From c50f179a15ad8c8bcbc7a71101a9ca23f19f6e8f Mon Sep 17 00:00:00 2001 From: Cristian Greco Date: Wed, 6 Oct 2010 03:22:41 +0200 Subject: Fix a bug in the implementation of the pseudo-random number generator This commit fixes an error in the mathematical formula of the Wichmann-Hill pseudo-random number generator. In particular, the implementation used until now produces sequences which differ from the expected ones by an extra starting number, which is instead the very last value of the sequence. This bug amplified the effect of extremely correlated initial numbers when seeding different generators with very similar seed values. --- lib/stdlib/src/random.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index 01227c29b4..d94722cb33 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -86,7 +86,7 @@ uniform() -> B2 = (A2*172) rem 30307, B3 = (A3*170) rem 30323, put(random_seed, {B1,B2,B3}), - R = A1/30269 + A2/30307 + A3/30323, + R = B1/30269 + B2/30307 + B3/30323, R - trunc(R). %% uniform(N) -> I @@ -110,7 +110,7 @@ uniform_s({A1, A2, A3}) -> B1 = (A1*171) rem 30269, B2 = (A2*172) rem 30307, B3 = (A3*170) rem 30323, - R = A1/30269 + A2/30307 + A3/30323, + R = B1/30269 + B2/30307 + B3/30323, {R - trunc(R), {B1,B2,B3}}. %% uniform_s(N, State) -> {I, NewState} -- cgit v1.2.3 From b52a2170d13fe7ff6e4e3b146b63d8f68c2aaadf Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Mon, 28 Mar 2011 16:38:57 +0200 Subject: Improve algorithm in module random. Avoid seed values that are even divisors of the primes and by that prevent getting seeds that are stuck on zero. Example: random:seed(0,0,0) would produce a series of only zeros. --- lib/stdlib/doc/src/random.xml | 7 ++++++- lib/stdlib/src/random.erl | 44 ++++++++++++++++++++++++------------------- 2 files changed, 31 insertions(+), 20 deletions(-) diff --git a/lib/stdlib/doc/src/random.xml b/lib/stdlib/doc/src/random.xml index dcc6d756e1..26f22db48e 100644 --- a/lib/stdlib/doc/src/random.xml +++ b/lib/stdlib/doc/src/random.xml @@ -4,7 +4,7 @@
- 19962009 + 19962011 Ericsson AB. All Rights Reserved. @@ -146,6 +146,11 @@ random_seed to remember the current seed.

If a process calls uniform/0 or uniform/1 without setting a seed first, seed/0 is called automatically.

+

The implementation changed in R15. Upgrading to R15 will break + applications that expect a specific output for a given seed. The output + is still deterministic number series, but different compared to releases + older than R15. The seed {0,0,0} will for example no longer + produce a flawed series of only zeros.

diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index d94722cb33..606edbb1fb 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-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,6 +26,10 @@ -export([seed/0, seed/1, seed/3, uniform/0, uniform/1, uniform_s/1, uniform_s/2, seed0/0]). +-define(PRIME1, 30269). +-define(PRIME2, 30307). +-define(PRIME3, 30323). + %%----------------------------------------------------------------------- %% The type of the state @@ -44,7 +48,11 @@ seed0() -> -spec seed() -> ran(). seed() -> - reseed(seed0()). + case seed_put(seed0()) of + undefined -> seed0(); + {_,_,_} = Tuple -> Tuple + end. + %% seed({A1, A2, A3}) %% Seed random number generation @@ -60,17 +68,15 @@ seed({A1, A2, A3}) -> -spec seed(integer(), integer(), integer()) -> 'undefined' | ran(). seed(A1, A2, A3) -> - put(random_seed, - {abs(A1) rem 30269, abs(A2) rem 30307, abs(A3) rem 30323}). + seed_put({(abs(A1) rem (?PRIME1-1)) + 1, % Avoid seed numbers that are + (abs(A2) rem (?PRIME2-1)) + 1, % even divisors of the + (abs(A3) rem (?PRIME3-1)) + 1}). % corresponding primes. --spec reseed(ran()) -> ran(). - -reseed({A1, A2, A3}) -> - case seed(A1, A2, A3) of - undefined -> seed0(); - {_,_,_} = Tuple -> Tuple - end. +-spec seed_put(ran()) -> 'undefined' | ran(). + +seed_put(Seed) -> + put(random_seed, Seed). %% uniform() %% Returns a random float between 0 and 1. @@ -82,11 +88,11 @@ uniform() -> undefined -> seed0(); Tuple -> Tuple end, - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, put(random_seed, {B1,B2,B3}), - R = B1/30269 + B2/30307 + B3/30323, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, R - trunc(R). %% uniform(N) -> I @@ -107,10 +113,10 @@ uniform(N) when is_integer(N), N >= 1 -> -spec uniform_s(ran()) -> {float(), ran()}. uniform_s({A1, A2, A3}) -> - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, - R = B1/30269 + B2/30307 + B3/30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, {R - trunc(R), {B1,B2,B3}}. %% uniform_s(N, State) -> {I, NewState} -- cgit v1.2.3 From 8db78b0c92a26e2a7766f8ece2f0ed7abb5db791 Mon Sep 17 00:00:00 2001 From: Filipe David Manana Date: Wed, 8 Jun 2011 17:33:18 +0100 Subject: Add NIF function enif_is_number This function allows for easily determining if a term represents or not a number (integer, float, small or big). --- erts/doc/src/erl_nif.xml | 4 ++++ erts/emulator/beam/erl_nif.c | 5 +++++ erts/emulator/beam/erl_nif_api_funcs.h | 2 ++ erts/emulator/test/nif_SUITE.erl | 25 +++++++++++++++++++++++-- erts/emulator/test/nif_SUITE_data/nif_SUITE.c | 4 +++- 5 files changed, 37 insertions(+), 3 deletions(-) diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index cdce4ec0b8..0f05d79488 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -692,6 +692,10 @@ typedef enum { Determine if a term is an exception

Return true if term is an exception.

 + intenif_is_number(ErlNifEnv* env, ERL_NIF_TERM term) + Determine if a term is a number (integer or float) +

Return true if term is a number.

 + intenif_is_fun(ErlNifEnv* env, ERL_NIF_TERM term) Determine if a term is a fun

Return true if term is a fun.

 diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 68421b4387..7ea0e1f6b2 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -435,6 +435,11 @@ int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term) return term == THE_NON_VALUE; } +int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term) +{ + return is_number(term); +} + static void aligned_binary_dtor(struct enif_tmp_obj_t* obj) { erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP); diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index c991b61abe..43d706dc72 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -136,6 +136,7 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64)); #endif ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); /* ** Add new entries here to keep compatibility on Windows!!! @@ -256,6 +257,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); #endif # define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception) +# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number) /* ** Add new entries here diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 91d695d979..8ed9ccd9ca 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1121,7 +1121,28 @@ is_checks(Config) when is_list(Config) -> ?line ensure_lib_loaded(Config, 1), ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], - {hejsan, "hejsan", [$h,"ejs",<<"an">>]}), + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try ?line error = check_is_exception(), ?line throw(expected_badarg) @@ -1251,7 +1272,7 @@ get_resource(_,_) -> ?nif_stub. release_resource(_) -> ?nif_stub. last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. -check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. +check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. check_is_exception() -> ?nif_stub. length_test(_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 0bb93daa33..014215bd68 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -781,6 +781,7 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER * argv[7] an empty list * argv[8] a non-empty list * argv[9] a tuple + * argv[10] a number (small, big integer or float) */ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -797,6 +798,7 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] if (!enif_is_list(env, argv[7])) return enif_make_badarg(env); if (!enif_is_list(env, argv[8])) return enif_make_badarg(env); if (!enif_is_tuple(env, argv[9])) return enif_make_badarg(env); + if (!enif_is_number(env, argv[10])) return enif_make_badarg(env); return ok_atom; } @@ -1399,7 +1401,7 @@ static ErlNifFunc nif_funcs[] = {"release_resource", 1, release_resource}, {"last_resource_dtor_call", 0, last_resource_dtor_call}, {"make_new_resource", 2, make_new_resource}, - {"check_is", 10, check_is}, + {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, {"length_test", 5, length_test}, {"make_atoms", 0, make_atoms}, -- cgit v1.2.3 From 584bfb265cc0be5f21a50347c135f1f9f2e38a2f Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 9 Aug 2011 12:22:55 +0200 Subject: Remove the warning that driver option is replaced by nif --- lib/megaco/src/binary/depend.mk | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lib/megaco/src/binary/depend.mk b/lib/megaco/src/binary/depend.mk index d12bd8bad0..c9ca34bcf6 100644 --- a/lib/megaco/src/binary/depend.mk +++ b/lib/megaco/src/binary/depend.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# Copyright Ericsson AB 2001-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,9 +24,9 @@ # but for per_bin it means that a stage in the encode # is done in the asn1 driver. # -# +driver +# +nif # For ber_bin this means that part of the decode is done -# in the asn1 driver. +# in the asn1 nif. # # +asn1config # This is only used by the ber_bin, and means that @@ -45,22 +45,22 @@ endif BER_V1_FLAGS = $(ASN1_CT_OPTS) BER_BIN_V1_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_V1_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_V1_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_V2_FLAGS = $(ASN1_CT_OPTS) BER_BIN_V2_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_V2_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_V2_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_PREV3A_FLAGS = $(ASN1_CT_OPTS) BER_BIN_PREV3A_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_PREV3A_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_PREV3A_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_PREV3B_FLAGS = $(ASN1_CT_OPTS) BER_BIN_PREV3B_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_PREV3B_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_PREV3B_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_PREV3C_FLAGS = $(ASN1_CT_OPTS) BER_BIN_PREV3C_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_PREV3C_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_PREV3C_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif BER_V3_FLAGS = $(ASN1_CT_OPTS) BER_BIN_V3_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize -BER_BIN_DRV_V3_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +driver +BER_BIN_DRV_V3_FLAGS = $(ASN1_CT_OPTS) +asn1config +optimize +nif PER_V1_FLAGS = $(ASN1_CT_OPTS) PER_BIN_V1_FLAGS = $(ASN1_CT_OPTS) PER_BIN_DRV_V1_FLAGS = $(ASN1_CT_OPTS) +optimize -- cgit v1.2.3 From 73d1959237d0a77dc10f57d83f6c2ed065a90528 Mon Sep 17 00:00:00 2001 From: Mats Cronqvist Date: Fri, 22 Oct 2010 10:53:32 +0200 Subject: make tab completion work in remote shells --- lib/kernel/src/user_drv.erl | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index c34f2ddeb0..e33b4830ab 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -117,8 +117,9 @@ server1(Iport, Oport, Shell) -> {Curr,Shell1} = case init:get_argument(remsh) of {ok,[[Node]]} -> - RShell = {list_to_atom(Node),shell,start,[]}, - RGr = group:start(self(), RShell), + ANode = list_to_atom(Node), + RShell = {ANode,shell,start,[]}, + RGr = group:start(self(), RShell, rem_sh_opts(ANode)), {RGr,RShell}; E when E =:= error ; E =:= {ok,[[]]} -> {group:start(self(), Shell),Shell} @@ -134,6 +135,9 @@ server1(Iport, Oport, Shell) -> %% Enter the server loop. server_loop(Iport, Oport, Curr, User, Gr). +rem_sh_opts(Node) -> + [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. + %% start_user() %% Start a group leader process and register it as 'user', unless, %% of course, a 'user' already exists. -- cgit v1.2.3 From 12c84d2ec315c8d26afc2adb8aa50cfe6183fc8a Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 1 Sep 2011 13:07:38 +0200 Subject: Fix two minor disk_log bugs disk_log:reopen/2,3 and disk_log:breopen/3 could return the error reason from file:rename/2 rather than the reason {file_error, Filename, Reason}. The message {disk_log, Node, {error, disk_log_stopped}} which according the documentation is sent upon failure to truncate or reopen a disk log was sometimes turned into a reply. --- lib/kernel/src/disk_log.erl | 22 ++++++++++++++++------ lib/kernel/test/disk_log_SUITE.erl | 15 ++++++++++----- 2 files changed, 26 insertions(+), 11 deletions(-) diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 9b8d2db437..d6bc23be6d 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1240,20 +1240,29 @@ is_owner(Pid, L) -> %% ok | throw(Error) rename_file(File, NewFile, halt) -> - file:rename(File, NewFile); + case file:rename(File, NewFile) of + ok -> + ok; + Else -> + file_error(NewFile, Else) + end; rename_file(File, NewFile, wrap) -> rename_file(wrap_file_extensions(File), File, NewFile, ok). -rename_file([Ext|Exts], File, NewFile, Res) -> - NRes = case file:rename(add_ext(File, Ext), add_ext(NewFile, Ext)) of +rename_file([Ext|Exts], File, NewFile0, Res) -> + NewFile = add_ext(NewFile0, Ext), + NRes = case file:rename(add_ext(File, Ext), NewFile) of ok -> Res; Else -> - Else + file_error(NewFile, Else) end, - rename_file(Exts, File, NewFile, NRes); + rename_file(Exts, File, NewFile0, NRes); rename_file([], _File, _NewFiles, Res) -> Res. +file_error(FileName, {error, Error}) -> + {error, {file_error, FileName, Error}}. + %% "Old" error messages have been kept, arg_mismatch has been added. %%-spec compare_arg(dlog_options(), #arg{}, compare_arg([], _A, none, _OrigHead) -> @@ -1947,7 +1956,8 @@ monitor_request(Pid, Req) -> receive {'DOWN', Ref, process, Pid, _Info} -> {error, no_such_log}; - {disk_log, Pid, Reply} -> + {disk_log, Pid, Reply} when not is_tuple(Reply) orelse + element(2, Reply) =/= disk_log_stopped -> erlang:demonitor(Ref), receive {'DOWN', Ref, process, Pid, _Reason} -> diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 4ae47b4762..ad987fe7a7 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -1831,11 +1831,16 @@ block_queue2(Conf) when is_list(Conf) -> %% Asynchronous stuff is ignored. ?line ok = disk_log:balog_terms(n, [<<"foo">>,<<"bar">>]), ?line ok = disk_log:balog_terms(n, [<<"more">>,<<"terms">>]), + Parent = self(), ?line Fun = - fun() -> {error,disk_log_stopped} = disk_log:sync(n) + fun() -> + {error,no_such_log} = disk_log:sync(n), + receive {disk_log, _, {error, disk_log_stopped}} -> ok end, + Parent ! disk_log_stopped_ok end, ?line spawn(Fun), ?line ok = sync_do(Pid, close), + ?line receive disk_log_stopped_ok -> ok end, ?line sync_do(Pid, terminate), ?line {ok,<<>>} = file:read_file(File ++ ".1"), ?line del(File, No), @@ -2708,7 +2713,7 @@ error_log(Conf) when is_list(Conf) -> % reopen (rename) fails, the log is terminated, ./File.2/ exists ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, {format, external},{size, 100000}]), - ?line {error, eisdir} = disk_log:reopen(n, LDir), + ?line {error, {file_error, _, eisdir}} = disk_log:reopen(n, LDir), ?line true = (P0 == pps()), ?line file:delete(File), @@ -2719,7 +2724,7 @@ error_log(Conf) when is_list(Conf) -> ?line {ok, n} = disk_log:open([{name, n}, {file, File2}, {type, wrap}, {format, external},{size, {100, No}}]), ?line ok = disk_log:blog_terms(n, [B,B,B]), - ?line {error, eisdir} = disk_log:reopen(n, File), + ?line {error, {file_error, _, eisdir}} = disk_log:reopen(n, File), ?line {error, no_such_log} = disk_log:close(n), ?line del(File2, No), ?line del(File, No), @@ -4917,7 +4922,7 @@ mark(FileName, What) -> ok = file:close(Fd). crash(File, Where) -> - {ok, Fd} = file:open(File, read_write), + {ok, Fd} = file:open(File, [read,write]), file:position(Fd, Where), ok = file:write(Fd, [10]), ok = file:close(Fd). @@ -4933,7 +4938,7 @@ writable(Fname) -> file:write_file_info(Fname, Info#file_info{mode = Mode}). truncate(File, Where) -> - {ok, Fd} = file:open(File, read_write), + {ok, Fd} = file:open(File, [read,write]), file:position(Fd, Where), ok = file:truncate(Fd), ok = file:close(Fd). -- cgit v1.2.3 From 29610af8d3db844568cffc4218f79fc68bfd8094 Mon Sep 17 00:00:00 2001 From: Haitao Li Date: Fri, 26 Aug 2011 10:21:41 +0800 Subject: ms_transform: Fix incorrect `variable shadowed' warnings Compile below module resulting incorrect warning: $ cat tmp.erl -module(tmp). -export([tmp/1]). -include_lib("stdlib/include/ms_transform.hrl"). tmp(X) when X > 100 -> Y=X, Y; tmp(X) -> ets:fun2ms(fun(Y) -> {X, Y} end). $ erlc tmp.erl ./tmp.erl:8: Warning: variable 'Y' shadowed in ms_transform fun head The scope for a variable is its function clause. Variables bound in one function clause should not interfere with other function clauses. This patch removes incorrect passing of variable bindings from one function clause to another. Signed-off-by: Haitao Li --- lib/stdlib/src/ms_transform.erl | 17 +++++++------ lib/stdlib/test/ms_transform_SUITE.erl | 45 +++++++++++++++++++++++++++++++++- 2 files changed, 53 insertions(+), 9 deletions(-) diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 48e22e53fa..63b397f3a5 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -333,17 +333,18 @@ form({function,Line,Name0,Arity0,Clauses0}) -> form(AnyOther) -> AnyOther. function(Name, Arity, Clauses0) -> - {Clauses1,_} = clauses(Clauses0,gb_sets:new()), + Clauses1 = clauses(Clauses0), {Name,Arity,Clauses1}. -clauses([C0|Cs],Bound) -> - {C1,Bound1} = clause(C0,Bound), - {C2,Bound2} = clauses(Cs,Bound1), - {[C1|C2],Bound2}; -clauses([],Bound) -> {[],Bound}. +clauses([C0|Cs]) -> + C1 = clause(C0,gb_sets:new()), + C2 = clauses(Cs), + [C1|C2]; +clauses([]) -> []. + clause({clause,Line,H0,G0,B0},Bound) -> {H1,Bound1} = copy(H0,Bound), - {B1,Bound2} = copy(B0,Bound1), - {{clause,Line,H1,G0,B1},Bound2}. + {B1,_Bound2} = copy(B0,Bound1), + {clause,Line,H1,G0,B1}. copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}}, As0},Bound) -> diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index 4e5df12798..c9688354b1 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -39,6 +39,7 @@ -export([float_1_function/1]). -export([action_function/1]). -export([warnings/1]). +-export([no_warnings/1]). -export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(_Func, Config) -> @@ -55,7 +56,7 @@ all() -> [from_shell, basic_ets, basic_dbg, records, record_index, multipass, bitsyntax, record_defaults, andalso_orelse, float_1_function, action_function, - warnings, top_match, old_guards, autoimported, + warnings, no_warnings, top_match, old_guards, autoimported, semicolon]. groups() -> @@ -155,6 +156,34 @@ warnings(Config) when is_list(Config) -> compile_ww(Prog7), ok. +no_warnings(suite) -> + []; +no_warnings(doc) -> + ["Check that variables bound in other function clauses don't generate " + "warning"]; +no_warnings(Config) when is_list(Config) -> + ?line setup(Config), + Prog = <<"tmp(X) when X > 100 ->\n", + " Y=X,\n" + " Y;\n" + "tmp(X) ->\n" + " ets:fun2ms(fun(Y) ->\n" + " {X, 3*Y}\n" + " end)">>, + ?line [] = compile_no_ww(Prog), + + Prog2 = <<"tmp(X) when X > 100 ->\n", + " Y=X,\n" + " Y;\n" + "tmp(X) when X < 200 ->\n" + " ok;\n" + "tmp(X) ->\n" + " ets:fun2ms(fun(Y) ->\n" + " {X, 3*Y}\n" + " end)">>, + ?line [] = compile_no_ww(Prog2), + ok. + andalso_orelse(suite) -> []; andalso_orelse(doc) -> @@ -842,6 +871,20 @@ compile_ww(Records,Expr) -> nowarn_unused_record]), Wlist. +compile_no_ww(Expr) -> + Prog = << + "-module(tmp).\n", + "-include_lib(\"stdlib/include/ms_transform.hrl\").\n", + "-export([tmp/1]).\n\n", + Expr/binary,".\n">>, + FN=temp_name(), + file:write_file(FN,Prog), + {ok,Forms} = epp:parse_file(FN,"",""), + {ok,tmp,_Bin,Wlist} = compile:forms(Forms,[return_warnings, + nowarn_unused_vars, + nowarn_unused_record]), + Wlist. + do_eval(String) -> {done,{ok,T,_},[]} = erl_scan:tokens( [], -- cgit v1.2.3 From 49854c414bc2d7ca0d538086476ca81c34d38fae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 7 Sep 2011 10:05:11 +0200 Subject: erts/configure.in: Remove useless --disable-fixalloc option ./configure --disable-fixalloc does not do anytning any longer, since there is no longer any "fix allocators" (in the original sense). --- erts/configure.in | 7 ------- erts/emulator/sys/vxworks/sys.c | 3 --- 2 files changed, 10 deletions(-) diff --git a/erts/configure.in b/erts/configure.in index 3dbf98b876..2ae9c63215 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -259,13 +259,6 @@ AS_HELP_STRING([--enable-m32-build], esac ],enable_m32_build=no) -AC_ARG_ENABLE(fixalloc, -AS_HELP_STRING([--disable-fixalloc], [disable the use of fix_alloc])) -if test x${enable_fixalloc} = xno ; then - AC_DEFINE(NO_FIX_ALLOC,[], - [Define if you don't want the fix allocator in Erlang]) -fi - AC_SUBST(PERFCTR_PATH) AC_ARG_WITH(perfctr, AS_HELP_STRING([--with-perfctr=PATH], diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c index c6e7b65f32..a59e4ec26a 100644 --- a/erts/emulator/sys/vxworks/sys.c +++ b/erts/emulator/sys/vxworks/sys.c @@ -2025,9 +2025,6 @@ int erl_memory_show(int p0, int p1, int p2, int p3, int p4, int p5, erts_printf("The memory block used by elib is save_malloc'ed " "at 0x%08x.\n", (unsigned int) alloc_pool_ptr); } -#ifdef NO_FIX_ALLOC - erts_printf("Fix_alloc is disabled in this build\n"); -#endif erts_printf("Statistics from elib_malloc:\n"); ELIB_LOCK; -- cgit v1.2.3 From 3fcc5534a40dbe9af99f5e2a84c9e56130cf0464 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 7 Sep 2011 10:23:06 +0200 Subject: erts/configure.in: Don't check for the presence of mach-o/dyld.h We no longer include mach-o/dyld.h (because we only support MacOS X versions that have dlopen()). --- erts/autoconf/win32.config.cache.static | 1 - erts/configure.in | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/erts/autoconf/win32.config.cache.static b/erts/autoconf/win32.config.cache.static index d25b1df9d9..bbfe66ffdf 100755 --- a/erts/autoconf/win32.config.cache.static +++ b/erts/autoconf/win32.config.cache.static @@ -124,7 +124,6 @@ ac_cv_header_ieeefp_h=${ac_cv_header_ieeefp_h=no} ac_cv_header_inttypes_h=${ac_cv_header_inttypes_h=no} ac_cv_header_langinfo_h=${ac_cv_header_langinfo_h=no} ac_cv_header_limits_h=${ac_cv_header_limits_h=yes} -ac_cv_header_mach_o_dyld_h=${ac_cv_header_mach_o_dyld_h=no} ac_cv_header_malloc_h=${ac_cv_header_malloc_h=yes} ac_cv_header_memory_h=${ac_cv_header_memory_h=yes} ac_cv_header_net_errno_h=${ac_cv_header_net_errno_h=no} diff --git a/erts/configure.in b/erts/configure.in index 2ae9c63215..bea1e14859 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1477,7 +1477,7 @@ AC_CHECK_HEADERS(fcntl.h limits.h unistd.h syslog.h dlfcn.h ieeefp.h \ sys/types.h sys/stropts.h sys/sysctl.h \ sys/ioctl.h sys/time.h sys/uio.h \ sys/socket.h sys/sockio.h sys/socketio.h \ - net/errno.h malloc.h mach-o/dyld.h arpa/nameser.h \ + net/errno.h malloc.h arpa/nameser.h \ pty.h util.h utmp.h langinfo.h poll.h sdkddkver.h) AC_CHECK_HEADER(sys/resource.h, -- cgit v1.2.3 From 293e2c2fa1c0cca21c941fd15033d3251dfa0711 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 7 Sep 2011 10:38:39 +0200 Subject: erts/configure.in: Remove broken support for System V If we are compiling on System V, the symbols NO_WEAK_PRAGMA and SOCKOPT_CONNECT_STAT are defined, but they are never used. --- erts/configure.in | 10 ---------- erts/emulator/drivers/common/inet_drv.c | 4 ++-- 2 files changed, 2 insertions(+), 12 deletions(-) diff --git a/erts/configure.in b/erts/configure.in index bea1e14859..77ea7a2471 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -907,16 +907,6 @@ fi AC_SUBST(ERLANG_OSTYPE) -dnl Which sysv4 would this be, and what is it for??? -dnl XXX: replace with feature tests. -case $host_os in - sysv4*) - AC_DEFINE(SOCKOPT_CONNECT_STAT,[],[Obscure SYSV feature]) - AC_DEFINE(NO_PRAGMA_WEAK,[],[Obscure SYSV feature]) - LIBS="$LIBS -lgen -lc -L /usr/ucblib -lucb" - ;; -esac - # Check how to export functions from the emulator executable, needed # when dynamically loaded drivers are loaded (so that they can find # emulator functions). diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index ebc4469a23..df1f19c482 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -9308,7 +9308,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) goto done; } } -#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* SO_ERROR */ #endif /* !__WIN32__ */ desc->inet.state = TCP_STATE_CONNECTED; @@ -10113,7 +10113,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event) goto done; } } -#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* SO_ERROR */ #endif /* !__WIN32__ */ desc->state = PACKET_STATE_CONNECTED; -- cgit v1.2.3 From c250fb907317bffbc17f7c3d962fa083d124f444 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 7 Sep 2011 11:04:21 +0200 Subject: erts/configure.in: Remove test for reversed setvbuf() arguments The test is not needed, because no code tests whether SETVBUF_REVERSED is defined. Furthermore, AC_FUNC_SETVBUF_REVERSED is now documented like this: Do nothing. Formerly, this macro checked whether setvbuf takes the buffering type as its second argument and the buffer pointer as the third, instead of the other way around, and defined SETVBUF_REVERSED. However, the last systems to have the problem were those based on SVR2, which became obsolete in 1987, and the macro is no longer needed. --- erts/autoconf/win32.config.cache.static | 1 - erts/configure.in | 5 ----- 2 files changed, 6 deletions(-) diff --git a/erts/autoconf/win32.config.cache.static b/erts/autoconf/win32.config.cache.static index bbfe66ffdf..b387db2b22 100755 --- a/erts/autoconf/win32.config.cache.static +++ b/erts/autoconf/win32.config.cache.static @@ -96,7 +96,6 @@ ac_cv_func_sbrk=${ac_cv_func_sbrk=no} ac_cv_func_select=${ac_cv_func_select=no} ac_cv_func_setlocale=${ac_cv_func_setlocale=yes} ac_cv_func_setsid=${ac_cv_func_setsid=no} -ac_cv_func_setvbuf_reversed=${ac_cv_func_setvbuf_reversed=yes} ac_cv_func_socket=${ac_cv_func_socket=no} ac_cv_func_strchr=${ac_cv_func_strchr=yes} ac_cv_func_strerror=${ac_cv_func_strerror=yes} diff --git a/erts/configure.in b/erts/configure.in index 77ea7a2471..4cb573b061 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1792,11 +1792,6 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop AC_CHECK_DECLS([posix2time],,,[#include ]) -if test "X$host" = "Xwin32"; then - ac_cv_func_setvbuf_reversed=yes -fi -AC_FUNC_SETVBUF_REVERSED - disable_vfork=false if test "x$EMU_THR_LIB_NAME" != "x"; then AC_MSG_CHECKING([if vfork is known to hang multithreaded applications]) -- cgit v1.2.3 From 47759479146ca11ad81eca0bb3236b265e20601d Mon Sep 17 00:00:00 2001 From: Christopher Faulet Date: Mon, 5 Sep 2011 12:42:33 +0200 Subject: Explicitly kill dynamic children in supervisors According to the supervisor's documentation: "Important note on simple-one-for-one supervisors: The dynamically created child processes of a simple-one-for-one supervisor are not explicitly killed, regardless of shutdown strategy, but are expected to terminate when the supervisor does (that is, when an exit signal from the parent process is received)." All is fine as long as we stop simple_one_for_one supervisor manually. Dynamic children catch the exit signal from the supervisor and leave. But, if this happens when we stop an application, after the top supervisor has stopped, the application master kills all remaining processes associated to this application. So, dynamic children that trap exit signals can be killed during their cleanup (here we mean inside terminate/2). This is unpredictable and highly time-dependent. In this commit, supervisor module is patched to explicitly terminate dynamic children accordingly to the shutdown strategy. NOTE: Order in which dynamic children are stopped is not defined. In fact, this is "almost" done at the same time. --- lib/stdlib/doc/src/supervisor.xml | 6 -- lib/stdlib/src/supervisor.erl | 116 +++++++++++++++++++++++++++++++++-- lib/stdlib/test/Makefile | 1 + lib/stdlib/test/supervisor_2.erl | 42 +++++++++++++ lib/stdlib/test/supervisor_SUITE.erl | 38 +++++++++++- 5 files changed, 190 insertions(+), 13 deletions(-) create mode 100644 lib/stdlib/test/supervisor_2.erl diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index edd119d37a..b4e81aba1f 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -171,12 +171,6 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules}

If the child process is another supervisor, Shutdown should be set to infinity to give the subtree ample time to shutdown.

-

Important note on simple-one-for-one supervisors: - The dynamically created child processes of a - simple-one-for-one supervisor are not explicitly killed, - regardless of shutdown strategy, but are expected to terminate - when the supervisor does (that is, when an exit signal from - the parent process is received).

Note that all child processes implemented using the standard OTP behavior modules automatically adhere to the shutdown protocol.

diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index dc31647eb5..8e1ac1bb5c 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -519,9 +519,12 @@ handle_info(Msg, State) -> %% -spec terminate(term(), state()) -> 'ok'. +terminate(_Reason, #state{children=[Child]} = State) when ?is_simple(State) -> + terminate_dynamic_children(Child, dynamics_db(Child#child.restart_type, + State#state.dynamics), + State#state.name); terminate(_Reason, State) -> - terminate_children(State#state.children, State#state.name), - ok. + terminate_children(State#state.children, State#state.name). %% %% Change code for the supervisor. @@ -831,8 +834,113 @@ monitor_child(Pid) -> %% that will be handled in shutdown/2. ok end. - - + + +%%----------------------------------------------------------------- +%% Func: terminate_dynamic_children/3 +%% Args: Child = child_rec() +%% Dynamics = ?DICT() | ?SET() +%% SupName = {local, atom()} | {global, atom()} | {pid(),Mod} +%% Returns: ok +%% +%% +%% Shutdown all dynamic children. This happens when the supervisor is +%% stopped. Because the supervisor can have millions of dynamic children, we +%% can have an significative overhead here. +%%----------------------------------------------------------------- +terminate_dynamic_children(Child, Dynamics, SupName) -> + Pids = monitor_dynamic_children(Child, Dynamics, SupName), + Sz = ?SETS:size(Pids), + case Child#child.shutdown of + brutal_kill -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, SupName, Sz, undefined); + infinity -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + wait_dynamic_children(Child, Pids, SupName, Sz, undefined); + Time -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + TRef = erlang:start_timer(Time, self(), kill), + wait_dynamic_children(Child, Pids, SupName, Sz, TRef) + end. + + +monitor_dynamic_children(#child{restart_type=temporary} = Child, + Dynamics, SupName) -> + ?SETS:fold(fun(P, Acc) -> + case monitor_child(P) of + ok -> + ?SETS:add_element(P, Acc); + {error, normal} -> + Acc; + {error, OtherReason} -> + report_error(shutdown_error, OtherReason, + Child#child{pid=P}, SupName), + Acc + end + end, ?SETS:new(), Dynamics); +monitor_dynamic_children(#child{restart_type=RType} = Child, + Dynamics, SupName) -> + ?DICT:fold(fun(P, _, Acc) -> + case monitor_child(P) of + ok -> + ?SETS:add_element(P, Acc); + {error, normal} when RType =/= permanent -> + Acc; + {error, OtherReason} -> + report_error(shutdown_error, OtherReason, + Child#child{pid=P}, SupName), + Acc + end + end, ?SETS:new(), Dynamics). + + + +wait_dynamic_children(_Child, _Pids, _SupName, 0, undefined) -> + ok; +wait_dynamic_children(_Child, _Pids, _SupName, 0, TRef) -> + %% If the timer has expired before its cancellation, we must empty the + %% mail-box of the 'timeout'-message. + erlang:cancel_timer(TRef), + receive + {timeout, TRef, kill} -> + ok + after 0 -> + ok + end; +wait_dynamic_children(#child{shutdown=brutal_kill} = Child, + Pids, SupName, Sz, TRef) -> + receive + {'DOWN', _MRef, process, Pid, killed} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, + Sz-1, TRef); + + {'DOWN', _MRef, process, Pid, Reason} -> + report_error(shutdown_error, Reason, Child#child{pid=Pid}, SupName), + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, + Sz-1, TRef) + end; +wait_dynamic_children(#child{restart_type=RType} = Child, Pids, + SupName, Sz, TRef) -> + receive + {'DOWN', _MRef, process, Pid, shutdown} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, + Sz-1, TRef); + + {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, + Sz-1, TRef); + + {'DOWN', _MRef, process, Pid, Reason} -> + report_error(shutdown_error, Reason, Child#child{pid=Pid}, SupName), + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, + Sz-1, TRef); + + {timeout, TRef, kill} -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, SupName, Sz, undefined) + end. + %%----------------------------------------------------------------- %% Child/State manipulating functions. %%----------------------------------------------------------------- diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 5502c69fa5..aa6a660c34 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -65,6 +65,7 @@ MODULES= \ stdlib_SUITE \ string_SUITE \ supervisor_1 \ + supervisor_2 \ naughty_child \ shell_SUITE \ supervisor_SUITE \ diff --git a/lib/stdlib/test/supervisor_2.erl b/lib/stdlib/test/supervisor_2.erl new file mode 100644 index 0000000000..67aacf5a9c --- /dev/null +++ b/lib/stdlib/test/supervisor_2.erl @@ -0,0 +1,42 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% Description: Simulates the behaviour that a child process may have. +%% Is used by the supervisor_SUITE test suite. +-module(supervisor_2). + +-export([start_child/1, init/1]). + +-export([handle_call/3, handle_info/2, terminate/2]). + +start_child(Time) when is_integer(Time), Time > 0 -> + gen_server:start_link(?MODULE, Time, []). + +init(Time) -> + process_flag(trap_exit, true), + {ok, Time}. + +handle_call(Req, _From, State) -> + {reply, Req, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, Time) -> + timer:sleep(Time), + ok. diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index b48450c151..a6358e7063 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -50,7 +50,7 @@ one_for_all_escalation/1, simple_one_for_one/1, simple_one_for_one_escalation/1, rest_for_one/1, rest_for_one_escalation/1, - simple_one_for_one_extra/1]). + simple_one_for_one_extra/1, simple_one_for_one_shutdown/1]). %% Misc tests -export([child_unlink/1, tree/1, count_children_memory/1, @@ -94,8 +94,8 @@ groups() -> {restart_one_for_all, [], [one_for_all, one_for_all_escalation]}, {restart_simple_one_for_one, [], - [simple_one_for_one, simple_one_for_one_extra, - simple_one_for_one_escalation]}, + [simple_one_for_one, simple_one_for_one_shutdown, + simple_one_for_one_extra, simple_one_for_one_escalation]}, {restart_rest_for_one, [], [rest_for_one, rest_for_one_escalation]}]. @@ -782,6 +782,38 @@ simple_one_for_one(Config) when is_list(Config) -> terminate(SupPid, Pid4, Id4, abnormal), check_exit([SupPid]). + +%%------------------------------------------------------------------------- +simple_one_for_one_shutdown(doc) -> + ["Test simple_one_for_one children shutdown accordingly to the " + "supervisor's shutdown strategy."]; +simple_one_for_one_shutdown(suite) -> []; +simple_one_for_one_shutdown(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ShutdownTime = 1000, + Child = {child, {supervisor_2, start_child, []}, + permanent, 2*ShutdownTime, worker, []}, + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + + %% Will be gracefully shutdown + {ok, _CPid1} = supervisor:start_child(sup_test, [ShutdownTime]), + {ok, _CPid2} = supervisor:start_child(sup_test, [ShutdownTime]), + + %% Will be killed after 2*ShutdownTime milliseconds + {ok, _CPid3} = supervisor:start_child(sup_test, [5*ShutdownTime]), + + {T, ok} = timer:tc(fun terminate/2, [SupPid, shutdown]), + if T < 1000*ShutdownTime -> + %% Because supervisor's children wait before exiting, it can't + %% terminate quickly + test_server:fail({shutdown_too_short, T}); + T >= 1000*5*ShutdownTime -> + test_server:fail({shutdown_too_long, T}); + true -> + check_exit([SupPid]) + end. + + %%------------------------------------------------------------------------- simple_one_for_one_extra(doc) -> ["Tests automatic restart of children " -- cgit v1.2.3 From 42c581ddefd332fcadea696b5b2bedcdd575f14a Mon Sep 17 00:00:00 2001 From: Christopher Faulet Date: Wed, 14 Sep 2011 16:30:44 +0200 Subject: Stack errors when dynamic children are stopped Because a simple_one_for_one supervisor can have many workers, we stack errors during its shutdown to report only one message for each encountered error type. Instead of reporting the child's pid, we use the number of concerned children. --- lib/stdlib/src/supervisor.erl | 123 +++++++++++++++++++++--------------------- 1 file changed, 63 insertions(+), 60 deletions(-) diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 8e1ac1bb5c..d103487218 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -849,96 +849,92 @@ monitor_child(Pid) -> %% can have an significative overhead here. %%----------------------------------------------------------------- terminate_dynamic_children(Child, Dynamics, SupName) -> - Pids = monitor_dynamic_children(Child, Dynamics, SupName), - Sz = ?SETS:size(Pids), - case Child#child.shutdown of - brutal_kill -> - ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), - wait_dynamic_children(Child, Pids, SupName, Sz, undefined); - infinity -> - ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), - wait_dynamic_children(Child, Pids, SupName, Sz, undefined); - Time -> - ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), - TRef = erlang:start_timer(Time, self(), kill), - wait_dynamic_children(Child, Pids, SupName, Sz, TRef) - end. - - -monitor_dynamic_children(#child{restart_type=temporary} = Child, - Dynamics, SupName) -> - ?SETS:fold(fun(P, Acc) -> + {Pids, EStack0} = monitor_dynamic_children(Child, Dynamics), + Sz = ?SETS:size(Pids), + EStack = case Child#child.shutdown of + brutal_kill -> + ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + infinity -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + wait_dynamic_children(Child, Pids, Sz, undefined, EStack0); + Time -> + ?SETS:fold(fun(P, _) -> exit(P, shutdown) end, ok, Pids), + TRef = erlang:start_timer(Time, self(), kill), + wait_dynamic_children(Child, Pids, Sz, TRef, EStack0) + end, + %% Unrool stacked errors and report them + ?DICT:fold(fun(Reason, Ls, _) -> + report_error(shutdown_error, Reason, + Child#child{pid=Ls}, SupName) + end, ok, EStack). + + +monitor_dynamic_children(#child{restart_type=temporary}, Dynamics) -> + ?SETS:fold(fun(P, {Pids, EStack}) -> case monitor_child(P) of ok -> - ?SETS:add_element(P, Acc); + {?SETS:add_element(P, Pids), EStack}; {error, normal} -> - Acc; - {error, OtherReason} -> - report_error(shutdown_error, OtherReason, - Child#child{pid=P}, SupName), - Acc + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} end - end, ?SETS:new(), Dynamics); -monitor_dynamic_children(#child{restart_type=RType} = Child, - Dynamics, SupName) -> - ?DICT:fold(fun(P, _, Acc) -> + end, {?SETS:new(), ?DICT:new()}, Dynamics); +monitor_dynamic_children(#child{restart_type=RType}, Dynamics) -> + ?DICT:fold(fun(P, _, {Pids, EStack}) -> case monitor_child(P) of ok -> - ?SETS:add_element(P, Acc); + {?SETS:add_element(P, Pids), EStack}; {error, normal} when RType =/= permanent -> - Acc; - {error, OtherReason} -> - report_error(shutdown_error, OtherReason, - Child#child{pid=P}, SupName), - Acc + {Pids, EStack}; + {error, Reason} -> + {Pids, ?DICT:append(Reason, P, EStack)} end - end, ?SETS:new(), Dynamics). - + end, {?SETS:new(), ?DICT:new()}, Dynamics). -wait_dynamic_children(_Child, _Pids, _SupName, 0, undefined) -> - ok; -wait_dynamic_children(_Child, _Pids, _SupName, 0, TRef) -> +wait_dynamic_children(_Child, _Pids, 0, undefined, EStack) -> + EStack; +wait_dynamic_children(_Child, _Pids, 0, TRef, EStack) -> %% If the timer has expired before its cancellation, we must empty the %% mail-box of the 'timeout'-message. erlang:cancel_timer(TRef), receive {timeout, TRef, kill} -> - ok + EStack after 0 -> - ok + EStack end; -wait_dynamic_children(#child{shutdown=brutal_kill} = Child, - Pids, SupName, Sz, TRef) -> +wait_dynamic_children(#child{shutdown=brutal_kill} = Child, Pids, Sz, + TRef, EStack) -> receive {'DOWN', _MRef, process, Pid, killed} -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, - Sz-1, TRef); + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); {'DOWN', _MRef, process, Pid, Reason} -> - report_error(shutdown_error, Reason, Child#child{pid=Pid}, SupName), - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, - Sz-1, TRef) + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)) end; -wait_dynamic_children(#child{restart_type=RType} = Child, Pids, - SupName, Sz, TRef) -> +wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, + TRef, EStack) -> receive {'DOWN', _MRef, process, Pid, shutdown} -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, - Sz-1, TRef); + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, - Sz-1, TRef); + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); {'DOWN', _MRef, process, Pid, Reason} -> - report_error(shutdown_error, Reason, Child#child{pid=Pid}, SupName), - wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), SupName, - Sz-1, TRef); + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, ?DICT:append(Reason, Pid, EStack)); {timeout, TRef, kill} -> ?SETS:fold(fun(P, _) -> exit(P, kill) end, ok, Pids), - wait_dynamic_children(Child, Pids, SupName, Sz, undefined) + wait_dynamic_children(Child, Pids, Sz-1, undefined, EStack) end. %%----------------------------------------------------------------- @@ -1243,8 +1239,15 @@ report_error(Error, Reason, Child, SupName) -> error_logger:error_report(supervisor_report, ErrorMsg). -extract_child(Child) -> +extract_child(Child) when is_pid(Child#child.pid) -> [{pid, Child#child.pid}, + {name, Child#child.name}, + {mfargs, Child#child.mfargs}, + {restart_type, Child#child.restart_type}, + {shutdown, Child#child.shutdown}, + {child_type, Child#child.child_type}]; +extract_child(Child) -> + [{nb_children, length(Child#child.pid)}, {name, Child#child.name}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, -- cgit v1.2.3 From 04731323678eff58f709b36f864d12aa08cfe6d9 Mon Sep 17 00:00:00 2001 From: Christopher Faulet Date: Wed, 14 Sep 2011 17:49:38 +0200 Subject: Explain how dynamic child processes are stopped --- lib/stdlib/doc/src/supervisor.xml | 4 ++++ system/doc/design_principles/sup_princ.xml | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index b4e81aba1f..9cc9b69dd9 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -94,6 +94,10 @@ instead the child specification identifier is used, terminate_child/2 will return {error,simple_one_for_one}.

+

Because a simple_one_for_one supervisor could have many + children, it shuts them all down at same time. So, order in which they + are stopped is not defined. For the same reason, it could have an + overhead with regards to the Shutdown strategy.

To prevent a supervisor from getting into an infinite loop of diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 2748f21bbe..df0777559a 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -341,6 +341,10 @@ call:start_link(id1) supervisor:terminate_child(Sup, Pid)

where Sup is the pid, or name, of the supervisor and Pid is the pid of the child.

+

Because a simple_one_for_one supervisor could have many children, + it shuts them all down at same time. So, order in which they are stopped is + not defined. For the same reason, it could have an overhead with regards to + the Shutdown strategy.

-- cgit v1.2.3 From 80711dbb10e103882aba9480b60f4cfbd2ab2061 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Fri, 30 Sep 2011 12:20:24 +0200 Subject: Kill nodes inbetween tests So that one test failure does not chain into other tests --- lib/kernel/test/pg2_SUITE.erl | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/kernel/test/pg2_SUITE.erl b/lib/kernel/test/pg2_SUITE.erl index 0ac34e735c..520b53b4e4 100644 --- a/lib/kernel/test/pg2_SUITE.erl +++ b/lib/kernel/test/pg2_SUITE.erl @@ -47,6 +47,7 @@ init_per_testcase(Case, Config) -> [{?TESTCASE, Case}, {watchdog, Dog} | Config]. end_per_testcase(_Case, _Config) -> + test_server_ctrl:kill_slavenodes(), Dog = ?config(watchdog, _Config), test_server:timetrap_cancel(Dog), ok. -- cgit v1.2.3 From b49d26ac2c3cecde759eb7b50f69792592a84946 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Mon, 3 Oct 2011 12:33:41 +0200 Subject: Add building script skeletons to include proper app version. --- lib/megaco/.gitignore | 3 + lib/megaco/configure.in | 1 + lib/megaco/examples/meas/Makefile | 132 --------------- lib/megaco/examples/meas/Makefile.in | 166 +++++++++++++++++++ lib/megaco/examples/meas/meas.sh.skel | 41 ----- lib/megaco/examples/meas/meas.sh.skel.src | 41 +++++ lib/megaco/examples/meas/modules.mk | 6 +- lib/megaco/examples/meas/mstone1.sh.skel | 239 --------------------------- lib/megaco/examples/meas/mstone1.sh.skel.src | 239 +++++++++++++++++++++++++++ 9 files changed, 453 insertions(+), 415 deletions(-) create mode 100644 lib/megaco/.gitignore delete mode 100644 lib/megaco/examples/meas/Makefile create mode 100644 lib/megaco/examples/meas/Makefile.in delete mode 100644 lib/megaco/examples/meas/meas.sh.skel create mode 100644 lib/megaco/examples/meas/meas.sh.skel.src delete mode 100644 lib/megaco/examples/meas/mstone1.sh.skel create mode 100644 lib/megaco/examples/meas/mstone1.sh.skel.src diff --git a/lib/megaco/.gitignore b/lib/megaco/.gitignore new file mode 100644 index 0000000000..1c5979cd62 --- /dev/null +++ b/lib/megaco/.gitignore @@ -0,0 +1,3 @@ +examples/meas/Makefile +examples/meas/meas.sh.skel +examples/meas/mstone1.sh.skel diff --git a/lib/megaco/configure.in b/lib/megaco/configure.in index 8f94a4efcf..f402ea18db 100644 --- a/lib/megaco/configure.in +++ b/lib/megaco/configure.in @@ -273,5 +273,6 @@ if test "$PERL" = no_perl; then AC_MSG_ERROR([Perl is required to build the flex scanner!]) fi +AC_OUTPUT(examples/meas/Makefile:examples/meas/Makefile.in) AC_OUTPUT(src/flex/$host/Makefile:src/flex/Makefile.in) diff --git a/lib/megaco/examples/meas/Makefile b/lib/megaco/examples/meas/Makefile deleted file mode 100644 index 0a6cbb44a6..0000000000 --- a/lib/megaco/examples/meas/Makefile +++ /dev/null @@ -1,132 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2002-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% - -include $(ERL_TOP)/make/target.mk - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -W -endif - -EBIN = . -MEGACO_INCLUDEDIR = ../../include - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(MEGACO_VSN) - - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/megaco-$(VSN) -EXAMPLE_RELSYSDIR = $(RELSYSDIR)/examples -MEAS_RELSYSDIR = $(EXAMPLE_RELSYSDIR)/meas - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -ERL_FILES = $(MODULES:%=%.erl) - -TARGET_FILES = \ - $(ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) - - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(WARN_UNUSED_WARS),true) -ERL_COMPILE_FLAGS += +warn_unused_vars -endif - -ifeq ($(USE_MEGACO_HIPE),true) -ERL_COMPILE_FLAGS += +native -endif - -ifeq ($(USE_VERBOSE_STATS),true) -ERL_COMPILE_FLAGS += -DVERBOSE_STATS=true -endif - -ifneq ($(MSTONE_TIME),) -ERL_COMPILE_FLAGS += -DMSTONE_TIME=$(MSTONE_TIME) -endif - -ERL_COMPILE_FLAGS += \ - -pa $(ERL_TOP)/lib/megaco/ebin \ - -I../include - - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - -docs: - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - - -release_spec: opt - $(INSTALL_DIR) $(EXAMPLE_RELSYSDIR) - $(INSTALL_DIR) $(MEAS_RELSYSDIR) - $(INSTALL_DATA) $(MESSAGE_PACKAGES) $(MEAS_RELSYSDIR) - $(INSTALL_DATA) $(SCRIPT_SKELETONS) $(MEAS_RELSYSDIR) - $(INSTALL_DATA) $(TARGET_FILES) $(MEAS_RELSYSDIR) - $(INSTALL_DATA) $(ERL_FILES) $(MEAS_RELSYSDIR) - - -release_docs_spec: - - -# ---------------------------------------------------- -# Include dependencies -# ---------------------------------------------------- - -megaco_codec_transform.$(EMULATOR): megaco_codec_transform.erl - -megaco_codec_meas.$(EMULATOR): megaco_codec_meas.erl - -megaco_codec_mstone1.$(EMULATOR): megaco_codec_mstone1.erl - -megaco_codec_mstone2.$(EMULATOR): megaco_codec_mstone2.erl - -megaco_codec_mstone_lib.$(EMULATOR): megaco_codec_mstone_lib.erl - diff --git a/lib/megaco/examples/meas/Makefile.in b/lib/megaco/examples/meas/Makefile.in new file mode 100644 index 0000000000..777d75fe10 --- /dev/null +++ b/lib/megaco/examples/meas/Makefile.in @@ -0,0 +1,166 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-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% + +include $(ERL_TOP)/make/target.mk + +ifeq ($(TYPE),debug) +ERL_COMPILE_FLAGS += -Ddebug -W +endif + +EBIN = . +MEGACO_INCLUDEDIR = ../../include + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(MEGACO_VSN) + + +# ---------------------------------------------------- +# Configured variables +# ---------------------------------------------------- +PERL = @PERL@ + + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/megaco-$(VSN) +EXAMPLE_RELSYSDIR = $(RELSYSDIR)/examples +MEAS_RELSYSDIR = $(EXAMPLE_RELSYSDIR)/meas + + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +include modules.mk + +ERL_FILES = $(MODULES:%=%.erl) + +SCRIPT_SKELETONS = $(SCRIPT_SKELETON_SRC:%.src=%) + +ERL_TARGETS = \ + $(ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) + +TARGET_FILES = $(SCRIPT_SKELETONS) $(ERL_TARGETS) + + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ifeq ($(WARN_UNUSED_WARS),true) +ERL_COMPILE_FLAGS += +warn_unused_vars +endif + +ifeq ($(USE_MEGACO_HIPE),true) +ERL_COMPILE_FLAGS += +native +endif + +ifeq ($(USE_VERBOSE_STATS),true) +ERL_COMPILE_FLAGS += -DVERBOSE_STATS=true +endif + +ifneq ($(MSTONE_TIME),) +ERL_COMPILE_FLAGS += -DMSTONE_TIME=$(MSTONE_TIME) +endif + +ERL_COMPILE_FLAGS += \ + -pa $(ERL_TOP)/lib/megaco/ebin \ + -I../include + + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +debug: + @${MAKE} TYPE=debug opt + +opt: $(TARGET_FILES) + +script_skeletons: $(SCRIPT_SKELETONS) + +info: + @echo "MODULES = $(MODULES)" + @echo "ERL_FILED = $(ERL_FILES)" + @echo "" + @echo "SCRIPT_SKELETON_SRC = $(SCRIPT_SKELETON_SRC)" + @echo "SCRIPT_SKELETONS = $(SCRIPT_SKELETONS)" + @echo "" + @echo "TARGET_FILES = $(TARGET_FILES)" + @echo "" + +clean: + rm -f $(TARGET_FILES) + rm -f errs core *~ + +docs: + +conf: + cd ../..; $(MAKE) conf + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + + +release_spec: opt + $(INSTALL_DIR) $(EXAMPLE_RELSYSDIR) + $(INSTALL_DIR) $(MEAS_RELSYSDIR) + $(INSTALL_DATA) $(MESSAGE_PACKAGES) $(MEAS_RELSYSDIR) + $(INSTALL_DATA) $(SCRIPT_SKELETONS) $(MEAS_RELSYSDIR) + $(INSTALL_DATA) $(TARGET_FILES) $(MEAS_RELSYSDIR) + $(INSTALL_DATA) $(ERL_FILES) $(MEAS_RELSYSDIR) + + +release_docs_spec: + + +# ---------------------------------------------------- +# Include dependencies +# ---------------------------------------------------- + +meas.sh.skel: meas.sh.skel.src + @echo "transforming $< to $@" + $(PERL) -p -e 's?%VSN%?$(VSN)? ' < $< > $@ + +mstone1.sh.skel: mstone1.sh.skel.src + @echo "transforming $< to $@" + $(PERL) -p -e 's?%VSN%?$(VSN)? ' < $< > $@ + +megaco_codec_transform.$(EMULATOR): megaco_codec_transform.erl + +megaco_codec_meas.$(EMULATOR): megaco_codec_meas.erl + +megaco_codec_mstone1.$(EMULATOR): megaco_codec_mstone1.erl + +megaco_codec_mstone2.$(EMULATOR): megaco_codec_mstone2.erl + +megaco_codec_mstone_lib.$(EMULATOR): megaco_codec_mstone_lib.erl + diff --git a/lib/megaco/examples/meas/meas.sh.skel b/lib/megaco/examples/meas/meas.sh.skel deleted file mode 100644 index 76745ed8f4..0000000000 --- a/lib/megaco/examples/meas/meas.sh.skel +++ /dev/null @@ -1,41 +0,0 @@ -#!/bin/sh - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2007-2010. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% - -# -# Skeleton for a script intended to run the meas test. -# - -ERL_HOME= -MEGACO_HOME=$ERL_HOME/lib/erlang/lib/ -MEAS_HOME=$MEGACO_HOME/examples/meas -PATH=$ERL_HOME/bin:$PATH - -# MEAS_TIME_TEST="-s megaco_codec_meas start time_test" -MEAS_DEFAULT="-s megaco_codec_meas start" -STOP="-s init stop" - -ERL="erl \ - -noshell \ - -pa $MEAS_HOME \ - $MEAS_DEFAULT \ - $STOP" - -echo $ERL -$ERL | tee meas.log - diff --git a/lib/megaco/examples/meas/meas.sh.skel.src b/lib/megaco/examples/meas/meas.sh.skel.src new file mode 100644 index 0000000000..37b426b12e --- /dev/null +++ b/lib/megaco/examples/meas/meas.sh.skel.src @@ -0,0 +1,41 @@ +#!/bin/sh + +# %CopyrightBegin% +# +# Copyright Ericsson AB 2007-2010. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% + +# +# Skeleton for a script intended to run the meas test. +# + +ERL_HOME= +MEGACO_HOME=$ERL_HOME/lib/erlang/lib/megaco-%VSN% +MEAS_HOME=$MEGACO_HOME/examples/meas +PATH=$ERL_HOME/bin:$PATH + +# MEAS_TIME_TEST="-s megaco_codec_meas start time_test" +MEAS_DEFAULT="-s megaco_codec_meas start" +STOP="-s init stop" + +ERL="erl \ + -noshell \ + -pa $MEAS_HOME \ + $MEAS_DEFAULT \ + $STOP" + +echo $ERL +$ERL | tee meas.log + diff --git a/lib/megaco/examples/meas/modules.mk b/lib/megaco/examples/meas/modules.mk index 8f1b45c8a6..b9d0d5d420 100644 --- a/lib/megaco/examples/meas/modules.mk +++ b/lib/megaco/examples/meas/modules.mk @@ -17,9 +17,9 @@ # # %CopyrightEnd% -SCRIPT_SKELETONS = \ - meas.sh.skel \ - mstone1.sh.skel +SCRIPT_SKELETON_SRC = \ + meas.sh.skel.src \ + mstone1.sh.skel.src MESSAGE_PACKAGES = \ time_test.msgs diff --git a/lib/megaco/examples/meas/mstone1.sh.skel b/lib/megaco/examples/meas/mstone1.sh.skel deleted file mode 100644 index b7c7e41007..0000000000 --- a/lib/megaco/examples/meas/mstone1.sh.skel +++ /dev/null @@ -1,239 +0,0 @@ -#!/bin/sh - -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2007-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% - -# Skeleton for a script intended to run the mstone1(N) -# performance test. -# - -# Get the name of the program -program=`echo $0 | sed 's#.*/##g'` - -usage="\ -Usage: $program [options] - -This shell script is used to run the mstone 1 (factor) performance -test. It is not intended to test the megaco stack but instead to -give a \"performance value\" of the host on which it is run. - -Options: - -help display this help and exit. - -mp message package to use for test - default is time_test - -h default process heap size - -a async thread pool size (default is 0) - -f normally the test is run with 16 processes - (factor 1), one for each codec config. The test - can however be run with other factors, e.g. - factor 10 means that 10 processes will be started - for each megaco codec config. - The options -s and -f cannot both be present. - -s normally the test is run with a fixed factor, - but if this option is given, the number of - schedulers is fixed (to the value set by this option) - and the factor is the variable. - The options -s and -f cannot both be present. - -d driver mode for the test: - std - all codec config(s) will be used - flex - only the text codec config(s) utilizing the - flex scanner will be used - nd - only codec config(s) without drivers will be used - od - only codec config(s) with drivers will be used - -- everything after this is just passed on to erl. -" - -ERL_HOME= -MEGACO_HOME=$ERL_HOME/lib/erlang/lib/ -MEAS_HOME=$MEGACO_HOME/examples/meas -PATH=$ERL_HOME/bin:$PATH - -MODULE=megaco_codec_mstone1 -STARTF="start" -FACTOR="" -MSG_PACK=time_test - -while test $# != 0; do - # echo "DBG: Value = $1" - case $1 in - -help) - echo "$usage" ; - exit 0;; - - -mp) - MSG_PACK="$2"; - shift ; shift ;; - - -h) - PHS="+h $2"; - shift ; shift ;; - - -a) - ATP="+A $2"; - shift ; shift ;; - - -d) - case $2 in - std) - STARTF="start"; - shift ; shift ;; - flex) - STARTF="start_flex"; - shift ; shift ;; - nd) - STARTF="start_no_drv"; - shift ; shift ;; - od) - STARTF="start_only_drv"; - shift ; shift ;; - *) - echo "unknown driver mode: $2"; - echo "$usage" ; - exit 0 - esac;; - - -f) - if [ "x$SCHED" != "x" ]; then - echo "option(s) -s and -f cannot both be given" ; - echo "$usage" ; - exit 0 - fi - FACTOR="$2"; - TYPE=factor; - shift ; shift ;; - - -s) - if [ "x$FACTOR" != "x" ]; then - echo "option(s) -f and -s cannot both be given" ; - echo "$usage" ; - exit 0 - fi - SCHED="$2"; - TYPE=sched; - shift ; shift ;; - - --) - shift ; - break;; - - *) - echo "unknown option: $1"; - echo "$usage" ; - exit 0 - esac -done - -if [ $TYPE = factor ]; then - - MSTONE="-s $MODULE $STARTF $MSG_PACK $FACTOR" - - # SCHEDS="no_smp 01 02 04" - # SCHEDS="no_smp 01 02 04 08" - # SCHEDS="no_smp 01 02 04 08 16" - # SCHEDS="no_smp 01 02 04 08 16 32" - # SCHEDS="no_smp 01 02 04 08 16 32 64" - SCHEDS="no_smp 01 02 03 04 05 06 07 08" - - for i in `echo $SCHEDS`; do - case $i in - no_smp) - SMP_INFO="No SMP" - SMP_OPTS="-smp disable" # THIS IS THE R12B WAY TO DISABLE SMP - LOG="mstone1-f$FACTOR-s00.log" - ;; - - 01) - SMP_INFO="SMP: 1 scheduler" - SMP_OPTS="-smp +S $i" - LOG="mstone1-f$FACTOR-s$i.log" - ;; - - *) - SMP_INFO="SMP: $i schedulers" - SMP_OPTS="-smp +S $i" - LOG="mstone1-f$FACTOR-s$i.log" - ;; - esac - - echo "" - echo "---------------------------------------------" - echo "$SMP_INFO" - echo "" - - ERL="erl \ - -noshell \ - $PHS \ - $ATP \ - $SMP_OPTS \ - -pa $MEAS_HOME \ - $MSTONE \ - $* \ - -s init stop" - - echo $ERL - $ERL | tee $LOG - done - -elif [ $TYPE = sched ]; then - - MSTONE="-s $MODULE $STARTF $MSG_PACK" - - # FACTORS="01 02 03 04" - # FACTORS="01 02 03 04 05 06 07 08 09 10" - FACTORS="01 02 04 08 16 32" - # FACTORS="001 010 100" - - case $SCHED in - no_smp) - SMP_OPTS="-smp disable" # THIS IS THE R12B WAY TO DISABLE SMP - ;; - - *) - SMP_OPTS="-smp +S $SCHED" - ;; - esac - - for i in `echo $FACTORS`; do - LOG="mstone1-s$SCHED-f$i.log" - - echo "" - echo "---------------------------------------------" - echo "Factor $i" - echo "" - - ERL="erl \ - -noshell \ - $PHS \ - $ATP \ - $SMP_OPTS \ - -pa $MEAS_HOME \ - $MSTONE $i \ - $* \ - -s init stop" - - echo $ERL - $ERL | tee $LOG - done - - -else - echo "Either option -f or -s must be specified" - echo "$usage" ; - exit 0 - -fi diff --git a/lib/megaco/examples/meas/mstone1.sh.skel.src b/lib/megaco/examples/meas/mstone1.sh.skel.src new file mode 100644 index 0000000000..60058c1989 --- /dev/null +++ b/lib/megaco/examples/meas/mstone1.sh.skel.src @@ -0,0 +1,239 @@ +#!/bin/sh + +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2007-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% + +# Skeleton for a script intended to run the mstone1(N) +# performance test. +# + +# Get the name of the program +program=`echo $0 | sed 's#.*/##g'` + +usage="\ +Usage: $program [options] + +This shell script is used to run the mstone 1 (factor) performance +test. It is not intended to test the megaco stack but instead to +give a \"performance value\" of the host on which it is run. + +Options: + -help display this help and exit. + -mp message package to use for test + default is time_test + -h default process heap size + -a async thread pool size (default is 0) + -f normally the test is run with 16 processes + (factor 1), one for each codec config. The test + can however be run with other factors, e.g. + factor 10 means that 10 processes will be started + for each megaco codec config. + The options -s and -f cannot both be present. + -s normally the test is run with a fixed factor, + but if this option is given, the number of + schedulers is fixed (to the value set by this option) + and the factor is the variable. + The options -s and -f cannot both be present. + -d driver mode for the test: + std - all codec config(s) will be used + flex - only the text codec config(s) utilizing the + flex scanner will be used + nd - only codec config(s) without drivers will be used + od - only codec config(s) with drivers will be used + -- everything after this is just passed on to erl. +" + +ERL_HOME= +MEGACO_HOME=$ERL_HOME/lib/erlang/lib/megaco-%VSN% +MEAS_HOME=$MEGACO_HOME/examples/meas +PATH=$ERL_HOME/bin:$PATH + +MODULE=megaco_codec_mstone1 +STARTF="start" +FACTOR="" +MSG_PACK=time_test + +while test $# != 0; do + # echo "DBG: Value = $1" + case $1 in + -help) + echo "$usage" ; + exit 0;; + + -mp) + MSG_PACK="$2"; + shift ; shift ;; + + -h) + PHS="+h $2"; + shift ; shift ;; + + -a) + ATP="+A $2"; + shift ; shift ;; + + -d) + case $2 in + std) + STARTF="start"; + shift ; shift ;; + flex) + STARTF="start_flex"; + shift ; shift ;; + nd) + STARTF="start_no_drv"; + shift ; shift ;; + od) + STARTF="start_only_drv"; + shift ; shift ;; + *) + echo "unknown driver mode: $2"; + echo "$usage" ; + exit 0 + esac;; + + -f) + if [ "x$SCHED" != "x" ]; then + echo "option(s) -s and -f cannot both be given" ; + echo "$usage" ; + exit 0 + fi + FACTOR="$2"; + TYPE=factor; + shift ; shift ;; + + -s) + if [ "x$FACTOR" != "x" ]; then + echo "option(s) -f and -s cannot both be given" ; + echo "$usage" ; + exit 0 + fi + SCHED="$2"; + TYPE=sched; + shift ; shift ;; + + --) + shift ; + break;; + + *) + echo "unknown option: $1"; + echo "$usage" ; + exit 0 + esac +done + +if [ $TYPE = factor ]; then + + MSTONE="-s $MODULE $STARTF $MSG_PACK $FACTOR" + + # SCHEDS="no_smp 01 02 04" + # SCHEDS="no_smp 01 02 04 08" + # SCHEDS="no_smp 01 02 04 08 16" + # SCHEDS="no_smp 01 02 04 08 16 32" + # SCHEDS="no_smp 01 02 04 08 16 32 64" + SCHEDS="no_smp 01 02 03 04 05 06 07 08" + + for i in `echo $SCHEDS`; do + case $i in + no_smp) + SMP_INFO="No SMP" + SMP_OPTS="-smp disable" # THIS IS THE R12B WAY TO DISABLE SMP + LOG="mstone1-f$FACTOR-s00.log" + ;; + + 01) + SMP_INFO="SMP: 1 scheduler" + SMP_OPTS="-smp +S $i" + LOG="mstone1-f$FACTOR-s$i.log" + ;; + + *) + SMP_INFO="SMP: $i schedulers" + SMP_OPTS="-smp +S $i" + LOG="mstone1-f$FACTOR-s$i.log" + ;; + esac + + echo "" + echo "---------------------------------------------" + echo "$SMP_INFO" + echo "" + + ERL="erl \ + -noshell \ + $PHS \ + $ATP \ + $SMP_OPTS \ + -pa $MEAS_HOME \ + $MSTONE \ + $* \ + -s init stop" + + echo $ERL + $ERL | tee $LOG + done + +elif [ $TYPE = sched ]; then + + MSTONE="-s $MODULE $STARTF $MSG_PACK" + + # FACTORS="01 02 03 04" + # FACTORS="01 02 03 04 05 06 07 08 09 10" + FACTORS="01 02 04 08 16 32" + # FACTORS="001 010 100" + + case $SCHED in + no_smp) + SMP_OPTS="-smp disable" # THIS IS THE R12B WAY TO DISABLE SMP + ;; + + *) + SMP_OPTS="-smp +S $SCHED" + ;; + esac + + for i in `echo $FACTORS`; do + LOG="mstone1-s$SCHED-f$i.log" + + echo "" + echo "---------------------------------------------" + echo "Factor $i" + echo "" + + ERL="erl \ + -noshell \ + $PHS \ + $ATP \ + $SMP_OPTS \ + -pa $MEAS_HOME \ + $MSTONE $i \ + $* \ + -s init stop" + + echo $ERL + $ERL | tee $LOG + done + + +else + echo "Either option -f or -s must be specified" + echo "$usage" ; + exit 0 + +fi -- cgit v1.2.3 From e5eacdcdbf39239e69b1e491e09b07b7aea7f719 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Mon, 3 Oct 2011 12:48:46 +0200 Subject: roper version. --- lib/megaco/vsn.mk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index c1476488ca..35acffcb64 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.15.1.1 +MEGACO_VSN = 3.15.1.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" -- cgit v1.2.3 From 87ca1d9f9d0962609ccb17a1b306a8a0815bc6c5 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Mon, 3 Oct 2011 12:58:10 +0200 Subject: Fixed file header dates. --- lib/megaco/configure.in | 2 +- lib/megaco/examples/meas/Makefile.in | 2 +- lib/megaco/examples/meas/meas.sh.skel.src | 2 +- lib/megaco/examples/meas/modules.mk | 2 +- lib/megaco/examples/meas/mstone1.sh.skel.src | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/megaco/configure.in b/lib/megaco/configure.in index f402ea18db..b88e17ec85 100644 --- a/lib/megaco/configure.in +++ b/lib/megaco/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. -*-m4-*- dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 2001-2010. All Rights Reserved. +dnl Copyright Ericsson AB 2001-2011. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in diff --git a/lib/megaco/examples/meas/Makefile.in b/lib/megaco/examples/meas/Makefile.in index 777d75fe10..6af7ef6c65 100644 --- a/lib/megaco/examples/meas/Makefile.in +++ b/lib/megaco/examples/meas/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-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 diff --git a/lib/megaco/examples/meas/meas.sh.skel.src b/lib/megaco/examples/meas/meas.sh.skel.src index 37b426b12e..c7bd6cdd2a 100644 --- a/lib/megaco/examples/meas/meas.sh.skel.src +++ b/lib/megaco/examples/meas/meas.sh.skel.src @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2007-2010. 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 diff --git a/lib/megaco/examples/meas/modules.mk b/lib/megaco/examples/meas/modules.mk index b9d0d5d420..26979933d7 100644 --- a/lib/megaco/examples/meas/modules.mk +++ b/lib/megaco/examples/meas/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# Copyright Ericsson AB 2002-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 diff --git a/lib/megaco/examples/meas/mstone1.sh.skel.src b/lib/megaco/examples/meas/mstone1.sh.skel.src index 60058c1989..54a6c61a58 100644 --- a/lib/megaco/examples/meas/mstone1.sh.skel.src +++ b/lib/megaco/examples/meas/mstone1.sh.skel.src @@ -3,7 +3,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 -- cgit v1.2.3 From eaaae023a1a0ca722c7a0a0c90ae1a402fc1a05b Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Thu, 6 Oct 2011 11:14:50 +0200 Subject: Added relaese notes and proper appup instruction (no changes). --- lib/megaco/doc/src/notes.xml | 42 +++++++++++++++++++++++++++++++++++++ lib/megaco/src/app/megaco.appup.src | 11 ++++++++++ 2 files changed, 53 insertions(+) diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index 2aba8db71b..a01aa26e53 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,6 +36,48 @@ section is the version number of Megaco.

+
Megaco 3.15.1.2 + +

Version 3.15.1.2 supports code replacement in runtime from/to + version 3.15.1.1, 3.15.1 and 3.15.

+ +
+ Improvements and new features + + + + + +

Minor improvemnts to the emasurement tool mstone1.

+

Own Id: OTP-9604

+ + + + +
+ +
+ Fixed bugs and malfunctions + +

-

+ + + +
+ +
+ +
Megaco 3.15.1.1

Version 3.15.1.1 supports code replacement in runtime from/to diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 7107178d1a..7f6fe0c733 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -139,10 +139,17 @@ %% | %% v %% 3.15.1.1 +%% | +%% v +%% 3.15.1.2 %% %% {"%VSN%", [ + {"3.15.1.1", + [ + ] + }, {"3.15.1", [ ] @@ -160,6 +167,10 @@ } ], [ + {"3.15.1.1", + [ + ] + }, {"3.15.1", [ ] -- cgit v1.2.3 From 238753cfd7887167f6ec19d7cde730b04214334d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 6 Oct 2011 13:17:07 +0200 Subject: Revert "ic documentation: Support parallel make" This reverts commit d9ec7c91ca6ae019ad80b03fb184924bad8d6bc8. The commit did not fix the real problem. --- lib/ic/doc/src/Makefile | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile index acb6848fee..8eda436a24 100644 --- a/lib/ic/doc/src/Makefile +++ b/lib/ic/doc/src/Makefile @@ -206,8 +206,6 @@ JAVADOCFLAGS = \ # ---------------------------------------------------- # Targets # ---------------------------------------------------- -_create_dirs := $(shell mkdir -p $(JAVA_OUT_DIR)) - $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ @@ -258,7 +256,10 @@ clean clean_docs clean_tex: endif -$(JAVADOC_GENERATED_FILES): +$(JAVA_OUT_DIR): + mkdir $(JAVA_OUT_DIR) + +$(JAVADOC_GENERATED_FILES): $(JAVA_OUT_DIR) @(cd ../../java_src; $(JAVADOC) $(JAVADOCFLAGS) com.ericsson.otp.ic) man: $(MAN3_FILES) -- cgit v1.2.3 From 199248be0ce5f5d147689b9608aa52e981c407ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 6 Oct 2011 13:19:22 +0200 Subject: ic documentation: Support parallel make Multiple instances of javadoc would be started at once, which is unnecessary work and could cause one or more instances to fail while creating directories. Use a stand-in file (JAVADOC-GENERATED) to ensure that only one instance of javadoc is started. Since javadoc creates directories itself, there is no need to explicitly create the $(JAVA_OUT_DIR) directory. --- .gitignore | 3 +++ lib/ic/doc/src/Makefile | 7 ++++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index e5f0869f27..e6920fbeca 100644 --- a/.gitignore +++ b/.gitignore @@ -100,6 +100,9 @@ make/win32/ # Used by ic & orber & cos* applications. IDL-GENERATED +# Used by applications that run javadoc (e.g. ic). +JAVADOC-GENERATED + # Anchored from $ERL_TOP /bin /config.log diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile index 8eda436a24..f255183e1f 100644 --- a/lib/ic/doc/src/Makefile +++ b/lib/ic/doc/src/Makefile @@ -253,14 +253,15 @@ clean clean_docs clean_tex: rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) rm -rf $(JAVA_OUT_DIR) + rm -f JAVADOC-GENERATED endif -$(JAVA_OUT_DIR): - mkdir $(JAVA_OUT_DIR) +$(JAVADOC_GENERATED_FILES): JAVADOC-GENERATED -$(JAVADOC_GENERATED_FILES): $(JAVA_OUT_DIR) +JAVADOC-GENERATED: $(JAVA_SOURCE_FILES:%=$(JAVA_SOURCE_DIR)/%) @(cd ../../java_src; $(JAVADOC) $(JAVADOCFLAGS) com.ericsson.otp.ic) + >JAVADOC-GENERATED man: $(MAN3_FILES) -- cgit v1.2.3 From b138f9e6879e44732e681d368704345acdf26b1b Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Thu, 29 Sep 2011 09:08:31 +0200 Subject: Add tls support to capabilities exchange To upgrade a connection to TLS or not, that is the question. It is possible for us to send a CER offering both NO_INBAND_SECURITY and TLS and for the peer to answer likewise: RFC 3588 doesn't make clear that a CEA should be unambiguous about the choice of security. Thus, if TLS is offered then assume the server is prepared to for a handshake. Similarly, when receiving a CER, choose TLS if it's offered and be unambiguous about our choice in CEA. There is no ssl:maybe_accept that would let us receive a handshake if it comes or another message if it doesn't. The choice of TLS should probably be made into a callback so that an application can decide based on the peer's Origin-Realm for example. Such a callback could also be used to reject a CER/CEA. Handle Inband-Security-Id values other than NO_INBAND_SECURITY and TLS by assuming that they require no intervention by the transport module, treating them like NO_INBAND_SECURITY. Whether or not this is reasonable (or useful) is unclear. There may be a need for more sychronization than we have on offer. (Having to do something before taking the connection up for example.) Note that diameter_peer_fsm must be upgraded before diameter_capx because of the new return value from diameter_capx:recv_CEA/2. --- lib/diameter/src/app/diameter_capx.erl | 145 ++++++++++++++++------------- lib/diameter/src/app/diameter_peer_fsm.erl | 87 +++++++++++------ 2 files changed, 140 insertions(+), 92 deletions(-) diff --git a/lib/diameter/src/app/diameter_capx.erl b/lib/diameter/src/app/diameter_capx.erl index aa5318e79d..138e76411e 100644 --- a/lib/diameter/src/app/diameter_capx.erl +++ b/lib/diameter/src/app/diameter_capx.erl @@ -62,6 +62,7 @@ -define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). -define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). %% =========================================================================== @@ -80,7 +81,7 @@ recv_CER(CER, Svc) -> try_it([fun rCER/2, CER, Svc]). -spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) - -> tried({['Unsigned32'()], #diameter_caps{}}). + -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). recv_CEA(CEA, Svc) -> try_it([fun rCEA/2, CEA, Svc]). @@ -126,10 +127,11 @@ mk_caps(Caps0, Opts) -> set_cap({Key, _}, _) -> ?THROW({duplicate, Key}). -cap(K, V) when K == 'Origin-Host'; - K == 'Origin-Realm'; - K == 'Vendor-Id'; - K == 'Product-Name' -> +cap(K, V) + when K == 'Origin-Host'; + K == 'Origin-Realm'; + K == 'Vendor-Id'; + K == 'Product-Name' -> V; cap('Host-IP-Address', Vs) @@ -139,11 +141,8 @@ cap('Host-IP-Address', Vs) cap('Firmware-Revision', V) -> [V]; -%% Not documented but accept it as long as it's what we support. -cap('Inband-Security-Id', [0] = Vs) -> %% NO_INBAND_SECURITY - Vs; - -cap(K, Vs) when K /= 'Inband-Security-Id', is_list(Vs) -> +cap(_, Vs) + when is_list(Vs) -> Vs; cap(K, V) -> @@ -161,28 +160,10 @@ ipaddr(A) -> %% %% Build a CER record to send to a remote peer. -bCER(#diameter_caps{origin_host = Host, - origin_realm = Realm, - host_ip_address = Addrs, - vendor_id = Vid, - product_name = Name, - origin_state_id = OSI, - supported_vendor_id = SVid, - auth_application_id = AuId, - acct_application_id = AcId, - vendor_specific_application_id = VSA, - firmware_revision = Rev}) -> - #diameter_base_CER{'Origin-Host' = Host, - 'Origin-Realm' = Realm, - 'Host-IP-Address' = Addrs, - 'Vendor-Id' = Vid, - 'Product-Name' = Name, - 'Origin-State-Id' = OSI, - 'Supported-Vendor-Id' = SVid, - 'Auth-Application-Id' = AuId, - 'Acct-Application-Id' = AcId, - 'Vendor-Specific-Application-Id' = VSA, - 'Firmware-Revision' = Rev}. +%% Use the fact that diameter_caps has the same field names as CER. +bCER(#diameter_caps{} = Rec) -> + #diameter_base_CER{} + = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). %% rCER/2 %% @@ -219,19 +200,16 @@ bCER(#diameter_caps{origin_host = Host, %% That is, each side sends all of its capabilities and is responsible for %% not sending commands that the peer doesn't support. -%% TODO: Make it an option to send only common applications in CEA to -%% allow backwards compatibility, and also because there are likely -%% servers that expect this. Or maybe a callback. - %% 6.10. Inband-Security-Id AVP %% %% NO_INBAND_SECURITY 0 %% This peer does not support TLS. This is the default value, if the %% AVP is omitted. +%% +%% TLS 1 +%% This node supports TLS security, as defined by [TLS]. rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> - #diameter_base_CER{'Inband-Security-Id' = RIS} - = CER, #diameter_base_CEA{} = CEA = cea_from_cer(bCER(LCaps)), @@ -241,56 +219,95 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> {SApps, RCaps, - build_CEA([] == SApps, - RIS, - lists:member(?NO_INBAND_SECURITY, RIS), - CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS, - 'Inband-Security-Id' = []})}. + build_CEA(SApps, + LCaps, + RCaps, + CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. -%% TODO: 5.3 of RFC3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION +%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION %% in the CEA and SHOULD disconnect the transport. However, we have %% no way to guarantee the send before disconnecting. -build_CEA(true, _, _, CEA) -> +build_CEA([], _, _, CEA) -> CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; -build_CEA(false, [_|_], false, CEA) -> - CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; -build_CEA(false, [_|_], true, CEA) -> - CEA#diameter_base_CEA{'Inband-Security-Id' = [?NO_INBAND_SECURITY]}; -build_CEA(false, [], false, CEA) -> - CEA. + +build_CEA(_, LCaps, RCaps, CEA) -> + case common_security(LCaps, RCaps) of + [] -> + CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; + [_] = IS -> + CEA#diameter_base_CEA{'Inband-Security-Id' = IS} + end. + +%% common_security/2 + +common_security(#diameter_caps{inband_security_id = LS}, + #diameter_caps{inband_security_id = RS}) -> + cs(LS, RS). + +%% Unspecified is equivalent to NO_INBAND_SECURITY. +cs([], RS) -> + cs([?NO_INBAND_SECURITY], RS); +cs(LS, []) -> + cs(LS, [?NO_INBAND_SECURITY]); + +%% Agree on TLS if both parties support it. When sending CEA, this is +%% to ensure the peer is clear that we will be expecting a TLS +%% handshake since there is no ssl:maybe_accept that would allow the +%% peer to choose between TLS or not upon reception of our CEA. When +%% receiving CEA it deals with a server that isn't explicit about its choice. +%% TODO: Make the choice configurable. +cs(LS, RS) -> + Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS), + ordsets:from_list(RS))), + case lists:member(?TLS, Is) of + true -> + [?TLS]; + false when [] == Is -> + Is; + false -> + [hd(Is)] %% probably NO_INBAND_SECURITY + end. +%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and +%% TLS but don't enforce this. In theory this allows some other +%% security mechanism we don't have to know about, although in +%% practice something there may be a need for more synchronization +%% than notification by way of an event subscription offers. %% cea_from_cer/1 +%% CER is a subset of CEA, the latter adding Result-Code and a few +%% more AVP's. cea_from_cer(#diameter_base_CER{} = CER) -> lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, #diameter_base_CEA{}, record_info(fields, diameter_base_CER)). to_cea(CER, Field, CEA) -> - try ?BASE:'#info-'(diameter_base_CEA, {index, Field}) of - N -> - setelement(N, CEA, ?BASE:'#get-'(Field, CER)) + try ?BASE:'#get-'(Field, CER) of + V -> ?BASE:'#set-'({Field, V}, CEA) catch - error: _ -> - CEA + error: _ -> CEA end. - + %% rCEA/2 -rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) - when is_record(CEA, diameter_base_CEA) -> - #diameter_base_CEA{'Result-Code' = RC} - = CEA, - +rCEA(#diameter_base_CEA{'Result-Code' = RC} + = CEA, + #diameter_service{capabilities = LCaps} + = Svc) -> RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), RCaps = capx_to_caps(CEA), SApps = common_applications(LCaps, RCaps, Svc), - [] == SApps andalso ?THROW({no_common_apps, LCaps, RCaps}), + [] == SApps andalso ?THROW(no_common_applications), + + IS = common_security(LCaps, RCaps), + + [] == IS andalso ?THROW(no_common_security), - {SApps, RCaps}; + {SApps, IS, RCaps}; rCEA(CEA, _Svc) -> ?THROW({invalid, CEA}). diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/app/diameter_peer_fsm.erl index 0252fb3809..282fa2742f 100644 --- a/lib/diameter/src/app/diameter_peer_fsm.erl +++ b/lib/diameter/src/app/diameter_peer_fsm.erl @@ -52,6 +52,9 @@ -define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). -define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + -define(LOOP_TIMEOUT, 2000). %% RFC 3588: @@ -195,10 +198,8 @@ handle_info(T, #state{} = State) -> ?LOG(stop, T), x(T, State) catch - throw: {?MODULE, close = C, Reason} -> - ?LOG(C, {Reason, T}), - x(Reason, State); - throw: {?MODULE, abort, Reason} -> + throw: {?MODULE, Tag, Reason} -> + ?LOG(Tag, {Reason, T}), {stop, {shutdown, Reason}, State} end. @@ -281,10 +282,9 @@ transition(shutdown, _) -> %% DPR already send: ensure expected timeout %% Request to close the transport connection. transition({close = T, Pid}, #state{parent = Pid, - transport = TPid} - = S) -> + transport = TPid}) -> diameter_peer:close(TPid), - close(T,S); + {stop, T}; %% DPA reception has timed out. transition(dpa_timeout, _) -> @@ -418,11 +418,11 @@ rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> %% Anything but CER/CEA in a non-Open state is an error, as is %% CER/CEA in anything but recv_CER/Wait-CEA. -rcv(Name, _, #state{state = PS} = S) +rcv(Name, _, #state{state = PS}) when PS /= 'Open'; Name == 'CER'; Name == 'CEA' -> - close({Name, PS}, S); + {stop, {Name, PS}}; rcv(N, Pkt, S) when N == 'DWR'; @@ -497,15 +497,20 @@ build_answer('CER', #diameter_service{capabilities = #diameter_caps{origin_host = OH}} = Svc, - {SupportedApps, #diameter_caps{origin_host = DH} = RCaps, CEA} + {SupportedApps, + #diameter_caps{origin_host = DH} = RCaps, + #diameter_base_CEA{'Result-Code' = RC} + = CEA} = recv_CER(CER, S), try - [] == SupportedApps - andalso ?THROW({no_common_application, 5010}), + 2001 == RC %% DIAMETER_SUCCESS + orelse ?THROW({sent_CEA, RC}), register_everywhere({?MODULE, connection, OH, DH}) orelse ?THROW({election_lost, 4003}), - {CEA, [fun open/4, Pkt, SupportedApps, RCaps]} + #diameter_base_CEA{'Inband-Security-Id' = [IS]} + = CEA, + {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]} catch ?FAILURE({Reason, RC}) -> {answer('CER', S) ++ [{'Result-Code', RC}], @@ -613,7 +618,7 @@ recv_CER(CER, #state{service = Svc}) -> handle_CEA(#diameter_packet{header = #diameter_header{version = V}, bin = Bin} = Pkt, - #state{service = Svc} + #state{service = #diameter_service{capabilities = LCaps}} = S) when is_binary(Bin) -> ?LOG(recv, 'CEA'), @@ -626,7 +631,11 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V}, [] == Errors orelse close({errors, Errors}, S), - {SApps, #diameter_caps{origin_host = DH} = RCaps} = recv_CEA(CEA, S), + {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps} + = recv_CEA(CEA, S), + + #diameter_caps{origin_host = OH} + = LCaps, %% Ensure that we don't already have a connection to the peer in %% question. This isn't the peer election of 3588 except in the @@ -634,40 +643,62 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V}, %% receive a CER/CEA, the first that arrives wins the right to a %% connection with the peer. - #diameter_service{capabilities = #diameter_caps{origin_host = OH}} - = Svc, - register_everywhere({?MODULE, connection, OH, DH}) - orelse - close({'CEA', DH}, S), + orelse close({'CEA', DH}, S), - open(DPkt, SApps, RCaps, S). + open(DPkt, SApps, RCaps, {connect, IS}, S). %% recv_CEA/2 recv_CEA(CEA, #state{service = Svc} = S) -> case diameter_capx:recv_CEA(CEA, Svc) of - {ok, {[], _}} -> + {ok, {_,_}} -> %% return from old code + close({'CEA', update}, S); + {ok, {[], _, _}} -> close({'CEA', no_common_application}, S); - {ok, T} -> + {ok, {_, [], _}} -> + close({'CEA', no_common_security}, S); + {ok, {_,_,_} = T} -> T; {error, Reason} -> close({'CEA', Reason}, S) end. -%% open/4 +%% open/5 -open(Pkt, SupportedApps, RCaps, #state{parent = Pid, - service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH} +open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid, + service = Svc} + = S) -> + #diameter_service{capabilities = #diameter_caps{origin_host = OH, + inband_security_id = LS} = LCaps} = Svc, #diameter_caps{origin_host = DH} = RCaps, + + tls_ack(lists:member(?TLS, LS), Type, IS, S), Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, + S#state{state = 'Open'}. +%% We've advertised TLS support: tell the transport the result +%% and expect a reply when the handshake is complete. +tls_ack(true, Type, IS, #state{transport = TPid} = S) -> + Ref = make_ref(), + MRef = erlang:monitor(process, TPid), + TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, + receive + {diameter, {tls, Ref}} -> + erlang:demonitor(MRef, [flush]); + {'DOWN', MRef, process, _, _} = T -> + close({tls_ack, T}, S) + end; + +%% Or not. Don't send anything to the transport so that transports +%% not supporting TLS work as before without modification. +tls_ack(false, _, _, _) -> + ok. + capz(#diameter_caps{} = L, #diameter_caps{} = R) -> #diameter_caps{} = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), -- cgit v1.2.3 From 10aa701bf7bf390303a499c99cdf1372eb911680 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 2 Oct 2011 01:33:42 +0200 Subject: Lift recursion in tcp message reception up the call chain When an initial message is received and TLS is a possibility, must wait for a message from the peer process before either commencing a handshake or receiving more messages. --- lib/diameter/src/transport/diameter_tcp.erl | 58 +++++++++++++++-------------- 1 file changed, 31 insertions(+), 27 deletions(-) diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index 653c114471..2c01037063 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -385,74 +385,78 @@ transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> %% using Nagle. recv(Bin, #transport{parent = Pid, frag = Head} = S) -> - S#transport{frag = recv(Pid, Head, Bin)}. + case recv1(Head, Bin) of + {Msg, B} when is_binary(Msg) -> + diameter_peer:recv(Pid, Msg), + recv(B, S#transport{frag = <<>>}); + Frag -> + S#transport{frag = Frag} + end. -%% recv/3 +%% recv1/2 %% No previous fragment. -recv(Pid, <<>>, Bin) -> - rcv(Pid, Bin); +recv1(<<>>, Bin) -> + rcv(Bin); -recv(Pid, {TRef, Head}, Bin) -> +recv1({TRef, Head}, Bin) -> erlang:cancel_timer(TRef), - rcv(Pid, Head, Bin). + rcv(Head, Bin). -%% rcv/3 +%% rcv/2 %% Not even the first four bytes of the header. -rcv(Pid, Head, Bin) +rcv(Head, Bin) when is_binary(Head) -> - rcv(Pid, <>); + rcv(<>); %% Or enough to know how many bytes to extract. -rcv(Pid, {Len, N, Head, Acc}, Bin) -> - rcv(Pid, Len, N + size(Bin), Head, [Bin | Acc]). +rcv({Len, N, Head, Acc}, Bin) -> + rcv(Len, N + size(Bin), Head, [Bin | Acc]). -%% rcv/5 +%% rcv/4 %% Extract a message for which we have all bytes. -rcv(Pid, Len, N, Head, Acc) +rcv(Len, N, Head, Acc) when Len =< N -> - rcv(Pid, rcv1(Pid, Len, bin(Head, Acc))); + rcv1(Len, bin(Head, Acc)); %% Wait for more packets. -rcv(_, Len, N, Head, Acc) -> +rcv(Len, N, Head, Acc) -> {start_timer(), {Len, N, Head, Acc}}. %% rcv/2 %% Nothing left. -rcv(_, <<>> = Bin) -> +rcv(<<>> = Bin) -> Bin; %% Well, this isn't good. Chances are things will go south from here %% but if we're lucky then the bytes we have extend to an intended %% message boundary and we can recover by simply discarding them, %% which is the result of receiving them. -rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin) +rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len < 20 -> - diameter_peer:recv(Pid, Bin), - <<>>; + {Bin, <<>>}; %% Enough bytes to extract a message. -rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin) +rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len =< size(Bin) -> - rcv(Pid, rcv1(Pid, Len, Bin)); + rcv1(Len, Bin); %% Or not: wait for more packets. -rcv(_, <<_:1/binary, Len:24, _/binary>> = Head) -> +rcv(<<_:1/binary, Len:24, _/binary>> = Head) -> {start_timer(), {Len, size(Head), Head, []}}; %% Not even 4 bytes yet. -rcv(_, Head) -> +rcv(Head) -> {start_timer(), Head}. -%% rcv1/3 +%% rcv1/2 -rcv1(Pid, Len, Bin) -> +rcv1(Len, Bin) -> <> = Bin, - diameter_peer:recv(Pid, Msg), - Rest. + {Msg, Rest}. %% bin/[12] -- cgit v1.2.3 From 804d96e755a65a17cfe0d67698b834bdda11afe5 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 3 Oct 2011 15:30:55 +0200 Subject: Handle tls notification for tcp If TLS has been configured on Inband-Security-Id then the transport process receives a message from the peer_fsm process indicating whether or not to upgrade to TLS. The current draft of RFC 3588 deprecates (but retains for backwards compatibility) the use of Inband-Security-Id for negotiating TLS, adding the possibility of TLS having be negotiated before capabilities exchange. This commit handles the deprecated case. --- lib/diameter/src/transport/diameter_tcp.erl | 105 +++++++++++++++++++++++++--- 1 file changed, 95 insertions(+), 10 deletions(-) diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index 2c01037063..e0b68237c2 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -71,8 +71,8 @@ {socket :: inet:socket(), %% accept or connect socket parent :: pid(), %% of process that started us module :: module(), %% gen_tcp-like module - frag = <<>> :: binary() | {tref(), frag()}}). %% message fragment - + frag = <<>> :: binary() | {tref(), frag()}, %% message fragment + ssl :: boolean() | [term()]}). %% ssl options %% The usual transport using gen_tcp can be replaced by anything %% sufficiently gen_tcp-like by passing a 'module' option as the first %% (for simplicity) transport option. The transport_module diameter_etcp @@ -122,12 +122,14 @@ i({T, Ref, Mod, Pid, Opts, Addrs}) %% that does nothing but kill us with the parent until call %% returns. {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}), - Sock = i(T, Ref, Mod, Pid, Opts, Addrs), + {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]), + Sock = i(T, Ref, Mod, Pid, Rest, Addrs), MPid ! {stop, self()}, %% tell the monitor to die setopts(Mod, Sock), #transport{parent = Pid, module = Mod, - socket = Sock}; + socket = Sock, + ssl = ssl_opts(Mod, SslOpts)}; %% A monitor process to kill the transport if the parent dies. i(#monitor{parent = Pid, transport = TPid} = S) -> @@ -151,6 +153,14 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) -> true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), start_timer(#listener{socket = LSock}). +ssl_opts(_, []) -> + false; +ssl_opts(Mod, [{ssl_options, Opts}]) + when is_list(Opts) -> + [{Mod, tcp, tcp_closed} | Opts]; +ssl_opts(_, L) -> + ?ERROR({ssl_options, L}). + %% i/6 i(accept, Ref, Mod, Pid, Opts, Addrs) -> @@ -258,6 +268,8 @@ handle_info(T, #monitor{} = S) -> %% # code_change/3 %% --------------------------------------------------------------------------- +code_change(_, {transport, _, _, _, _} = S, _) -> + {ok, #transport{} = list_to_tuple(tuple_to_list(S) ++ [false])}; code_change(_, State, _) -> {ok, State}. @@ -332,17 +344,56 @@ t(T,S) -> %% transition/2 +%% Initial incoming message when we might need to upgrade to TLS: +%% don't request another message until we know. +transition({tcp, Sock, Bin}, #transport{socket = Sock, + parent = Pid, + frag = Head, + module = M, + ssl = Opts} + = S) + when is_list(Opts) -> + case recv1(Head, Bin) of + {Msg, B} when is_binary(Msg) -> + diameter_peer:recv(Pid, Msg), + S#transport{frag = B}; + Frag -> + setopts(M, Sock), + S#transport{frag = Frag} + end; + %% Incoming message. -transition({tcp, Sock, Data}, #transport{socket = Sock, - module = M} - = S) -> +transition({P, Sock, Bin}, #transport{socket = Sock, + module = M, + ssl = B} + = S) + when P == tcp, not B; + P == ssl, B -> + setopts(M, Sock), + recv(Bin, S); + +%% Capabilties exchange has decided on whether or not to run over TLS. +transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid} + = S) -> + #transport{socket = Sock, + module = M} + = NS + = tls_handshake(Type, B, S), + Pid ! {diameter, {tls, Ref}}, setopts(M, Sock), - recv(Data, S); + NS#transport{ssl = B}; -transition({tcp_closed, Sock}, #transport{socket = Sock}) -> +transition({C, Sock}, #transport{socket = Sock, + ssl = B}) + when C == tcp_closed, not B; + C == ssl_closed, B -> stop; -transition({tcp_error, Sock, _Reason} = T, #transport{socket = Sock} = S) -> +transition({E, Sock, _Reason} = T, #transport{socket = Sock, + ssl = B} + = S) + when E == tcp_error, not B; + E == ssl_error, B -> ?ERROR({T,S}); %% Outgoing message. @@ -379,6 +430,29 @@ transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> %% Crash on anything unexpected. +%% tls_handshake/3 +%% +%% In the case that no tls message is received (eg. the service hasn't +%% been configured to advertise TLS support) we will simply never ask +%% for another TCP message, which will force the watchdog to +%% eventually take us down. + +tls_handshake(Type, true, #transport{socket = Sock, + ssl = Opts} + = S) -> + is_list(Opts) orelse ?ERROR({tls, Opts}), + {ok, SSock} = tls(Type, Sock, Opts), + S#transport{socket = SSock, + module = ssl}; + +tls_handshake(_, false, S) -> + S. + +tls(connect, Sock, Opts) -> + ssl:connect(Sock, Opts); +tls(accept, Sock, Opts) -> + ssl:ssl_accept(Sock, Opts). + %% recv/2 %% %% Reassemble fragmented messages and extract multple message sent @@ -509,6 +583,8 @@ connect(Mod, Host, Port, Opts) -> send(gen_tcp, Sock, Bin) -> gen_tcp:send(Sock, Bin); +send(ssl, Sock, Bin) -> + ssl:send(Sock, Bin); send(M, Sock, Bin) -> M:send(Sock, Bin). @@ -516,6 +592,8 @@ send(M, Sock, Bin) -> setopts(gen_tcp, Sock, Opts) -> inet:setopts(Sock, Opts); +setopts(ssl, Sock, Opts) -> + ssl:setopts(Sock, Opts); setopts(M, Sock, Opts) -> M:setopts(Sock, Opts). @@ -531,5 +609,12 @@ setopts(M, Sock) -> lport(gen_tcp, Sock) -> inet:port(Sock); +lport(ssl, Sock) -> + case ssl:sockname(Sock) of + {ok, {_Addr, PortNr}} -> + {ok, PortNr}; + {error, _} = No -> + No + end; lport(M, Sock) -> M:port(Sock). -- cgit v1.2.3 From 68c94d9b8db4773259c323cd428cf4bf20931869 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 2 Oct 2011 12:09:34 +0200 Subject: Close transport if tls is requested over sctp RFC 3588 requires that a Diameter server support TLS but in practise this seems to mean TLS over SCTP since there are limitations with running over SCTP: see RFC 6083 (DTLS over SCTP), which is a response to RFC 3436 (TLS over SCTP). The current RFC 3588 draft acknowledges this by equating the Inband-Security-Id value TLS with TLS/TCP and DTLS/SCTP but underlying support for DTLS is still thin on the ground. --- lib/diameter/src/transport/diameter_sctp.erl | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 46473e7bf1..cb024c77b1 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -411,6 +411,14 @@ transition({diameter, {send, Msg}}, S) -> transition({diameter, {close, Pid}}, #transport{parent = Pid}) -> stop; +%% TLS over SCTP is described in RFC 3436 but has limitations as +%% described in RFC 6083. The latter describes DTLS over SCTP, which +%% addresses these limitations, DTLS itself being described in RFC +%% 4347. TLS is primarily used over TCP, which the current RFC 3588 +%% draft acknowledges by equating TLS with TLS/TCP and DTLS/SCTP. +transition({diameter, {tls, _Ref, _Type, _Bool}}, _) -> + stop; + %% Listener process has died. transition({'DOWN', _, process, Pid, _}, #transport{mode = {accept, Pid}}) -> stop; -- cgit v1.2.3 From 30a7d3935e57bd4c6b7e64f8b25eb0a11c0e7c80 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 3 Oct 2011 15:31:27 +0200 Subject: Documentation updates --- lib/diameter/doc/src/diameter.xml | 21 ++++++++++++++++ lib/diameter/doc/src/diameter_soc.xml | 10 +++++--- lib/diameter/doc/src/diameter_tcp.xml | 34 +++++++++++++++++++++++--- lib/diameter/doc/src/diameter_transport.xml | 38 +++++++++++++++++++++++++++++ 4 files changed, 97 insertions(+), 6 deletions(-) diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 2cad70e3bc..43c497f50a 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -367,6 +367,19 @@ capabilities exchange message. Optional, defaults to the empty list.

+{'Inband-Security-Id', [Unsigned32()]} + +

+Values of Inband-Security-Id AVPs sent in an outgoing +capabilities exchange message. +Optional, defaults to the empty list, which is equivalent to a +list containing only 0 (= NO_INBAND_SECURITY).

+ +

+If 1 (= TLS) is specified then TLS is selected if the CER/CEA received +from the peer offers it.

+ + {'Acct-Application-Id', [Unsigned32()]}

@@ -683,6 +696,14 @@ in question.

AVP's used to construct outgoing CER/CEA messages. Any AVP specified takes precedence over a corresponding value specified for the service in question.

+ +

+Specifying a capability as a transport option +may be particularly appropriate for Inband-Security-Id in case +TLS is desired over TCP as implemented by +diameter_tcp(3) but +not over SCTP as implemented by +diameter_sctp(3).

 {watchdog_timer, TwInit} diff --git a/lib/diameter/doc/src/diameter_soc.xml b/lib/diameter/doc/src/diameter_soc.xml index 4f8581a904..6b9ef9f756 100644 --- a/lib/diameter/doc/src/diameter_soc.xml +++ b/lib/diameter/doc/src/diameter_soc.xml @@ -57,9 +57,13 @@ including the P Flag in the AVP header.

-There is no TLS support. -It's unclear (aka uninvestigated) how TLS would impact -diameter but IPsec can be used without it needing to know.

+There is no TLS support over SCTP. +RFC 3588 requires that a Diameter server support TLS but in +practise this seems to mean TLS over SCTP since there are limitations +with running over SCTP: see RFC 6083 (DTLS over SCTP), which is a +response to RFC 3436 (TLS over SCTP). +The current RFC 3588 draft acknowledges this by equating +TLS with TLS/TCP and DTLS/SCTP but we do not yet support DTLS.

 diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index a502e53972..916700927f 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -43,7 +43,9 @@ It can be specified as the value of a transport_module option to diameter:add_transport/2 and implements the behaviour documented in -diameter_transport(3).

+diameter_transport(3). +TLS security is supported, a connection being upgraded if +TLS is negotiated during capabilities exchange.

@@ -60,10 +62,14 @@ and implements the behaviour documented in Type = connect | accept Ref = reference() Svc = #diameter_service{} -Opt = {raddr, ip_address()} | {rport, integer()} | term() +Opt = OwnOpt | TlsOpt | TcpOpt Pid = pid() LAddr = ip_address() Reason = term() +OwnOpt = {raddr, ip_address()} + | {rport, integer()} +TlsOpt = {ssl_options, list()} +TcpOpt = term() @@ -74,8 +80,11 @@ marker="diameter_transport#start">diameter_transport(3).

The only diameter_tcp-specific argument is the options list. Options raddr and rport specify the remote address -and port for a connecting transport and not valid for a listening +and port for a connecting transport and are not valid for a listening transport. +Option ssl_options specifies options to be passed +to ssl:connect/2 of ssl:ssl_accept/2 in case capabilities exchange +results in TLS being chosen for inband security. Remaining options are any accepted by gen_tcp:connect/3 for a connecting transport, or gen_tcp:listen/2 for a listening transport, with the exception of binary, packet and active. @@ -84,6 +93,24 @@ to specify the local listening port, the default being the standardized 3868 if unspecified. Note that option ip specifies the local address.

+

+The ssl_options option must be specified if and only if +the transport in question has specified an Inband-Security-Id +AVP with value TLS on the relevant call to +start_service/2 or +add_transport/2, +so that the transport process will receive notification of +whether or not to commence with a TLS handshake following capabilities +exchange. +Failing to specify ssl_options on a TLS-capable transport +for which TLS is negotiated will cause TLS handshake to fail. +Failing to specify TLS capability when ssl_options has been +specified will cause the transport process to wait for a notification +that will not be forthcoming, which will eventually cause the RFC 3539 +watchdog to take down the connection.

+

If the service specifies more than one Host-IP-Address and option ip is unspecified then then the @@ -104,6 +131,7 @@ The returned local address list has length one.

SEE ALSO

+diameter(3), diameter_transport(3)

diff --git a/lib/diameter/doc/src/diameter_transport.xml b/lib/diameter/doc/src/diameter_transport.xml index 37cc871e75..087a90b099 100644 --- a/lib/diameter/doc/src/diameter_transport.xml +++ b/lib/diameter/doc/src/diameter_transport.xml @@ -143,6 +143,34 @@ connection. Pid is the pid() of the parent process.

+{diameter, {tls, Ref, Type, Bool}} + +

+Indication of whether or not capabilities exchange has selected +inband security using TLS. +Ref is a reference() that must be included in the +{diameter, {tls, Ref}} reply message to the transport's +parent process (see below). +Type is either connect or accept depending on +whether the process has been started for a connecting or listening +transport respectively. +Bool is a boolean() indicating whether or not the transport connection +should be upgraded to TLS.

+ +

+If TLS is requested (Bool = true) then a connecting process should +initiate a TLS handshake with the peer and an accepting process should +prepare to accept a handshake. +A successful handshake should be followed by a {diameter, {tls, Ref}} +message to the parent process. +A failed handshake should cause the process to exit.

+ +

+This message is only sent to a transport process over whose +Inband-Security-Id configuration has indicated support for +TLS.

+ +

@@ -184,6 +212,16 @@ How the transport_data is used/interpreted is up to the transport module.

+{diameter, {tls, Ref}} + +

+Acknowledgment of a successful TLS handshake. +Ref is the reference() received in the +{diameter, {tls, Ref, Type, Bool}} message in response +to which the reply is sent. +A transport must exit if a handshake is not successful.

+ +
-- cgit v1.2.3 From 8998476269bf308e92b004f00e5ae3636f08541e Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 3 Oct 2011 00:56:18 +0200 Subject: Add tls testsuite --- lib/diameter/test/diameter_tls_SUITE.erl | 347 +++++++++++++++++++++ .../test/diameter_tls_SUITE_data/Makefile.ca | 43 +++ lib/diameter/test/modules.mk | 3 +- 3 files changed, 392 insertions(+), 1 deletion(-) create mode 100644 lib/diameter/test/diameter_tls_SUITE.erl create mode 100644 lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl new file mode 100644 index 0000000000..466f7af138 --- /dev/null +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -0,0 +1,347 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Tests of traffic between four Diameter nodes connected as follows. +%% +%% ---- SERVER.REALM1 +%% / +%% CLIENT.REALM0 ----- SERVER.REALM2 +%% \ +%% ---- SERVER.REALM3 +%% +%% The first two connections are established over TLS, the third not. +%% + +-module(diameter_tls_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_group/2, + end_per_group/2, + init_per_suite/1, + end_per_suite/1]). + +%% testcases +-export([send1/1, + send2/1, + send3/1, + remove_transports/1, + stop_services/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/4, + prepare_request/3, + prepare_retransmit/3, + handle_answer/4, + handle_error/4, + handle_request/3]). + +-ifdef(DIAMETER_CT). +-include("diameter_gen_base_rfc3588.hrl"). +-else. +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). +-endif. + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_ct.hrl"). + +%% =========================================================================== + +-define(ADDR, {127,0,0,1}). + +-define(CLIENT, "CLIENT.REALM0"). +-define(SERVER1, "SERVER.REALM1"). +-define(SERVER2, "SERVER.REALM2"). +-define(SERVER3, "SERVER.REALM3"). + +-define(DICT_COMMON, ?DIAMETER_DICT_COMMON). + +-define(APP_ALIAS, the_app). +-define(APP_ID, ?DICT_COMMON:id()). + +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + +%% Config for diameter:start_service/2. +-define(SERVICE(Host, Dict), + [{'Origin-Host', Host}, + {'Origin-Realm', realm(Host)}, + {'Host-IP-Address', [?ADDR]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Inband-Security-Id', [?NO_INBAND_SECURITY]}, + {'Auth-Application-Id', [Dict:id()]}, + {application, [{alias, ?APP_ALIAS}, + {dictionary, Dict}, + {module, ?MODULE}, + {answer_errors, callback}]}]). + +%% Config for diameter:add_transport/2. In the listening case, listen +%% on a free port that we then lookup using the implementation detail +%% that diameter_tcp registers the port with diameter_reg. +-define(CONNECT(PortNr, Caps, Opts), + {connect, [{transport_module, diameter_tcp}, + {transport_config, [{raddr, ?ADDR}, + {rport, PortNr}, + {ip, ?ADDR}, + {port, 0} + | Opts]}, + {capabilities, Caps}]}). +-define(LISTEN(Caps, Opts), + {listen, [{transport_module, diameter_tcp}, + {transport_config, [{ip, ?ADDR}, {port, 0} | Opts]}, + {capabilities, Caps}]}). + +-define(SUCCESS, 2001). + +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [{group, N} || {N, _, _} <- groups()] + ++ [remove_transports, stop_services]. + +groups() -> + Ts = tc(), + [{all, [], Ts}, + {p, [parallel], Ts}]. + +init_per_group(_, Config) -> + Config. + +end_per_group(_, _) -> + ok. + +init_per_suite(Config) -> + ok = ssl:start(), + ok = diameter:start(), + + Dir = proplists:get_value(priv_dir, Config), + Servers = [server(?SERVER1, + inband_security([?TLS]), + ssl_options(Dir, "server1")), + server(?SERVER2, + inband_security([?NO_INBAND_SECURITY, ?TLS]), + ssl_options(Dir, "server2")), + server(?SERVER3, + [], + [])], + + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + true = diameter:subscribe(?CLIENT), + + Connections = connect(?CLIENT, + Servers, + inband_security([?NO_INBAND_SECURITY, ?TLS]), + ssl_options(Dir, "client")), + + [{transports, lists:zip(Servers, Connections)} | Config]. + +end_per_suite(_Config) -> + ok = diameter:stop(), + ok = ssl:stop(). + +%% Testcases to run when services are started and connections +%% established. These are trivial, the interesting stuff is setting up +%% the connections in init_per_suite/2. +tc() -> + [send1, + send2, + send3]. + +%% =========================================================================== + +inband_security(Ids) -> + [{'Inband-Security-Id', Ids}]. + +ssl_options(Dir, Base) -> + {Key, Cert} = make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"), + [{ssl_options, [{certfile, Cert}, {keyfile, Key}]}]. + +server(Host, Caps, Opts) -> + ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)), + {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)), + {LRef, portnr(LRef)}. + +connect(Host, {_LRef, PortNr}, Caps, Opts) -> + {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)), + ok = receive + #diameter_event{service = Host, + info = {up, Ref, _, _, #diameter_packet{}}} -> + ok + after 2000 -> + false + end, + Ref; +connect(Host, Ports, Caps, Opts) -> + [connect(Host, P, Caps, Opts) || P <- Ports]. + +portnr(LRef) -> + portnr(LRef, 20). + +portnr(LRef, N) + when 0 < N -> + case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of + [{T, _Pid}] -> + {_, _, {LRef, {_Addr, LSock}}} = T, + {ok, PortNr} = inet:port(LSock), + PortNr; + [] -> + receive after 50 -> ok end, + portnr(LRef, N-1) + end. + +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + +make_cert(Dir, Keyfile, Certfile) -> + [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]], + + KCmd = join(["openssl genrsa -out", K, "2048"]), + CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7", + "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]), + + %% Hope for the best and only check that files are written. + os:cmd(KCmd), + os:cmd(CCmd), + + [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]], + + {K,C}. + +join(Strs) -> + string:join(Strs, " "). + +%% =========================================================================== + +%% Send an STR intended for a specific server and expect success. +send1(_Config) -> + call(?SERVER1). +send2(_Config) -> + call(?SERVER2). +send3(_Config) -> + call(?SERVER3). + +%% Remove the client transports and expect the corresponding server +%% transport to go down. +remove_transports(Config) -> + Ts = proplists:get_value(transports, Config), + + true = diameter:subscribe(?SERVER1), + true = diameter:subscribe(?SERVER2), + true = diameter:subscribe(?SERVER3), + + lists:map(fun disconnect/1, Ts). + +disconnect({{LRef, _PortNr}, CRef}) -> + ok = diameter:remove_transport(?CLIENT, CRef), + ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok + after 2000 -> false + end. + +stop_services(_Config) -> + S = [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3], + Ok = [ok || _ <- S], + Ok = [diameter:stop_service(H) || H <- S]. + +%% =========================================================================== + +call(Server) -> + Realm = realm(Server), + Req = ['STR', {'Destination-Realm', Realm}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Origin-Host' = Server, + 'Origin-Realm' = Realm} + = call(Req, [{filter, realm}]). + +call(Req, Opts) -> + diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). + +set([H|T], Vs) -> + [H | Vs ++ T]. + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/4 + +pick_peer([Peer], _, ?CLIENT, _State) -> + {ok, Peer}. + +%% prepare_request/3 + +prepare_request(#diameter_packet{msg = Req}, + ?CLIENT, + {_Ref, Caps}) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + + {send, set(Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}])}. + +%% prepare_retransmit/3 + +prepare_retransmit(_Pkt, false, _Peer) -> + discard. + +%% handle_answer/4 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> + #diameter_packet{msg = Rec, errors = []} = Pkt, + Rec. + +%% handle_error/4 + +handle_error(Reason, _Req, ?CLIENT, _Peer) -> + {error, Reason}. + +%% handle_request/3 + +handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}}, + OH, + {_Ref, #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR, _}}}) + when OH /= ?CLIENT -> + {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR}}. diff --git a/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca new file mode 100644 index 0000000000..3f2645add0 --- /dev/null +++ b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca @@ -0,0 +1,43 @@ +# -*- makefile -*- +# %CopyrightBegin% +# +# Copyright Ericsson AB 2011. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% + +# +# Certificates are now generated from the suite itself but the +# makefile itself is still useful. +# + +KEYS = $(HOSTS:%=%_key.pem) +CERTS = $(HOSTS:%=%_ca.pem) + +all: $(CERTS) + +%_ca.pem: %_key.pem + openssl req -new -x509 -key $< -out $@ -days 1095 \ + -subj '/C=SE/ST=./L=Stockholm/CN=www.erlang.org' + +%_key.pem: + openssl genrsa -out $@ 2048 + +clean: + rm -f $(CERTS) + +realclean: clean + rm -f $(KEYS) + +.PRECIOUS: $(KEYS) +.PHONY: all clean realclean diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index c6f709dc36..7c691c302b 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -34,7 +34,8 @@ MODULES = \ diameter_watchdog_SUITE \ diameter_transport_SUITE \ diameter_traffic_SUITE \ - diameter_relay_SUITE + diameter_relay_SUITE \ + diameter_tls_SUITE INTERNAL_HRL_FILES = \ diameter_ct.hrl -- cgit v1.2.3 From 82934adca7cd26777025bc9ae1b87b45d2a55fe2 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Tue, 4 Oct 2011 17:28:57 +0200 Subject: Add tls support at connection establishment This is the method added in draft-ietf-dime-rfc3588bis, whereby a TLS handshake immediately follows connection establishment and CER/CEA is sent over the secured connection. --- lib/diameter/doc/src/diameter_tcp.xml | 34 ++-- lib/diameter/src/transport/diameter_tcp.erl | 64 +++++-- lib/diameter/test/diameter_tls_SUITE.erl | 274 ++++++++++++++++------------ 3 files changed, 224 insertions(+), 148 deletions(-) diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index 916700927f..210ae9fdfe 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -44,8 +44,9 @@ It can be specified as the value of a transport_module option to marker="diameter#add_transport">diameter:add_transport/2 and implements the behaviour documented in diameter_transport(3). -TLS security is supported, a connection being upgraded if -TLS is negotiated during capabilities exchange.

+TLS security is supported, both as an upgrade following +capabilities exchange as specified by RFC 3588 and +at connection establishment as in the current draft standard.

@@ -62,14 +63,15 @@ TLS is negotiated during capabilities exchange.

Type = connect | accept Ref = reference() Svc = #diameter_service{} -Opt = OwnOpt | TlsOpt | TcpOpt +Opt = OwnOpt | SslOpt | OtherOpt Pid = pid() LAddr = ip_address() Reason = term() OwnOpt = {raddr, ip_address()} - | {rport, integer()} -TlsOpt = {ssl_options, list()} -TcpOpt = term() + | {rport, integer()} + | {port, integer()} +SslOpt = {ssl_options, true | list()} +OtherOpt = term() @@ -82,19 +84,23 @@ The only diameter_tcp-specific argument is the options list. Options raddr and rport specify the remote address and port for a connecting transport and are not valid for a listening transport. -Option ssl_options specifies options to be passed -to ssl:connect/2 of ssl:ssl_accept/2 in case capabilities exchange -results in TLS being chosen for inband security. -Remaining options are any accepted by gen_tcp:connect/3 for -a connecting transport, or gen_tcp:listen/2 for a listening transport, -with the exception of binary, packet and active. +Option ssl_options must be specified for a transport +that must be able to support TLS: a value of true results in a +TLS handshake immediately upon connection establishment while +list() specifies options to be passed to ssl:connect/2 of ssl:ssl_accept/2 +after capabilities exchange if TLS is negotiated. +Remaining options are any accepted by ssl:connect/3 or gen_tcp:connect/3 for +a connecting transport, or ssl:listen/3 or gen_tcp:listen/2 for +a listening transport, depending on whether or not {ssl_options, true} +has been specified. +Options binary, packet and active cannot be specified. Also, option port can be specified for a listening transport to specify the local listening port, the default being the standardized 3868 if unspecified. Note that option ip specifies the local address.

-The ssl_options option must be specified if and only if +An ssl_options list must be specified if and only if the transport in question has specified an Inband-Security-Id AVP with value TLS on the relevant call to add_transport/2, so that the transport process will receive notification of whether or not to commence with a TLS handshake following capabilities exchange. -Failing to specify ssl_options on a TLS-capable transport +Failing to specify an options list on a TLS-capable transport for which TLS is negotiated will cause TLS handshake to fail. Failing to specify TLS capability when ssl_options has been specified will cause the transport process to wait for a notification diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index e0b68237c2..33b9daf0d9 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -45,6 +45,9 @@ -define(LISTENER_TIMEOUT, 30000). -define(FRAGMENT_TIMEOUT, 1000). +%% cb_info passed to ssl. +-define(TCP_CB(Mod), {Mod, tcp, tcp_closed, tcp_error}). + %% The same gen_server implementation supports three different kinds %% of processes: an actual transport process, one that will club it to %% death should the parent die before a connection is established, and @@ -122,14 +125,15 @@ i({T, Ref, Mod, Pid, Opts, Addrs}) %% that does nothing but kill us with the parent until call %% returns. {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}), - {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]), - Sock = i(T, Ref, Mod, Pid, Rest, Addrs), + {SslOpts, Rest} = ssl(Opts), + Sock = i(T, Ref, Mod, Pid, SslOpts, Rest, Addrs), MPid ! {stop, self()}, %% tell the monitor to die - setopts(Mod, Sock), + M = if SslOpts -> ssl; true -> Mod end, + setopts(M, Sock), #transport{parent = Pid, - module = Mod, + module = M, socket = Sock, - ssl = ssl_opts(Mod, SslOpts)}; + ssl = SslOpts}; %% A monitor process to kill the transport if the parent dies. i(#monitor{parent = Pid, transport = TPid} = S) -> @@ -153,15 +157,29 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) -> true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), start_timer(#listener{socket = LSock}). -ssl_opts(_, []) -> +ssl(Opts) -> + {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]), + {ssl_opts(SslOpts), Rest}. + +ssl_opts([]) -> false; -ssl_opts(Mod, [{ssl_options, Opts}]) +ssl_opts([{ssl_options, true}]) -> + true; +ssl_opts([{ssl_options, Opts}]) when is_list(Opts) -> - [{Mod, tcp, tcp_closed} | Opts]; -ssl_opts(_, L) -> + Opts; +ssl_opts(L) -> ?ERROR({ssl_options, L}). -%% i/6 +%% i/7 + +%% Establish a TLS connection before capabilities exchange ... +i(Type, Ref, Mod, Pid, true, Opts, Addrs) -> + i(Type, Ref, ssl, Pid, [{cb_info, ?TCP_CB(Mod)} | Opts], Addrs); + +%% ... or not. +i(Type, Ref, Mod, Pid, _, Opts, Addrs) -> + i(Type, Ref, Mod, Pid, Opts, Addrs). i(accept, Ref, Mod, Pid, Opts, Addrs) -> {LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}), @@ -437,14 +455,25 @@ transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> %% for another TCP message, which will force the watchdog to %% eventually take us down. +%% TLS has already been established with the connection. +tls_handshake(_, _, #transport{ssl = true} = S) -> + S; + +%% Capabilities exchange negotiated TLS but transport was not +%% configured with an options list. +tls_handshake(_, true, #transport{ssl = false}) -> + ?ERROR(no_ssl_options); + +%% Capabilities exchange negotiated TLS: upgrade the connection. tls_handshake(Type, true, #transport{socket = Sock, + module = M, ssl = Opts} = S) -> - is_list(Opts) orelse ?ERROR({tls, Opts}), - {ok, SSock} = tls(Type, Sock, Opts), + {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]), S#transport{socket = SSock, module = ssl}; +%% Capabilities exchange has not negotiated TLS. tls_handshake(_, false, S) -> S. @@ -567,15 +596,18 @@ flush(_, S) -> %% accept/2 -accept(gen_tcp, LSock) -> - gen_tcp:accept(LSock); +accept(ssl, LSock) -> + case ssl:transport_accept(LSock) of + {ok, Sock} -> + {ssl:ssl_accept(Sock), Sock}; + {error, _} = No -> + No + end; accept(Mod, LSock) -> Mod:accept(LSock). %% connect/4 -connect(gen_tcp, Host, Port, Opts) -> - gen_tcp:connect(Host, Port, Opts); connect(Mod, Host, Port, Opts) -> Mod:connect(Host, Port, Opts). diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 466f7af138..8cf135cebf 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -18,15 +18,17 @@ %% %% -%% Tests of traffic between four Diameter nodes connected as follows. +%% Tests of traffic between six Diameter nodes connected as follows. %% -%% ---- SERVER.REALM1 +%% ---- SERVER.REALM1 (TLS after capabilities exchange) %% / -%% CLIENT.REALM0 ----- SERVER.REALM2 +%% / ---- SERVER.REALM2 (ditto) +%% | / +%% CLIENT.REALM0 ----- SERVER.REALM3 (no security) +%% | \ +%% \ ---- SERVER.REALM4 (TLS at connection establishment) %% \ -%% ---- SERVER.REALM3 -%% -%% The first two connections are established over TLS, the third not. +%% ---- SERVER.REALM5 (ditto) %% -module(diameter_tls_SUITE). @@ -43,6 +45,8 @@ -export([send1/1, send2/1, send3/1, + send4/1, + send5/1, remove_transports/1, stop_services/1]). @@ -73,6 +77,10 @@ -define(SERVER1, "SERVER.REALM1"). -define(SERVER2, "SERVER.REALM2"). -define(SERVER3, "SERVER.REALM3"). +-define(SERVER4, "SERVER.REALM4"). +-define(SERVER5, "SERVER.REALM5"). + +-define(SERVERS, [?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]). -define(DICT_COMMON, ?DIAMETER_DICT_COMMON). @@ -113,13 +121,12 @@ {capabilities, Caps}]}). -define(SUCCESS, 2001). - -define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). %% =========================================================================== suite() -> - [{timetrap, {seconds, 10}}]. + [{timetrap, {seconds, 15}}]. all() -> [{group, N} || {N, _, _} <- groups()] @@ -141,24 +148,14 @@ init_per_suite(Config) -> ok = diameter:start(), Dir = proplists:get_value(priv_dir, Config), - Servers = [server(?SERVER1, - inband_security([?TLS]), - ssl_options(Dir, "server1")), - server(?SERVER2, - inband_security([?NO_INBAND_SECURITY, ?TLS]), - ssl_options(Dir, "server2")), - server(?SERVER3, - [], - [])], + Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS], ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), - true = diameter:subscribe(?CLIENT), - Connections = connect(?CLIENT, - Servers, - inband_security([?NO_INBAND_SECURITY, ?TLS]), - ssl_options(Dir, "client")), + Opts = ssl_options(Dir, "client"), + Connections = [connect(?CLIENT, S, copts(N, Opts)) + || {S,N} <- lists:zip(Servers, ?SERVERS)], [{transports, lists:zip(Servers, Connections)} | Config]. @@ -172,72 +169,12 @@ end_per_suite(_Config) -> tc() -> [send1, send2, - send3]. - -%% =========================================================================== - -inband_security(Ids) -> - [{'Inband-Security-Id', Ids}]. - -ssl_options(Dir, Base) -> - {Key, Cert} = make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"), - [{ssl_options, [{certfile, Cert}, {keyfile, Key}]}]. - -server(Host, Caps, Opts) -> - ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)), - {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)), - {LRef, portnr(LRef)}. - -connect(Host, {_LRef, PortNr}, Caps, Opts) -> - {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)), - ok = receive - #diameter_event{service = Host, - info = {up, Ref, _, _, #diameter_packet{}}} -> - ok - after 2000 -> - false - end, - Ref; -connect(Host, Ports, Caps, Opts) -> - [connect(Host, P, Caps, Opts) || P <- Ports]. - -portnr(LRef) -> - portnr(LRef, 20). - -portnr(LRef, N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of - [{T, _Pid}] -> - {_, _, {LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = inet:port(LSock), - PortNr; - [] -> - receive after 50 -> ok end, - portnr(LRef, N-1) - end. - -realm(Host) -> - tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). - -make_cert(Dir, Keyfile, Certfile) -> - [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]], - - KCmd = join(["openssl genrsa -out", K, "2048"]), - CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7", - "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]), - - %% Hope for the best and only check that files are written. - os:cmd(KCmd), - os:cmd(CCmd), - - [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]], - - {K,C}. - -join(Strs) -> - string:join(Strs, " "). + send3, + send4, + send5]. %% =========================================================================== +%% testcases %% Send an STR intended for a specific server and expect success. send1(_Config) -> @@ -246,46 +183,22 @@ send2(_Config) -> call(?SERVER2). send3(_Config) -> call(?SERVER3). +send4(_Config) -> + call(?SERVER4). +send5(_Config) -> + call(?SERVER5). %% Remove the client transports and expect the corresponding server %% transport to go down. remove_transports(Config) -> Ts = proplists:get_value(transports, Config), - - true = diameter:subscribe(?SERVER1), - true = diameter:subscribe(?SERVER2), - true = diameter:subscribe(?SERVER3), - + [] = [T || S <- ?SERVERS, T <- [diameter:subscribe(S)], T /= true], lists:map(fun disconnect/1, Ts). -disconnect({{LRef, _PortNr}, CRef}) -> - ok = diameter:remove_transport(?CLIENT, CRef), - ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok - after 2000 -> false - end. - stop_services(_Config) -> - S = [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3], - Ok = [ok || _ <- S], - Ok = [diameter:stop_service(H) || H <- S]. - -%% =========================================================================== - -call(Server) -> - Realm = realm(Server), - Req = ['STR', {'Destination-Realm', Realm}, - {'Termination-Cause', ?LOGOUT}, - {'Auth-Application-Id', ?APP_ID}], - #diameter_base_STA{'Result-Code' = ?SUCCESS, - 'Origin-Host' = Server, - 'Origin-Realm' = Realm} - = call(Req, [{filter, realm}]). - -call(Req, Opts) -> - diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). - -set([H|T], Vs) -> - [H | Vs ++ T]. + Hs = [?CLIENT | ?SERVERS], + Ok = [ok || _ <- Hs], + Ok = [diameter:stop_service(H) || H <- Hs]. %% =========================================================================== %% diameter callbacks @@ -345,3 +258,128 @@ handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}}, 'Session-Id' = SId, 'Origin-Host' = OH, 'Origin-Realm' = OR}}. + +%% =========================================================================== +%% support functions + +call(Server) -> + Realm = realm(Server), + Req = ['STR', {'Destination-Realm', Realm}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Origin-Host' = Server, + 'Origin-Realm' = Realm} + = call(Req, [{filter, realm}]). + +call(Req, Opts) -> + diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). + +set([H|T], Vs) -> + [H | Vs ++ T]. + +disconnect({{LRef, _PortNr}, CRef}) -> + ok = diameter:remove_transport(?CLIENT, CRef), + ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok + after 2000 -> false + end. + +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + +inband_security(Ids) -> + [{'Inband-Security-Id', Ids}]. + +ssl_options(Dir, Base) -> + {Key, Cert} = make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"), + [{ssl_options, [{certfile, Cert}, {keyfile, Key}]}]. + +make_cert(Dir, Keyfile, Certfile) -> + [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]], + + KCmd = join(["openssl genrsa -out", K, "2048"]), + CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7", + "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]), + + %% Hope for the best and only check that files are written. + os:cmd(KCmd), + os:cmd(CCmd), + + [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]], + + {K,C}. + +join(Strs) -> + string:join(Strs, " "). + +%% server/2 + +server(Host, {Caps, Opts}) -> + ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)), + {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)), + {LRef, portnr(LRef)}. + +sopts(?SERVER1, Dir) -> + {inband_security([?TLS]), + ssl_options(Dir, "server1")}; +sopts(?SERVER2, Dir) -> + {inband_security([?NO_INBAND_SECURITY, ?TLS]), + ssl_options(Dir, "server2")}; +sopts(?SERVER3, _) -> + {[], []}; +sopts(?SERVER4, Dir) -> + {[], ssl(ssl_options(Dir, "server4"))}; +sopts(?SERVER5, Dir) -> + {[], ssl(ssl_options(Dir, "server5"))}. + +ssl([{ssl_options = T, Opts}]) -> + [{T, true} | Opts]. + +portnr(LRef) -> + portnr(LRef, 20). + +portnr(LRef, N) + when 0 < N -> + case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of + [{T, _Pid}] -> + {_, _, {LRef, {_Addr, LSock}}} = T, + {ok, PortNr} = to_portnr(LSock) , + PortNr; + [] -> + receive after 500 -> ok end, + portnr(LRef, N-1) + end. + +to_portnr(Sock) + when is_port(Sock) -> + inet:port(Sock); +to_portnr(Sock) -> + case ssl:sockname(Sock) of + {ok, {_,N}} -> + {ok, N}; + No -> + No + end. + +%% connect/3 + +connect(Host, {_LRef, PortNr}, {Caps, Opts}) -> + {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)), + ok = receive + #diameter_event{service = Host, + info = {up, Ref, _, _, #diameter_packet{}}} -> + ok + after 2000 -> + false + end, + Ref. + +copts(S, Opts) + when S == ?SERVER1; + S == ?SERVER2; + S == ?SERVER3 -> + {inband_security([?NO_INBAND_SECURITY, ?TLS]), Opts}; +copts(S, Opts) + when S == ?SERVER4; + S == ?SERVER5 -> + {[], ssl(Opts)}. -- cgit v1.2.3 From c002a636022d9910288a8612d03c6edd5c1a6962 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Tue, 4 Oct 2011 18:06:53 +0200 Subject: Clarify that ssl must be started for TLS support Also update app testsuite to allow for "undefined" calls from diameter_tcp to ssl. --- lib/diameter/doc/src/diameter_tcp.xml | 4 ++++ lib/diameter/test/diameter_app_SUITE.erl | 18 ++++++++++++------ 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index 210ae9fdfe..e6b53383c0 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -48,6 +48,10 @@ TLS security is supported, both as an upgrade following capabilities exchange as specified by RFC 3588 and at connection establishment as in the current draft standard.

+

+Note that the ssl application is required for TLS and must be started +before configuring TLS capability on diameter transports.

+ diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 104785b4e6..15a98d4441 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -147,14 +147,13 @@ appvsn(Name) -> %% =========================================================================== %% # xref/1 %% -%% Ensure that no function in our application calls an undefined function. +%% Ensure that no function in our application calls an undefined function +%% or one in an application we haven't specified as a dependency. (Almost.) %% =========================================================================== xref(Config) -> App = fetch(app, Config), - Mods = fetch(modules, App) -- [diameter_codegen, diameter_dbg], - %% Skip modules that aren't required at runtime and that have - %% dependencies beyond those applications listed in the app file. + Mods = fetch(modules, App), {ok, XRef} = xref:start(make_name(xref_test_name)), ok = xref:set_default(XRef, [{verbose, false}, {warnings, false}]), @@ -164,7 +163,10 @@ xref(Config) -> %% stop xref from complaining about calls to module erlang, which %% was previously in kernel. Erts isn't an application however, in %% the sense that there's no .app file, and isn't listed in - %% applications. Seems less than ideal. + %% applications. Seems less than ideal. Also, diameter_tcp does + %% call ssl despite ssl not being listed as a dependency in the + %% app file since ssl is only required for TLS security: it's up + %% to a client who wants TLS it to start ssl. ok = lists:foreach(fun(A) -> add_application(XRef, A) end, [?APP, erts | fetch(applications, App)]), @@ -173,7 +175,11 @@ xref(Config) -> xref:stop(XRef), %% Only care about calls from our own application. - [] = lists:filter(fun({{M,_,_},_}) -> lists:member(M, Mods) end, Undefs). + [] = lists:filter(fun({{F,_,_},{T,_,_}}) -> + lists:member(F, Mods) + andalso {F,T} /= {diameter_tcp, ssl} + end, + Undefs). add_application(XRef, App) -> add_application(XRef, App, code:lib_dir(App)). -- cgit v1.2.3 From dce08a5f07935e89f8d049376ff660cf59184e85 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Thu, 18 Aug 2011 11:58:45 +0200 Subject: Simplify depend.sed for better compatibility Sed on Solaris doesn't remember matches after branching. --- lib/diameter/doc/src/depend.sed | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lib/diameter/doc/src/depend.sed b/lib/diameter/doc/src/depend.sed index 5973c4586e..42de597f15 100644 --- a/lib/diameter/doc/src/depend.sed +++ b/lib/diameter/doc/src/depend.sed @@ -21,14 +21,18 @@ # massaged in Makefile. # -/^\([^<]*\)<\/com>/b rf -/^\([^<]*\)<\/module>/b rf +/^/b c +/^/b c /^/!d +# Chapter: html basename is same as xml. s@@$(HTMLDIR)/%FILE%.html: %FILE%.xml@ q -:rf -s@@$(HTMLDIR)/\1.html: %FILE%.xml@ +# Reference: html basename is from contents of com/module element. +:c +s@^[^>]*>@@ +s@<.*@@ +s@.*@$(HTMLDIR)/&.html: %FILE%.xml@ q -- cgit v1.2.3 From afaae9dc224c9b57eb4cbf6465e8adbac0264871 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 7 Oct 2011 13:28:23 +0200 Subject: Skip tls testsuite if there's no openssl --- lib/diameter/test/diameter_tls_SUITE.erl | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 8cf135cebf..c0a9603e04 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -144,6 +144,11 @@ end_per_group(_, _) -> ok. init_per_suite(Config) -> + init(os:find_executable("openssl"), Config). + +init(false, _) -> + {skip, no_openssl}; +init(_, Config) -> ok = ssl:start(), ok = diameter:start(), -- cgit v1.2.3 From 0edb6a4d2d76960846fd04ecce3aa00b3348691b Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Sun, 30 May 2010 20:02:39 +0300 Subject: Add '-callback' attribute to language syntax Behaviours may define specs for their callbacks using the familiar spec syntax, replacing the '-spec' keyword with '-callback'. Simple lint checks are performed to ensure that no callbacks are defined twice and all types referred are declared. These attributes can be then used by tools to provide documentation to the behaviour or find discrepancies in the callback definitions in the callback module. --- lib/compiler/src/compile.erl | 2 ++ lib/stdlib/src/erl_lint.erl | 25 +++++++++++++++++++++++-- lib/stdlib/src/erl_parse.yrl | 10 +++++++--- 3 files changed, 32 insertions(+), 5 deletions(-) diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 15849957e7..bfa7c6cedd 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1512,6 +1512,8 @@ restore_expand_module([{attribute,Line,opaque,[Type]}|Fs]) -> [{attribute,Line,opaque,Type}|restore_expand_module(Fs)]; restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) -> [{attribute,Line,spec,Arg}|restore_expand_module(Fs)]; +restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) -> + [{attribute,Line,callback,Arg}|restore_expand_module(Fs)]; restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index dd0b9bc2ab..0d8773ff0d 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -123,6 +123,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, specs = dict:new() :: dict(), %Type specifications + callbacks = dict:new() :: dict(), %Callback types types = dict:new() :: dict(), %Type definitions exp_types=gb_sets:empty():: gb_set() %Exported types }). @@ -310,8 +311,6 @@ format_error({conflicting_behaviours,{Name,Arity},B,FirstL,FirstB}) -> format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}) -> io_lib:format("undefined callback function ~w/~w (behaviour '~w')", [Func,Arity,Behaviour]); -format_error({undefined_behaviour_func, {Func,Arity,_Spec}, Behaviour}) -> - format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}); format_error({undefined_behaviour,Behaviour}) -> io_lib:format("behaviour ~w undefined", [Behaviour]); format_error({undefined_behaviour_callbacks,Behaviour}) -> @@ -348,12 +347,16 @@ format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); +format_error({redefine_callback, {M, F, A}}) -> + io_lib:format("callback ~w:~w/~w already defined", [M, F, A]); format_error({spec_fun_undefined, {M, F, A}}) -> io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]); format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> "spec has the wrong arity"; +format_error(callback_wrong_arity) -> + "callback has the wrong arity"; format_error({imported_predefined_type, Name}) -> io_lib:format("referring to built-in type ~w as a remote type; " "please take out the module name", [Name]); @@ -747,6 +750,8 @@ attribute_state({attribute,L,opaque,{TypeName,TypeDef,Args}}, St) -> type_def(opaque, L, TypeName, TypeDef, Args, St); attribute_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); +attribute_state({attribute,L,callback,{Fun,Types}}, St) -> + callback_decl(L, Fun, Types, St); attribute_state({attribute,L,on_load,Val}, St) -> on_load(L, Val, St); attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others @@ -2770,6 +2775,20 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> false -> check_specs(TypeSpecs, Arity, St1) end. +%% callback_decl(Line, Fun, Types, State) -> State. + +callback_decl(Line, MFA0, TypeSpecs, + St0 = #lint{callbacks = Callbacks, module = Mod}) -> + MFA = case MFA0 of + {F, Arity} -> {Mod, F, Arity}; + {_M, _F, Arity} -> MFA0 + end, + St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, + case dict:is_key(MFA, Callbacks) of + true -> add_error(Line, {redefine_callback, MFA}, St1); + false -> check_specs(TypeSpecs, Arity, St1) + end. + check_specs([FunType|Left], Arity, St0) -> {FunType1, CTypes} = case FunType of @@ -3275,6 +3294,8 @@ modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> {attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}}; modify_line1({attribute,L,spec,{Fun,Types}}, Mf) -> {attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}}; +modify_line1({attribute,L,callback,{Fun,Types}}, Mf) -> + {attribute,Mf(L),callback,{Fun,modify_line1(Types, Mf)}}; modify_line1({attribute,L,type,{TypeName,TypeDef,Args}}, Mf) -> {attribute,Mf(L),type,{TypeName,modify_line1(TypeDef, Mf), modify_line1(Args, Mf)}}; diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index bd5d65a1e1..709bd83e6f 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -62,7 +62,7 @@ char integer float atom string var '==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '<<' '>>' '!' '=' '::' '..' '...' -'spec' % helper +'spec' 'callback' % helper dot. Expect 2. @@ -77,6 +77,7 @@ attribute -> '-' atom attr_val : build_attribute('$2', '$3'). attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3'). attribute -> '-' atom '(' typed_attr_val ')' : build_typed_attribute('$2','$4'). attribute -> '-' 'spec' type_spec : build_type_spec('$2', '$3'). +attribute -> '-' 'callback' type_spec : build_type_spec('$2', '$3'). type_spec -> spec_fun type_sigs : {'$1', '$2'}. type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. @@ -549,6 +550,8 @@ Erlang code. ErrorInfo :: error_info(). parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> parse([{'-',L1},{'spec',L2}|Tokens]); +parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> + parse([{'-',L1},{'callback',L2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -603,7 +606,8 @@ build_typed_attribute({atom,La,Attr},_) -> _ -> ret_err(La, "bad attribute") end. -build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> +build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) + when (Kind =:= spec) or (Kind =:= callback) -> NewSpecFun = case SpecFun of {atom, _, Fun} -> @@ -617,7 +621,7 @@ build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> %% Old style spec. Allow this for now. {Mod,Fun,Arity} end, - {attribute,La,spec,{NewSpecFun, TypeSpecs}}. + {attribute,La,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> %% Use the first spec to find the arity. If all are not the same, -- cgit v1.2.3 From 493262e2f024d3a0773b8a062c24de84b5cf21d5 Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Sun, 30 May 2010 23:42:34 +0300 Subject: Automatically generate 'behaviour_info' function from '-callback' attributes 'behaviour_info(callbacks)' is a special function that is defined in a module which describes a behaviour and returns a list of its callbacks. This function is now automatically generated using the '-callback' specs. An error is returned by lint if user defines both '-callback' attributes and the behaviour_info/1 function. If no type info is needed for a callback use a generic spec for it. --- lib/compiler/src/sys_pre_expand.erl | 36 ++++++++++++++++++++++++++++++++++-- lib/stdlib/src/erl_lint.erl | 23 ++++++++++++++++++++++- 2 files changed, 56 insertions(+), 3 deletions(-) diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 249bd7a8e7..0fa1fea09f 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -43,6 +43,7 @@ mod_imports, %Module Imports compile=[], %Compile flags attributes=[], %Attributes + callbacks=[], %Callbacks defined=[], %Defined functions vcount=0, %Variable counter func=[], %Current function @@ -172,10 +173,41 @@ define_functions(Forms, #expand{defined=Predef}=St) -> end, Predef, Forms), St#expand{defined=ordsets:from_list(Fs)}. -module_attrs(St) -> - {[{attribute,Line,Name,Val} || {Name,Line,Val} <- St#expand.attributes],St}. +module_attrs(#expand{attributes=Attributes}=St) -> + Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], + Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], + {Attrs,St#expand{callbacks=Callbacks}}. module_predef_funcs(St) -> + {Mpf1,St1}=module_predef_func_beh_info(St), + {Mpf2,St2}=module_predef_funcs_mod_info(St1), + {Mpf1++Mpf2,St2}. + +module_predef_func_beh_info(#expand{callbacks=[]}=St) -> + {[], St}; +module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, + exports=Exports}=St) -> + PreDef=[{behaviour_info,1}], + PreExp=PreDef, + {[gen_beh_info(Callbacks)], + St#expand{defined=union(from_list(PreDef), Defined), + exports=union(from_list(PreExp), Exports)}}. + +gen_beh_info(Callbacks) -> + List = make_list(Callbacks), + {function,0,behaviour_info,1, + [{clause,0,[{atom,0,callbacks}],[], + [List]}]}. + +make_list([]) -> {nil,0}; +make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> + {cons,0, + {tuple,0, + [{atom,0,Name}, + {integer,0,Arity}]}, + make_list(Rest)}. + +module_predef_funcs_mod_info(St) -> PreDef = [{module_info,0},{module_info,1}], PreExp = PreDef, {[{function,0,module_info,0, diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 0d8773ff0d..78b996d94b 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -319,6 +319,9 @@ format_error({undefined_behaviour_callbacks,Behaviour}) -> format_error({ill_defined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions erroneously defined", [Behaviour]); +format_error({behaviour_info, {_M,F,A}}) -> + io_lib:format("cannot define callback attibute for ~w/~w when " + "behaviour_info is defined",[F,A]); %% --- types and specs --- format_error({singleton_typevar, Name}) -> io_lib:format("type variable ~w is only used once (is unbound)", [Name]); @@ -845,7 +848,8 @@ post_traversal_check(Forms, St0) -> StB = check_unused_types(Forms, StA), StC = check_untyped_records(Forms, StB), StD = check_on_load(StC), - check_unused_records(Forms, StD). + StE = check_unused_records(Forms, StD), + check_callback_information(StE). %% check_behaviour(State0) -> State %% Check that the behaviour attribute is valid. @@ -1144,6 +1148,23 @@ check_unused_records(Forms, St0) -> St0 end. +check_callback_information(#lint{callbacks = Callbacks, + defined = Defined} = State) -> + case gb_sets:is_member({behaviour_info,1}, Defined) of + false -> State; + true -> + case dict:size(Callbacks) of + 0 -> State; + _ -> + CallbacksList = dict:to_list(Callbacks), + FoldL = + fun({Fa,Line},St) -> + add_error(Line, {behaviour_info, Fa}, St) + end, + lists:foldl(FoldL, State, CallbacksList) + end + end. + %% For storing the import list we use the orddict module. %% We know an empty set is []. -- cgit v1.2.3 From 8ea0c7c566d2c356f273806c42615f31b9e946d3 Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Tue, 10 May 2011 18:31:02 +0300 Subject: Update the documentation with information on the callback attribute --- system/doc/design_principles/spec_proc.xml | 48 ++++++++++++++++++++---------- 1 file changed, 33 insertions(+), 15 deletions(-) diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml index f0f62891b6..a1c862e004 100644 --- a/system/doc/design_principles/spec_proc.xml +++ b/system/doc/design_principles/spec_proc.xml @@ -411,30 +411,48 @@ loop(...) ->

To implement a user-defined behaviour, write code similar to code for a special process but calling functions in a callback module for handling specific tasks.

-

If it is desired that the compiler should warn for missing - callback functions, as it does for the OTP behaviours, implement - and export the function:

+

If it is desired that the compiler should warn for missing callback + functions, as it does for the OTP behaviours, add callback attributes in the + behaviour module to describe the expected callbacks:

+ +-callback Name1(Arg1_1, Arg1_2, ..., Arg1_N1) -> Res1. +-callback Name2(Arg2_1, Arg2_2, ..., Arg2_N2) -> Res2. +... +-callback NameM(ArgM_1, ArgM_2, ..., ArgM_NM) -> ResM. +

where NameX are the names of the expected callbacks and + ArgX_Y, ResX are types as they are described in Specifications + for functions in Types and + Function Specifications. The whole syntax of spec attributes is + supported by callback attributes.

+

Alternatively you may directly implement and export the function:

behaviour_info(callbacks) -> [{Name1,Arity1},...,{NameN,ArityN}]. -

where each {Name,Arity} specifies the name and arity of - a callback function.

+

where each {Name,Arity} specifies the name and arity of a callback + function. This function is otherwise automatically generated by the compiler + using the callback attributes.

When the compiler encounters the module attribute - -behaviour(Behaviour). in a module Mod, it will call - Behaviour:behaviour_info(callbacks) and compare the result - with the set of functions actually exported from Mod, and - issue a warning if any callback function is missing.

+ -behaviour(Behaviour). in a module Mod, it will call + Behaviour:behaviour_info(callbacks) and compare the result with the + set of functions actually exported from Mod, and issue a warning if + any callback function is missing.

Example:

%% User-defined behaviour module -module(simple_server). -export([start_link/2,...]). --export([behaviour_info/1]). -behaviour_info(callbacks) -> - [{init,1}, - {handle_req,1}, - {terminate,0}]. +-callback init(State :: term()) -> 'ok'. +-callback handle_req(Req :: term(), State :: term()) -> {'ok', Reply :: term()}. +-callback terminate() -> 'ok'. + +%% Alternatively you may define: +%% +%% -export([behaviour_info/1]). +%% behaviour_info(callbacks) -> +%% [{init,1}, +%% {handle_req,2}, +%% {terminate,0}]. start_link(Name, Module) -> proc_lib:start_link(?MODULE, init, [self(), Name, Module]). @@ -452,7 +470,7 @@ init(Parent, Name, Module) -> -module(db). -behaviour(simple_server). --export([init/0, handle_req/1, terminate/0]). +-export([init/0, handle_req/2, terminate/0]). ... -- cgit v1.2.3 From 570594df20b0780333c2b6ba4ff7cfd6a0b02395 Mon Sep 17 00:00:00 2001 From: Henrik Nord Date: Fri, 7 Oct 2011 17:16:54 +0200 Subject: Update primary bootstrap --- bootstrap/lib/compiler/ebin/beam_asm.beam | Bin 11096 -> 11096 bytes bootstrap/lib/compiler/ebin/beam_disasm.beam | Bin 24976 -> 24968 bytes bootstrap/lib/compiler/ebin/compile.beam | Bin 36380 -> 36920 bytes bootstrap/lib/compiler/ebin/sys_pre_expand.beam | Bin 15848 -> 16504 bytes bootstrap/lib/kernel/ebin/code_server.beam | Bin 25896 -> 25956 bytes bootstrap/lib/kernel/ebin/hipe_unified_loader.beam | Bin 12540 -> 12540 bytes bootstrap/lib/kernel/ebin/inet.beam | Bin 19688 -> 19688 bytes bootstrap/lib/stdlib/ebin/beam_lib.beam | Bin 18192 -> 18220 bytes bootstrap/lib/stdlib/ebin/dets.beam | Bin 53204 -> 53204 bytes bootstrap/lib/stdlib/ebin/erl_compile.beam | Bin 5140 -> 5076 bytes bootstrap/lib/stdlib/ebin/erl_internal.beam | Bin 4996 -> 5016 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 83840 -> 84792 bytes bootstrap/lib/stdlib/ebin/erl_parse.beam | Bin 70760 -> 71068 bytes bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam | Bin 4772 -> 4936 bytes bootstrap/lib/stdlib/ebin/otp_internal.beam | Bin 9052 -> 9140 bytes bootstrap/lib/stdlib/ebin/sofs.beam | Bin 41096 -> 41096 bytes bootstrap/lib/stdlib/ebin/supervisor.beam | Bin 18064 -> 18136 bytes 17 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam index 2679b0993f..c14ccc2e7b 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_asm.beam and b/bootstrap/lib/compiler/ebin/beam_asm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam index 49b49871dd..0d4f028d48 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_disasm.beam and b/bootstrap/lib/compiler/ebin/beam_disasm.beam differ diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam index da1d7a2922..4985e3d6da 100644 Binary files a/bootstrap/lib/compiler/ebin/compile.beam and b/bootstrap/lib/compiler/ebin/compile.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam index b4129dc7aa..9d1629d9d4 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam and b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam differ diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam index 55f7fbdc9d..9ed647a94b 100644 Binary files a/bootstrap/lib/kernel/ebin/code_server.beam and b/bootstrap/lib/kernel/ebin/code_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam index 873b717651..b638157e11 100644 Binary files a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam and b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam index cb028e612a..0c4607063d 100644 Binary files a/bootstrap/lib/kernel/ebin/inet.beam and b/bootstrap/lib/kernel/ebin/inet.beam differ diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam index c2592e3dbc..67a8554abe 100644 Binary files a/bootstrap/lib/stdlib/ebin/beam_lib.beam and b/bootstrap/lib/stdlib/ebin/beam_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam index 9cd59e7a76..b53a1357ff 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets.beam and b/bootstrap/lib/stdlib/ebin/dets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam index 6435fcbab5..deb6b97657 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_compile.beam and b/bootstrap/lib/stdlib/ebin/erl_compile.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam index 592989520b..07e7f2a377 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_internal.beam and b/bootstrap/lib/stdlib/ebin/erl_internal.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index c2b6549490..c0c8cd7cdd 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index d885821f52..097c378dbd 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam index e1542991b2..886bba634c 100644 Binary files a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam and b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam index c0c236fecb..f22f936f42 100644 Binary files a/bootstrap/lib/stdlib/ebin/otp_internal.beam and b/bootstrap/lib/stdlib/ebin/otp_internal.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam index 90bbb671eb..b1bc6498a6 100644 Binary files a/bootstrap/lib/stdlib/ebin/sofs.beam and b/bootstrap/lib/stdlib/ebin/sofs.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index b9d50e231b..54ff535fc3 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ -- cgit v1.2.3 From 9bb4ba879b613fc1986ac37c027a16884f3814fe Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Wed, 10 Nov 2010 20:00:52 +0200 Subject: Add '-callback' attributes in stdlib's behaviours Replace the behaviour_info(callbacks) export in stdlib's behaviours with -callback' attributes for all the callbacks. --- lib/stdlib/src/gen_event.erl | 75 +++++++++++++++--------------------- lib/stdlib/src/gen_fsm.erl | 41 +++++++++++++++----- lib/stdlib/src/gen_server.erl | 35 ++++++++++++----- lib/stdlib/src/supervisor.erl | 16 +++----- lib/stdlib/src/supervisor_bridge.erl | 9 ++--- 5 files changed, 98 insertions(+), 78 deletions(-) diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index d1dd074fba..9879b76391 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -36,8 +36,6 @@ add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). --export([behaviour_info/1]). - -export([init_it/6, system_continue/3, system_terminate/4, @@ -60,14 +58,6 @@ %%% API %%%========================================================================= --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_event,2},{handle_call,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. - %% gen_event:start(Handler) -> {ok, Pid} | {error, What} %% gen_event:add_handler(Handler, Mod, Args) -> ok | Other %% gen_event:notify(Handler, Event) -> ok @@ -78,41 +68,36 @@ behaviour_info(_Other) -> %% gen_event:which_handler(Handler) -> [Mod] %% gen_event:stop(Handler) -> ok - -%% handlers must export -%% Mod:init(Args) -> {ok, State} | Other -%% Mod:handle_event(Event, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_info(Info, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_call(Query, State) -> -%% {ok, Reply, State'} | {remove_handler, Reply} | -%% {swap_handler, Reply, Args1,State1,Mod2,Args2} -%% Mod:terminate(Args, State) -> Val - - -%% add_handler(H, Mod, Args) -> ok | Other -%% Mod:init(Args) -> {ok, State} | Other - -%% delete_handler(H, Mod, Args) -> Val -%% Mod:terminate(Args, State) -> Val - -%% notify(H, Event) -%% Mod:handle_event(Event, State) -> -%% {ok, State1} -%% remove_handler -%% Mod:terminate(remove_handler, State) is called -%% the return value is ignored -%% {swap_handler, Args1, State1, Mod2, Args2} -%% State2 = Mod:terminate(Args1, State1) is called -%% the return value is chained into the new module and -%% Mod2:init({Args2, State2}) is called -%% Other -%% Mod:terminate({error, Other}, State) is called -%% The return value is ignored -%% call(H, Mod, Query) -> Val -%% call(H, Mod, Query, Timeout) -> Val -%% Mod:handle_call(Query, State) -> as above +-callback init(InitArgs :: term()) -> + {ok, State :: term()} | + {ok, State :: term(), hibernate}. +-callback handle_event(Event :: term(), State :: term()) -> + {ok, NewState :: term()} | + {ok, NewState :: term(), hibernate} | + {swap_handler, Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler. +-callback handle_call(Request :: term(), State :: term()) -> + {ok, Reply :: term(), NewState :: term()} | + {ok, Reply :: term(), NewState :: term(), hibernate} | + {swap_handler, Reply :: term(), Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + {remove_handler, Reply :: term()}. +-callback handle_info(Info :: term(), State :: term()) -> + {ok, NewState :: term()} | + {ok, NewState :: term(), hibernate} | + {swap_handler, Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler. +-callback terminate(Args :: (term() | {stop, Reason :: term()} | + stop | remove_handler | + {error, {'EXIT', Reason :: term()}} | + {error, term()}), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), + State :: term(), Extra :: term()) -> + {ok, NewState :: term()}. %%--------------------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index ea21136bdb..3db8c9f4f2 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -113,8 +113,6 @@ start_timer/2,send_event_after/2,cancel_timer/1, enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/6]). --export([behaviour_info/1]). - %% Internal exports -export([init_it/6, system_continue/3, @@ -128,13 +126,38 @@ %%% Interface functions. %%% --------------------------------------------------- --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_event,3},{handle_sync_event,4},{handle_info,3}, - {terminate,3},{code_change,4}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, StateName :: atom(), StateData :: term()} | + {ok, StateName :: atom(), StateData :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_event(Event :: term(), StateName :: atom(), + StateData :: term()) -> + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: term(), NewStateData :: term()}. +-callback handle_sync_event(Event :: term(), From :: {pid(), Tag :: term()}, + StateName :: atom(), StateData :: term()) -> + {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term()} | + {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewStateData :: term()} | + {stop, Reason :: term(), NewStateData :: term()}. +-callback handle_info(Info :: term(), StateName :: atom(), + StateData :: term()) -> + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: normal | term(), NewStateData :: term()}. +-callback terminate(Reason :: normal | shutdown | {shutdown, term()} + | term(), StateName :: atom(), StateData :: term()) -> + term(). +-callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(), + StateData :: term(), Extra :: term()) -> + {ok, NextStateName :: atom(), NewStateData :: term()}. %%% --------------------------------------------------- %%% Starts a generic state machine. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index b8ea3a4de2..dd0ef74f30 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -94,8 +94,6 @@ multi_call/2, multi_call/3, multi_call/4, enter_loop/3, enter_loop/4, enter_loop/5, wake_hib/5]). --export([behaviour_info/1]). - %% System exports -export([system_continue/3, system_terminate/4, @@ -111,13 +109,32 @@ %%% API %%%========================================================================= --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: term()) -> + {reply, Reply :: term(), NewState :: term()} | + {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: term()} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_cast(Request :: term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_info(Info :: timeout() | term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. +-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), + Extra :: term()) -> + {ok, NewState :: term()}. %%% ----------------------------------------------------------------- %%% Starts a generic server. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 36cc7f4f4b..9da0d52f8c 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -27,8 +27,6 @@ which_children/1, count_children/1, check_childspecs/1]). --export([behaviour_info/1]). - %% Internal exports -export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]). -export([handle_cast/2]). @@ -90,14 +88,12 @@ -define(is_simple(State), State#state.strategy =:= simple_one_for_one). -%%-------------------------------------------------------------------------- - --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, {{RestartStrategy :: strategy(), + MaxR :: non_neg_integer(), + MaxT :: non_neg_integer()}, + [ChildSpec :: child_spec()]}} + | ignore. %%% --------------------------------------------------- %%% This is a general process supervisor built upon gen_server.erl. diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl index 555cb5a66f..e8405ab9a4 100644 --- a/lib/stdlib/src/supervisor_bridge.erl +++ b/lib/stdlib/src/supervisor_bridge.erl @@ -22,15 +22,14 @@ %% External exports -export([start_link/2, start_link/3]). --export([behaviour_info/1]). %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). -export([code_change/3]). -behaviour_info(callbacks) -> - [{init,1},{terminate,2}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, Pid :: pid(), State :: term()} | ignore | {error, Error :: term()}. +-callback terminate(Reason :: (shutdown | term()), State :: term()) -> + Ignored :: term(). %%%----------------------------------------------------------------- %%% This is a rewrite of supervisor_bridge from BS.3. -- cgit v1.2.3 From 1d3544d9b5c4bc2cad99b220f44aa370703dbc6b Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Tue, 8 Jun 2010 23:19:13 +0300 Subject: Add callback specs to inets_service module following possibly deprecated comments --- lib/inets/src/inets_app/inets_service.erl | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/lib/inets/src/inets_app/inets_service.erl b/lib/inets/src/inets_app/inets_service.erl index e9eb9892f2..f89dac195c 100644 --- a/lib/inets/src/inets_app/inets_service.erl +++ b/lib/inets/src/inets_app/inets_service.erl @@ -20,24 +20,20 @@ -module(inets_service). --export([behaviour_info/1]). - -behaviour_info(callbacks) -> - [{start_standalone, 1}, - {start_service, 1}, - {stop_service, 1}, - {services, 0}, - {service_info, 1}]; -behaviour_info(_) -> - undefined. - %% Starts service stand-alone %% start_standalone(Config) -> % {ok, Pid} | {error, Reason} %% :start_link(Config). +-callback start_standalone(Config :: term()) -> + {ok, pid()} | {error, Reason :: term()}. + %% Starts service as part of inets %% start_service(Config) -> % {ok, Pid} | {error, Reason} %% :start_child(Config). + +-callback start_service(Config :: term()) -> + {ok, pid()} | {error, Reason :: term()}. + %% Stop service %% stop_service(Pid) -> % ok | {error, Reason} %% :stop_child(maybe_map_pid_to_other_ref(Pid)). @@ -51,6 +47,9 @@ behaviour_info(_) -> %% Error %% end. +-callback stop_service(Service :: term()) -> + ok | {error, Reason :: term()}. + %% Returns list of running services. Services started as stand alone %% are not listed %% services() -> % [{Service, Pid}] @@ -59,7 +58,12 @@ behaviour_info(_) -> %% [{httpc, Pid} || {_, Pid, _, _} <- %% supervisor:which_children(httpc_profile_sup)]. +-callback services() -> + [{Service :: term(), pid()}]. -%% service_info() -> [{Property, Value}] | {error, Reason} +%% service_info() -> {ok, [{Property, Value}]} | {error, Reason} %% ex: httpc:service_info() -> [{profile, ProfileName}] %% httpd:service_info() -> [{host, Host}, {port, Port}] + +-callback service_info(Service :: term()) -> + {ok, [{Property :: term(), Value :: term()}]} | {error, Reason :: term()}. -- cgit v1.2.3 From 3ae841405f4005b52950a74727578deea2aee209 Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Tue, 8 Jun 2010 23:53:43 +0300 Subject: Add callback specs to tftp module following internet documentation --- lib/inets/src/tftp/tftp.erl | 47 +++++++++++++++++++++++++++++++++++++++------ 1 file changed, 41 insertions(+), 6 deletions(-) diff --git a/lib/inets/src/tftp/tftp.erl b/lib/inets/src/tftp/tftp.erl index bfdb4c0030..b33c0a98f4 100644 --- a/lib/inets/src/tftp/tftp.erl +++ b/lib/inets/src/tftp/tftp.erl @@ -215,8 +215,6 @@ start/0 ]). --export([behaviour_info/1]). - %% Application local functions -export([ start_standalone/1, @@ -227,13 +225,50 @@ ]). -behaviour_info(callbacks) -> - [{prepare, 6}, {open, 6}, {read, 1}, {write, 2}, {abort, 3}]; -behaviour_info(_) -> - undefined. +-type peer() :: {PeerType :: inet | inet6, + PeerHost :: inet:ip_address(), + PeerPort :: port()}. + +-type access() :: read | write. + +-type options() :: [{Key :: string(), Value :: string()}]. + +-type error_code() :: undef | enoent | eacces | enospc | + badop | eexist | baduser | badopt | + integer(). + +-callback prepare(Peer :: peer(), + Access :: access(), + Filename :: file:name(), + Mode :: string(), + SuggestedOptions :: options(), + InitialState :: [] | [{root_dir, string()}]) -> + {ok, AcceptedOptions :: options(), NewState :: term()} | + {error, {Code :: error_code(), string()}}. + +-callback open(Peer :: peer(), + Access :: access(), + Filename :: file:name(), + Mode :: string(), + SuggestedOptions :: options(), + State :: [] | [{root_dir, string()}] | term()) -> + {ok, AcceptedOptions :: options(), NewState :: term()} | + {error, {Code :: error_code(), string()}}. + +-callback read(State :: term()) -> {more, binary(), NewState :: term()} | + {last, binary(), integer()} | + {error, {Code :: error_code(), string()}}. + +-callback write(binary(), State :: term()) -> + {more, NewState :: term()} | + {last, FileSize :: integer()} | + {error, {Code :: error_code(), string()}}. + +-callback abort(Code :: error_code(), string(), State :: term()) -> 'ok'. -include("tftp.hrl"). + %%------------------------------------------------------------------- %% read_file(RemoteFilename, LocalFilename, Options) -> %% {ok, LastCallbackState} | {error, Reason} -- cgit v1.2.3 From ed72d05e27fcf1d4f649014ffd7a1c2878b5b010 Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Tue, 8 Jun 2010 20:55:26 +0300 Subject: Add callback specs into 'application' module in kernel --- lib/kernel/src/application.erl | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index fa3a4c3d36..caac4d926c 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -28,8 +28,6 @@ -export([get_application/0, get_application/1, info/0]). -export([start_type/0]). --export([behaviour_info/1]). - %%%----------------------------------------------------------------- -type start_type() :: 'normal' @@ -59,12 +57,12 @@ %%------------------------------------------------------------------ --spec behaviour_info(atom()) -> 'undefined' | [{atom(), byte()}]. +-callback start(StartType :: normal | {takeover, node()} | {failover, node()}, + StartArgs :: term()) -> + {ok, pid()} | {ok, pid(), State :: term()} | {error, Reason :: term}. -behaviour_info(callbacks) -> - [{start,2},{stop,1}]; -behaviour_info(_Other) -> - undefined. +-callback stop(State :: term()) -> + term(). %%%----------------------------------------------------------------- %%% This module is API towards application_controller and -- cgit v1.2.3 From ac2810603b7aaad24129fadf887d9e8deff31d2f Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 7 Oct 2011 16:26:45 +0200 Subject: Make testsuites more robust in case of init failure In particular, move code out of init_per_suite since failure causes end_per_suite to be skipped. Cleanup is simpler if both init and cleanup happen as testcases. --- lib/diameter/test/diameter_relay_SUITE.erl | 207 +++++++++++++------------ lib/diameter/test/diameter_traffic_SUITE.erl | 94 ++++++----- lib/diameter/test/diameter_transport_SUITE.erl | 17 +- lib/diameter/test/diameter_util.erl | 23 ++- 4 files changed, 197 insertions(+), 144 deletions(-) diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index d3d1fe690a..60babd0b9a 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -37,20 +37,22 @@ all/0, groups/0, init_per_group/2, - end_per_group/2, - init_per_suite/1, - end_per_suite/1]). + end_per_group/2]). %% testcases --export([send1/1, +-export([start/1, + start_services/1, + connect/1, + send1/1, send2/1, send3/1, send4/1, send_loop/1, send_timeout_1/1, send_timeout_2/1, - remove_transports/1, - stop_services/1]). + disconnect/1, + stop_services/1, + stop/1]). %% diameter callbacks -export([peer_up/3, @@ -73,6 +75,8 @@ %% =========================================================================== +-define(util, diameter_util). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT.REALM1"). @@ -83,6 +87,10 @@ -define(SERVER3, "SERVER1.REALM3"). -define(SERVER4, "SERVER2.REALM3"). +-define(SERVICES, [?CLIENT, + ?RELAY1, ?RELAY2, + ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4]). + -define(DICT_COMMON, ?DIAMETER_DICT_COMMON). -define(DICT_RELAY, ?DIAMETER_DICT_RELAY). @@ -131,13 +139,15 @@ suite() -> [{timetrap, {seconds, 10}}]. all() -> - [{group, N} || {N, _, _} <- groups()] - ++ [remove_transports, stop_services]. + [start, start_services, connect] + ++ tc() + ++ [{group, all}, + disconnect, + stop_services, + stop]. groups() -> - Ts = tc(), - [{all, [], Ts}, - {p, [parallel], Ts}]. + [{all, [parallel], tc()}]. init_per_group(_, Config) -> Config. @@ -145,32 +155,7 @@ init_per_group(_, Config) -> end_per_group(_, _) -> ok. -init_per_suite(Config) -> - ok = diameter:start(), - [S1,S2,S3,S4] = S = [server(N, ?DICT_COMMON) || N <- [?SERVER1, - ?SERVER2, - ?SERVER3, - ?SERVER4]], - [R1,R2] = R = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]], - - ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), - - true = diameter:subscribe(?RELAY1), - true = diameter:subscribe(?RELAY2), - true = diameter:subscribe(?CLIENT), - - [C1,C2] = connect(?RELAY1, [S1,S2]), - [C3,C4] = connect(?RELAY2, [S3,S4]), - [C5,C6] = connect(?CLIENT, [R1,R2]), - - C7 = connect(?RELAY1, R2), - - [{transports, {S, R, [C1,C2,C3,C4,C5,C6,C7]}} | Config]. - -end_per_suite(_Config) -> - ok = diameter:stop(). - -%% Testcases to run when services are started and connections +%% Traffic cases run when services are started and connections %% established. tc() -> [send1, @@ -181,43 +166,65 @@ tc() -> send_timeout_1, send_timeout_2]. -server(Host, Dict) -> - ok = diameter:start_service(Host, ?SERVICE(Host, Dict)), - {ok, LRef} = diameter:add_transport(Host, ?LISTEN), - {LRef, portnr(LRef)}. +%% =========================================================================== +%% start/stop testcases -connect(Host, {_LRef, PortNr}) -> - {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)), - ok = receive - #diameter_event{service = Host, - info = {up, Ref, _, _, #diameter_packet{}}} -> - ok - after 2000 -> - false - end, - Ref; -connect(Host, Ports) -> - [connect(Host, P) || P <- Ports]. +start(_Config) -> + ok = diameter:start(). -portnr(LRef) -> - portnr(LRef, 20). +start_services(_Config) -> + S = [server(N, ?DICT_COMMON) || N <- [?SERVER1, + ?SERVER2, + ?SERVER3, + ?SERVER4]], + R = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]], -portnr(LRef, N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of - [{T, _Pid}] -> - {_, _, {LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = inet:port(LSock), - PortNr; - [] -> - receive after 50 -> ok end, - portnr(LRef, N-1) - end. + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), -realm(Host) -> - tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + {save_config, S ++ R}. + +connect(Config) -> + {_, [S1,S2,S3,S4,R1,R2] = SR} = proplists:get_value(saved_config, Config), + + true = diameter:subscribe(?RELAY1), + true = diameter:subscribe(?RELAY2), + true = diameter:subscribe(?CLIENT), + + [R1S1,R1S2] = connect(?RELAY1, [S1,S2]), + [R2S3,R2S4] = connect(?RELAY2, [S3,S4]), + [CR1,CR2] = connect(?CLIENT, [R1,R2]), + + R1R2 = connect(?RELAY1, R2), + + ?util:write_priv(Config, "cfg", SR ++ [R1S1,R1S2,R2S3,R2S4,CR1,CR2,R1R2]). + +%% Remove the client transports and expect the corresponding server +%% transport to go down. +disconnect(Config) -> + [S1,S2,S3,S4,R1,R2,R1S1,R1S2,R2S3,R2S4,CR1,CR2,R1R2] + = ?util:read_priv(Config, "cfg"), + + [?CLIENT | Svcs] = ?SERVICES, + [] = [{S,T} || S <- Svcs, T <- [diameter:subscribe(S)], T /= true], + + disconnect(?RELAY1, S1, R1S1), + disconnect(?RELAY1, S2, R1S2), + disconnect(?RELAY2, S3, R2S3), + disconnect(?RELAY2, S4, R2S4), + disconnect(?CLIENT, R1, CR1), + disconnect(?CLIENT, R2, CR2), + disconnect(?RELAY1, R2, R1R2). + +stop_services(_Config) -> + [] = [{H,T} || H <- ?SERVICES, + T <- [diameter:stop_service(H)], + T /= ok]. + +stop(_Config) -> + ok = diameter:stop(). %% =========================================================================== +%% traffic testcases %% Send an STR intended for a specific server and expect success. send1(_Config) -> @@ -254,40 +261,50 @@ send_timeout(Tmo) -> {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}], call(Req, [{filter, realm}, {timeout, Tmo}]). -%% Remove the client transports and expect the corresponding server -%% transport to go down. -remove_transports(Config) -> - {[S1,S2,S3,S4], [R1,R2], [C1,C2,C3,C4,C5,C6,C7]} - = proplists:get_value(transports, Config), - - true = diameter:subscribe(?SERVER1), - true = diameter:subscribe(?SERVER2), - true = diameter:subscribe(?SERVER3), - true = diameter:subscribe(?SERVER4), - true = diameter:subscribe(?RELAY1), - true = diameter:subscribe(?RELAY2), +%% =========================================================================== + +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + +server(Host, Dict) -> + ok = diameter:start_service(Host, ?SERVICE(Host, Dict)), + {ok, LRef} = diameter:add_transport(Host, ?LISTEN), + {LRef, portnr(LRef)}. + +portnr(LRef) -> + portnr(LRef, 20). + +portnr(LRef, N) + when 0 < N -> + case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of + [{T, _Pid}] -> + {_, _, {LRef, {_Addr, LSock}}} = T, + {ok, PortNr} = inet:port(LSock), + PortNr; + [] -> + receive after 50 -> ok end, + portnr(LRef, N-1) + end. - disconnect(S1, ?RELAY1, C1), - disconnect(S2, ?RELAY1, C2), - disconnect(S3, ?RELAY2, C3), - disconnect(S4, ?RELAY2, C4), - disconnect(R1, ?CLIENT, C5), - disconnect(R2, ?CLIENT, C6), - disconnect(R2, ?RELAY1, C7). +connect(Host, {_LRef, PortNr}) -> + {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)), + ok = receive + #diameter_event{service = Host, + info = {up, Ref, _, _, #diameter_packet{}}} -> + ok + after 2000 -> + false + end, + Ref; +connect(Host, Ports) -> + [connect(Host, P) || P <- Ports]. -disconnect({LRef, _PortNr}, Client, CRef) -> +disconnect(Client, {LRef, _PortNr}, CRef) -> ok = diameter:remove_transport(Client, CRef), ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok after 2000 -> false end. -stop_services(_Config) -> - S = [?CLIENT, ?RELAY1, ?RELAY2, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4], - Ok = [ok || _ <- S], - Ok = [diameter:stop_service(H) || H <- S]. - -%% =========================================================================== - call(Server) -> Realm = realm(Server), Req = ['STR', {'Destination-Realm', Realm}, diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 8c85323222..f6905473b7 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -26,15 +26,16 @@ -export([suite/0, all/0, groups/0, - init_per_suite/1, - end_per_suite/1, init_per_group/2, end_per_group/2, init_per_testcase/2, end_per_testcase/2]). %% testcases --export([result_codes/1, +-export([start/1, + start_services/1, + add_transports/1, + result_codes/1, send_ok/1, send_arbitrary/1, send_unknown/1, @@ -73,7 +74,8 @@ send_multiple_filters_3/1, send_anything/1, remove_transports/1, - stop_services/1]). + stop_services/1, + stop/1]). %% diameter callbacks -export([peer_up/3, @@ -96,6 +98,8 @@ %% =========================================================================== +-define(util, diameter_util). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT"). @@ -177,30 +181,18 @@ suite() -> [{timetrap, {seconds, 10}}]. all() -> - [result_codes | [{group, N} || {N, _, _} <- groups()]] - ++ [remove_transports, stop_services]. + [start, start_services, add_transports, result_codes + | [{group, N} || {N, _, _} <- groups()]] + ++ [remove_transports, stop_services, stop]. groups() -> Ts = tc(), - [{E, [], Ts} || E <- ?ENCODINGS] - ++ [{?P(E), [parallel], Ts} || E <- ?ENCODINGS]. + [{grp(E,P), P, Ts} || E <- ?ENCODINGS, P <- [[], [parallel]]]. -init_per_suite(Config) -> - ok = diameter:start(), - ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), - ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)), - {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN), - true = diameter:subscribe(?CLIENT), - {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(portnr())), - {up, CRef, _Peer, _Config, #diameter_packet{}} - = receive #diameter_event{service = ?CLIENT, info = I} -> I - after 2000 -> false - end, - true = diameter:unsubscribe(?CLIENT), - [{transports, {LRef, CRef}} | Config]. - -end_per_suite(_Config) -> - ok = diameter:stop(). +grp(E, []) -> + E; +grp(E, [parallel]) -> + ?P(E). init_per_group(Name, Config) -> E = case ?L(Name) of @@ -276,6 +268,45 @@ portnr(N) portnr(N-1) end. +%% =========================================================================== +%% start/stop testcases + +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). + +add_transports(Config) -> + {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN), + true = diameter:subscribe(?CLIENT), + {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(portnr())), + {up, CRef, _Peer, _Cfg, #diameter_packet{}} + = receive #diameter_event{service = ?CLIENT, info = I} -> I + after 2000 -> false + end, + true = diameter:unsubscribe(?CLIENT), + ?util:write_priv(Config, "transport", {LRef, CRef}). + +%% Remove the client transport and expect the server transport to +%% go down. +remove_transports(Config) -> + {LRef, CRef} = ?util:read_priv(Config, "transport"), + true = diameter:subscribe(?SERVER), + ok = diameter:remove_transport(?CLIENT, CRef), + {down, LRef, _, _} + = receive #diameter_event{service = ?SERVER, info = I} -> I + after 2000 -> false + end. + +stop_services(_Config) -> + ok = diameter:stop_service(?CLIENT), + ok = diameter:stop_service(?SERVER). + +stop(_Config) -> + ok = diameter:stop(). + %% =========================================================================== %% Ensure that result codes have the expected values. @@ -532,21 +563,6 @@ send_anything(Config) -> #diameter_base_STA{'Result-Code' = ?SUCCESS} = call(Config, anything). -%% Remove the client transport and expect the server transport to -%% go down. -remove_transports(Config) -> - {LRef, CRef} = proplists:get_value(transports, Config), - true = diameter:subscribe(?SERVER), - ok = diameter:remove_transport(?CLIENT, CRef), - {down, LRef, _, _} - = receive #diameter_event{service = ?SERVER, info = I} -> I - after 2000 -> false - end. - -stop_services(_Config) -> - {ok, ok} = {diameter:stop_service(?CLIENT), - diameter:stop_service(?SERVER)}. - %% =========================================================================== call(Config, Req) -> diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index d545859fe8..064e5caa67 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -33,10 +33,12 @@ end_per_suite/1]). %% testcases --export([tcp_accept/1, +-export([start/1, + tcp_accept/1, tcp_connect/1, sctp_accept/1, - sctp_connect/1]). + sctp_connect/1, + stop/1]). -export([accept/1, connect/1, @@ -101,7 +103,7 @@ suite() -> [{timetrap, {minutes, 2}}]. all() -> - [{group, all} | tc()]. + [start | tc()] ++ [{group, all}, stop]. groups() -> [{all, [parallel], tc()}]. @@ -119,10 +121,17 @@ end_per_group(_, _) -> ok. init_per_suite(Config) -> - ok = diameter:start(), [{sctp, have_sctp()} | Config]. end_per_suite(_Config) -> + ok. + +%% =========================================================================== + +start(_Config) -> + ok = diameter:start(). + +stop(_Config) -> ok = diameter:stop(). %% =========================================================================== diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 99f4fa1977..f9942c3408 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -28,7 +28,8 @@ fold/3, foldl/3, scramble/1, - ps/0]). + write_priv/3, + read_priv/2]). -define(L, atom_to_list). @@ -150,11 +151,6 @@ s(Acc, L) -> {H, [T|Rest]} = lists:split(random:uniform(length(L)) - 1, L), s([T|Acc], H ++ Rest). -%% ps/0 - -ps() -> - [{P, process_info(P)} || P <- erlang:processes()]. - %% eval/1 eval({M,[F|A]}) @@ -175,3 +171,18 @@ eval(L) eval(F) when is_function(F,0) -> F(). + +%% write_priv/3 + +write_priv(Config, Name, Term) -> + Dir = proplists:get_value(priv_dir, Config), + Path = filename:join([Dir, Name]), + ok = file:write_file(Path, term_to_binary(Term)). + +%% read_priv/2 + +read_priv(Config, Name) -> + Dir = proplists:get_value(priv_dir, Config), + Path = filename:join([Dir, Name]), + {ok, Bin} = file:read_file(Path), + binary_to_term(Bin). -- cgit v1.2.3 From 5dcee558b61f0f5dd70e18a530a2bb97c479aab5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 4 Sep 2011 07:58:30 +0200 Subject: Pre-build the tuples returned by os:type/0 and os:version/0 Pre-building the tuples returned by os:type/0 (system_info(os_type)) and os:version() (system_info(os_version)) saves some run-time and avoids building garbage in the calling process. --- erts/emulator/beam/erl_bif_info.c | 48 +++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 20 deletions(-) diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index e17325b64f..de5e4046fa 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -119,6 +119,10 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE # define PERFMON_GETPCR _IOR('P', 2, unsigned long long) #endif +/* Cached, pre-built {OsType,OsFlavor} and {Major,Minor,Build} tuples */ +static Eterm os_type_tuple; +static Eterm os_version_tuple; + static Eterm current_function(Process* p, Process* rp, Eterm** hpp, int full_info); static Eterm current_stacktrace(Process* p, Process* rp, Eterm** hpp); @@ -2227,16 +2231,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) return erts_instr_get_type_info(BIF_P); } else if (BIF_ARG_1 == am_os_type) { - Eterm type = am_atom_put(os_type, strlen(os_type)); - Eterm flav, tup; - char *buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ - - os_flavor(buf, 1024); - flav = am_atom_put(buf, strlen(buf)); - hp = HAlloc(BIF_P, 3); - tup = TUPLE2(hp, type, flav); - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_RET(tup); + BIF_RET(os_type_tuple); } else if (BIF_ARG_1 == am_allocator) { BIF_RET(erts_allocator_options((void *) BIF_P)); @@ -2262,16 +2257,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(am_false); } else if (BIF_ARG_1 == am_os_version) { - int major, minor, build; - Eterm tup; - - os_version(&major, &minor, &build); - hp = HAlloc(BIF_P, 4); - tup = TUPLE3(hp, - make_small(major), - make_small(minor), - make_small(build)); - BIF_RET(tup); + BIF_RET(os_version_tuple); } else if (BIF_ARG_1 == am_version) { int n = strlen(ERLANG_VERSION); @@ -4107,6 +4093,27 @@ BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } +static void os_info_init(void) +{ + Eterm type = am_atom_put(os_type, strlen(os_type)); + Eterm flav; + int major, minor, build; + char* buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ + Eterm* hp; + + os_flavor(buf, 1024); + flav = am_atom_put(buf, strlen(buf)); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm)); + os_type_tuple = TUPLE2(hp, type, flav); + hp += 3; + os_version(&major, &minor, &build); + os_version_tuple = TUPLE3(hp, + make_small(major), + make_small(minor), + make_small(build)); +} + void erts_bif_info_init(void) { @@ -4114,4 +4121,5 @@ erts_bif_info_init(void) erts_smp_atomic_init_nob(&hipe_test_reschedule_flag, 0); process_info_init(); + os_info_init(); } -- cgit v1.2.3 From 8f4523c56f243aa4fc4ff4415f89dd1924e49d62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 4 Sep 2011 08:10:52 +0200 Subject: sys.c for Unix: Undo caching of utsname in os_flavor() Since his function will be called only once, caching is a waste of memory. --- erts/emulator/sys/unix/sys.c | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 82d2c64d81..d7f8ac60a9 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -931,18 +931,13 @@ void os_flavor(char* namebuf, /* Where to return the name. */ unsigned size) /* Size of name buffer. */ { - static int called = 0; - static struct utsname uts; /* Information about the system. */ - - if (!called) { - char* s; + struct utsname uts; /* Information about the system. */ + char* s; - (void) uname(&uts); - called = 1; - for (s = uts.sysname; *s; s++) { - if (isupper((int) *s)) { - *s = tolower((int) *s); - } + (void) uname(&uts); + for (s = uts.sysname; *s; s++) { + if (isupper((int) *s)) { + *s = tolower((int) *s); } } strcpy(namebuf, uts.sysname); -- cgit v1.2.3 From 44d3cf7625aa869829c59567d8fc6403eb0a1518 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 4 Sep 2011 09:20:11 +0200 Subject: Optimize filename:extension/1 to produce less garbage Simply return a tail of the flattened filename. --- lib/stdlib/src/filename.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 1cb9e4a25e..b9665d7dec 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -369,8 +369,8 @@ extension(Name0) -> Name = flatten(Name0), extension(Name, [], major_os_type()). -extension([$.|Rest], _Result, OsType) -> - extension(Rest, [$.], OsType); +extension([$.|Rest]=Result, _Result, OsType) -> + extension(Rest, Result, OsType); extension([Char|Rest], [], OsType) when is_integer(Char) -> extension(Rest, [], OsType); extension([$/|Rest], _Result, OsType) -> @@ -378,9 +378,9 @@ extension([$/|Rest], _Result, OsType) -> extension([$\\|Rest], _Result, win32) -> extension(Rest, [], win32); extension([Char|Rest], Result, OsType) when is_integer(Char) -> - extension(Rest, [Char|Result], OsType); + extension(Rest, Result, OsType); extension([], Result, _OsType) -> - lists:reverse(Result). + Result. %% Joins a list of filenames with directory separators. -- cgit v1.2.3 From fb76a9149fddd06c5d06f2199193a4f976256533 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Thu, 6 Oct 2011 12:05:36 +0200 Subject: gen_sctp:open/0-2 might return {error, eprotonosupport} Previously error:badarg was raise if there was no underlying support for SCTP. Handle both new and old failure until OTP-9239 is merged. --- lib/diameter/test/diameter_transport_SUITE.erl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index d545859fe8..6ae06266f6 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -180,7 +180,9 @@ have_sctp() -> try gen_sctp:open() of {ok, Sock} -> gen_sctp:close(Sock), - true + true; + {error, eprotonosupport} -> %% fail on any other reason + false catch error: badarg -> false -- cgit v1.2.3 From 942e68d3f93ce686a16d27716892e7c0d2e5872b Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 7 Oct 2011 17:01:06 +0200 Subject: Move init/end_per_suite into testcases See ac2810603b7aaad24129fadf887d9e8deff31d2f. --- lib/diameter/test/diameter_tls_SUITE.erl | 103 ++++++++++++++++++++----------- 1 file changed, 66 insertions(+), 37 deletions(-) diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index c0a9603e04..90e32c834f 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -42,13 +42,19 @@ end_per_suite/1]). %% testcases --export([send1/1, +-export([start_ssl/1, + start_diameter/1, + start_services/1, + add_transports/1, + send1/1, send2/1, send3/1, send4/1, send5/1, remove_transports/1, - stop_services/1]). + stop_services/1, + stop_diameter/1, + stop_ssl/1]). %% diameter callbacks -export([peer_up/3, @@ -71,6 +77,8 @@ %% =========================================================================== +-define(util, diameter_util). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT.REALM0"). @@ -129,8 +137,12 @@ suite() -> [{timetrap, {seconds, 15}}]. all() -> - [{group, N} || {N, _, _} <- groups()] - ++ [remove_transports, stop_services]. + [start_ssl, + start_diameter, + start_services, + add_transports] + ++ [{group, N} || {N, _, _} <- groups()] + ++ [remove_transports, stop_services, stop_diameter, stop_ssl]. groups() -> Ts = tc(), @@ -144,42 +156,71 @@ end_per_group(_, _) -> ok. init_per_suite(Config) -> - init(os:find_executable("openssl"), Config). + case os:find_executable("openssl") of + false -> + {skip, no_openssl}; + _ -> + Config + end. + +end_per_suite(_Config) -> + ok. + +%% Testcases to run when services are started and connections +%% established. +tc() -> + [send1, + send2, + send3, + send4, + send5]. + +%% =========================================================================== +%% testcases + +start_ssl(_Config) -> + ok = ssl:start(). -init(false, _) -> - {skip, no_openssl}; -init(_, Config) -> - ok = ssl:start(), - ok = diameter:start(), +start_diameter(_Config) -> + ok = diameter:start(). +start_services(Config) -> Dir = proplists:get_value(priv_dir, Config), Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS], ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + {save_config, [Dir | Servers]}. + +add_transports(Config) -> + {_, [Dir | Servers]} = proplists:get_value(saved_config, Config), + true = diameter:subscribe(?CLIENT), Opts = ssl_options(Dir, "client"), Connections = [connect(?CLIENT, S, copts(N, Opts)) || {S,N} <- lists:zip(Servers, ?SERVERS)], - [{transports, lists:zip(Servers, Connections)} | Config]. + ?util:write_priv(Config, "cfg", lists:zip(Servers, Connections)). -end_per_suite(_Config) -> - ok = diameter:stop(), - ok = ssl:stop(). -%% Testcases to run when services are started and connections -%% established. These are trivial, the interesting stuff is setting up -%% the connections in init_per_suite/2. -tc() -> - [send1, - send2, - send3, - send4, - send5]. +%% Remove the client transports and expect the corresponding server +%% transport to go down. +remove_transports(Config) -> + Ts = ?util:read_priv(Config, "cfg"), + [] = [T || S <- ?SERVERS, T <- [diameter:subscribe(S)], T /= true], + lists:map(fun disconnect/1, Ts). -%% =========================================================================== -%% testcases +stop_services(_Config) -> + [] = [{H,T} || H <- [?CLIENT | ?SERVERS], + T <- [diameter:stop_service(H)], + T /= ok]. + +stop_diameter(_Config) -> + ok = diameter:stop(). + +stop_ssl(_Config) -> + ok = ssl:stop(). %% Send an STR intended for a specific server and expect success. send1(_Config) -> @@ -193,18 +234,6 @@ send4(_Config) -> send5(_Config) -> call(?SERVER5). -%% Remove the client transports and expect the corresponding server -%% transport to go down. -remove_transports(Config) -> - Ts = proplists:get_value(transports, Config), - [] = [T || S <- ?SERVERS, T <- [diameter:subscribe(S)], T /= true], - lists:map(fun disconnect/1, Ts). - -stop_services(_Config) -> - Hs = [?CLIENT | ?SERVERS], - Ok = [ok || _ <- Hs], - Ok = [diameter:stop_service(H) || H <- Hs]. - %% =========================================================================== %% diameter callbacks -- cgit v1.2.3 From 7b4bd37903c5d740c009adc6655db0e15587681a Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 9 Oct 2011 20:33:36 +0200 Subject: Add port resolution interface to transport modules --- lib/diameter/src/transport/diameter_sctp.erl | 81 ++++++++++++++++++++++------ lib/diameter/src/transport/diameter_tcp.erl | 75 ++++++++++++++++++++++---- 2 files changed, 130 insertions(+), 26 deletions(-) diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index cb024c77b1..209f8c01c1 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -37,6 +37,9 @@ code_change/3, terminate/2]). +-export([ports/0, + ports/1]). + -include_lib("kernel/include/inet_sctp.hrl"). -include_lib("diameter/include/diameter.hrl"). @@ -118,8 +121,8 @@ s({accept, Ref} = A, Addrs, Opts) -> %% gen_sctp in order to be able to accept a new association only %% *after* an accepting transport has been spawned. -s({connect = C, _}, Addrs, Opts) -> - diameter_sctp_sup:start_child({C, self(), Opts, Addrs}). +s({connect = C, Ref}, Addrs, Opts) -> + diameter_sctp_sup:start_child({C, self(), Opts, Addrs, Ref}). %% start_link/1 @@ -149,28 +152,36 @@ i({listen, Ref, {Opts, Addrs}}) -> socket = Sock}); %% A connecting transport. -i({connect, Pid, Opts, Addrs}) -> +i({connect, Pid, Opts, Addrs, Ref}) -> {[As, Ps], Rest} = proplists:split(Opts, [raddr, rport]), RAs = [diameter_lib:ipaddr(A) || {raddr, A} <- As], [RP] = [P || {rport, P} <- Ps] ++ [P || P <- [?DEFAULT_PORT], [] == Ps], {LAs, Sock} = open(Addrs, Rest, 0), + putr(ref, Ref), proc_lib:init_ack({ok, self(), LAs}), erlang:monitor(process, Pid), #transport{parent = Pid, mode = {connect, connect(Sock, RAs, RP, [])}, socket = Sock}; +i({connect, _, _, _} = T) -> %% from old code + x(T); %% An accepting transport spawned by diameter. -i({accept, Pid, LPid, Sock}) -> +i({accept, Pid, LPid, Sock, Ref}) + when is_pid(Pid) -> + putr(ref, Ref), proc_lib:init_ack({ok, self()}), erlang:monitor(process, Pid), erlang:monitor(process, LPid), #transport{parent = Pid, mode = {accept, LPid}, socket = Sock}; +i({accept, _, _, _} = T) -> %% from old code + x(T); %% An accepting transport spawned at association establishment. i({accept, Ref, LPid, Sock, Id}) -> + putr(ref, Ref), proc_lib:init_ack({ok, self()}), MRef = erlang:monitor(process, LPid), %% Wait for a signal that the transport has been started before @@ -249,6 +260,26 @@ gen_opts(Opts) -> [[],[],[],[],[]] == L orelse ?ERROR({reserved_options, Opts}), [binary, {active, once} | Opts]. +%% --------------------------------------------------------------------------- +%% # ports/0-1 +%% --------------------------------------------------------------------------- + +ports() -> + Ts = diameter_reg:match({?MODULE, '_', '_'}), + [{type(T), N, Pid} || {{?MODULE, T, {_, {_, S}}}, Pid} <- Ts, + {ok, N} <- [inet:port(S)]]. + +ports(Ref) -> + Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}), + [{type(T), N, Pid} || {{?MODULE, T, {R, {_, S}}}, Pid} <- Ts, + R == Ref, + {ok, N} <- [inet:port(S)]]. + +type(listener) -> + listen; +type(T) -> + T. + %% --------------------------------------------------------------------------- %% # handle_call/3 %% --------------------------------------------------------------------------- @@ -256,7 +287,7 @@ gen_opts(Opts) -> handle_call({{accept, Ref}, Pid}, _, #listener{ref = Ref, count = N} = S) -> - {TPid, NewS} = accept(Pid, S), + {TPid, NewS} = accept(Ref, Pid, S), {reply, {ok, TPid}, NewS#listener{count = N+1}}; handle_call(_, _, State) -> @@ -306,6 +337,12 @@ terminate(_, #listener{socket = Sock}) -> %% --------------------------------------------------------------------------- +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + %% start_timer/1 start_timer(#listener{count = 0} = S) -> @@ -425,21 +462,27 @@ transition({'DOWN', _, process, Pid, _}, #transport{mode = {accept, Pid}}) -> %% Parent process has died. transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> - stop. + stop; + +%% Request for the local port number. +transition({resolve_port, Pid}, #transport{socket = Sock}) + when is_pid(Pid) -> + Pid ! inet:port(Sock), + ok. %% Crash on anything unexpected. -%% accept/2 +%% accept/3 %% %% Start a new transport process or use one that's already been %% started as a consequence of association establishment. %% No pending associations: spawn a new transport. -accept(Pid, #listener{socket = Sock, - tmap = T, - pending = {0,_} = Q} - = S) -> - Arg = {accept, Pid, self(), Sock}, +accept(Ref, Pid, #listener{socket = Sock, + tmap = T, + pending = {0,_} = Q} + = S) -> + Arg = {accept, Pid, self(), Sock, Ref}, {ok, TPid} = diameter_sctp_sup:start_child(Arg), MRef = erlang:monitor(process, TPid), ets:insert(T, [{MRef, TPid}, {TPid, MRef}]), @@ -450,12 +493,12 @@ accept(Pid, #listener{socket = Sock, %% Accepting transport has died. This can happen if a new transport is %% started before the DOWN has arrived. -accept(Pid, #listener{pending = [TPid | {0,_} = Q]} = S) -> +accept(Ref, Pid, #listener{pending = [TPid | {0,_} = Q]} = S) -> false = is_process_alive(TPid), %% assert - accept(Pid, S#listener{pending = Q}); + accept(Ref, Pid, S#listener{pending = Q}); %% Pending associations: attach to the first in the queue. -accept(Pid, #listener{ref = Ref, pending = {N,Q}} = S) -> +accept(_, Pid, #listener{ref = Ref, pending = {N,Q}} = S) -> TPid = ets:first(Q), TPid ! {Ref, Pid}, ets:delete(Q, TPid), @@ -507,8 +550,14 @@ recv({[], #sctp_assoc_change{state = comm_up, outbound_streams = OS, inbound_streams = IS, assoc_id = Id}}, - #transport{assoc_id = undefined} + #transport{assoc_id = undefined, + mode = {T, _}, + socket = Sock} = S) -> + Ref = getr(ref), + is_reference(Ref) %% started in new code + andalso + (true = diameter_reg:add_new({?MODULE, T, {Ref, {Id, Sock}}})), up(S#transport{assoc_id = Id, streams = {IS, OS}}); diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index 33b9daf0d9..a15c49f4a7 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -37,6 +37,9 @@ code_change/3, terminate/2]). +-export([ports/0, + ports/1]). + -include_lib("diameter/include/diameter.hrl"). -define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). @@ -130,10 +133,13 @@ i({T, Ref, Mod, Pid, Opts, Addrs}) MPid ! {stop, self()}, %% tell the monitor to die M = if SslOpts -> ssl; true -> Mod end, setopts(M, Sock), + putr(ref, Ref), #transport{parent = Pid, module = M, socket = Sock, ssl = SslOpts}; +%% Put the reference in the process dictionary since we now use it +%% advertise the ssl socket after TLS upgrade. %% A monitor process to kill the transport if the parent dies. i(#monitor{parent = Pid, transport = TPid} = S) -> @@ -181,20 +187,22 @@ i(Type, Ref, Mod, Pid, true, Opts, Addrs) -> i(Type, Ref, Mod, Pid, _, Opts, Addrs) -> i(Type, Ref, Mod, Pid, Opts, Addrs). -i(accept, Ref, Mod, Pid, Opts, Addrs) -> +i(accept = T, Ref, Mod, Pid, Opts, Addrs) -> {LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}), proc_lib:init_ack({ok, self(), [LAddr]}), Sock = ok(accept(Mod, LSock)), + true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}), diameter_peer:up(Pid), Sock; -i(connect, _, Mod, Pid, Opts, Addrs) -> +i(connect = T, Ref, Mod, Pid, Opts, Addrs) -> {[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]), LAddr = get_addr(LA, Addrs), RAddr = get_addr(RA, []), RPort = get_port(RP), proc_lib:init_ack({ok, self(), [LAddr]}), Sock = ok(connect(Mod, RAddr, RPort, gen_opts(LAddr, Rest))), + true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}), diameter_peer:up(Pid, {RAddr, RPort}), Sock. @@ -254,6 +262,43 @@ gen_opts(LAddr, Opts) -> {ip, LAddr} | Opts]. +%% --------------------------------------------------------------------------- +%% # ports/1 +%% --------------------------------------------------------------------------- + +ports() -> + Ts = diameter_reg:match({?MODULE, '_', '_'}), + [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {_,S}}, Pid} <- Ts]. + +ports(Ref) -> + Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}), + [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {R,S}}, Pid} <- Ts, + R == Ref]. + +type(listener) -> + listen; +type(T) -> + T. + +sock(listener, {_LAddr, Sock}) -> + Sock; +sock(_, Sock) -> + Sock. + +resolve(Type, S) -> + Sock = sock(Type, S), + try + ok(portnr(Sock)) + catch + _:_ -> Sock + end. + +portnr(Sock) + when is_port(Sock) -> + portnr(gen_tcp, Sock); +portnr(Sock) -> + portnr(ssl, Sock). + %% --------------------------------------------------------------------------- %% # handle_call/3 %% --------------------------------------------------------------------------- @@ -300,6 +345,12 @@ terminate(_, _) -> %% --------------------------------------------------------------------------- +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + %% start_timer/1 start_timer(#listener{count = 0} = S) -> @@ -436,10 +487,10 @@ transition({timeout, TRef, flush}, S) -> flush(TRef, S); %% Request for the local port number. -transition({resolve_port, RPid}, #transport{socket = Sock, - module = M}) - when is_pid(RPid) -> - RPid ! lport(M, Sock), +transition({resolve_port, Pid}, #transport{socket = Sock, + module = M}) + when is_pid(Pid) -> + Pid ! portnr(M, Sock), ok; %% Parent process has died. @@ -470,6 +521,10 @@ tls_handshake(Type, true, #transport{socket = Sock, ssl = Opts} = S) -> {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]), + Ref = getr(ref), + is_reference(Ref) %% started in new code + andalso + (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})), S#transport{socket = SSock, module = ssl}; @@ -637,16 +692,16 @@ setopts(M, Sock) -> X -> x({setopts, M, Sock, X}) %% possibly on peer disconnect end. -%% lport/2 +%% portnr/2 -lport(gen_tcp, Sock) -> +portnr(gen_tcp, Sock) -> inet:port(Sock); -lport(ssl, Sock) -> +portnr(ssl, Sock) -> case ssl:sockname(Sock) of {ok, {_Addr, PortNr}} -> {ok, PortNr}; {error, _} = No -> No end; -lport(M, Sock) -> +portnr(M, Sock) -> M:port(Sock). -- cgit v1.2.3 From 698360f3a8c7bb8298d70ccc054cd2124a11f10e Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 9 Oct 2011 20:35:20 +0200 Subject: Register tcp listener before transport start return --- lib/diameter/src/transport/diameter_tcp.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index a15c49f4a7..78dbda6888 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -158,9 +158,9 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) -> LAddr = get_addr(LA, Addrs), LPort = get_port(LP), {ok, LSock} = Mod:listen(LPort, gen_opts(LAddr, Rest)), + true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), proc_lib:init_ack({ok, self(), {LAddr, LSock}}), erlang:monitor(process, APid), - true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), start_timer(#listener{socket = LSock}). ssl(Opts) -> -- cgit v1.2.3 From 52f3b4e508cf1f43c88bd20b0e1e6cc75ec4f020 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 9 Oct 2011 20:36:31 +0200 Subject: Use tcp/sctp port resolution from testsuites --- lib/diameter/test/diameter_relay_SUITE.erl | 17 +-------- lib/diameter/test/diameter_tls_SUITE.erl | 28 +------------- lib/diameter/test/diameter_traffic_SUITE.erl | 18 +-------- lib/diameter/test/diameter_transport_SUITE.erl | 53 +++++--------------------- lib/diameter/test/diameter_util.erl | 31 ++++++++++++++- 5 files changed, 43 insertions(+), 104 deletions(-) diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index 60babd0b9a..f7f65197ed 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -269,22 +269,7 @@ realm(Host) -> server(Host, Dict) -> ok = diameter:start_service(Host, ?SERVICE(Host, Dict)), {ok, LRef} = diameter:add_transport(Host, ?LISTEN), - {LRef, portnr(LRef)}. - -portnr(LRef) -> - portnr(LRef, 20). - -portnr(LRef, N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of - [{T, _Pid}] -> - {_, _, {LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = inet:port(LSock), - PortNr; - [] -> - receive after 50 -> ok end, - portnr(LRef, N-1) - end. + {LRef, hd([_] = ?util:lport(tcp, LRef, 20))}. connect(Host, {_LRef, PortNr}) -> {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)), diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 90e32c834f..fb4ddcde0f 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -351,7 +351,7 @@ join(Strs) -> server(Host, {Caps, Opts}) -> ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)), {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)), - {LRef, portnr(LRef)}. + {LRef, hd([_] = ?util:lport(tcp, LRef, 20))}. sopts(?SERVER1, Dir) -> {inband_security([?TLS]), @@ -369,32 +369,6 @@ sopts(?SERVER5, Dir) -> ssl([{ssl_options = T, Opts}]) -> [{T, true} | Opts]. -portnr(LRef) -> - portnr(LRef, 20). - -portnr(LRef, N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of - [{T, _Pid}] -> - {_, _, {LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = to_portnr(LSock) , - PortNr; - [] -> - receive after 500 -> ok end, - portnr(LRef, N-1) - end. - -to_portnr(Sock) - when is_port(Sock) -> - inet:port(Sock); -to_portnr(Sock) -> - case ssl:sockname(Sock) of - {ok, {_,N}} -> - {ok, N}; - No -> - No - end. - %% connect/3 connect(Host, {_LRef, PortNr}, {Caps, Opts}) -> diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index f6905473b7..d85539edce 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -253,21 +253,6 @@ tc() -> send_multiple_filters_3, send_anything]. -portnr() -> - portnr(20). - -portnr(N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, '_'}) of - [{T, _Pid}] -> - {_, _, {_LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = inet:port(LSock), - PortNr; - [] -> - receive after 50 -> ok end, - portnr(N-1) - end. - %% =========================================================================== %% start/stop testcases @@ -281,7 +266,8 @@ start_services(_Config) -> add_transports(Config) -> {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN), true = diameter:subscribe(?CLIENT), - {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(portnr())), + [PortNr] = ?util:lport(tcp, LRef, 20), + {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(PortNr)), {up, CRef, _Peer, _Cfg, #diameter_packet{}} = receive #diameter_event{service = ?CLIENT, info = I} -> I after 2000 -> false diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index d556a903e5..a9520ef5bd 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -69,16 +69,6 @@ = #diameter_caps{host_ip_address = Addrs}}). -%% The term diameter_tcp/sctp registers after opening a listening -%% socket. This is an implementation detail that should probably be -%% replaced by some documented way of getting at the port number of -%% the listening socket, which is what we're after since we specify -%% port 0 to get something unused. --define(TCP_LISTENER(Ref, Addr, LSock), - {diameter_tcp, listener, {Ref, {Addr, LSock}}}). --define(SCTP_LISTENER(Ref, Addr, LSock), - {diameter_sctp, listener, {Ref, {[Addr], LSock}}}). - %% The term we register after open a listening port with gen_tcp. -define(TEST_LISTENER(Ref, PortNr), {?MODULE, listen, Ref, PortNr}). @@ -227,7 +217,7 @@ init(accept, {Prot, Ref}) -> init(gen_connect, {Prot, Ref}) -> %% Lookup the peer's listening socket. - {ok, PortNr} = inet:port(lsock(Prot, Ref)), + [PortNr] = ?util:lport(Prot, Ref, 20), %% Connect, send a message and receive it back. {ok, Sock} = gen_connect(Prot, PortNr, Ref), @@ -264,22 +254,16 @@ init(connect, {Prot, Ref}) -> MRef = erlang:monitor(process, TPid), ?RECV({'DOWN', MRef, process, _, _}). -lsock(sctp, Ref) -> - [{?SCTP_LISTENER(_ , _, LSock), _}] - = match(?SCTP_LISTENER(Ref, ?ADDR, '_')), - LSock; -lsock(tcp, Ref) -> - [{?TCP_LISTENER(_ , _, LSock), _}] - = match(?TCP_LISTENER(Ref, ?ADDR, '_')), - LSock. - match(Pat) -> - case diameter_reg:match(Pat) of - [] -> + match(Pat, 20). + +match(Pat, T) -> + L = diameter_reg:match(Pat), + if [] /= L orelse 1 == T -> + L; + true -> ?WAIT(50), - match(Pat); - L -> - L + match(Pat, T-1) end. bin(sctp, #diameter_packet{bin = Bin}) -> @@ -343,7 +327,7 @@ start_accept(Prot, Ref) -> %% Configure the same port number for transports on the same %% reference. - PortNr = portnr(Prot, Ref), + [PortNr | _] = ?util:lport(Prot, Ref) ++ [0], {Mod, Opts} = tmod(Prot), try @@ -373,23 +357,6 @@ tmod(sctp) -> tmod(tcp) -> {diameter_tcp, []}. -portnr(sctp, Ref) -> - case diameter_reg:match(?SCTP_LISTENER(Ref, ?ADDR, '_')) of - [{?SCTP_LISTENER(_, _, LSock), _}] -> - {ok, N} = inet:port(LSock), - N; - [] -> - 0 - end; -portnr(tcp, Ref) -> - case diameter_reg:match(?TCP_LISTENER(Ref, ?ADDR, '_')) of - [{?TCP_LISTENER(_, _, LSock), _}] -> - {ok, N} = inet:port(LSock), - N; - [] -> - 0 - end. - %% =========================================================================== %% gen_connect/3 diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index f9942c3408..3313e6ab75 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -23,12 +23,19 @@ %% Utility functions. %% +%% generic -export([consult/2, run/1, fold/3, foldl/3, - scramble/1, - write_priv/3, + scramble/1]). + +%% diameter-specific +-export([lport/2, + lport/3]). + +%% common_test-specific +-export([write_priv/3, read_priv/2]). -define(L, atom_to_list). @@ -172,6 +179,26 @@ eval(F) when is_function(F,0) -> F(). +%% lport/2-3 + +lport(M, Ref) -> + lport(M, Ref, 1). + +lport(M, Ref, Tries) -> + lp(tmod(M), Ref, Tries). + +tmod(sctp) -> diameter_sctp; +tmod(tcp) -> diameter_tcp. + +lp(M, Ref, T) -> + L = [N || {listen, N, _} <- M:ports(Ref)], + if [] /= L orelse T =< 1 -> + L; + true -> + receive after 50 -> ok end, + lp(M, Ref, T-1) + end. + %% write_priv/3 write_priv(Config, Name, Term) -> -- cgit v1.2.3 From 421281c888cc99239833c5cd359e12a9c7594b42 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 9 Oct 2011 15:18:01 +0200 Subject: Add util functions for managing connections --- lib/diameter/test/diameter_util.erl | 140 +++++++++++++++++++++++++++++++----- 1 file changed, 124 insertions(+), 16 deletions(-) diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 3313e6ab75..3574094417 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -32,14 +32,19 @@ %% diameter-specific -export([lport/2, - lport/3]). + lport/3, + service/1, + listen/2, + connect/3]). %% common_test-specific -export([write_priv/3, - read_priv/2]). + read_priv/2, + map_priv/3]). -define(L, atom_to_list). +%% --------------------------------------------------------------------------- %% consult/2 %% %% Extract info from the app/appup file (presumably) of the named @@ -64,6 +69,7 @@ consult(Path) -> %% Name/Path in the return value distinguish the errors and allow for %% a useful badmatch. +%% --------------------------------------------------------------------------- %% run/1 %% %% Evaluate functions in parallel and return a list of those that @@ -79,6 +85,7 @@ cons(true, _, _, Acc) -> cons(false, F, RC, Acc) -> [{F, RC} | Acc]. +%% --------------------------------------------------------------------------- %% fold/3 %% %% Parallel fold. Results are folded in the order received. @@ -124,6 +131,7 @@ down(MRef) -> down() -> receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end. +%% --------------------------------------------------------------------------- %% foldl/3 %% %% Parallel fold. Results are folded in order of the function list. @@ -139,6 +147,7 @@ recvl([{MRef, F} | L], Ref, Fun, Acc) -> R = down(MRef), recvl(L, Ref, Fun, acc(R, Ref, F, Fun, Acc)). +%% --------------------------------------------------------------------------- %% scramble/1 %% %% Sort a list into random order. @@ -158,7 +167,10 @@ s(Acc, L) -> {H, [T|Rest]} = lists:split(random:uniform(length(L)) - 1, L), s([T|Acc], H ++ Rest). +%% --------------------------------------------------------------------------- %% eval/1 +%% +%% Evaluate a function in one of a number of forms. eval({M,[F|A]}) when is_atom(F) -> @@ -179,7 +191,52 @@ eval(F) when is_function(F,0) -> F(). +%% --------------------------------------------------------------------------- +%% write_priv/3 +%% +%% Write an arbitrary term to a named file. + +write_priv(Config, Name, Term) -> + write(path(Config, Name), Term). + +write(Path, Term) -> + ok = file:write_file(Path, term_to_binary(Term)). + +%% read_priv/2 +%% +%% Read a term from a file. + +read_priv(Config, Name) -> + read(path(Config, Name)). + +read(Path) -> + {ok, Bin} = file:read_file(Path), + binary_to_term(Bin). + +%% map_priv/3 +%% +%% Modify a term in a file and return both old and new values. + +map_priv(Config, Name, Fun1) -> + map(path(Config, Name), Fun1). + +map(Path, Fun1) -> + T0 = read(Path), + T1 = Fun1(T0), + write(Path, T1), + {T0, T1}. + +path(Config, Name) + when is_atom(Name) -> + path(Config, ?L(Name)); +path(Config, Name) -> + Dir = proplists:get_value(priv_dir, Config), + filename:join([Dir, Name]). + +%% --------------------------------------------------------------------------- %% lport/2-3 +%% +%% Lookup the port number of a tcp/sctp listening transport. lport(M, Ref) -> lport(M, Ref, 1). @@ -187,9 +244,6 @@ lport(M, Ref) -> lport(M, Ref, Tries) -> lp(tmod(M), Ref, Tries). -tmod(sctp) -> diameter_sctp; -tmod(tcp) -> diameter_tcp. - lp(M, Ref, T) -> L = [N || {listen, N, _} <- M:ports(Ref)], if [] /= L orelse T =< 1 -> @@ -199,17 +253,71 @@ lp(M, Ref, T) -> lp(M, Ref, T-1) end. -%% write_priv/3 +%% --------------------------------------------------------------------------- +%% service/1 +%% +%% Start a new diameter service and return its generated name. -write_priv(Config, Name, Term) -> - Dir = proplists:get_value(priv_dir, Config), - Path = filename:join([Dir, Name]), - ok = file:write_file(Path, term_to_binary(Term)). +service(Opts) -> + Name = make_ref(), -%% read_priv/2 + case diameter:start_service(Name, Opts) of + ok -> + {ok, Name}; + {error, _} = No -> + No + end. -read_priv(Config, Name) -> - Dir = proplists:get_value(priv_dir, Config), - Path = filename:join([Dir, Name]), - {ok, Bin} = file:read_file(Path), - binary_to_term(Bin). +%% --------------------------------------------------------------------------- +%% listen/2 +%% +%% Add a listening transport on the loopback address and a free port. + +listen(SvcName, Prot) -> + add_transport(SvcName, {listen, transport(Prot, listen)}). + +%% --------------------------------------------------------------------------- +%% connect/3 +%% +%% Add a connecting transport on and connect to a listening transport +%% with the specified reference. + +connect(SvcName, Prot, LRef) -> + [PortNr] = lport(Prot, LRef), + Ref = add_transport(SvcName, {connect, transport(Prot, PortNr)}), + true = diameter:subscribe(SvcName), + receive + {diameter_event, SvcName, {up, Ref, _, _, _}} -> Ref + after 2000 -> + error({up, SvcName, Prot, PortNr}) + end. + +%% --------------------------------------------------------------------------- + +-define(ADDR, {127,0,0,1}). + +add_transport(SvcName, T) -> + {ok, Ref} = diameter:add_transport(SvcName, T), + Ref. + +tmod(tcp) -> + diameter_tcp; +tmod(sctp) -> + diameter_sctp. + +transport(Prot, T) -> + {tag(T), opts(Prot, T)}. + +tag(listen = T) -> + T; +tag(_PortNr) -> + connect. + +opts(Prot, T) -> + [{transport_module, tmod(Prot)}, + {transport_config, [{ip, ?ADDR}, {port, 0} | opts(T)]}]. + +opts(listen) -> + []; +opts(PortNr) -> + [{raddr, ?ADDR}, {rport, PortNr}]. -- cgit v1.2.3 From 9118a8b0772aff1aa5b1ec1f280e67aed38f8826 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 9 Oct 2011 21:37:22 +0200 Subject: Add beam target to makefile --- lib/diameter/test/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index dba1f126dc..04e686c969 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -77,7 +77,7 @@ ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \ all: $(SUITES) -tests debug opt: $(TARGET_FILES) +beam tests debug opt: $(TARGET_FILES) clean: rm -f $(TARGET_FILES) -- cgit v1.2.3 From 7de6f57074245a51faf1379629fe2000ae1037e5 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 9 Oct 2011 21:37:56 +0200 Subject: Move certificate generation into own testcase --- lib/diameter/test/diameter_tls_SUITE.erl | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index fb4ddcde0f..99f92ca0e0 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -44,6 +44,7 @@ %% testcases -export([start_ssl/1, start_diameter/1, + make_certs/1, make_certs/0, start_services/1, add_transports/1, send1/1, @@ -134,11 +135,12 @@ %% =========================================================================== suite() -> - [{timetrap, {seconds, 15}}]. + [{timetrap, {seconds, 10}}]. all() -> [start_ssl, start_diameter, + make_certs, start_services, add_transports] ++ [{group, N} || {N, _, _} <- groups()] @@ -184,6 +186,18 @@ start_ssl(_Config) -> start_diameter(_Config) -> ok = diameter:start(). +make_certs() -> + [{timetrap, {seconds, 30}}]. + +make_certs(Config) -> + Dir = proplists:get_value(priv_dir, Config), + + [] = ?util:run([[fun make_cert/2, Dir, B] || B <- ["server1", + "server2", + "server4", + "server5", + "client"]]). + start_services(Config) -> Dir = proplists:get_value(priv_dir, Config), Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS], @@ -325,8 +339,12 @@ inband_security(Ids) -> [{'Inband-Security-Id', Ids}]. ssl_options(Dir, Base) -> - {Key, Cert} = make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"), - [{ssl_options, [{certfile, Cert}, {keyfile, Key}]}]. + Root = filename:join([Dir, Base]), + [{ssl_options, [{certfile, Root ++ "_ca.pem"}, + {keyfile, Root ++ "_key.pem"}]}]. + +make_cert(Dir, Base) -> + make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"). make_cert(Dir, Keyfile, Certfile) -> [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]], -- cgit v1.2.3 From bc099fc49937477d96f930237fc58d388a0d43ef Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 9 Oct 2011 23:37:21 +0200 Subject: Use util to simplify connection establishment in suites --- lib/diameter/test/diameter_relay_SUITE.erl | 99 +++++++--------------------- lib/diameter/test/diameter_traffic_SUITE.erl | 33 +--------- lib/diameter/test/diameter_util.erl | 63 ++++++++---------- 3 files changed, 56 insertions(+), 139 deletions(-) diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index f7f65197ed..03f1115496 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -110,19 +110,6 @@ {module, ?MODULE}, {answer_errors, callback}]}]). -%% Config for diameter:add_transport/2. In the listening case, listen -%% on a free port that we then lookup using the implementation detail -%% that diameter_tcp registers the port with diameter_reg. --define(CONNECT(PortNr), - {connect, [{transport_module, diameter_tcp}, - {transport_config, [{raddr, ?ADDR}, - {rport, PortNr}, - {ip, ?ADDR}, - {port, 0}]}]}). --define(LISTEN, - {listen, [{transport_module, diameter_tcp}, - {transport_config, [{ip, ?ADDR}, {port, 0}]}]}). - -define(SUCCESS, 2001). -define(LOOP_DETECTED, 3005). -define(UNABLE_TO_DELIVER, 3002). @@ -130,9 +117,6 @@ -define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). -define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY'). --define(A, list_to_atom). --define(L, atom_to_list). - %% =========================================================================== suite() -> @@ -173,47 +157,29 @@ start(_Config) -> ok = diameter:start(). start_services(_Config) -> - S = [server(N, ?DICT_COMMON) || N <- [?SERVER1, - ?SERVER2, - ?SERVER3, - ?SERVER4]], - R = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]], + [S1,S2,S3,S4] = [server(N, ?DICT_COMMON) || N <- [?SERVER1, + ?SERVER2, + ?SERVER3, + ?SERVER4]], + [R1,R2] = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]], ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), - {save_config, S ++ R}. + {save_config, [{?RELAY1, [S1,S2,R2]}, + {?RELAY2, [S3,S4]}, + {?CLIENT, [R1,R2]}]}. connect(Config) -> - {_, [S1,S2,S3,S4,R1,R2] = SR} = proplists:get_value(saved_config, Config), - - true = diameter:subscribe(?RELAY1), - true = diameter:subscribe(?RELAY2), - true = diameter:subscribe(?CLIENT), + {_, Conns} = proplists:get_value(saved_config, Config), - [R1S1,R1S2] = connect(?RELAY1, [S1,S2]), - [R2S3,R2S4] = connect(?RELAY2, [S3,S4]), - [CR1,CR2] = connect(?CLIENT, [R1,R2]), + ?util:write_priv(Config, + "cfg", + lists:flatmap(fun({CN,Ss}) -> connect(CN, Ss) end, + Conns)). - R1R2 = connect(?RELAY1, R2), - - ?util:write_priv(Config, "cfg", SR ++ [R1S1,R1S2,R2S3,R2S4,CR1,CR2,R1R2]). - -%% Remove the client transports and expect the corresponding server -%% transport to go down. disconnect(Config) -> - [S1,S2,S3,S4,R1,R2,R1S1,R1S2,R2S3,R2S4,CR1,CR2,R1R2] - = ?util:read_priv(Config, "cfg"), - - [?CLIENT | Svcs] = ?SERVICES, - [] = [{S,T} || S <- Svcs, T <- [diameter:subscribe(S)], T /= true], - - disconnect(?RELAY1, S1, R1S1), - disconnect(?RELAY1, S2, R1S2), - disconnect(?RELAY2, S3, R2S3), - disconnect(?RELAY2, S4, R2S4), - disconnect(?CLIENT, R1, CR1), - disconnect(?CLIENT, R2, CR2), - disconnect(?RELAY1, R2, R1R2). + lists:foreach(fun({{CN,CR},{SN,SR}}) -> ?util:disconnect(CN,CR,SN,SR) end, + ?util:read_priv(Config, "cfg")). stop_services(_Config) -> [] = [{H,T} || H <- ?SERVICES, @@ -223,6 +189,15 @@ stop_services(_Config) -> stop(_Config) -> ok = diameter:stop(). +%% ---------------------------------------- + +server(Name, Dict) -> + ok = diameter:start_service(Name, ?SERVICE(Name, Dict)), + {Name, ?util:listen(Name, tcp)}. + +connect(Name, Refs) -> + [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs]. + %% =========================================================================== %% traffic testcases @@ -266,30 +241,6 @@ send_timeout(Tmo) -> realm(Host) -> tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). -server(Host, Dict) -> - ok = diameter:start_service(Host, ?SERVICE(Host, Dict)), - {ok, LRef} = diameter:add_transport(Host, ?LISTEN), - {LRef, hd([_] = ?util:lport(tcp, LRef, 20))}. - -connect(Host, {_LRef, PortNr}) -> - {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)), - ok = receive - #diameter_event{service = Host, - info = {up, Ref, _, _, #diameter_packet{}}} -> - ok - after 2000 -> - false - end, - Ref; -connect(Host, Ports) -> - [connect(Host, P) || P <- Ports]. - -disconnect(Client, {LRef, _PortNr}, CRef) -> - ok = diameter:remove_transport(Client, CRef), - ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok - after 2000 -> false - end. - call(Server) -> Realm = realm(Server), Req = ['STR', {'Destination-Realm', Realm}, @@ -325,7 +276,7 @@ peer_down(_SvcName, _Peer, State) -> pick_peer([Peer | _], _, Svc, _State) when Svc == ?RELAY1; Svc == ?RELAY2; - Svc == ?CLIENT-> + Svc == ?CLIENT -> {ok, Peer}. %% prepare_request/3 diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index d85539edce..6704f24532 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -127,19 +127,6 @@ {module, ?MODULE}, {answer_errors, callback}]}]). -%% Config for diameter:add_transport/2. In the listening case, listen -%% on a free port that we then lookup using the implementation detail -%% that diameter_tcp registers the port with diameter_reg. --define(CONNECT(PortNr), - {connect, [{transport_module, diameter_tcp}, - {transport_config, [{raddr, ?ADDR}, - {rport, PortNr}, - {ip, ?ADDR}, - {port, 0}]}]}). --define(LISTEN, - {listen, [{transport_module, diameter_tcp}, - {transport_config, [{ip, ?ADDR}, {port, 0}]}]}). - -define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). -define(COMMAND_UNSUPPORTED, @@ -264,27 +251,13 @@ start_services(_Config) -> ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). add_transports(Config) -> - {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN), - true = diameter:subscribe(?CLIENT), - [PortNr] = ?util:lport(tcp, LRef, 20), - {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(PortNr)), - {up, CRef, _Peer, _Cfg, #diameter_packet{}} - = receive #diameter_event{service = ?CLIENT, info = I} -> I - after 2000 -> false - end, - true = diameter:unsubscribe(?CLIENT), + LRef = ?util:listen(?SERVER, tcp), + CRef = ?util:connect(?CLIENT, tcp, LRef), ?util:write_priv(Config, "transport", {LRef, CRef}). -%% Remove the client transport and expect the server transport to -%% go down. remove_transports(Config) -> {LRef, CRef} = ?util:read_priv(Config, "transport"), - true = diameter:subscribe(?SERVER), - ok = diameter:remove_transport(?CLIENT, CRef), - {down, LRef, _, _} - = receive #diameter_event{service = ?SERVER, info = I} -> I - after 2000 -> false - end. + ?util:disconnect(?CLIENT, CRef, ?SERVER, LRef). stop_services(_Config) -> ok = diameter:stop_service(?CLIENT), diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 3574094417..3fe8ea5363 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -33,9 +33,9 @@ %% diameter-specific -export([lport/2, lport/3, - service/1, listen/2, - connect/3]). + connect/3, + disconnect/4]). %% common_test-specific -export([write_priv/3, @@ -253,28 +253,13 @@ lp(M, Ref, T) -> lp(M, Ref, T-1) end. -%% --------------------------------------------------------------------------- -%% service/1 -%% -%% Start a new diameter service and return its generated name. - -service(Opts) -> - Name = make_ref(), - - case diameter:start_service(Name, Opts) of - ok -> - {ok, Name}; - {error, _} = No -> - No - end. - %% --------------------------------------------------------------------------- %% listen/2 %% %% Add a listening transport on the loopback address and a free port. listen(SvcName, Prot) -> - add_transport(SvcName, {listen, transport(Prot, listen)}). + add_transport(SvcName, {listen, opts(Prot, listen)}). %% --------------------------------------------------------------------------- %% connect/3 @@ -282,15 +267,31 @@ listen(SvcName, Prot) -> %% Add a connecting transport on and connect to a listening transport %% with the specified reference. -connect(SvcName, Prot, LRef) -> - [PortNr] = lport(Prot, LRef), - Ref = add_transport(SvcName, {connect, transport(Prot, PortNr)}), - true = diameter:subscribe(SvcName), - receive - {diameter_event, SvcName, {up, Ref, _, _, _}} -> Ref - after 2000 -> - error({up, SvcName, Prot, PortNr}) - end. +connect(Client, Prot, LRef) -> + [PortNr] = lport(Prot, LRef, 20), + Ref = add_transport(Client, {connect, opts(Prot, PortNr)}), + true = diameter:subscribe(Client), + ok = receive + {diameter_event, Client, {up, Ref, _, _, _}} -> ok + after 2000 -> + {Client, Prot, PortNr, process_info(self(), messages)} + end, + Ref. + +%% --------------------------------------------------------------------------- +%% disconnect/4 +%% +%% Remove the client transport and expect the server transport to go +%% down. + +disconnect(Client, Ref, Server, LRef) -> + true = diameter:subscribe(Server), + ok = diameter:remove_transport(Client, Ref), + ok = receive + {diameter_event, Server, {down, LRef, _, _}} -> ok + after 2000 -> + {Client, Ref, Server, LRef, process_info(self(), messages)} + end. %% --------------------------------------------------------------------------- @@ -305,14 +306,6 @@ tmod(tcp) -> tmod(sctp) -> diameter_sctp. -transport(Prot, T) -> - {tag(T), opts(Prot, T)}. - -tag(listen = T) -> - T; -tag(_PortNr) -> - connect. - opts(Prot, T) -> [{transport_module, tmod(Prot)}, {transport_config, [{ip, ?ADDR}, {port, 0} | opts(T)]}]. -- cgit v1.2.3 From 9c9be3b8315c99477e1017fd736ef5ed40459b2f Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 10 Oct 2011 00:54:16 +0200 Subject: Add failover suite --- lib/diameter/test/diameter_failover_SUITE.erl | 262 ++++++++++++++++++++++++++ lib/diameter/test/modules.mk | 3 +- 2 files changed, 264 insertions(+), 1 deletion(-) create mode 100644 lib/diameter/test/diameter_failover_SUITE.erl diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl new file mode 100644 index 0000000000..c25e9682f0 --- /dev/null +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -0,0 +1,262 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Tests of traffic between six Diameter nodes in three realms, +%% connected as follows. +%% +%% ----- SERVER1.REALM2 +%% / +%% / ----- SERVER2.REALM2 +%% | / +%% CLIENT.REALM1 ------ SERVER3.REALM2 +%% | \ +%% | \ +%% \ ---- SERVER1.REALM3 +%% \ +%% ----- SERVER2.REALM3 +%% + +-module(diameter_failover_SUITE). + +-export([suite/0, + all/0]). + +%% testcases +-export([start/1, + start_services/1, + connect/1, + send_ok/1, + send_nok/1, + stop_services/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/4, + prepare_request/3, + prepare_retransmit/3, + handle_answer/4, + handle_error/4, + handle_request/3]). + +-ifdef(DIAMETER_CT). +-include("diameter_gen_base_rfc3588.hrl"). +-else. +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). +-endif. + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_ct.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(ADDR, {127,0,0,1}). + +-define(CLIENT, "CLIENT.REALM1"). +-define(SERVER1, "SERVER1.REALM2"). +-define(SERVER2, "SERVER2.REALM2"). +-define(SERVER3, "SERVER3.REALM2"). +-define(SERVER4, "SERVER1.REALM3"). +-define(SERVER5, "SERVER2.REALM3"). + +-define(SERVICES, [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]). + +-define(DICT_COMMON, ?DIAMETER_DICT_COMMON). + +-define(APP_ALIAS, the_app). +-define(APP_ID, ?DICT_COMMON:id()). + +%% Config for diameter:start_service/2. +-define(SERVICE(Host, Dict), + [{'Origin-Host', Host}, + {'Origin-Realm', realm(Host)}, + {'Host-IP-Address', [?ADDR]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Acct-Application-Id', [Dict:id()]}, + {application, [{alias, ?APP_ALIAS}, + {dictionary, Dict}, + {module, ?MODULE}, + {answer_errors, callback}]}]). + +-define(SUCCESS, 2001). + +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [start, + start_services, + connect, + send_ok, + send_nok, + stop_services, + stop]. + +%% =========================================================================== +%% start/stop testcases + +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + S = [server(N, ?DICT_COMMON) || N <- tl(?SERVICES)], + + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + {save_config, [{?CLIENT, S}]}. + +connect(Config) -> + {_, Conns} = proplists:get_value(saved_config, Config), + + lists:foreach(fun({CN,Ss}) -> connect(CN, Ss) end, Conns). + +stop_services(_Config) -> + [] = [{H,T} || H <- ?SERVICES, + T <- [diameter:stop_service(H)], + T /= ok]. + +stop(_Config) -> + ok = diameter:stop(). + +%% ---------------------------------------- + +server(Name, Dict) -> + ok = diameter:start_service(Name, ?SERVICE(Name, Dict)), + {Name, ?util:listen(Name, tcp)}. + +connect(Name, Refs) -> + [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs]. + +%% =========================================================================== +%% traffic testcases + +%% Send an STR and expect success after SERVER3 answers after a couple +%% of failovers. +send_ok(_Config) -> + Req = ['STR', {'Destination-Realm', realm(?SERVER1)}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Origin-Host' = ?SERVER3} + = call(Req, [{filter, realm}]). + +%% Send an STR and expect failure when both servers fail. +send_nok(_Config) -> + Req = ['STR', {'Destination-Realm', realm(?SERVER4)}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + {error, failover} = call(Req, [{filter, realm}]). + +%% =========================================================================== + +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + +call(Req, Opts) -> + diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). + +set([H|T], Vs) -> + [H | Vs ++ T]. + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/4 + +%% Choose a server other than SERVER3 or SERVER5 if possible. +pick_peer(Peers, _, ?CLIENT, _State) -> + case lists:partition(fun({_, #diameter_caps{origin_host = {_, OH}}}) -> + OH /= ?SERVER3 andalso OH /= ?SERVER5 + end, + Peers) + of + {[], [Peer]} -> + {ok, Peer}; + {[Peer | _], _} -> + {ok, Peer} + end. + +%% prepare_request/3 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}) -> + {send, prepare(Pkt, Caps)}. + +prepare(#diameter_packet{msg = Req}, Caps) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + set(Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}]). + +%% prepare_retransmit/3 + +prepare_retransmit(Pkt, ?CLIENT, _Peer) -> + {send, Pkt}. + +%% handle_answer/4 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> + #diameter_packet{msg = Rec, errors = []} = Pkt, + Rec. + +%% handle_error/4 + +handle_error(Reason, _Req, ?CLIENT, _Peer) -> + {error, Reason}. + +%% handle_request/3 + +%% Only SERVER3 actually answers. +handle_request(Pkt, ?SERVER3, {_, Caps}) -> + #diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId, + 'Origin-Host' = ?CLIENT}} + = Pkt, + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + + {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR}}; + +%% Others kill the transport to force failover. +handle_request(_, _, {TPid, _}) -> + exit(TPid, kill), + discard. diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index 7c691c302b..531aca2799 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -35,7 +35,8 @@ MODULES = \ diameter_transport_SUITE \ diameter_traffic_SUITE \ diameter_relay_SUITE \ - diameter_tls_SUITE + diameter_tls_SUITE \ + diameter_failover_SUITE INTERNAL_HRL_FILES = \ diameter_ct.hrl -- cgit v1.2.3 From 30c169c79a4602d6f63cc0d6f5ba171cca8c1863 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 10 Oct 2011 15:44:34 +0200 Subject: Fix a minor bug in Dets If a Dets table had been properly closed but the space management data could not been read, it was not possible to repair the file. --- lib/stdlib/src/dets.erl | 87 +++++++++++++++++++++++++++--------------- lib/stdlib/test/dets_SUITE.erl | 4 +- 2 files changed, 60 insertions(+), 31 deletions(-) diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index fa0641ffd9..7ed9c4b695 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -2475,10 +2475,25 @@ fopen2(Fname, Tab) -> %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {error, not_closed} -> - io:format(user,"dets: file ~p not properly closed, " - "repairing ...~n", [Fname]), + Do = case Mod:check_file_header(FH, Fd) of + {ok, Head1, ExtraInfo} -> + Head2 = Head1#head{filename = Fname}, + try Mod:init_freelist(Head2, ExtraInfo) of + Ftab -> + {ok, Head1#head{freelists = Ftab}} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + {error, not_closed} -> + M = " not properly closed, repairing ...", + {repair, M}; + Else -> + Else + end, + case Do of + {repair, Mess} -> + io:format(user, "dets: file ~p~s~n", [Fname, Mess]), Version = default, case fsck(Fd, Tab, Fname, FH, default, default, Version) of ok -> @@ -2486,9 +2501,9 @@ fopen2(Fname, Tab) -> Error -> throw(Error) end; - {ok, Head, ExtraInfo} -> + {ok, Head} -> open_final(Head, Fname, Acc, Ram, ?DEFAULT_CACHE, - Tab, ExtraInfo, false); + Tab, false); {error, Reason} -> throw({error, {Reason, Fname}}) end; @@ -2520,12 +2535,13 @@ fopen_existing_file(Tab, OpenArgs) -> V9 = (Version =:= 9) or (Version =:= default), MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots), MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots), - Do = case (FH#fileheader.mod):check_file_header(FH, Fd) of + Mod = (FH#fileheader.mod), + Wh = case Mod:check_file_header(FH, Fd) of {ok, Head, true} when Rep =:= force, Acc =:= read_write, FH#fileheader.version =:= 9, FH#fileheader.no_colls =/= undefined, MinF, MaxF, V9 -> - {compact, Head}; + {compact, Head, true}; {ok, _Head, _Extra} when Rep =:= force, Acc =:= read -> throw({error, {access_mode, Fname}}); {ok, Head, need_compacting} when Acc =:= read -> @@ -2555,6 +2571,19 @@ fopen_existing_file(Tab, OpenArgs) -> {error, Reason} -> throw({error, {Reason, Fname}}) end, + Do = case Wh of + {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact -> + Hd1 = Hd#head{filename = Fname}, + try Mod:init_freelist(Hd1, Extra) of + Ftab -> + {Tag, Hd#head{freelists = Ftab}} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + Else -> + Else + end, case Do of _ when FH#fileheader.type =/= Type -> throw({error, {type_mismatch, Fname}}); @@ -2563,8 +2592,7 @@ fopen_existing_file(Tab, OpenArgs) -> {compact, SourceHead} -> io:format(user, "dets: file ~p is now compacted ...~n", [Fname]), {ok, NewSourceHead} = open_final(SourceHead, Fname, read, false, - ?DEFAULT_CACHE, Tab, true, - Debug), + ?DEFAULT_CACHE, Tab, Debug), case catch compact(NewSourceHead) of ok -> erlang:garbage_collect(), @@ -2584,9 +2612,9 @@ fopen_existing_file(Tab, OpenArgs) -> Version, OpenArgs); _ when FH#fileheader.version =/= Version, Version =/= default -> throw({error, {version_mismatch, Fname}}); - {final, H, EI} -> + {final, H} -> H1 = H#head{auto_save = Auto}, - open_final(H1, Fname, Acc, Ram, CacheSz, Tab, EI, Debug) + open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug) end. do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> @@ -2600,19 +2628,16 @@ do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> end. %% -> {ok, head()} | throw(Error) -open_final(Head, Fname, Acc, Ram, CacheSz, Tab, ExtraInfo, Debug) -> +open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) -> Head1 = Head#head{access = Acc, ram_file = Ram, filename = Fname, name = Tab, cache = dets_utils:new_cache(CacheSz)}, init_disk_map(Head1#head.version, Tab, Debug), - Mod = Head#head.mod, - Mod:cache_segps(Head1#head.fptr, Fname, Head1#head.next), - Ftab = Mod:init_freelist(Head1, ExtraInfo), + (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next), check_growth(Head1), - NewHead = Head1#head{freelists = Ftab}, - {ok, NewHead}. + {ok, Head1}. %% -> {ok, head()} | throw(Error) fopen_init_file(Tab, OpenArgs) -> @@ -3241,18 +3266,20 @@ view(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {ok, H0, ExtraInfo} -> - Ftab = Mod:init_freelist(H0, ExtraInfo), - {_Bump, Base} = constants(FH, FileName), - H = H0#head{freelists=Ftab, base = Base}, - v_free_list(H), - Mod:v_segments(H), - file:close(Fd); - X -> - file:close(Fd), - X - end; + try + case Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + Ftab = Mod:init_freelist(H0, ExtraInfo), + {_Bump, Base} = constants(FH, FileName), + H = H0#head{freelists=Ftab, base = Base}, + v_free_list(H), + Mod:v_segments(H), + ok; + X -> + X + end + after file:close(Fd) + end; X -> X end. diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index b569ed9003..b68d83b12d 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1568,8 +1568,10 @@ repair(Config, V) -> ?line FileSize = dets:info(TabRef, memory), ?line ok = dets:close(TabRef), crash(Fname, FileSize+20), - ?line {error, {bad_freelists, Fname}} = + %% Used to return bad_freelists, but that changed in OTP-9622 + ?line {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + ?line ok = dets:close(TabRef), ?line file:delete(Fname), %% File not closed, opening with read and read_write access tried. -- cgit v1.2.3 From 2c4e984bd1d75524fd6444dc2032f8d758a945ae Mon Sep 17 00:00:00 2001 From: Christopher Faulet Date: Tue, 6 Sep 2011 11:10:43 +0200 Subject: Allow an infinite timeout to shutdown worker processes Now, in child specification, the shutdown value can also be set to infinity for worker children. This restriction was removed because this is not always possible to predict the shutdown time for a worker. This is highly application-dependent. --- lib/stdlib/doc/src/supervisor.xml | 3 ++- lib/stdlib/src/supervisor.erl | 2 +- lib/stdlib/test/supervisor_SUITE.erl | 26 +++++++++++++------------- system/doc/design_principles/sup_princ.xml | 3 ++- 4 files changed, 18 insertions(+), 16 deletions(-) diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index ec607d6e4c..b4baf2f0a0 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -169,7 +169,8 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} exit(Child,kill).

If the child process is another supervisor, Shutdown should be set to infinity to give the subtree ample - time to shutdown.

+ time to shutdown. It is also allowed to set it to infinity, + if the child process is a worker.

Important note on simple-one-for-one supervisors: The dynamically created child processes of a simple-one-for-one supervisor are not explicitly killed, diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 9da0d52f8c..051dca462b 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1053,7 +1053,7 @@ validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}). validShutdown(Shutdown, _) when is_integer(Shutdown), Shutdown > 0 -> true; -validShutdown(infinity, supervisor) -> true; +validShutdown(infinity, _) -> true; validShutdown(brutal_kill, _) -> true; validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}). diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 2aa3131aeb..9d47233422 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -209,8 +209,8 @@ sup_start_fail(Config) when is_list(Config) -> %%------------------------------------------------------------------------- sup_stop_infinity(doc) -> - ["See sup_stop/1 when Shutdown = infinity, this walue is only allowed " - "for children of type supervisor"]; + ["See sup_stop/1 when Shutdown = infinity, this walue is allowed " + "for children of type supervisor _AND_ worker"]; sup_stop_infinity(suite) -> []; sup_stop_infinity(Config) when is_list(Config) -> @@ -221,12 +221,13 @@ sup_stop_infinity(Config) when is_list(Config) -> Child2 = {child2, {supervisor_1, start_child, []}, permanent, infinity, worker, []}, {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid1), - {error, {invalid_shutdown,infinity}} = - supervisor:start_child(sup_test, Child2), + link(CPid2), terminate(Pid, shutdown), - check_exit_reason(CPid1, shutdown). + check_exit_reason(CPid1, shutdown), + check_exit_reason(CPid2, shutdown). %%------------------------------------------------------------------------- @@ -458,9 +459,8 @@ child_specs(Config) when is_list(Config) -> B2 = {child, {m,f,[a]}, prmanent, 1000, worker, []}, B3 = {child, {m,f,[a]}, permanent, -10, worker, []}, B4 = {child, {m,f,[a]}, permanent, 10, wrker, []}, - B5 = {child, {m,f,[a]}, permanent, infinity, worker, []}, - B6 = {child, {m,f,[a]}, permanent, 1000, worker, dy}, - B7 = {child, {m,f,[a]}, permanent, 1000, worker, [1,2,3]}, + B5 = {child, {m,f,[a]}, permanent, 1000, worker, dy}, + B6 = {child, {m,f,[a]}, permanent, 1000, worker, [1,2,3]}, %% Correct child specs! %% (last parameter in a child spec) can be [] as we do @@ -469,6 +469,7 @@ child_specs(Config) when is_list(Config) -> C2 = {child, {m,f,[a]}, permanent, 1000, supervisor, []}, C3 = {child, {m,f,[a]}, temporary, 1000, worker, dynamic}, C4 = {child, {m,f,[a]}, transient, 1000, worker, [m]}, + C5 = {child, {m,f,[a]}, permanent, infinity, worker, [m]}, {error, {invalid_mfa,mfa}} = supervisor:start_child(sup_test, B1), {error, {invalid_restart_type, prmanent}} = @@ -477,9 +478,8 @@ child_specs(Config) when is_list(Config) -> = supervisor:start_child(sup_test, B3), {error, {invalid_child_type,wrker}} = supervisor:start_child(sup_test, B4), - {error, _} = supervisor:start_child(sup_test, B5), {error, {invalid_modules,dy}} - = supervisor:start_child(sup_test, B6), + = supervisor:start_child(sup_test, B5), {error, {invalid_mfa,mfa}} = supervisor:check_childspecs([B1]), {error, {invalid_restart_type,prmanent}} = @@ -487,15 +487,15 @@ child_specs(Config) when is_list(Config) -> {error, {invalid_shutdown,-10}} = supervisor:check_childspecs([B3]), {error, {invalid_child_type,wrker}} = supervisor:check_childspecs([B4]), - {error, _} = supervisor:check_childspecs([B5]), - {error, {invalid_modules,dy}} = supervisor:check_childspecs([B6]), + {error, {invalid_modules,dy}} = supervisor:check_childspecs([B5]), {error, {invalid_module, 1}} = - supervisor:check_childspecs([B7]), + supervisor:check_childspecs([B6]), ok = supervisor:check_childspecs([C1]), ok = supervisor:check_childspecs([C2]), ok = supervisor:check_childspecs([C3]), ok = supervisor:check_childspecs([C4]), + ok = supervisor:check_childspecs([C5]), ok. %%------------------------------------------------------------------------- diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 2748f21bbe..42d9f3e3d8 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -181,7 +181,8 @@ init(...) -> terminated using exit(Child, kill). If the child process is another supervisor, it should be set to infinity to give the subtree enough time to - shutdown. + shutdown. It is also allowed to set it to infinity, if the + child process is a worker. -- cgit v1.2.3 From 9679510bb27b569fd47394b6cb319916c3282de9 Mon Sep 17 00:00:00 2001 From: Christopher Faulet Date: Wed, 14 Sep 2011 14:30:47 +0200 Subject: Add a warning to docs about workers' shutdown strategy --- lib/stdlib/doc/src/supervisor.xml | 7 +++++++ system/doc/design_principles/sup_princ.xml | 7 +++++++ 2 files changed, 14 insertions(+) diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index b4baf2f0a0..54e7cab884 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -171,6 +171,13 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} should be set to infinity to give the subtree ample time to shutdown. It is also allowed to set it to infinity, if the child process is a worker.

+ +

Be careful by setting the Shutdown strategy to + infinity when the child process is a worker. Because, in this + situation, the termination of the supervision tree depends on the + child process, it must be implemented in a safe way and its cleanup + procedure must always return.

+

Important note on simple-one-for-one supervisors: The dynamically created child processes of a simple-one-for-one supervisor are not explicitly killed, diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 42d9f3e3d8..9e7cc2f543 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -184,6 +184,13 @@ init(...) -> shutdown. It is also allowed to set it to infinity, if the child process is a worker. + +

Be careful by setting the Shutdown strategy to + infinity when the child process is a worker. Because, in this + situation, the termination of the supervision tree depends on the + child process, it must be implemented in a safe way and its cleanup + procedure must always return.

+

Type specifies if the child process is a supervisor or -- cgit v1.2.3 From 802dd95ab279c3d9b56d5beae6519b1cfd16f325 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 13 Jun 2011 14:23:09 +0200 Subject: Remove optimization of 'move R R' Ancient versions of BEAM compiler could generate move instruction with the same source and destination registers, so the loader would optimize away such instructions. --- erts/emulator/beam/ops.tab | 2 -- 1 file changed, 2 deletions(-) diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 538f0b94af..1dba2128f4 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -310,8 +310,6 @@ raise s s badarg j system_limit j -move R R => - move C=cxy r | jump Lbl => move_jump Lbl C %macro: move_jump MoveJump -nonext -- cgit v1.2.3 From 5a037222bcf42cab8bb3887c716b618e0d5c39e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 15 Jun 2011 08:26:21 +0200 Subject: Remove the special instructions for the hybrid heap emulator The hybrid-heap emulator is broken since R12, so there is no need to keep those instructions. --- erts/emulator/beam/beam_emu.c | 86 ------------------------------------------- erts/emulator/beam/ops.tab | 20 ---------- 2 files changed, 106 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4b5b5cbdaa..eec9ecb410 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -4862,92 +4862,6 @@ void process_main(void) Goto(*I); } - /* - * Instructions for allocating on the message area. - */ - - OpCase(i_global_cons): - { - BeamInstr *next; -#ifdef HYBRID - Eterm *hp; - - PreFetch(0,next); - TestGlobalHeap(2,2,hp); - hp[0] = r(0); - hp[1] = x(1); - r(0) = make_list(hp); -#ifndef INCREMENTAL - global_htop += 2; -#endif - NextPF(0,next); -#else - PreFetch(0,next); - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - OpCase(i_global_tuple): - { - BeamInstr *next; - int len; -#ifdef HYBRID - Eterm list; - Eterm *hp; -#endif - - if ((len = list_length(r(0))) < 0) { - goto badarg; - } - - PreFetch(0,next); -#ifdef HYBRID - TestGlobalHeap(len + 1,1,hp); - list = r(0); - r(0) = make_tuple(hp); - *hp++ = make_arityval(len); - while(is_list(list)) - { - Eterm* cons = list_val(list); - *hp++ = CAR(cons); - list = CDR(cons); - } -#ifndef INCREMENTAL - global_htop += len + 1; -#endif - NextPF(0,next); -#else - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - OpCase(i_global_copy): - { - BeamInstr *next; - PreFetch(0,next); -#ifdef HYBRID - if (!IS_CONST(r(0))) - { - BM_SWAP_TIMER(system,copy); - SWAPOUT; - reg[0] = r(0); - reg[1] = NIL; - r(0) = copy_struct_lazy(c_p,r(0),0); - ASSERT(ma_src_top == 0); - ASSERT(ma_dst_top == 0); - ASSERT(ma_offset_top == 0); - SWAPIN; - BM_SWAP_TIMER(copy,system); - } - NextPF(0,next); -#else - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - /* * New floating point instructions. */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 1dba2128f4..b2f82a5df1 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -88,9 +88,6 @@ i_time_breakpoint i_return_time_trace i_return_to_trace i_yield -i_global_cons -i_global_tuple -i_global_copy return @@ -905,23 +902,6 @@ call_ext u==3 u$func:erlang:hibernate/3 => i_hibernate call_ext_last u==3 u$func:erlang:hibernate/3 D => i_hibernate call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate -# -# Hybrid memory architecture need special cons and tuple instructions -# that allocate on the message area. These looks like BIFs in the BEAM code. -# - -call_ext u==2 u$func:hybrid:cons/2 => i_global_cons -call_ext_last u==2 u$func:hybrid:cons/2 D => i_global_cons | deallocate_return D -call_ext_only Ar=u==2 u$func:hybrid:cons/2 => i_global_cons | return - -call_ext u==1 u$func:hybrid:tuple/1 => i_global_tuple -call_ext_last u==1 u$func:hybrid:tuple/1 D => i_global_tuple | deallocate_return D -call_ext_only Ar=u==1 u$func:hybrid:tuple/1 => i_global_tuple | return - -call_ext u==1 u$func:hybrid:copy/1 => i_global_copy -call_ext_last u==1 u$func:hybrid:copy/1 D => i_global_copy | deallocate_return D -call_ext_only u==1 Ar=u$func:hybrid:copy/1 => i_global_copy | return - # # The general case for BIFs that have no special instructions. # A BIF used in the tail must be followed by a return instruction. -- cgit v1.2.3 From 8f52f4b5d92197de19dd5df29513a9dcb5437280 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 11 Aug 2011 11:19:29 +0200 Subject: Remove too_old_compiler handling for very old instruction variants is_list/2 and other test instructions with a zero label was last generated by the v1 BEAM compiler which was last supported in R6B. Since BEAM modules produced by that compiler will be rejected with a nice error message for other reasons (e.g. by the test for the module_info/0,1 functions), retaining those transformations serves no useful purpose. --- erts/emulator/beam/ops.tab | 24 +++--------------------- 1 file changed, 3 insertions(+), 21 deletions(-) diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index b2f82a5df1..dcfd9063d9 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -25,31 +25,13 @@ # instruction transformations; thus, they never occur in BEAM files. # -# Special instruction used to generate an error message when -# trying to load a module compiled by the V1 compiler (R5 & R6). -# (Specially treated in beam_load.c.) +# The too_old_compiler/0 instruction is specially handled in beam_load.c +# to produce a user-friendly message informing the user that the module +# needs to be re-compiled with a modern compiler. too_old_compiler/0 too_old_compiler -# -# Obsolete instruction usage follow. (Nowdays we use f with -# a zero label instead of p.) -# - -is_list p S => too_old_compiler -is_nonempty_list p R => too_old_compiler -is_nil p R => too_old_compiler - -is_tuple p S => too_old_compiler -test_arity p S Arity => too_old_compiler - -is_integer p R => too_old_compiler -is_float p R => too_old_compiler -is_atom p R => too_old_compiler - -is_eq_exact p S1 S2 => too_old_compiler - # In R9C and earlier, the loader used to insert special instructions inside # the module_info/0,1 functions. (In R10B and later, the compiler inserts # an explicit call to an undocumented BIF, so that no loader trickery is -- cgit v1.2.3 From 3b3bb767433a333750b090908fa370d957bbbfa2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 13 Jun 2011 14:38:52 +0200 Subject: Generalize and rename is_set_var_instr() to is_instr() It is more useful to have a helper function that can test for any instruction. --- erts/emulator/utils/beam_makeops | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index ebf7db3277..75047f22bd 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1437,7 +1437,7 @@ sub tr_gen_from { push(@code, &make_op($var, 'set_var', $var{$var})); } } - if (is_set_var_instr($code[$#code])) { + if (is_instr($code[$#code], 'set_var')) { my $ref = pop @code; my $comment = $ref->[2]; my $var = $ref->[1][1]; @@ -1560,7 +1560,7 @@ sub tr_gen_to { } push(@code, &make_op('', 'next_arg')); } - pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + pop(@code) if is_instr($code[$#code], 'next_arg'); } push(@code, &make_op('', 'end')); @@ -1597,10 +1597,10 @@ sub make_op { [scalar(@op), [@op], $comment]; } -sub is_set_var_instr { - my($ref) = @_; +sub is_instr { + my($ref,$op) = @_; return 0 unless ref($ref) eq 'ARRAY'; - $ref->[1][0] eq 'set_var'; + $ref->[1][0] eq $op; } sub tr_gen_call { -- cgit v1.2.3 From f354e22115c8b92753fae861698945ff64970294 Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Tue, 11 Oct 2011 09:36:56 +0200 Subject: Put back ssl:peercert/1 I accidentally removed a little too much, only peercert/2 was deprecated. --- lib/ssl/src/ssl.erl | 20 +++++++++++++++----- lib/ssl/test/ssl_basic_SUITE.erl | 40 +++++++++++++++++++++++++++++++++++++++- 2 files changed, 54 insertions(+), 6 deletions(-) diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 5819553bd4..35f9410562 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -27,16 +27,13 @@ transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3, cipher_suites/0, cipher_suites/1, close/1, shutdown/2, connect/3, connect/2, connect/4, connection_info/1, - controlling_process/2, listen/2, pid/1, peername/1, recv/2, - recv/3, send/2, getopts/2, setopts/2, sockname/1, + controlling_process/2, listen/2, pid/1, peername/1, peercert/1, + recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1, versions/0, session_info/1, format_error/1, renegotiate/1]). -%% Should be deprecated as soon as old ssl is removed -deprecated({pid, 1, next_major_release}). -%-deprecated({peercert, 2, next_major_release}). -%%-include("ssl_int.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). @@ -287,6 +284,19 @@ connection_info(#sslsocket{pid = Pid}) -> peername(#sslsocket{pid = Pid}) -> ssl_connection:peername(Pid). +%%-------------------------------------------------------------------- +-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. +%% +%% Description: Returns the peercert. +%%-------------------------------------------------------------------- +peercert(#sslsocket{pid = Pid}) -> + case ssl_connection:peer_certificate(Pid) of + {ok, undefined} -> + {error, no_peercert}; + Result -> + Result + end. + %%-------------------------------------------------------------------- -spec cipher_suites() -> [erl_cipher_suite()]. -spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()]. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index d5cd3b3b4b..a9109c5a6e 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -207,7 +207,7 @@ all() -> [app, alerts, connection_info, protocol_versions, empty_protocol_versions, controlling_process, controller_dies, client_closes_socket, - connect_dist, peername, sockname, socket_options, + connect_dist, peername, peercert, sockname, socket_options, invalid_inet_get_option, invalid_inet_get_option_not_list, invalid_inet_get_option_improper_list, invalid_inet_set_option, invalid_inet_set_option_not_list, @@ -662,6 +662,44 @@ peername(Config) when is_list(Config) -> peername_result(S) -> ssl:peername(S). +%%-------------------------------------------------------------------- +peercert(doc) -> + [""]; +peercert(suite) -> + []; +peercert(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, peercert_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, peercert_result, []}}, + {options, ClientOpts}]), + + CertFile = proplists:get_value(certfile, ServerOpts), + [{'Certificate', BinCert, _}]= ssl_test_lib:pem_to_der(CertFile), + + ServerMsg = {error, no_peercert}, + ClientMsg = {ok, BinCert}, + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +peercert_result(Socket) -> + ssl:peercert(Socket). + %%-------------------------------------------------------------------- sockname(doc) -> ["Test API function sockname/1"]; -- cgit v1.2.3 From ce653bf162c96e1da12b8a11688aa15ddf7d1a02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 13 Jun 2011 14:53:31 +0200 Subject: Remove redundant 'next_arg' before 'next_instr' Fix the incorrect code that attempted to remove a single 'next_arg' instructions before 'next_instr'. --- erts/emulator/utils/beam_makeops | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 75047f22bd..b5187dd676 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1446,8 +1446,9 @@ sub tr_gen_from { push(@code, &make_op('', 'next_arg')); } } + # Remove redundant 'next_arg' instructions before 'next_instr'. + pop(@code) while is_instr($code[$#code], 'next_arg'); push(@code, &make_op('', 'next_instr')); - pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; } # -- cgit v1.2.3 From 929c67fdaca5de8ea9ac3c602acbbaccd074a492 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 13 Jun 2011 14:19:48 +0200 Subject: In transformations, don't store variables that are never used This optimization will save some space (in the loader tables) and some loading time. --- erts/emulator/utils/beam_makeops | 57 +++++++++++++++++++++++++++++++++++++--- 1 file changed, 53 insertions(+), 4 deletions(-) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index b5187dd676..f1fa71fd9e 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1304,7 +1304,8 @@ sub tr_gen { foreach $ref (@g) { my($line, $orig_transform, $from_ref, $to_ref) = @$ref; - my $so_far = tr_gen_from($line, @$from_ref); + my $used_ref = used_vars($from_ref, $to_ref); + my $so_far = tr_gen_from($line, $used_ref, @$from_ref); tr_gen_to($line, $orig_transform, $so_far, @$to_ref); } @@ -1342,8 +1343,48 @@ sub tr_gen { print "};\n\n"; } +sub used_vars { + my($from_ref,$to_ref) = @_; + my %used; + my %seen; + + foreach my $ref (@$from_ref) { + my($name,$arity,@ops) = @$ref; + if ($name =~ /^[.]/) { + foreach my $var (@ops) { + $used{$var} = 1; + } + } else { + # Any variable that is used at least twice on the + # left-hand side is used. (E.g. "move R R".) + foreach my $op (@ops) { + my($var, $type, $type_val) = @$op; + next if $var eq ''; + $used{$var} = 1 if $seen{$var}; + $seen{$var} = 1; + } + } + } + + foreach my $ref (@$to_ref) { + my($name, $arity, @ops) = @$ref; + if ($name =~ /^[.]/) { + foreach my $var (@ops) { + $used{$var} = 1; + } + } else { + foreach my $op (@ops) { + my($var, $type, $type_val) = @$op; + next if $var eq ''; + $used{$var} = 1; + } + } + } + \%used; +} + sub tr_gen_from { - my($line, @tr) = @_; + my($line,$used_ref,@tr) = @_; my(%var) = (); my(%var_type); my($var_num) = 0; @@ -1353,6 +1394,7 @@ sub tr_gen_from { my(@fix_pred_funcs); my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; + my %var_used = %$used_ref; foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; @@ -1387,6 +1429,7 @@ sub tr_gen_from { $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; + my $ignored_var = "$var (ignored)"; if ($type ne '' && $type ne '*') { # @@ -1394,6 +1437,7 @@ sub tr_gen_from { # their own built-in type test and don't need to # be guarded with a type test instruction. # + $ignored_var = ''; unless ($cond eq 'is_bif' or $cond eq 'is_not_bif' or $cond eq 'is_func') { @@ -1415,22 +1459,27 @@ sub tr_gen_from { if ($cond eq 'is_func') { my($m, $f, $a) = split(/:/, $val); + $ignored_var = ''; push(@code, &make_op('', "$cond", "am_$m", "am_$f", $a)); } elsif ($cond ne '') { + $ignored_var = ''; push(@code, &make_op('', "$cond", $val)); } if ($var ne '') { if (defined $var{$var}) { + $ignored_var = ''; push(@code, &make_op($var, 'is_same_var', $var{$var})); } elsif ($type eq '*') { # # Reserve a hole for a 'rest_args' instruction. # + $ignored_var = ''; push(@fix_rest_args, scalar(@code)); push(@code, $var); - } else { + } elsif ($var_used{$var}) { + $ignored_var = ''; $var_type{$var} = 'scalar'; $var{$var} = $var_num; $var_num++; @@ -1443,7 +1492,7 @@ sub tr_gen_from { my $var = $ref->[1][1]; push(@code, make_op($comment, 'set_var_next_arg', $var)); } else { - push(@code, &make_op('', 'next_arg')); + push(@code, &make_op($ignored_var, 'next_arg')); } } # Remove redundant 'next_arg' instructions before 'next_instr'. -- cgit v1.2.3 From eea824979a7e8dfd760b943b1790663849862342 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 13 Jun 2011 16:14:48 +0200 Subject: Add some more information in instruction comments --- erts/emulator/utils/beam_makeops | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index f1fa71fd9e..ec3d6c067d 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1451,7 +1451,7 @@ sub tr_gen_from { push(@code, &make_op($types, 'is_type', $type_mask)); } else { $cond = ''; - push(@code, &make_op($types, 'is_type_eq', + push(@code, &make_op("$types== $val", 'is_type_eq', $type_mask, $val)); } } @@ -1629,7 +1629,8 @@ sub tr_gen_to { if defined @{$gen_transform{$key}}; # Fail my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code))); unshift(@code, @prefix); - push(@{$gen_transform{$key}}, @code, &make_op('', 'fail')); + push(@{$gen_transform{$key}}, + @code, make_op(""), make_op("$key", 'fail')); } sub tr_code_len { -- cgit v1.2.3 From fe32a91def97823b036ccad946b84853688b41af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 13 Jun 2011 17:43:59 +0200 Subject: Get rid of redundant 'try_me_else' and 'fail' instructions If the left part of a transformation will always match, omit the the 'try_me_else' and 'fail' instructions. As part of this optimization, make it an error to have a transformation that can never be reached because of a previous transformation that will always match. (Remove one transformation from ops.tab that was found to be unreachable.) --- erts/emulator/beam/beam_load.c | 1 - erts/emulator/beam/ops.tab | 2 -- erts/emulator/utils/beam_makeops | 43 ++++++++++++++++++++++++++++++++++------ 3 files changed, 37 insertions(+), 9 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 16dd5795c7..4da411be1f 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4238,7 +4238,6 @@ transform_engine(LoaderState* st) ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail); instr = st->genop; #define RETURN(r) rval = (r); goto do_return; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index dcfd9063d9..08d2e35fbb 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -595,8 +595,6 @@ get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg original_reg Reg Pos => -get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst - original_reg/2 extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index ec3d6c067d..7b66496856 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1395,18 +1395,24 @@ sub tr_gen_from { my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; my %var_used = %$used_ref; + my $may_fail = 0; + my $is_first = 1; foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; my($key) = "$name/$arity"; my($opnum); + $may_fail = 1 unless $is_first; + $is_first = 0; + # # A name starting with a period is a C pred function to be called. # if ($name =~ /^\.(\w+)/) { $name = $1; + $may_fail = 1; my $var; my(@args); @@ -1432,6 +1438,8 @@ sub tr_gen_from { my $ignored_var = "$var (ignored)"; if ($type ne '' && $type ne '*') { + $may_fail = 1; + # # The is_bif, is_not_bif, and is_func instructions have # their own built-in type test and don't need to @@ -1460,16 +1468,19 @@ sub tr_gen_from { if ($cond eq 'is_func') { my($m, $f, $a) = split(/:/, $val); $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", "am_$m", "am_$f", $a)); } elsif ($cond ne '') { $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", $val)); } if ($var ne '') { if (defined $var{$var}) { $ignored_var = ''; + $may_fail = 1; push(@code, &make_op($var, 'is_same_var', $var{$var})); } elsif ($type eq '*') { # @@ -1504,7 +1515,8 @@ sub tr_gen_from { # Insert the commit operation. # pop(@code); # Get rid of 'next_instr' - push(@code, &make_op('', 'commit')); + + push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); # # If there is an rest_args instruction, we must insert its correct @@ -1553,6 +1565,10 @@ sub tr_gen_to { my($op, $ref); # Loop variables. my($where) = "right side of transformation in line $line: "; + my $last_instr = $code[$#code]; + my $cannot_fail = is_instr($last_instr, 'commit') && + (get_comment($last_instr) =~ /^always/); + foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; @@ -1625,12 +1641,20 @@ sub tr_gen_to { $min_window{$key} = $min_window if $min_window{$key} > $min_window; - pop(@{$gen_transform{$key}}) + my $prev_last; + $prev_last = pop(@{$gen_transform{$key}}) if defined @{$gen_transform{$key}}; # Fail - my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code))); - unshift(@code, @prefix); - push(@{$gen_transform{$key}}, - @code, make_op(""), make_op("$key", 'fail')); + + if ($prev_last && !is_instr($prev_last, 'fail')) { + error("Line $line: A previous transformation shadows '$orig_transform'"); + } + unless ($cannot_fail) { + unshift(@code, make_op('', 'try_me_else', + tr_code_len(@code))); + push(@code, make_op(""), make_op("$key", 'fail')); + } + unshift(@code, make_op($comment)); + push(@{$gen_transform{$key}}, @code), } sub tr_code_len { @@ -1654,6 +1678,13 @@ sub is_instr { $ref->[1][0] eq $op; } +sub get_comment { + my($ref,$op) = @_; + return '' unless ref($ref) eq 'ARRAY'; + $ref->[2]; +} + + sub tr_gen_call { my(@call_table) = @_; my($i); -- cgit v1.2.3 From 5bd8f04a8a4b5c7a3f859355dd47dab27c6fa494 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 15 Jun 2011 07:29:52 +0200 Subject: Remove some unnecessary type constraints in transformations We don't need type constraints that essentially are assertions; the wrong type will be detected and loading aborted when no specific instruction can be found. --- erts/emulator/beam/ops.tab | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 08d2e35fbb..fc98c399c1 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -919,9 +919,9 @@ move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r -call_ext Ar=u Func => i_call_ext Func -call_ext_last Ar=u Func D => i_call_ext_last Func D -call_ext_only Ar=u Func => i_call_ext_only Func +call_ext Ar Func => i_call_ext Func +call_ext_last Ar Func D => i_call_ext_last Func D +call_ext_only Ar Func => i_call_ext_only Func i_apply i_apply_last P @@ -955,7 +955,7 @@ bif1 p Bif S1 Dst => bif1_body Bif S1 Dst bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst -bif2 Fail=f Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst +bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst i_get s d @@ -1038,8 +1038,8 @@ i_move_call_ext_only e c r # Fun calls. -call_fun Arity=u | deallocate D | return => i_call_fun_last Arity D -call_fun Arity=u => i_call_fun Arity +call_fun Arity | deallocate D | return => i_call_fun_last Arity D +call_fun Arity => i_call_fun Arity i_call_fun I i_call_fun_last I P @@ -1295,13 +1295,13 @@ i_bs_utf16_size s d bs_put_utf8 Fail=j Flags=u Literal=q => \ move Literal x | bs_put_utf8 Fail Flags x -bs_put_utf8 Fail=j u Src=s => i_bs_put_utf8 Fail Src +bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s bs_put_utf16 Fail=j Flags=u Literal=q => \ move Literal x | bs_put_utf16 Fail Flags x -bs_put_utf16 Fail=j Flags=u Src=s => i_bs_put_utf16 Fail Flags Src +bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src i_bs_put_utf16 j I s -- cgit v1.2.3 From 207436c383995dc6fcea1953f9188f8df280bd81 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 15 Jun 2011 08:03:25 +0200 Subject: Combine a 'call' instruction with the following 'end' instruction A 'call' instruction in the loader transformation language is always followed by an 'end' instruction, so we can replace the 'call' instruction with a 'call_end' instruction. --- erts/emulator/beam/beam_load.c | 6 +++--- erts/emulator/utils/beam_makeops | 5 +++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 4da411be1f..0d639572e0 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4458,8 +4458,8 @@ transform_engine(LoaderState* st) #endif break; -#if defined(TOP_call) - case TOP_call: +#if defined(TOP_call_end) + case TOP_call_end: { GenOp** lastp; GenOp* new_instr; @@ -4496,7 +4496,7 @@ transform_engine(LoaderState* st) *lastp = st->genop; st->genop = new_instr; } - break; + RETURN(TE_OK); #endif case TOP_new_instr: /* diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 7b66496856..2272a941bb 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1591,7 +1591,7 @@ sub tr_gen_to { } } pop(@code); # Get rid of 'next_instr' - push(@code, &make_op("$name()", 'call', scalar(@call_table))); + push(@code, make_op("$name()", 'call_end', scalar(@call_table))); push(@call_table, [$name, @args]); last; } @@ -1629,7 +1629,8 @@ sub tr_gen_to { pop(@code) if is_instr($code[$#code], 'next_arg'); } - push(@code, &make_op('', 'end')); + push(@code, make_op('', 'end')) + unless is_instr($code[$#code], 'call_end'); # # Chain together all codes segments having the same first operation. -- cgit v1.2.3 From cac63dbe2da001e050be70664cb6421cdea33430 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 5 Aug 2011 14:49:34 +0200 Subject: Merge 'new_instr' and 'store_op' into 'new_instr' Since the 'new_instr' instruction always occurs before the 'store_op' instruction, we can merge the instructions into one. Also, there is no need to include the arity of the BEAM instruction as an operand, since the arity can be looked up based on the opcode. --- erts/emulator/beam/beam_load.c | 6 ++---- erts/emulator/utils/beam_makeops | 5 ++--- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 0d639572e0..551bc399e7 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4505,12 +4505,10 @@ transform_engine(LoaderState* st) NEW_GENOP(st, instr); instr->next = st->genop; st->genop = instr; + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; ap = 0; break; - case TOP_store_op: - instr->op = *pc++; - instr->arity = *pc++; - break; case TOP_store_type: i = *pc++; instr->a[ap].type = i; diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 2272a941bb..d71531a1f1 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1590,7 +1590,7 @@ sub tr_gen_to { push(@args, "var+$var{$var}"); } } - pop(@code); # Get rid of 'next_instr' + pop(@code); # Get rid of 'commit' instruction push(@code, make_op("$name()", 'call_end', scalar(@call_table))); push(@call_table, [$name, @args]); last; @@ -1609,8 +1609,7 @@ sub tr_gen_to { # Create code to build the generic instruction. # - push(@code, &make_op('', 'new_instr')); - push(@code, &make_op("$name/$arity", 'store_op', $opnum, $arity)); + push(@code, make_op("$name/$arity", 'new_instr', $opnum)); foreach $op (@ops) { my($var, $type, $type_val) = @$op; -- cgit v1.2.3 From 3f8f70e8594ee956dba7edb3602dc9e26e144a69 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 5 Aug 2011 15:15:43 +0200 Subject: Merge 'next_instr' and 'is_op' into 'next_instr' 'next_instr' is always followed by 'is_op'. --- erts/emulator/beam/beam_load.c | 8 +++----- erts/emulator/utils/beam_makeops | 11 ++++------- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 551bc399e7..e858305e9c 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4250,7 +4250,9 @@ transform_engine(LoaderState* st) op = *pc++; switch (op) { - case TOP_is_op: + case TOP_next_instr: + instr = instr->next; + ap = 0; if (instr == NULL) { /* * We'll need at least one more instruction to decide whether @@ -4437,10 +4439,6 @@ transform_engine(LoaderState* st) case TOP_next_arg: ap++; break; - case TOP_next_instr: - instr = instr->next; - ap = 0; - break; case TOP_commit: instr = instr->next; /* The next_instr was optimized away. */ diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index d71531a1f1..5e86356e10 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1416,10 +1416,8 @@ sub tr_gen_from { my $var; my(@args); - my $next_instr = pop(@code); # Get rid of 'next_instr' push(@fix_pred_funcs, scalar(@code)); push(@code, [$name, @ops]); - push(@code, $next_instr); next; } @@ -1431,7 +1429,7 @@ sub tr_gen_from { unless defined $gen_opnum{$name,$arity}; $opnum = $gen_opnum{$name,$arity}; - push(@code, &make_op("$name/$arity", 'is_op', $opnum)); + push(@code, make_op("$name/$arity", 'next_instr', $opnum)); $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; @@ -1506,16 +1504,15 @@ sub tr_gen_from { push(@code, &make_op($ignored_var, 'next_arg')); } } - # Remove redundant 'next_arg' instructions before 'next_instr'. + + # Remove redundant 'next_arg' instructions before the end + # of the instruction. pop(@code) while is_instr($code[$#code], 'next_arg'); - push(@code, &make_op('', 'next_instr')); } # # Insert the commit operation. # - pop(@code); # Get rid of 'next_instr' - push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); # -- cgit v1.2.3 From e87760199eb9d3c02480e92a0bcf76864c750972 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 8 Aug 2011 09:42:26 +0200 Subject: Combine 'store_var' with 'next_arg' 'store_var' is always followed by 'next_arg'. --- erts/emulator/beam/beam_load.c | 3 ++- erts/emulator/utils/beam_makeops | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index e858305e9c..7d2b4dea28 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4516,11 +4516,12 @@ transform_engine(LoaderState* st) i = *pc++; instr->a[ap].val = i; break; - case TOP_store_var: + case TOP_store_var_next_arg: i = *pc++; ASSERT(i < TE_MAX_VARS); instr->a[ap].type = var[i].type; instr->a[ap].val = var[i].val; + ap++; break; case TOP_try_me_else: restart = pc + 1; diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 5e86356e10..9c7e5e94a5 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1613,14 +1613,14 @@ sub tr_gen_to { if ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; - push(@code, &make_op($var, 'store_var', $var{$var})); + push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); } elsif ($type ne '') { push(@code, &make_op('', 'store_type', "TAG_$type")); if ($type_val) { push(@code, &make_op('', 'store_val', $type_val)); } + push(@code, make_op('', 'next_arg')); } - push(@code, &make_op('', 'next_arg')); } pop(@code) if is_instr($code[$#code], 'next_arg'); } -- cgit v1.2.3 From 2a30746d09f467c13e9361774867462ae4f2bd32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 9 Aug 2011 16:49:39 +0200 Subject: Introduce 'try_me_else_fail' --- erts/emulator/beam/beam_load.c | 6 +++++- erts/emulator/utils/beam_makeops | 21 ++++++++++++++++++++- 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 7d2b4dea28..655b5496a8 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4225,6 +4225,7 @@ transform_engine(LoaderState* st) GenOp* instr; Uint* pc; int rval; + static Uint restart_fail[1] = {TOP_fail}; ASSERT(gen_opc[st->genop->op].transform != -1); pc = op_transform + gen_opc[st->genop->op].transform; @@ -4528,10 +4529,13 @@ transform_engine(LoaderState* st) restart += *pc++; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ break; + case TOP_try_me_else_fail: + restart = restart_fail; + break; case TOP_end: RETURN(TE_OK); case TOP_fail: - RETURN(TE_FAIL) + RETURN(TE_FAIL); default: ASSERT(0); } diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 9c7e5e94a5..367f089401 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -186,6 +186,12 @@ sub define_type_bit { define_type_bit('Q', $type_bit{'u'}); } +# +# Pre-define the 'fail' instruction. It is used internally +# by the 'try_me_else_fail' instruction. +# +$match_engine_ops{'TOP_fail'} = 1; + # # Sanity checks. # @@ -1316,7 +1322,20 @@ sub tr_gen { print "Uint op_transform[] = {\n"; foreach $key (keys %gen_transform) { $gen_transform_offset{$key} = $offset; - foreach $instr (@{$gen_transform{$key}}) { + my @instr = @{$gen_transform{$key}}; + + # + # If the last instruction is 'fail', remove it and + # convert the previous 'try_me_else' to 'try_me_else_fail'. + # + if (is_instr($instr[$#instr], 'fail')) { + pop(@instr); + my $i = $#instr; + $i-- while !is_instr($instr[$i], 'try_me_else'); + $instr[$i] = make_op('', 'try_me_else_fail'); + } + + foreach $instr (@instr) { my($size, $instr_ref, $comment) = @$instr; my($op, @args) = @$instr_ref; print " "; -- cgit v1.2.3 From f2e79b0670d1c56205ae89ac248de53f46d56ee8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 10 Aug 2011 15:14:36 +0200 Subject: Refactor 'too_old_compiler' handling In the handling of generic instructions, we used to always test whether the instruction was 'too_old_compiler' and abort loading with a special error message. Refactor the code so that we only do test if we an error has occurred. That will allow us to make the test more expensive in the future, allowing us to customize error messages for certain opcode without any cost in the successful case. --- erts/emulator/beam/beam_emu.c | 1 - erts/emulator/beam/beam_load.c | 22 +++++++++++++--------- erts/emulator/beam/ops.tab | 2 +- 3 files changed, 14 insertions(+), 11 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index eec9ecb410..5691f7aec1 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -5155,7 +5155,6 @@ void process_main(void) OpCase(int_code_end): OpCase(label_L): - OpCase(too_old_compiler): OpCase(on_load): OpCase(line_I): erl_exit(1, "meta op\n"); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 655b5496a8..7c32518ba9 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1886,14 +1886,6 @@ load_code(LoaderState* stp) goto get_next_instr; } - /* - * Special error message instruction. - */ - if (stp->genop->op == genop_too_old_compiler_0) { - LoadError0(stp, "please re-compile this module with an " - ERLANG_OTP_RELEASE " compiler"); - } - /* * From the collected generic instruction, find the specific * instruction. @@ -1945,7 +1937,17 @@ load_code(LoaderState* stp) ERLANG_OTP_RELEASE " compiler "); } - LoadError0(stp, "no specific operation found"); + /* + * Some generic instructions should have a special + * error message. + */ + switch (stp->genop->op) { + case genop_too_old_compiler_0: + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler"); + default: + LoadError0(stp, "no specific operation found"); + } } stp->specific_op = specific; @@ -2409,6 +2411,8 @@ load_code(LoaderState* stp) #define no_fpe_signals(St) 0 #endif +#define never(St) 0 + /* * Predicate that tests whether a jump table can be used. */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index fc98c399c1..327c4e8651 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -30,7 +30,7 @@ # needs to be re-compiled with a modern compiler. too_old_compiler/0 -too_old_compiler +too_old_compiler | never() => # In R9C and earlier, the loader used to insert special instructions inside # the module_info/0,1 functions. (In R10B and later, the compiler inserts -- cgit v1.2.3 From c75c84657c1b65c5df24e3c9316a25cb67803873 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 10 Aug 2011 08:16:07 +0200 Subject: Simplify transformations of gc_bif[123] instructions Each gc_bif[123] instruction must have both a transformation in ops.tab and special code in gen_guard_bif[123](). Rewrite it to do most of the work in gen_guard_bif[123](). --- erts/emulator/beam/beam_load.c | 77 ++++++++++++++++++++++++++++++------------ erts/emulator/beam/ops.tab | 36 +++++++------------- 2 files changed, 68 insertions(+), 45 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 7c32518ba9..de4b32b238 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1945,6 +1945,16 @@ load_code(LoaderState* stp) case genop_too_old_compiler_0: LoadError0(stp, "please re-compile this module with an " ERLANG_OTP_RELEASE " compiler"); + case genop_unsupported_guard_bif_3: + { + Eterm Mod = (Eterm) stp->genop->a[0].val; + Eterm Name = (Eterm) stp->genop->a[1].val; + Uint arity = (Uint) stp->genop->a[2].val; + FREE_GENOP(stp, stp->genop); + stp->genop = 0; + LoadError3(stp, "unsupported guard BIF: %T:%T/%d\n", + Mod, Name, arity); + } default: LoadError0(stp, "no specific operation found"); } @@ -3668,10 +3678,7 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_i_gc_bif1_5; - op->arity = 5; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ @@ -3692,19 +3699,30 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, } else if (bf == trunc_1) { op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_i_gc_bif1_5; + op->arity = 5; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = Src; op->a[3] = Live; op->a[4] = Dst; - op->next = NULL; return op; } /* - * This is used by the ops.tab rule that rewrites gc_bifs with two parameters + * This is used by the ops.tab rule that rewrites gc_bifs with two parameters. * The instruction returned is then again rewritten to an i_load instruction - * folowed by i_gc_bif2_jIId, to handle literals properly. + * followed by i_gc_bif2_jIId, to handle literals properly. * As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is * always rewritten, regardless of if there actually are any literals. */ @@ -3716,31 +3734,39 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_ii_gc_bif2_6; - op->arity = 6; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ if (bf == binary_part_2) { op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_ii_gc_bif2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = S1; op->a[3] = S2; op->a[4] = Live; op->a[5] = Dst; - op->next = NULL; return op; } /* - * This is used by the ops.tab rule that rewrites gc_bifs with three parameters + * This is used by the ops.tab rule that rewrites gc_bifs with three parameters. * The instruction returned is then again rewritten to a move instruction that * uses r[0] for temp storage, followed by an i_load instruction, - * folowed by i_gc_bif3_jIsId, to handle literals properly. Rewriting + * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting * always occur, as with the gc_bif2 counterpart. */ static GenOp* @@ -3751,18 +3777,27 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_ii_gc_bif3_7; - op->arity = 7; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; bf = stp->import[Bif.val].bf; /* The translations here need to have a reverse counterpart in beam_emu.c:translate_gc_bif for error handling to work properly. */ if (bf == binary_part_3) { op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_ii_gc_bif3_7; + op->arity = 7; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = S1; op->a[3] = S2; op->a[4] = S3; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 327c4e8651..34bd5d0653 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1466,34 +1466,13 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler # # Guard BIFs. # -gc_bif1 Fail I Bif=u$bif:erlang:length/1 Src Dst=d => \ +gc_bif1 Fail I Bif Src Dst => \ gen_guard_bif1(Fail, I, Bif, Src, Dst) -gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \ +gc_bif2 Fail I Bif S1 S2 Dst => \ gen_guard_bif2(Fail, I, Bif, S1, S2, Dst) -gc_bif3 Fail I Bif=u$bif:erlang:binary_part/3 S1 S2 S3 Dst=d => \ +gc_bif3 Fail I Bif S1 S2 S3 Dst => \ gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D @@ -1511,6 +1490,15 @@ ii_gc_bif3/7 ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D i_gc_bif3 j I s I d + +# +# The following instruction is specially handled in beam_load.c +# to produce a user-friendly message if an unsupported guard BIF is +# encountered. +# +unsupported_guard_bif/3 +unsupported_guard_bif A B C | never() => + # # R13B03 # -- cgit v1.2.3 From 39c0668121ff347877090e3ed237214f873c3e55 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 11 Aug 2011 10:39:01 +0200 Subject: Share code for call of predicate and transformation functions --- erts/emulator/utils/beam_makeops | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 367f089401..fa3f3ed5e3 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -105,7 +105,9 @@ my %match_engine_ops; # All opcodes for the match engine. my %gen_transform_offset; my @transformations; my @call_table; +my %call_table; my @pred_table; +my %pred_table; # Operand types for generic instructions. @@ -1562,9 +1564,8 @@ sub tr_gen_from { push(@args, "var+$var{$var}"); } } - splice(@code, $index, 1, &make_op("$name()", - 'pred', scalar(@pred_table))); - push(@pred_table, [$name, @args]); + my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); + splice(@code, $index, 1, make_op("$name()", 'pred', $pi)); } $te_max_vars = $var_num @@ -1607,8 +1608,9 @@ sub tr_gen_to { } } pop(@code); # Get rid of 'commit' instruction - push(@code, make_op("$name()", 'call_end', scalar(@call_table))); - push(@call_table, [$name, @args]); + my $index = tr_next_index(\@call_table, \%call_table, + $name, @args); + push(@code, make_op("$name()", 'call_end', $index)); last; } @@ -1700,16 +1702,26 @@ sub get_comment { $ref->[2]; } +sub tr_next_index { + my($lref,$href,$name,@args) = @_; + my $code = "RVAL = $name(" . join(', ', 'st', @args) . "); break;\n"; + my $index; + + if (defined $$href{$code}) { + $index = $$href{$code}; + } else { + $index = scalar(@$lref); + push(@$lref, $code); + $$href{$code} = $index; + } + $index; +} sub tr_gen_call { my(@call_table) = @_; my($i); - print "\n"; for ($i = 0; $i < @call_table; $i++) { - my $ref = $call_table[$i]; - my($name, @args) = @$ref; - print "case $i: RVAL = $name(", join(', ', 'st', @args), "); break;\n"; + print "case $i: $call_table[$i]"; } - print "\n"; } -- cgit v1.2.3 From 09a5930d116bc4ebfac9404845bed8181662a0db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 11 Aug 2011 10:42:02 +0200 Subject: Print transformtions sorted on the name of the first instruction --- erts/emulator/utils/beam_makeops | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index fa3f3ed5e3..58c36c3bdc 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1322,7 +1322,7 @@ sub tr_gen { # my($offset) = 0; print "Uint op_transform[] = {\n"; - foreach $key (keys %gen_transform) { + foreach $key (sort keys %gen_transform) { $gen_transform_offset{$key} = $offset; my @instr = @{$gen_transform{$key}}; -- cgit v1.2.3 From e04883d448df6e622535020449903e2f2a0f32c9 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 26 Jul 2011 17:11:41 +0200 Subject: Update integer and floating point number comparisons For floating point values which are greater than 9007199254740990.0 or smaller than -9007199254740990.0, the floating point numbers are now converted to integers during comparison with an integer. This makes number comparisons transitive for large floating point numbers. --- erts/emulator/beam/big.c | 57 +++++++++++++++++++++++++++++++++++++++++++ erts/emulator/beam/big.h | 1 + erts/emulator/beam/erl_vm.h | 2 +- erts/emulator/beam/utils.c | 59 ++++++++++++++++++++++++++++++++++++--------- 4 files changed, 107 insertions(+), 12 deletions(-) diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index d18de9ae5d..51e5d2d305 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1584,6 +1584,63 @@ big_to_double(Wterm x, double* resp) return 0; } +Eterm +double_to_big(double x, Eterm *heap) +{ + int is_negative; + int ds; + ErtsDigit* xp; + Eterm tmp_res; + int i; + size_t sz; + Eterm* hp; + double dbase; + + if ((x < (double) (MAX_SMALL + 1)) && (x > (double) (MIN_SMALL - 1))) { + Sint xi = x; + return make_small(xi); + } + + if (x >= 0) { + is_negative = 0; + } else { + is_negative = 1; + x = -x; + } + + /* Unscale & (calculate exponent) */ + ds = 0; + dbase = ((double) (D_MASK) + 1); + while (x >= 1.0) { + x /= dbase; /* "shift" right */ + ds++; + } + sz = BIG_NEED_SIZE(ds); /* number of words including arity */ + + hp = heap; + tmp_res = make_big(hp); + xp = (ErtsDigit*) (hp + 1); + + for (i = ds - 1; i >= 0; i--) { + ErtsDigit d; + + x *= dbase; /* "shift" left */ + d = x; /* trunc */ + xp[i] = d; /* store digit */ + x -= d; /* remove integer part */ + } + while ((ds & (BIG_DIGITS_PER_WORD - 1)) != 0) { + xp[ds++] = 0; + } + + if (is_negative) { + *hp = make_neg_bignum_header(sz-1); + } else { + *hp = make_pos_bignum_header(sz-1); + } + return tmp_res; +} + /* ** Estimate the number of decimal digits (include sign) diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 2afc37004f..256f1c2b45 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -140,6 +140,7 @@ Eterm big_lshift(Eterm, Sint, Eterm*); int big_comp (Wterm, Wterm); int big_ucomp (Eterm, Eterm); int big_to_double(Wterm x, double* resp); +Eterm double_to_big(double, Eterm*); Eterm small_to_big(Sint, Eterm*); Eterm uint_to_big(Uint, Eterm*); Eterm uword_to_big(UWord, Eterm*); diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index e7fd144ec3..ed9139518c 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -55,7 +55,7 @@ heap data on the C stack or if we use the buffers in the scheduler data. */ #define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers small heap for transient heap data */ -#define CMP_TMP_HEAP_SIZE 2 /* cmp wants its own tmp-heap... */ +#define CMP_TMP_HEAP_SIZE 16 /* cmp wants its own tmp-heap... */ #define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */ #define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 3f6accba2d..e67a793b9a 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2642,7 +2642,7 @@ tailrecur_ne: FloatDef f1, f2; Eterm big; #if HEAP_ON_C_STACK - Eterm big_buf[2]; /* If HEAP_ON_C_STACK */ + Eterm big_buf[16]; /* If HEAP_ON_C_STACK */ #else Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap; #endif @@ -2661,33 +2661,70 @@ tailrecur_ne: j = big_comp(big, bw); break; case SMALL_FLOAT: - f1.fd = signed_val(a); GET_DOUBLE(bw, f2); - j = float_comp(f1.fd, f2.fd); + if ((f2.fd < 9007199254740990.0 && f2.fd > -9007199254740990.0)) // Float is within the no loss limit + { + f1.fd = signed_val(a); + j = float_comp(f1.fd, f2.fd); + } else if (f2.fd > (double) (MAX_SMALL + 1)) { // Float is a positive bignum, i.e. bigger + j = -1; + } else if (f2.fd < (double) (MIN_SMALL - 1)) { // Float is a negative bignum, i.e. smaller + j = 1; + } else { // Float is a Sint but less precise it + j = signed_val(a) - (Sint) f2.fd; + } break; case BIG_SMALL: big = small_to_big(signed_val(b), big_buf); j = big_comp(aw, big); break; case BIG_FLOAT: - if (big_to_double(aw, &f1.fd) < 0) { + GET_DOUBLE(bw, f2); + if ((f2.fd < 9007199254740990.0 && f2.fd > -9007199254740990.0)) { + if (big_to_double(aw, &f1.fd) < 0) { + j = big_sign(a) ? -1 : 1; + } else { + j = float_comp(f1.fd, f2.fd); + } + } else if ((f2.fd < (double) (MAX_SMALL + 1)) && (f2.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint + j = big_sign(a) ? -1 : 1; + } else if (big_arity(a) > ((1 << 10) / D_EXP)) { // If bignum size is larger than largest/smallest float j = big_sign(a) ? -1 : 1; } else { - GET_DOUBLE(bw, f2); - j = float_comp(f1.fd, f2.fd); + big = double_to_big(f2.fd, big_buf); + j = big_comp(aw, big); } break; case FLOAT_SMALL: GET_DOUBLE(aw, f1); - f2.fd = signed_val(b); - j = float_comp(f1.fd, f2.fd); + if ((f1.fd < 9007199254740990.0 && f1.fd > -9007199254740990.0)) // Float is within the no loss limit + { + f2.fd = signed_val(b); + j = float_comp(f1.fd, f2.fd); + } else if (f1.fd > (double) (MAX_SMALL + 1)) { // Float is a positive bignum, i.e. bigger + j = 1; + } else if (f1.fd < (double) (MIN_SMALL - 1)) { // Float is a negative bignum, i.e. smaller + j = -1; + } else { // Float is a Sint but less precise it + j = (Sint) f1.fd - signed_val(b); + } break; case FLOAT_BIG: - if (big_to_double(bw, &f2.fd) < 0) { + GET_DOUBLE(aw, f1); + if ((f1.fd < 9007199254740990.0 && f1.fd > -9007199254740990.0)) { + if (big_to_double(bw, &f2.fd) < 0) { + j = big_sign(b) ? 1 : -1; + } else { + j = float_comp(f1.fd, f2.fd); + } + } else if ((f1.fd < (double) (MAX_SMALL + 1)) + && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint + j = big_sign(b) ? 1 : -1; + } else if (big_arity(b) > ((1 << 10) / D_EXP)) { // If bignum size is larger than largest/smallest float j = big_sign(b) ? 1 : -1; } else { - GET_DOUBLE(aw, f1); - j = float_comp(f1.fd, f2.fd); + big = double_to_big(f1.fd, big_buf); + j = big_comp(big, bw); } break; default: -- cgit v1.2.3 From 5d4e1831fafb5c2cb119d4b2cc5a704f3b9c1c55 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 27 Jul 2011 14:52:29 +0200 Subject: Add float vs integer comparison tests --- erts/emulator/test/float_SUITE.erl | 44 +++++++++++++++++++++++++++++++++++--- 1 file changed, 41 insertions(+), 3 deletions(-) diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index 736510339f..e2e9b9120c 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -25,7 +25,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, - bad_float_unpack/1]). + bad_float_unpack/1,cmp_zero/1, cmp_integer/1, cmp_bignum/1]). -export([otp_7178/1]). @@ -41,10 +41,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, - match, bad_float_unpack]. + match, bad_float_unpack, {group, comparison}]. groups() -> - []. + [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}]. init_per_suite(Config) -> Config. @@ -187,6 +187,44 @@ bad_float_unpack(Config) when is_list(Config) -> bad_float_unpack_match(<>) -> F; bad_float_unpack_match(<>) -> I. +cmp_zero(_Config) -> + cmp(0.5e-323,0). + +cmp_integer(_Config) -> + Axis = (1 bsl 53)-2.0, %% The point where floating points become unprecise + span_cmp(Axis,2,200), + cmp(Axis*Axis, round(Axis)). + +cmp_bignum(_Config) -> + span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float + + %% Test I to I+1 bignum segment overflow + [span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)], + + cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0), + ok. + +span_cmp(Axis) -> + span_cmp(Axis, 50). +span_cmp(Axis, Length) -> + span_cmp(Axis, round(Axis) bsr 52, Length). +span_cmp(Axis, Incr, Length) -> + [cmp(round(Axis*-1.0)+1+I*Incr,Axis*-1.0+I*Incr) + || I <- lists:seq((Length div 2)*-1,(Length div 2))], + [cmp(round(Axis)+1+I*Incr,Axis+I*Incr) || + I <- lists:seq((Length div 2)*-1,(Length div 2))]. + +cmp(Big,Small) -> + BigSmall = lists:flatten( + io_lib:format("~p > ~p",[Big,Small])), + SmallBig = lists:flatten( + io_lib:format("~p < ~p",[Big,Small])), + {_,_,_,true} = {Big,Small,BigSmall, + Big > Small}, + {_,_,_,false} = {Big,Small,SmallBig, + Big < Small}, + {BigSmall, SmallBig}. + id(I) -> I. start_node(Config) when is_list(Config) -> -- cgit v1.2.3 From b47a8245774ee1d57872d99015081e6307e037f1 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 27 Jul 2011 16:41:13 +0200 Subject: Optimise bugnum and small comparison As it is possible to assume that bignums are bigger than smalls, we can just check the sign of the bignum. --- erts/emulator/beam/utils.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index e67a793b9a..5e22aa42c8 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2657,8 +2657,10 @@ tailrecur_ne: switch(_NUMBER_CODE(a_tag, b_tag)) { case SMALL_BIG: - big = small_to_big(signed_val(a), big_buf); - j = big_comp(big, bw); + j = big_sign(bw) ? 1 : -1; + break; + case BIG_SMALL: + j = big_sign(aw) ? -1 : 1; break; case SMALL_FLOAT: GET_DOUBLE(bw, f2); @@ -2674,10 +2676,6 @@ tailrecur_ne: j = signed_val(a) - (Sint) f2.fd; } break; - case BIG_SMALL: - big = small_to_big(signed_val(b), big_buf); - j = big_comp(aw, big); - break; case BIG_FLOAT: GET_DOUBLE(bw, f2); if ((f2.fd < 9007199254740990.0 && f2.fd > -9007199254740990.0)) { -- cgit v1.2.3 From 1224324e4ee4526397725c4aaaf8885ec7da0c4e Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 27 Jul 2011 16:46:08 +0200 Subject: Add heauristics bignum vs float checks These tests are useful when the difference between the bignum and float is larger than one bignum segment. --- erts/emulator/beam/utils.c | 67 +++++++++++++++++++++++++++++----------------- 1 file changed, 42 insertions(+), 25 deletions(-) diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 5e22aa42c8..91e4e50e15 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2653,6 +2653,8 @@ tailrecur_ne: Eterm aw = a; Eterm bw = b; #endif +#define MAX_LOSSLESS_FLOAT ((double)((1L << 53) - 2)) +#define MIN_LOSSLESS_FLOAT ((double)(((1L << 53) - 2)*-1)) b_tag = tag_val_def(bw); switch(_NUMBER_CODE(a_tag, b_tag)) { @@ -2664,30 +2666,39 @@ tailrecur_ne: break; case SMALL_FLOAT: GET_DOUBLE(bw, f2); - if ((f2.fd < 9007199254740990.0 && f2.fd > -9007199254740990.0)) // Float is within the no loss limit - { - f1.fd = signed_val(a); + if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + f1.fd = signed_val(aw); j = float_comp(f1.fd, f2.fd); - } else if (f2.fd > (double) (MAX_SMALL + 1)) { // Float is a positive bignum, i.e. bigger + } else if (f2.fd > (double) (MAX_SMALL + 1)) { + // Float is a positive bignum, i.e. bigger j = -1; - } else if (f2.fd < (double) (MIN_SMALL - 1)) { // Float is a negative bignum, i.e. smaller + } else if (f2.fd < (double) (MIN_SMALL - 1)) { + // Float is a negative bignum, i.e. smaller j = 1; - } else { // Float is a Sint but less precise it - j = signed_val(a) - (Sint) f2.fd; + } else { // Float is a Sint but less precise + j = signed_val(aw) - (Sint) f2.fd; } break; case BIG_FLOAT: GET_DOUBLE(bw, f2); - if ((f2.fd < 9007199254740990.0 && f2.fd > -9007199254740990.0)) { + if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit if (big_to_double(aw, &f1.fd) < 0) { - j = big_sign(a) ? -1 : 1; + j = big_sign(aw) ? -1 : 1; } else { j = float_comp(f1.fd, f2.fd); } - } else if ((f2.fd < (double) (MAX_SMALL + 1)) && (f2.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint - j = big_sign(a) ? -1 : 1; - } else if (big_arity(a) > ((1 << 10) / D_EXP)) { // If bignum size is larger than largest/smallest float - j = big_sign(a) ? -1 : 1; + } else if ((f2.fd < (double) (MAX_SMALL + 1)) + && (f2.fd > (double) (MIN_SMALL - 1))) { + // Float is a Sint + j = big_sign(aw) ? -1 : 1; + } else if ( (( 1 << (big_arity(aw)*D_EXP))-1) > f2.fd) { + // If bignum size shows that it is bigger than the float + j = -1; + } else if ( (( 1 << (big_arity(aw)*D_EXP))-1)*-1 < f2.fd) { + // If bignum size shows that it is smaller than the float + j = 1; } else { big = double_to_big(f2.fd, big_buf); j = big_comp(aw, big); @@ -2695,31 +2706,37 @@ tailrecur_ne: break; case FLOAT_SMALL: GET_DOUBLE(aw, f1); - if ((f1.fd < 9007199254740990.0 && f1.fd > -9007199254740990.0)) // Float is within the no loss limit - { - f2.fd = signed_val(b); + if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + f2.fd = signed_val(bw); j = float_comp(f1.fd, f2.fd); - } else if (f1.fd > (double) (MAX_SMALL + 1)) { // Float is a positive bignum, i.e. bigger + } else if (f1.fd > (double) (MAX_SMALL + 1)) { + // Float is a positive bignum, i.e. bigger j = 1; - } else if (f1.fd < (double) (MIN_SMALL - 1)) { // Float is a negative bignum, i.e. smaller + } else if (f1.fd < (double) (MIN_SMALL - 1)) { + // Float is a negative bignum, i.e. smaller j = -1; } else { // Float is a Sint but less precise it - j = (Sint) f1.fd - signed_val(b); + j = (Sint) f1.fd - signed_val(bw); } break; case FLOAT_BIG: GET_DOUBLE(aw, f1); - if ((f1.fd < 9007199254740990.0 && f1.fd > -9007199254740990.0)) { - if (big_to_double(bw, &f2.fd) < 0) { - j = big_sign(b) ? 1 : -1; + if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { + if (big_to_double(bw, &f1.fd) < 0) { + j = big_sign(bw) ? 1 : -1; } else { j = float_comp(f1.fd, f2.fd); } } else if ((f1.fd < (double) (MAX_SMALL + 1)) && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint - j = big_sign(b) ? 1 : -1; - } else if (big_arity(b) > ((1 << 10) / D_EXP)) { // If bignum size is larger than largest/smallest float - j = big_sign(b) ? 1 : -1; + j = big_sign(bw) ? 1 : -1; + } else if ( (( 1 << (big_arity(bw)*D_EXP))-1) > f1.fd) { + // If bignum size shows that it is bigger than the float + j = 1; + } else if ( (( 1 << (big_arity(bw)*D_EXP))-1)*-1 < f1.fd) { + // If bignum size shows that it is smaller than the float + j = -1; } else { big = double_to_big(f1.fd, big_buf); j = big_comp(big, bw); -- cgit v1.2.3 From 5afcc1900d858984143c673aca5c1639d12f9e84 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 11 Oct 2011 17:18:15 +0200 Subject: Update heauristic to work on halfword --- erts/emulator/beam/erl_vm.h | 2 +- erts/emulator/beam/utils.c | 45 ++++++++++++++++++++------------------------- 2 files changed, 21 insertions(+), 26 deletions(-) diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index ed9139518c..f810392e60 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -55,7 +55,7 @@ heap data on the C stack or if we use the buffers in the scheduler data. */ #define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers small heap for transient heap data */ -#define CMP_TMP_HEAP_SIZE 16 /* cmp wants its own tmp-heap... */ +#define CMP_TMP_HEAP_SIZE 32 /* cmp wants its own tmp-heap... */ #define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */ #define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 91e4e50e15..85e8c86d53 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2653,8 +2653,8 @@ tailrecur_ne: Eterm aw = a; Eterm bw = b; #endif -#define MAX_LOSSLESS_FLOAT ((double)((1L << 53) - 2)) -#define MIN_LOSSLESS_FLOAT ((double)(((1L << 53) - 2)*-1)) +#define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2)) +#define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1)) b_tag = tag_val_def(bw); switch(_NUMBER_CODE(a_tag, b_tag)) { @@ -2682,23 +2682,20 @@ tailrecur_ne: break; case BIG_FLOAT: GET_DOUBLE(bw, f2); - if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + if ((f2.fd < (double) (MAX_SMALL + 1)) + && (f2.fd > (double) (MIN_SMALL - 1))) { + // Float is a Sint + j = big_sign(aw) ? -1 : 1; + } else if ( (pow(2.0,(big_arity(aw)-1.0)*D_EXP)-1.0) > fabs(f2.fd)) { + // If bignum size shows that it is bigger or smaller than the float + j = big_sign(aw) ? -1 : 1; + } else if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { // Float is within the no loss limit if (big_to_double(aw, &f1.fd) < 0) { j = big_sign(aw) ? -1 : 1; } else { j = float_comp(f1.fd, f2.fd); } - } else if ((f2.fd < (double) (MAX_SMALL + 1)) - && (f2.fd > (double) (MIN_SMALL - 1))) { - // Float is a Sint - j = big_sign(aw) ? -1 : 1; - } else if ( (( 1 << (big_arity(aw)*D_EXP))-1) > f2.fd) { - // If bignum size shows that it is bigger than the float - j = -1; - } else if ( (( 1 << (big_arity(aw)*D_EXP))-1)*-1 < f2.fd) { - // If bignum size shows that it is smaller than the float - j = 1; } else { big = double_to_big(f2.fd, big_buf); j = big_comp(aw, big); @@ -2706,7 +2703,7 @@ tailrecur_ne: break; case FLOAT_SMALL: GET_DOUBLE(aw, f1); - if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { + if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { // Float is within the no loss limit f2.fd = signed_val(bw); j = float_comp(f1.fd, f2.fd); @@ -2722,21 +2719,19 @@ tailrecur_ne: break; case FLOAT_BIG: GET_DOUBLE(aw, f1); - if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { - if (big_to_double(bw, &f1.fd) < 0) { + if ((f1.fd < (double) (MAX_SMALL + 1)) + && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint + j = big_sign(bw) ? 1 : -1; + } else if ((pow(2.0, (big_arity(bw) - 1.0) * D_EXP) - 1.0) > fabs(f1.fd)) { + // If bignum size shows that it is bigger than the float + j = big_sign(bw) ? 1 : -1; + } else if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd >MIN_LOSSLESS_FLOAT) { + // Float is within the no loss limit + if (big_to_double(bw, &f2.fd) < 0) { j = big_sign(bw) ? 1 : -1; } else { j = float_comp(f1.fd, f2.fd); } - } else if ((f1.fd < (double) (MAX_SMALL + 1)) - && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint - j = big_sign(bw) ? 1 : -1; - } else if ( (( 1 << (big_arity(bw)*D_EXP))-1) > f1.fd) { - // If bignum size shows that it is bigger than the float - j = 1; - } else if ( (( 1 << (big_arity(bw)*D_EXP))-1)*-1 < f1.fd) { - // If bignum size shows that it is smaller than the float - j = -1; } else { big = double_to_big(f1.fd, big_buf); j = big_comp(big, bw); -- cgit v1.2.3 From 0ab6d70a34f5e2fbfdeb6235024a1d5e83cab64f Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Tue, 11 Oct 2011 17:18:41 +0200 Subject: Expand tests for float and number comparison --- erts/emulator/test/float_SUITE.erl | 36 ++++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index e2e9b9120c..a8cc3b9a3f 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -193,7 +193,7 @@ cmp_zero(_Config) -> cmp_integer(_Config) -> Axis = (1 bsl 53)-2.0, %% The point where floating points become unprecise span_cmp(Axis,2,200), - cmp(Axis*Axis, round(Axis)). + cmp(Axis*Axis,round(Axis)). cmp_bignum(_Config) -> span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float @@ -202,23 +202,39 @@ cmp_bignum(_Config) -> [span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)], cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0), + [cmp((1 bsl (32*I)) - 1, (1 bsl (32*(I-2))) * 1.0) || I <- lists:seq(3,30)], ok. span_cmp(Axis) -> - span_cmp(Axis, 50). + span_cmp(Axis, 25). span_cmp(Axis, Length) -> span_cmp(Axis, round(Axis) bsr 52, Length). span_cmp(Axis, Incr, Length) -> - [cmp(round(Axis*-1.0)+1+I*Incr,Axis*-1.0+I*Incr) - || I <- lists:seq((Length div 2)*-1,(Length div 2))], - [cmp(round(Axis)+1+I*Incr,Axis+I*Incr) || - I <- lists:seq((Length div 2)*-1,(Length div 2))]. - -cmp(Big,Small) -> + [span_cmp(Axis, Incr, Length, 1 bsl (1 bsl I)) || I <- lists:seq(0,6)]. +span_cmp(Axis, Incr, Length, Diff) -> + [begin + cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), + cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) + end || I <- lists:seq((Length div 2)*-1,(Length div 2))], + [begin + cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), + cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) + end || I <- lists:seq((Length div 2)*-1,(Length div 2))]. + +cmp(Big,Small) when is_float(Big) -> + BigSmall = lists:flatten( + io_lib:format("~f > ~p",[Big,Small])), + SmallBig = lists:flatten( + io_lib:format("~f < ~p",[Big,Small])), + cmp(Big,Small,BigSmall,SmallBig); +cmp(Big,Small) when is_float(Small) -> BigSmall = lists:flatten( - io_lib:format("~p > ~p",[Big,Small])), + io_lib:format("~p > ~f",[Big,Small])), SmallBig = lists:flatten( - io_lib:format("~p < ~p",[Big,Small])), + io_lib:format("~p < ~f",[Big,Small])), + cmp(Big,Small,BigSmall,SmallBig). + +cmp(Big,Small,BigSmall,SmallBig) -> {_,_,_,true} = {Big,Small,BigSmall, Big > Small}, {_,_,_,false} = {Big,Small,SmallBig, -- cgit v1.2.3 From f99fd21debc8274dbdecd595e1666436ec962ccd Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Fri, 29 Jul 2011 15:47:06 +0200 Subject: Update size of tmp cmp bignum buffer This is needed for use on 32 bit with very large floats. --- erts/emulator/beam/utils.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 85e8c86d53..5822b2e1d9 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2642,7 +2642,7 @@ tailrecur_ne: FloatDef f1, f2; Eterm big; #if HEAP_ON_C_STACK - Eterm big_buf[16]; /* If HEAP_ON_C_STACK */ + Eterm big_buf[32]; /* If HEAP_ON_C_STACK */ #else Eterm *big_buf = erts_get_scheduler_data()->cmp_tmp_heap; #endif -- cgit v1.2.3 From 6c1a36a91a0b214d598f845bed2b649a4de8ae3f Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 8 Aug 2011 16:13:32 +0200 Subject: Cleanup double_to_bignum conversion code --- erts/emulator/beam/big.c | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 51e5d2d305..b90ea6b478 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1584,23 +1584,22 @@ big_to_double(Wterm x, double* resp) return 0; } +/* + * Logic has been copied from erl_bif_guard.c and slightly + * modified to use a static instead of dynamic heap + */ Eterm double_to_big(double x, Eterm *heap) { int is_negative; int ds; ErtsDigit* xp; - Eterm tmp_res; + Eterm res; int i; size_t sz; Eterm* hp; double dbase; - if ((x < (double) (MAX_SMALL + 1)) && (x > (double) (MIN_SMALL - 1))) { - Sint xi = x; - return make_small(xi); - } - if (x >= 0) { is_negative = 0; } else { @@ -1618,7 +1617,7 @@ double_to_big(double x, Eterm *heap) sz = BIG_NEED_SIZE(ds); /* number of words including arity */ hp = heap; - tmp_res = make_big(hp); + res = make_big(hp); xp = (ErtsDigit*) (hp + 1); for (i = ds - 1; i >= 0; i--) { @@ -1638,7 +1637,7 @@ double_to_big(double x, Eterm *heap) } else { *hp = make_pos_bignum_header(sz-1); } - return tmp_res; + return res; } -- cgit v1.2.3 From 0e88b9724ddd2d5ccd1def55ab2044e7665ca9e4 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 8 Aug 2011 18:46:56 +0200 Subject: Add tests for comparing large floats and small bignums --- erts/emulator/test/float_SUITE.erl | 38 +++++++++++++++++++++++++------------- 1 file changed, 25 insertions(+), 13 deletions(-) diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index a8cc3b9a3f..bf0fbc70bc 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -203,6 +203,7 @@ cmp_bignum(_Config) -> cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0), [cmp((1 bsl (32*I)) - 1, (1 bsl (32*(I-2))) * 1.0) || I <- lists:seq(3,30)], + [cmp((1 bsl (64*15)) * 1.0, (1 bsl (32*(I)))) || I <- lists:seq(1,29)], ok. span_cmp(Axis) -> @@ -222,24 +223,35 @@ span_cmp(Axis, Incr, Length, Diff) -> end || I <- lists:seq((Length div 2)*-1,(Length div 2))]. cmp(Big,Small) when is_float(Big) -> - BigSmall = lists:flatten( + BigGtSmall = lists:flatten( io_lib:format("~f > ~p",[Big,Small])), - SmallBig = lists:flatten( + BigLtSmall = lists:flatten( io_lib:format("~f < ~p",[Big,Small])), - cmp(Big,Small,BigSmall,SmallBig); + SmallGtBig = lists:flatten( + io_lib:format("~p > ~f",[Small,Big])), + SmallLtBig = lists:flatten( + io_lib:format("~p < ~f",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig); cmp(Big,Small) when is_float(Small) -> - BigSmall = lists:flatten( - io_lib:format("~p > ~f",[Big,Small])), - SmallBig = lists:flatten( - io_lib:format("~p < ~f",[Big,Small])), - cmp(Big,Small,BigSmall,SmallBig). - -cmp(Big,Small,BigSmall,SmallBig) -> - {_,_,_,true} = {Big,Small,BigSmall, + BigGtSmall = lists:flatten( + io_lib:format("~p > ~f",[Big,Small])), + BigLtSmall = lists:flatten( + io_lib:format("~p < ~f",[Big,Small])), + SmallGtBig = lists:flatten( + io_lib:format("~f > ~p",[Small,Big])), + SmallLtBig = lists:flatten( + io_lib:format("~f < ~p",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig). + +cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig) -> + {_,_,_,true} = {Big,Small,BigGtSmall, Big > Small}, - {_,_,_,false} = {Big,Small,SmallBig, + {_,_,_,false} = {Big,Small,BigLtSmall, Big < Small}, - {BigSmall, SmallBig}. + {_,_,_,false} = {Big,Small,SmallGtBig, + Small > Big}, + {_,_,_,true} = {Big,Small,SmallLtBig, + Small < Big}. id(I) -> I. -- cgit v1.2.3 From 3b62e52f16ef72ce4224a61dc9e6bc7ab53234a1 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 8 Aug 2011 18:48:16 +0200 Subject: Optimize comparison of huge floats and smaller bignums --- erts/emulator/beam/utils.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 5822b2e1d9..f296ccbadd 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2686,9 +2686,12 @@ tailrecur_ne: && (f2.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint j = big_sign(aw) ? -1 : 1; - } else if ( (pow(2.0,(big_arity(aw)-1.0)*D_EXP)-1.0) > fabs(f2.fd)) { - // If bignum size shows that it is bigger or smaller than the float + } else if ((pow(2.0,(big_arity(aw)-1.0)*D_EXP)-1.0) > fabs(f2.fd)) { + // If bignum size shows that it is bigger than the abs float j = big_sign(aw) ? -1 : 1; + } else if ((pow(2.0,(big_arity(aw))*D_EXP)-1.0) < fabs(f2.fd)) { + // If bignum size shows that it is smaller than the abs float + j = f2.fd < 0 ? 1 : -1; } else if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) { // Float is within the no loss limit if (big_to_double(aw, &f1.fd) < 0) { @@ -2723,9 +2726,12 @@ tailrecur_ne: && (f1.fd > (double) (MIN_SMALL - 1))) { // Float is a Sint j = big_sign(bw) ? 1 : -1; } else if ((pow(2.0, (big_arity(bw) - 1.0) * D_EXP) - 1.0) > fabs(f1.fd)) { - // If bignum size shows that it is bigger than the float + // If bignum size shows that it is bigger than the abs float j = big_sign(bw) ? 1 : -1; - } else if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd >MIN_LOSSLESS_FLOAT) { + } else if ((pow(2.0,(big_arity(bw))*D_EXP)-1.0) < fabs(f1.fd)) { + // If bignum size shows that it is smaller than the abs float + j = f1.fd < 0 ? -1 : 1; + } else if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) { // Float is within the no loss limit if (big_to_double(bw, &f2.fd) < 0) { j = big_sign(bw) ? 1 : -1; -- cgit v1.2.3 From 3dc379948b1d7ce6c4f35f56df937603a6013f24 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 3 Oct 2011 19:08:20 +0200 Subject: Add tests for equality checking Test for checking equality on all float exponents Test in equality for all comparison tests --- erts/emulator/test/float_SUITE.erl | 41 ++++++++++++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 6 deletions(-) diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index bf0fbc70bc..46466427c5 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -198,13 +198,19 @@ cmp_integer(_Config) -> cmp_bignum(_Config) -> span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float - %% Test I to I+1 bignum segment overflow + %% Test when the big num goes from I to I+1 in size [span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)], + %% Test bignum greater then largest float cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0), + %% Test when num is much larger then float [cmp((1 bsl (32*I)) - 1, (1 bsl (32*(I-2))) * 1.0) || I <- lists:seq(3,30)], + %% Test when float is much larger than num [cmp((1 bsl (64*15)) * 1.0, (1 bsl (32*(I)))) || I <- lists:seq(1,29)], - ok. + + %% Test that all int == float works as they should + [true = 1 bsl N == (1 bsl N)*1.0 || N <- lists:seq(0, 1023)], + [true = (1 bsl N)*-1 == (1 bsl N)*-1.0 || N <- lists:seq(0, 1023)]. span_cmp(Axis) -> span_cmp(Axis, 25). @@ -212,6 +218,14 @@ span_cmp(Axis, Length) -> span_cmp(Axis, round(Axis) bsr 52, Length). span_cmp(Axis, Incr, Length) -> [span_cmp(Axis, Incr, Length, 1 bsl (1 bsl I)) || I <- lists:seq(0,6)]. +%% This function creates tests around number axis. Both <, > and == is tested +%% for both negative and positive numbers. +%% +%% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0 +%% Incr: How much to increment the test numbers inbetween each test. +%% Length: Length/2 is the number of Incr away from Axis to test on the +%% negative and positive plane. +%% Diff: How much the float and int should differ when comparing span_cmp(Axis, Incr, Length, Diff) -> [begin cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), @@ -227,23 +241,34 @@ cmp(Big,Small) when is_float(Big) -> io_lib:format("~f > ~p",[Big,Small])), BigLtSmall = lists:flatten( io_lib:format("~f < ~p",[Big,Small])), + BigEqSmall = lists:flatten( + io_lib:format("~f == ~p",[Big,Small])), SmallGtBig = lists:flatten( io_lib:format("~p > ~f",[Small,Big])), SmallLtBig = lists:flatten( io_lib:format("~p < ~f",[Small,Big])), - cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig); + SmallEqBig = lists:flatten( + io_lib:format("~p == ~f",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall); cmp(Big,Small) when is_float(Small) -> BigGtSmall = lists:flatten( io_lib:format("~p > ~f",[Big,Small])), BigLtSmall = lists:flatten( io_lib:format("~p < ~f",[Big,Small])), + BigEqSmall = lists:flatten( + io_lib:format("~p == ~f",[Big,Small])), SmallGtBig = lists:flatten( io_lib:format("~f > ~p",[Small,Big])), SmallLtBig = lists:flatten( io_lib:format("~f < ~p",[Small,Big])), - cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig). + SmallEqBig = lists:flatten( + io_lib:format("~f == ~p",[Small,Big])), + cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall). -cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig) -> +cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, + SmallEqBig,BigEqSmall) -> {_,_,_,true} = {Big,Small,BigGtSmall, Big > Small}, {_,_,_,false} = {Big,Small,BigLtSmall, @@ -251,7 +276,11 @@ cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig) -> {_,_,_,false} = {Big,Small,SmallGtBig, Small > Big}, {_,_,_,true} = {Big,Small,SmallLtBig, - Small < Big}. + Small < Big}, + {_,_,_,false} = {Big,Small,SmallEqBig, + Small == Big}, + {_,_,_,false} = {Big,Small,BigEqSmall, + Big == Small}. id(I) -> I. -- cgit v1.2.3 From f82d49ab3e65f52fd7b6dd7d9e8913543b7a1375 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Mon, 3 Oct 2011 19:09:55 +0200 Subject: Do small optimisation on platforms with 32 bit Eterm On 32 bit we know that a comparison with a lossfull double and a short will always give the float is being superior. So therefore we only have to check the sign on the double. --- erts/emulator/beam/utils.c | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index f296ccbadd..825cb140b2 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2670,6 +2670,7 @@ tailrecur_ne: // Float is within the no loss limit f1.fd = signed_val(aw); j = float_comp(f1.fd, f2.fd); +#if ERTS_SIZEOF_ETERM == 8 } else if (f2.fd > (double) (MAX_SMALL + 1)) { // Float is a positive bignum, i.e. bigger j = -1; @@ -2679,6 +2680,12 @@ tailrecur_ne: } else { // Float is a Sint but less precise j = signed_val(aw) - (Sint) f2.fd; } +#else + } else { + // If float is positive it is bigger than small + j = (f2.fd > 0.0) ? -1 : 1; + } +#endif // ERTS_SIZEOF_ETERM == 8 break; case BIG_FLOAT: GET_DOUBLE(bw, f2); @@ -2710,6 +2717,7 @@ tailrecur_ne: // Float is within the no loss limit f2.fd = signed_val(bw); j = float_comp(f1.fd, f2.fd); +#if ERTS_SIZEOF_ETERM == 8 } else if (f1.fd > (double) (MAX_SMALL + 1)) { // Float is a positive bignum, i.e. bigger j = 1; @@ -2719,6 +2727,12 @@ tailrecur_ne: } else { // Float is a Sint but less precise it j = (Sint) f1.fd - signed_val(bw); } +#else + } else { + // If float is positive it is bigger than small + j = (f1.fd > 0.0) ? 1 : -1; + } +#endif // ERTS_SIZEOF_ETERM == 8 break; case FLOAT_BIG: GET_DOUBLE(aw, f1); -- cgit v1.2.3 From 1c52cfa3b8cbc6e8650444ff10bab827965aa4ec Mon Sep 17 00:00:00 2001 From: Lars Thorsen Date: Wed, 12 Oct 2011 10:27:12 +0200 Subject: corba applications: Fix broken 'make clean' The IDL-GENERATED files must be removed too; otherwise the target files will not be made the next time 'make' is invoked. --- lib/cosEvent/src/Makefile | 2 +- lib/cosEventDomain/src/Makefile | 2 +- lib/cosFileTransfer/src/Makefile | 2 +- lib/cosNotification/src/Makefile | 2 +- lib/cosProperty/src/Makefile | 2 +- lib/cosTime/src/Makefile | 2 +- lib/cosTransactions/src/Makefile | 2 +- lib/ic/examples/pre_post_condition/Makefile | 2 +- lib/orber/COSS/CosNaming/Makefile | 2 +- lib/orber/examples/Stack/Makefile | 2 +- lib/orber/src/Makefile | 2 +- 11 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/cosEvent/src/Makefile b/lib/cosEvent/src/Makefile index c774d18380..736b95538a 100644 --- a/lib/cosEvent/src/Makefile +++ b/lib/cosEvent/src/Makefile @@ -164,7 +164,7 @@ debug: @${MAKE} TYPE=debug opt clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) diff --git a/lib/cosEventDomain/src/Makefile b/lib/cosEventDomain/src/Makefile index 91bef4e7e6..5af790c760 100644 --- a/lib/cosEventDomain/src/Makefile +++ b/lib/cosEventDomain/src/Makefile @@ -137,7 +137,7 @@ debug: @${MAKE} TYPE=debug opt clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) diff --git a/lib/cosFileTransfer/src/Makefile b/lib/cosFileTransfer/src/Makefile index 17e82f9bc2..b811ef1106 100644 --- a/lib/cosFileTransfer/src/Makefile +++ b/lib/cosFileTransfer/src/Makefile @@ -147,7 +147,7 @@ cleanb: rm -f errs core *~ clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) diff --git a/lib/cosNotification/src/Makefile b/lib/cosNotification/src/Makefile index b976ab94f3..be52d1a06f 100644 --- a/lib/cosNotification/src/Makefile +++ b/lib/cosNotification/src/Makefile @@ -328,7 +328,7 @@ cleanb: rm -f errs core *~ clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) diff --git a/lib/cosProperty/src/Makefile b/lib/cosProperty/src/Makefile index d12554b18d..b72019f37d 100644 --- a/lib/cosProperty/src/Makefile +++ b/lib/cosProperty/src/Makefile @@ -147,7 +147,7 @@ cleanb: rm -f errs core *~ clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) diff --git a/lib/cosTime/src/Makefile b/lib/cosTime/src/Makefile index 1793822fb6..fa456249bd 100644 --- a/lib/cosTime/src/Makefile +++ b/lib/cosTime/src/Makefile @@ -162,7 +162,7 @@ cleanb: rm -f errs core *~ clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) diff --git a/lib/cosTransactions/src/Makefile b/lib/cosTransactions/src/Makefile index 4b77251c3c..e7d4b0b080 100644 --- a/lib/cosTransactions/src/Makefile +++ b/lib/cosTransactions/src/Makefile @@ -141,7 +141,7 @@ debug: @${MAKE} TYPE=debug clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) diff --git a/lib/ic/examples/pre_post_condition/Makefile b/lib/ic/examples/pre_post_condition/Makefile index 85cbbdb9ff..d57133c964 100644 --- a/lib/ic/examples/pre_post_condition/Makefile +++ b/lib/ic/examples/pre_post_condition/Makefile @@ -100,7 +100,7 @@ YRL_FLAGS = debug opt: $(TARGET_FILES) clean: - rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) + rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED rm -f errs core *~ docs: diff --git a/lib/orber/COSS/CosNaming/Makefile b/lib/orber/COSS/CosNaming/Makefile index 28b4d9cacc..d4b2079036 100644 --- a/lib/orber/COSS/CosNaming/Makefile +++ b/lib/orber/COSS/CosNaming/Makefile @@ -113,7 +113,7 @@ debug: @${MAKE} TYPE=debug clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) diff --git a/lib/orber/examples/Stack/Makefile b/lib/orber/examples/Stack/Makefile index ccb65038a3..215e57fcbe 100644 --- a/lib/orber/examples/Stack/Makefile +++ b/lib/orber/examples/Stack/Makefile @@ -96,7 +96,7 @@ ERL_COMPILE_FLAGS += \ debug opt: $(TARGET_FILES) clean: - rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) + rm -f $(TARGET_FILES) $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) $(CLASS_FILES) IDL-GENERATED rm -f errs core *~ docs: diff --git a/lib/orber/src/Makefile b/lib/orber/src/Makefile index ed62c94b98..e812e22b46 100644 --- a/lib/orber/src/Makefile +++ b/lib/orber/src/Makefile @@ -212,7 +212,7 @@ debug: opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) clean: - rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(GEN_FILES) $(APP_TARGET) $(APPUP_TARGET) IDL-GENERATED rm -f errs core *~ $(APP_TARGET): $(APP_SRC) ../vsn.mk -- cgit v1.2.3 From 36fa068807ef85fdcc85240ca077239ed7d34f5b Mon Sep 17 00:00:00 2001 From: Lars Thorsen Date: Wed, 12 Oct 2011 15:11:20 +0200 Subject: Fix match bug Incorrect use of ets:match changed to ets:match_object. --- lib/ic/doc/src/notes.xml | 16 ++++++++++++++++ lib/ic/src/ic_pragma.erl | 6 +++--- lib/ic/vsn.mk | 2 +- 3 files changed, 20 insertions(+), 4 deletions(-) diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index de519d5f84..ff289bd76c 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -30,6 +30,22 @@ notes.xml

+
+ IC 4.2.28 + +
+ Fixed Bugs and Malfunctions + + +

+ Incorrect use of ets:match changed to ets:match_object.

+

+ Own Id: OTP-9630

+ + +
+
+
IC 4.2.27 diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl index 7f2216b9dc..beaa2852ab 100644 --- a/lib/ic/src/ic_pragma.erl +++ b/lib/ic/src/ic_pragma.erl @@ -1601,7 +1601,7 @@ remove_inheriters(S,RS,InheriterList) -> ReducedInhList; _Other -> CleanList = - ets:match(S, {inherits,'_','_'}), + ets:match_object(S, {inherits,'_','_'}), % CodeOptList = % [X || X <- EtsList, element(1,X) == codeopt], NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList), @@ -1648,7 +1648,7 @@ remove_inh([X],[Y],List,EtsList) -> %%%---------------------------------------------- remove_inherited(S,InheriterList) -> CleanList = - ets:match(S, {inherits, '_', '_'}), + ets:match_object(S, {inherits, '_', '_'}), remove_inherited(S,InheriterList,CleanList). @@ -1766,7 +1766,7 @@ inherits2(_X,Y,Z,EtsList) -> %% false otherwise %% is_inherited_by(Interface1,Interface2,PragmaTab) -> - InheritsList = ets:match(PragmaTab, {inherits, '_', '_'}), + InheritsList = ets:match_object(PragmaTab, {inherits, '_', '_'}), inherits(Interface2,Interface1,InheritsList). diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index 6561ccd2a7..703c8d29eb 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.2.27 +IC_VSN = 4.2.28 -- cgit v1.2.3 From a0f45f929092c8d3355a8604780a4f4df49f3759 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 12 Oct 2011 12:27:08 +0200 Subject: make_preload: Don't output a C comment start inside a comment We already avoid outputting a comment terminator ("*/") inside a comment to avoid causing a syntax error. Also avoid outputting the start of a comment ("/*") to avoid causing a compiler warning. Noticed-by: Tuncer Ayaz --- erts/emulator/utils/make_preload | 1 + 1 file changed, 1 insertion(+) diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload index d0671e998d..d22f08f993 100755 --- a/erts/emulator/utils/make_preload +++ b/erts/emulator/utils/make_preload @@ -88,6 +88,7 @@ foreach $file (@ARGV) { print "unsigned char preloaded_$module", "[] = {\n"; for ($i = 0; $i < length($_); $i++) { if ($i % 8 == 0 && $comment ne '') { + $comment =~ s@/\*@..@g; # Comment start -- avoid warning. $comment =~ s@\*/@..@g; # Comment terminator. print " /* $comment */\n "; $comment = ''; -- cgit v1.2.3 From 5847f72e816107678be7dae0dc4a61e9e2b84e2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 12 Oct 2011 10:40:21 +0200 Subject: asn1: Fix typo that caused failure of 'make release' on Windows --- lib/asn1/c_src/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile index f7213b9651..8c06be56f8 100644 --- a/lib/asn1/c_src/Makefile +++ b/lib/asn1/c_src/Makefile @@ -62,7 +62,7 @@ NIF_OBJ_FILES = $(OBJDIR)/asn1_erl_nif.o ifeq ($(TARGET),win32) -NIF_SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_nif.dll +NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.dll CLIB_FLAGS = LN=cp else -- cgit v1.2.3 From 34db76765561487e526fe66d3d19ecf3b3fb9dc8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 30 Aug 2011 11:51:11 +0200 Subject: Allow noncharacter code points in unicode encoding and decoding The two noncharacter code points 16#FFFE and 16#FFFF were not allowed to be encoded or decoded using the unicode module or bit syntax. That causes an inconsistency, since the noncharacters 16#FDD0 to 16#FDEF could be encoded/decoded. There is two ways to fix that inconsistency. We have chosen to allow 16#FFFE and 16#FFFF to be encoded and decoded, because the noncharacters could be useful internally within an application and it will make encoding and decoding slightly faster. Reported-by: Alisdair Sullivan --- erts/emulator/beam/beam_emu.c | 7 +++---- erts/emulator/beam/erl_bits.c | 12 +++-------- erts/emulator/beam/erl_unicode.c | 24 +++++----------------- erts/emulator/test/bs_utf_SUITE.erl | 12 +++-------- lib/compiler/test/bs_utf_SUITE.erl | 21 ------------------- .../com/ericsson/otp/erlang/OtpErlangString.java | 5 ++--- lib/stdlib/doc/src/unicode.xml | 3 +-- lib/stdlib/test/unicode_SUITE.erl | 4 +--- system/doc/reference_manual/expressions.xml | 12 +++++------ 9 files changed, 23 insertions(+), 77 deletions(-) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4b5b5cbdaa..62a14dbacf 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3967,8 +3967,7 @@ void process_main(void) * too big numbers). */ if (is_not_small(val) || val > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL)) || - val == make_small(0xFFFEUL) || val == make_small(0xFFFFUL)) { + (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) { goto badarg; } Next(2); @@ -3987,8 +3986,8 @@ void process_main(void) * the valid range). */ if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= tmp_arg1 && tmp_arg1 <= make_small(0xDFFFUL)) || - tmp_arg1 == make_small(0xFFFEUL) || tmp_arg1 == make_small(0xFFFFUL)) { + (make_small(0xD800UL) <= tmp_arg1 && + tmp_arg1 <= make_small(0xDFFFUL))) { ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2); mb->offset -= 32; diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 326a5c136b..6f7309f493 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -845,8 +845,7 @@ erts_bs_put_utf8(ERL_BITS_PROTO_1(Eterm arg)) dst[1] = 0x80 | (val & 0x3F); num_bits = 16; } else if (val < 0x10000UL) { - if ((0xD800 <= val && val <= 0xDFFF) || - val == 0xFFFE || val == 0xFFFF) { + if (0xD800 <= val && val <= 0xDFFF) { return 0; } dst[0] = 0xE0 | (val >> 12); @@ -886,8 +885,7 @@ erts_bs_put_utf16(ERL_BITS_PROTO_2(Eterm arg, Uint flags)) return 0; } val = unsigned_val(arg); - if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF) || - val == 0xFFFE || val == 0xFFFF) { + if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF)) { return 0; } @@ -1652,8 +1650,7 @@ erts_bs_get_utf8(ErlBinMatchBuffer* mb) return THE_NON_VALUE; } result = (((result << 6) + a) << 6) + b - (Eterm) 0x000E2080UL; - if ((0xD800 <= result && result <= 0xDFFF) || - result == 0xFFFE || result == 0xFFFF) { + if (0xD800 <= result && result <= 0xDFFF) { return THE_NON_VALUE; } mb->offset += 24; @@ -1723,9 +1720,6 @@ erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags) w1 = (src[0] << 8) | src[1]; } if (w1 < 0xD800 || w1 > 0xDFFF) { - if (w1 == 0xFFFE || w1 == 0xFFFF) { - return THE_NON_VALUE; - } mb->offset += 16; return make_small(w1); } else if (w1 > 0xDBFF) { diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 158eb361a4..bd5f3cc4c1 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -348,12 +348,6 @@ static int copy_utf8_bin(byte *target, byte *source, Uint size, return copied; } - if (((*source) == 0xEF) && (source[1] == 0xBF) && - ((source[2] == 0xBE) || (source[2] == 0xBF))) { - *err_pos = source; - return copied; - } - *(target++) = *(source++); *(target++) = *(source++); *(target++) = *(source++); @@ -714,9 +708,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ target[(*pos)++] = (((byte) (x & 0x3F)) | ((byte) 0x80)); } else if (x < 0x10000) { - if ((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF)) { /* Invalid unicode range */ + if (x >= 0xD800 && x <= 0xDFFF) { + /* Invalid unicode range */ *err = 1; goto done; } @@ -1230,10 +1223,6 @@ int erts_analyze_utf8(byte *source, Uint size, ((source[1] & 0x20) != 0)) { return ERTS_UTF8_ERROR; } - if (((*source) == 0xEF) && (source[1] == 0xBF) && - ((source[2] == 0xBE) || (source[2] == 0xBF))) { - return ERTS_UTF8_ERROR; - } source += 3; size -= 3; } else if (((*source) & ((byte) 0xF8)) == 0xF0) { @@ -2166,9 +2155,8 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ } else if (x < 0x800) { need += 2; } else if (x < 0x10000) { - if ((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF)) { /* Invalid unicode range */ + if (x >= 0xD800 && x <= 0xDFFF) { + /* Invalid unicode range */ DESTROY_ESTACK(stack); return ((Sint) -1); } @@ -2314,9 +2302,7 @@ L_Again: /* Restart with sublist, old listend was pushed on stack */ *p++ = (((byte) (x & 0x3F)) | ((byte) 0x80)); } else if (x < 0x10000) { - ASSERT(!((x >= 0xD800 && x <= 0xDFFF) || - (x == 0xFFFE) || - (x == 0xFFFF))); + ASSERT(!(x >= 0xD800 && x <= 0xDFFF)); *p++ = (((byte) (x >> 12)) | ((byte) 0xE0)); *p++ = ((((byte) (x >> 6)) & 0x3F) | diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl index 72c656c400..4ab7d674a6 100644 --- a/erts/emulator/test/bs_utf_SUITE.erl +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -64,8 +64,7 @@ end_per_group(_GroupName, Config) -> utf8_roundtrip(Config) when is_list(Config) -> ?line utf8_roundtrip(0, 16#D7FF), - ?line utf8_roundtrip(16#E000, 16#FFFD), - ?line utf8_roundtrip(16#10000, 16#10FFFF), + ?line utf8_roundtrip(16#E000, 16#10FFFF), ok. utf8_roundtrip(First, Last) when First =< Last -> @@ -91,8 +90,7 @@ utf16_roundtrip(Config) when is_list(Config) -> do_utf16_roundtrip(Fun) -> do_utf16_roundtrip(0, 16#D7FF, Fun), - do_utf16_roundtrip(16#E000, 16#FFFD, Fun), - do_utf16_roundtrip(16#10000, 16#10FFFF, Fun). + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). do_utf16_roundtrip(First, Last, Fun) when First =< Last -> Fun(First), @@ -129,8 +127,7 @@ utf32_roundtrip(Config) when is_list(Config) -> do_utf32_roundtrip(Fun) -> do_utf32_roundtrip(0, 16#D7FF, Fun), - do_utf32_roundtrip(16#E000, 16#FFFD, Fun), - do_utf32_roundtrip(16#10000, 16#10FFFF, Fun). + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). do_utf32_roundtrip(First, Last, Fun) when First =< Last -> Fun(First), @@ -158,7 +155,6 @@ utf32_little_roundtrip(Char) -> utf8_illegal_sequences(Config) when is_list(Config) -> ?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line fail_range(16#FFFE, 16#FFFF), %Non-characters. %% Illegal first character. ?line [fail(<>) || I <- lists:seq(16#80, 16#BF)], @@ -251,7 +247,6 @@ fail_1(_) -> ok. utf16_illegal_sequences(Config) when is_list(Config) -> ?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf16_fail_range(16#FFFE, 16#FFFF), %Non-characters. ?line lonely_hi_surrogate(16#D800, 16#DFFF), ?line leading_lo_surrogate(16#DC00, 16#DFFF), @@ -300,7 +295,6 @@ leading_lo_surrogate(_, _, _) -> ok. utf32_illegal_sequences(Config) when is_list(Config) -> ?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf32_fail_range(16#FFFE, 16#FFFF), %Non-characters. ?line utf32_fail_range(-100, -1), ok. diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl index f30a4d3fef..94549ad0d3 100644 --- a/lib/compiler/test/bs_utf_SUITE.erl +++ b/lib/compiler/test/bs_utf_SUITE.erl @@ -264,18 +264,10 @@ literals(Config) when is_list(Config) -> ?line {'EXIT',{badarg,_}} = (catch <<(-1)/utf32,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<(-1)/little-utf32,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf8,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf8,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/utf8,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf16,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/little-utf16,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf16,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/little-utf16,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/utf16,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/little-utf16,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf32,I/utf8>>), ?line {'EXIT',{badarg,_}} = (catch <<16#D800/little-utf32,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf32,I/utf8>>), - ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/little-utf32,I/utf8>>), B = 16#10FFFF+1, ?line {'EXIT',{badarg,_}} = (catch <>), @@ -286,20 +278,11 @@ literals(Config) when is_list(Config) -> %% Matching of bad literals. ?line error = bad_literal_match(<<237,160,128>>), %16#D800 in UTF-8 - ?line error = bad_literal_match(<<239,191,190>>), %16#FFFE in UTF-8 - ?line error = bad_literal_match(<<239,191,191>>), %16#FFFF in UTF-8 ?line error = bad_literal_match(<<244,144,128,128>>), %16#110000 in UTF-8 - ?line error = bad_literal_match(<<255,254>>), %16#FFFE in UTF-16 - ?line error = bad_literal_match(<<255,255>>), %16#FFFF in UTF-16 - ?line error = bad_literal_match(<<16#D800:32>>), - ?line error = bad_literal_match(<<16#FFFE:32>>), - ?line error = bad_literal_match(<<16#FFFF:32>>), ?line error = bad_literal_match(<<16#110000:32>>), ?line error = bad_literal_match(<<16#D800:32/little>>), - ?line error = bad_literal_match(<<16#FFFE:32/little>>), - ?line error = bad_literal_match(<<16#FFFF:32/little>>), ?line error = bad_literal_match(<<16#110000:32/little>>), ok. @@ -314,11 +297,7 @@ match_literal(<<"bj\366rn"/big-utf16>>) -> bjorn_utf16be; match_literal(<<"bj\366rn"/little-utf16>>) -> bjorn_utf16le. bad_literal_match(<<16#D800/utf8>>) -> ok; -bad_literal_match(<<16#FFFE/utf8>>) -> ok; -bad_literal_match(<<16#FFFF/utf8>>) -> ok; bad_literal_match(<<16#110000/utf8>>) -> ok; -bad_literal_match(<<16#FFFE/utf16>>) -> ok; -bad_literal_match(<<16#FFFF/utf16>>) -> ok; bad_literal_match(<<16#D800/utf32>>) -> ok; bad_literal_match(<<16#110000/utf32>>) -> ok; bad_literal_match(<<16#D800/little-utf32>>) -> ok; diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java index 19ee92e0d0..23734bf83b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java @@ -166,7 +166,7 @@ public class OtpErlangString extends OtpErlangObject implements Serializable, /** * Validate a code point according to Erlang definition; Unicode 3.0. * That is; valid in the range U+0..U+10FFFF, but not in the range - * U+D800..U+DFFF (surrogat pairs), nor U+FFFE..U+FFFF (non-characters). + * U+D800..U+DFFF (surrogat pairs). * * @param cp * the code point value to validate @@ -179,8 +179,7 @@ public class OtpErlangString extends OtpErlangObject implements Serializable, // Erlang definition of valid Unicode code points; // Unicode 3.0, XML, et.al. return (cp>>>16) <= 0x10 // in 0..10FFFF; Unicode range - && (cp & ~0x7FF) != 0xD800 // not in D800..DFFF; surrogate range - && (cp & ~1) != 0xFFFE; // not in FFFE..FFFF; non-characters + && (cp & ~0x7FF) != 0xD800; // not in D800..DFFF; surrogate range } /** diff --git a/lib/stdlib/doc/src/unicode.xml b/lib/stdlib/doc/src/unicode.xml index d02763f75c..1001ebbae4 100644 --- a/lib/stdlib/doc/src/unicode.xml +++ b/lib/stdlib/doc/src/unicode.xml @@ -203,8 +203,7 @@ greater than 16#10FFFF (the maximum unicode character), in the range 16#D800 to 16#DFFF - (invalid unicode range) - or equal to 16#FFFE or 16#FFFF (non characters) + (invalid range reserved for UTF-16 surrogate pairs) is found. diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 9aa800209d..4055af2741 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -322,7 +322,7 @@ roundtrips(Config) when is_list(Config) -> ex_roundtrips(Config) when is_list(Config) -> ?line L1 = ranges(0, 16#D800 - 1, erlang:system_info(context_reductions) * 11), - ?line L2 = ranges(16#DFFF + 1, 16#FFFE - 1, + ?line L2 = ranges(16#DFFF + 1, 16#10000 - 1, erlang:system_info(context_reductions) * 11), %?line L3 = ranges(16#FFFF + 1, 16#10FFFF, % erlang:system_info(context_reductions) * 11), @@ -569,7 +569,6 @@ utf16_illegal_sequences_bif(Config) when is_list(Config) -> ex_utf16_illegal_sequences_bif(Config) when is_list(Config) -> ?line utf16_fail_range_bif_simple(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf16_fail_range_bif(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf16_fail_range_bif(16#FFFE, 16#FFFF), %Non-characters. ?line lonely_hi_surrogate_bif(16#D800, 16#DBFF,incomplete), ?line lonely_hi_surrogate_bif(16#DC00, 16#DFFF,error), @@ -644,7 +643,6 @@ utf8_illegal_sequences_bif(Config) when is_list(Config) -> ex_utf8_illegal_sequences_bif(Config) when is_list(Config) -> ?line fail_range_bif(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line fail_range_bif(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line fail_range_bif(16#FFFE, 16#FFFF), %Reserved (BOM). %% Illegal first character. ?line [fail_bif(<>,unicode) || I <- lists:seq(16#80, 16#BF)], diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 497d7eb464..644896cd7f 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -879,9 +879,8 @@ Ei = Value | and UTF-32, respectively.

When constructing a segment of a utf type, Value - must be an integer in one of the ranges 0..16#D7FF, - 16#E000..16#FFFD, or 16#10000..16#10FFFF - (i.e. a valid Unicode code point). Construction + must be an integer in the range 0..16#D7FF or + 16#E000....16#10FFFF. Construction will fail with a badarg exception if Value is outside the allowed ranges. The size of the resulting binary segment depends on the type and/or Value. For utf8, @@ -896,14 +895,13 @@ Ei = Value | >]]>.

A successful match of a segment of a utf type results - in an integer in one of the ranges 0..16#D7FF, 16#E000..16#FFFD, - or 16#10000..16#10FFFF - (i.e. a valid Unicode code point). The match will fail if returned value + in an integer in the range 0..16#D7FF or 16#E000..16#10FFFF. + The match will fail if returned value would fall outside those ranges.

A segment of type utf8 will match 1 to 4 bytes in the binary, if the binary at the match position contains a valid UTF-8 sequence. - (See RFC-2279 or the Unicode standard.)

+ (See RFC-3629 or the Unicode standard.)

A segment of type utf16 may match 2 or 4 bytes in the binary. The match will fail if the binary at the match position does not contain -- cgit v1.2.3 From a4ce63afbc88e7e089b2898d1c08578ceb5ee207 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 6 Oct 2011 14:42:28 +0200 Subject: Fix bugs in the generation of manpages The indentation of the tag has been corrected, as has the corresponding tag used for Erlang specs. The contents of the was not properly processed. --- lib/erl_docgen/priv/xsl/db_man.xsl | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl index 1df96caa36..0aca74bc97 100644 --- a/lib/erl_docgen/priv/xsl/db_man.xsl +++ b/lib/erl_docgen/priv/xsl/db_man.xsl @@ -137,8 +137,9 @@ (there is no spec with more than one clause) --> .RS - .TP 3 + .LP Types: + .RS 3 @@ -164,6 +165,8 @@ + .RE + .RE @@ -257,8 +260,8 @@ - - .br + .RS 2 + .RE @@ -757,24 +760,26 @@ .RS - .TP 3 + .LP Types: + .RS 3 .RE + .RE - + .br - - .br + .RS 2 + .RE -- cgit v1.2.3 From 6a37976806f9a0998d0970c17f0e176b6e19bdad Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 6 Oct 2011 15:08:09 +0200 Subject: Correct the docs --- erts/doc/src/erl.xml | 2 +- lib/stdlib/doc/src/lists.xml | 26 +++++++++++++------------- lib/stdlib/src/lists.erl | 29 +++++++++++++++++------------ 3 files changed, 31 insertions(+), 26 deletions(-) diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 8502ceadd2..39c79a29df 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -994,7 +994,7 @@ the section, i.e. the end of the command line following after an flag.

- and + and

The content of these environment variables will be added to the end of the command line for .

diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 6f3ed7af98..7042c84437 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -240,7 +240,7 @@ flatmap(Fun, List1) -> Delete an element from a list of tuples - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Returns a copy of TupleList1 where the first occurrence of a tuple whose Nth element compares equal to @@ -266,7 +266,7 @@ flatmap(Fun, List1) -> Map a function over a list of tuples - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Returns a list of tuples where, for each tuple in TupleList1, the Nth element Term1 of the tuple @@ -298,7 +298,7 @@ flatmap(Fun, List1) -> Merge two key-sorted lists of tuples - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Returns the sorted list formed by merging TupleList1 and TupleList2. The merge is performed on @@ -312,7 +312,7 @@ flatmap(Fun, List1) -> Replace an element in a list of tuples - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Returns a copy of TupleList1 where the first occurrence of a T tuple whose Nth element @@ -342,7 +342,7 @@ flatmap(Fun, List1) -> Sort a list of tuples - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Returns a list containing the sorted elements of the list TupleList1. Sorting is performed on the Nth @@ -352,7 +352,7 @@ flatmap(Fun, List1) -> Store an element in a list of tuples - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Returns a copy of TupleList1 where the first occurrence of a tuple T whose Nth element @@ -366,7 +366,7 @@ flatmap(Fun, List1) -> Extract an element from a list of tuples - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Searches the list of tuples TupleList1 for a tuple whose Nth element compares equal to Key. @@ -500,7 +500,7 @@ flatmap(Fun, List1) -> Return the Nth element of a list - 1..length(List) + 1..length(List)

Returns the Nth element of List. For example:

@@ -511,7 +511,7 @@ c
Return the Nth tail of a list - 0..length(List) + 0..length(List)

Returns the Nth tail of List, that is, the sublist of List starting at N+1 and continuing up to @@ -630,7 +630,7 @@ length(lists:seq(From, To, Incr)) == (To-From+Incr) div Incr Split a list into two lists - 0..length(List1) + 0..length(List1)

Splits List1 into List2 and List3. List2 contains the first N elements and @@ -670,7 +670,7 @@ splitwith(Pred, List) -> Return a sub-list starting at a given position and with a given number of elements - 1..(length(List1)+1) + 1..(length(List1)+1)

Returns the sub-list of List1 starting at Start and with (max) Len elements. It is not an error for @@ -732,7 +732,7 @@ splitwith(Pred, List) -> Merge two key-sorted lists of tuples, removing duplicates - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Returns the sorted list formed by merging TupleList1 and TupleList2. The merge is performed on the @@ -746,7 +746,7 @@ splitwith(Pred, List) -> Sort a list of tuples, removing duplicates - 1..tuple_size(Tuple) + 1..tuple_size(Tuple)

Returns a list containing the sorted elements of the list TupleList1 where all but the first tuple of the diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index bba46e4cb6..e73c087753 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -628,9 +628,10 @@ keydelete3(_, _, []) -> []. -spec keyreplace(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + NewTuple :: Tuple, + Tuple :: tuple(). keyreplace(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keyreplace3(K, N, L, New). @@ -660,9 +661,10 @@ keytake(_K, _N, [], _L) -> false. -spec keystore(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple(), ...], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple, ...], + NewTuple :: Tuple, + Tuple :: tuple(). keystore(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keystore2(K, N, L, New). @@ -740,8 +742,9 @@ keysort_1(_I, X, _EX, [], R) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). keymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> case L2 of @@ -842,8 +845,9 @@ ukeysort_1(_I, X, _EX, []) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 -> case L1 of @@ -873,8 +877,9 @@ rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> -spec keymap(Fun, N, TupleList1) -> TupleList2 when Fun :: fun((Term1 :: term()) -> Term2 :: term()), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()]. + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + Tuple :: tuple(). keymap(Fun, Index, [Tup|Tail]) -> [setelement(Index, Tup, Fun(element(Index, Tup)))|keymap(Fun, Index, Tail)]; -- cgit v1.2.3 From 45951664c2214ee9e4342e5909a8fa8445f03b92 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 6 Oct 2011 09:50:38 +0200 Subject: Fix a bug in Dets concerning repair of almost full tables A Dets table with sufficiently large buckets could not always be repaired. (Reported by Gordon Guthrie.) The format of Dets files has been modified. When downgrading tables created with the new system will be repaired. Otherwise the modification should not be noticeable. --- lib/stdlib/src/dets.erl | 57 +++++++++----------- lib/stdlib/src/dets.hrl | 3 +- lib/stdlib/src/dets_v8.erl | 16 +++--- lib/stdlib/src/dets_v9.erl | 118 +++++++++++++++++++++++------------------ lib/stdlib/test/dets_SUITE.erl | 93 ++++++++++++++++++++++++++++++-- 5 files changed, 189 insertions(+), 98 deletions(-) diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 7ed9c4b695..c0f9ce34b0 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1754,17 +1754,6 @@ system_code_change(State, _Module, _OldVsn, _Extra) -> %%% Internal functions %%%---------------------------------------------------------------------- -constants(FH, FileName) -> - Version = FH#fileheader.version, - if - Version =< 8 -> - dets_v8:constants(); - Version =:= 9 -> - dets_v9:constants(); - true -> - throw({error, {not_a_dets_file, FileName}}) - end. - %% -> {ok, Fd, fileheader()} | throw(Error) read_file_header(FileName, Access, RamFile) -> BF = if @@ -1842,7 +1831,11 @@ do_bchunk_init(Head, Tab) -> {H2, {error, old_version}}; Parms -> L = dets_utils:all_allocated(H2), - C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L}, + Bin = if + L =:= <<>> -> eof; + true -> <<>> + end, + C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L}, BinParms = term_to_binary(Parms), {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk}, [BinParms]}} @@ -2478,9 +2471,7 @@ fopen2(Fname, Tab) -> Do = case Mod:check_file_header(FH, Fd) of {ok, Head1, ExtraInfo} -> Head2 = Head1#head{filename = Fname}, - try Mod:init_freelist(Head2, ExtraInfo) of - Ftab -> - {ok, Head1#head{freelists = Ftab}} + try {ok, Mod:init_freelist(Head2, ExtraInfo)} catch throw:_ -> {repair, " has bad free lists, repairing ..."} @@ -2574,9 +2565,7 @@ fopen_existing_file(Tab, OpenArgs) -> Do = case Wh of {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact -> Hd1 = Hd#head{filename = Fname}, - try Mod:init_freelist(Hd1, Extra) of - Ftab -> - {Tag, Hd#head{freelists = Ftab}} + try {Tag, Mod:init_freelist(Hd1, Extra)} catch throw:_ -> {repair, " has bad free lists, repairing ..."} @@ -3164,8 +3153,12 @@ init_scan(Head, NoObjs) -> check_safe_fixtable(Head), FreeLists = dets_utils:get_freelists(Head), Base = Head#head.base, - {From, To} = dets_utils:find_next_allocated(FreeLists, Base, Base), - #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From, To, <<>>}}. + case dets_utils:find_next_allocated(FreeLists, Base, Base) of + {From, To} -> + #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From,To,<<>>}}; + none -> + #dets_cont{no_objs = NoObjs, bin = eof, alloc = <<>>} + end. check_safe_fixtable(Head) -> case (Head#head.fixed =:= false) andalso @@ -3266,18 +3259,18 @@ view(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> Mod = FH#fileheader.mod, - try - case Mod:check_file_header(FH, Fd) of - {ok, H0, ExtraInfo} -> - Ftab = Mod:init_freelist(H0, ExtraInfo), - {_Bump, Base} = constants(FH, FileName), - H = H0#head{freelists=Ftab, base = Base}, - v_free_list(H), - Mod:v_segments(H), - ok; - X -> - X - end + try Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + Mod = FH#fileheader.mod, + case Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + H = Mod:init_freelist(H0, ExtraInfo), + v_free_list(H), + Mod:v_segments(H), + ok; + X -> + X + end after file:close(Fd) end; X -> diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl index fbffc9d008..a3f99357a2 100644 --- a/lib/stdlib/src/dets.hrl +++ b/lib/stdlib/src/dets.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-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 @@ -92,6 +92,7 @@ %% Info extracted from the file header. -record(fileheader, { freelist, + fl_base, cookie, closed_properly, type, diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index cdd38d5604..3e962a1c8b 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles versions up to %% and including 8(c). To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, write_cache/1, may_grow/3, @@ -196,10 +196,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <>}], @@ -308,8 +304,9 @@ init_freelist(Head, {convert_freelist,_Version}) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - FreeList = lists:reverse(Term), - dets_utils:init_slots_from_old_file(FreeList, Ftab); + FreeList1 = lists:reverse(Term), + FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab), + Head#head{freelists = FreeList, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end; @@ -318,7 +315,7 @@ init_freelist(Head, _) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - Term; + Head#head{freelists = Term, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end. @@ -331,6 +328,7 @@ read_file_header(Fd, FileName) -> {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), FH = #fileheader{freelist = Freelist, + fl_base = ?BASE, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -413,7 +411,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 132af01f79..f577b4410f 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-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 @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles version 9. %% To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, prep_table_copy/9, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, bchunk_init/2, @@ -70,6 +70,17 @@ %% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. %% (FreelistsPointer, Cookie and ClosedProperly are not digested.) %% 128 Reserved for future versions. Initially zeros. +%% Version 9(d), introduced in R15A, has instead: +%% 112 28 counters for the buddy system sizes (as for 9(b)). +%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. +%% (FreelistsPointer, Cookie and ClosedProperly are not digested.) +%% 4 Base of the buddy system. +%% 0 (zero) if the base is equal to ?BASE. Compatible with R14B. +%% File size at the end of the file is RealFileSize - Base. +%% The reason for modifying file size is that when a file created +%% by R15 is read by R14 a repair takes place immediately, which +%% is acceptable when downgrading. +%% 124 Reserved for future versions. Initially zeros. %% --- %% ------------------ end of file header %% 4*256 SegmentArray Pointers. @@ -86,7 +97,7 @@ %% ----------------------------- %% ??? Free lists %% ----------------------------- -%% 4 File size, in bytes. +%% 4 File size, in bytes. See 9(d) obove. %% Before we can find an object we must find the slot where the %% object resides. Each slot is a (possibly empty) list (or chain) of @@ -177,14 +188,14 @@ %%% File header %%% --define(RESERVED, 128). % Reserved for future use. +-define(RESERVED, 124). % Reserved for future use. -define(COLL_CNTRS, (28*4)). % Counters for the buddy system. -define(MD5SZ, 16). +-define(FL_BASE, 4). --define(HEADSZ, - 56+?COLL_CNTRS+?MD5SZ). % The size of the file header, in bytes, - % not including the reserved part. +-define(HEADSZ, 56+?COLL_CNTRS % The size of the file header, in bytes, + +?MD5SZ+?FL_BASE). % not including the reserved part. -define(HEADEND, (?HEADSZ+?RESERVED)). % End of header and reserved area. -define(SEGSZ, 512). % Size of a segment, in words. SZOBJP*SEGSZP. @@ -270,10 +281,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <>}], @@ -356,7 +363,7 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, cache = dets_utils:new_cache(CacheSz), version = ?FILE_FORMAT_VERSION, bump = ?BUMP, - base = ?BASE, + base = ?BASE, % to be overwritten mod = ?MODULE }, @@ -378,13 +385,20 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, {Head1, Ws1} = init_parts(Head0, 0, no_parts(Next), Zero, []), NoSegs = no_segs(Next), - {Head, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), + {Head2, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), Ws2 = if DoInitSegments -> WsP ++ WsI; true -> WsP end, dets_utils:pwrite(Fd, Fname, [W0 | lists:append(Ws1) ++ Ws2]), - true = hash_invars(Head), + true = hash_invars(Head2), + %% The allocations that have been made so far (parts, segments) + %% are permanent; the table will never shrink. Therefore the base + %% of the Buddy system can be set to the first free object. + %% This is used in allocate_all(), see below. + {_, Where, _} = dets_utils:alloc(Head2, ?BUMP), + NewFtab = dets_utils:init_alloc(Where), + Head = Head2#head{freelists = NewFtab, base = Where}, {ok, Head}. %% Returns a power of two not less than 256. @@ -451,8 +465,9 @@ read_file_header(Fd, FileName) -> Version:32, M:32, Next:32, Kp:32, NoObjects:32, NoKeys:32, MinNoSlots:32, MaxNoSlots:32, HashMethod:32, N:32, NoCollsB:?COLL_CNTRS/binary, - MD5:?MD5SZ/binary>> = Bin, - <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-12)/binary,_/binary>> = Bin, + MD5:?MD5SZ/binary, FlBase:32>> = Bin, + <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-?FL_BASE-12)/binary, + _/binary>> = Bin, {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), {CL, <<>>} = lists:foldl(fun(LSz, {Acc,<>}) -> @@ -468,8 +483,12 @@ read_file_header(Fd, FileName) -> true -> lists:reverse(CL) end, - + Base = case FlBase of + 0 -> ?BASE; + _ -> FlBase + end, FH = #fileheader{freelist = FreeList, + fl_base = Base, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -486,7 +505,7 @@ read_file_header(Fd, FileName) -> read_md5 = MD5, has_md5 = <<0:?MD5SZ/unit:8>> =/= MD5, md5 = erlang:md5(MD5DigestedPart), - trailer = FileSize, + trailer = FileSize + FlBase, eof = EOF, n = N, mod = ?MODULE}, @@ -544,7 +563,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error @@ -1185,41 +1204,25 @@ write_loop(Head, BytesToWrite, Bin) -> write_loop(Head, BytesToWrite, SmallBin). %% By allocating bigger objects before smaller ones, holes in the -%% buddy system memory map are avoided. Unfortunately, the segments -%% are always allocated first, so if there are objects bigger than a -%% segment, there is a hole to handle. (Haven't considered placing the -%% segments among other objects of the same size.) +%% buddy system memory map are avoided. allocate_all_objects(Head, SizeT) -> DTL = lists:reverse(lists:keysort(1, ets:tab2list(SizeT))), MaxSz = element(1, hd(DTL)), - SegSize = ?ACTUAL_SEG_SIZE, - {Head1, HSz, HN, HA} = alloc_hole(MaxSz, Head, SegSize), - {Head2, NL} = allocate_all(Head1, DTL, []), + {Head1, NL} = allocate_all(Head, DTL, []), %% Find the position that will be the end of the file by allocating %% a minimal object. - {_Head, EndOfFile, _} = dets_utils:alloc(Head2, ?BUMP), - Head3 = free_hole(Head2, HSz, HN, HA), - NewHead = Head3#head{maxobjsize = max_objsize(Head3#head.no_collections)}, + {_Head, EndOfFile, _} = dets_utils:alloc(Head1, ?BUMP), + NewHead = Head1#head{maxobjsize = max_objsize(Head1#head.no_collections)}, {NewHead, NL, MaxSz, EndOfFile}. -alloc_hole(LSize, Head, SegSz) when ?POW(LSize-1) > SegSz -> - Size = ?POW(LSize-1), - {_, SegAddr, _} = dets_utils:alloc(Head, adjsz(SegSz)), - {_, Addr, _} = dets_utils:alloc(Head, adjsz(Size)), - N = (Addr - SegAddr) div SegSz, - Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr), - {Head1, SegSz, N, SegAddr}; -alloc_hole(_MaxSz, Head, _SegSz) -> - {Head, 0, 0, 0}. - -free_hole(Head, _Size, 0, _Addr) -> - Head; -free_hole(Head, Size, N, Addr) -> - {Head1, _} = dets_utils:free(Head, Addr, adjsz(Size)), - free_hole(Head1, Size, N-1, Addr+Size). - %% One (temporary) file for each buddy size, write all objects of that %% size to the file. +%% +%% Before R15 a "hole" was needed before the first bucket if the size +%% of the biggest bucket was greater than the size of a segment. The +%% hole proved to be a problem with almost full tables with huge +%% buckets. Since R15 the hole is no longer needed due to the fact +%% that the base of the Buddy system is flexible. allocate_all(Head, [{?FSCK_SEGMENT,_,Data,_}], L) -> %% And one file for the segments... %% Note that space for the array parts and the segments has @@ -1593,23 +1596,28 @@ do_perform_save(H) -> H1 = H#head{freelists_p = FreeListsPointer}, {FLW, FLSize} = free_lists_to_file(H1), FileSize = FreeListsPointer + FLSize + 4, - ok = dets_utils:write(H1, [FLW | <>]), + AdjustedFileSize = case H#head.base of + ?BASE -> FileSize; + Base -> FileSize - Base + end, + ok = dets_utils:write(H1, [FLW | <>]), FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY), case dets_utils:debug_mode() of true -> - TmpHead = H1#head{freelists = init_freelist(H1, true), - fixed = false}, + TmpHead0 = init_freelist(H1#head{fixed = false}, true), + TmpHead = TmpHead0#head{base = H1#head.base}, case catch dets_utils:all_allocated_as_list(TmpHead) =:= dets_utils:all_allocated_as_list(H1) - of + of true -> dets_utils:pwrite(H1, [{0, FileHeader}]); _ -> + throw( dets_utils:corrupt_reason(H1, {failed_to_save_free_lists, FreeListsPointer, TmpHead#head.freelists, - H1#head.freelists}) + H1#head.freelists})) end; false -> dets_utils:pwrite(H1, [{0, FileHeader}]) @@ -1648,7 +1656,11 @@ file_header(Head, FreeListsPointer, ClosedProperly, NoColls) -> true -> erlang:md5(DigH); false -> <<0:?MD5SZ/unit:8>> end, - [H1, DigH, MD5 | <<0:?RESERVED/unit:8>>]. + Base = case Head#head.base of + ?BASE -> <<0:32>>; + FlBase -> <> + end, + [H1, DigH, MD5, Base | <<0:?RESERVED/unit:8>>]. %% Going through some trouble to avoid creating one single binary for %% the free lists. If the free lists are huge, binary_to_term and @@ -1695,8 +1707,8 @@ free_lists_from_file(H, Pos) -> case catch bin_to_tree([], H, start, FL, -1, []) of {'EXIT', _} -> throw({error, {bad_freelists, H#head.filename}}); - Reply -> - Reply + Ftab -> + H#head{freelists = Ftab, base = ?BASE} end. bin_to_tree(Bin, H, LastPos, Ftab, A0, L) -> diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index b68d83b12d..63767aeda6 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -34,6 +34,8 @@ -define(datadir(Conf), ?config(data_dir, Conf)). -endif. +-compile(r13). % OTP-9607 + -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, not_run/1, newly_started/1, basic_v8/1, basic_v9/1, @@ -53,7 +55,7 @@ simultaneous_open/1, insert_new/1, repair_continuation/1, otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1, otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1, - otp_8923/1, otp_9282/1]). + otp_8923/1, otp_9282/1, otp_9607/1]). -export([dets_dirty_loop/0]). @@ -112,7 +114,7 @@ all() -> many_clients, otp_4906, otp_5402, simultaneous_open, insert_new, repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898, - otp_8899, otp_8903, otp_8923, otp_9282] + otp_8899, otp_8903, otp_8923, otp_9282, otp_9607] end. groups() -> @@ -554,7 +556,11 @@ dets_dirty_loop() -> {From, [write, Name, Value]} -> Ret = dets:insert(Name, Value), From ! {self(), Ret}, - dets_dirty_loop() + dets_dirty_loop(); + {From, [close, Name]} -> + Ret = dets:close(Name), + From ! {self(), Ret}, + dets_dirty_loop() end. @@ -3882,10 +3888,91 @@ some_calls(Tab, Config) -> ?line ok = dets:close(T), file:delete(File). +otp_9607(doc) -> + ["OTP-9607. Test downgrading the slightly changed format."]; +otp_9607(suite) -> + []; +otp_9607(Config) when is_list(Config) -> + %% Note: the bug is about almost full tables. The fix of that + %% problem is *not* tested here. + Version = r13b, + case ?t:is_release_available(atom_to_list(Version)) of + true -> + T = otp_9607, + File = filename(T, Config), + Key = a, + Value = 1, + Args = [{file,File}], + ?line {ok, T} = dets:open_file(T, Args), + ?line ok = dets:insert(T, {Key, Value}), + ?line ok = dets:close(T), + + ?line Call = fun(P, A) -> + P ! {self(), A}, + receive + {P, Ans} -> + Ans + after 5000 -> + exit(other_process_dead) + end + end, + %% Create a file on the modified format, read the file + %% with an emulator that doesn't know about the modified + %% format. + ?line {ok, Node} = start_node_rel(Version, Version, slave), + ?line Pid = rpc:call(Node, erlang, spawn, + [?MODULE, dets_dirty_loop, []]), + ?line {error,{needs_repair, File}} = + Call(Pid, [open, T, Args++[{repair,false}]]), + io:format("Expect repair:~n"), + ?line {ok, T} = Call(Pid, [open, T, Args]), + ?line [{Key,Value}] = Call(Pid, [read, T, Key]), + ?line ok = Call(Pid, [close, T]), + file:delete(File), + + %% Create a file on the unmodified format. Modify the file + %% using an emulator that must not turn the file into the + %% modified format. Read the file and make sure it is not + %% repaired. + ?line {ok, T} = Call(Pid, [open, T, Args]), + ?line ok = Call(Pid, [write, T, {Key,Value}]), + ?line [{Key,Value}] = Call(Pid, [read, T, Key]), + ?line ok = Call(Pid, [close, T]), + + Key2 = b, + Value2 = 2, + + ?line {ok, T} = dets:open_file(T, Args), + ?line [{Key,Value}] = dets:lookup(T, Key), + ?line ok = dets:insert(T, {Key2,Value2}), + ?line ok = dets:close(T), + + ?line {ok, T} = Call(Pid, [open, T, Args++[{repair,false}]]), + ?line [{Key2,Value2}] = Call(Pid, [read, T, Key2]), + ?line ok = Call(Pid, [close, T]), + + ?t:stop_node(Node), + file:delete(File), + ok; + false -> + {skipped, "No support for old node"} + end. + + + %% %% Parts common to several test cases %% +start_node_rel(Name, Rel, How) -> + Release = [{release, atom_to_list(Rel)}], + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line test_server:start_node(Name, How, + [{args, + " -kernel net_setuptime 100 " + " -pa " ++ Pa}, + {erl, Release}]). + crash(File, Where) -> crash(File, Where, 10). -- cgit v1.2.3 From c03ac3db1d90e2b86ac4acfd6f0d09a324be4a42 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 01:44:58 +0200 Subject: @result_code -> @define in dictionary files The section simply results in generated macros and has nothing specifically to do with result codes. It's still not documented, and neither are the macros generated from @enum, since the generated names are typically so long as to be impractical/unreadable in source. Better to use numeric values with a comment or define your own shorter macros as the need arises. --- lib/diameter/src/app/diameter_gen_base_rfc3588.dia | 2 +- lib/diameter/src/compiler/diameter_codegen.erl | 4 ++-- lib/diameter/src/compiler/diameter_spec_util.erl | 8 +++++--- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia b/lib/diameter/src/app/diameter_gen_base_rfc3588.dia index 4a12e21acd..4c14ee7575 100644 --- a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia +++ b/lib/diameter/src/app/diameter_gen_base_rfc3588.dia @@ -340,7 +340,7 @@ GRANT_AND_STORE 2 GRANT_AND_LOSE 3 -@result_code Result-Code +@define Result-Code ;; 7.1.1. Informational DIAMETER_MULTI_ROUND_AUTH 1001 diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index a33b07a3d3..0fd4a0b301 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -707,9 +707,9 @@ gen_hrl(Path, Mod, Spec) -> write("ENUM Macros", Fd, m_enums(PREFIX, false, get_value(enums, Spec))), - write("RESULT CODE Macros", + write("DEFINE Macros", Fd, - m_enums(PREFIX, false, get_value(result_codes, Spec))), + m_enums(PREFIX, false, get_value(defines, Spec))), lists:foreach(fun({M,Es}) -> write("ENUM Macros from " ++ atom_to_list(M), diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl index b60886b678..e9221ed00a 100644 --- a/lib/diameter/src/compiler/diameter_spec_util.erl +++ b/lib/diameter/src/compiler/diameter_spec_util.erl @@ -204,9 +204,11 @@ chunk({avp_vendor_id = T, [{number, I}], Body}, Dict) -> chunk({enum, [N], Str}, Dict) -> append(enums, {atomize(N), parse_enums(Str)}, Dict); -%% result_codes -> [{ResultName, [{Value, Name}, ...]}, ...] -chunk({result_code, [N], Str}, Dict) -> - append(result_codes, {atomize(N), parse_enums(Str)}, Dict); +%% defines -> [{DefineName, [{Value, Name}, ...]}, ...] +chunk({define, [N], Str}, Dict) -> + append(defines, {atomize(N), parse_enums(Str)}, Dict); +chunk({result_code, [_] = N, Str}, Dict) -> %% backwards compatibility + chunk({define, N, Str}, Dict); %% commands -> [{Name, Abbrev}, ...] chunk({commands = T, [], Body}, Dict) -> -- cgit v1.2.3 From 945d09cdea615404454b5951cb49472adab29eeb Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 01:55:55 +0200 Subject: Whitespace fixes --- lib/diameter/bin/diameterc | 2 +- .../src/app/diameter_gen_base_accounting.dia | 80 ++-- lib/diameter/src/app/diameter_gen_base_rfc3588.dia | 486 ++++++++++----------- 3 files changed, 284 insertions(+), 284 deletions(-) diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index f5cf3ebc10..e232cdb120 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -120,7 +120,7 @@ arg(["-H" | Args], #argv{output = Output} = A) -> arg(["-d" | Args], #argv{options = Opts, output = Output} = A) -> arg(Args, A#argv{options = [debug | Opts], - output = [spec | Output]}); + output = [spec | Output]}); arg([[$- = M, C, H | T] | Args], A) %% clustered options when C /= $i, C /= $o -> diff --git a/lib/diameter/src/app/diameter_gen_base_accounting.dia b/lib/diameter/src/app/diameter_gen_base_accounting.dia index 64e95dddb5..b76e9f3473 100644 --- a/lib/diameter/src/app/diameter_gen_base_accounting.dia +++ b/lib/diameter/src/app/diameter_gen_base_accounting.dia @@ -25,44 +25,44 @@ @messages - ACR ::= < Diameter Header: 271, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Accounting-Record-Type } - { Accounting-Record-Number } - [ Acct-Application-Id ] - [ Vendor-Specific-Application-Id ] - [ User-Name ] - [ Accounting-Sub-Session-Id ] - [ Acct-Session-Id ] - [ Acct-Multi-Session-Id ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] - ACA ::= < Diameter Header: 271, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - { Accounting-Record-Type } - { Accounting-Record-Number } - [ Acct-Application-Id ] - [ Vendor-Specific-Application-Id ] - [ User-Name ] - [ Accounting-Sub-Session-Id ] - [ Acct-Session-Id ] - [ Acct-Multi-Session-Id ] - [ Error-Reporting-Host ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ AVP ] + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Reporting-Host ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] diff --git a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia b/lib/diameter/src/app/diameter_gen_base_rfc3588.dia index 4c14ee7575..7ec4c613d4 100644 --- a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia +++ b/lib/diameter/src/app/diameter_gen_base_rfc3588.dia @@ -76,274 +76,274 @@ @messages - CER ::= < Diameter Header: 257, REQ > - { Origin-Host } - { Origin-Realm } - 1* { Host-IP-Address } - { Vendor-Id } - { Product-Name } - [ Origin-State-Id ] - * [ Supported-Vendor-Id ] - * [ Auth-Application-Id ] - * [ Inband-Security-Id ] - * [ Acct-Application-Id ] - * [ Vendor-Specific-Application-Id ] - [ Firmware-Revision ] - * [ AVP ] - - CEA ::= < Diameter Header: 257 > - { Result-Code } - { Origin-Host } - { Origin-Realm } - 1* { Host-IP-Address } - { Vendor-Id } - { Product-Name } - [ Origin-State-Id ] - [ Error-Message ] - * [ Failed-AVP ] - * [ Supported-Vendor-Id ] - * [ Auth-Application-Id ] - * [ Inband-Security-Id ] - * [ Acct-Application-Id ] - * [ Vendor-Specific-Application-Id ] - [ Firmware-Revision ] - * [ AVP ] - - DPR ::= < Diameter Header: 282, REQ > - { Origin-Host } - { Origin-Realm } - { Disconnect-Cause } - - DPA ::= < Diameter Header: 282 > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ Error-Message ] - * [ Failed-AVP ] - - DWR ::= < Diameter Header: 280, REQ > - { Origin-Host } - { Origin-Realm } - [ Origin-State-Id ] - - DWA ::= < Diameter Header: 280 > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ Error-Message ] - * [ Failed-AVP ] - [ Origin-State-Id ] - - answer-message ::= < Diameter Header: code, ERR [PXY] > - 0*1< Session-Id > - { Origin-Host } - { Origin-Realm } - { Result-Code } - [ Origin-State-Id ] - [ Error-Reporting-Host ] - [ Proxy-Info ] - * [ AVP ] - - RAR ::= < Diameter Header: 258, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Destination-Host } - { Auth-Application-Id } - { Re-Auth-Request-Type } - [ User-Name ] - [ Origin-State-Id ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - RAA ::= < Diameter Header: 258, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ User-Name ] - [ Origin-State-Id ] - [ Error-Message ] - [ Error-Reporting-Host ] - * [ Failed-AVP ] - * [ Redirect-Host ] - [ Redirect-Host-Usage ] - [ Redirect-Max-Cache-Time ] - * [ Proxy-Info ] - * [ AVP ] - - STR ::= < Diameter Header: 275, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Auth-Application-Id } - { Termination-Cause } - [ User-Name ] - [ Destination-Host ] - * [ Class ] - [ Origin-State-Id ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - STA ::= < Diameter Header: 275, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ User-Name ] - * [ Class ] - [ Error-Message ] - [ Error-Reporting-Host ] - * [ Failed-AVP ] - [ Origin-State-Id ] - * [ Redirect-Host ] - [ Redirect-Host-Usage ] - [ Redirect-Max-Cache-Time ] - * [ Proxy-Info ] - * [ AVP ] - - ASR ::= < Diameter Header: 274, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Destination-Host } - { Auth-Application-Id } - [ User-Name ] - [ Origin-State-Id ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - ASA ::= < Diameter Header: 274, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ User-Name ] - [ Origin-State-Id ] - [ Error-Message ] - [ Error-Reporting-Host ] - * [ Failed-AVP ] - * [ Redirect-Host ] - [ Redirect-Host-Usage ] - [ Redirect-Max-Cache-Time ] - * [ Proxy-Info ] - * [ AVP ] - - ACR ::= < Diameter Header: 271, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Accounting-Record-Type } - { Accounting-Record-Number } - [ Acct-Application-Id ] - [ Vendor-Specific-Application-Id ] - [ User-Name ] - [ Accounting-Sub-Session-Id ] - [ Acct-Session-Id ] - [ Acct-Multi-Session-Id ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - ACA ::= < Diameter Header: 271, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - { Accounting-Record-Type } - { Accounting-Record-Number } - [ Acct-Application-Id ] - [ Vendor-Specific-Application-Id ] - [ User-Name ] - [ Accounting-Sub-Session-Id ] - [ Acct-Session-Id ] - [ Acct-Multi-Session-Id ] - [ Error-Reporting-Host ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ AVP ] + CER ::= < Diameter Header: 257, REQ > + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + CEA ::= < Diameter Header: 257 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + [ Error-Message ] + * [ Failed-AVP ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + DPR ::= < Diameter Header: 282, REQ > + { Origin-Host } + { Origin-Realm } + { Disconnect-Cause } + + DPA ::= < Diameter Header: 282 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + * [ Failed-AVP ] + + DWR ::= < Diameter Header: 280, REQ > + { Origin-Host } + { Origin-Realm } + [ Origin-State-Id ] + + DWA ::= < Diameter Header: 280 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + * [ Failed-AVP ] + [ Origin-State-Id ] + + answer-message ::= < Diameter Header: code, ERR [PXY] > + 0*1 < Session-Id > + { Origin-Host } + { Origin-Realm } + { Result-Code } + [ Origin-State-Id ] + [ Error-Reporting-Host ] + [ Proxy-Info ] + * [ AVP ] + + RAR ::= < Diameter Header: 258, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + { Re-Auth-Request-Type } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + RAA ::= < Diameter Header: 258, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + STR ::= < Diameter Header: 275, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Auth-Application-Id } + { Termination-Cause } + [ User-Name ] + [ Destination-Host ] + * [ Class ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + STA ::= < Diameter Header: 275, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + * [ Class ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + [ Origin-State-Id ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ASR ::= < Diameter Header: 274, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ASA ::= < Diameter Header: 274, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Reporting-Host ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] @enum Disconnect-Cause - REBOOTING 0 - BUSY 1 - DO_NOT_WANT_TO_TALK_TO_YOU 2 + REBOOTING 0 + BUSY 1 + DO_NOT_WANT_TO_TALK_TO_YOU 2 @enum Redirect-Host-Usage - DONT_CACHE 0 - ALL_SESSION 1 - ALL_REALM 2 - REALM_AND_APPLICATION 3 - ALL_APPLICATION 4 - ALL_HOST 5 - ALL_USER 6 + DONT_CACHE 0 + ALL_SESSION 1 + ALL_REALM 2 + REALM_AND_APPLICATION 3 + ALL_APPLICATION 4 + ALL_HOST 5 + ALL_USER 6 @enum Auth-Request-Type - AUTHENTICATE_ONLY 1 - AUTHORIZE_ONLY 2 - AUTHORIZE_AUTHENTICATE 3 + AUTHENTICATE_ONLY 1 + AUTHORIZE_ONLY 2 + AUTHORIZE_AUTHENTICATE 3 @enum Auth-Session-State - STATE_MAINTAINED 0 - NO_STATE_MAINTAINED 1 + STATE_MAINTAINED 0 + NO_STATE_MAINTAINED 1 @enum Re-Auth-Request-Type - AUTHORIZE_ONLY 0 - AUTHORIZE_AUTHENTICATE 1 + AUTHORIZE_ONLY 0 + AUTHORIZE_AUTHENTICATE 1 @enum Termination-Cause - DIAMETER_LOGOUT 1 - DIAMETER_SERVICE_NOT_PROVIDED 2 - DIAMETER_BAD_ANSWER 3 - DIAMETER_ADMINISTRATIVE 4 - DIAMETER_LINK_BROKEN 5 - DIAMETER_AUTH_EXPIRED 6 - DIAMETER_USER_MOVED 7 - DIAMETER_SESSION_TIMEOUT 8 + DIAMETER_LOGOUT 1 + DIAMETER_SERVICE_NOT_PROVIDED 2 + DIAMETER_BAD_ANSWER 3 + DIAMETER_ADMINISTRATIVE 4 + DIAMETER_LINK_BROKEN 5 + DIAMETER_AUTH_EXPIRED 6 + DIAMETER_USER_MOVED 7 + DIAMETER_SESSION_TIMEOUT 8 @enum Session-Server-Failover - REFUSE_SERVICE 0 - TRY_AGAIN 1 - ALLOW_SERVICE 2 - TRY_AGAIN_ALLOW_SERVICE 3 + REFUSE_SERVICE 0 + TRY_AGAIN 1 + ALLOW_SERVICE 2 + TRY_AGAIN_ALLOW_SERVICE 3 @enum Accounting-Record-Type - EVENT_RECORD 1 - START_RECORD 2 - INTERIM_RECORD 3 - STOP_RECORD 4 + EVENT_RECORD 1 + START_RECORD 2 + INTERIM_RECORD 3 + STOP_RECORD 4 @enum Accounting-Realtime-Required - DELIVER_AND_GRANT 1 - GRANT_AND_STORE 2 - GRANT_AND_LOSE 3 + DELIVER_AND_GRANT 1 + GRANT_AND_STORE 2 + GRANT_AND_LOSE 3 @define Result-Code ;; 7.1.1. Informational - DIAMETER_MULTI_ROUND_AUTH 1001 + DIAMETER_MULTI_ROUND_AUTH 1001 ;; 7.1.2. Success DIAMETER_SUCCESS 2001 @@ -393,16 +393,16 @@ * [ AVP ] Failed-AVP ::= < AVP Header: 279 > - 1* {AVP} + 1* {AVP} Experimental-Result ::= < AVP Header: 297 > - { Vendor-Id } - { Experimental-Result-Code } + { Vendor-Id } + { Experimental-Result-Code } Vendor-Specific-Application-Id ::= < AVP Header: 260 > - 1* { Vendor-Id } - [ Auth-Application-Id ] - [ Acct-Application-Id ] + 1* { Vendor-Id } + [ Auth-Application-Id ] + [ Acct-Application-Id ] ;; The E2E-Sequence AVP is defined in RFC 3588 as Grouped, but ;; there is no definition of the group - only an informal text stating -- cgit v1.2.3 From 1bc7cbe24f2ae45f6573e4dfd002d6cfc9d4887a Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 02:41:46 +0200 Subject: Move dictionaries into own directory and rename Generated files are unchanged but the separation will be especially pleasant when more dictionary files are added as examples. It is still only the rfc3588 and relay dictionaries that are known to the diameter implementation. --- lib/diameter/src/app/Makefile | 59 ++- .../src/app/diameter_gen_base_accounting.dia | 68 ---- lib/diameter/src/app/diameter_gen_base_rfc3588.dia | 413 -------------------- lib/diameter/src/app/diameter_gen_relay.dia | 24 -- lib/diameter/src/app/modules.mk | 8 +- lib/diameter/src/dict/base_accounting.dia | 69 ++++ lib/diameter/src/dict/base_rfc3588.dia | 414 +++++++++++++++++++++ lib/diameter/src/dict/relay.dia | 25 ++ 8 files changed, 540 insertions(+), 540 deletions(-) delete mode 100644 lib/diameter/src/app/diameter_gen_base_accounting.dia delete mode 100644 lib/diameter/src/app/diameter_gen_base_rfc3588.dia delete mode 100644 lib/diameter/src/app/diameter_gen_relay.dia create mode 100644 lib/diameter/src/dict/base_accounting.dia create mode 100644 lib/diameter/src/dict/base_rfc3588.dia create mode 100644 lib/diameter/src/dict/relay.dia diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile index 96b7736a90..9042bff407 100644 --- a/lib/diameter/src/app/Makefile +++ b/lib/diameter/src/app/Makefile @@ -28,8 +28,6 @@ EBIN = ../../ebin include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk endif - - # ---------------------------------------------------- # Application version # ---------------------------------------------------- @@ -52,19 +50,10 @@ INCDIR = ../../include include modules.mk -diameter_gen_base_accounting.erl: \ - $(EBIN)/diameter_gen_base_rfc3588.beam -diameter_gen_relay.erl: \ - $(EBIN)/diameter_gen_base_rfc3588.beam - -SPEC_MODULES = \ - $(SPEC_FILES:%.dia=%) - -SPEC_ERL_FILES = \ - $(SPEC_FILES:%.dia=%.erl) - -SPEC_HRL_FILES = \ - $(SPEC_FILES:%.dia=%.hrl) +DICT_FILES = $(DICTIONARIES:%=../dict/%.dia) +DICT_MODULES = $(DICTIONARIES:%=diameter_gen_%) +DICT_ERL_FILES = $(DICT_MODULES:%=%.erl) +DICT_HRL_FILES = $(DICT_MODULES:%=%.hrl) MODULES = \ $(RUNTIME_MODULES) \ @@ -72,7 +61,7 @@ MODULES = \ APP_MODULES = \ $(RUNTIME_MODULES) \ - $(SPEC_MODULES) + $(DICT_MODULES) TARGET_MODULES = \ $(APP_MODULES) \ @@ -118,7 +107,7 @@ debug: opt: $(TARGET_FILES) clean: - rm -f $(TARGET_FILES) $(SPEC_ERL_FILES) $(SPEC_HRL_FILES) + rm -f $(TARGET_FILES) $(DICT_ERL_FILES) $(DICT_HRL_FILES) rm -f $(APP_TARGET) $(APPUP_TARGET) rm -f errs core *~ diameter_gen_*.forms diameter_gen_*.spec rm -f depend.mk @@ -127,8 +116,8 @@ docs: info: @echo "" - @echo "SPEC_FILES = $(FILES)" - @echo "MODULES = $(MODULES)" + @echo "DICTIONARIES = $(DICTIONARIES)" + @echo "MODULES = $(MODULES)" @echo "" @echo "EXTERNAL_HRL_FILES = $(EXTERNAL_HRL_FILES)" @echo "INTERNAL_HRL_FILES = $(INTERNAL_HRL_FILES)" @@ -140,6 +129,10 @@ info: # Special Build Targets # ---------------------------------------------------- +# erl/hrl from application spec +diameter_gen_%.erl diameter_gen_%.hrl: ../dict/%.dia + ../../bin/diameterc -i $(EBIN) $< + # Generate the app file and then modules into in. This shouldn't know # about ../transport but good enough for now. $(APP_TARGET): $(APP_SRC) \ @@ -158,13 +151,10 @@ $(APPUP_TARGET): $(APPUP_SRC) ../../vsn.mk compiler: $(MAKE) -C ../$@ -app: $(APP_TARGET) $(APPUP_TARGET) - -# erl/hrl from application spec -diameter_gen_%.erl diameter_gen_%.hrl: diameter_gen_%.dia - ../../bin/diameterc -i $(EBIN) -o $(@D) $< +app: $(APP_TARGET) $(APPUP_TARGET) +dict: $(DICT_ERL_FILES) -$(SPEC_MODULES:%=$(EBIN)/%.$(EMULATOR)): $(EBIN)/diameter_exprecs.$(EMULATOR) +$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): $(EBIN)/diameter_exprecs.$(EMULATOR) # ---------------------------------------------------- # Release Target @@ -180,14 +170,15 @@ release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/bin $(INSTALL_DIR) $(RELSYSDIR)/ebin $(INSTALL_DIR) $(RELSYSDIR)/src/app + $(INSTALL_DIR) $(RELSYSDIR)/src/dict $(INSTALL_DIR) $(RELSYSDIR)/include $(INSTALL_DIR) $(RELSYSDIR)/examples $(INSTALL_SCRIPT) $(ESCRIPT_FILES) $(RELSYSDIR)/bin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(MODULES:%=%.erl) $(SPEC_ERL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(SPEC_FILES) $(RELSYSDIR)/src/app + $(INSTALL_DATA) $(MODULES:%=%.erl) $(DICT_ERL_FILES) $(RELSYSDIR)/src/app + $(INSTALL_DATA) $(DICT_FILES) $(RELSYSDIR)/src/dict $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(SPEC_HRL_FILES) $(RELSYSDIR)/include + $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) $(RELSYSDIR)/include $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples release_docs_spec: @@ -196,7 +187,12 @@ release_docs_spec: # Dependencies # ---------------------------------------------------- -$(SPEC_FILES:%.dia=$(EBIN)/%.$(EMULATOR)): \ +diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ + $(EBIN)/diameter_gen_base_rfc3588.beam + +$(DICT_ERL_FILES) $(DICT_HRL_FILES): compiler + +$(DICT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)): \ $(DIAMETER_TOP)/include/diameter.hrl \ $(DIAMETER_TOP)/include/diameter_gen.hrl @@ -214,5 +210,6 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile -include depend.mk -.PRECIOUS: $(SPEC_ERL_FILES) $(SPEC_HRL_FILES) -.PHONY: app clean debug depend info opt compiler release_spec release_docs_spec +.PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) +.PHONY: app clean debug depend info opt compiler dict +.PHONY: release_spec release_docs_spec diff --git a/lib/diameter/src/app/diameter_gen_base_accounting.dia b/lib/diameter/src/app/diameter_gen_base_accounting.dia deleted file mode 100644 index b76e9f3473..0000000000 --- a/lib/diameter/src/app/diameter_gen_base_accounting.dia +++ /dev/null @@ -1,68 +0,0 @@ -;; -;; %CopyrightBegin% -;; -;; Copyright Ericsson AB 2010-2011. All Rights Reserved. -;; -;; The contents of this file are subject to the Erlang Public License, -;; Version 1.1, (the "License"); you may not use this file except in -;; compliance with the License. You should have received a copy of the -;; Erlang Public License along with this software. If not, it can be -;; retrieved online at http://www.erlang.org/. -;; -;; Software distributed under the License is distributed on an "AS IS" -;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -;; the License for the specific language governing rights and limitations -;; under the License. -;; -;; %CopyrightEnd% -;; - -@id 3 -@prefix diameter_base_accounting -@vendor 0 IETF - -@inherits diameter_gen_base_rfc3588 - -@messages - - ACR ::= < Diameter Header: 271, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Accounting-Record-Type } - { Accounting-Record-Number } - [ Acct-Application-Id ] - [ Vendor-Specific-Application-Id ] - [ User-Name ] - [ Accounting-Sub-Session-Id ] - [ Acct-Session-Id ] - [ Acct-Multi-Session-Id ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - ACA ::= < Diameter Header: 271, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - { Accounting-Record-Type } - { Accounting-Record-Number } - [ Acct-Application-Id ] - [ Vendor-Specific-Application-Id ] - [ User-Name ] - [ Accounting-Sub-Session-Id ] - [ Acct-Session-Id ] - [ Acct-Multi-Session-Id ] - [ Error-Reporting-Host ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ AVP ] diff --git a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia b/lib/diameter/src/app/diameter_gen_base_rfc3588.dia deleted file mode 100644 index 7ec4c613d4..0000000000 --- a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia +++ /dev/null @@ -1,413 +0,0 @@ -;; -;; %CopyrightBegin% -;; -;; Copyright Ericsson AB 2010-2011. All Rights Reserved. -;; -;; The contents of this file are subject to the Erlang Public License, -;; Version 1.1, (the "License"); you may not use this file except in -;; compliance with the License. You should have received a copy of the -;; Erlang Public License along with this software. If not, it can be -;; retrieved online at http://www.erlang.org/. -;; -;; Software distributed under the License is distributed on an "AS IS" -;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -;; the License for the specific language governing rights and limitations -;; under the License. -;; -;; %CopyrightEnd% -;; - -@id 0 -@prefix diameter_base -@vendor 0 IETF - -@avp_types - - Acct-Interim-Interval 85 Unsigned32 M - Accounting-Realtime-Required 483 Enumerated M - Acct-Multi-Session-Id 50 UTF8String M - Accounting-Record-Number 485 Unsigned32 M - Accounting-Record-Type 480 Enumerated M - Acct-Session-Id 44 OctetString M - Accounting-Sub-Session-Id 287 Unsigned64 M - Acct-Application-Id 259 Unsigned32 M - Auth-Application-Id 258 Unsigned32 M - Auth-Request-Type 274 Enumerated M - Authorization-Lifetime 291 Unsigned32 M - Auth-Grace-Period 276 Unsigned32 M - Auth-Session-State 277 Enumerated M - Re-Auth-Request-Type 285 Enumerated M - Class 25 OctetString M - Destination-Host 293 DiamIdent M - Destination-Realm 283 DiamIdent M - Disconnect-Cause 273 Enumerated M - E2E-Sequence 300 Grouped M - Error-Message 281 UTF8String - - Error-Reporting-Host 294 DiamIdent - - Event-Timestamp 55 Time M - Experimental-Result 297 Grouped M - Experimental-Result-Code 298 Unsigned32 M - Failed-AVP 279 Grouped M - Firmware-Revision 267 Unsigned32 - - Host-IP-Address 257 Address M - Inband-Security-Id 299 Unsigned32 M - Multi-Round-Time-Out 272 Unsigned32 M - Origin-Host 264 DiamIdent M - Origin-Realm 296 DiamIdent M - Origin-State-Id 278 Unsigned32 M - Product-Name 269 UTF8String - - Proxy-Host 280 DiamIdent M - Proxy-Info 284 Grouped M - Proxy-State 33 OctetString M - Redirect-Host 292 DiamURI M - Redirect-Host-Usage 261 Enumerated M - Redirect-Max-Cache-Time 262 Unsigned32 M - Result-Code 268 Unsigned32 M - Route-Record 282 DiamIdent M - Session-Id 263 UTF8String M - Session-Timeout 27 Unsigned32 M - Session-Binding 270 Unsigned32 M - Session-Server-Failover 271 Enumerated M - Supported-Vendor-Id 265 Unsigned32 M - Termination-Cause 295 Enumerated M - User-Name 1 UTF8String M - Vendor-Id 266 Unsigned32 M - Vendor-Specific-Application-Id 260 Grouped M - -@messages - - CER ::= < Diameter Header: 257, REQ > - { Origin-Host } - { Origin-Realm } - 1* { Host-IP-Address } - { Vendor-Id } - { Product-Name } - [ Origin-State-Id ] - * [ Supported-Vendor-Id ] - * [ Auth-Application-Id ] - * [ Inband-Security-Id ] - * [ Acct-Application-Id ] - * [ Vendor-Specific-Application-Id ] - [ Firmware-Revision ] - * [ AVP ] - - CEA ::= < Diameter Header: 257 > - { Result-Code } - { Origin-Host } - { Origin-Realm } - 1* { Host-IP-Address } - { Vendor-Id } - { Product-Name } - [ Origin-State-Id ] - [ Error-Message ] - * [ Failed-AVP ] - * [ Supported-Vendor-Id ] - * [ Auth-Application-Id ] - * [ Inband-Security-Id ] - * [ Acct-Application-Id ] - * [ Vendor-Specific-Application-Id ] - [ Firmware-Revision ] - * [ AVP ] - - DPR ::= < Diameter Header: 282, REQ > - { Origin-Host } - { Origin-Realm } - { Disconnect-Cause } - - DPA ::= < Diameter Header: 282 > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ Error-Message ] - * [ Failed-AVP ] - - DWR ::= < Diameter Header: 280, REQ > - { Origin-Host } - { Origin-Realm } - [ Origin-State-Id ] - - DWA ::= < Diameter Header: 280 > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ Error-Message ] - * [ Failed-AVP ] - [ Origin-State-Id ] - - answer-message ::= < Diameter Header: code, ERR [PXY] > - 0*1 < Session-Id > - { Origin-Host } - { Origin-Realm } - { Result-Code } - [ Origin-State-Id ] - [ Error-Reporting-Host ] - [ Proxy-Info ] - * [ AVP ] - - RAR ::= < Diameter Header: 258, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Destination-Host } - { Auth-Application-Id } - { Re-Auth-Request-Type } - [ User-Name ] - [ Origin-State-Id ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - RAA ::= < Diameter Header: 258, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ User-Name ] - [ Origin-State-Id ] - [ Error-Message ] - [ Error-Reporting-Host ] - * [ Failed-AVP ] - * [ Redirect-Host ] - [ Redirect-Host-Usage ] - [ Redirect-Max-Cache-Time ] - * [ Proxy-Info ] - * [ AVP ] - - STR ::= < Diameter Header: 275, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Auth-Application-Id } - { Termination-Cause } - [ User-Name ] - [ Destination-Host ] - * [ Class ] - [ Origin-State-Id ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - STA ::= < Diameter Header: 275, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ User-Name ] - * [ Class ] - [ Error-Message ] - [ Error-Reporting-Host ] - * [ Failed-AVP ] - [ Origin-State-Id ] - * [ Redirect-Host ] - [ Redirect-Host-Usage ] - [ Redirect-Max-Cache-Time ] - * [ Proxy-Info ] - * [ AVP ] - - ASR ::= < Diameter Header: 274, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Destination-Host } - { Auth-Application-Id } - [ User-Name ] - [ Origin-State-Id ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - ASA ::= < Diameter Header: 274, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - [ User-Name ] - [ Origin-State-Id ] - [ Error-Message ] - [ Error-Reporting-Host ] - * [ Failed-AVP ] - * [ Redirect-Host ] - [ Redirect-Host-Usage ] - [ Redirect-Max-Cache-Time ] - * [ Proxy-Info ] - * [ AVP ] - - ACR ::= < Diameter Header: 271, REQ, PXY > - < Session-Id > - { Origin-Host } - { Origin-Realm } - { Destination-Realm } - { Accounting-Record-Type } - { Accounting-Record-Number } - [ Acct-Application-Id ] - [ Vendor-Specific-Application-Id ] - [ User-Name ] - [ Accounting-Sub-Session-Id ] - [ Acct-Session-Id ] - [ Acct-Multi-Session-Id ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ Route-Record ] - * [ AVP ] - - ACA ::= < Diameter Header: 271, PXY > - < Session-Id > - { Result-Code } - { Origin-Host } - { Origin-Realm } - { Accounting-Record-Type } - { Accounting-Record-Number } - [ Acct-Application-Id ] - [ Vendor-Specific-Application-Id ] - [ User-Name ] - [ Accounting-Sub-Session-Id ] - [ Acct-Session-Id ] - [ Acct-Multi-Session-Id ] - [ Error-Reporting-Host ] - [ Acct-Interim-Interval ] - [ Accounting-Realtime-Required ] - [ Origin-State-Id ] - [ Event-Timestamp ] - * [ Proxy-Info ] - * [ AVP ] - -@enum Disconnect-Cause - - REBOOTING 0 - BUSY 1 - DO_NOT_WANT_TO_TALK_TO_YOU 2 - -@enum Redirect-Host-Usage - - DONT_CACHE 0 - ALL_SESSION 1 - ALL_REALM 2 - REALM_AND_APPLICATION 3 - ALL_APPLICATION 4 - ALL_HOST 5 - ALL_USER 6 - -@enum Auth-Request-Type - - AUTHENTICATE_ONLY 1 - AUTHORIZE_ONLY 2 - AUTHORIZE_AUTHENTICATE 3 - -@enum Auth-Session-State - - STATE_MAINTAINED 0 - NO_STATE_MAINTAINED 1 - -@enum Re-Auth-Request-Type - - AUTHORIZE_ONLY 0 - AUTHORIZE_AUTHENTICATE 1 - -@enum Termination-Cause - - DIAMETER_LOGOUT 1 - DIAMETER_SERVICE_NOT_PROVIDED 2 - DIAMETER_BAD_ANSWER 3 - DIAMETER_ADMINISTRATIVE 4 - DIAMETER_LINK_BROKEN 5 - DIAMETER_AUTH_EXPIRED 6 - DIAMETER_USER_MOVED 7 - DIAMETER_SESSION_TIMEOUT 8 - -@enum Session-Server-Failover - - REFUSE_SERVICE 0 - TRY_AGAIN 1 - ALLOW_SERVICE 2 - TRY_AGAIN_ALLOW_SERVICE 3 - -@enum Accounting-Record-Type - - EVENT_RECORD 1 - START_RECORD 2 - INTERIM_RECORD 3 - STOP_RECORD 4 - -@enum Accounting-Realtime-Required - - DELIVER_AND_GRANT 1 - GRANT_AND_STORE 2 - GRANT_AND_LOSE 3 - -@define Result-Code - -;; 7.1.1. Informational - DIAMETER_MULTI_ROUND_AUTH 1001 - -;; 7.1.2. Success - DIAMETER_SUCCESS 2001 - DIAMETER_LIMITED_SUCCESS 2002 - -;; 7.1.3. Protocol Errors - DIAMETER_COMMAND_UNSUPPORTED 3001 - DIAMETER_UNABLE_TO_DELIVER 3002 - DIAMETER_REALM_NOT_SERVED 3003 - DIAMETER_TOO_BUSY 3004 - DIAMETER_LOOP_DETECTED 3005 - DIAMETER_REDIRECT_INDICATION 3006 - DIAMETER_APPLICATION_UNSUPPORTED 3007 - DIAMETER_INVALID_HDR_BITS 3008 - DIAMETER_INVALID_AVP_BITS 3009 - DIAMETER_UNKNOWN_PEER 3010 - -;; 7.1.4. Transient Failures - DIAMETER_AUTHENTICATION_REJECTED 4001 - DIAMETER_OUT_OF_SPACE 4002 - ELECTION_LOST 4003 - -;; 7.1.5. Permanent Failures - DIAMETER_AVP_UNSUPPORTED 5001 - DIAMETER_UNKNOWN_SESSION_ID 5002 - DIAMETER_AUTHORIZATION_REJECTED 5003 - DIAMETER_INVALID_AVP_VALUE 5004 - DIAMETER_MISSING_AVP 5005 - DIAMETER_RESOURCES_EXCEEDED 5006 - DIAMETER_CONTRADICTING_AVPS 5007 - DIAMETER_AVP_NOT_ALLOWED 5008 - DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009 - DIAMETER_NO_COMMON_APPLICATION 5010 - DIAMETER_UNSUPPORTED_VERSION 5011 - DIAMETER_UNABLE_TO_COMPLY 5012 - DIAMETER_INVALID_BIT_IN_HEADER 5013 - DIAMETER_INVALID_AVP_LENGTH 5014 - DIAMETER_INVALID_MESSAGE_LENGTH 5015 - DIAMETER_INVALID_AVP_BIT_COMBO 5016 - DIAMETER_NO_COMMON_SECURITY 5017 - -@grouped - - Proxy-Info ::= < AVP Header: 284 > - { Proxy-Host } - { Proxy-State } - * [ AVP ] - - Failed-AVP ::= < AVP Header: 279 > - 1* {AVP} - - Experimental-Result ::= < AVP Header: 297 > - { Vendor-Id } - { Experimental-Result-Code } - - Vendor-Specific-Application-Id ::= < AVP Header: 260 > - 1* { Vendor-Id } - [ Auth-Application-Id ] - [ Acct-Application-Id ] - -;; The E2E-Sequence AVP is defined in RFC 3588 as Grouped, but -;; there is no definition of the group - only an informal text stating -;; that there should be a nonce (an OctetString) and a counter -;; (integer) -;; - E2E-Sequence ::= - 2* { AVP } diff --git a/lib/diameter/src/app/diameter_gen_relay.dia b/lib/diameter/src/app/diameter_gen_relay.dia deleted file mode 100644 index d86446e368..0000000000 --- a/lib/diameter/src/app/diameter_gen_relay.dia +++ /dev/null @@ -1,24 +0,0 @@ -;; -;; %CopyrightBegin% -;; -;; Copyright Ericsson AB 2010-2011. All Rights Reserved. -;; -;; The contents of this file are subject to the Erlang Public License, -;; Version 1.1, (the "License"); you may not use this file except in -;; compliance with the License. You should have received a copy of the -;; Erlang Public License along with this software. If not, it can be -;; retrieved online at http://www.erlang.org/. -;; -;; Software distributed under the License is distributed on an "AS IS" -;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -;; the License for the specific language governing rights and limitations -;; under the License. -;; -;; %CopyrightEnd% -;; - -@id 0xFFFFFFFF -@prefix diameter_relay -@vendor 0 IETF - -@inherits diameter_gen_base_rfc3588 diff --git a/lib/diameter/src/app/modules.mk b/lib/diameter/src/app/modules.mk index c133e6f64e..ea4c58bfd7 100644 --- a/lib/diameter/src/app/modules.mk +++ b/lib/diameter/src/app/modules.mk @@ -17,10 +17,10 @@ # # %CopyrightEnd% -SPEC_FILES = \ - diameter_gen_base_rfc3588.dia \ - diameter_gen_base_accounting.dia \ - diameter_gen_relay.dia +DICTIONARIES = \ + base_rfc3588 \ + base_accounting \ + relay RUNTIME_MODULES = \ diameter \ diff --git a/lib/diameter/src/dict/base_accounting.dia b/lib/diameter/src/dict/base_accounting.dia new file mode 100644 index 0000000000..ced324078c --- /dev/null +++ b/lib/diameter/src/dict/base_accounting.dia @@ -0,0 +1,69 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2010-2011. All Rights Reserved. +;; +;; The contents of this file are subject to the Erlang Public License, +;; Version 1.1, (the "License"); you may not use this file except in +;; compliance with the License. You should have received a copy of the +;; Erlang Public License along with this software. If not, it can be +;; retrieved online at http://www.erlang.org/. +;; +;; Software distributed under the License is distributed on an "AS IS" +;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +;; the License for the specific language governing rights and limitations +;; under the License. +;; +;; %CopyrightEnd% +;; + +@id 3 +@name diameter_gen_base_accounting +@prefix diameter_base_accounting +@vendor 0 IETF + +@inherits diameter_gen_base_rfc3588 + +@messages + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Reporting-Host ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] diff --git a/lib/diameter/src/dict/base_rfc3588.dia b/lib/diameter/src/dict/base_rfc3588.dia new file mode 100644 index 0000000000..f7a0b717cd --- /dev/null +++ b/lib/diameter/src/dict/base_rfc3588.dia @@ -0,0 +1,414 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2010-2011. All Rights Reserved. +;; +;; The contents of this file are subject to the Erlang Public License, +;; Version 1.1, (the "License"); you may not use this file except in +;; compliance with the License. You should have received a copy of the +;; Erlang Public License along with this software. If not, it can be +;; retrieved online at http://www.erlang.org/. +;; +;; Software distributed under the License is distributed on an "AS IS" +;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +;; the License for the specific language governing rights and limitations +;; under the License. +;; +;; %CopyrightEnd% +;; + +@id 0 +@name diameter_gen_base_rfc3588 +@prefix diameter_base +@vendor 0 IETF + +@avp_types + + Acct-Interim-Interval 85 Unsigned32 M + Accounting-Realtime-Required 483 Enumerated M + Acct-Multi-Session-Id 50 UTF8String M + Accounting-Record-Number 485 Unsigned32 M + Accounting-Record-Type 480 Enumerated M + Acct-Session-Id 44 OctetString M + Accounting-Sub-Session-Id 287 Unsigned64 M + Acct-Application-Id 259 Unsigned32 M + Auth-Application-Id 258 Unsigned32 M + Auth-Request-Type 274 Enumerated M + Authorization-Lifetime 291 Unsigned32 M + Auth-Grace-Period 276 Unsigned32 M + Auth-Session-State 277 Enumerated M + Re-Auth-Request-Type 285 Enumerated M + Class 25 OctetString M + Destination-Host 293 DiamIdent M + Destination-Realm 283 DiamIdent M + Disconnect-Cause 273 Enumerated M + E2E-Sequence 300 Grouped M + Error-Message 281 UTF8String - + Error-Reporting-Host 294 DiamIdent - + Event-Timestamp 55 Time M + Experimental-Result 297 Grouped M + Experimental-Result-Code 298 Unsigned32 M + Failed-AVP 279 Grouped M + Firmware-Revision 267 Unsigned32 - + Host-IP-Address 257 Address M + Inband-Security-Id 299 Unsigned32 M + Multi-Round-Time-Out 272 Unsigned32 M + Origin-Host 264 DiamIdent M + Origin-Realm 296 DiamIdent M + Origin-State-Id 278 Unsigned32 M + Product-Name 269 UTF8String - + Proxy-Host 280 DiamIdent M + Proxy-Info 284 Grouped M + Proxy-State 33 OctetString M + Redirect-Host 292 DiamURI M + Redirect-Host-Usage 261 Enumerated M + Redirect-Max-Cache-Time 262 Unsigned32 M + Result-Code 268 Unsigned32 M + Route-Record 282 DiamIdent M + Session-Id 263 UTF8String M + Session-Timeout 27 Unsigned32 M + Session-Binding 270 Unsigned32 M + Session-Server-Failover 271 Enumerated M + Supported-Vendor-Id 265 Unsigned32 M + Termination-Cause 295 Enumerated M + User-Name 1 UTF8String M + Vendor-Id 266 Unsigned32 M + Vendor-Specific-Application-Id 260 Grouped M + +@messages + + CER ::= < Diameter Header: 257, REQ > + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + CEA ::= < Diameter Header: 257 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + [ Error-Message ] + * [ Failed-AVP ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + DPR ::= < Diameter Header: 282, REQ > + { Origin-Host } + { Origin-Realm } + { Disconnect-Cause } + + DPA ::= < Diameter Header: 282 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + * [ Failed-AVP ] + + DWR ::= < Diameter Header: 280, REQ > + { Origin-Host } + { Origin-Realm } + [ Origin-State-Id ] + + DWA ::= < Diameter Header: 280 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + * [ Failed-AVP ] + [ Origin-State-Id ] + + answer-message ::= < Diameter Header: code, ERR [PXY] > + 0*1 < Session-Id > + { Origin-Host } + { Origin-Realm } + { Result-Code } + [ Origin-State-Id ] + [ Error-Reporting-Host ] + [ Proxy-Info ] + * [ AVP ] + + RAR ::= < Diameter Header: 258, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + { Re-Auth-Request-Type } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + RAA ::= < Diameter Header: 258, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + STR ::= < Diameter Header: 275, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Auth-Application-Id } + { Termination-Cause } + [ User-Name ] + [ Destination-Host ] + * [ Class ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + STA ::= < Diameter Header: 275, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + * [ Class ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + [ Origin-State-Id ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ASR ::= < Diameter Header: 274, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ASA ::= < Diameter Header: 274, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Reporting-Host ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] + +@enum Disconnect-Cause + + REBOOTING 0 + BUSY 1 + DO_NOT_WANT_TO_TALK_TO_YOU 2 + +@enum Redirect-Host-Usage + + DONT_CACHE 0 + ALL_SESSION 1 + ALL_REALM 2 + REALM_AND_APPLICATION 3 + ALL_APPLICATION 4 + ALL_HOST 5 + ALL_USER 6 + +@enum Auth-Request-Type + + AUTHENTICATE_ONLY 1 + AUTHORIZE_ONLY 2 + AUTHORIZE_AUTHENTICATE 3 + +@enum Auth-Session-State + + STATE_MAINTAINED 0 + NO_STATE_MAINTAINED 1 + +@enum Re-Auth-Request-Type + + AUTHORIZE_ONLY 0 + AUTHORIZE_AUTHENTICATE 1 + +@enum Termination-Cause + + DIAMETER_LOGOUT 1 + DIAMETER_SERVICE_NOT_PROVIDED 2 + DIAMETER_BAD_ANSWER 3 + DIAMETER_ADMINISTRATIVE 4 + DIAMETER_LINK_BROKEN 5 + DIAMETER_AUTH_EXPIRED 6 + DIAMETER_USER_MOVED 7 + DIAMETER_SESSION_TIMEOUT 8 + +@enum Session-Server-Failover + + REFUSE_SERVICE 0 + TRY_AGAIN 1 + ALLOW_SERVICE 2 + TRY_AGAIN_ALLOW_SERVICE 3 + +@enum Accounting-Record-Type + + EVENT_RECORD 1 + START_RECORD 2 + INTERIM_RECORD 3 + STOP_RECORD 4 + +@enum Accounting-Realtime-Required + + DELIVER_AND_GRANT 1 + GRANT_AND_STORE 2 + GRANT_AND_LOSE 3 + +@define Result-Code + +;; 7.1.1. Informational + DIAMETER_MULTI_ROUND_AUTH 1001 + +;; 7.1.2. Success + DIAMETER_SUCCESS 2001 + DIAMETER_LIMITED_SUCCESS 2002 + +;; 7.1.3. Protocol Errors + DIAMETER_COMMAND_UNSUPPORTED 3001 + DIAMETER_UNABLE_TO_DELIVER 3002 + DIAMETER_REALM_NOT_SERVED 3003 + DIAMETER_TOO_BUSY 3004 + DIAMETER_LOOP_DETECTED 3005 + DIAMETER_REDIRECT_INDICATION 3006 + DIAMETER_APPLICATION_UNSUPPORTED 3007 + DIAMETER_INVALID_HDR_BITS 3008 + DIAMETER_INVALID_AVP_BITS 3009 + DIAMETER_UNKNOWN_PEER 3010 + +;; 7.1.4. Transient Failures + DIAMETER_AUTHENTICATION_REJECTED 4001 + DIAMETER_OUT_OF_SPACE 4002 + ELECTION_LOST 4003 + +;; 7.1.5. Permanent Failures + DIAMETER_AVP_UNSUPPORTED 5001 + DIAMETER_UNKNOWN_SESSION_ID 5002 + DIAMETER_AUTHORIZATION_REJECTED 5003 + DIAMETER_INVALID_AVP_VALUE 5004 + DIAMETER_MISSING_AVP 5005 + DIAMETER_RESOURCES_EXCEEDED 5006 + DIAMETER_CONTRADICTING_AVPS 5007 + DIAMETER_AVP_NOT_ALLOWED 5008 + DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009 + DIAMETER_NO_COMMON_APPLICATION 5010 + DIAMETER_UNSUPPORTED_VERSION 5011 + DIAMETER_UNABLE_TO_COMPLY 5012 + DIAMETER_INVALID_BIT_IN_HEADER 5013 + DIAMETER_INVALID_AVP_LENGTH 5014 + DIAMETER_INVALID_MESSAGE_LENGTH 5015 + DIAMETER_INVALID_AVP_BIT_COMBO 5016 + DIAMETER_NO_COMMON_SECURITY 5017 + +@grouped + + Proxy-Info ::= < AVP Header: 284 > + { Proxy-Host } + { Proxy-State } + * [ AVP ] + + Failed-AVP ::= < AVP Header: 279 > + 1* {AVP} + + Experimental-Result ::= < AVP Header: 297 > + { Vendor-Id } + { Experimental-Result-Code } + + Vendor-Specific-Application-Id ::= < AVP Header: 260 > + 1* { Vendor-Id } + [ Auth-Application-Id ] + [ Acct-Application-Id ] + +;; The E2E-Sequence AVP is defined in RFC 3588 as Grouped, but +;; there is no definition of the group - only an informal text stating +;; that there should be a nonce (an OctetString) and a counter +;; (integer) +;; + E2E-Sequence ::= + 2* { AVP } diff --git a/lib/diameter/src/dict/relay.dia b/lib/diameter/src/dict/relay.dia new file mode 100644 index 0000000000..c22293209b --- /dev/null +++ b/lib/diameter/src/dict/relay.dia @@ -0,0 +1,25 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2010-2011. All Rights Reserved. +;; +;; The contents of this file are subject to the Erlang Public License, +;; Version 1.1, (the "License"); you may not use this file except in +;; compliance with the License. You should have received a copy of the +;; Erlang Public License along with this software. If not, it can be +;; retrieved online at http://www.erlang.org/. +;; +;; Software distributed under the License is distributed on an "AS IS" +;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +;; the License for the specific language governing rights and limitations +;; under the License. +;; +;; %CopyrightEnd% +;; + +@id 0xFFFFFFFF +@name diameter_gen_relay +@prefix diameter_relay +@vendor 0 IETF + +@inherits diameter_gen_base_rfc3588 -- cgit v1.2.3 From d8ec8f4f35707581fa55f4e97fc8264b7adf0cab Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 12:19:14 +0200 Subject: Dependency fix Has to follow the release_targets include for make not to think that a misspelled dictionary is up to date just because the exprecs dependency is. --- lib/diameter/src/app/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile index 9042bff407..b2efc42a69 100644 --- a/lib/diameter/src/app/Makefile +++ b/lib/diameter/src/app/Makefile @@ -154,8 +154,6 @@ compiler: app: $(APP_TARGET) $(APPUP_TARGET) dict: $(DICT_ERL_FILES) -$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): $(EBIN)/diameter_exprecs.$(EMULATOR) - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -187,6 +185,8 @@ release_docs_spec: # Dependencies # ---------------------------------------------------- +$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): $(EBIN)/diameter_exprecs.$(EMULATOR) + diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ $(EBIN)/diameter_gen_base_rfc3588.beam -- cgit v1.2.3 From 1327c7c7d098a7593e5458bc5c06fd9459e73de3 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 10:01:22 +0200 Subject: Allow @name/@prefix to be set with diameterc --- lib/diameter/bin/diameterc | 28 ++++++++++++++++-------- lib/diameter/src/compiler/diameter_spec_util.erl | 19 +++++++++++----- 2 files changed, 33 insertions(+), 14 deletions(-) diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index e232cdb120..c4dbd0060f 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -33,19 +33,23 @@ usage() -> io:format( - "~w [options] file~n" + "~w [options] dict~n" "~n" " Compile a diameter dictionary file (.dia) to Erlang source (.erl)~n" " and/or header (.hrl) files.~n" "~n" " options:~n" - " -h = print this message~n" - " -v = verbose output~n" - " -o dir = set the output directory (default .)~n" - " -i dir = set an include directory for inherited beams~n" - " -E = no .erl output~n" - " -H = no .hrl output~n" - " -d = write intermediate files (.spec and .forms)~n", + "~n" + " --name name = set @name~n" + " --prefix prefix = set @prefix~n" + "~n" + " -h = print this message~n" + " -v = verbose output~n" + " -o dir = set the output directory (default .)~n" + " -i dir = set an include directory for inherited beams~n" + " -E = no .erl output~n" + " -H = no .hrl output~n" + " -d = write intermediate files (.spec and .forms)~n", [?MODULE]). main(Args) -> @@ -112,6 +116,12 @@ arg(["-i", Dir | Args], #argv{options = Opts} = A) -> true = dir_exists(Dir), arg(Args, A#argv{options = Opts ++ [{include, Dir}]}); +arg(["--name", Name | Args], #argv{options = Opts} = A) -> + arg(Args, A#argv{options = [{name, Name} | Opts]}); + +arg(["--prefix", Name | Args], #argv{options = Opts} = A) -> + arg(Args, A#argv{options = [{prefix, Name} | Opts]}); + arg(["-E" | Args], #argv{output = Output} = A) -> arg(Args, A#argv{output = lists:delete(erl, Output)}); @@ -123,7 +133,7 @@ arg(["-d" | Args], #argv{options = Opts, output = Output} = A) -> output = [spec | Output]}); arg([[$- = M, C, H | T] | Args], A) %% clustered options - when C /= $i, C /= $o -> + when C /= $i, C /= $o, C /= $- -> arg([[M,C], [M,H|T] | Args], A); arg([File], A) -> diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl index e9221ed00a..e62ba05427 100644 --- a/lib/diameter/src/compiler/diameter_spec_util.erl +++ b/lib/diameter/src/compiler/diameter_spec_util.erl @@ -34,19 +34,28 @@ %% %% Output: orddict() -parse(Path, Options) -> - put({?MODULE, verbose}, lists:member(verbose, Options)), +parse(Path, Opts) -> + put({?MODULE, verbose}, lists:member(verbose, Opts)), {ok, B} = file:read_file(Path), Chunks = chunk(B), - Spec = make_spec(Chunks), + Spec = reset(make_spec(Chunks), Opts, [name, prefix]), true = groups_defined(Spec), %% sanity checks true = customs_defined(Spec), %% - Full = import_enums(import_groups(import_avps(insert_codes(Spec), - Options))), + Full = import_enums(import_groups(import_avps(insert_codes(Spec), Opts))), true = enums_defined(Full), %% sanity checks true = v_flags_set(Spec), Full. +reset(Spec, Opts, Keys) -> + lists:foldl(fun(K,S) -> reset(lists:keyfind(K, 1, Opts), S) end, + Spec, + Keys). + +reset({Key, Str}, Spec) -> + orddict:store(Key, ?ATOM(Str), Spec); +reset(_, Spec) -> + Spec. + %% Optional reports when running verbosely. report(What, Data) -> report(get({?MODULE, verbose}), What, Data). -- cgit v1.2.3 From 7352ec2c7d3f52a44b8bc18642dadfdc160209a5 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 14:59:27 +0200 Subject: Allow @inherits to be set/cleared with diameterc This is to enable dictionaries compiled with --name/--prefix to be inherited using --inherits. --- lib/diameter/bin/diameterc | 8 ++++++-- lib/diameter/src/compiler/diameter_spec_util.erl | 18 ++++++++++++++---- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index c4dbd0060f..8e0eda10dd 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -40,8 +40,9 @@ usage() -> "~n" " options:~n" "~n" - " --name name = set @name~n" - " --prefix prefix = set @prefix~n" + " --name name = set @name~n" + " --prefix prefix = set @prefix~n" + " --inherits dict|- = set/clear @inherits~n" "~n" " -h = print this message~n" " -v = verbose output~n" @@ -122,6 +123,9 @@ arg(["--name", Name | Args], #argv{options = Opts} = A) -> arg(["--prefix", Name | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = [{prefix, Name} | Opts]}); +arg(["--inherits", Dict | Args], #argv{options = Opts} = A) -> + arg(Args, A#argv{options = Opts ++ [{inherits, Dict}]}); + arg(["-E" | Args], #argv{output = Output} = A) -> arg(Args, A#argv{output = lists:delete(erl, Output)}); diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl index e62ba05427..62536bf06d 100644 --- a/lib/diameter/src/compiler/diameter_spec_util.erl +++ b/lib/diameter/src/compiler/diameter_spec_util.erl @@ -38,7 +38,7 @@ parse(Path, Opts) -> put({?MODULE, verbose}, lists:member(verbose, Opts)), {ok, B} = file:read_file(Path), Chunks = chunk(B), - Spec = reset(make_spec(Chunks), Opts, [name, prefix]), + Spec = reset(make_spec(Chunks), Opts, [name, prefix, inherits]), true = groups_defined(Spec), %% sanity checks true = customs_defined(Spec), %% Full = import_enums(import_groups(import_avps(insert_codes(Spec), Opts))), @@ -47,12 +47,22 @@ parse(Path, Opts) -> Full. reset(Spec, Opts, Keys) -> - lists:foldl(fun(K,S) -> reset(lists:keyfind(K, 1, Opts), S) end, + lists:foldl(fun(K,S) -> + reset([{A,?ATOM(V)} || {A,V} <- Opts, A == K], S) + end, Spec, Keys). -reset({Key, Str}, Spec) -> - orddict:store(Key, ?ATOM(Str), Spec); +reset(L, Spec) + when is_list(L) -> + lists:foldl(fun reset/2, Spec, L); + +reset({inherits = Key, '-'}, Spec) -> + orddict:erase(Key, Spec); +reset({inherits = Key, Dict}, Spec) -> + orddict:append(Key, Dict, Spec); +reset({Key, Atom}, Spec) -> + orddict:store(Key, Atom, Spec); reset(_, Spec) -> Spec. -- cgit v1.2.3 From dcfb32c0a47a8e87cb475d7304bc5d7b407e5f0e Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 15:23:34 +0200 Subject: Don't require -i directory to exist --- lib/diameter/bin/diameterc | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index 8e0eda10dd..c0e83ea1a4 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -114,7 +114,6 @@ arg(["-o", Dir | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = [{outdir, Dir} | Opts]}); arg(["-i", Dir | Args], #argv{options = Opts} = A) -> - true = dir_exists(Dir), arg(Args, A#argv{options = Opts ++ [{include, Dir}]}); arg(["--name", Name | Args], #argv{options = Opts} = A) -> -- cgit v1.2.3 From fa5503c2faa47cfdeb006fe6a17b4aea6acef771 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 15:48:04 +0200 Subject: Update documentation --- lib/diameter/doc/src/diameter_compile.xml | 32 ++++++++++++++++++++++++++++--- 1 file changed, 29 insertions(+), 3 deletions(-) diff --git a/lib/diameter/doc/src/diameter_compile.xml b/lib/diameter/doc/src/diameter_compile.xml index 72bac30709..60e08d41da 100644 --- a/lib/diameter/doc/src/diameter_compile.xml +++ b/lib/diameter/doc/src/diameter_compile.xml @@ -64,9 +64,10 @@ Defaults to the current working directory.

Specifies a directory to add to the code path. -Typically used to point at beam files corresponding to dictionaries -included by the one being compiled (using the @includes directive): -inclusion is a beam dependency, not an erl/hrl dependency.

+Use to point at beam files corresponding to dictionaries +inherited by the one being compiled using @inherits or +--inherits. +Inheritance is a beam dependency, not an erl/hrl dependency.

Multiple -i options can be specified.

@@ -84,6 +85,31 @@ Supresses erl generation.

Supresses hrl generation.

 +]]> + +

+Set @name in the dictionary file. +Overrides any setting in the file itself.

+ + +]]> + +

+Set @prefix in the dictionary file. +Overrides any setting in the file itself.

+ + +]]> + +

+Append an @inherits to the dictionary file. +Specifying '-' as the dictionary has the effect of clearing +any previous inherits, effectively ignoring previous inherits.

+ +

+Multiple --inherits options can be specified.

+ + -- cgit v1.2.3 From a0fb3d0302a18420cb622c9e172ca71ffdaf6a73 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 17:04:38 +0200 Subject: Add diameter_make as compilation interface As a module-based alternative to the escript diameterc. --- lib/diameter/src/compiler/diameter_make.erl | 122 +++++++++------------------- lib/diameter/src/compiler/modules.mk | 3 +- lib/diameter/test/diameter_app_SUITE.erl | 1 + 3 files changed, 43 insertions(+), 83 deletions(-) diff --git a/lib/diameter/src/compiler/diameter_make.erl b/lib/diameter/src/compiler/diameter_make.erl index 4431b88c4d..5380ee56ca 100644 --- a/lib/diameter/src/compiler/diameter_make.erl +++ b/lib/diameter/src/compiler/diameter_make.erl @@ -18,103 +18,61 @@ %% %% -%% Driver for the encoder generator utility. +%% Module alternative to diameterc for dictionary compilation. +%% +%% Eg. 1> diameter_make:dict("mydict.dia"). +%% +%% $ erl -noshell \ +%% -boot start_clean \ +%% -s diameter_make dict mydict.dia \ +%% -s init stop %% -module(diameter_make). --export([spec/0, - hrl/0, - erl/0]). +-export([dict/1, + dict/2, + spec/1, + spec/2]). --spec spec() -> no_return(). --spec hrl() -> no_return(). --spec erl() -> no_return(). +-type opt() :: {outdir|include|name|prefix|inherits, string()} + | verbose + | debug. -spec() -> - make(spec). +%% dict/1-2 -hrl() -> - make(hrl). +-spec dict(string(), [opt()]) + -> ok. -erl() -> - make(erl). +dict(File, Opts) -> + make(File, + Opts, + spec(File, Opts), + [spec || _ <- [1], lists:member(debug, Opts)] ++ [erl, hrl]). -%% make/1 +dict(File) -> + dict(File, []). -make(Mode) -> - Args = init:get_plain_arguments(), - Opts = try options(Args) catch throw: help -> help(Mode) end, - Files = proplists:get_value(files, Opts, []), - lists:foreach(fun(F) -> from_file(F, Mode, Opts) end, Files), - halt(0). +%% spec/2 -%% from_file/3 - -from_file(F, Mode, Opts) -> - try to_spec(F, Mode, Opts) of - Spec -> - from_spec(F, Spec, Mode, Opts) - catch - error: Reason -> - io:format("==> ~p parse failure:~n~p~n", - [F, {Reason, erlang:get_stacktrace()}]), - halt(1) - end. +-spec spec(string(), [opt()]) + -> orddict:orddict(). -%% to_spec/2 +spec(File, Opts) -> + diameter_spec_util:parse(File, Opts). -%% Try to read the input as an already parsed file or else parse it. -to_spec(F, spec, Opts) -> - diameter_spec_util:parse(F, Opts); -to_spec(F, _, _) -> - {ok, [Spec]} = file:consult(F), - Spec. +spec(File) -> + spec(File, []). -%% from_spec/4 +%% =========================================================================== -from_spec(File, Spec, Mode, Opts) -> - try - diameter_codegen:from_spec(File, Spec, Opts, Mode) +make(_, _, _, []) -> + ok; +make(File, Opts, Spec, [Mode | Rest]) -> + try diameter_codegen:from_spec(File, Spec, Opts, Mode) of + ok -> + make(File, Opts, Spec, Rest) catch error: Reason -> - io:format("==> ~p codegen failure:~n~p~n~p~n", - [Mode, File, {Reason, erlang:get_stacktrace()}]), - halt(1) + {error, {Reason, Mode, erlang:get_stacktrace()}} end. - -%% options/1 - -options(["-v" | Rest]) -> - [verbose | options(Rest)]; - -options(["-o", Outdir | Rest]) -> - [{outdir, Outdir} | options(Rest)]; - -options(["-i", Incdir | Rest]) -> - [{include, Incdir} | options(Rest)]; - -options(["-h" | _]) -> - throw(help); - -options(["--" | Fs]) -> - [{files, Fs}]; - -options(["-" ++ _ = Opt | _]) -> - io:fwrite("==> unknown option: ~s~n", [Opt]), - throw(help); - -options(Fs) -> %% trailing arguments - options(["--" | Fs]). - -%% help/1 - -help(M) -> - io:fwrite("Usage: ~p ~p [Options] [--] File ...~n" - "Options:~n" - " -v verbose output~n" - " -h shows this help message~n" - " -o OutDir where to put the output files~n" - " -i IncludeDir where to search for beams to import~n", - [?MODULE, M]), - halt(1). diff --git a/lib/diameter/src/compiler/modules.mk b/lib/diameter/src/compiler/modules.mk index 17a311dacf..4b40e99a3e 100644 --- a/lib/diameter/src/compiler/modules.mk +++ b/lib/diameter/src/compiler/modules.mk @@ -20,7 +20,8 @@ MODULES = \ diameter_codegen \ diameter_spec_scan \ - diameter_spec_util + diameter_spec_util \ + diameter_make HRL_FILES = \ diameter_forms.hrl diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 15a98d4441..d5ecdea291 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -98,6 +98,7 @@ modules(Config) -> diameter_dbg, diameter_exprecs, diameter_info, + diameter_make, diameter_spec_scan, diameter_spec_util], {[], Help} = {Mods -- Installed, lists:sort(Installed -- Mods)}. -- cgit v1.2.3 From 270dd088e9e29ca8880ae7f0fd02bfe2b7a27d92 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 17:25:45 +0200 Subject: Move diameter_exprecs to compiler directory --- lib/diameter/src/app/Makefile | 2 - lib/diameter/src/app/diameter_exprecs.erl | 301 ------------------------- lib/diameter/src/app/modules.mk | 1 - lib/diameter/src/compiler/diameter_exprecs.erl | 301 +++++++++++++++++++++++++ lib/diameter/src/compiler/modules.mk | 1 + 5 files changed, 302 insertions(+), 304 deletions(-) delete mode 100644 lib/diameter/src/app/diameter_exprecs.erl create mode 100644 lib/diameter/src/compiler/diameter_exprecs.erl diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile index b2efc42a69..38af3cbe37 100644 --- a/lib/diameter/src/app/Makefile +++ b/lib/diameter/src/app/Makefile @@ -185,8 +185,6 @@ release_docs_spec: # Dependencies # ---------------------------------------------------- -$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): $(EBIN)/diameter_exprecs.$(EMULATOR) - diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ $(EBIN)/diameter_gen_base_rfc3588.beam diff --git a/lib/diameter/src/app/diameter_exprecs.erl b/lib/diameter/src/app/diameter_exprecs.erl deleted file mode 100644 index 5e120d6f44..0000000000 --- a/lib/diameter/src/app/diameter_exprecs.erl +++ /dev/null @@ -1,301 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Parse transform for generating record access functions -%% -%% This parse transform can be used to reduce compile-time -%% dependencies in large systems. -%% -%% In the old days, before records, Erlang programmers often wrote -%% access functions for tuple data. This was tedious and error-prone. -%% The record syntax made this easier, but since records were implemented -%% fully in the pre-processor, a nasty compile-time dependency was -%% introduced. -%% -%% This module automates the generation of access functions for -%% records. While this method cannot fully replace the utility of -%% pattern matching, it does allow a fair bit of functionality on -%% records without the need for compile-time dependencies. -%% -%% Whenever record definitions need to be exported from a module, -%% inserting a compiler attribute, -%% -%% export_records([RecName, ...]) -%% -%% causes this transform to lay out access functions for the exported -%% records: -%% -%% -module(foo) -%% -compile({parse_transform, diameter_exprecs}). -%% -%% -record(r, {a, b, c}). -%% -export_records([a]). -%% -%% -export(['#info-'/1, '#info-'/2, -%% '#new-'/1, '#new-'/2, -%% '#get-'/2, '#set-'/2, -%% '#new-a'/0, '#new-a'/1, -%% '#get-a'/2, '#set-a'/2, -%% '#info-a'/1]). -%% -%% '#info-'(RecName) -> -%% '#info-'(RecName, fields). -%% -%% '#info-'(r, Info) -> -%% '#info-r'(Info). -%% -%% '#new-'(r) -> #r{}. -%% '#new-'(r, Vals) -> '#new-r'(Vals) -%% -%% '#new-r'() -> #r{}. -%% '#new-r'(Vals) -> '#set-r'(Vals, #r{}). -%% -%% '#get-'(Attrs, #r{} = Rec) -> -%% '#get-r'(Attrs, Rec). -%% -%% '#get-r'(Attrs, Rec) when is_list(Attrs) -> -%% ['#get-r'(A, Rec) || A <- Attrs]; -%% '#get-r'(a, Rec) -> Rec#r.a; -%% '#get-r'(b, Rec) -> Rec#r.b; -%% '#get-r'(c, Rec) -> Rec#r.c. -%% -%% '#set-'(Vals, #r{} = Rec) -> -%% '#set-r'(Vals, Rec). -%% -%% '#set-r'(Vals, Rec) when is_list(Vals) -> -%% lists:foldl(fun '#set-r'/2, Rec, Vals); -%% '#set-r'({a,V}, Rec) -> Rec#r{a = V}; -%% '#set-r'({b,V}, Rec) -> Rec#r{b = V}; -%% '#set-r'({c,V}, Rec) -> Rec#r{c = V}. -%% -%% '#info-r'(fields) -> record_info(fields, r); -%% '#info-r'(size) -> record_info(size, r); -%% '#info-r'({index, a}) -> 1; -%% '#info-r'({index, b}) -> 2; -%% '#info-r'({index, c}) -> 3; -%% - --module(diameter_exprecs). - --export([parse_transform/2]). - -%% Form tag with line number. --define(F(T), T, ?LINE). -%% Yes, that's right. The replacement is to the first unmatched ')'. - --define(attribute, ?F(attribute)). --define(clause, ?F(clause)). --define(function, ?F(function)). --define(call, ?F(call)). --define('fun', ?F('fun')). --define(generate, ?F(generate)). --define(lc, ?F(lc)). --define(match, ?F(match)). --define(remote, ?F(remote)). --define(record, ?F(record)). --define(record_field, ?F(record_field)). --define(record_index, ?F(record_index)). --define(tuple, ?F(tuple)). - --define(ATOM(T), {atom, ?LINE, T}). --define(VAR(V), {var, ?LINE, V}). - --define(CALL(F,A), {?call, ?ATOM(F), A}). --define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). - -%% parse_transform/2 - -parse_transform(Forms, _Options) -> - Rs = [R || {attribute, _, record, R} <- Forms], - case lists:append([E || {attribute, _, export_records, E} <- Forms]) of - [] -> - Forms; - Es -> - {H,T} = lists:splitwith(fun is_head/1, Forms), - H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T - end. - -is_head(T) -> - not lists:member(element(1,T), [function, eof]). - -%% a_export/1 - -a_export(Exports) -> - {?attribute, export, [{fname(info), 1}, - {fname(info), 2}, - {fname(new), 1}, - {fname(new), 2}, - {fname(get), 2}, - {fname(set), 2} - | lists:flatmap(fun export/1, Exports)]}. - -export(Rname) -> - New = fname(new, Rname), - [{New, 0}, - {New, 1}, - {fname(get, Rname), 2}, - {fname(set, Rname), 2}, - {fname(info, Rname), 1}]. - -%% f_accessors/2 - -f_accessors(Es, Rs) -> - ['#info-/1'(), - '#info-/2'(Es), - '#new-/1'(Es), - '#new-/2'(Es), - '#get-/2'(Es), - '#set-/2'(Es) - | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)]. - -accessors(Rname, Fields) -> - ['#new-X/0'(Rname), - '#new-X/1'(Rname), - '#get-X/2'(Rname, Fields), - '#set-X/2'(Rname, Fields), - '#info-X/1'(Rname, Fields)]. - -fields(Rname, Recs) -> - {Rname, Fields} = lists:keyfind(Rname, 1, Recs), - lists:map(fun({record_field, _, {atom, _, N}}) -> N; - ({record_field, _, {atom, _, N}, _}) -> N - end, - Fields). - -fname_prefix(Op) -> - "#" ++ atom_to_list(Op) ++ "-". - -fname(Op) -> - list_to_atom(fname_prefix(Op)). - -fname(Op, Rname) -> - Prefix = fname_prefix(Op), - list_to_atom(Prefix ++ atom_to_list(Rname)). - -%% Generated functions. - -'#info-/1'() -> - Fname = fname(info), - {?function, Fname, 1, - [{?clause, [?VAR('RecName')], - [], - [?CALL(Fname, [?VAR('RecName'), ?ATOM(fields)])]}]}. - -'#info-/2'(Exports) -> - {?function, fname(info), 2, - lists:map(fun 'info-'/1, Exports)}. - -'info-'(R) -> - {?clause, [?ATOM(R), ?VAR('Info')], - [], - [?CALL(fname(info, R), [?VAR('Info')])]}. - -'#new-/1'(Exports) -> - {?function, fname(new), 1, - lists:map(fun 'new-'/1, Exports)}. - -'new-'(R) -> - {?clause, [?ATOM(R)], - [], - [{?record, R, []}]}. - -'#new-/2'(Exports) -> - {?function, fname(new), 2, - lists:map(fun 'new--'/1, Exports)}. - -'new--'(R) -> - {?clause, [?ATOM(R), ?VAR('Vals')], - [], - [?CALL(fname(new, R), [?VAR('Vals')])]}. - -'#get-/2'(Exports) -> - {?function, fname(get), 2, - lists:map(fun 'get-'/1, Exports)}. - -'get-'(R) -> - {?clause, [?VAR('Attrs'), - {?match, {?record, R, []}, ?VAR('Rec')}], - [], - [?CALL(fname(get, R), [?VAR('Attrs'), ?VAR('Rec')])]}. - -'#set-/2'(Exports) -> - {?function, fname(set), 2, - lists:map(fun 'set-'/1, Exports)}. - -'set-'(R) -> - {?clause, [?VAR('Vals'), {?match, {?record, R, []}, ?VAR('Rec')}], - [], - [?CALL(fname(set, R), [?VAR('Vals'), ?VAR('Rec')])]}. - -'#new-X/0'(Rname) -> - {?function, fname(new, Rname), 0, - [{?clause, [], - [], - [{?record, Rname, []}]}]}. - -'#new-X/1'(Rname) -> - {?function, fname(new, Rname), 1, - [{?clause, [?VAR('Vals')], - [], - [?CALL(fname(set, Rname), [?VAR('Vals'), {?record, Rname, []}])]}]}. - -'#set-X/2'(Rname, Fields) -> - {?function, fname(set, Rname), 2, - [{?clause, [?VAR('Vals'), ?VAR('Rec')], - [[?CALL(is_list, [?VAR('Vals')])]], - [?APPLY(lists, foldl, [{?'fun', {function, fname(set, Rname), 2}}, - ?VAR('Rec'), - ?VAR('Vals')])]} - | lists:map(fun(A) -> 'set-X'(Rname, A) end, Fields)]}. - -'set-X'(Rname, Attr) -> - {?clause, [{?tuple, [?ATOM(Attr), ?VAR('V')]}, ?VAR('Rec')], - [], - [{?record, ?VAR('Rec'), Rname, - [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}. - -'#get-X/2'(Rname, Fields) -> - FName = fname(get, Rname), - {?function, FName, 2, - [{?clause, [?VAR('Attrs'), ?VAR('Rec')], - [[?CALL(is_list, [?VAR('Attrs')])]], - [{?lc, ?CALL(FName, [?VAR('A'), ?VAR('Rec')]), - [{?generate, ?VAR('A'), ?VAR('Attrs')}]}]} - | lists:map(fun(A) -> 'get-X'(Rname, A) end, Fields)]}. - -'get-X'(Rname, Attr) -> - {?clause, [?ATOM(Attr), ?VAR('Rec')], - [], - [{?record_field, ?VAR('Rec'), Rname, ?ATOM(Attr)}]}. - -'#info-X/1'(Rname, Fields) -> - {?function, fname(info, Rname), 1, - [{?clause, [?ATOM(fields)], - [], - [?CALL(record_info, [?ATOM(fields), ?ATOM(Rname)])]}, - {?clause, [?ATOM(size)], - [], - [?CALL(record_info, [?ATOM(size), ?ATOM(Rname)])]} - | lists:map(fun(A) -> 'info-X'(Rname, A) end, Fields)]}. - -'info-X'(Rname, Attr) -> - {?clause, [{?tuple, [?ATOM(index), ?ATOM(Attr)]}], - [], - [{?record_index, Rname, ?ATOM(Attr)}]}. diff --git a/lib/diameter/src/app/modules.mk b/lib/diameter/src/app/modules.mk index ea4c58bfd7..2b602cd713 100644 --- a/lib/diameter/src/app/modules.mk +++ b/lib/diameter/src/app/modules.mk @@ -47,7 +47,6 @@ RUNTIME_MODULES = \ HELP_MODULES = \ diameter_callback \ - diameter_exprecs \ diameter_dbg \ diameter_info diff --git a/lib/diameter/src/compiler/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl new file mode 100644 index 0000000000..5e120d6f44 --- /dev/null +++ b/lib/diameter/src/compiler/diameter_exprecs.erl @@ -0,0 +1,301 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Parse transform for generating record access functions +%% +%% This parse transform can be used to reduce compile-time +%% dependencies in large systems. +%% +%% In the old days, before records, Erlang programmers often wrote +%% access functions for tuple data. This was tedious and error-prone. +%% The record syntax made this easier, but since records were implemented +%% fully in the pre-processor, a nasty compile-time dependency was +%% introduced. +%% +%% This module automates the generation of access functions for +%% records. While this method cannot fully replace the utility of +%% pattern matching, it does allow a fair bit of functionality on +%% records without the need for compile-time dependencies. +%% +%% Whenever record definitions need to be exported from a module, +%% inserting a compiler attribute, +%% +%% export_records([RecName, ...]) +%% +%% causes this transform to lay out access functions for the exported +%% records: +%% +%% -module(foo) +%% -compile({parse_transform, diameter_exprecs}). +%% +%% -record(r, {a, b, c}). +%% -export_records([a]). +%% +%% -export(['#info-'/1, '#info-'/2, +%% '#new-'/1, '#new-'/2, +%% '#get-'/2, '#set-'/2, +%% '#new-a'/0, '#new-a'/1, +%% '#get-a'/2, '#set-a'/2, +%% '#info-a'/1]). +%% +%% '#info-'(RecName) -> +%% '#info-'(RecName, fields). +%% +%% '#info-'(r, Info) -> +%% '#info-r'(Info). +%% +%% '#new-'(r) -> #r{}. +%% '#new-'(r, Vals) -> '#new-r'(Vals) +%% +%% '#new-r'() -> #r{}. +%% '#new-r'(Vals) -> '#set-r'(Vals, #r{}). +%% +%% '#get-'(Attrs, #r{} = Rec) -> +%% '#get-r'(Attrs, Rec). +%% +%% '#get-r'(Attrs, Rec) when is_list(Attrs) -> +%% ['#get-r'(A, Rec) || A <- Attrs]; +%% '#get-r'(a, Rec) -> Rec#r.a; +%% '#get-r'(b, Rec) -> Rec#r.b; +%% '#get-r'(c, Rec) -> Rec#r.c. +%% +%% '#set-'(Vals, #r{} = Rec) -> +%% '#set-r'(Vals, Rec). +%% +%% '#set-r'(Vals, Rec) when is_list(Vals) -> +%% lists:foldl(fun '#set-r'/2, Rec, Vals); +%% '#set-r'({a,V}, Rec) -> Rec#r{a = V}; +%% '#set-r'({b,V}, Rec) -> Rec#r{b = V}; +%% '#set-r'({c,V}, Rec) -> Rec#r{c = V}. +%% +%% '#info-r'(fields) -> record_info(fields, r); +%% '#info-r'(size) -> record_info(size, r); +%% '#info-r'({index, a}) -> 1; +%% '#info-r'({index, b}) -> 2; +%% '#info-r'({index, c}) -> 3; +%% + +-module(diameter_exprecs). + +-export([parse_transform/2]). + +%% Form tag with line number. +-define(F(T), T, ?LINE). +%% Yes, that's right. The replacement is to the first unmatched ')'. + +-define(attribute, ?F(attribute)). +-define(clause, ?F(clause)). +-define(function, ?F(function)). +-define(call, ?F(call)). +-define('fun', ?F('fun')). +-define(generate, ?F(generate)). +-define(lc, ?F(lc)). +-define(match, ?F(match)). +-define(remote, ?F(remote)). +-define(record, ?F(record)). +-define(record_field, ?F(record_field)). +-define(record_index, ?F(record_index)). +-define(tuple, ?F(tuple)). + +-define(ATOM(T), {atom, ?LINE, T}). +-define(VAR(V), {var, ?LINE, V}). + +-define(CALL(F,A), {?call, ?ATOM(F), A}). +-define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). + +%% parse_transform/2 + +parse_transform(Forms, _Options) -> + Rs = [R || {attribute, _, record, R} <- Forms], + case lists:append([E || {attribute, _, export_records, E} <- Forms]) of + [] -> + Forms; + Es -> + {H,T} = lists:splitwith(fun is_head/1, Forms), + H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T + end. + +is_head(T) -> + not lists:member(element(1,T), [function, eof]). + +%% a_export/1 + +a_export(Exports) -> + {?attribute, export, [{fname(info), 1}, + {fname(info), 2}, + {fname(new), 1}, + {fname(new), 2}, + {fname(get), 2}, + {fname(set), 2} + | lists:flatmap(fun export/1, Exports)]}. + +export(Rname) -> + New = fname(new, Rname), + [{New, 0}, + {New, 1}, + {fname(get, Rname), 2}, + {fname(set, Rname), 2}, + {fname(info, Rname), 1}]. + +%% f_accessors/2 + +f_accessors(Es, Rs) -> + ['#info-/1'(), + '#info-/2'(Es), + '#new-/1'(Es), + '#new-/2'(Es), + '#get-/2'(Es), + '#set-/2'(Es) + | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)]. + +accessors(Rname, Fields) -> + ['#new-X/0'(Rname), + '#new-X/1'(Rname), + '#get-X/2'(Rname, Fields), + '#set-X/2'(Rname, Fields), + '#info-X/1'(Rname, Fields)]. + +fields(Rname, Recs) -> + {Rname, Fields} = lists:keyfind(Rname, 1, Recs), + lists:map(fun({record_field, _, {atom, _, N}}) -> N; + ({record_field, _, {atom, _, N}, _}) -> N + end, + Fields). + +fname_prefix(Op) -> + "#" ++ atom_to_list(Op) ++ "-". + +fname(Op) -> + list_to_atom(fname_prefix(Op)). + +fname(Op, Rname) -> + Prefix = fname_prefix(Op), + list_to_atom(Prefix ++ atom_to_list(Rname)). + +%% Generated functions. + +'#info-/1'() -> + Fname = fname(info), + {?function, Fname, 1, + [{?clause, [?VAR('RecName')], + [], + [?CALL(Fname, [?VAR('RecName'), ?ATOM(fields)])]}]}. + +'#info-/2'(Exports) -> + {?function, fname(info), 2, + lists:map(fun 'info-'/1, Exports)}. + +'info-'(R) -> + {?clause, [?ATOM(R), ?VAR('Info')], + [], + [?CALL(fname(info, R), [?VAR('Info')])]}. + +'#new-/1'(Exports) -> + {?function, fname(new), 1, + lists:map(fun 'new-'/1, Exports)}. + +'new-'(R) -> + {?clause, [?ATOM(R)], + [], + [{?record, R, []}]}. + +'#new-/2'(Exports) -> + {?function, fname(new), 2, + lists:map(fun 'new--'/1, Exports)}. + +'new--'(R) -> + {?clause, [?ATOM(R), ?VAR('Vals')], + [], + [?CALL(fname(new, R), [?VAR('Vals')])]}. + +'#get-/2'(Exports) -> + {?function, fname(get), 2, + lists:map(fun 'get-'/1, Exports)}. + +'get-'(R) -> + {?clause, [?VAR('Attrs'), + {?match, {?record, R, []}, ?VAR('Rec')}], + [], + [?CALL(fname(get, R), [?VAR('Attrs'), ?VAR('Rec')])]}. + +'#set-/2'(Exports) -> + {?function, fname(set), 2, + lists:map(fun 'set-'/1, Exports)}. + +'set-'(R) -> + {?clause, [?VAR('Vals'), {?match, {?record, R, []}, ?VAR('Rec')}], + [], + [?CALL(fname(set, R), [?VAR('Vals'), ?VAR('Rec')])]}. + +'#new-X/0'(Rname) -> + {?function, fname(new, Rname), 0, + [{?clause, [], + [], + [{?record, Rname, []}]}]}. + +'#new-X/1'(Rname) -> + {?function, fname(new, Rname), 1, + [{?clause, [?VAR('Vals')], + [], + [?CALL(fname(set, Rname), [?VAR('Vals'), {?record, Rname, []}])]}]}. + +'#set-X/2'(Rname, Fields) -> + {?function, fname(set, Rname), 2, + [{?clause, [?VAR('Vals'), ?VAR('Rec')], + [[?CALL(is_list, [?VAR('Vals')])]], + [?APPLY(lists, foldl, [{?'fun', {function, fname(set, Rname), 2}}, + ?VAR('Rec'), + ?VAR('Vals')])]} + | lists:map(fun(A) -> 'set-X'(Rname, A) end, Fields)]}. + +'set-X'(Rname, Attr) -> + {?clause, [{?tuple, [?ATOM(Attr), ?VAR('V')]}, ?VAR('Rec')], + [], + [{?record, ?VAR('Rec'), Rname, + [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}. + +'#get-X/2'(Rname, Fields) -> + FName = fname(get, Rname), + {?function, FName, 2, + [{?clause, [?VAR('Attrs'), ?VAR('Rec')], + [[?CALL(is_list, [?VAR('Attrs')])]], + [{?lc, ?CALL(FName, [?VAR('A'), ?VAR('Rec')]), + [{?generate, ?VAR('A'), ?VAR('Attrs')}]}]} + | lists:map(fun(A) -> 'get-X'(Rname, A) end, Fields)]}. + +'get-X'(Rname, Attr) -> + {?clause, [?ATOM(Attr), ?VAR('Rec')], + [], + [{?record_field, ?VAR('Rec'), Rname, ?ATOM(Attr)}]}. + +'#info-X/1'(Rname, Fields) -> + {?function, fname(info, Rname), 1, + [{?clause, [?ATOM(fields)], + [], + [?CALL(record_info, [?ATOM(fields), ?ATOM(Rname)])]}, + {?clause, [?ATOM(size)], + [], + [?CALL(record_info, [?ATOM(size), ?ATOM(Rname)])]} + | lists:map(fun(A) -> 'info-X'(Rname, A) end, Fields)]}. + +'info-X'(Rname, Attr) -> + {?clause, [{?tuple, [?ATOM(index), ?ATOM(Attr)]}], + [], + [{?record_index, Rname, ?ATOM(Attr)}]}. diff --git a/lib/diameter/src/compiler/modules.mk b/lib/diameter/src/compiler/modules.mk index 4b40e99a3e..6fbc8fa8d4 100644 --- a/lib/diameter/src/compiler/modules.mk +++ b/lib/diameter/src/compiler/modules.mk @@ -19,6 +19,7 @@ MODULES = \ diameter_codegen \ + diameter_exprecs \ diameter_spec_scan \ diameter_spec_util \ diameter_make -- cgit v1.2.3 From f4c38ecd803451280d0021bcfa7f2ad25b96cbcd Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 17:41:28 +0200 Subject: Remove app dependency on compiler to avoid forced recompilation --- lib/diameter/src/app/Makefile | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile index 38af3cbe37..7752bb1798 100644 --- a/lib/diameter/src/app/Makefile +++ b/lib/diameter/src/app/Makefile @@ -148,6 +148,10 @@ $(APP_TARGET): $(APP_SRC) \ $(APPUP_TARGET): $(APPUP_SRC) ../../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ +# This isn't a dependency for $(DICT_ERL_FILES) $(DICT_HRL_FILES) +# since it would force recompilation: compiler must explicity be made +# first, which ../Makefile does. Should share a makefile for proper +# dependencies. (Aka, recursive make considered harmful.) compiler: $(MAKE) -C ../$@ @@ -188,8 +192,6 @@ release_docs_spec: diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ $(EBIN)/diameter_gen_base_rfc3588.beam -$(DICT_ERL_FILES) $(DICT_HRL_FILES): compiler - $(DICT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)): \ $(DIAMETER_TOP)/include/diameter.hrl \ $(DIAMETER_TOP)/include/diameter_gen.hrl -- cgit v1.2.3 From 14bf1dc855bbd973bb15578f418e37ab2d4f17fe Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 19:40:29 +0200 Subject: One makefile for src build instead of recursion Simpler, no duplication of similar makefiles and makes for better dependencies. (Aka, recursive make considered harmful.) --- lib/diameter/configure.in | 1 - lib/diameter/src/.gitignore | 2 + lib/diameter/src/Makefile | 224 +- lib/diameter/src/app/.gitignore | 6 - lib/diameter/src/app/Makefile | 215 -- lib/diameter/src/app/depend.sed | 31 - lib/diameter/src/app/diameter.app.src | 28 - lib/diameter/src/app/diameter.appup.src | 47 - lib/diameter/src/app/diameter.erl | 190 -- lib/diameter/src/app/diameter.mk.in | 47 - lib/diameter/src/app/diameter_app.erl | 36 - lib/diameter/src/app/diameter_callback.erl | 91 - lib/diameter/src/app/diameter_capx.erl | 405 ---- lib/diameter/src/app/diameter_codec.erl | 561 ----- lib/diameter/src/app/diameter_config.erl | 676 ------ lib/diameter/src/app/diameter_dbg.erl | 516 ---- lib/diameter/src/app/diameter_dict.erl | 153 -- lib/diameter/src/app/diameter_info.erl | 869 ------- lib/diameter/src/app/diameter_internal.hrl | 80 - lib/diameter/src/app/diameter_lib.erl | 272 --- lib/diameter/src/app/diameter_misc_sup.erl | 58 - lib/diameter/src/app/diameter_peer.erl | 225 -- lib/diameter/src/app/diameter_peer_fsm.erl | 777 ------ lib/diameter/src/app/diameter_peer_fsm_sup.erl | 63 - lib/diameter/src/app/diameter_reg.erl | 327 --- lib/diameter/src/app/diameter_service.erl | 2903 ----------------------- lib/diameter/src/app/diameter_service_sup.erl | 64 - lib/diameter/src/app/diameter_session.erl | 172 -- lib/diameter/src/app/diameter_stats.erl | 342 --- lib/diameter/src/app/diameter_sup.erl | 101 - lib/diameter/src/app/diameter_sync.erl | 550 ----- lib/diameter/src/app/diameter_types.erl | 537 ----- lib/diameter/src/app/diameter_types.hrl | 139 -- lib/diameter/src/app/diameter_watchdog.erl | 571 ----- lib/diameter/src/app/diameter_watchdog_sup.erl | 60 - lib/diameter/src/app/modules.mk | 69 - lib/diameter/src/base/diameter.app.src | 28 + lib/diameter/src/base/diameter.appup.src | 47 + lib/diameter/src/base/diameter.erl | 190 ++ lib/diameter/src/base/diameter_app.erl | 36 + lib/diameter/src/base/diameter_callback.erl | 91 + lib/diameter/src/base/diameter_capx.erl | 405 ++++ lib/diameter/src/base/diameter_codec.erl | 561 +++++ lib/diameter/src/base/diameter_config.erl | 676 ++++++ lib/diameter/src/base/diameter_dbg.erl | 516 ++++ lib/diameter/src/base/diameter_dict.erl | 153 ++ lib/diameter/src/base/diameter_info.erl | 869 +++++++ lib/diameter/src/base/diameter_internal.hrl | 80 + lib/diameter/src/base/diameter_lib.erl | 272 +++ lib/diameter/src/base/diameter_misc_sup.erl | 58 + lib/diameter/src/base/diameter_peer.erl | 225 ++ lib/diameter/src/base/diameter_peer_fsm.erl | 777 ++++++ lib/diameter/src/base/diameter_peer_fsm_sup.erl | 63 + lib/diameter/src/base/diameter_reg.erl | 327 +++ lib/diameter/src/base/diameter_service.erl | 2903 +++++++++++++++++++++++ lib/diameter/src/base/diameter_service_sup.erl | 64 + lib/diameter/src/base/diameter_session.erl | 172 ++ lib/diameter/src/base/diameter_stats.erl | 342 +++ lib/diameter/src/base/diameter_sup.erl | 101 + lib/diameter/src/base/diameter_sync.erl | 550 +++++ lib/diameter/src/base/diameter_types.erl | 537 +++++ lib/diameter/src/base/diameter_types.hrl | 139 ++ lib/diameter/src/base/diameter_watchdog.erl | 571 +++++ lib/diameter/src/base/diameter_watchdog_sup.erl | 60 + lib/diameter/src/compiler/.gitignore | 3 - lib/diameter/src/compiler/Makefile | 131 - lib/diameter/src/compiler/modules.mk | 29 - lib/diameter/src/depend.sed | 51 + lib/diameter/src/gen/.gitignore | 2 + lib/diameter/src/modules.mk | 93 + lib/diameter/src/subdirs.mk | 21 - lib/diameter/src/transport/.gitignore | 3 - lib/diameter/src/transport/Makefile | 141 -- lib/diameter/src/transport/modules.mk | 29 - lib/diameter/test/Makefile | 23 +- 75 files changed, 11185 insertions(+), 11562 deletions(-) create mode 100644 lib/diameter/src/.gitignore delete mode 100644 lib/diameter/src/app/.gitignore delete mode 100644 lib/diameter/src/app/Makefile delete mode 100644 lib/diameter/src/app/depend.sed delete mode 100644 lib/diameter/src/app/diameter.app.src delete mode 100644 lib/diameter/src/app/diameter.appup.src delete mode 100644 lib/diameter/src/app/diameter.erl delete mode 100644 lib/diameter/src/app/diameter.mk.in delete mode 100644 lib/diameter/src/app/diameter_app.erl delete mode 100644 lib/diameter/src/app/diameter_callback.erl delete mode 100644 lib/diameter/src/app/diameter_capx.erl delete mode 100644 lib/diameter/src/app/diameter_codec.erl delete mode 100644 lib/diameter/src/app/diameter_config.erl delete mode 100644 lib/diameter/src/app/diameter_dbg.erl delete mode 100644 lib/diameter/src/app/diameter_dict.erl delete mode 100644 lib/diameter/src/app/diameter_info.erl delete mode 100644 lib/diameter/src/app/diameter_internal.hrl delete mode 100644 lib/diameter/src/app/diameter_lib.erl delete mode 100644 lib/diameter/src/app/diameter_misc_sup.erl delete mode 100644 lib/diameter/src/app/diameter_peer.erl delete mode 100644 lib/diameter/src/app/diameter_peer_fsm.erl delete mode 100644 lib/diameter/src/app/diameter_peer_fsm_sup.erl delete mode 100644 lib/diameter/src/app/diameter_reg.erl delete mode 100644 lib/diameter/src/app/diameter_service.erl delete mode 100644 lib/diameter/src/app/diameter_service_sup.erl delete mode 100644 lib/diameter/src/app/diameter_session.erl delete mode 100644 lib/diameter/src/app/diameter_stats.erl delete mode 100644 lib/diameter/src/app/diameter_sup.erl delete mode 100644 lib/diameter/src/app/diameter_sync.erl delete mode 100644 lib/diameter/src/app/diameter_types.erl delete mode 100644 lib/diameter/src/app/diameter_types.hrl delete mode 100644 lib/diameter/src/app/diameter_watchdog.erl delete mode 100644 lib/diameter/src/app/diameter_watchdog_sup.erl delete mode 100644 lib/diameter/src/app/modules.mk create mode 100644 lib/diameter/src/base/diameter.app.src create mode 100644 lib/diameter/src/base/diameter.appup.src create mode 100644 lib/diameter/src/base/diameter.erl create mode 100644 lib/diameter/src/base/diameter_app.erl create mode 100644 lib/diameter/src/base/diameter_callback.erl create mode 100644 lib/diameter/src/base/diameter_capx.erl create mode 100644 lib/diameter/src/base/diameter_codec.erl create mode 100644 lib/diameter/src/base/diameter_config.erl create mode 100644 lib/diameter/src/base/diameter_dbg.erl create mode 100644 lib/diameter/src/base/diameter_dict.erl create mode 100644 lib/diameter/src/base/diameter_info.erl create mode 100644 lib/diameter/src/base/diameter_internal.hrl create mode 100644 lib/diameter/src/base/diameter_lib.erl create mode 100644 lib/diameter/src/base/diameter_misc_sup.erl create mode 100644 lib/diameter/src/base/diameter_peer.erl create mode 100644 lib/diameter/src/base/diameter_peer_fsm.erl create mode 100644 lib/diameter/src/base/diameter_peer_fsm_sup.erl create mode 100644 lib/diameter/src/base/diameter_reg.erl create mode 100644 lib/diameter/src/base/diameter_service.erl create mode 100644 lib/diameter/src/base/diameter_service_sup.erl create mode 100644 lib/diameter/src/base/diameter_session.erl create mode 100644 lib/diameter/src/base/diameter_stats.erl create mode 100644 lib/diameter/src/base/diameter_sup.erl create mode 100644 lib/diameter/src/base/diameter_sync.erl create mode 100644 lib/diameter/src/base/diameter_types.erl create mode 100644 lib/diameter/src/base/diameter_types.hrl create mode 100644 lib/diameter/src/base/diameter_watchdog.erl create mode 100644 lib/diameter/src/base/diameter_watchdog_sup.erl delete mode 100644 lib/diameter/src/compiler/.gitignore delete mode 100644 lib/diameter/src/compiler/Makefile delete mode 100644 lib/diameter/src/compiler/modules.mk create mode 100644 lib/diameter/src/depend.sed create mode 100644 lib/diameter/src/gen/.gitignore create mode 100644 lib/diameter/src/modules.mk delete mode 100644 lib/diameter/src/subdirs.mk delete mode 100644 lib/diameter/src/transport/.gitignore delete mode 100644 lib/diameter/src/transport/Makefile delete mode 100644 lib/diameter/src/transport/modules.mk diff --git a/lib/diameter/configure.in b/lib/diameter/configure.in index 9aca3859c5..8acfb28fed 100644 --- a/lib/diameter/configure.in +++ b/lib/diameter/configure.in @@ -132,7 +132,6 @@ dnl AC_OUTPUT( Makefile:Makefile.in - src/app/diameter.mk:src/app/diameter.mk.in make/$host/rules.mk:make/rules.mk.in ) diff --git a/lib/diameter/src/.gitignore b/lib/diameter/src/.gitignore new file mode 100644 index 0000000000..feeb378fd8 --- /dev/null +++ b/lib/diameter/src/.gitignore @@ -0,0 +1,2 @@ + +/depend.mk diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 6935eb053e..a72bf4420b 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -16,28 +16,228 @@ # # %CopyrightEnd% -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else +ifeq ($(ERL_TOP),) include $(DIAMETER_TOP)/make/target.mk include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk +else +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk endif # ---------------------------------------------------- -# Common Macros +# Application version +# ---------------------------------------------------- + +include ../vsn.mk + +VSN = $(DIAMETER_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- + +RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) + +# Where to put/find things. +EBIN = ../ebin +INCDIR = ../include + +# Where make should look for dependencies. +VPATH = .:base:compiler:transport:gen + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +include modules.mk + +DICT_FILES = $(RT_DICTS:%=dict/%.dia) +DICT_MODULES = $(RT_DICTS:%=gen/diameter_gen_%) +DICT_ERL_FILES = $(DICT_MODULES:%=%.erl) +DICT_HRL_FILES = $(DICT_MODULES:%=%.hrl) + +# Modules to build before compiling dictionaries. +COMPILER_MODULES = $(filter compiler/%, $(CT_MODULES)) + +# All handwritten modules. +MODULES = \ + $(RT_MODULES) \ + $(CT_MODULES) + +# Modules whose names are inserted into the app file. +APP_MODULES = \ + $(RT_MODULES) \ + $(DICT_MODULES) + +# Modules for which to build beams. +TARGET_MODULES = \ + $(APP_MODULES) \ + $(CT_MODULES) + +# What to build for the 'opt' target. +TARGET_FILES = \ + $(patsubst %,$(EBIN)/%.$(EMULATOR),$(notdir $(TARGET_MODULES))) \ + $(APP_TARGET) \ + $(APPUP_TARGET) + +# Subdirectories of src to release modules into. +TARGET_DIRS = $(sort $(dir $(TARGET_MODULES))) + +APP_FILE = diameter.app +APP_SRC = $(APP_FILE).src +APP_TARGET = $(EBIN)/$(APP_FILE) + +APPUP_FILE = diameter.appup +APPUP_SRC = $(APPUP_FILE).src +APPUP_TARGET = $(EBIN)/$(APPUP_FILE) + +EXAMPLE_FILES = $(EXAMPLES:%=../examples/%) +BIN_FILES = $(BINS:%=../bin/%) + +# ---------------------------------------------------- +# FLAGS # ---------------------------------------------------- -include subdirs.mk +ifeq ($(TYPE),debug) +ERL_COMPILE_FLAGS += -Ddebug +endif -SPECIAL_TARGETS = +ERL_COMPILE_FLAGS += \ + +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,$(APP_VSN)}' \ + +warn_unused_vars \ + -pa $(EBIN) \ + -I $(INCDIR) \ + -I gen # ---------------------------------------------------- -# Default Subdir Targets +# Targets # ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_subdir.mk + +debug: + @$(MAKE) TYPE=debug opt + +opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) $(DICT_ERL_FILES) $(DICT_HRL_FILES) + rm -f $(APP_TARGET) $(APPUP_TARGET) + rm -f errs core *~ gen/diameter_gen_*.forms gen/diameter_gen_*.spec + rm -f depend.mk + +docs: + +list = echo $(1):; echo $($(1)) | tr ' ' '\n' | sort | sed 's@^@ @' + +info: + @echo ======================================== + @$(call list,RT_DICTS) + @echo + @$(call list,RT_MODULES) + @echo + @$(call list,CT_MODULES) + @echo + @$(call list,TARGET_MODULES) + @echo + @$(call list,TARGET_DIRS) + @echo + @$(call list,EXTERNAL_HRL_FILES) + @echo + @$(call list,INTERNAL_HRL_FILES) + @echo + @$(call list,EXAMPLE_FILES) + @echo + @$(call list,BIN_FILES) + @echo ======================================== + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +# erl/hrl from dictionary file. +gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia + ../bin/diameterc -o gen -i $(EBIN) $< + +# Generate the app file. +$(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk + M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ + sed -e 's;%VSN%;$(VSN);' \ + -e "s;%MODULES%;$$M;" \ + $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +app: $(APP_TARGET) $(APPUP_TARGET) +dict: $(DICT_ERL_FILES) + +# Make the modules from a subdirectory. +$(TARGET_DIRS:%/=%): + $(MAKE) \ + $(patsubst $@/%,$(EBIN)/%.$(EMULATOR),$(filter $@/%,$(TARGET_MODULES))) + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- + +ifeq ($(ERL_TOP),) +include $(DIAMETER_TOP)/make/release_targets.mk else -include $(DIAMETER_TOP)/make/subdir.mk +include $(ERL_TOP)/make/otp_release_targets.mk endif -#include ../make/subdir.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/bin \ + $(RELSYSDIR)/ebin \ + $(RELSYSDIR)/src/dict \ + $(TARGET_DIRS:%=$(RELSYSDIR)/src/%) \ + $(RELSYSDIR)/include \ + $(RELSYSDIR)/examples + $(INSTALL_SCRIPT) $(BIN_FILES) $(RELSYSDIR)/bin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(DICT_FILES) $(RELSYSDIR)/src/dict + $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) \ + $(RELSYSDIR)/include + $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples + for dir in $(TARGET_DIRS); do \ + $(MAKE) release_subdir SRCDIR=$$dir; \ + done + +release_subdir: + [ -d "$(SRCDIR)" ] + $(INSTALL_DATA) $(filter $(SRCDIR)%,$(TARGET_MODULES:%=%.erl) \ + $(INTERNAL_HRL_FILES)) \ + $(RELSYSDIR)/src/$(SRCDIR) + +release_docs_spec: + +# ---------------------------------------------------- +# Dependencies +# ---------------------------------------------------- + +gen/diameter_gen_base_accounting.erl gen/diameter_gen_relay.erl \ +gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.hrl: \ + $(EBIN)/diameter_gen_base_rfc3588.$(EMULATOR) + +gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl: \ + $(COMPILER_MODULES:compiler/%=$(EBIN)/%.$(EMULATOR)) + +$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): \ + $(INCDIR)/diameter.hrl \ + $(INCDIR)/diameter_gen.hrl + +depend: depend.mk + +# Generate dependencies makefile. +depend.mk: depend.sed $(MODULES:%=%.erl) Makefile + (for f in $(MODULES); do \ + (echo $$f; cat $$f.erl) | sed -f $<; \ + done) \ + > $@ + +-include depend.mk + +.PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) +.PHONY: app clean depend dict info release_subdir +.PHONY: debug opt release_docs_spec release_spec +.PHONY: $(TARGET_DIRS:%/=%) diff --git a/lib/diameter/src/app/.gitignore b/lib/diameter/src/app/.gitignore deleted file mode 100644 index d388e61877..0000000000 --- a/lib/diameter/src/app/.gitignore +++ /dev/null @@ -1,6 +0,0 @@ - -/diameter_gen_*.erl -/diameter_gen_*.hrl -/depend.mk -/diameter.mk - diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile deleted file mode 100644 index 7752bb1798..0000000000 --- a/lib/diameter/src/app/Makefile +++ /dev/null @@ -1,215 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- - -include ../../vsn.mk - -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -DICT_FILES = $(DICTIONARIES:%=../dict/%.dia) -DICT_MODULES = $(DICTIONARIES:%=diameter_gen_%) -DICT_ERL_FILES = $(DICT_MODULES:%=%.erl) -DICT_HRL_FILES = $(DICT_MODULES:%=%.hrl) - -MODULES = \ - $(RUNTIME_MODULES) \ - $(HELP_MODULES) - -APP_MODULES = \ - $(RUNTIME_MODULES) \ - $(DICT_MODULES) - -TARGET_MODULES = \ - $(APP_MODULES) \ - $(HELP_MODULES) - -TARGET_FILES = \ - $(TARGET_MODULES:%=$(EBIN)/%.$(EMULATOR)) \ - $(APP_TARGET) \ - $(APPUP_TARGET) - -ESCRIPT_FILES = \ - ../../bin/diameterc - -APP_FILE = diameter.app -APP_SRC = $(APP_FILE).src -APP_TARGET = $(EBIN)/$(APP_FILE) - -APPUP_FILE = diameter.appup -APPUP_SRC = $(APPUP_FILE).src -APPUP_TARGET = $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @$(MAKE) TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) $(DICT_ERL_FILES) $(DICT_HRL_FILES) - rm -f $(APP_TARGET) $(APPUP_TARGET) - rm -f errs core *~ diameter_gen_*.forms diameter_gen_*.spec - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "DICTIONARIES = $(DICTIONARIES)" - @echo "MODULES = $(MODULES)" - @echo "" - @echo "EXTERNAL_HRL_FILES = $(EXTERNAL_HRL_FILES)" - @echo "INTERNAL_HRL_FILES = $(INTERNAL_HRL_FILES)" - @echo "" - @echo "EXAMPLE_FILES = $(EXAMPLE_FILES)" - @echo "" - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# erl/hrl from application spec -diameter_gen_%.erl diameter_gen_%.hrl: ../dict/%.dia - ../../bin/diameterc -i $(EBIN) $< - -# Generate the app file and then modules into in. This shouldn't know -# about ../transport but good enough for now. -$(APP_TARGET): $(APP_SRC) \ - ../../vsn.mk \ - modules.mk \ - ../transport/modules.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - M=`echo $(APP_MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ - echo "/%APP_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ - | ed -s $@ - $(MAKE) -C ../transport $(APP_TARGET) APP_TARGET=$(APP_TARGET) - -$(APPUP_TARGET): $(APPUP_SRC) ../../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -# This isn't a dependency for $(DICT_ERL_FILES) $(DICT_HRL_FILES) -# since it would force recompilation: compiler must explicity be made -# first, which ../Makefile does. Should share a makefile for proper -# dependencies. (Aka, recursive make considered harmful.) -compiler: - $(MAKE) -C ../$@ - -app: $(APP_TARGET) $(APPUP_TARGET) -dict: $(DICT_ERL_FILES) - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/bin - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src/app - $(INSTALL_DIR) $(RELSYSDIR)/src/dict - $(INSTALL_DIR) $(RELSYSDIR)/include - $(INSTALL_DIR) $(RELSYSDIR)/examples - $(INSTALL_SCRIPT) $(ESCRIPT_FILES) $(RELSYSDIR)/bin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(MODULES:%=%.erl) $(DICT_ERL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(DICT_FILES) $(RELSYSDIR)/src/dict - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) $(RELSYSDIR)/include - $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples - -release_docs_spec: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ - $(EBIN)/diameter_gen_base_rfc3588.beam - -$(DICT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)): \ - $(DIAMETER_TOP)/include/diameter.hrl \ - $(DIAMETER_TOP)/include/diameter_gen.hrl - -depend: depend.mk - -# Generate dependencies makefile. It's assumed that the compile target -# has already been made since it's currently not smart enough to not -# force a rebuild of those beams dependent on generated hrls, and this -# is a no-no at make release. -depend.mk: depend.sed $(MODULES:%=%.erl) Makefile - (for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done) \ - > $@ - --include depend.mk - -.PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) -.PHONY: app clean debug depend info opt compiler dict -.PHONY: release_spec release_docs_spec diff --git a/lib/diameter/src/app/depend.sed b/lib/diameter/src/app/depend.sed deleted file mode 100644 index 9df0133960..0000000000 --- a/lib/diameter/src/app/depend.sed +++ /dev/null @@ -1,31 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# - -# -# Extract include dependencies from .erl files. The output is massaged -# further in Makefile. -# - -/^-include/!d -/"diameter/!d - -s@^-include_lib("[^/]*@$(DIAMETER_TOP)@ -s@^-include("@@ -s@".*@@ -s@^@$(EBIN)/.$(EMULATOR): @ diff --git a/lib/diameter/src/app/diameter.app.src b/lib/diameter/src/app/diameter.app.src deleted file mode 100644 index a806b5c78a..0000000000 --- a/lib/diameter/src/app/diameter.app.src +++ /dev/null @@ -1,28 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -{application, diameter, - [{description, "Diameter protocol"}, - {vsn, "%VSN%"}, - {modules, [%APP_MODULES%,%TRANSPORT_MODULES%]}, - {registered, []}, - {applications, [stdlib, kernel]}, - {env, []}, - {mod, {diameter_app, []}} - ]}. diff --git a/lib/diameter/src/app/diameter.appup.src b/lib/diameter/src/app/diameter.appup.src deleted file mode 100644 index 6d8ceadb92..0000000000 --- a/lib/diameter/src/app/diameter.appup.src +++ /dev/null @@ -1,47 +0,0 @@ -%% This is an -*- erlang -*- file. -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -{"%VSN%", - [ - {"0.9", - [ - {load_module, diameter, soft_purge, soft_purge, []}, - {load_module, diameter_capx, soft_purge, soft_purge, []}, - {load_module, diameter_codec, soft_purge, soft_purge, [diameter_lib]}, - {load_module, diameter_lib, soft_purge, soft_purge, []}, - {load_module, diameter_types, soft_purge, soft_purge, []}, - {load_module, diameter_gen_base_accounting, soft_purge, soft_purge, []}, - {load_module, diameter_gen_base_rfc3588, soft_purge, soft_purge, []}, - {load_module, diameter_gen_relay, soft_purge, soft_purge, []}, - {update, diameter_service, soft, soft_purge, soft_purge, [diameter_lib]}, - {update, diameter_config, soft, soft_purge, soft_purge, []}, - {update, diameter_peer, soft, soft_purge, soft_purge, []}, - {update, diameter_peer_fsm, soft, soft_purge, soft_purge, [diameter_lib]}, - {update, diameter_reg, soft, soft_purge, soft_purge, []}, - {update, diameter_sctp, soft, soft_purge, soft_purge, []}, - {update, diameter_stats, soft, soft_purge, soft_purge, []}, - {update, diameter_sync, soft, soft_purge, soft_purge, []}, - {update, diameter_watchdog, soft, soft_purge, soft_purge, [diameter_lib]} - ] - } - ], - [ - ] -}. diff --git a/lib/diameter/src/app/diameter.erl b/lib/diameter/src/app/diameter.erl deleted file mode 100644 index 2f721421d8..0000000000 --- a/lib/diameter/src/app/diameter.erl +++ /dev/null @@ -1,190 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter). - -%% Configuration. --export([start_service/2, - stop_service/1, - add_transport/2, - remove_transport/2, - subscribe/1, - unsubscribe/1]). - -%% Traffic. --export([session_id/1, - origin_state_id/0, - call/3, - call/4]). - -%% Information. --export([services/0, - service_info/2]). - -%% Start/stop the application. In a "real" application this should -%% typically be a consequence of specifying diameter in a release file -%% rather than by calling start/stop explicitly. --export([start/0, - stop/0]). - --include("diameter_internal.hrl"). --include("diameter_types.hrl"). - -%%% -------------------------------------------------------------------------- -%%% start/0 -%%% -------------------------------------------------------------------------- - --spec start() - -> ok - | {error, term()}. - -start() -> - application:start(?APPLICATION). - -%%% -------------------------------------------------------------------------- -%%% stop/0 -%%% -------------------------------------------------------------------------- - --spec stop() - -> ok - | {error, term()}. - -stop() -> - application:stop(?APPLICATION). - -%%% -------------------------------------------------------------------------- -%%% start_service/2 -%%% -------------------------------------------------------------------------- - --spec start_service(service_name(), [service_opt()]) - -> ok - | {error, term()}. - -start_service(SvcName, Opts) - when is_list(Opts) -> - diameter_config:start_service(SvcName, Opts). - -%%% -------------------------------------------------------------------------- -%%% stop_service/1 -%%% -------------------------------------------------------------------------- - --spec stop_service(service_name()) - -> ok - | {error, term()}. - -stop_service(SvcName) -> - diameter_config:stop_service(SvcName). - -%%% -------------------------------------------------------------------------- -%%% services/0 -%%% -------------------------------------------------------------------------- - --spec services() - -> [service_name()]. - -services() -> - [Name || {Name, _} <- diameter_service:services()]. - -%%% -------------------------------------------------------------------------- -%%% service_info/2 -%%% -------------------------------------------------------------------------- - --spec service_info(service_name(), atom() | [atom()]) - -> any(). - -service_info(SvcName, Option) -> - diameter_service:info(SvcName, Option). - -%%% -------------------------------------------------------------------------- -%%% add_transport/3 -%%% -------------------------------------------------------------------------- - --spec add_transport(service_name(), {listen|connect, [transport_opt()]}) - -> {ok, transport_ref()} - | {error, term()}. - -add_transport(SvcName, {T, Opts} = Cfg) - when is_list(Opts), (T == connect orelse T == listen) -> - diameter_config:add_transport(SvcName, Cfg). - -%%% -------------------------------------------------------------------------- -%%% remove_transport/2 -%%% -------------------------------------------------------------------------- - --spec remove_transport(service_name(), transport_pred()) - -> ok | {error, term()}. - -remove_transport(SvcName, Pred) -> - diameter_config:remove_transport(SvcName, Pred). - -%%% -------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% -%%% Description: Subscribe to #diameter_event{} messages for the specified -%%% service. -%%% -------------------------------------------------------------------------- - --spec subscribe(service_name()) - -> true. - -subscribe(SvcName) -> - diameter_service:subscribe(SvcName). - -%%% -------------------------------------------------------------------------- -%%% # unsubscribe(SvcName) -%%% -------------------------------------------------------------------------- - --spec unsubscribe(service_name()) - -> true. - -unsubscribe(SvcName) -> - diameter_service:unsubscribe(SvcName). - -%%% ---------------------------------------------------------- -%%% # session_id/1 -%%% ---------------------------------------------------------- - --spec session_id('DiameterIdentity'()) - -> 'OctetString'(). - -session_id(Ident) -> - diameter_session:session_id(Ident). - -%%% ---------------------------------------------------------- -%%% # origin_state_id/0 -%%% ---------------------------------------------------------- - --spec origin_state_id() - -> 'Unsigned32'(). - -origin_state_id() -> - diameter_session:origin_state_id(). - -%%% -------------------------------------------------------------------------- -%%% # call/[34] -%%% -------------------------------------------------------------------------- - --spec call(service_name(), app_alias(), any(), [call_opt()]) - -> any(). - -call(SvcName, App, Message, Options) -> - diameter_service:call(SvcName, {alias, App}, Message, Options). - -call(SvcName, App, Message) -> - call(SvcName, App, Message, []). diff --git a/lib/diameter/src/app/diameter.mk.in b/lib/diameter/src/app/diameter.mk.in deleted file mode 100644 index c161064303..0000000000 --- a/lib/diameter/src/app/diameter.mk.in +++ /dev/null @@ -1,47 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% - -DIAMETER_TOP = @DIAMETER_TOP@ - -# ifneq ($(PREFIX),) -# ifeq ($(TESTROOT),) -# TESTROOT = $(PREFIX) -# endif -# endif - -ifeq ($(USE_DIAMETER_TEST_CODE), true) -ERL_COMPILE_FLAGS += -DDIAMETER_TEST_CODE=mona_lisa_spelar_doom -endif - -ifeq ($(USE_DIAMETER_HIPE), true) -ERL_COMPILE_FLAGS += +native -endif - -ifeq ($(WARN_UNUSED_WARS), true) -ERL_COMPILE_FLAGS += +warn_unused_vars -endif - -DIAMETER_APP_VSN_COMPILE_FLAGS = \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' - -DIAMETER_ERL_COMPILE_FLAGS += \ - -pa $(DIAMETER_TOP)/ebin \ - $(DIAMETER_APP_VSN_COMPILE_FLAGS) - diff --git a/lib/diameter/src/app/diameter_app.erl b/lib/diameter/src/app/diameter_app.erl deleted file mode 100644 index 600f7ff04d..0000000000 --- a/lib/diameter/src/app/diameter_app.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_app). - --behaviour(application). - -%% application callbacks --export([start/2, - stop/1]). - -%% start/2 - -start(_Type, _Args) -> - diameter_sup:start_link(). - -%% stop/1 - -stop(_) -> - ok. diff --git a/lib/diameter/src/app/diameter_callback.erl b/lib/diameter/src/app/diameter_callback.erl deleted file mode 100644 index 6d5c8cdca1..0000000000 --- a/lib/diameter/src/app/diameter_callback.erl +++ /dev/null @@ -1,91 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% A minimal application callback module. -%% - --module(diameter_callback). - --export([peer_up/3, - peer_down/3, - pick_peer/4, - prepare_request/3, - prepare_retransmit/3, - handle_request/3, - handle_answer/4, - handle_error/4]). - --include_lib("diameter/include/diameter.hrl"). - -%%% ---------------------------------------------------------- -%%% # peer_up/3 -%%% ---------------------------------------------------------- - -peer_up(_Svc, _Peer, State) -> - State. - -%%% ---------------------------------------------------------- -%%% # peer_down/3 -%%% ---------------------------------------------------------- - -peer_down(_SvcName, _Peer, State) -> - State. - -%%% ---------------------------------------------------------- -%%% # pick_peer/4 -%%% ---------------------------------------------------------- - -pick_peer([Peer|_], _, _SvcName, _State) -> - {ok, Peer}. - -%%% ---------------------------------------------------------- -%%% # prepare_request/3 -%%% ---------------------------------------------------------- - -prepare_request(Pkt, _SvcName, _Peer) -> - {send, Pkt}. - -%%% ---------------------------------------------------------- -%%% # prepare_retransmit/3 -%%% ---------------------------------------------------------- - -prepare_retransmit(Pkt, _SvcName, _Peer) -> - {send, Pkt}. - -%%% ---------------------------------------------------------- -%%% # handle_request/3 -%%% ---------------------------------------------------------- - -handle_request(_Pkt, _SvcName, _Peer) -> - {protocol_error, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED - -%%% ---------------------------------------------------------- -%%% # handle_answer/4 -%%% ---------------------------------------------------------- - -handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) -> - Ans. - -%%% --------------------------------------------------------------------------- -%%% # handle_error/4 -%%% --------------------------------------------------------------------------- - -handle_error(Reason, _Req, _SvcName, _Peer) -> - {error, Reason}. diff --git a/lib/diameter/src/app/diameter_capx.erl b/lib/diameter/src/app/diameter_capx.erl deleted file mode 100644 index 138e76411e..0000000000 --- a/lib/diameter/src/app/diameter_capx.erl +++ /dev/null @@ -1,405 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module builds CER and CEA records for use during capabilities -%% exchange. All of a CER/CEA is built from AVP values configured on -%% the service in question but values for Supported-Vendor-Id, -%% Vendor-Specific-Application-Id, Auth-Application-Id and -%% Acct-Application-id are also obtained using an older method that -%% remains only for backwards compatibility. With this method, each -%% dictionary module was required to export a cer/0 that returned a -%% diameter_base_CER record (or corresponding list, although the list -%% is also a later addition). Each returned CER contributes its member -%% values for the aforementioned four AVPs to the resulting CER, with -%% remaining AVP's either unspecified or identical to those configured -%% on the service. Auth-Application-Id and Acct-Application-id were -%% originally treated a little differently, each callback being -%% required to return either no value of the same value as the other -%% callbacks, but this coupled the callback modules unnecessarily. (A -%% union is backwards compatible to boot.) -%% -%% Values obtained from the service and callbacks are all included -%% when building a CER. Older code with only callback can continue to -%% use them, newer code should probably stick to service configuration -%% (since this is more explicit) or mix at their own peril. -%% -%% The cer/0 callback is now undocumented (despite never being fully -%% documented to begin with) and should be considered deprecated even -%% by those poor souls still using it. -%% - --module(diameter_capx). - --export([build_CER/1, - recv_CER/2, - recv_CEA/2, - make_caps/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). --include("diameter_gen_base_rfc3588.hrl"). - --define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). --define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION'). --define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). - --define(NO_INBAND_SECURITY, 0). --define(TLS, 1). - -%% =========================================================================== - --type tried(T) :: {ok, T} | {error, {term(), list()}}. - --spec build_CER(#diameter_caps{}) - -> tried(#diameter_base_CER{}). - -build_CER(Caps) -> - try_it([fun bCER/1, Caps]). - --spec recv_CER(#diameter_base_CER{}, #diameter_service{}) - -> tried({['Unsigned32'()], #diameter_caps{}, #diameter_base_CEA{}}). - -recv_CER(CER, Svc) -> - try_it([fun rCER/2, CER, Svc]). - --spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) - -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). - -recv_CEA(CEA, Svc) -> - try_it([fun rCEA/2, CEA, Svc]). - -make_caps(Caps, Opts) -> - try_it([fun mk_caps/2, Caps, Opts]). - -%% =========================================================================== -%% =========================================================================== - -try_it([Fun | Args]) -> - try apply(Fun, Args) of - T -> {ok, T} - catch - throw: ?FAILURE(Reason) -> {error, {Reason, Args}} - end. - -%% mk_caps/2 - -mk_caps(Caps0, Opts) -> - {Caps, _} = lists:foldl(fun set_cap/2, - {Caps0, #diameter_caps{_ = false}}, - Opts), - Caps. - --define(SC(K,F), - set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) -> - {Caps#diameter_caps{F = cap(K, Val)}, C#diameter_caps{F = true}}). - -?SC('Origin-Host', origin_host); -?SC('Origin-Realm', origin_realm); -?SC('Host-IP-Address', host_ip_address); -?SC('Vendor-Id', vendor_id); -?SC('Product-Name', product_name); -?SC('Origin-State-Id', origin_state_id); -?SC('Supported-Vendor-Id', supported_vendor_id); -?SC('Auth-Application-Id', auth_application_id); -?SC('Inband-Security-Id', inband_security_id); -?SC('Acct-Application-Id', acct_application_id); -?SC('Vendor-Specific-Application-Id', vendor_specific_application_id); -?SC('Firmware-Revision', firmware_revision); - -set_cap({Key, _}, _) -> - ?THROW({duplicate, Key}). - -cap(K, V) - when K == 'Origin-Host'; - K == 'Origin-Realm'; - K == 'Vendor-Id'; - K == 'Product-Name' -> - V; - -cap('Host-IP-Address', Vs) - when is_list(Vs) -> - lists:map(fun ipaddr/1, Vs); - -cap('Firmware-Revision', V) -> - [V]; - -cap(_, Vs) - when is_list(Vs) -> - Vs; - -cap(K, V) -> - ?THROW({invalid, K, V}). - -ipaddr(A) -> - try - diameter_lib:ipaddr(A) - catch - error: {invalid_address, _} = T -> - ?THROW(T) - end. - -%% bCER/1 -%% -%% Build a CER record to send to a remote peer. - -%% Use the fact that diameter_caps has the same field names as CER. -bCER(#diameter_caps{} = Rec) -> - #diameter_base_CER{} - = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). - -%% rCER/2 -%% -%% Build a CEA record to send to a remote peer in response to an -%% incoming CER. RFC 3588 gives no guidance on what should be sent -%% here: should we advertise applications that the peer hasn't sent in -%% its CER (aside from the relay application) or not? If we send -%% applications that the peer hasn't advertised then the peer may have -%% to be aware of the possibility. If we don't then we just look like -%% a server that supports a subset (possibly) of what the client -%% advertised, so this feels like the path of least incompatibility. -%% However, the current draft standard (draft-ietf-dime-rfc3588bis-26, -%% expires 24 July 2011) says this in section 5.3, Capabilities -%% Exchange: -%% -%% The receiver of the Capabilities-Exchange-Request (CER) MUST -%% determine common applications by computing the intersection of its -%% own set of supported Application Id against all of the application -%% identifier AVPs (Auth-Application-Id, Acct-Application-Id and Vendor- -%% Specific-Application-Id) present in the CER. The value of the -%% Vendor-Id AVP in the Vendor-Specific-Application-Id MUST NOT be used -%% during computation. The sender of the Capabilities-Exchange-Answer -%% (CEA) SHOULD include all of its supported applications as a hint to -%% the receiver regarding all of its application capabilities. -%% -%% Both RFC and the draft also say this: -%% -%% The receiver only issues commands to its peers that have advertised -%% support for the Diameter application that defines the command. A -%% Diameter node MUST cache the supported applications in order to -%% ensure that unrecognized commands and/or AVPs are not unnecessarily -%% sent to a peer. -%% -%% That is, each side sends all of its capabilities and is responsible for -%% not sending commands that the peer doesn't support. - -%% 6.10. Inband-Security-Id AVP -%% -%% NO_INBAND_SECURITY 0 -%% This peer does not support TLS. This is the default value, if the -%% AVP is omitted. -%% -%% TLS 1 -%% This node supports TLS security, as defined by [TLS]. - -rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> - #diameter_base_CEA{} - = CEA - = cea_from_cer(bCER(LCaps)), - - RCaps = capx_to_caps(CER), - SApps = common_applications(LCaps, RCaps, Svc), - - {SApps, - RCaps, - build_CEA(SApps, - LCaps, - RCaps, - CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. - -%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION -%% in the CEA and SHOULD disconnect the transport. However, we have -%% no way to guarantee the send before disconnecting. - -build_CEA([], _, _, CEA) -> - CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; - -build_CEA(_, LCaps, RCaps, CEA) -> - case common_security(LCaps, RCaps) of - [] -> - CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; - [_] = IS -> - CEA#diameter_base_CEA{'Inband-Security-Id' = IS} - end. - -%% common_security/2 - -common_security(#diameter_caps{inband_security_id = LS}, - #diameter_caps{inband_security_id = RS}) -> - cs(LS, RS). - -%% Unspecified is equivalent to NO_INBAND_SECURITY. -cs([], RS) -> - cs([?NO_INBAND_SECURITY], RS); -cs(LS, []) -> - cs(LS, [?NO_INBAND_SECURITY]); - -%% Agree on TLS if both parties support it. When sending CEA, this is -%% to ensure the peer is clear that we will be expecting a TLS -%% handshake since there is no ssl:maybe_accept that would allow the -%% peer to choose between TLS or not upon reception of our CEA. When -%% receiving CEA it deals with a server that isn't explicit about its choice. -%% TODO: Make the choice configurable. -cs(LS, RS) -> - Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS), - ordsets:from_list(RS))), - case lists:member(?TLS, Is) of - true -> - [?TLS]; - false when [] == Is -> - Is; - false -> - [hd(Is)] %% probably NO_INBAND_SECURITY - end. -%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and -%% TLS but don't enforce this. In theory this allows some other -%% security mechanism we don't have to know about, although in -%% practice something there may be a need for more synchronization -%% than notification by way of an event subscription offers. - -%% cea_from_cer/1 - -%% CER is a subset of CEA, the latter adding Result-Code and a few -%% more AVP's. -cea_from_cer(#diameter_base_CER{} = CER) -> - lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, - #diameter_base_CEA{}, - record_info(fields, diameter_base_CER)). - -to_cea(CER, Field, CEA) -> - try ?BASE:'#get-'(Field, CER) of - V -> ?BASE:'#set-'({Field, V}, CEA) - catch - error: _ -> CEA - end. - -%% rCEA/2 - -rCEA(#diameter_base_CEA{'Result-Code' = RC} - = CEA, - #diameter_service{capabilities = LCaps} - = Svc) -> - RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), - - RCaps = capx_to_caps(CEA), - SApps = common_applications(LCaps, RCaps, Svc), - - [] == SApps andalso ?THROW(no_common_applications), - - IS = common_security(LCaps, RCaps), - - [] == IS andalso ?THROW(no_common_security), - - {SApps, IS, RCaps}; - -rCEA(CEA, _Svc) -> - ?THROW({invalid, CEA}). - -%% capx_to_caps/1 - -capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Host-IP-Address' = IP, - 'Vendor-Id' = VId, - 'Product-Name' = PN, - 'Origin-State-Id' = OSI, - 'Supported-Vendor-Id' = SV, - 'Auth-Application-Id' = Auth, - 'Inband-Security-Id' = IS, - 'Acct-Application-Id' = Acct, - 'Vendor-Specific-Application-Id' = VSA, - 'Firmware-Revision' = FR, - 'AVP' = X}) -> - #diameter_caps{origin_host = OH, - origin_realm = OR, - vendor_id = VId, - product_name = PN, - origin_state_id = OSI, - host_ip_address = IP, - supported_vendor_id = SV, - auth_application_id = Auth, - inband_security_id = IS, - acct_application_id = Acct, - vendor_specific_application_id = VSA, - firmware_revision = FR, - avp = X}; - -capx_to_caps(#diameter_base_CER{} = CER) -> - capx_to_caps(cea_from_cer(CER)). - -%% --------------------------------------------------------------------------- -%% --------------------------------------------------------------------------- - -%% common_applications/3 -%% -%% Identify the (local) applications to be supported on the connection -%% in question. - -common_applications(LCaps, RCaps, #diameter_service{applications = Apps}) -> - LA = app_union(LCaps), - RA = app_union(RCaps), - - lists:foldl(fun(I,A) -> ca(I, Apps, RA, A) end, [], LA). - -ca(Id, Apps, RA, Acc) -> - Relay = lists:member(?APP_ID_RELAY, RA), - #diameter_app{alias = Alias} = find_app(Id, Apps), - tcons(Relay %% peer is a relay - orelse ?APP_ID_RELAY == Id %% we're a relay - orelse lists:member(Id, RA), %% app is supported by the peer - Id, - Alias, - Acc). -%% 5.3 of the RFC states that a peer advertising itself as a relay must -%% be interpreted as having common applications. - -%% Extract the list of all application identifiers from Auth-Application-Id, -%% Acct-Application-Id and Vendor-Specific-Application-Id. -app_union(#diameter_caps{auth_application_id = U, - acct_application_id = C, - vendor_specific_application_id = V}) -> - set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)). - -vsa_apps(#'diameter_base_Vendor-Specific-Application-Id' - {'Auth-Application-Id' = U, - 'Acct-Application-Id' = C}) -> - U ++ C; -vsa_apps(L) -> - Rec = ?BASE:'#new-'('diameter_base_Vendor-Specific-Application-Id', L), - vsa_apps(Rec). - -%% It's a configuration error for a locally advertised application not -%% to be represented in Apps. Don't just match on lists:keyfind/3 in -%% order to generate a more helpful error. -find_app(Id, Apps) -> - case lists:keyfind(Id, #diameter_app.id, Apps) of - #diameter_app{} = A -> - A; - false -> - ?THROW({app_not_configured, Id}) - end. - -set_list(L) -> - sets:to_list(sets:from_list(L)). - -tcons(true, K, V, Acc) -> - [{K,V} | Acc]; -tcons(false, _, _, Acc) -> - Acc. diff --git a/lib/diameter/src/app/diameter_codec.erl b/lib/diameter/src/app/diameter_codec.erl deleted file mode 100644 index d88f42fb7c..0000000000 --- a/lib/diameter/src/app/diameter_codec.erl +++ /dev/null @@ -1,561 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_codec). - --export([encode/2, - decode/2, - decode/3, - collect_avps/1, - decode_header/1, - sequence_numbers/1, - hop_by_hop_id/2, - msg_name/1, - msg_id/1]). - -%% Towards generated encoders (from diameter_gen.hrl). --export([pack_avp/1, - pack_avp/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(MASK(N,I), ((I) band (1 bsl (N)))). - -%% 0 1 2 3 -%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Version | Message Length | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | command flags | Command-Code | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Application-ID | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Hop-by-Hop Identifier | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | End-to-End Identifier | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | AVPs ... -%% +-+-+-+-+-+-+-+-+-+-+-+-+- - -%%% --------------------------------------------------------------------------- -%%% # encode/[2-4] -%%% --------------------------------------------------------------------------- - -encode(Mod, #diameter_packet{} = Pkt) -> - try - e(Mod, Pkt) - catch - error: Reason -> - %% Be verbose rather than letting the emulator truncate the - %% error report. - X = {Reason, ?STACK}, - diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}), - exit(X) - end; - -encode(Mod, Msg) -> - Seq = diameter_session:sequence(), - Hdr = #diameter_header{version = ?DIAMETER_VERSION, - end_to_end_id = Seq, - hop_by_hop_id = Seq}, - encode(Mod, #diameter_packet{header = Hdr, - msg = Msg}). - -e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> - Avps = encode_avps(As), - Length = size(Avps) + 20, - - #diameter_header{version = Vsn, - cmd_code = Code, - application_id = Aid, - hop_by_hop_id = Hid, - end_to_end_id = Eid} - = Hdr, - - Flags = make_flags(0, Hdr), - - Pkt#diameter_packet{bin = <>}; - -e(Mod0, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> - #diameter_header{version = Vsn, - hop_by_hop_id = Hid, - end_to_end_id = Eid} - = Hdr, - - {Mod, MsgName} = rec2msg(Mod0, Msg), - {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), - Flags = make_flags(Flags0, Hdr), - - Avps = encode_avps(Mod, MsgName, values(Msg)), - Length = size(Avps) + 20, - - Pkt#diameter_packet{header = Hdr#diameter_header - {length = Length, - cmd_code = Code, - application_id = Aid, - is_request = 0 /= ?MASK(7, Flags), - is_proxiable = 0 /= ?MASK(6, Flags), - is_error = 0 /= ?MASK(5, Flags), - is_retransmitted = 0 /= ?MASK(4, Flags)}, - bin = <>}. - -%% make_flags/2 - -make_flags(Flags0, #diameter_header{is_request = R, - is_proxiable = P, - is_error = E, - is_retransmitted = T}) -> - {Flags, 3} = lists:foldl(fun(B,{F,N}) -> {mf(B,F,N), N-1} end, - {Flags0, 7}, - [R,P,E,T]), - Flags. - -mf(undefined, F, _) -> - F; -mf(B, F, N) -> %% reset the affected bit - (F bxor (F band (1 bsl N))) bor bit(B, N). - -bit(true, N) -> 1 bsl N; -bit(false, _) -> 0. - -%% values/1 - -values([H|T]) - when is_atom(H) -> - T; -values(Avps) -> - Avps. - -%% encode_avps/3 - -%% Specifying values as a #diameter_avp list bypasses arity and other -%% checks: the values are expected to be already encoded and the AVP's -%% presented are simply sent. This is needed for relay agents, since -%% these have to be able to resend whatever comes. - -%% Message as a list of #diameter_avp{} ... -encode_avps(_, _, [#diameter_avp{} | _] = Avps) -> - encode_avps(reorder(Avps, [], Avps)); - -%% ... or as a tuple list or record. -encode_avps(Mod, MsgName, Values) -> - Mod:encode_avps(MsgName, Values). - -%% reorder/1 - -reorder([#diameter_avp{index = 0} | _] = Avps, Acc, _) -> - Avps ++ Acc; - -reorder([#diameter_avp{index = N} = A | Avps], Acc, _) - when is_integer(N) -> - lists:reverse(Avps, [A | Acc]); - -reorder([H | T], Acc, Avps) -> - reorder(T, [H | Acc], Avps); - -reorder([], Acc, _) -> - Acc. - -%% encode_avps/1 - -encode_avps(Avps) -> - list_to_binary(lists:map(fun pack_avp/1, Avps)). - -%% msg_header/3 - -msg_header(Mod, MsgName, Header) -> - {Code, Flags, ApplId} = h(Mod, MsgName, Header), - {Code, p(Flags, Header), ApplId}. - -%% 6.2 of 3588 requires the same 'P' bit on an answer as on the -%% request. - -p(Flags, #diameter_header{is_request = true, - is_proxiable = P}) -> - Flags band (2#10110000 bor choose(P, 2#01000000, 0)); -p(Flags, _) -> - Flags. - -h(Mod, 'answer-message' = MsgName, Header) -> - ?BASE = Mod, - #diameter_header{cmd_code = Code} = Header, - {_, Flags, ApplId} = ?BASE:msg_header(MsgName), - {Code, Flags, ApplId}; - -h(Mod, MsgName, _) -> - Mod:msg_header(MsgName). - -%% rec2msg/2 - -rec2msg(_, ['answer-message' = M | _]) -> - {?BASE, M}; - -rec2msg(Mod, [MsgName|_]) - when is_atom(MsgName) -> - {Mod, MsgName}; - -rec2msg(Mod, Rec) -> - R = element(1, Rec), - A = 'answer-message', - case ?BASE:msg2rec(A) of - R -> - {?BASE, A}; - _ -> - {Mod, Mod:rec2msg(R)} - end. - -%%% --------------------------------------------------------------------------- -%%% # decode/2 -%%% --------------------------------------------------------------------------- - -%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. - -decode(Mod, Pkt) -> - decode(Mod:id(), Mod, Pkt). - -%% If we're a relay application then just extract the avp's without -%% any decoding of their data since we don't know the application in -%% question. -decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> - case collect_avps(Pkt) of - {Bs, As} -> - Pkt#diameter_packet{avps = As, - errors = [Bs]}; - As -> - Pkt#diameter_packet{avps = As} - end; - -%% Otherwise decode using the dictionary. -decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) - when is_atom(Mod) -> - #diameter_header{cmd_code = CmdCode, - is_request = IsRequest, - is_error = IsError} - = Hdr, - - {M, MsgName} = if IsError andalso not IsRequest -> - {?BASE, 'answer-message'}; - true -> - {Mod, Mod:msg_name(CmdCode, IsRequest)} - end, - - decode_avps(MsgName, M, Pkt, collect_avps(Pkt)); - -decode(Id, Mod, Bin) - when is_bitstring(Bin) -> - decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). - -decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ... - ?LOG(invalid, Pkt#diameter_packet.bin), - #diameter_packet{errors = Failed} - = P - = decode_avps(MsgName, Mod, Pkt, Avps), - P#diameter_packet{errors = [Bs | Failed]}; - -decode_avps('', Mod, Pkt, Avps) -> %% unknown message ... - ?LOG(unknown, {Mod, Pkt#diameter_packet.header}), - Pkt#diameter_packet{avps = lists:reverse(Avps), - errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED -%% msg = undefined identifies this case. - -decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not - {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps), - ?LOGC([] /= Failed, failed, {Mod, Failed}), - Pkt#diameter_packet{msg = Rec, - errors = Failed, - avps = As}. - -%%% --------------------------------------------------------------------------- -%%% # decode_header/1 -%%% --------------------------------------------------------------------------- - -decode_header(<>) -> - <> - = CmdFlags, - %% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored - %% by the receiver. - - %% The RFC is quite unclear about the order of the bits in this - %% case. It writes - %% - %% 0 1 2 3 4 5 6 7 - %% +-+-+-+-+-+-+-+-+ - %% |R P E T r r r r| - %% +-+-+-+-+-+-+-+-+ - %% - %% in defining these but the scale refers to the (big endian) - %% transmission order, first to last, not the bit order. That is, - %% R is the high order bit. It's odd that a standard reserves - %% low-order bit rather than high-order ones. - - #diameter_header{version = Version, - length = MsgLength, - cmd_code = CmdCode, - application_id = ApplicationId, - hop_by_hop_id = HopByHopId, - end_to_end_id = EndToEndId, - is_request = 1 == R, - is_proxiable = 1 == P, - is_error = 1 == E, - is_retransmitted = 1 == T}; - -decode_header(_) -> - false. - -%%% --------------------------------------------------------------------------- -%%% # sequence_numbers/1 -%%% --------------------------------------------------------------------------- - -%% The End-To-End identifier must be unique for at least 4 minutes. We -%% maintain a 24-bit wraparound counter, and add an 8-bit persistent -%% wraparound counter. The 8-bit counter is incremented each time the -%% system is restarted. - -sequence_numbers(#diameter_packet{bin = Bin}) - when is_binary(Bin) -> - sequence_numbers(Bin); - -sequence_numbers(#diameter_packet{header = #diameter_header{} = H}) -> - sequence_numbers(H); - -sequence_numbers(#diameter_header{hop_by_hop_id = H, - end_to_end_id = E}) -> - {H,E}; - -sequence_numbers(<<_:12/binary, H:32, E:32, _/binary>>) -> - {H,E}. - -%%% --------------------------------------------------------------------------- -%%% # hop_by_hop_id/2 -%%% --------------------------------------------------------------------------- - -hop_by_hop_id(Id, <>) -> - <>. - -%%% --------------------------------------------------------------------------- -%%% # msg_name/1 -%%% --------------------------------------------------------------------------- - -msg_name(#diameter_header{application_id = ?APP_ID_COMMON, - cmd_code = C, - is_request = R}) -> - ?BASE:msg_name(C,R); - -msg_name(Hdr) -> - msg_id(Hdr). - -%% Note that messages in different applications could have the same -%% name. - -%%% --------------------------------------------------------------------------- -%%% # msg_id/1 -%%% --------------------------------------------------------------------------- - -msg_id(#diameter_packet{msg = [#diameter_header{} = Hdr | _]}) -> - msg_id(Hdr); - -msg_id(#diameter_packet{header = #diameter_header{} = Hdr}) -> - msg_id(Hdr); - -msg_id(#diameter_header{application_id = A, - cmd_code = C, - is_request = R}) -> - {A, C, if R -> 1; true -> 0 end}; - -msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> - {ApplId, CmdCode, Rbit}. - -%%% --------------------------------------------------------------------------- -%%% # collect_avps/1 -%%% --------------------------------------------------------------------------- - -%% Note that the returned list of AVP's is reversed relative to their -%% order in the binary. Note also that grouped avp's aren't unraveled, -%% only those at the top level. - -collect_avps(#diameter_packet{bin = Bin}) -> - <<_:20/binary, Avps/bitstring>> = Bin, - collect_avps(Avps); - -collect_avps(Bin) -> - collect_avps(Bin, 0, []). - -collect_avps(<<>>, _, Acc) -> - Acc; -collect_avps(Bin, N, Acc) -> - try split_avp(Bin) of - {Rest, AVP} -> - collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc]) - catch - ?FAILURE(_) -> - {Bin, Acc} - end. - -%% 0 1 2 3 -%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | AVP Code | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% |V M P r r r r r| AVP Length | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Vendor-ID (opt) | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Data ... -%% +-+-+-+-+-+-+-+-+ - -%% split_avp/1 - -split_avp(Bin) -> - 8 =< size(Bin) orelse ?THROW(truncated_header), - - <> - = Bin, - - DataSize = Length - 8, % size(Code+Flags+Length) = 8 octets - PadSize = (4 - (DataSize rem 4)) rem 4, - - DataSize + PadSize =< size(Rest) - orelse ?THROW(truncated_data), - - <> - = Rest, - <> - = Flags, - - 0 == Vbit orelse 4 =< size(Data) - orelse ?THROW(truncated_vendor_id), - - {Vid, D} = vid(Vbit, Data), - {R, #diameter_avp{code = Code, - vendor_id = Vid, - is_mandatory = 1 == Mbit, - need_encryption = 1 == Pbit, - data = D}}. - -%% The RFC is a little misleading when stating that OctetString is -%% padded to a 32-bit boundary while other types align naturally. All -%% other types are already multiples of 32 bits so there's no need to -%% distinguish between types here. Any invalid lengths will result in -%% decode error in diameter_types. - -vid(1, <>) -> - {Vid, Data}; -vid(0, Data) -> - {undefined, Data}. - -%%% --------------------------------------------------------------------------- -%%% # pack_avp/1 -%%% --------------------------------------------------------------------------- - -%% The normal case here is data as an #diameter_avp{} list or an -%% iolist, which are the cases that generated codec modules use. The -%% other case is as a convenience in the relay case in which the -%% dictionary doesn't know about specific AVP's. - -%% Grouped AVP whose components need packing ... -pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) -> - pack_avp(A#diameter_avp{data = encode_avps(Avps)}); - -%% ... data as a type/value tuple, possibly with header data, ... -pack_avp(#diameter_avp{data = {Type, Value}} = A) - when is_atom(Type) -> - pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)}); -pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) -> - pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value))); -pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}}) - when is_binary(Bin) -> - pack_avp(T, Bin); -pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> - {Code, _Flags, Vid} = Hdr = Dict:avp_header(Name), - {Name, Type} = Dict:avp_name(Code, Vid), - pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); - -%% ... or as an iolist. -pack_avp(#diameter_avp{code = Code, - vendor_id = V, - is_mandatory = M, - need_encryption = P, - data = Data}) -> - Flags = lists:foldl(fun flag_avp/2, 0, [{V /= undefined, 2#10000000}, - {M, 2#01000000}, - {P, 2#00100000}]), - pack_avp({Code, Flags, V}, iolist_to_binary(Data)). - -flag_avp({true, B}, F) -> - F bor B; -flag_avp({false, _}, F) -> - F. - -%%% --------------------------------------------------------------------------- -%%% # pack_avp/2 -%%% --------------------------------------------------------------------------- - -pack_avp({Code, Flags, VendorId}, Bin) - when is_binary(Bin) -> - Sz = size(Bin), - pack_avp(Code, Flags, VendorId, Sz, pad(Sz rem 4, Bin)). - -pad(0, Bin) -> - Bin; -pad(N, Bin) -> - P = 8*(4-N), - <>. -%% Note that padding is not included in the length field as mandated by -%% the RFC. - -%% pack_avp/5 -%% -%% Prepend the vendor id as required. - -pack_avp(Code, Flags, Vid, Sz, Bin) - when 0 == Flags band 2#10000000 -> - undefined = Vid, %% sanity check - pack_avp(Code, Flags, Sz, Bin); - -pack_avp(Code, Flags, Vid, Sz, Bin) -> - pack_avp(Code, Flags, Sz+4, <>). - -%% pack_avp/4 - -pack_avp(Code, Flags, Sz, Bin) -> - Length = Sz + 8, - <>. - -%% =========================================================================== - -choose(true, X, _) -> X; -choose(false, _, X) -> X. diff --git a/lib/diameter/src/app/diameter_config.erl b/lib/diameter/src/app/diameter_config.erl deleted file mode 100644 index a6b48fe65b..0000000000 --- a/lib/diameter/src/app/diameter_config.erl +++ /dev/null @@ -1,676 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module writes service/transport configuration to the table -%% diameter_config, so that the config will survive service process -%% death, and then turns it into calls towards diameter_service. It -%% also restarts services upon their death. -%% -%% The table diameter_config is only written here while -%% diameter_service reads. This is all somewhat after the fact. Once -%% upon a time the config was only stored in the service process, -%% causing much grief if these processes died (which they did with -%% some regularity) and one was forced to reconfigure. This module was -%% then inserted into the service start in order to keep a more -%% permanent record of the config. That said, service processes are -%% now much more robust than they once were and crashing is a thing of -%% the past. -%% - --module(diameter_config). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([start_service/2, - stop_service/1, - add_transport/2, - remove_transport/2, - have_transport/2, - lookup/1]). - -%% child server start --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% diameter_sync requests. --export([sync/1]). - -%% debug --export([state/0, - uptime/0]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - -%% Server state. --record(state, {id = now()}). - -%% Registered name of the server. --define(SERVER, ?MODULE). - -%% Table config is written to. --define(TABLE, ?MODULE). - -%% Workaround for dialyzer's lack of understanding of match specs. --type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - -%% Configuration records in ?TABLE. - --record(service, - {name, - rec :: match(#diameter_service{}), - options :: match(list())}). - --record(transport, - {service, %% name - ref = make_ref() :: match(reference()), - type :: match(connect | listen), - options :: match(list())}). - -%% Monitor entry in ?TABLE. --record(monitor, {mref = make_ref() :: reference(), - service}). %% name - -%% Time to lay low before restarting a dead service. --define(RESTART_SLEEP, 2000). - -%% A minimal diameter_caps for checking for valid capabilities values. --define(EXAMPLE_CAPS, - #diameter_caps{origin_host = "TheHost", - origin_realm = "TheRealm", - host_ip_address = [{127,0,0,1}], - vendor_id = 42, - product_name = "TheProduct"}). - --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -%%% The return values below assume the server diameter_config is started. -%%% The functions will exit if it isn't. - -%% -------------------------------------------------------------------------- -%% # start_service(SvcName, Opts) -%% -%% Output: ok | {error, Reason} -%% -------------------------------------------------------------------------- - -start_service(SvcName, Opts) - when is_list(Opts) -> - start_rc(sync(SvcName, {start_service, SvcName, Opts})). - -start_rc({ok = T, _Pid}) -> - T; -start_rc({error, _} = No) -> - No; -start_rc(timeout) -> - {error, application_not_started}. - -%% -------------------------------------------------------------------------- -%% # stop_service(SvcName) -%% -%% Output: ok -%% -------------------------------------------------------------------------- - -stop_service(SvcName) -> - sync(SvcName, {stop_service, SvcName}). - -%% -------------------------------------------------------------------------- -%% # add_transport(SvcName, {Type, Opts}) -%% -%% Input: Type = connect | listen -%% -%% Output: {ok, Ref} | {error, Reason} -%% -------------------------------------------------------------------------- - -add_transport(SvcName, {T, Opts}) - when is_list(Opts), (T == connect orelse T == listen) -> - sync(SvcName, {add, SvcName, T, Opts}). - -%% -------------------------------------------------------------------------- -%% # remove_transport(SvcName, Pred) -%% -%% Input: Pred = arity 3 fun on transport ref, connect|listen and Opts, -%% returning true if the transport is to be removed, false if -%% not -%% | arity 2 fun on Ref and Opts only -%% | arity 1 fun on Opts only -%% | Opts matching all transports that have all of the specified -%% options -%% | Ref matching only the transport with this reference. -%% | {M,F,A} applied to Ref, connect|listen and Opts -%% | boolean() -%% -%% Output: ok | {error, Reason} -%% -------------------------------------------------------------------------- - -remove_transport(SvcName, Pred) -> - try - sync(SvcName, {remove, SvcName, pred(Pred)}) - catch - ?FAILURE(Reason) -> - {error, Reason} - end. - -pred(Pred) - when is_function(Pred, 3) -> - Pred; -pred(Pred) - when is_function(Pred, 2) -> - fun(R,_,O) -> Pred(R,O) end; -pred(Pred) - when is_function(Pred, 1) -> - fun(_,_,O) -> Pred(O) end; -pred(Opts) - when is_list(Opts) -> - fun(_,_,O) -> [] == Opts -- O end; -pred(Ref) - when is_reference(Ref) -> - fun(R,_,_) -> R == Ref end; -pred({M,F,A}) - when is_atom(M), is_atom(F), is_list(A) -> - fun(R,T,O) -> apply(M,F,[R,T,O|A]) end; -pred({Type, Pred}) -> %% backwards compatibility - P = pred(Pred), - fun(R,T,O) -> T == Type andalso P(R,T,O) end; -pred(B) - when is_boolean(B) -> - fun(_,_,_) -> B end; -pred(_) -> - ?THROW(pred). - -%% -------------------------------------------------------------------------- -%% # have_transport/2 -%% -%% Output: true | false -%% -------------------------------------------------------------------------- - -have_transport(SvcName, Ref) -> - member([{#transport{service = '$1', - ref = '$2', - _ = '_'}, - [{'andalso', {'=:=', '$1', {const, SvcName}}, - {'=:=', '$2', {const, Ref}}}], - [true]}]). - -%% -------------------------------------------------------------------------- -%% # lookup/1 -%% -------------------------------------------------------------------------- - -lookup(SvcName) -> - select([{#service{name = '$1', rec = '$2', options = '$3'}, - [{'=:=', '$1', {const, SvcName}}], - [{{'$1', '$2', '$3'}}]}, - {#transport{service = '$1', - ref = '$2', - type = '$3', - options = '$4'}, - [{'=:=', '$1', {const, SvcName}}], - [{{'$2', '$3', '$4'}}]}]). - -%% --------------------------------------------------------- -%% EXPORTED INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init/1 -%%% ---------------------------------------------------------- - -init([]) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call/2 -%%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - Reply = {error, {bad_request, Req}}, - {reply, Reply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast/2 -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info/2 -%%% ---------------------------------------------------------- - -%% A service process has died. This is most likely a consequence of -%% stop_service, in which case the restart will find no config for the -%% service and do nothing. The entry keyed on the monitor ref is only -%% removed as a result of the 'DOWN' notification however. -handle_info({'DOWN', MRef, process, _, Reason}, State) -> - [#monitor{service = SvcName} = T] = select([{#monitor{mref = MRef, - _ = '_'}, - [], - ['$_']}]), - queue_restart(Reason, SvcName), - delete_object(T), - {noreply, State}; - -handle_info({monitor, SvcName, Pid}, State) -> - monitor(Pid, SvcName), - {noreply, State}; - -handle_info({restart, SvcName}, State) -> - restart(SvcName), - {noreply, State}; - -handle_info(restart, State) -> - restart(), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%%-------------------------------------------------------------------- -%% # terminate/2 -%%-------------------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%%% ---------------------------------------------------------- -%%% # code_change/3 -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -insert(T) -> - ets:insert(?TABLE, T). - -%% ?TABLE is a bag: check only for a service entry. -have_service(SvcName) -> - member([{#service{name = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - [true]}]). - -member(MatchSpec) -> - '$end_of_table' =/= ets:select(?TABLE, MatchSpec, 1). - -delete_object(T) -> - ets:delete_object(?TABLE, T). - -delete(Key) -> - ets:delete(?TABLE, Key). - -select(MatchSpec) -> - ets:select(?TABLE, MatchSpec). - -select_delete(MatchSpec) -> - ets:select_delete(?TABLE, MatchSpec). - -%% sync/2 -%% -%% Interface functions used to be implemented as calls to ?SERVER but -%% now serialize things per service instead since stopping a service -%% can take time if the server doesn't answer DPR. A caller who wants -%% to stop multiple services can then improve performance by spawning -%% processes to stop them concurrently. - -sync(SvcName, T) -> - diameter_sync:call({?MODULE, SvcName}, - {?MODULE, sync, [T]}, - infinity, - infinity). - -%% sync/1 - -sync({restart, SvcName}) -> - have_service(SvcName) andalso start(SvcName); - -sync({start_service, SvcName, Opts}) -> - try - start(have_service(SvcName), SvcName, Opts) - catch - ?FAILURE(Reason) -> {error, Reason} - end; - -sync({stop_service, SvcName}) -> - stop(SvcName); - -sync({add, SvcName, Type, Opts}) -> - try - add(SvcName, Type, Opts) - catch - ?FAILURE(Reason) -> {error, Reason} - end; - -sync({remove, SvcName, Pred}) -> - remove(select([{#transport{service = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - ['$_']}]), - SvcName, - Pred). - -%% start/3 - -start(true, _, _) -> - {error, already_started}; -start(false, SvcName, Opts) -> - insert(make_config(SvcName, Opts)), - start(SvcName). - -%% start/1 - -start(SvcName) -> - RC = diameter_service:start(SvcName), - startmon(SvcName, RC), - RC. - -startmon(SvcName, {ok, Pid}) -> - ?SERVER ! {monitor, SvcName, Pid}; -startmon(_, {error, _}) -> - ok. - -monitor(Pid, SvcName) -> - MRef = erlang:monitor(process, Pid), - insert(#monitor{mref = MRef, service = SvcName}). - -%% queue_restart/2 - -%% Service has gone down on monitor death. Note that all service-related -%% config is deleted. -queue_restart({shutdown, {monitor, _}}, SvcName) -> - delete(SvcName); - -%% Application shutdown: ignore. -queue_restart(shutdown, _) -> - ok; - -%% Or not. -queue_restart(_, SvcName) -> - erlang:send_after(?RESTART_SLEEP, self(), {restart, SvcName}). - -%% restart/1 - -restart(SvcName) -> - sync(SvcName, {restart, SvcName}). - -%% restart/0 -%% -%% Start anything configured as required. Bang 'restart' to the server -%% to kick things into gear manually. (Not that it should be required -%% but it's been useful for test.) - -restart() -> - MatchSpec = [{#service{name = '$1', _ = '_'}, - [], - ['$1']}], - lists:foreach(fun restart/1, select(MatchSpec)). - -%% stop/1 - -stop(SvcName) -> - %% If the call to the service returns error for any reason other - %% than the process not being alive then deleting the config from - %% under it will surely bring it down. - diameter_service:stop(SvcName), - %% Delete only the service entry, not everything keyed on the name, - select_delete([{#service{name = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - [true]}]), - ok. -%% Note that a transport has to be removed for its statistics to be -%% deleted. - -%% add/3 - -add(SvcName, Type, Opts) -> - %% Ensure usable capabilities. diameter_service:merge_service/2 - %% depends on this. - lists:foreach(fun(Os) -> - is_list(Os) orelse ?THROW({capabilities, Os}), - ok = encode_CER(Os) - end, - [Os || {capabilities, Os} <- Opts, is_list(Os)]), - - Ref = make_ref(), - T = {Ref, Type, Opts}, - %% The call to the service returns error if the service isn't - %% started yet, which is harmless. The transport will be started - %% when the service is in that case. - case start_transport(SvcName, T) of - ok -> - insert(#transport{service = SvcName, - ref = Ref, - type = Type, - options = Opts}), - {ok, Ref}; - {error, _} = No -> - No - end. - -start_transport(SvcName, T) -> - case diameter_service:start_transport(SvcName, T) of - {ok, _Pid} -> - ok; - {error, no_service} -> - ok; - {error, _} = No -> - No - end. - -%% remove/3 - -remove(L, SvcName, Pred) -> - rm(SvcName, lists:filter(fun(#transport{ref = R, type = T, options = O}) -> - Pred(R,T,O) - end, - L)). - -rm(_, []) -> - ok; -rm(SvcName, L) -> - Refs = lists:map(fun(#transport{ref = R}) -> R end, L), - case stop_transport(SvcName, Refs) of - ok -> - lists:foreach(fun delete_object/1, L); - {error, _} = No -> - No - end. - -stop_transport(SvcName, Refs) -> - case diameter_service:stop_transport(SvcName, Refs) of - ok -> - ok; - {error, no_service} -> - ok; - {error, _} = No -> - No - end. - -%% make_config/2 - -make_config(SvcName, Opts) -> - Apps = init_apps(Opts), - [] == Apps andalso ?THROW(no_apps), - - %% Use the fact that diameter_caps has the same field names as CER. - Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER) -- ['AVP'], - - COpts = [T || {K,_} = T <- Opts, lists:member(K, Fields)], - Caps = make_caps(#diameter_caps{}, COpts), - - ok = encode_CER(COpts), - - Os = split(Opts, [{[fun erlang:is_boolean/1], false, share_peers}, - {[fun erlang:is_boolean/1], false, use_shared_peers}, - {[fun erlang:is_pid/1, false], false, monitor}]), - %% share_peers and use_shared_peers are currently undocumented. - - #service{name = SvcName, - rec = #diameter_service{applications = Apps, - capabilities = Caps}, - options = Os}. - -make_caps(Caps, Opts) -> - case diameter_capx:make_caps(Caps, Opts) of - {ok, T} -> - T; - {error, {Reason, _}} -> - ?THROW(Reason) - end. - -%% Validate types by encoding a CER. -encode_CER(Opts) -> - {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts)), - - Hdr = #diameter_header{version = ?DIAMETER_VERSION, - end_to_end_id = 0, - hop_by_hop_id = 0}, - - try - diameter_codec:encode(?BASE, #diameter_packet{header = Hdr, - msg = CER}), - ok - catch - exit: Reason -> - ?THROW(Reason) - end. - -init_apps(Opts) -> - lists:foldl(fun app_acc/2, [], lists:reverse(Opts)). - -app_acc({application, Opts}, Acc) -> - is_list(Opts) orelse ?THROW({application, Opts}), - - [Dict, Mod] = get_opt([dictionary, module], Opts), - Alias = get_opt(alias, Opts, Dict), - ModS = get_opt(state, Opts, Alias), - M = get_opt(call_mutates_state, Opts, false), - A = get_opt(answer_errors, Opts, report), - [#diameter_app{alias = Alias, - dictionary = Dict, - id = cb(Dict, id), - module = init_mod(Mod), - init_state = ModS, - mutable = init_mutable(M), - answer_errors = init_answers(A)} - | Acc]; -app_acc(_, Acc) -> - Acc. - -init_mod(M) - when is_atom(M) -> - [M]; -init_mod([M|_] = L) - when is_atom(M) -> - L; -init_mod(M) -> - ?THROW({module, M}). - -init_mutable(M) - when M == true; - M == false -> - M; -init_mutable(M) -> - ?THROW({call_mutates_state, M}). - -init_answers(A) - when callback == A; - report == A; - discard == A -> - A; -init_answers(A) -> - ?THROW({answer_errors, A}). - -%% Get a single value at the specified key. -get_opt(Keys, List) - when is_list(Keys) -> - [get_opt(K, List) || K <- Keys]; -get_opt(Key, List) -> - case [V || {K,V} <- List, K == Key] of - [V] -> V; - _ -> ?THROW({arity, Key}) - end. - -%% Get an optional value at the specified key. -get_opt(Key, List, Def) -> - case [V || {K,V} <- List, K == Key] of - [] -> Def; - [V] -> V; - _ -> ?THROW({arity, Key}) - end. - -split(Opts, Defs) -> - [{K, value(D, Opts)} || {_,_,K} = D <- Defs]. - -value({Preds, Def, Key}, Opts) -> - V = get_opt(Key, Opts, Def), - lists:any(fun(P) -> pred(P,V) end, Preds) - orelse ?THROW({value, Key}), - V. - -pred(F, V) - when is_function(F) -> - F(V); -pred(T, V) -> - T == V. - -cb(M,F) -> - try M:F() of - V -> V - catch - E: Reason -> - ?THROW({callback, E, Reason, ?STACK}) - end. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_dbg.erl b/lib/diameter/src/app/diameter_dbg.erl deleted file mode 100644 index 5b0ac3a3b6..0000000000 --- a/lib/diameter/src/app/diameter_dbg.erl +++ /dev/null @@ -1,516 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_dbg). - --export([table/1, - tables/0, - fields/1, - help/0, - modules/0, - versions/0, - version_info/0, - compiled/0, - procs/0, - latest/0, - nl/0, - log/4]). - --export([diameter_config/0, - diameter_peer/0, - diameter_reg/0, - diameter_request/0, - diameter_sequence/0, - diameter_service/0, - diameter_stats/0]). - --export([pp/1, - subscriptions/0, - children/0]). - -%% Trace help. --export([tracer/0, tracer/1, - p/0, p/1, - stop/0, - tpl/1, - tp/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - - --define(INFO, diameter_info). --define(SEP(), ?INFO:sep()). - --define(LOCAL, [diameter_config, - diameter_peer, - diameter_reg, - diameter_request, - diameter_sequence, - diameter_service, - diameter_stats]). - --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -log(_Slogan, _Mod, _Line, _Details) -> - ok. - -%%% ---------------------------------------------------------- -%%% # help() -%%% ---------------------------------------------------------- - -help() -> - not_yet_implemented. - -%%% ---------------------------------------------------------- -%%% # table(TableName) -%%% -%%% Input: TableName = diameter table containing record entries. -%%% -%%% Output: Count | undefined -%%% ---------------------------------------------------------- - -table(T) - when (T == diameter_peer) orelse (T == diameter_reg) -> - ?INFO:format(collect(T), fields(T), fun ?INFO:split/2); - -table(Table) - when is_atom(Table) -> - case fields(Table) of - undefined = No -> - No; - Fields -> - ?INFO:format(Table, Fields, fun split/2) - end. - -split([started, name | Fs], [S, N | Vs]) -> - {name, [started | Fs], N, [S | Vs]}; -split([[F|FT]|Fs], [Rec|Vs]) -> - [_, V | VT] = tuple_to_list(Rec), - {F, FT ++ Fs, V, VT ++ Vs}; -split([F|Fs], [V|Vs]) -> - {F, Fs, V, Vs}. - -%%% ---------------------------------------------------------- -%%% # TableName() -%%% ---------------------------------------------------------- - --define(TABLE(Name), Name() -> table(Name)). - -?TABLE(diameter_config). -?TABLE(diameter_peer). -?TABLE(diameter_reg). -?TABLE(diameter_request). -?TABLE(diameter_sequence). -?TABLE(diameter_service). -?TABLE(diameter_stats). - -%%% ---------------------------------------------------------- -%%% # tables() -%%% -%%% Output: Number of records output. -%%% -%%% Description: Pretty-print records in diameter tables from all nodes. -%%% ---------------------------------------------------------- - -tables() -> - ?INFO:format(field(?LOCAL), fun split/3, fun collect/1). - -field(Tables) -> - lists:map(fun(T) -> {T, fields(T)} end, lists:sort(Tables)). - -split(_, Fs, Vs) -> - split(Fs, Vs). - -%%% ---------------------------------------------------------- -%%% # modules() -%%% ---------------------------------------------------------- - -modules() -> - Path = filename:join([appdir(), atom_to_list(?APPLICATION) ++ ".app"]), - {ok, [{application, ?APPLICATION, Attrs}]} = file:consult(Path), - {modules, Mods} = lists:keyfind(modules, 1, Attrs), - Mods. - -appdir() -> - [_|_] = code:lib_dir(?APPLICATION, ebin). - -%%% ---------------------------------------------------------- -%%% # versions() -%%% ---------------------------------------------------------- - -versions() -> - ?INFO:versions(modules()). - -%%% ---------------------------------------------------------- -%%% # versions() -%%% ---------------------------------------------------------- - -version_info() -> - ?INFO:version_info(modules()). - -%%% ---------------------------------------------------------- -%%% # compiled() -%%% ---------------------------------------------------------- - -compiled() -> - ?INFO:compiled(modules()). - -%%% ---------------------------------------------------------- -%%% procs() -%%% ---------------------------------------------------------- - -procs() -> - ?INFO:procs(?APPLICATION). - -%%% ---------------------------------------------------------- -%%% # latest() -%%% ---------------------------------------------------------- - -latest() -> - ?INFO:latest(modules()). - -%%% ---------------------------------------------------------- -%%% # nl() -%%% ---------------------------------------------------------- - -nl() -> - lists:foreach(fun(M) -> abcast = c:nl(M) end, modules()). - -%%% ---------------------------------------------------------- -%%% # pp(Bin) -%%% -%%% Description: Pretty-print a message binary. -%%% ---------------------------------------------------------- - -%% Network byte order = big endian. - -pp(<>) -> - ?SEP(), - ppp(["Version", - "Message length", - "[Actual length]", - "R(equest)", - "P(roxiable)", - "E(rror)", - "T(Potential retrans)", - "Reserved bits", - "Command code", - "Application id", - "Hop by hop id", - "End to end id"], - [Version, MsgLength, size(AVPs) + 20, - Rbit, Pbit, Ebit, Tbit, Reserved, - CmdCode, - ApplId, - HbHid, - E2Eid]), - N = avp_loop({AVPs, MsgLength - 20}, 0), - ?SEP(), - N; - -pp(<<_Version:8, MsgLength:24, _/binary>> = Bin) -> - {bad_message_length, MsgLength, size(Bin)}; - -pp(Bin) - when is_binary(Bin) -> - {truncated_binary, size(Bin)}; - -pp(_) -> - not_binary. - -%% avp_loop/2 - -avp_loop({Bin, Size}, N) -> - avp_loop(avp(Bin, Size), N+1); -avp_loop(ok, N) -> - N; -avp_loop([_E, _Rest] = L, N) -> - io:format("! ~s: ~p~n", L), - N; -avp_loop([E, Rest, Fmt | Values], N) - when is_binary(Rest) -> - io:format("! ~s (" ++ Fmt ++ "): ~p~n", [E|Values] ++ [Rest]), - N. - -%% avp/2 - -avp(<<>>, 0) -> - ok; -avp(<>, - Size) -> - avp(Code, Flags, Length, Rest, Size); -avp(Bin, _) -> - ["truncated AVP header", Bin]. - -%% avp/5 - -avp(Code, Flags, Length, Rest, Size) -> - <> - = Flags, - b(), - ppp(["AVP Code", - "V(endor)", - "M(andatory)", - "P(Security)", - "R(eserved)", - "Length"], - [Code, V, M, P, Res, Length]), - avp(V, Rest, Length - 8, Size - 8). - -%% avp/4 - -avp(1, <>, Length, Size) -> - ppp({"Vendor-ID", V}), - data(Data, Length - 4, Size - 4); -avp(1, Bin, _, _) -> - ["truncated Vendor-ID", Bin]; -avp(0, Data, Length, Size) -> - data(Data, Length, Size). - -data(Bin, Length, Size) - when size(Bin) >= Length -> - <> = Bin, - ppp({"Data", AVP}), - unpad(Rest, Size - Length, Length rem 4); - -data(Bin, _, _) -> - ["truncated AVP data", Bin]. - -%% Remove padding bytes up to the next word boundary. -unpad(Bin, Size, 0) -> - {Bin, Size}; -unpad(Bin, Size, N) -> - un(Bin, Size, 4 - N). - -un(Bin, Size, N) - when size(Bin) >= N -> - ppp({"Padding bytes", N}), - <> = Bin, - Bits = N*8, - case Pad of - <<0:Bits>> -> - {Rest, Size - N}; - _ -> - ["non-zero padding", Bin, "~p", N] - end; - -un(Bin, _, _) -> - ["truncated padding", Bin]. - -b() -> - io:format("#~n"). - -ppp(Fields, Values) -> - lists:foreach(fun ppp/1, lists:zip(Fields, Values)). - -ppp({Field, Value}) -> - io:format(": ~-22s : ~p~n", [Field, Value]). - -%%% ---------------------------------------------------------- -%%% # subscriptions() -%%% -%%% Output: list of {SvcName, Pid} -%%% ---------------------------------------------------------- - -subscriptions() -> - diameter_service:subscriptions(). - -%%% ---------------------------------------------------------- -%%% # children() -%%% ---------------------------------------------------------- - -children() -> - diameter_sup:tree(). - -%%% ---------------------------------------------------------- - -%% tracer/[12] - -tracer(Port) - when is_integer(Port) -> - dbg:tracer(port, dbg:trace_port(ip, Port)); - -tracer(Path) - when is_list(Path) -> - dbg:tracer(port, dbg:trace_port(file, Path)). - -tracer() -> - dbg:tracer(process, {fun p/2, ok}). - -p(T,_) -> - io:format("+ ~p~n", [T]). - -%% p/[01] - -p() -> - p([c,timestamp]). - -p(T) -> - dbg:p(all,T). - -%% stop/0 - -stop() -> - dbg:ctp(), - dbg:stop_clear(). - -%% tpl/1 -%% tp/1 - -tpl(T) -> - dbg(tpl, T). - -tp(T) -> - dbg(tp, T). - -%% dbg/2 - -dbg(F, L) - when is_list(L) -> - [dbg(F, X) || X <- L]; - -dbg(F, M) - when is_atom(M) -> - apply(dbg, F, [M, x]); - -dbg(F, T) - when is_tuple(T) -> - apply(dbg, F, tuple_to_list(T)). - -%% =========================================================================== -%% =========================================================================== - -%% collect/1 - -collect(diameter_peer) -> - lists:flatmap(fun peers/1, diameter:services()); - -collect(diameter_reg) -> - diameter_reg:terms(); - -collect(Name) -> - c(ets:info(Name), Name). - -c(undefined, _) -> - []; -c(_, Name) -> - ets:tab2list(Name). - -%% peers/1 - -peers(Name) -> - peers(Name, diameter:service_info(Name, transport)). - -peers(_, undefined) -> - []; -peers(Name, Ts) -> - lists:flatmap(fun(T) -> mk_peers(Name, T) end, Ts). - -mk_peers(Name, [_, {type, connect} | _] = Ts) -> - [[Name | mk_peer(Ts)]]; -mk_peers(Name, [R, {type, listen}, O, {accept = A, As}]) -> - [[Name | mk_peer([R, {type, A}, O | Ts])] || Ts <- As]. -%% This is a bit lame: service_info works to build this list and out -%% of something like what we want here and then we take it apart. - -mk_peer(Vs) -> - [Type, Ref, State, Opts, WPid, TPid, SApps, Caps] - = get_values(Vs, [type,ref,state,options,watchdog,peer,apps,caps]), - [Ref, State, [{type, Type} | Opts], s(WPid), s(TPid), SApps, Caps]. - -get_values(Vs, Ks) -> - [proplists:get_value(K, Vs) || K <- Ks]. - -s(undefined = T) -> - T; -s({Pid, _Started, _State}) -> - state(Pid); -s({Pid, _Started}) -> - state(Pid). - -%% Collect states from watchdog/transport pids. -state(Pid) -> - MRef = erlang:monitor(process, Pid), - Pid ! {state, self()}, - receive - {'DOWN', MRef, process, _, _} -> - Pid; - {Pid, _} = T -> - erlang:demonitor(MRef, [flush]), - T - end. - -%% fields/1 - --define(FIELDS(Table), fields(Table) -> record_info(fields, Table)). - -fields(diameter_config) -> - []; - -fields(T) - when T == diameter_request; - T == diameter_sequence -> - fun kv/1; - -fields(diameter_stats) -> - fun({Ctr, N}) when not is_pid(Ctr) -> - {[counter, value], [Ctr, N]}; - (_) -> - [] - end; - -fields(diameter_service) -> - [started, - name, - record_info(fields, diameter_service), - peerT, - connT, - share_peers, - use_shared_peers, - shared_peers, - local_peers, - monitor]; - -?FIELDS(diameter_event); -?FIELDS(diameter_uri); -?FIELDS(diameter_avp); -?FIELDS(diameter_header); -?FIELDS(diameter_packet); -?FIELDS(diameter_app); -?FIELDS(diameter_caps); - -fields(diameter_peer) -> - [service, ref, state, options, watchdog, peer, applications, capabilities]; - -fields(diameter_reg) -> - [property, pids]; - -fields(_) -> - undefined. - -kv({_,_}) -> - [key, value]; -kv(_) -> - []. diff --git a/lib/diameter/src/app/diameter_dict.erl b/lib/diameter/src/app/diameter_dict.erl deleted file mode 100644 index 3b9ba00a3f..0000000000 --- a/lib/diameter/src/app/diameter_dict.erl +++ /dev/null @@ -1,153 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module provide OTP's dict interface built on top of ets. -%% -%% Note that while the interface is the same as dict the semantics -%% aren't quite. A Dict here is just a table identifier (although -%% this fact can't be used if you want dict/ets-based implementations -%% to be interchangeable) so changes made to the Dict modify the -%% underlying table. For merge/3, the first argument table is modified. -%% -%% The underlying ets table implementing a dict is deleted when the -%% process from which new() was invoked exits and the dict is only -%% writable from this process. -%% -%% The reason for this is to be able to swap dict/ets-based -%% implementations: the former is easier to debug, the latter is -%% faster for larger tables. It's also just a nice interface even -%% when there's no need for swapability. -%% - --module(diameter_dict). - --export([append/3, - append_list/3, - erase/2, - fetch/2, - fetch_keys/1, - filter/2, - find/2, - fold/3, - from_list/1, - is_key/2, - map/2, - merge/3, - new/0, - store/3, - to_list/1, - update/3, - update/4, - update_counter/3]). - -%%% ---------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% ---------------------------------------------------------- - -append(Key, Value, Dict) -> - append_list(Key, [Value], Dict). - -append_list(Key, ValueList, Dict) - when is_list(ValueList) -> - update(Key, fun(V) -> V ++ ValueList end, ValueList, Dict). - -erase(Key, Dict) -> - ets:delete(Dict, Key), - Dict. - -fetch(Key, Dict) -> - {ok, V} = find(Key, Dict), - V. - -fetch_keys(Dict) -> - ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). - -filter(Pred, Dict) -> - lists:foreach(fun({K,V}) -> filter(Pred(K,V), K, Dict) end, to_list(Dict)), - Dict. - -find(Key, Dict) -> - case ets:lookup(Dict, Key) of - [{Key, V}] -> - {ok, V}; - [] -> - error - end. - -fold(Fun, Acc0, Dict) -> - ets:foldl(fun({K,V}, Acc) -> Fun(K, V, Acc) end, Acc0, Dict). - -from_list(List) -> - lists:foldl(fun store/2, new(), List). - -is_key(Key, Dict) -> - ets:member(Dict, Key). - -map(Fun, Dict) -> - lists:foreach(fun({K,V}) -> store(K, Fun(K,V), Dict) end, to_list(Dict)), - Dict. - -merge(Fun, Dict1, Dict2) -> - fold(fun(K2,V2,_) -> - update(K2, fun(V1) -> Fun(K2, V1, V2) end, V2, Dict1) - end, - Dict1, - Dict2). - -new() -> - ets:new(?MODULE, [set]). - -store(Key, Value, Dict) -> - store({Key, Value}, Dict). - -to_list(Dict) -> - ets:tab2list(Dict). - -update(Key, Fun, Dict) -> - store(Key, Fun(fetch(Key, Dict)), Dict). - -update(Key, Fun, Initial, Dict) -> - store(Key, map(Key, Fun, Dict, Initial), Dict). - -update_counter(Key, Increment, Dict) - when is_integer(Increment) -> - update(Key, fun(V) -> V + Increment end, Increment, Dict). - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -store({_,_} = T, Dict) -> - ets:insert(Dict, T), - Dict. - -filter(true, _, _) -> - ok; -filter(false, K, Dict) -> - erase(K, Dict). - -map(Key, Fun, Dict, Error) -> - case find(Key, Dict) of - {ok, V} -> - Fun(V); - error -> - Error - end. - diff --git a/lib/diameter/src/app/diameter_info.erl b/lib/diameter/src/app/diameter_info.erl deleted file mode 100644 index 39d32d07cd..0000000000 --- a/lib/diameter/src/app/diameter_info.erl +++ /dev/null @@ -1,869 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_info). - --export([usage/1, - format/1, - format/2, - format/3, - format/4, - table/2, - tables/1, - tables/2, - split/2, - split/3, - tab2list/1, - modules/1, - versions/1, - version_info/1, - attrs/2, - compiled/1, - procs/1, - latest/1, - list/1]). - -%% Support for rolling your own. --export([sep/0, - sep/1, - widest/1, - p/1, - p/3]). - --compile({no_auto_import,[max/2]}). - --export([collect/2]). - --define(LONG_TIMEOUT, 30000). --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -%%% ---------------------------------------------------------- -%%% # usage(String) -%%% ---------------------------------------------------------- - -usage(Usage) -> - sep($+), - io:format("+ ~p~n", [?MODULE]), - io:format("~n~s~n~n", [compact(Usage)]), - sep($+). - -%%% -%%% The function format/3, for pretty-printing tables, comes in -%%% several flavours. -%%% - -%%% ---------------------------------------------------------- -%%% # format(TableName, Fields, SplitFun) -%%% -%%% Input: TableName = atom() name of table. -%%% -%%% Fields = List of field names for the records maintained -%%% in the specified table. Can be empty, in which -%%% case entries are listed unadorned of field names -%%% and SplitFun is unused. -%%% | Integer, equivalent to a list with this many '' atoms. -%%% | Arity 1 fun mapping a table entry to a Fields list -%%% or a tuple {Fields, Values} of lists of the same -%%% length. -%%% -%%% If Fields is a list then its length must be the same -%%% as or one less than the size of the tuples contained -%%% in the table. (The values printed then being those -%%% in the tuple or record in question.) -%%% -%%% SplitFun = Arity 3 fun applied as -%%% -%%% SplitFun(TableName, Fields, Values) -%%% -%%% in order to obtain a tuple -%%% -%%% {Field, RestFields, Value, RestValues} -%%% -%%% for which Field/Value will be formatted on -%%% STDOUT. (This is to allow a value to be -%%% transformed before being output by returning a -%%% new value and/or replacing the remainder of -%%% the list.) The returned lists must have the -%%% same length and Field here is an atom, '' causing -%%% a value to be listed unadorned of the field name. -%%% -%%% Field can also be list of field names, in -%%% which case Value must be a record of the -%%% corresponding type. -%%% -%%% | Arity 2 fun applied as SplitFun(Fields, Values). -%%% -%%% Output: Count | undefined -%%% -%%% Count = Number of entries output. -%%% -%%% Description: Pretty-print records in a named table. -%%% ---------------------------------------------------------- - -format(Table, Fields, SFun) - when is_atom(Table), is_function(SFun, 2) -> - ft(ets:info(Table), Table, SFun, Fields); - -format(Table, Fields, SFun) - when is_atom(Table), is_function(SFun, 3) -> - format(Table, Fields, fun(Fs,Vs) -> SFun(Table, Fs, Vs) end); - -%%% ---------------------------------------------------------- -%%% # format(Recs, Fields, SplitFun) -%%% -%%% Input: Recs = list of records/tuples -%%% Fields = As for format(Table, Fields, SplitFun), a table -%%% entry there being a member of Recs. -%%% SplitFun = Arity 3 fun applied as above but with the TableName -%%% replaced by the first element of the records in -%%% question. -%%% | Arity 2 fun as for format/3. -%%% -%%% Output: length(Recs) -%%% -%%% Description: Pretty print records/tuples. -%%% ---------------------------------------------------------- - -format(Recs, Fields, SFun) - when is_list(Recs), is_function(SFun, 3) -> - lists:foldl(fun(R,A) -> f(recsplit(SFun, R), 0, Fields, R, A) end, - 0, - Recs); - -format(Recs, Fields, SFun) - when is_list(Recs), is_function(SFun, 2) -> - lists:foldl(fun(R,A) -> f(SFun, 0, Fields, R, A) end, - 0, - Recs); - -%%% ---------------------------------------------------------- -%%% # format(Tables, SplitFun, CollectFun) -%%% -%%% Input: Tables = list of {TableName, Fields}. -%%% SplitFun = As for format(Table, Fields, SplitFun). -%%% CollectFun = arity 1 fun mapping a table name to a list -%%% of elements. A non-list can be returned to indicate -%%% that the table in question doesn't exist. -%%% -%%% Output: Number of entries output. -%%% -%%% Description: Pretty-print records in a named tables as collected -%%% from known nodes. Each table listing is preceeded by -%%% a banner. -%%% ---------------------------------------------------------- - -format(Tables, SFun, CFun) - when is_list(Tables), is_function(CFun, 1) -> - format_remote(Tables, - SFun, - rpc:multicall(nodes(known), - ?MODULE, - collect, - [CFun, lists:map(fun({T,_}) -> T end, Tables)], - ?LONG_TIMEOUT)); - -%%% ---------------------------------------------------------- -%%% # format(LocalTables, RemoteTables, SplitFun, CollectFun) -%%% # format(LocalTables, RemoteTables, SplitFun) -%%% -%%% Input: LocalTables = list of {TableName, Fields}. -%%% | list of {TableName, Recs, Fields} -%%% RemoteTable = list of {TableName, Fields}. -%%% SplitFun, CollectFun = As for format(Table, CollectFun, SplitFun). -%%% -%%% Output: Number of entries output. -%%% -%%% Description: Pretty-print records in a named tables as collected -%%% from local and remote nodes. Each table listing is -%%% preceeded by a banner. -%%% ---------------------------------------------------------- - -format(Local, Remote, SFun) -> - format(Local, Remote, SFun, fun tab2list/1). - -format(Local, Remote, SFun, CFun) - when is_list(Local), is_list(Remote), is_function(CFun, 1) -> - format_local(Local, SFun) + format(Remote, SFun, CFun). - -%%% ---------------------------------------------------------- -%%% # format(Tables, SplitFun) -%%% ---------------------------------------------------------- - -format(Tables, SFun) - when is_list(Tables), (is_function(SFun, 2) or is_function(SFun, 3)) -> - format(Tables, SFun, fun tab2list/1); - -format(Tables, CFun) - when is_list(Tables), is_function(CFun, 1) -> - format(Tables, fun split/2, CFun). - -%%% ---------------------------------------------------------- -%%% # format(Table|Tables) -%%% ---------------------------------------------------------- - -format(Table) - when is_atom(Table) -> - format(Table, [], fun split/2); - -format(Tables) - when is_list(Tables) -> - format(Tables, fun split/2, fun tab2list/1). - -%%% ---------------------------------------------------------- -%%% # split(TableName, Fields, Values) -%%% -%%% Description: format/3 SplitFun that does nothing special. -%%% ---------------------------------------------------------- - -split([F|FT], [V|VT]) -> - {F, FT, V, VT}. - -split(_, Fs, Vs) -> - split(Fs, Vs). - -%%% ---------------------------------------------------------- -%%% # tab2list(TableName) -%%% -%%% Description: format/4 CollectFun that extracts records from an -%%% existing ets table. -%%% ---------------------------------------------------------- - -tab2list(Table) -> - case ets:info(Table) of - undefined = No -> - No; - _ -> - ets:tab2list(Table) - end. - -list(Table) -> - l(tab2list(Table)). - -l(undefined = No) -> - No; -l(List) - when is_list(List) -> - io:format("~p~n", [List]), - length(List). - -%%% ---------------------------------------------------------- -%%% # table(TableName, Fields) -%%% ---------------------------------------------------------- - -table(Table, Fields) -> - format(Table, Fields, fun split/2). - -%%% ---------------------------------------------------------- -%%% # tables(LocalTables, RemoteTables) -%%% ---------------------------------------------------------- - -tables(Local, Remote) -> - format(Local, Remote, fun split/2). - -%%% ---------------------------------------------------------- -%%% # tables(Tables) -%%% ---------------------------------------------------------- - -tables(Tables) -> - format(Tables, fun split/2). - -%%% ---------------------------------------------------------- -%%% # modules(Prefix|Prefixes) -%%% -%%% Input: Prefix = atom() -%%% -%%% Description: Return the list of all loaded modules with the -%%% specified prefix. -%%% ---------------------------------------------------------- - -modules(Prefix) - when is_atom(Prefix) -> - lists:sort(mods(Prefix)); - -modules(Prefixes) - when is_list(Prefixes) -> - lists:sort(lists:flatmap(fun modules/1, Prefixes)). - -mods(Prefix) -> - P = atom_to_list(Prefix), - lists:filter(fun(M) -> - lists:prefix(P, atom_to_list(M)) - end, - erlang:loaded()). - -%%% ---------------------------------------------------------- -%%% # versions(Modules|Prefix) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List the versions of the specified modules. -%%% ---------------------------------------------------------- - -versions(Modules) -> - {SysInfo, OsInfo, ModInfo} = version_info(Modules), - sep(), - print_sys_info(SysInfo), - sep(), - print_os_info(OsInfo), - sep(), - print_mod_info(ModInfo), - sep(). - -%%% ---------------------------------------------------------- -%%% # attrs(Modules|Prefix, Attr|FormatFun) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List an attribute from module_info. -%%% ---------------------------------------------------------- - -attrs(Modules, Attr) - when is_atom(Attr) -> - attrs(Modules, fun(W,M) -> attr(W, M, Attr, fun attr/1) end); - -attrs(Modules, Fun) - when is_list(Modules) -> - sep(), - W = 2 + widest(Modules), - N = lists:foldl(fun(M,A) -> Fun(W,M), A+1 end, 0, Modules), - sep(), - N; - -attrs(Prefix, Fun) -> - attrs(modules(Prefix), Fun). - -%% attr/1 - -attr(T) when is_atom(T) -> - atom_to_list(T); -attr(N) when is_integer(N) -> - integer_to_list(N); -attr(V) -> - case is_list(V) andalso lists:all(fun is_char/1, V) of - true -> %% string - V; - false -> - io_lib:format("~p", [V]) - end. - -is_char(C) -> - 0 =< C andalso C < 256. - -%% attr/4 - -attr(Width, Mod, Attr, VFun) -> - io:format(": ~*s~s~n", [-Width, Mod, attr(Mod, Attr, VFun)]). - -attr(Mod, Attr, VFun) -> - Key = key(Attr), - try - VFun(val(Attr, keyfetch(Attr, Mod:module_info(Key)))) - catch - _:_ -> - "-" - end. - -attr(Mod, Attr) -> - attr(Mod, Attr, fun attr/1). - -key(time) -> compile; -key(_) -> attributes. - -val(time, {_,_,_,_,_,_} = T) -> - lists:flatten(io_lib:format("~p-~2..0B-~2..0B ~2..0B:~2..0B:~2..0B", - tuple_to_list(T))); -val(_, [V]) -> - V. - -%%% ---------------------------------------------------------- -%%% # compiled(Modules|Prefix) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List the compile times of the specified modules. -%%% ---------------------------------------------------------- - -compiled(Modules) - when is_list(Modules) -> - attrs(Modules, fun compiled/2); - -compiled(Prefix) -> - compiled(modules(Prefix)). - -compiled(Width, Mod) -> - io:format(": ~*s~19s ~s~n", [-Width, - Mod, - attr(Mod, time), - opt(attr(Mod, date))]). - -opt("-") -> - ""; -opt(D) -> - "(" ++ D ++ ")". - -%%% ---------------------------------------------------------- -%%% # procs(Pred|Prefix|Prefixes|Pid|Pids) -%%% -%%% Input: Pred = arity 2 fun returning true|false when applied to a -%%% pid and its process info. -%%% -%%% Output: Number of processes listed. -%%% -%%% Description: List process info for all local processes that test -%%% true with the specified predicate. With the prefix -%%% form, those processes that are either currently -%%% executing in, started executing in, or have a -%%% registered name with a specified prefix are listed. -%%% With the pid forms, only those process that are local -%%% are listed and those that are dead list only the pid -%%% itself. -%%% ---------------------------------------------------------- - -procs(Pred) - when is_function(Pred, 2) -> - procs(Pred, erlang:processes()); - -procs([]) -> - 0; - -procs(Prefix) - when is_atom(Prefix) -> - procs(fun(_,I) -> info(fun pre1/2, I, atom_to_list(Prefix)) end); - -procs(Prefixes) - when is_atom(hd(Prefixes)) -> - procs(fun(_,I) -> info(fun pre/2, I, Prefixes) end); - -procs(Pid) - when is_pid(Pid) -> - procs(fun true2/2, [Pid]); - -procs(Pids) - when is_list(Pids) -> - procs(fun true2/2, Pids). - -true2(_,_) -> - true. - -%% procs/2 - -procs(Pred, Pids) -> - Procs = lists:foldl(fun(P,A) -> - procs_acc(Pred, P, catch process_info(P), A) - end, - [], - Pids), - sep(0 < length(Procs)), - lists:foldl(fun(T,N) -> p(T), sep(), N+1 end, 0, Procs). - -procs_acc(_, Pid, undefined, Acc) -> %% dead - [[{pid, Pid}] | Acc]; -procs_acc(Pred, Pid, Info, Acc) - when is_list(Info) -> - p_acc(Pred(Pid, Info), Pid, Info, Acc); -procs_acc(_, _, _, Acc) -> - Acc. - -p_acc(true, Pid, Info, Acc) -> - [[{pid, Pid} | Info] | Acc]; -p_acc(false, _, _, Acc) -> - Acc. - -%% info/3 - -info(Pred, Info, T) -> - lists:any(fun(I) -> i(Pred, I, T) end, Info). - -i(Pred, {K, {M,_,_}}, T) - when K == current_function; - K == initial_call -> - Pred(M,T); -i(Pred, {registered_name, N}, T) -> - Pred(N,T); -i(_,_,_) -> - false. - -pre1(A, Pre) -> - lists:prefix(Pre, atom_to_list(A)). - -pre(A, Prefixes) -> - lists:any(fun(P) -> pre1(A, atom_to_list(P)) end, Prefixes). - -%%% ---------------------------------------------------------- -%%% # latest(Modules|Prefix) -%%% -%%% Output: {Mod, {Y,M,D,HH,MM,SS}, Version} -%%% -%%% Description: Return the compile time of the most recently compiled -%%% module from the specified non-empty list. The modules -%%% are assumed to exist. -%%% ---------------------------------------------------------- - -latest(Prefix) - when is_atom(Prefix) -> - latest(modules(Prefix)); - -latest([_|_] = Modules) -> - {Mod, T} - = hd(lists:sort(fun latest/2, lists:map(fun compile_time/1, Modules))), - {Mod, T, app_vsn(Mod)}. - -app_vsn(Mod) -> - keyfetch(app_vsn, Mod:module_info(attributes)). - -compile_time(Mod) -> - T = keyfetch(time, Mod:module_info(compile)), - {Mod, T}. - -latest({_,T1},{_,T2}) -> - T1 > T2. - -%%% ---------------------------------------------------------- -%%% version_info(Modules|Prefix) -%%% -%%% Output: {SysInfo, OSInfo, [ModInfo]} -%%% -%%% SysInfo = {Arch, Vers} -%%% OSInfo = {Vers, {Fam, Name}} -%%% ModInfo = {Vsn, AppVsn, Time, CompilerVsn} -%%% ---------------------------------------------------------- - -version_info(Prefix) - when is_atom(Prefix) -> - version_info(modules(Prefix)); - -version_info(Mods) - when is_list(Mods) -> - {sys_info(), os_info(), [{M, mod_version_info(M)} || M <- Mods]}. - -mod_version_info(Mod) -> - try - Info = Mod:module_info(), - [[Vsn], AppVsn] = get_values(attributes, [vsn, app_vsn], Info), - [Ver, Time] = get_values(compile, [version, time], Info), - [Vsn, AppVsn, Ver, Time] - catch - _:_ -> - [] - end. - -get_values(Attr, Keys, Info) -> - As = proplists:get_value(Attr, Info), - [proplists:get_value(K, As, "?") || K <- Keys]. - -sys_info() -> - [A,V] = [chomp(erlang:system_info(K)) || K <- [system_architecture, - system_version]], - {A,V}. - -os_info() -> - {os:version(), case os:type() of - {_Fam, _Name} = T -> - T; - Fam -> - {Fam, ""} - end}. - -chomp(S) -> - string:strip(S, right, $\n). - -print_sys_info({Arch, Ver}) -> - io:format("System info:~n" - " architecture : ~s~n" - " version : ~s~n", - [Arch, Ver]). - -print_os_info({Vsn, {Fam, Name}}) -> - io:format("OS info:~n" - " family : ~s ~s~n" - " version : ~s~n", - [str(Fam), bkt(str(Name)), vsn(Vsn)]). - -print_mod_info(Mods) -> - io:format("Module info:~n", []), - lists:foreach(fun print_mod/1, Mods). - -print_mod({Mod, []}) -> - io:format(" ~w:~n", [Mod]); -print_mod({Mod, [Vsn, AppVsn, Ver, {Year, Month, Day, Hour, Min, Sec}]}) -> - Time = io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", - [Year, Month, Day, Hour, Min, Sec]), - io:format(" ~w:~n" - " vsn : ~s~n" - " app_vsn : ~s~n" - " compiled : ~s~n" - " compiler : ~s~n", - [Mod, str(Vsn), str(AppVsn), Time, Ver]). - -str(A) - when is_atom(A) -> - atom_to_list(A); -str(S) - when is_list(S) -> - S; -str(T) -> - io_lib:format("~p", [T]). - -bkt("" = S) -> - S; -bkt(S) -> - [$[, S, $]]. - -vsn(T) when is_tuple(T) -> - case [[$., integer_to_list(N)] || N <- tuple_to_list(T)] of - [[$.,S] | Rest] -> - [S | Rest]; - [] = S -> - S - end; -vsn(T) -> - str(T). - -%%% ---------------------------------------------------------- -%%% ---------------------------------------------------------- - -%% p/1 - -p(Info) -> - W = 2 + widest([K || {K,_} <- Info]), - lists:foreach(fun({K,V}) -> p(W,K,V) end, Info). - -p(Width, Key, Value) -> - io:format(": ~*s: ~p~n", [-Width, Key, Value]). - -%% sep/[01] - -sep() -> - sep($#). - -sep(true) -> - sep(); -sep(false) -> - ok; - -sep(Ch) -> - io:format("~c~65c~n", [Ch, $-]). - -%% widest/1 - -widest(List) -> - lists:foldl(fun widest/2, 0, List). - -widest(T, Max) - when is_atom(T) -> - widest(atom_to_list(T), Max); - -widest(T, Max) - when is_integer(T) -> - widest(integer_to_list(T), Max); - -widest(T, Max) - when is_list(T) -> %% string - max(length(T), Max). - -pt(T) -> - io:format(": ~p~n", [T]). - -recsplit(SFun, Rec) -> - fun(Fs,Vs) -> SFun(element(1, Rec), Fs, Vs) end. - -max(A, B) -> - if A > B -> A; true -> B end. - -keyfetch(Key, List) -> - {Key,V} = lists:keyfind(Key, 1, List), - V. - -%% ft/4 - -ft(undefined = No, _, _, _) -> - No; - -ft(_, Table, SFun, Fields) -> - ets:foldl(fun(R,A) -> - f(SFun, 0, Fields, R, A) - end, - 0, - Table). - -%% f/5 - -f(SFun, Width, Fields, Rec, Count) -> - ff(SFun, Width, fields(Fields, Rec), Rec, Count). - -ff(SFun, Width, Fields, Rec, Count) -> - sep(0 == Count), - f(SFun, Width, Fields, Rec), - sep(), - Count+1. - -fields(N, _) - when is_integer(N), N >= 0 -> - lists:duplicate(N, ''); %% list values unadorned -fields(Fields, R) - when is_function(Fields, 1) -> - fields(Fields(R), R); -fields({Fields, Values} = T, _) - when length(Fields) == length(Values) -> - T; -fields(Fields, _) - when is_list(Fields) -> - Fields. %% list field/value pairs, or tuples if [] - -%% f/4 - -%% Empty fields list: just print the entry. -f(_, _, [], Rec) - when is_tuple(Rec) -> - pt(Rec); - -%% Otherwise list field names/values. -f(SFun, Width, {Fields, Values}, _) -> - f(SFun, Width, Fields, Values); - -f(SFun, Width, Fields, Rec) - when is_tuple(Rec) -> - f(SFun, Width, Fields, values(Fields, Rec)); - -f(_, _, [], []) -> - ok; - -f(SFun, Width, [HF | _] = Fields, Values) -> - {F, FT, V, VT} = SFun(Fields, Values), - if is_list(F) -> %% V is a record - break($>, HF), - f(SFun, Width, F, values(F,V)), - break($<, HF), - f(SFun, Width, FT, VT); - F == '' -> %% no field name: just list value - pt(V), - f(SFun, Width, FT, VT); - true -> %% list field/value. - W = max(Width, 1 + widest(Fields)), - p(W, F, V), - f(SFun, W, FT, VT) - end. - -values(Fields, Rec) - when length(Fields) == size(Rec) - 1 -> - ?VALUES(Rec); -values(Fields, T) - when length(Fields) == size(T) -> - tuple_to_list(T). - -%% format_local/2 - -format_local(Tables, SFun) -> - lists:foldl(fun(T,A) -> fl(SFun, T, A) end, 0, Tables). - -fl(SFun, {Table, Recs, Fields}, Count) -> - sep(), - io:format("# ~p~n", [Table]), - N = fmt(Recs, Fields, SFun), - sep(0 == N), - Count + N; - -fl(SFun, {Table, Fields}, Count) -> - fl(SFun, {Table, Table, Fields}, Count). - -%% fmt/3 - -fmt(T, Fields, SFun) -> - case format(T, Fields, SFun) of - undefined -> - 0; - N -> - N - end. - -%% break/2 - -break(C, T) -> - io:format("~c ~p~n", [C, T]). - -%% collect/2 -%% -%% Output: {[{TableName, Recs}, ...], node()} - -collect(CFun, TableNames) -> - {lists:foldl(fun(N,A) -> c(CFun, N, A) end, [], TableNames), node()}. - -c(CFun, TableName, Acc) -> - case CFun(TableName) of - Recs when is_list(Recs) -> - [{TableName, Recs} | Acc]; - _ -> - Acc - end. - -%% format_remote/3 - -format_remote(Tables, SFun, {Replies, BadNodes}) -> - N = lists:foldl(fun(T,A) -> fr(Tables, SFun, T, A) end, - 0, - Replies), - sep(0 == N andalso [] /= BadNodes), - lists:foreach(fun(Node) -> io:format("# no reply from ~p~n", [Node]) end, - BadNodes), - sep([] /= BadNodes), - N. - -fr(Tables, SFun, {List, Node}, Count) - when is_list(List) -> %% guard against {badrpc, Reason} - lists:foldl(fun({T,Recs}, C) -> fr(Tables, SFun, Node, T, Recs,C) end, - Count, - List); -fr(_, _, _, Count) -> - Count. - -fr(Tables, SFun, Node, Table, Recs, Count) -> - Fields = keyfetch(Table, Tables), - sep(), - io:format("# ~p@~p~n", [Table, Node]), - N = format(Recs, Fields, tblsplit(SFun, Table)), - sep(0 == N), - Count + N. - -tblsplit(SFun, Table) - when is_function(SFun, 3) -> - fun(Fs,Vs) -> SFun(Table, Fs, Vs) end; -tblsplit(SFun, _) - when is_function(SFun, 2) -> - SFun. - -%% compact/1 -%% -%% Strip whitespace from both ends of a string. - -compact(Str) -> - compact(Str, true). - -compact([Ch|Rest], B) - when Ch == $\n; - Ch == $ ; - Ch == $\t; - Ch == $\v; - Ch == $\r -> - compact(Rest, B); - -compact(Str, false) -> - Str; - -compact(Str, true) -> - lists:reverse(compact(lists:reverse(Str), false)). diff --git a/lib/diameter/src/app/diameter_internal.hrl b/lib/diameter/src/app/diameter_internal.hrl deleted file mode 100644 index 63b35550a8..0000000000 --- a/lib/diameter/src/app/diameter_internal.hrl +++ /dev/null @@ -1,80 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% Our Erlang application. --define(APPLICATION, diameter). - -%% The one and only. --define(DIAMETER_VERSION, 1). - -%% Exception for use within a module with decent protection against -%% catching something we haven't thrown. Not foolproof but close -%% enough. ?MODULE is rudmentary protection against catching across -%% module boundaries, a root of much evil: always catch ?FAILURE(X), -%% never X. --define(FAILURE(Reason), {{?MODULE}, {Reason}}). --define(THROW(Reason), throw(?FAILURE(Reason))). - -%% A corresponding error when failure is the best option. --define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). - -%% Failure reports always get a stack trace. --define(STACK, erlang:get_stacktrace()). - -%% Warning report for unexpected messages in various processes. --define(UNEXPECTED(F,A), - diameter_lib:warning_report(unexpected, {?MODULE, F, A})). --define(UNEXPECTED(A), ?UNEXPECTED(?FUNC, A)). - -%% Something to trace on. --define(LOG(Slogan, Details), - diameter_lib:log(Slogan, ?MODULE, ?LINE, Details)). --define(LOGC(Bool, Slogan, Details), ((Bool) andalso ?LOG(Slogan, Details))). - -%% Compensate for no builtin ?FUNC for use in log reports. --define(FUNC, element(2, element(2, process_info(self(), current_function)))). - -%% Disjunctive match spec condition. 'false' is to ensure that there's at -%% least one condition. --define(ORCOND(List), list_to_tuple(['orelse', false | List])). - -%% 3588, 2.4: --define(APP_ID_COMMON, 0). --define(APP_ID_RELAY, 16#FFFFFFFF). - --define(BASE, diameter_gen_base_rfc3588). - -%%% --------------------------------------------------------- - -%%% RFC 3588, ch 2.6 Peer table --record(diameter_peer, - {host_id, - statusT, - is_dynamic, - expiration, - tls_enabled}). - -%%% RFC 3588, ch 2.7 Realm-based routing table --record(diameter_realm, - {name, - app_id, - local_action, % LOCAL | RELAY | PROXY | REDIRECT - server_id, - is_dynamic, - expiration}). diff --git a/lib/diameter/src/app/diameter_lib.erl b/lib/diameter/src/app/diameter_lib.erl deleted file mode 100644 index 362d593b24..0000000000 --- a/lib/diameter/src/app/diameter_lib.erl +++ /dev/null @@ -1,272 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_lib). - --export([report/2, info_report/2, - error_report/2, - warning_report/2, - now_diff/1, - time/1, - eval/1, - ip4address/1, - ip6address/1, - ipaddr/1, - spawn_opts/2, - wait/1, - fold_tuple/3, - log/4]). - --include("diameter_internal.hrl"). - -%% --------------------------------------------------------------------------- -%% # info_report(Reason, MFA) -%% -%% Input: Reason = Arbitrary term indicating the reason for the report. -%% MFA = {Module, Function, Args} to report. -%% -%% Output: true -%% --------------------------------------------------------------------------- - -report(Reason, MFA) -> - info_report(Reason, MFA). - -info_report(Reason, MFA) -> - report(fun error_logger:info_report/1, Reason, MFA), - true. - -%%% --------------------------------------------------------------------------- -%%% # error_report(Reason, MFA) -%%% # warning_report(Reason, MFA) -%%% -%%% Output: false -%%% --------------------------------------------------------------------------- - -error_report(Reason, MFA) -> - report(fun error_logger:error_report/1, Reason, MFA). - -warning_report(Reason, MFA) -> - report(fun error_logger:warning_report/1, Reason, MFA). - -report(Fun, Reason, MFA) -> - Fun([{why, Reason}, {who, self()}, {what, MFA}]), - false. - -%%% --------------------------------------------------------------------------- -%%% # now_diff(Time) -%%% -%%% Description: Return timer:now_diff(now(), Time) as an {H, M, S, MicroS} -%%% tuple instead of as integer microseconds. -%%% --------------------------------------------------------------------------- - -now_diff({_,_,_} = Time) -> - time(timer:now_diff(erlang:now(), Time)). - -%%% --------------------------------------------------------------------------- -%%% # time(Time) -%%% -%%% Input: Time = {MegaSec, Sec, MicroSec} -%%% | MicroSec -%%% -%%% Output: {H, M, S, MicroS} -%%% --------------------------------------------------------------------------- - -time({_,_,_} = Time) -> %% time of day - %% 24 hours = 24*60*60*1000000 = 86400000000 microsec - time(timer:now_diff(Time, {0,0,0}) rem 86400000000); - -time(Micro) -> %% elapsed time - Seconds = Micro div 1000000, - H = Seconds div 3600, - M = (Seconds rem 3600) div 60, - S = Seconds rem 60, - {H, M, S, Micro rem 1000000}. - -%%% --------------------------------------------------------------------------- -%%% # eval(Func) -%%% --------------------------------------------------------------------------- - -eval({M,F,A}) -> - apply(M,F,A); - -eval([{M,F,A} | X]) -> - apply(M, F, X ++ A); - -eval([[F|A] | X]) -> - eval([F | X ++ A]); - -eval([F|A]) -> - apply(F,A); - -eval({F}) -> - eval(F); - -eval(F) -> - F(). - -%%% --------------------------------------------------------------------------- -%%% # ip4address(Addr) -%%% -%%% Input: string() (eg. "10.0.0.1") -%%% | list of integer() -%%% | tuple of integer() -%%% -%%% Output: {_,_,_,_} of integer -%%% -%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - -ip4address([_,_,_,_] = Addr) -> %% Length 4 string can't be an address. - ipaddr(list_to_tuple(Addr)); - -%% Be brutal. -ip4address(Addr) -> - try - {_,_,_,_} = ipaddr(Addr) - catch - error: _ -> - erlang:error({invalid_address, Addr, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # ip6address(Addr) -%%% -%%% Input: string() (eg. "1080::8:800:200C:417A") -%%% | list of integer() -%%% | tuple of integer() -%%% -%%% Output: {_,_,_,_,_,_,_,_} of integer -%%% -%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - -ip6address([_,_,_,_,_,_,_,_] = Addr) -> %% Length 8 string can't be an address. - ipaddr(list_to_tuple(Addr)); - -%% Be brutal. -ip6address(Addr) -> - try - {_,_,_,_,_,_,_,_} = ipaddr(Addr) - catch - error: _ -> - erlang:error({invalid_address, Addr, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # ipaddr(Addr) -%%% -%%% Input: string() | tuple of integer() -%%% -%%% Output: {_,_,_,_} | {_,_,_,_,_,_,_,_} -%%% -%%% Exceptions: error: {invalid_address, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - --spec ipaddr(string() | tuple()) - -> inet:ip_address(). - -%% Don't convert lists of integers since a length 8 list like -%% [$1,$0,$.,$0,$.,$0,$.,$1] is ambiguous: is it "10.0.0.1" or -%% "49:48:46:48:46:48:46:49"? -%% -%% RFC 2373 defines the format parsed for v6 addresses. - -%% Be brutal. -ipaddr(Addr) -> - try - ip(Addr) - catch - error: _ -> - erlang:error({invalid_address, ?STACK}) - end. - -%% Already a tuple: ensure non-negative integers of the right size. -ip(T) - when size(T) == 4; - size(T) == 8 -> - Bs = 2*size(T), - [] = lists:filter(fun(N) when 0 =< N -> 0 < N bsr Bs end, - tuple_to_list(T)), - T; - -%% Or not: convert from '.'/':'-separated decimal/hex. -ip(Addr) -> - {ok, A} = inet_parse:address(Addr), %% documented in inet(3) - A. - -%%% --------------------------------------------------------------------------- -%%% # spawn_opts(Type, Opts) -%%% --------------------------------------------------------------------------- - -%% TODO: config variables. - -spawn_opts(server, Opts) -> - opts(75000, Opts); -spawn_opts(worker, Opts) -> - opts(5000, Opts). - -opts(HeapSize, Opts) -> - [{min_heap_size, HeapSize} | lists:keydelete(min_heap_size, 1, Opts)]. - -%%% --------------------------------------------------------------------------- -%%% # wait(MRefs) -%%% --------------------------------------------------------------------------- - -wait(L) -> - w([erlang:monitor(process, P) || P <- L]). - -w([]) -> - ok; -w(L) -> - receive - {'DOWN', MRef, process, _, _} -> - w(lists:delete(MRef, L)) - end. - -%%% --------------------------------------------------------------------------- -%%% # fold_tuple(N, T0, T) -%%% --------------------------------------------------------------------------- - -%% Replace fields in T0 by those of T starting at index N, unless the -%% new value is 'undefined'. -%% -%% eg. fold_tuple(2, Hdr, #diameter_header{end_to_end_id = 42}) - -fold_tuple(_, T, undefined) -> - T; - -fold_tuple(N, T0, T1) -> - {_, T} = lists:foldl(fun(V, {I,_} = IT) -> {I+1, ft(V, IT)} end, - {N, T0}, - lists:nthtail(N-1, tuple_to_list(T1))), - T. - -ft(undefined, {_, T}) -> - T; -ft(Value, {Idx, T}) -> - setelement(Idx, T, Value). - -%%% ---------------------------------------------------------- -%%% # log(Slogan, Mod, Line, Details) -%%% -%%% Called to have something to trace on for happenings of interest. -%%% ---------------------------------------------------------- - -log(_, _, _, _) -> - ok. diff --git a/lib/diameter/src/app/diameter_misc_sup.erl b/lib/diameter/src/app/diameter_misc_sup.erl deleted file mode 100644 index 4e40476f14..0000000000 --- a/lib/diameter/src/app/diameter_misc_sup.erl +++ /dev/null @@ -1,58 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The supervisor of the static server processes. -%% - --module(diameter_misc_sup). - --behaviour(supervisor). - --export([start_link/0]). %% supervisor start - -%% supervisor callback --export([init/1]). - --define(CHILDREN, [diameter_sync, %% serialization - diameter_stats, %% statistics counter management - diameter_reg, %% service/property publishing - diameter_peer, %% remote peer manager - diameter_config]). %% configuration/restart - -%% start_link/0 - -start_link() -> - SupName = {local, ?MODULE}, - supervisor:start_link(SupName, ?MODULE, []). - -%% init/1 - -init([]) -> - Flags = {one_for_one, 1, 5}, - Workers = lists:map(fun spec/1, ?CHILDREN), - {ok, {Flags, Workers}}. - -spec(Mod) -> - {Mod, - {Mod, start_link, []}, - permanent, - 1000, - worker, - [Mod]}. diff --git a/lib/diameter/src/app/diameter_peer.erl b/lib/diameter/src/app/diameter_peer.erl deleted file mode 100644 index 3e78c4caef..0000000000 --- a/lib/diameter/src/app/diameter_peer.erl +++ /dev/null @@ -1,225 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_peer). - --behaviour(gen_server). - -%% Interface towards transport modules ... --export([recv/2, - up/1, - up/2]). - -%% ... and the stack. --export([start/3, - send/2, - close/1, - abort/1, - notify/2]). - -%% Server start. --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% debug --export([state/0, - uptime/0]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - -%% Registered name of the server. --define(SERVER, ?MODULE). - -%% Server state. --record(state, {id = now()}). - -%%% --------------------------------------------------------------------------- -%%% # notify/2 -%%% --------------------------------------------------------------------------- - -notify(SvcName, T) -> - rpc:abcast(nodes(), ?SERVER, {notify, SvcName, T}). - -%%% --------------------------------------------------------------------------- -%%% # start/3 -%%% --------------------------------------------------------------------------- - -start(T, Opts, #diameter_service{} = Svc) -> - {Mod, Cfg} = split_transport(Opts), - apply(Mod, start, [T, Svc, Cfg]). - -%%% --------------------------------------------------------------------------- -%%% # up/[12] -%%% --------------------------------------------------------------------------- - -up(Pid) -> %% accepting transport - ifc_send(Pid, {self(), connected}). - -up(Pid, Remote) -> %% connecting transport - ifc_send(Pid, {self(), connected, Remote}). - -%%% --------------------------------------------------------------------------- -%%% # recv/2 -%%% --------------------------------------------------------------------------- - -recv(Pid, Pkt) -> - ifc_send(Pid, {recv, Pkt}). - -%%% --------------------------------------------------------------------------- -%%% # send/2 -%%% --------------------------------------------------------------------------- - -send(Pid, #diameter_packet{transport_data = undefined, - bin = Bin}) -> - send(Pid, Bin); - -send(Pid, Pkt) -> - ifc_send(Pid, {send, Pkt}). - -%%% --------------------------------------------------------------------------- -%%% # close/1 -%%% --------------------------------------------------------------------------- - -close(Pid) -> - ifc_send(Pid, {close, self()}). - -%%% --------------------------------------------------------------------------- -%%% # abort/1 -%%% --------------------------------------------------------------------------- - -abort(Pid) -> - exit(Pid, shutdown). - -%% --------------------------------------------------------------------------- -%% --------------------------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init(Role) -%%% ---------------------------------------------------------- - -init([]) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info(Request, State) -%%% ---------------------------------------------------------- - -%% Remote service is distributing a message. -handle_info({notify, SvcName, T}, S) -> - bang(diameter_service:whois(SvcName), T), - {noreply, S}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% terminate(Reason, State) -%% ---------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%% ---------------------------------------------------------- -%% code_change(OldVsn, State, Extra) -%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -%% ifc_send/2 -%% -%% Send something over the transport interface. - -ifc_send(Pid, T) -> - Pid ! {diameter, T}. - -%% bang/2 - -bang(undefined = No, _) -> - No; -bang(Pid, T) -> - Pid ! T. - -%% split_transport/1 -%% -%% Split options into transport module, transport config and -%% remaining options. - -split_transport(Opts) -> - {[M,C], _} = proplists:split(Opts, [transport_module, - transport_config]), - {value(M, diameter_tcp), value(C, [])}. - -value([{_,V}], _) -> - V; -value([], V) -> - V. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/app/diameter_peer_fsm.erl deleted file mode 100644 index 282fa2742f..0000000000 --- a/lib/diameter/src/app/diameter_peer_fsm.erl +++ /dev/null @@ -1,777 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module implements (as a process) the RFC 3588 Peer State -%% Machine modulo the necessity of adapting the peer election to the -%% fact that we don't know the identity of a peer until we've -%% received a CER/CEA from it. -%% - --module(diameter_peer_fsm). --behaviour(gen_server). - -%% Interface towards diameter_watchdog. --export([start/3]). - -%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% diameter_peer_fsm_sup callback --export([start_link/1]). - -%% internal callbacks --export([match/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). --include("diameter_gen_base_rfc3588.hrl"). - --define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). --define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). - --define(NO_INBAND_SECURITY, 0). --define(TLS, 1). - --define(LOOP_TIMEOUT, 2000). - -%% RFC 3588: -%% -%% Timeout An application-defined timer has expired while waiting -%% for some event. -%% --define(EVENT_TIMEOUT, 10000). - -%% How long to wait for a DPA in response to DPR before simply -%% aborting. Used to distinguish between shutdown and not but there's -%% not really any need. Stopping a service will require a timeout if -%% the peer doesn't answer DPR so the value should be short-ish. --define(DPA_TIMEOUT, 1000). - --record(state, - {state = 'Wait-Conn-Ack' %% state of RFC 3588 Peer State Machine - :: 'Wait-Conn-Ack' | recv_CER | 'Wait-CEA' | 'Open', - mode :: accept | connect | {connect, reference()}, - parent :: pid(), - transport :: pid(), - service :: #diameter_service{}, - dpr = false :: false | {'Unsigned32'(), 'Unsigned32'()}}). - %% | hop by hop and end to end identifiers - -%% There are non-3588 states possible as a consequence of 5.6.1 of the -%% standard and the corresponding problem for incoming CEA's: we don't -%% know who we're talking to until either a CER or CEA has been -%% received. The CEA problem in particular makes it impossible to -%% follow the state machine exactly as documented in 3588: there can -%% be no election until the CEA arrives and we have an Origin-Host to -%% elect. - -%% -%% Once upon a time start/2 started a process akin to that started by -%% start/3 below, which in turn started a watchdog/transport process -%% with the result that the watchdog could send DWR/DWA regardless of -%% whether or not the corresponding Peer State Machine was in its open -%% state; that is, before capabilities exchange had taken place. This -%% is not what RFC's 3588 and 3539 say (albeit not very clearly). -%% Watchdog messages are only exchanged on *open* connections, so the -%% 3539 state machine is more naturally placed on top of the 3588 Peer -%% State Machine rather than closer to the transport. This is what we -%% now do below: connect/accept call diameter_watchdog and return the -%% pid of the watchdog process, and the watchdog in turn calls start/3 -%% below to start the process implementing the Peer State Machine. The -%% former is a "peer" in diameter_service while the latter is a -%% "conn". In a sense, diameter_service sees the watchdog as -%% implementing the Peer State Machine and the process implemented -%% here as being the transport, not being aware of the watchdog at -%% all. -%% - -%%% --------------------------------------------------------------------------- -%%% # start({connect|accept, Ref}, Opts, Service) -%%% -%%% Output: Pid -%%% --------------------------------------------------------------------------- - -%% diameter_config requires a non-empty list of applications on the -%% service but diameter_service then constrains the list to any -%% specified on the transport in question. Check here that the list is -%% still non-empty. - -start({_, Ref} = Type, Opts, #diameter_service{applications = Apps} = Svc) -> - [] /= Apps orelse ?ERROR({no_apps, Type, Opts}), - T = {self(), Type, Opts, Svc}, - {ok, Pid} = diameter_peer_fsm_sup:start_child(T), - diameter_stats:reg(Pid, Ref), - Pid. - -start_link(T) -> - {ok, _} = proc_lib:start_link(?MODULE, - init, - [T], - infinity, - diameter_lib:spawn_opts(server, [])). - -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- - -%% init/1 - -init(T) -> - proc_lib:init_ack({ok, self()}), - gen_server:enter_loop(?MODULE, [], i(T)). - -i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> - putr(dwa, dwa(Caps)), - {ok, TPid, Svc} = start_transport(T, Opts, Svc0), - erlang:monitor(process, TPid), - erlang:monitor(process, WPid), - #state{parent = WPid, - transport = TPid, - mode = M, - service = Svc}. -%% The transport returns its local ip addresses so that different -%% transports on the same service can use different local addresses. -%% The local addresses are put into Host-IP-Address avps here when -%% sending capabilities exchange messages. -%% -%% Invalid transport config may cause us to crash but note that the -%% watchdog start (start/2) succeeds regardless so as not to crash the -%% service. - -start_transport(T, Opts, Svc) -> - case diameter_peer:start(T, Opts, Svc) of - {ok, TPid} -> - {ok, TPid, Svc}; - {ok, TPid, [_|_] = Addrs} -> - #diameter_service{capabilities = Caps0} = Svc, - Caps = Caps0#diameter_caps{host_ip_address = Addrs}, - {ok, TPid, Svc#diameter_service{capabilities = Caps}}; - No -> - exit({shutdown, No}) - end. - -%% handle_call/3 - -handle_call(_, _, State) -> - {reply, nok, State}. - -%% handle_cast/2 - -handle_cast(_, State) -> - {noreply, State}. - -%% handle_info/1 - -handle_info(T, #state{} = State) -> - try transition(T, State) of - ok -> - {noreply, State}; - #state{state = X} = S -> - ?LOGC(X =/= State#state.state, transition, X), - {noreply, S}; - {stop, Reason} -> - ?LOG(stop, Reason), - x(Reason, State); - stop -> - ?LOG(stop, T), - x(T, State) - catch - throw: {?MODULE, Tag, Reason} -> - ?LOG(Tag, {Reason, T}), - {stop, {shutdown, Reason}, State} - end. - -x(Reason, #state{} = S) -> - close_wd(Reason, S), - {stop, {shutdown, Reason}, S}. - -%% terminate/2 - -terminate(_, _) -> - ok. - -%% code_change/3 - -code_change(_, State, _) -> - {ok, State}. - -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- - -putr(Key, Val) -> - put({?MODULE, Key}, Val). - -getr(Key) -> - get({?MODULE, Key}). - -%% transition/2 - -%% Connection to peer. -transition({diameter, {TPid, connected, Remote}}, - #state{state = PS, - mode = M} - = S) -> - 'Wait-Conn-Ack' = PS, %% assert - connect = M, %% - send_CER(S#state{mode = {M, Remote}, - transport = TPid}); - -%% Connection from peer. -transition({diameter, {TPid, connected}}, - #state{state = PS, - mode = M, - parent = Pid} - = S) -> - 'Wait-Conn-Ack' = PS, %% assert - accept = M, %% - Pid ! {accepted, self()}, - start_timer(S#state{state = recv_CER, - transport = TPid}); - -%% Incoming message from the transport. -transition({diameter, {recv, Pkt}}, S) -> - recv(Pkt, S); - -%% Timeout when still in the same state ... -transition({timeout, PS}, #state{state = PS}) -> - stop; - -%% ... or not. -transition({timeout, _}, _) -> - ok; - -%% Outgoing message. -transition({send, Msg}, #state{transport = TPid}) -> - send(TPid, Msg), - ok; - -%% Request for graceful shutdown. -transition({shutdown, Pid}, #state{parent = Pid, dpr = false} = S) -> - dpr(?GOAWAY, S); -transition({shutdown, Pid}, #state{parent = Pid}) -> - ok; - -%% Application shutdown. -transition(shutdown, #state{dpr = false} = S) -> - dpr(?REBOOT, S); -transition(shutdown, _) -> %% DPR already send: ensure expected timeout - dpa_timer(), - ok; - -%% Request to close the transport connection. -transition({close = T, Pid}, #state{parent = Pid, - transport = TPid}) -> - diameter_peer:close(TPid), - {stop, T}; - -%% DPA reception has timed out. -transition(dpa_timeout, _) -> - stop; - -%% Someone wants to know a resolved port: forward to the transport process. -transition({resolve_port, _Pid} = T, #state{transport = TPid}) -> - TPid ! T, - ok; - -%% Parent or transport has died. -transition({'DOWN', _, process, P, _}, - #state{parent = Pid, - transport = TPid}) - when P == Pid; - P == TPid -> - stop; - -%% State query. -transition({state, Pid}, #state{state = S, transport = TPid}) -> - Pid ! {self(), [S, TPid]}, - ok. - -%% Crash on anything unexpected. - -%% send_CER/1 - -send_CER(#state{mode = {connect, Remote}, - service = #diameter_service{capabilities = Caps}, - transport = TPid} - = S) -> - req_send_CER(Caps#diameter_caps.origin_host, Remote) - orelse - close(connected, S), - CER = build_CER(S), - ?LOG(send, 'CER'), - send(TPid, encode(CER)), - start_timer(S#state{state = 'Wait-CEA'}). - -%% Register ourselves as connecting to the remote endpoint in -%% question. This isn't strictly necessary since a peer implementing -%% the 3588 Peer State Machine should reject duplicate connection's -%% from the same peer but there's little point in us setting up a -%% duplicate connection in the first place. This could also include -%% the transport protocol being used but since we're blind to -%% transport just avoid duplicate connections to the same host/port. -req_send_CER(OriginHost, Remote) -> - register_everywhere({?MODULE, connection, OriginHost, {remote, Remote}}). - -%% start_timer/1 - -start_timer(#state{state = PS} = S) -> - erlang:send_after(?EVENT_TIMEOUT, self(), {timeout, PS}), - S. - -%% build_CER/1 - -build_CER(#state{service = #diameter_service{capabilities = Caps}}) -> - {ok, CER} = diameter_capx:build_CER(Caps), - CER. - -%% encode/1 - -encode(Rec) -> - #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Rec), - Bin. - -%% recv/2 - -%% RFC 3588 has result code 5015 for an invalid length but if a -%% transport is detecting message boundaries using the length header -%% then a length error will likely lead to further errors. - -recv(#diameter_packet{header = #diameter_header{length = Len} - = Hdr, - bin = Bin}, - S) - when Len < 20; - (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) -> - discard(invalid_message_length, recv, [size(Bin), - bit_size(Bin) rem 8, - Hdr, - S]); - -recv(#diameter_packet{header = #diameter_header{} = Hdr} - = Pkt, - #state{parent = Pid} - = S) -> - Name = diameter_codec:msg_name(Hdr), - Pid ! {recv, self(), Name, Pkt}, - diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received - rcv(Name, Pkt, S); - -recv(#diameter_packet{header = undefined, - bin = Bin} - = Pkt, - S) -> - recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S); - -recv(Bin, S) - when is_binary(Bin) -> - recv(#diameter_packet{bin = Bin}, S); - -recv(#diameter_packet{header = false} = Pkt, S) -> - discard(truncated_header, recv, [Pkt, S]). - -msg_id({_,_,_} = T, _) -> - T; -msg_id(_, Hdr) -> - diameter_codec:msg_id(Hdr). - -%% Treat invalid length as a transport error and die. Especially in -%% the TCP case, in which there's no telling where the next message -%% begins in the incoming byte stream, keeping a crippled connection -%% alive may just make things worse. - -discard(Reason, F, A) -> - diameter_stats:incr(Reason), - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - throw({?MODULE, abort, Reason}). - -%% rcv/3 - -%% Incoming CEA. -rcv('CEA', Pkt, #state{state = 'Wait-CEA'} = S) -> - handle_CEA(Pkt, S); - -%% Incoming CER -rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> - handle_request(N, Pkt, S); - -%% Anything but CER/CEA in a non-Open state is an error, as is -%% CER/CEA in anything but recv_CER/Wait-CEA. -rcv(Name, _, #state{state = PS}) - when PS /= 'Open'; - Name == 'CER'; - Name == 'CEA' -> - {stop, {Name, PS}}; - -rcv(N, Pkt, S) - when N == 'DWR'; - N == 'DPR' -> - handle_request(N, Pkt, S); - -%% DPA even though we haven't sent DPR: ignore. -rcv('DPA', _Pkt, #state{dpr = false}) -> - ok; - -%% DPA in response to DPR. We could check the sequence numbers but -%% don't bother, just close. -rcv('DPA' = N, _Pkt, #state{transport = TPid}) -> - diameter_peer:close(TPid), - {stop, N}; - -rcv(_, _, _) -> - ok. - -%% send/2 - -%% Msg here could be a #diameter_packet or a binary depending on who's -%% sending. In particular, the watchdog will send DWR as a binary -%% while messages coming from clients will be in a #diameter_packet. -send(Pid, Msg) -> - diameter_stats:incr({diameter_codec:msg_id(Msg), send}), - diameter_peer:send(Pid, Msg). - -%% handle_request/3 - -handle_request(Type, #diameter_packet{} = Pkt, S) -> - ?LOG(recv, Type), - send_answer(Type, diameter_codec:decode(?BASE, Pkt), S). - -%% send_answer/3 - -send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> - #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, - transport_data = TD} - = ReqPkt, - - {Answer, PostF} = build_answer(Type, V, ReqPkt, S), - - Pkt = #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, - msg = Answer, - transport_data = TD}, - - send(TPid, diameter_codec:encode(?BASE, Pkt)), - eval(PostF, S). - -eval([F|A], S) -> - apply(F, A ++ [S]); -eval(ok, S) -> - S. - -%% build_answer/4 - -build_answer('CER', - ?DIAMETER_VERSION, - #diameter_packet{msg = CER, - header = #diameter_header{is_error = false}, - errors = []} - = Pkt, - #state{service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH}} - = Svc, - - {SupportedApps, - #diameter_caps{origin_host = DH} = RCaps, - #diameter_base_CEA{'Result-Code' = RC} - = CEA} - = recv_CER(CER, S), - - try - 2001 == RC %% DIAMETER_SUCCESS - orelse ?THROW({sent_CEA, RC}), - register_everywhere({?MODULE, connection, OH, DH}) - orelse ?THROW({election_lost, 4003}), - #diameter_base_CEA{'Inband-Security-Id' = [IS]} - = CEA, - {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]} - catch - ?FAILURE({Reason, RC}) -> - {answer('CER', S) ++ [{'Result-Code', RC}], - [fun close/2, {'CER', Reason, DH}]} - end; - -%% The error checks below are similar to those in diameter_service for -%% other messages. Should factor out the commonality. - -build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) -> - FailedAvp = failed_avp([A || {_,A} <- Es]), - Ans = answer(answer(Type, S), V, H, Es), - {set(Ans, FailedAvp), if 'CER' == Type -> - [fun close/2, {Type, V, Pkt}]; - true -> - ok - end}. - -failed_avp([] = No) -> - No; -failed_avp(Avps) -> - [{'Failed-AVP', [[{'AVP', Avps}]]}]. - -set(Ans, []) -> - Ans; -set(['answer-message' | _] = Ans, FailedAvp) -> - Ans ++ [{'AVP', [FailedAvp]}]; -set([_|_] = Ans, FailedAvp) -> - Ans ++ FailedAvp. - -answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) -> - ['answer-message', OH, OR, {'Result-Code', 3008}]; - -answer([_, OH, OR | _], _, _, [Bs|_]) - when is_bitstring(Bs) -> - ['answer-message', OH, OR, {'Result-Code', 3009}]; - -answer(Ans, ?DIAMETER_VERSION, _, Es) -> - Ans ++ [{'Result-Code', rc(Es)}]; - -answer(Ans, _, _, _) -> - Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION - -rc([]) -> - 2001; %% DIAMETER_SUCCESS -rc([{RC,_}|_]) -> - RC; -rc([RC|_]) -> - RC. - -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. - -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. - -%% ELECTION_LOST 4003 -%% The peer has determined that it has lost the election process and -%% has therefore disconnected the transport connection. - -%% DIAMETER_NO_COMMON_APPLICATION 5010 -%% This error is returned when a CER message is received, and there -%% are no common applications supported between the peers. - -%% DIAMETER_UNSUPPORTED_VERSION 5011 -%% This error is returned when a request was received, whose version -%% number is unsupported. - -%% answer/2 - -answer('DWR', _) -> - getr(dwa); - -answer(Name, #state{service = #diameter_service{capabilities = Caps}}) -> - a(Name, Caps). - -a('CER', #diameter_caps{vendor_id = Vid, - origin_host = Host, - origin_realm = Realm, - host_ip_address = Addrs, - product_name = Name}) -> - ['CEA', {'Origin-Host', Host}, - {'Origin-Realm', Realm}, - {'Host-IP-Address', Addrs}, - {'Vendor-Id', Vid}, - {'Product-Name', Name}]; - -a('DPR', #diameter_caps{origin_host = Host, - origin_realm = Realm}) -> - ['DPA', {'Origin-Host', Host}, - {'Origin-Realm', Realm}]. - -%% recv_CER/2 - -recv_CER(CER, #state{service = Svc}) -> - {ok, T} = diameter_capx:recv_CER(CER, Svc), - T. - -%% handle_CEA/1 - -handle_CEA(#diameter_packet{header = #diameter_header{version = V}, - bin = Bin} - = Pkt, - #state{service = #diameter_service{capabilities = LCaps}} - = S) - when is_binary(Bin) -> - ?LOG(recv, 'CEA'), - - ?DIAMETER_VERSION == V orelse close({version, V}, S), - - #diameter_packet{msg = CEA, errors = Errors} - = DPkt - = diameter_codec:decode(?BASE, Pkt), - - [] == Errors orelse close({errors, Errors}, S), - - {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps} - = recv_CEA(CEA, S), - - #diameter_caps{origin_host = OH} - = LCaps, - - %% Ensure that we don't already have a connection to the peer in - %% question. This isn't the peer election of 3588 except in the - %% sense that, since we don't know who we're talking to until we - %% receive a CER/CEA, the first that arrives wins the right to a - %% connection with the peer. - - register_everywhere({?MODULE, connection, OH, DH}) - orelse close({'CEA', DH}, S), - - open(DPkt, SApps, RCaps, {connect, IS}, S). - -%% recv_CEA/2 - -recv_CEA(CEA, #state{service = Svc} = S) -> - case diameter_capx:recv_CEA(CEA, Svc) of - {ok, {_,_}} -> %% return from old code - close({'CEA', update}, S); - {ok, {[], _, _}} -> - close({'CEA', no_common_application}, S); - {ok, {_, [], _}} -> - close({'CEA', no_common_security}, S); - {ok, {_,_,_} = T} -> - T; - {error, Reason} -> - close({'CEA', Reason}, S) - end. - -%% open/5 - -open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid, - service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH, - inband_security_id = LS} - = LCaps} - = Svc, - #diameter_caps{origin_host = DH} - = RCaps, - - tls_ack(lists:member(?TLS, LS), Type, IS, S), - Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, - - S#state{state = 'Open'}. - -%% We've advertised TLS support: tell the transport the result -%% and expect a reply when the handshake is complete. -tls_ack(true, Type, IS, #state{transport = TPid} = S) -> - Ref = make_ref(), - MRef = erlang:monitor(process, TPid), - TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, - receive - {diameter, {tls, Ref}} -> - erlang:demonitor(MRef, [flush]); - {'DOWN', MRef, process, _, _} = T -> - close({tls_ack, T}, S) - end; - -%% Or not. Don't send anything to the transport so that transports -%% not supporting TLS work as before without modification. -tls_ack(false, _, _, _) -> - ok. - -capz(#diameter_caps{} = L, #diameter_caps{} = R) -> - #diameter_caps{} - = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), - tl(tuple_to_list(R)))]). - -%% close/2 - -%% Tell the watchdog that our death isn't due to transport failure. -close(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid), - throw({?MODULE, close, Reason}). - -%% close_wd/2 - -%% Ensure the watchdog dies if DPR has been sent ... -close_wd(_, #state{dpr = false}) -> - ok; -close_wd(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid); - -%% ... or otherwise -close_wd(Reason, Pid) -> - Pid ! {close, self(), Reason}. - -%% dwa/1 - -dwa(#diameter_caps{origin_host = OH, - origin_realm = OR, - origin_state_id = OSI}) -> - ['DWA', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Origin-State-Id', OSI}]. - -%% dpr/2 - -dpr(Cause, #state{transport = TPid, - service = #diameter_service{capabilities = Caps}} - = S) -> - #diameter_caps{origin_host = OH, - origin_realm = OR} - = Caps, - - Bin = encode(['DPR', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Disconnect-Cause', Cause}]), - send(TPid, Bin), - dpa_timer(), - ?LOG(send, 'DPR'), - S#state{dpr = diameter_codec:sequence_numbers(Bin)}. - -dpa_timer() -> - erlang:send_after(?DPA_TIMEOUT, self(), dpa_timeout). - -%% register_everywhere/1 -%% -%% Register a term and ensure it's not registered elsewhere. Note that -%% two process that simultaneously register the same term may well -%% both fail to do so this isn't foolproof. - -register_everywhere(T) -> - diameter_reg:add_new(T) - andalso unregistered(T). - -unregistered(T) -> - {ResL, _} = rpc:multicall(?MODULE, match, [{node(), T}]), - lists:all(fun(L) -> [] == L end, ResL). - -match({Node, _}) - when Node == node() -> - []; -match({_, T}) -> - try - diameter_reg:match(T) - catch - _:_ -> [] - end. diff --git a/lib/diameter/src/app/diameter_peer_fsm_sup.erl b/lib/diameter/src/app/diameter_peer_fsm_sup.erl deleted file mode 100644 index 995eaf74d0..0000000000 --- a/lib/diameter/src/app/diameter_peer_fsm_sup.erl +++ /dev/null @@ -1,63 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The supervisor of peer_fsm processes. -%% - --module(diameter_peer_fsm_sup). - --behaviour(supervisor). - --define(NAME, ?MODULE). %% supervisor name - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- - --export([start_link/0, %% supervisor start - start_child/1]). %% peer fsm start - --export([init/1]). - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% Start a peer_fsm process. - -start_child(T) -> - supervisor:start_child(?NAME, [T]). - -%% init/1 - -init([]) -> - Mod = diameter_peer_fsm, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/diameter_reg.erl b/lib/diameter/src/app/diameter_reg.erl deleted file mode 100644 index 882b9da238..0000000000 --- a/lib/diameter/src/app/diameter_reg.erl +++ /dev/null @@ -1,327 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The module implements a simple term -> pid registry. -%% - --module(diameter_reg). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([add/1, - add_new/1, - del/1, - repl/2, - match/1]). - --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% test --export([pids/0, - terms/0]). - -%% debug --export([state/0, - uptime/0]). - --include("diameter_internal.hrl"). - --define(SERVER, ?MODULE). --define(TABLE, ?MODULE). - -%% Table entry used to keep from starting more than one monitor on the -%% same process. This isn't a problem but there's no point in starting -%% multiple monitors if we can avoid it. Note that we can't have a 2-tuple -%% keyed on Pid since a registered term can be anything. Want the entry -%% keyed on Pid so that lookup is fast. --define(MONITOR(Pid, MRef), {Pid, monitor, MRef}). - -%% Table entry containing the Term -> Pid mapping. --define(MAPPING(Term, Pid), {Term, Pid}). - --record(state, {id = now()}). - -%%% ---------------------------------------------------------- -%%% # add(T) -%%% -%%% Input: Term = term() -%%% -%%% Output: true -%%% -%%% Description: Associate the specified term with self(). The list of pids -%%% having this or other assocations can be retrieved using -%%% match/1. -%%% -%%% An association is removed when the calling process dies -%%% or as a result of calling del/1. Adding the same term -%%% more than once is equivalent to adding it exactly once. -%%% -%%% Note that since match/1 takes a pattern as argument, -%%% specifying a term that contains match variables is -%%% probably not a good idea -%%% ---------------------------------------------------------- - --spec add(any()) - -> true. - -add(T) -> - call({add, fun ets:insert/2, T, self()}). - -%%% ---------------------------------------------------------- -%%% # add_new(T) -%%% -%%% Input: T = term() -%%% -%%% Output: true | false -%%% -%%% Description: Like add/1 but only one process is allowed to have the -%%% the association, false being returned if an association -%%% already exists. -%%% ---------------------------------------------------------- - --spec add_new(any()) - -> boolean(). - -add_new(T) -> - call({add, fun insert_new/2, T, self()}). - -%%% ---------------------------------------------------------- -%%% # repl(T, NewT) -%%% -%%% Input: T, NewT = term() -%%% -%%% Output: true | false -%%% -%%% Description: Like add/1 but only replace an existing association on T, -%%% false being returned if it doesn't exist. -%%% ---------------------------------------------------------- - --spec repl(any(), any()) - -> boolean(). - -repl(T, U) -> - call({repl, T, U, self()}). - -%%% ---------------------------------------------------------- -%%% # del(Term) -%%% -%%% Input: Term = term() -%%% -%%% Output: true -%%% -%%% Description: Remove any existing association of Term with self(). -%%% ---------------------------------------------------------- - --spec del(any()) - -> true. - -del(T) -> - call({del, T, self()}). - -%%% ---------------------------------------------------------- -%%% # match(Pat) -%%% -%%% Input: Pat = pattern in the sense of ets:match_object/2. -%%% -%%% Output: list of {Term, Pid} -%%% -%%% Description: Return the list of associations whose Term, as specified -%%% to add/1 or add_new/1, matches the specified pattern. -%%% -%%% Note that there's no guarantee that the returned processes -%%% are still alive. (Although one that isn't will soon have -%%% its associations removed.) -%%% ---------------------------------------------------------- - --spec match(tuple()) - -> [{term(), pid()}]. - -match(Pat) -> - ets:match_object(?TABLE, ?MAPPING(Pat, '_')). - -%% --------------------------------------------------------- -%% EXPORTED INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, ?MODULE, [], Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%% pids/0 -%% -%% Output: list of {Pid, [Term, ...]} - -pids() -> - to_list(fun swap/1). - -to_list(Fun) -> - ets:foldl(fun(T,A) -> acc(Fun, T, A) end, orddict:new(), ?TABLE). - -acc(Fun, ?MAPPING(Term, Pid), Dict) -> - append(Fun({Term, Pid}), Dict); -acc(_, _, Dict) -> - Dict. - -append({K,V}, Dict) -> - orddict:append(K, V, Dict). - -id(T) -> T. - -%% terms/0 -%% -%% Output: list of {Term, [Pid, ...]} - -terms() -> - to_list(fun id/1). - -swap({X,Y}) -> {Y,X}. - -%%% ---------------------------------------------------------- -%%% # init(Role) -%%% -%%% Output: {ok, State} -%%% ---------------------------------------------------------- - -init(_) -> - ets:new(?TABLE, [bag, named_table]), - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -handle_call({add, Fun, Key, Pid}, _, State) -> - B = Fun(?TABLE, {Key, Pid}), - monitor(B andalso no_monitor(Pid), Pid), - {reply, B, State}; - -handle_call({del, Key, Pid}, _, State) -> - {reply, ets:delete_object(?TABLE, ?MAPPING(Key, Pid)), State}; - -handle_call({repl, T, U, Pid}, _, State) -> - MatchSpec = [{?MAPPING('$1', Pid), - [{'=:=', '$1', {const, T}}], - ['$_']}], - {reply, repl(ets:select(?TABLE, MatchSpec), U, Pid), State}; - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State)-> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info(Request, State) -%%% ---------------------------------------------------------- - -handle_info({'DOWN', MRef, process, Pid, _}, State) -> - ets:delete_object(?TABLE, ?MONITOR(Pid, MRef)), - ets:match_delete(?TABLE, ?MAPPING('_', Pid)), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # terminate(Reason, State) -%%% ---------------------------------------------------------- - -terminate(_Reason, _State)-> - ok. - -%%% ---------------------------------------------------------- -%%% # code_change(OldVsn, State, Extra) -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -monitor(true, Pid) -> - ets:insert(?TABLE, ?MONITOR(Pid, erlang:monitor(process, Pid))); -monitor(false, _) -> - ok. - -%% Do we need a monitor for the specified Pid? -no_monitor(Pid) -> - [] == ets:match_object(?TABLE, ?MONITOR(Pid, '_')). - -%% insert_new/2 - -insert_new(?TABLE, {Key, _} = T) -> - flush(ets:lookup(?TABLE, Key)), - ets:insert_new(?TABLE, T). - -%% Remove any processes that are dead but for which we may not have -%% received 'DOWN' yet. This is to ensure that add_new can be used -%% to register a unique name each time a process restarts. -flush(List) -> - lists:foreach(fun({_,P} = T) -> - del(erlang:is_process_alive(P), T) - end, - List). - -del(Alive, T) -> - Alive orelse ets:delete_object(?TABLE, T). - -%% repl/3 - -repl([?MAPPING(_, Pid) = M], Key, Pid) -> - ets:delete_object(?TABLE, M), - true = ets:insert(?TABLE, ?MAPPING(Key, Pid)); -repl([], _, _) -> - false. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_service.erl b/lib/diameter/src/app/diameter_service.erl deleted file mode 100644 index 421e36ccf5..0000000000 --- a/lib/diameter/src/app/diameter_service.erl +++ /dev/null @@ -1,2903 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Implements the process that represents a service. -%% - --module(diameter_service). --behaviour(gen_server). - --export([start/1, - stop/1, - start_transport/2, - stop_transport/2, - info/2, - call/4]). - -%% towards diameter_watchdog --export([receive_message/3]). - -%% service supervisor --export([start_link/1]). - --export([subscribe/1, - unsubscribe/1, - subscriptions/1, - subscriptions/0, - services/0, - services/1, - whois/1, - flush_stats/1]). - -%% test/debug --export([call_module/3, - state/1, - uptime/1]). - -%%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% Other callbacks. --export([send/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). - --define(STATE_UP, up). --define(STATE_DOWN, down). - --define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1 --define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests --define(RESTART_TC, 1000). %% if restart was this recent - -%% Used to be able to swap this with anything else dict-like but now -%% rely on the fact that a service's #state{} record does not change -%% in storing in it ?STATE table and not always going through the -%% service process. In particular, rely on the fact that operations on -%% a ?Dict don't change the handle to it. --define(Dict, diameter_dict). - -%% Table containing outgoing requests for which a reply has yet to be -%% received. --define(REQUEST_TABLE, diameter_request). - -%% Maintains state in a table. In contrast to previously, a service's -%% stat is not constant and is accessed outside of the service -%% process. --define(STATE_TABLE, ?MODULE). - -%% Workaround for dialyzer's lack of understanding of match specs. --type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - -%% State of service gen_server. --record(state, - {id = now(), - service_name, %% as passed to start_service/2, key in ?STATE_TABLE - service :: #diameter_service{}, - peerT = ets_new(peers) :: ets:tid(), %% #peer{} at start_fsm - connT = ets_new(conns) :: ets:tid(), %% #conn{} at connection_up - share_peers = false :: boolean(), %% broadcast peers to remote nodes? - use_shared_peers = false :: boolean(), %% use broadcasted peers? - shared_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] - local_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] - monitor = false :: false | pid()}). %% process to die with -%% shared_peers reflects the peers broadcast from remote nodes. Note -%% that the state term itself doesn't change, which is relevant for -%% the stateless application callbacks since the state is retrieved -%% from ?STATE_TABLE from outside the service process. The pid in the -%% service record is used to determine whether or not we need to call -%% the process for a pick_peer callback. - -%% Record representing a watchdog process. --record(peer, - {pid :: match(pid()), - type :: match(connect | accept), - ref :: match(reference()), %% key into diameter_config - options :: match([transport_opt()]), %% as passed to start_transport - op_state = ?STATE_DOWN :: match(?STATE_DOWN | ?STATE_UP), - started = now(), %% at process start - conn = false :: match(boolean() | pid())}). - %% true at accept, pid() at connection_up (connT key) - -%% Record representing a peer_fsm process. --record(conn, - {pid :: pid(), - apps :: [{0..16#FFFFFFFF, app_alias()}], %% {Id, Alias} - caps :: #diameter_caps{}, - started = now(), %% at process start - peer :: pid()}). %% key into peerT - -%% Record stored in diameter_request for each outgoing request. --record(request, - {from, %% arg 2 of handle_call/3 - handler :: match(pid()), %% request process - transport :: match(pid()), %% peer process - caps :: match(#diameter_caps{}), - app :: match(app_alias()), %% #diameter_app.alias - dictionary :: match(module()), %% #diameter_app.dictionary - module :: match(nonempty_improper_list(module(), list())), - %% #diameter_app.module - filter :: match(peer_filter()), - packet :: match(#diameter_packet{})}). - -%% Record call/4 options are parsed into. --record(options, - {filter = none :: peer_filter(), - extra = [] :: list(), - timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, - detach = false :: boolean()}). - -%% Since RFC 3588 requires that a Diameter agent not modify End-to-End -%% Identifiers, the possibility of explicitly setting an End-to-End -%% Identifier would be needed to be able to implement an agent in -%% which one side of the communication is not implemented on top of -%% diameter. For example, Diameter being sent or received encapsulated -%% in some other protocol, or even another Diameter stack in a -%% non-Erlang environment. (Not that this is likely to be a normal -%% case.) -%% -%% The implemented solution is not an option but to respect any header -%% values set in a diameter_header record returned from a -%% prepare_request callback. A call to diameter:call/4 can communicate -%% values to the callback using the 'extra' option if so desired. - -%%% --------------------------------------------------------------------------- -%%% # start(SvcName) -%%% --------------------------------------------------------------------------- - -start(SvcName) -> - diameter_service_sup:start_child(SvcName). - -start_link(SvcName) -> - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(?MODULE, [SvcName], Options). -%% Put the arbitrary term SvcName in a list in case we ever want to -%% send more than this and need to distinguish old from new. - -%%% --------------------------------------------------------------------------- -%%% # stop(SvcName) -%%% --------------------------------------------------------------------------- - -stop(SvcName) -> - case whois(SvcName) of - undefined -> - {error, not_started}; - Pid -> - stop(call_service(Pid, stop), Pid) - end. - -stop(ok, Pid) -> - MRef = erlang:monitor(process, Pid), - receive {'DOWN', MRef, process, _, _} -> ok end; -stop(No, _) -> - No. - -%%% --------------------------------------------------------------------------- -%%% # start_transport(SvcName, {Ref, Type, Opts}) -%%% --------------------------------------------------------------------------- - -start_transport(SvcName, {_,_,_} = T) -> - call_service_by_name(SvcName, {start, T}). - -%%% --------------------------------------------------------------------------- -%%% # stop_transport(SvcName, Refs) -%%% --------------------------------------------------------------------------- - -stop_transport(_, []) -> - ok; -stop_transport(SvcName, [_|_] = Refs) -> - call_service_by_name(SvcName, {stop, Refs}). - -%%% --------------------------------------------------------------------------- -%%% # info(SvcName, Item) -%%% --------------------------------------------------------------------------- - -info(SvcName, Item) -> - info_rc(call_service_by_name(SvcName, {info, Item})). - -info_rc({error, _}) -> - undefined; -info_rc(Info) -> - Info. - -%%% --------------------------------------------------------------------------- -%%% # receive_message(TPid, Pkt, MessageData) -%%% --------------------------------------------------------------------------- - -%% Handle an incoming message in the watchdog process. This used to -%% come through the service process but this avoids that becoming a -%% bottleneck. - -receive_message(TPid, Pkt, T) - when is_pid(TPid) -> - #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, - recv(R, (not R) andalso lookup_request(Pkt, TPid), TPid, Pkt, T). - -%% Incoming request ... -recv(true, false, TPid, Pkt, T) -> - try - spawn(fun() -> recv_request(TPid, Pkt, T) end) - catch - error: system_limit = E -> %% discard - ?LOG({error, E}, now()) - end; - -%% ... answer to known request ... -recv(false, #request{from = {_, Ref}, handler = Pid} = Req, _, Pkt, _) -> - Pid ! {answer, Ref, Req, Pkt}; -%% Note that failover could have happened prior to this message being -%% received and triggering failback. That is, both a failover message -%% and answer may be on their way to the handler process. In the worst -%% case the request process gets notification of the failover and -%% sends to the alternate peer before an answer arrives, so it's -%% always the case that we can receive more than one answer after -%% failover. The first answer received by the request process wins, -%% any others are discarded. - -%% ... or not. -recv(false, false, _, _, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # call(SvcName, App, Msg, Options) -%%% --------------------------------------------------------------------------- - -call(SvcName, App, Msg, Options) - when is_list(Options) -> - Rec = make_options(Options), - Ref = make_ref(), - Caller = {self(), Ref}, - Fun = fun() -> exit({Ref, call(SvcName, App, Msg, Rec, Caller)}) end, - try spawn_monitor(Fun) of - {_, MRef} -> - recv(MRef, Ref, Rec#options.detach, false) - catch - error: system_limit = E -> - {error, E} - end. - -%% Don't rely on gen_server:call/3 for the timeout handling since it -%% makes no guarantees about not leaving a reply message in the -%% mailbox if we catch its exit at timeout. It currently *can* do so, -%% which is also undocumented. - -recv(MRef, _, true, true) -> - erlang:demonitor(MRef, [flush]), - ok; - -recv(MRef, Ref, Detach, Sent) -> - receive - Ref -> %% send has been attempted - recv(MRef, Ref, Detach, true); - {'DOWN', MRef, process, _, Reason} -> - call_rc(Reason, Ref, Sent) - end. - -%% call/5 has returned ... -call_rc({Ref, Ans}, Ref, _) -> - Ans; - -%% ... or not. In this case failure/encode are documented. -call_rc(_, _, Sent) -> - {error, choose(Sent, failure, encode)}. - -%% call/5 -%% -%% In the process spawned for the outgoing request. - -call(SvcName, App, Msg, Opts, Caller) -> - c(ets:lookup(?STATE_TABLE, SvcName), App, Msg, Opts, Caller). - -c([#state{service_name = SvcName} = S], App, Msg, Opts, Caller) -> - case find_transport(App, Msg, Opts, S) of - {_,_,_} = T -> - send_request(T, Msg, Opts, Caller, SvcName); - false -> - {error, no_connection}; - {error, _} = No -> - No - end; - -c([], _, _, _, _) -> - {error, no_service}. - -%% make_options/1 - -make_options(Options) -> - lists:foldl(fun mo/2, #options{}, Options). - -mo({timeout, T}, Rec) - when is_integer(T), 0 =< T -> - Rec#options{timeout = T}; - -mo({filter, F}, #options{filter = none} = Rec) -> - Rec#options{filter = F}; -mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> - Rec#options{filter = {all, [F | Fs]}}; -mo({filter, F}, #options{filter = F0} = Rec) -> - Rec#options{filter = {all, [F0, F]}}; - -mo({extra, L}, #options{extra = X} = Rec) - when is_list(L) -> - Rec#options{extra = X ++ L}; - -mo(detach, Rec) -> - Rec#options{detach = true}; - -mo(T, _) -> - ?ERROR({invalid_option, T}). - -%%% --------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% # unsubscribe(SvcName) -%%% --------------------------------------------------------------------------- - -subscribe(SvcName) -> - diameter_reg:add({?MODULE, subscriber, SvcName}). - -unsubscribe(SvcName) -> - diameter_reg:del({?MODULE, subscriber, SvcName}). - -subscriptions(Pat) -> - pmap(diameter_reg:match({?MODULE, subscriber, Pat})). - -subscriptions() -> - subscriptions('_'). - -pmap(Props) -> - lists:map(fun({{?MODULE, _, Name}, Pid}) -> {Name, Pid} end, Props). - -%%% --------------------------------------------------------------------------- -%%% # services(Pattern) -%%% --------------------------------------------------------------------------- - -services(Pat) -> - pmap(diameter_reg:match({?MODULE, service, Pat})). - -services() -> - services('_'). - -whois(SvcName) -> - case diameter_reg:match({?MODULE, service, SvcName}) of - [{_, Pid}] -> - Pid; - [] -> - undefined - end. - -%%% --------------------------------------------------------------------------- -%%% # flush_stats/1 -%%% -%%% Output: list of {{SvcName, Alias, Counter}, Value} -%%% --------------------------------------------------------------------------- - -flush_stats(TPid) -> - diameter_stats:flush(TPid). - -%% =========================================================================== -%% =========================================================================== - -state(Svc) -> - call_service(Svc, state). - -uptime(Svc) -> - call_service(Svc, uptime). - -%% call_module/3 - -call_module(Service, AppMod, Request) -> - call_service(Service, {call_module, AppMod, Request}). - -%%% --------------------------------------------------------------------------- -%%% # init([SvcName]) -%%% --------------------------------------------------------------------------- - -init([SvcName]) -> - process_flag(trap_exit, true), %% ensure terminate(shutdown, _) - i(SvcName, diameter_reg:add_new({?MODULE, service, SvcName})). - -i(SvcName, true) -> - {ok, i(SvcName)}; -i(_, false) -> - {stop, {shutdown, already_started}}. - -%%% --------------------------------------------------------------------------- -%%% # handle_call(Req, From, State) -%%% --------------------------------------------------------------------------- - -handle_call(state, _, S) -> - {reply, S, S}; - -handle_call(uptime, _, #state{id = T} = S) -> - {reply, diameter_lib:now_diff(T), S}; - -%% Start a transport. -handle_call({start, {Ref, Type, Opts}}, _From, S) -> - {reply, start(Ref, {Type, Opts}, S), S}; - -%% Stop transports. -handle_call({stop, Refs}, _From, S) -> - shutdown(Refs, S), - {reply, ok, S}; - -%% pick_peer with mutable state -handle_call({pick_peer, Local, Remote, App}, _From, S) -> - #diameter_app{mutable = true} = App, %% assert - {reply, pick_peer(Local, Remote, self(), S#state.service_name, App), S}; - -handle_call({call_module, AppMod, Req}, From, S) -> - call_module(AppMod, Req, From, S); - -handle_call({info, Item}, _From, S) -> - {reply, service_info(Item, S), S}; - -handle_call(stop, _From, S) -> - shutdown(S), - {stop, normal, ok, S}; -%% The server currently isn't guaranteed to be dead when the caller -%% gets the reply. We deal with this in the call to the server, -%% stating a monitor that waits for DOWN before returning. - -handle_call(Req, From, S) -> - unexpected(handle_call, [Req, From], S), - {reply, nok, S}. - -%%% --------------------------------------------------------------------------- -%%% # handle_cast(Req, State) -%%% --------------------------------------------------------------------------- - -handle_cast(Req, S) -> - unexpected(handle_cast, [Req], S), - {noreply, S}. - -%%% --------------------------------------------------------------------------- -%%% # handle_info(Req, State) -%%% --------------------------------------------------------------------------- - -handle_info(T,S) -> - case transition(T,S) of - ok -> - {noreply, S}; - #state{} = NS -> - {noreply, NS}; - {stop, Reason} -> - {stop, {shutdown, Reason}, S} - end. - -%% transition/2 - -%% Peer process is telling us to start a new accept process. -transition({accepted, Pid, TPid}, S) -> - accepted(Pid, TPid, S), - ok; - -%% Peer process has a new open connection. -transition({connection_up, Pid, T}, S) -> - connection_up(Pid, T, S); - -%% Peer process has left state open. -transition({connection_down, Pid}, S) -> - connection_down(Pid, S); - -%% Peer process has returned to state open. -transition({connection_up, Pid}, S) -> - connection_up(Pid, S); - -%% Accepting transport has lost connectivity. -transition({close, Pid}, S) -> - close(Pid, S), - ok; - -%% Connecting transport is being restarted by watchdog. -transition({reconnect, Pid}, S) -> - reconnect(Pid, S), - ok; - -%% Monitor process has died. Just die with a reason that tells -%% diameter_config about the happening. If a cleaner shutdown is -%% required then someone should stop us. -transition({'DOWN', MRef, process, _, Reason}, #state{monitor = MRef}) -> - {stop, {monitor, Reason}}; - -%% Local peer process has died. -transition({'DOWN', _, process, Pid, Reason}, S) - when node(Pid) == node() -> - peer_down(Pid, Reason, S); - -%% Remote service wants to know about shared transports. -transition({service, Pid}, S) -> - share_peers(Pid, S), - ok; - -%% Remote service is communicating a shared peer. -transition({peer, TPid, Aliases, Caps}, S) -> - remote_peer_up(TPid, Aliases, Caps, S); - -%% Remote peer process has died. -transition({'DOWN', _, process, TPid, _}, S) -> - remote_peer_down(TPid, S); - -%% Restart after tc expiry. -transition({tc_timeout, T}, S) -> - tc_timeout(T, S), - ok; - -%% Request process is telling us it may have missed a failover message -%% after a transport went down and the service process looked up -%% outstanding requests. -transition({failover, TRef, Seqs}, S) -> - failover(TRef, Seqs, S), - ok; - -transition(Req, S) -> - unexpected(handle_info, [Req], S), - ok. - -%%% --------------------------------------------------------------------------- -%%% # terminate(Reason, State) -%%% --------------------------------------------------------------------------- - -terminate(Reason, #state{service_name = Name} = S) -> - ets:delete(?STATE_TABLE, Name), - shutdown == Reason %% application shutdown - andalso shutdown(S). - -%%% --------------------------------------------------------------------------- -%%% # code_change(FromVsn, State, Extra) -%%% --------------------------------------------------------------------------- - -code_change(FromVsn, - #state{service_name = SvcName, - service = #diameter_service{applications = Apps}} - = S, - Extra) -> - lists:foreach(fun(A) -> - code_change(FromVsn, SvcName, Extra, A) - end, - Apps), - {ok, S}. - -code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> - {ok, S} = cb(A, code_change, [FromVsn, - mod_state(Alias), - Extra, - SvcName]), - mod_state(Alias, S). - -%% =========================================================================== -%% =========================================================================== - -unexpected(F, A, #state{service_name = Name}) -> - ?UNEXPECTED(F, A ++ [Name]). - -cb([_|_] = M, F, A) -> - eval(M, F, A); -cb(Rec, F, A) -> - {_, M} = app(Rec), - eval(M, F, A). - -app(#request{app = A, module = M}) -> - {A,M}; -app(#diameter_app{alias = A, module = M}) -> - {A,M}. - -eval([M|X], F, A) -> - apply(M, F, A ++ X). - -%% Callback with state. - -state_cb(#diameter_app{mutable = false, init_state = S}, {ModX, F, A}) -> - eval(ModX, F, A ++ [S]); - -state_cb(#diameter_app{mutable = true, alias = Alias}, {_,_,_} = MFA) -> - state_cb(MFA, Alias); - -state_cb({ModX,F,A}, Alias) - when is_list(ModX) -> - eval(ModX, F, A ++ [mod_state(Alias)]). - -choose(true, X, _) -> X; -choose(false, _, X) -> X. - -ets_new(Tbl) -> - ets:new(Tbl, [{keypos, 2}]). - -insert(Tbl, Rec) -> - ets:insert(Tbl, Rec), - Rec. - -monitor(Pid) -> - erlang:monitor(process, Pid), - Pid. - -%% Using the process dictionary for the callback state was initially -%% just a way to make what was horrendous trace (big state record and -%% much else everywhere) somewhat more readable. There's not as much -%% need for it now but it's no worse (except possibly that we don't -%% see the table identifier being passed around) than an ets table so -%% keep it. - -mod_state(Alias) -> - get({?MODULE, mod_state, Alias}). - -mod_state(Alias, ModS) -> - put({?MODULE, mod_state, Alias}, ModS). - -%% have_transport/2 - -have_transport(SvcName, Ref) -> - [] /= diameter_config:have_transport(SvcName, Ref). - -%%% --------------------------------------------------------------------------- -%%% # shutdown/2 -%%% --------------------------------------------------------------------------- - -shutdown(Refs, #state{peerT = PeerT}) -> - ets:foldl(fun(P,ok) -> s(P, Refs), ok end, ok, PeerT). - -s(#peer{ref = Ref, pid = Pid}, Refs) -> - s(lists:member(Ref, Refs), Pid); - -s(true, Pid) -> - Pid ! {shutdown, self()}; %% 'DOWN' will cleanup as usual -s(false, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # shutdown/1 -%%% --------------------------------------------------------------------------- - -shutdown(#state{peerT = PeerT}) -> - %% A transport might not be alive to receive the shutdown request - %% but give those that are a chance to shutdown gracefully. - wait(fun st/2, PeerT), - %% Kill the watchdogs explicitly in case there was no transport. - wait(fun sw/2, PeerT). - -wait(Fun, T) -> - diameter_lib:wait(ets:foldl(Fun, [], T)). - -st(#peer{conn = B}, Acc) - when is_boolean(B) -> - Acc; -st(#peer{conn = Pid}, Acc) -> - Pid ! shutdown, - [Pid | Acc]. - -sw(#peer{pid = Pid}, Acc) -> - exit(Pid, shutdown), - [Pid | Acc]. - -%%% --------------------------------------------------------------------------- -%%% # call_service/2 -%%% --------------------------------------------------------------------------- - -call_service(Pid, Req) - when is_pid(Pid) -> - cs(Pid, Req); -call_service(SvcName, Req) -> - call_service_by_name(SvcName, Req). - -call_service_by_name(SvcName, Req) -> - cs(whois(SvcName), Req). - -cs(Pid, Req) - when is_pid(Pid) -> - try - gen_server:call(Pid, Req, infinity) - catch - E: Reason when E == exit -> - {error, {E, Reason}} - end; - -cs(undefined, _) -> - {error, no_service}. - -%%% --------------------------------------------------------------------------- -%%% # i/1 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Intialize the state of a service gen_server. - -i(SvcName) -> - %% Split the config into a server state and a list of transports. - {#state{} = S, CL} = lists:foldl(fun cfg_acc/2, - {false, []}, - diameter_config:lookup(SvcName)), - - %% Publish the state in order to be able to access it outside of - %% the service process. Originally table identifiers were only - %% known to the service process but we now want to provide the - %% option of application callbacks being 'stateless' in order to - %% avoid having to go through a common process. (Eg. An agent that - %% sends a request for every incoming request.) - true = ets:insert_new(?STATE_TABLE, S), - - %% Start fsms for each transport. - lists:foreach(fun(T) -> start_fsm(T,S) end, CL), - - init_shared(S), - S. - -cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts}, - {false, Acc}) -> - lists:foreach(fun init_mod/1, Apps), - S = #state{service_name = SvcName, - service = Rec#diameter_service{pid = self()}, - share_peers = get_value(share_peers, Opts), - use_shared_peers = get_value(use_shared_peers, Opts), - monitor = mref(get_value(monitor, Opts))}, - {S, Acc}; - -cfg_acc({_Ref, Type, _Opts} = T, {S, Acc}) - when Type == connect; - Type == listen -> - {S, [T | Acc]}. - -mref(false = No) -> - No; -mref(P) -> - erlang:monitor(process, P). - -init_shared(#state{use_shared_peers = true, - service_name = Svc}) -> - diameter_peer:notify(Svc, {service, self()}); -init_shared(#state{use_shared_peers = false}) -> - ok. - -init_mod(#diameter_app{alias = Alias, - init_state = S}) -> - mod_state(Alias, S). - -start_fsm({Ref, Type, Opts}, S) -> - start(Ref, {Type, Opts}, S). - -get_value(Key, Vs) -> - {_, V} = lists:keyfind(Key, 1, Vs), - V. - -%%% --------------------------------------------------------------------------- -%%% # start/3 -%%% --------------------------------------------------------------------------- - -%% If the initial start/3 at service/transport start succeeds then -%% subsequent calls to start/4 on the same service will also succeed -%% since they involve the same call to merge_service/2. We merge here -%% rather than earlier since the service may not yet be configured -%% when the transport is configured. - -start(Ref, {T, Opts}, S) - when T == connect; - T == listen -> - try - {ok, start(Ref, type(T), Opts, S)} - catch - ?FAILURE(Reason) -> - {error, Reason} - end. -%% TODO: don't actually raise any errors yet - -%% There used to be a difference here between the handling of -%% configured listening and connecting transports but now we simply -%% tell the transport_module to start an accepting or connecting -%% process respectively, the transport implementation initiating -%% listening on a port as required. -type(listen) -> accept; -type(accept) -> listen; -type(connect = T) -> T. - -%% start/4 - -start(Ref, Type, Opts, #state{peerT = PeerT, - connT = ConnT, - service_name = SvcName, - service = Svc}) - when Type == connect; - Type == accept -> - Pid = monitor(s(Type, Ref, {ConnT, - Opts, - SvcName, - merge_service(Opts, Svc)})), - insert(PeerT, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts}), - Pid. - -%% Note that the service record passed into the watchdog is the merged -%% record so that each watchdog (and peer_fsm) may get a different -%% record. This record is what is passed back into application -%% callbacks. - -s(Type, Ref, T) -> - diameter_watchdog:start({Type, Ref}, T). - -%% merge_service/2 - -merge_service(Opts, Svc) -> - lists:foldl(fun ms/2, Svc, Opts). - -%% Limit the applications known to the fsm to those in the 'apps' -%% option. That this might be empty is checked by the fsm. It's not -%% checked at config-time since there's no requirement that the -%% service be configured first. (Which could be considered a bit odd.) -ms({applications, As}, #diameter_service{applications = Apps} = S) - when is_list(As) -> - S#diameter_service{applications - = [A || A <- Apps, - lists:member(A#diameter_app.alias, As)]}; - -%% The fact that all capabilities can be configured on the transports -%% means that the service doesn't necessarily represent a single -%% locally implemented Diameter peer as identified by Origin-Host: a -%% transport can configure its own Origin-Host. This means that the -%% service little more than a placeholder for default capabilities -%% plus a list of applications that individual transports can choose -%% to support (or not). -ms({capabilities, Opts}, #diameter_service{capabilities = Caps0} = Svc) - when is_list(Opts) -> - %% make_caps has already succeeded in diameter_config so it will succeed - %% again here. - {ok, Caps} = diameter_capx:make_caps(Caps0, Opts), - Svc#diameter_service{capabilities = Caps}; - -ms(_, Svc) -> - Svc. - -%%% --------------------------------------------------------------------------- -%%% # accepted/3 -%%% --------------------------------------------------------------------------- - -accepted(Pid, _TPid, #state{peerT = PeerT} = S) -> - #peer{ref = Ref, type = accept = T, conn = false, options = Opts} - = P - = fetch(PeerT, Pid), - insert(PeerT, P#peer{conn = true}), %% mark replacement transport started - start(Ref, T, Opts, S). %% start new peer - -fetch(Tid, Key) -> - [T] = ets:lookup(Tid, Key), - T. - -%%% --------------------------------------------------------------------------- -%%% # connection_up/3 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has reached the open state. - -connection_up(Pid, {TPid, {Caps, SApps, Pkt}}, #state{peerT = PeerT, - connT = ConnT} - = S) -> - P = fetch(PeerT, Pid), - C = #conn{pid = TPid, - apps = SApps, - caps = Caps, - peer = Pid}, - - insert(ConnT, C), - connection_up([Pkt], P#peer{conn = TPid}, C, S). - -%%% --------------------------------------------------------------------------- -%%% # connection_up/2 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has transitioned back into the open state. Note that there -%% has been no new capabilties exchange in this case. - -connection_up(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{conn = TPid} = P = fetch(PeerT, Pid), - C = fetch(ConnT, TPid), - connection_up([], P, C, S). - -%% connection_up/4 - -connection_up(T, P, C, #state{peerT = PeerT, - local_peers = LDict, - service_name = SvcName, - service - = #diameter_service{applications = Apps}} - = S) -> - #peer{conn = TPid, op_state = ?STATE_DOWN} - = P, - #conn{apps = SApps, caps = Caps} - = C, - - insert(PeerT, P#peer{op_state = ?STATE_UP}), - - request_peer_up(TPid), - report_status(up, P, C, S, T), - S#state{local_peers = insert_local_peer(SApps, - {{TPid, Caps}, {SvcName, Apps}}, - LDict)}. - -insert_local_peer(SApps, T, LDict) -> - lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). - -ilp({Id, Alias}, {TC, SA}, LDict) -> - init_conn(Id, Alias, TC, SA), - ?Dict:append(Alias, TC, LDict). - -init_conn(Id, Alias, TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert - = find_app(Alias, Apps), - - peer_cb({ModX, peer_up, [SvcName, TC]}, Alias). - -find_app(Alias, Apps) -> - lists:keyfind(Alias, #diameter_app.alias, Apps). - -%% A failing peer callback brings down the service. In the case of -%% peer_up we could just kill the transport and emit an error but for -%% peer_down we have no way to cleanup any state change that peer_up -%% may have introduced. -peer_cb(MFA, Alias) -> - try state_cb(MFA, Alias) of - ModS -> - mod_state(Alias, ModS) - catch - E: Reason -> - ?ERROR({E, Reason, MFA, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # connection_down/2 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has transitioned out of the open state. - -connection_down(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{conn = TPid} - = P - = fetch(PeerT, Pid), - - C = fetch(ConnT, TPid), - insert(PeerT, P#peer{op_state = ?STATE_DOWN}), - connection_down(P,C,S). - -%% connection_down/3 - -connection_down(#peer{conn = TPid, - op_state = ?STATE_UP} - = P, - #conn{caps = Caps, - apps = SApps} - = C, - #state{service_name = SvcName, - service = #diameter_service{applications = Apps}, - local_peers = LDict} - = S) -> - report_status(down, P, C, S, []), - NewS = S#state{local_peers - = remove_local_peer(SApps, - {{TPid, Caps}, {SvcName, Apps}}, - LDict)}, - request_peer_down(TPid, NewS), - NewS. - -remove_local_peer(SApps, T, LDict) -> - lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). - -rlp({Id, Alias}, {TC, SA}, LDict) -> - L = ?Dict:fetch(Alias, LDict), - down_conn(Id, Alias, TC, SA), - ?Dict:store(Alias, lists:delete(TC, L), LDict). - -down_conn(Id, Alias, TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert - = find_app(Alias, Apps), - - peer_cb({ModX, peer_down, [SvcName, TC]}, Alias). - -%%% --------------------------------------------------------------------------- -%%% # peer_down/3 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has died. - -peer_down(Pid, _Reason, #state{peerT = PeerT} = S) -> - P = fetch(PeerT, Pid), - ets:delete_object(PeerT, P), - restart(P,S), - peer_down(P,S). - -%% peer_down/2 - -%% The peer has never come up ... -peer_down(#peer{conn = B}, S) - when is_boolean(B) -> - S; - -%% ... or it has. -peer_down(#peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts} - = P, - #state{service_name = SvcName, - connT = ConnT} - = S) -> - #conn{caps = Caps} - = C - = fetch(ConnT, TPid), - ets:delete_object(ConnT, C), - try - pd(P,C,S) - after - send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}}) - end. - -pd(#peer{op_state = ?STATE_DOWN}, _, S) -> - S; -pd(#peer{op_state = ?STATE_UP} = P, C, S) -> - connection_down(P,C,S). - -%% restart/2 - -restart(P,S) -> - q_restart(restart(P), S). - -%% restart/1 - -%% Always try to reconnect. -restart(#peer{ref = Ref, - type = connect = T, - options = Opts, - started = Time}) -> - {Time, {Ref, T, Opts}}; - -%% Transport connection hasn't yet been accepted ... -restart(#peer{ref = Ref, - type = accept = T, - options = Opts, - conn = false, - started = Time}) -> - {Time, {Ref, T, Opts}}; - -%% ... or it has: a replacement transport has already been spawned. -restart(#peer{type = accept}) -> - false. - -%% q_restart/2 - -%% Start the reconnect timer. -q_restart({Time, {_Ref, Type, Opts} = T}, S) -> - start_tc(tc(Time, default_tc(Type, Opts)), T, S); -q_restart(false, _) -> - ok. - -%% RFC 3588, 2.1: -%% -%% When no transport connection exists with a peer, an attempt to -%% connect SHOULD be periodically made. This behavior is handled via -%% the Tc timer, whose recommended value is 30 seconds. There are -%% certain exceptions to this rule, such as when a peer has terminated -%% the transport connection stating that it does not wish to -%% communicate. - -default_tc(connect, Opts) -> - proplists:get_value(reconnect_timer, Opts, ?DEFAULT_TC); -default_tc(accept, _) -> - 0. - -%% Bound tc below if the peer was restarted recently to avoid -%% continuous in case of faulty config or other problems. -tc(Time, Tc) -> - choose(Tc > ?RESTART_TC - orelse timer:now_diff(now(), Time) > 1000*?RESTART_TC, - Tc, - ?RESTART_TC). - -start_tc(0, T, S) -> - tc_timeout(T, S); -start_tc(Tc, T, _) -> - erlang:send_after(Tc, self(), {tc_timeout, T}). - -%% tc_timeout/2 - -tc_timeout({Ref, _Type, _Opts} = T, #state{service_name = SvcName} = S) -> - tc(have_transport(SvcName, Ref), T, S). - -tc(true, {Ref, Type, Opts}, #state{service_name = SvcName} - = S) -> - send_event(SvcName, {reconnect, Ref, Opts}), - start(Ref, Type, Opts, S); -tc(false = No, _, _) -> %% removed - No. - -%%% --------------------------------------------------------------------------- -%%% # close/2 -%%% --------------------------------------------------------------------------- - -%% The watchdog doesn't start a new fsm in the accept case, it -%% simply stays alive until someone tells it to die in order for -%% another watchdog to be able to detect that it should transition -%% from initial into reopen rather than okay. That someone is either -%% the accepting watchdog upon reception of a CER from the previously -%% connected peer, or us after reconnect_timer timeout. - -close(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{pid = Pid, - type = accept, - ref = Ref, - options = Opts} - = fetch(PeerT, Pid), - - c(Pid, have_transport(SvcName, Ref), Opts). - -%% Tell watchdog to (maybe) die later ... -c(Pid, true, Opts) -> - Tc = proplists:get_value(reconnect_timer, Opts, 2*?DEFAULT_TC), - erlang:send_after(Tc, Pid, close); - -%% ... or now. -c(Pid, false, _Opts) -> - Pid ! close. - -%% The RFC's only document the behaviour of Tc, our reconnect_timer, -%% for the establishment of connections but we also give -%% reconnect_timer semantics for a listener, being the time within -%% which a new connection attempt is expected of a connecting peer. -%% The value should be greater than the peer's Tc + jitter. - -%%% --------------------------------------------------------------------------- -%%% # reconnect/2 -%%% --------------------------------------------------------------------------- - -reconnect(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{ref = Ref, - type = connect, - options = Opts} - = fetch(PeerT, Pid), - send_event(SvcName, {reconnect, Ref, Opts}). - -%%% --------------------------------------------------------------------------- -%%% # call_module/4 -%%% --------------------------------------------------------------------------- - -%% Backwards compatibility and never documented/advertised. May be -%% removed. - -call_module(Mod, Req, From, #state{service - = #diameter_service{applications = Apps}, - service_name = Svc} - = S) -> - case cm([A || A <- Apps, Mod == hd(A#diameter_app.module)], - Req, - From, - Svc) - of - {reply = T, RC} -> - {T, RC, S}; - noreply = T -> - {T, S}; - Reason -> - {reply, {error, Reason}, S} - end. - -cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> - MFA = {ModX, handle_call, [Req, From, Svc]}, - - try state_cb(MFA, Alias) of - {noreply = T, ModS} -> - mod_state(Alias, ModS), - T; - {reply = T, RC, ModS} -> - mod_state(Alias, ModS), - {T, RC}; - T -> - diameter_lib:error_report({invalid, T}, MFA), - invalid - catch - E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA), - failure - end; - -cm([], _, _, _) -> - unknown; - -cm([_,_|_], _, _, _) -> - multiple. - -%%% --------------------------------------------------------------------------- -%%% # send_request/5 -%%% --------------------------------------------------------------------------- - -%% Send an outgoing request in its dedicated process. -%% -%% Note that both encode of the outgoing request and of the received -%% answer happens in this process. It's also this process that replies -%% to the caller. The service process only handles the state-retaining -%% callbacks. -%% -%% The mod field of the #diameter_app{} here includes any extra -%% arguments passed to diameter:call/2. - -send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> - #diameter_app{module = ModX} - = App, - - Pkt = make_packet(Msg), - - case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of - {send, P} -> - send_request(make_packet(P, Pkt), - TPid, - Caps, - App, - Opts, - Caller, - SvcName); - {discard, Reason} -> - {error, Reason}; - discard -> - {error, discarded}; - T -> - ?ERROR({invalid_return, prepare_request, App, T}) - end. - -%% make_packet/1 -%% -%% Turn an outgoing request as passed to call/4 into a diameter_packet -%% record in preparation for a prepare_request callback. - -make_packet(Bin) - when is_binary(Bin) -> - #diameter_packet{header = diameter_codec:decode_header(Bin), - bin = Bin}; - -make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) -> - Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]}; - -make_packet(#diameter_packet{header = Hdr} = Pkt) -> - Pkt#diameter_packet{header = make_header(Hdr)}; - -make_packet(Msg) -> - make_packet(#diameter_packet{msg = Msg}). - -%% make_header/1 - -make_header(undefined) -> - Seq = diameter_session:sequence(), - make_header(#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); - -make_header(#diameter_header{version = undefined} = Hdr) -> - make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); - -make_header(#diameter_header{end_to_end_id = undefined} = H) -> - Seq = diameter_session:sequence(), - make_header(H#diameter_header{end_to_end_id = Seq}); - -make_header(#diameter_header{hop_by_hop_id = undefined} = H) -> - Seq = diameter_session:sequence(), - make_header(H#diameter_header{hop_by_hop_id = Seq}); - -make_header(#diameter_header{} = Hdr) -> - Hdr; - -make_header(T) -> - ?ERROR({invalid_header, T}). - -%% make_packet/2 -%% -%% Reconstruct a diameter_packet from the return value of -%% prepare_request or prepare_retransmit callback. - -make_packet(Bin, _) - when is_binary(Bin) -> - make_packet(Bin); - -make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> - Pkt; - -%% Returning a diameter_packet with no header from a prepare_request -%% or prepare_retransmit callback retains the header passed into it. -%% This is primarily so that the end to end and hop by hop identifiers -%% are retained. -make_packet(#diameter_packet{header = Hdr} = Pkt, - #diameter_packet{header = Hdr0}) -> - Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; - -make_packet(Msg, Pkt) -> - Pkt#diameter_packet{msg = Msg}. - -%% fold_record/2 - -fold_record(undefined, R) -> - R; -fold_record(Rec, R) -> - diameter_lib:fold_tuple(2, Rec, R). - -%% send_request/7 - -send_request(Pkt, TPid, Caps, App, Opts, Caller, SvcName) -> - #diameter_app{alias = Alias, - dictionary = Dict, - module = ModX, - answer_errors = AE} - = App, - - EPkt = encode(Dict, Pkt), - - #options{filter = Filter, - timeout = Timeout} - = Opts, - - Req = #request{packet = Pkt, - from = Caller, - handler = self(), - transport = TPid, - caps = Caps, - app = Alias, - filter = Filter, - dictionary = Dict, - module = ModX}, - - try - TRef = send_request(TPid, EPkt, Req, Timeout), - ack(Caller), - handle_answer(SvcName, AE, recv_answer(Timeout, SvcName, {TRef, Req})) - after - erase_request(EPkt) - end. - -%% Tell caller a send has been attempted. -ack({Pid, Ref}) -> - Pid ! Ref. - -%% recv_answer/3 - -recv_answer(Timeout, - SvcName, - {TRef, #request{from = {_, Ref}, packet = RPkt} = Req} - = T) -> - - %% Matching on TRef below ensures we ignore messages that pertain - %% to a previous transport prior to failover. The answer message - %% includes the #request{} since it's not necessarily Req; that - %% is, from the last peer to which we've transmitted. - - receive - {answer = A, Ref, Rq, Pkt} -> %% Answer from peer - {A, Rq, Pkt}; - {timeout = Reason, TRef, _} -> %% No timely reply - {error, Req, Reason}; - {failover = Reason, TRef, false} -> %% No alternate peer - {error, Req, Reason}; - {failover, TRef, Transport} -> %% Resend to alternate peer - try_retransmit(Timeout, SvcName, Req, Transport); - {failover, TRef} -> %% May have missed failover notification - Seqs = diameter_codec:sequence_numbers(RPkt), - Pid = whois(SvcName), - is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}), - recv_answer(Timeout, SvcName, T) - end. -%% Note that failover starts a new timer and that expiry of an old -%% timer value is ignored. This means that an answer could be accepted -%% from a peer after timeout in the case of failover. - -try_retransmit(Timeout, SvcName, Req, Transport) -> - try retransmit(Transport, Req, SvcName, Timeout) of - T -> recv_answer(Timeout, SvcName, T) - catch - ?FAILURE(Reason) -> {error, Req, Reason} - end. - -%% handle_error/3 - -handle_error(Req, Reason, SvcName) -> - #request{module = ModX, - packet = Pkt, - transport = TPid, - caps = Caps} - = Req, - cb(ModX, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). - -msg(#diameter_packet{msg = undefined, bin = Bin}) -> - Bin; -msg(#diameter_packet{msg = Msg}) -> - Msg. - -%% encode/2 - -%% Note that prepare_request can return a diameter_packet containing -%% header or transport_data. Even allow the returned record to contain -%% an encoded binary. This isn't the usual case but could some in -%% handy, for test at least. (For example, to send garbage.) - -%% The normal case: encode the returned message. -encode(Dict, #diameter_packet{msg = Msg, bin = undefined} = Pkt) -> - D = pick_dictionary([Dict, ?BASE], Msg), - diameter_codec:encode(D, Pkt); - -%% Callback has returned an encoded binary: just send. -encode(_, #diameter_packet{} = Pkt) -> - Pkt. - -%% pick_dictionary/2 - -%% Pick the first dictionary that declares the application id in the -%% specified header. -pick_dictionary(Ds, [#diameter_header{application_id = Id} | _]) -> - pd(Ds, fun(D) -> Id = D:id() end); - -%% Pick the first dictionary that knows the specified message name. -pick_dictionary(Ds, [MsgName|_]) -> - pd(Ds, fun(D) -> D:msg2rec(MsgName) end); - -%% Pick the first dictionary that knows the name of the specified -%% message record. -pick_dictionary(Ds, Rec) -> - Name = element(1, Rec), - pd(Ds, fun(D) -> D:rec2msg(Name) end). - -pd([D|Ds], F) -> - try - F(D), - D - catch - error:_ -> - pd(Ds, F) - end; - -pd([], _) -> - ?ERROR(no_dictionary). - -%% send_request/4 - -send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout) - when node() == node(TPid) -> - %% Store the outgoing request before sending to avoid a race with - %% reply reception. - TRef = store_request(TPid, Bin, Req, Timeout), - send(TPid, Pkt), - TRef; - -%% Send using a remote transport: spawn a process on the remote node -%% to relay the answer. -send_request(TPid, #diameter_packet{} = Pkt, Req, Timeout) -> - TRef = erlang:start_timer(Timeout, self(), timeout), - T = {TPid, Pkt, Req, Timeout, TRef}, - spawn(node(TPid), ?MODULE, send, [T]), - TRef. - -%% send/1 - -send({TPid, Pkt, #request{handler = Pid} = Req, Timeout, TRef}) -> - Ref = send_request(TPid, Pkt, Req#request{handler = self()}, Timeout), - Pid ! reref(receive T -> T end, Ref, TRef). - -reref({T, Ref, R}, Ref, TRef) -> - {T, TRef, R}; -reref(T, _, _) -> - T. - -%% send/2 - -send(Pid, Pkt) -> - Pid ! {send, Pkt}. - -%% retransmit/4 - -retransmit({TPid, Caps, #diameter_app{alias = Alias} = App}, - #request{app = Alias, - packet = Pkt} - = Req, - SvcName, - Timeout) -> - have_request(Pkt, TPid) %% Don't failover to a peer we've - andalso ?THROW(timeout), %% already sent to. - - case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of - {send, P} -> - retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout); - {discard, Reason} -> - ?THROW(Reason); - discard -> - ?THROW(discarded); - T -> - ?ERROR({invalid_return, prepare_retransmit, App, T}) - end. - -%% retransmit/5 - -retransmit(Pkt, TPid, Caps, #request{dictionary = Dict} = Req, Timeout) -> - EPkt = encode(Dict, Pkt), - - NewReq = Req#request{transport = TPid, - packet = Pkt, - caps = Caps}, - - ?LOG(retransmission, NewReq), - TRef = send_request(TPid, EPkt, NewReq, Timeout), - {TRef, NewReq}. - -%% store_request/4 - -store_request(TPid, Bin, Req, Timeout) -> - Seqs = diameter_codec:sequence_numbers(Bin), - TRef = erlang:start_timer(Timeout, self(), timeout), - ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), - ets:member(?REQUEST_TABLE, TPid) - orelse (self() ! {failover, TRef}), %% possibly missed failover - TRef. - -%% lookup_request/2 - -lookup_request(Msg, TPid) - when is_pid(TPid) -> - lookup(Msg, TPid, '_'); - -lookup_request(Msg, TRef) - when is_reference(TRef) -> - lookup(Msg, '_', TRef). - -lookup(Msg, TPid, TRef) -> - Seqs = diameter_codec:sequence_numbers(Msg), - Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, TRef}, - [], - ['$_']}], - case ets:select(?REQUEST_TABLE, Spec) of - [{_, Req, _}] -> - Req; - [] -> - false - end. - -%% erase_request/1 - -erase_request(Pkt) -> - ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). - -%% match_requests/1 - -match_requests(TPid) -> - Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, - ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). - -%% have_request/2 - -have_request(Pkt, TPid) -> - Seqs = diameter_codec:sequence_numbers(Pkt), - Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, - '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). - -%% request_peer_up/1 - -request_peer_up(TPid) -> - ets:insert(?REQUEST_TABLE, {TPid}). - -%% request_peer_down/2 - -request_peer_down(TPid, S) -> - ets:delete(?REQUEST_TABLE, TPid), - lists:foreach(fun(T) -> failover(T,S) end, match_requests(TPid)). -%% Note that a request process can store its request after failover -%% notifications are sent here: store_request/4 sends the notification -%% in that case. Note also that we'll send as many notifications to a -%% given handler as there are peers its sent to. All but one of these -%% will be ignored. - -%%% --------------------------------------------------------------------------- -%%% recv_request/3 -%%% --------------------------------------------------------------------------- - -recv_request(TPid, Pkt, {ConnT, SvcName, Apps}) -> - try ets:lookup(ConnT, TPid) of - [C] -> - recv_request(C, TPid, Pkt, SvcName, Apps); - [] -> %% transport has gone down - ok - catch - error: badarg -> %% service has gone down (and taken table with it) - ok - end. - -%% recv_request/5 - -recv_request(#conn{apps = SApps, caps = Caps}, TPid, Pkt, SvcName, Apps) -> - #diameter_caps{origin_host = {OH,_}, - origin_realm = {OR,_}} - = Caps, - - #diameter_packet{header = #diameter_header{application_id = Id}} - = Pkt, - - recv_request(find_recv_app(Id, SApps), - {SvcName, OH, OR}, - TPid, - Apps, - Caps, - Pkt). - -%% find_recv_app/2 - -%% No one should be sending the relay identifier. -find_recv_app(?APP_ID_RELAY, _) -> - false; - -%% With any other id we either support it locally or as a relay. -find_recv_app(Id, SApps) -> - keyfind([Id, ?APP_ID_RELAY], 1, SApps). - -%% keyfind/3 - -keyfind([], _, _) -> - false; -keyfind([Key | Rest], Pos, L) -> - case lists:keyfind(Key, Pos, L) of - false -> - keyfind(Rest, Pos, L); - T -> - T - end. - -%% recv_request/6 - -recv_request({Id, Alias}, T, TPid, Apps, Caps, Pkt) -> - #diameter_app{dictionary = Dict} - = A - = find_app(Alias, Apps), - recv_request(T, {TPid, Caps}, A, diameter_codec:decode(Id, Dict, Pkt)); -%% Note that the decode is different depending on whether or not Id is -%% ?APP_ID_RELAY. - -%% DIAMETER_APPLICATION_UNSUPPORTED 3007 -%% A request was sent for an application that is not supported. - -recv_request(false, T, TPid, _, _, Pkt) -> - As = collect_avps(Pkt), - protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}). - -collect_avps(Pkt) -> - case diameter_codec:collect_avps(Pkt) of - {_Bs, As} -> - As; - As -> - As - end. - -%% recv_request/4 - -%% Wrong number of bits somewhere in the message: reply. -%% -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. -%% -recv_request(T, {TPid, _}, _, #diameter_packet{errors = [Bs | _]} = Pkt) - when is_bitstring(Bs) -> - protocol_error(3009, T, TPid, Pkt); - -%% Either we support this application but don't recognize the command -%% or we're a relay and the command isn't proxiable. -%% -%% DIAMETER_COMMAND_UNSUPPORTED 3001 -%% The Request contained a Command-Code that the receiver did not -%% recognize or support. This MUST be used when a Diameter node -%% receives an experimental command that it does not understand. -%% -recv_request(T, - {TPid, _}, - #diameter_app{id = Id}, - #diameter_packet{header = #diameter_header{is_proxiable = P}, - msg = M} - = Pkt) - when ?APP_ID_RELAY /= Id, undefined == M; - ?APP_ID_RELAY == Id, not P -> - protocol_error(3001, T, TPid, Pkt); - -%% Error bit was set on a request. -%% -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. -%% -recv_request(T, - {TPid, _}, - _, - #diameter_packet{header = #diameter_header{is_error = true}} - = Pkt) -> - protocol_error(3008, T, TPid, Pkt); - -%% A message in a locally supported application or a proxiable message -%% in the relay application. Don't distinguish between the two since -%% each application has its own callback config. That is, the user can -%% easily distinguish between the two cases. -recv_request(T, TC, App, Pkt) -> - request_cb(T, TC, App, examine(Pkt)). - -%% Note that there may still be errors but these aren't protocol -%% (3xxx) errors that lead to an answer-message. - -request_cb({SvcName, _OH, _OR} = T, TC, App, Pkt) -> - request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), App, T, TC, Pkt). - -%% examine/1 -%% -%% Look for errors in a decoded message. Length errors result in -%% decode failure in diameter_codec. - -examine(#diameter_packet{header = #diameter_header{version - = ?DIAMETER_VERSION}} - = Pkt) -> - Pkt; - -%% DIAMETER_UNSUPPORTED_VERSION 5011 -%% This error is returned when a request was received, whose version -%% number is unsupported. - -examine(#diameter_packet{errors = Es} = Pkt) -> - Pkt#diameter_packet{errors = [5011 | Es]}. -%% It's odd/unfortunate that this isn't a protocol error. - -%% request_cb/5 - -%% A reply may be an answer-message, constructed either here or by -%% the handle_request callback. The header from the incoming request -%% is passed into the encode so that it can retrieve the relevant -%% command code in this case. It will also then ignore Dict and use -%% the base encoder. -request_cb({reply, Ans}, - #diameter_app{dictionary = Dict}, - _, - {TPid, _}, - Pkt) -> - reply(Ans, Dict, TPid, Pkt); - -%% An 3xxx result code, for which the E-bit is set in the header. -request_cb({protocol_error, RC}, _, T, {TPid, _}, Pkt) - when 3000 =< RC, RC < 4000 -> - protocol_error(RC, T, TPid, Pkt); - -%% RFC 3588 says we must reply 3001 to anything unrecognized or -%% unsupported. 'noreply' is undocumented (and inappropriately named) -%% backwards compatibility for this, protocol_error the documented -%% alternative. -request_cb(noreply, _, T, {TPid, _}, Pkt) -> - protocol_error(3001, T, TPid, Pkt); - -%% Relay a request to another peer. This is equivalent to doing an -%% explicit call/4 with the message in question except that (1) a loop -%% will be detected by examining Route-Record AVP's, (3) a -%% Route-Record AVP will be added to the outgoing request and (3) the -%% End-to-End Identifier will default to that in the -%% #diameter_header{} without the need for an end_to_end_identifier -%% option. -%% -%% relay and proxy are similar in that they require the same handling -%% with respect to Route-Record and End-to-End identifier. The -%% difference is that a proxy advertises specific applications, while -%% a relay advertises the relay application. If a callback doesn't -%% want to distinguish between the cases in the callback return value -%% then 'resend' is a neutral alternative. -%% -request_cb({A, Opts}, - #diameter_app{id = Id} - = App, - T, - TC, - Pkt) - when A == relay, Id == ?APP_ID_RELAY; - A == proxy, Id /= ?APP_ID_RELAY; - A == resend -> - resend(Opts, App, T, TC, Pkt); - -request_cb(discard, _, _, _, _) -> - ok; - -request_cb({eval, RC, F}, App, T, TC, Pkt) -> - request_cb(RC, App, T, TC, Pkt), - diameter_lib:eval(F). - -%% protocol_error/4 - -protocol_error(RC, {_, OH, OR}, TPid, #diameter_packet{avps = Avps} = Pkt) -> - ?LOG({error, RC}, Pkt), - reply(answer_message({OH, OR, RC}, Avps), ?BASE, TPid, Pkt). - -%% resend/5 -%% -%% Resend a message as a relay or proxy agent. - -resend(Opts, - #diameter_app{} = App, - {_SvcName, OH, _OR} = T, - {_TPid, _Caps} = TC, - #diameter_packet{avps = Avps} = Pkt) -> - {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'), - resend(is_loop(Code, Vid, OH, Avps), Opts, App, T, TC, Pkt). - -%% DIAMETER_LOOP_DETECTED 3005 -%% An agent detected a loop while trying to get the message to the -%% intended recipient. The message MAY be sent to an alternate peer, -%% if one is available, but the peer reporting the error has -%% identified a configuration problem. - -resend(true, _, _, T, {TPid, _}, Pkt) -> %% Route-Record loop - protocol_error(3005, T, TPid, Pkt); - -%% 6.1.8. Relaying and Proxying Requests -%% -%% A relay or proxy agent MUST append a Route-Record AVP to all requests -%% forwarded. The AVP contains the identity of the peer the request was -%% received from. - -resend(false, - Opts, - App, - {SvcName, _, _} = T, - {TPid, #diameter_caps{origin_host = {_, OH}}}, - #diameter_packet{header = Hdr0, - avps = Avps} - = Pkt) -> - Route = #diameter_avp{data = {?BASE, 'Route-Record', OH}}, - Seq = diameter_session:sequence(), - Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, - Msg = [Hdr, Route | Avps], - resend(call(SvcName, App, Msg, Opts), T, TPid, Pkt). -%% The incoming request is relayed with the addition of a -%% Route-Record. Note the requirement on the return from call/4 below, -%% which places a requirement on the value returned by the -%% handle_answer callback of the application module in question. -%% -%% Note that there's nothing stopping the request from being relayed -%% back to the sender. A pick_peer callback may want to avoid this but -%% a smart peer might recognize the potential loop and choose another -%% route. A less smart one will probably just relay the request back -%% again and force us to detect the loop. A pick_peer that wants to -%% avoid this can specify filter to avoid the possibility. -%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. -%% -%% RFC 6.3 says that a relay agent does not modify Origin-Host but -%% says nothing about a proxy. Assume it should behave the same way. - -%% resend/4 -%% -%% Relay a reply to a relayed request. - -%% Answer from the peer: reset the hop by hop identifier and send. -resend(#diameter_packet{bin = B} - = Pkt, - _, - TPid, - #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, - transport_data = TD}) -> - send(TPid, Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), - transport_data = TD}); -%% TODO: counters - -%% Or not: DIAMETER_UNABLE_TO_DELIVER. -resend(_, T, TPid, Pkt) -> - protocol_error(3002, T, TPid, Pkt). - -%% is_loop/4 -%% -%% Is there a Route-Record AVP with our Origin-Host? - -is_loop(Code, - Vid, - Bin, - [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> - true; - -is_loop(_, _, _, []) -> - false; - -is_loop(Code, Vid, OH, [_ | Avps]) - when is_binary(OH) -> - is_loop(Code, Vid, OH, Avps); - -is_loop(Code, Vid, OH, Avps) -> - is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps). - -%% reply/4 -%% -%% Send a locally originating reply. - -%% No errors or a diameter_header/avp list. -reply(Msg, Dict, TPid, #diameter_packet{errors = Es, - transport_data = TD} - = ReqPkt) - when [] == Es; - is_record(hd(Msg), diameter_header) -> - Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)), - incr(send, Pkt, Dict, TPid), %% count result codes in sent answers - send(TPid, Pkt#diameter_packet{transport_data = TD}); - -%% Or not: set Result-Code and Failed-AVP AVP's. -reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) -> - reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), - Dict, - TPid, - Pkt#diameter_packet{errors = []}). - -%% make_reply_packet/2 - -%% Binaries and header/avp lists are sent as-is. -make_reply_packet(Bin, _) - when is_binary(Bin) -> - #diameter_packet{bin = Bin}; -make_reply_packet([#diameter_header{} | _] = Msg, _) -> - #diameter_packet{msg = Msg}; - -%% Otherwise a reply message clears the R and T flags and retains the -%% P flag. The E flag will be set at encode. -make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) -> - Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, - is_request = false, - is_error = undefined, - is_retransmitted = false}, - #diameter_packet{header = Hdr, - msg = Msg}. - -%% rc/1 - -rc({RC, _}) -> - RC; -rc(RC) -> - RC. - -%% rc/4 - -rc(Rec, RC, Failed, Dict) - when is_integer(RC) -> - set(Rec, [{'Result-Code', RC} | failed_avp(Rec, Failed, Dict)], Dict). - -%% Reply as name and tuple list ... -set([_|_] = Ans, Avps, _) -> - Ans ++ Avps; %% Values nearer tail take precedence. - -%% ... or record. -set(Rec, Avps, Dict) -> - Dict:'#set-'(Avps, Rec). - -%% failed_avp/3 - -failed_avp(_, [] = No, _) -> - No; - -failed_avp(Rec, Failed, Dict) -> - [fa(Rec, [{'AVP', Failed}], Dict)]. - -%% Reply as name and tuple list ... -fa([MsgName | Values], FailedAvp, Dict) -> - R = Dict:msg2rec(MsgName), - try - Dict:'#info-'(R, {index, 'Failed-AVP'}), - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = proplists:get_value('AVP', Values, []), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end; - -%% ... or record. -fa(Rec, FailedAvp, Dict) -> - try - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = Dict:'get-'('AVP', Rec), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end. - -%% 3. Diameter Header -%% -%% E(rror) - If set, the message contains a protocol error, -%% and the message will not conform to the ABNF -%% described for this command. Messages with the 'E' -%% bit set are commonly referred to as error -%% messages. This bit MUST NOT be set in request -%% messages. See Section 7.2. - -%% 3.2. Command Code ABNF specification -%% -%% e-bit = ", ERR" -%% ; If present, the 'E' bit in the Command -%% ; Flags is set, indicating that the answer -%% ; message contains a Result-Code AVP in -%% ; the "protocol error" class. - -%% 7.1.3. Protocol Errors -%% -%% Errors that fall within the Protocol Error category SHOULD be treated -%% on a per-hop basis, and Diameter proxies MAY attempt to correct the -%% error, if it is possible. Note that these and only these errors MUST -%% only be used in answer messages whose 'E' bit is set. - -%% Thus, only construct answers to protocol errors. Other errors -%% require an message-specific answer and must be handled by the -%% application. - -%% 6.2. Diameter Answer Processing -%% -%% When a request is locally processed, the following procedures MUST be -%% applied to create the associated answer, in addition to any -%% additional procedures that MAY be discussed in the Diameter -%% application defining the command: -%% -%% - The same Hop-by-Hop identifier in the request is used in the -%% answer. -%% -%% - The local host's identity is encoded in the Origin-Host AVP. -%% -%% - The Destination-Host and Destination-Realm AVPs MUST NOT be -%% present in the answer message. -%% -%% - The Result-Code AVP is added with its value indicating success or -%% failure. -%% -%% - If the Session-Id is present in the request, it MUST be included -%% in the answer. -%% -%% - Any Proxy-Info AVPs in the request MUST be added to the answer -%% message, in the same order they were present in the request. -%% -%% - The 'P' bit is set to the same value as the one in the request. -%% -%% - The same End-to-End identifier in the request is used in the -%% answer. -%% -%% Note that the error messages (see Section 7.3) are also subjected to -%% the above processing rules. - -%% 7.3. Error-Message AVP -%% -%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY -%% accompany a Result-Code AVP as a human readable error message. The -%% Error-Message AVP is not intended to be useful in real-time, and -%% SHOULD NOT be expected to be parsed by network entities. - -%% answer_message/2 - -answer_message({OH, OR, RC}, Avps) -> - {Code, _, Vid} = ?BASE:avp_header('Session-Id'), - ['answer-message', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Result-Code', RC} - | session_id(Code, Vid, Avps)]. - -session_id(Code, Vid, Avps) - when is_list(Avps) -> - try - {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), - [{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}] - catch - error: _ -> - [] - end. - -%% find_avp/3 - -find_avp(Code, Vid, Avps) - when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> - find(fun(A) -> is_avp(Code, Vid, A) end, Avps). - -%% The final argument here could be a list of AVP's, depending on the case, -%% but we're only searching at the top level. -is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> - true; -is_avp(_, _, _) -> - false. - -find(_, []) -> - false; -find(Pred, [H|T]) -> - case Pred(H) of - true -> - {value, H}; - false -> - find(Pred, T) - end. - -%% 7. Error Handling -%% -%% There are certain Result-Code AVP application errors that require -%% additional AVPs to be present in the answer. In these cases, the -%% Diameter node that sets the Result-Code AVP to indicate the error -%% MUST add the AVPs. Examples are: -%% -%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) -%% set, causes an answer to be sent with the Result-Code AVP set to -%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the -%% offending AVP. -%% -%% - An AVP that is received with an unrecognized value causes an -%% answer to be returned with the Result-Code AVP set to -%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the -%% AVP causing the error. -%% -%% - A command is received with an AVP that is omitted, yet is -%% mandatory according to the command's ABNF. The receiver issues an -%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and -%% creates an AVP with the AVP Code and other fields set as expected -%% in the missing AVP. The created AVP is then added to the Failed- -%% AVP AVP. -%% -%% The Result-Code AVP describes the error that the Diameter node -%% encountered in its processing. In case there are multiple errors, -%% the Diameter node MUST report only the first error it encountered -%% (detected possibly in some implementation dependent order). The -%% specific errors that can be described by this AVP are described in -%% the following section. - -%% 7.5. Failed-AVP AVP -%% -%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides -%% debugging information in cases where a request is rejected or not -%% fully processed due to erroneous information in a specific AVP. The -%% value of the Result-Code AVP will provide information on the reason -%% for the Failed-AVP AVP. -%% -%% The possible reasons for this AVP are the presence of an improperly -%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP -%% value, the omission of a required AVP, the presence of an explicitly -%% excluded AVP (see tables in Section 10), or the presence of two or -%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 -%% occurrences. -%% -%% A Diameter message MAY contain one Failed-AVP AVP, containing the -%% entire AVP that could not be processed successfully. If the failure -%% reason is omission of a required AVP, an AVP with the missing AVP -%% code, the missing vendor id, and a zero filled payload of the minimum -%% required length for the omitted AVP will be added. - -%%% --------------------------------------------------------------------------- -%%% # handle_answer/3 -%%% --------------------------------------------------------------------------- - -%% Process an answer message in call-specific process. - -handle_answer(SvcName, _, {error, Req, Reason}) -> - handle_error(Req, Reason, SvcName); - -handle_answer(SvcName, - AnswerErrors, - {answer, #request{dictionary = Dict} = Req, Pkt}) -> - a(examine(diameter_codec:decode(Dict, Pkt)), - SvcName, - AnswerErrors, - Req). - -%% We don't really need to do a full decode if we're a relay and will -%% just resend with a new hop by hop identifier, but might a proxy -%% want to examine the answer? - -a(#diameter_packet{errors = []} - = Pkt, - SvcName, - AE, - #request{transport = TPid, - dictionary = Dict, - caps = Caps, - packet = P} - = Req) -> - try - incr(in, Pkt, Dict, TPid) - of - _ -> - cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]) - catch - exit: {invalid_error_bit, _} = E -> - e(Pkt#diameter_packet{errors = [E]}, SvcName, AE, Req) - end; - -a(#diameter_packet{} = Pkt, SvcName, AE, Req) -> - e(Pkt, SvcName, AE, Req). - -e(Pkt, SvcName, callback, #request{transport = TPid, - caps = Caps, - packet = Pkt} - = Req) -> - cb(Req, handle_answer, [Pkt, msg(Pkt), SvcName, {TPid, Caps}]); -e(Pkt, SvcName, report, Req) -> - x(errors, handle_answer, [SvcName, Req, Pkt]); -e(Pkt, SvcName, discard, Req) -> - x({errors, handle_answer, [SvcName, Req, Pkt]}). - -%% Note that we don't check that the application id in the answer's -%% header is what we expect. (TODO: Does the rfc says anything about -%% this?) - -%% incr/4 -%% -%% Increment a stats counter for an incoming or outgoing message. - -%% TODO: fix -incr(_, #diameter_packet{msg = undefined}, _, _) -> - ok; - -incr(Dir, Pkt, Dict, TPid) - when is_pid(TPid) -> - #diameter_packet{header = #diameter_header{is_error = E} - = Hdr, - msg = Rec} - = Pkt, - - D = choose(E, ?BASE, Dict), - RC = int(get_avp_value(D, 'Result-Code', Rec)), - PE = is_protocol_error(RC), - - %% Check that the E bit is set only for 3xxx result codes. - (not (E orelse PE)) - orelse (E andalso PE) - orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), - - Ctr = rc_counter(D, Rec, RC), - is_tuple(Ctr) - andalso incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). - -%% incr/2 - -incr(TPid, Counter) -> - diameter_stats:incr(Counter, TPid, 1). - -%% RFC 3588, 7.6: -%% -%% All Diameter answer messages defined in vendor-specific -%% applications MUST include either one Result-Code AVP or one -%% Experimental-Result AVP. -%% -%% Maintain statistics assuming one or the other, not both, which is -%% surely the intent of the RFC. - -rc_counter(_, _, RC) - when is_integer(RC) -> - {'Result-Code', RC}; -rc_counter(D, Rec, _) -> - rcc(get_avp_value(D, 'Experimental-Result', Rec)). - -%% Outgoing answers may be in any of the forms messages can be sent -%% in. Incoming messages will be records. We're assuming here that the -%% arity of the result code AVP's is 0 or 1. - -rcc([{_,_,RC} = T]) - when is_integer(RC) -> - T; -rcc({_,_,RC} = T) - when is_integer(RC) -> - T; -rcc(_) -> - undefined. - -int([N]) - when is_integer(N) -> - N; -int(N) - when is_integer(N) -> - N; -int(_) -> - undefined. - -is_protocol_error(RC) -> - 3000 =< RC andalso RC < 4000. - --spec x(any(), atom(), list()) -> no_return(). - -%% Warn and exit request process on errors in an incoming answer. -x(Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - x(Reason). - -x(T) -> - exit(T). - -%%% --------------------------------------------------------------------------- -%%% # failover/[23] -%%% --------------------------------------------------------------------------- - -%% Failover as a consequence of request_peer_down/2. -failover({_, #request{handler = Pid} = Req, TRef}, S) -> - Pid ! {failover, TRef, rt(Req, S)}. - -%% Failover as a consequence of store_request/4. -failover(TRef, Seqs, S) - when is_reference(TRef) -> - case lookup_request(Seqs, TRef) of - #request{} = Req -> - failover({Seqs, Req, TRef}, S); - false -> - ok - end. - -%% prepare_request returned a binary ... -rt(#request{packet = #diameter_packet{msg = undefined}}, _) -> - false; %% TODO: Not what we should do. - -%% ... or not. -rt(#request{packet = #diameter_packet{msg = Msg}, dictionary = D} = Req, S) -> - find_transport(get_destination(Msg, D), Req, S). - -%%% --------------------------------------------------------------------------- -%%% # report_status/5 -%%% --------------------------------------------------------------------------- - -report_status(Status, - #peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts}, - #conn{apps = [_|_] = As, - caps = Caps}, - #state{service_name = SvcName} - = S, - Extra) -> - share_peer(Status, Caps, As, TPid, S), - Info = [Status, Ref, {TPid, Caps}, {type(Type), Opts} | Extra], - send_event(SvcName, list_to_tuple(Info)). - -%% send_event/2 - -send_event(SvcName, Info) -> - send_event(#diameter_event{service = SvcName, - info = Info}). - -send_event(#diameter_event{service = SvcName} = E) -> - lists:foreach(fun({_, Pid}) -> Pid ! E end, subscriptions(SvcName)). - -%%% --------------------------------------------------------------------------- -%%% # share_peer/5 -%%% --------------------------------------------------------------------------- - -share_peer(up, Caps, Aliases, TPid, #state{share_peers = true, - service_name = Svc}) -> - diameter_peer:notify(Svc, {peer, TPid, Aliases, Caps}); - -share_peer(_, _, _, _, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # share_peers/2 -%%% --------------------------------------------------------------------------- - -share_peers(Pid, #state{share_peers = true, - local_peers = PDict}) -> - ?Dict:fold(fun(A,Ps,ok) -> sp(Pid, A, Ps), ok end, ok, PDict); - -share_peers(_, #state{share_peers = false}) -> - ok. - -sp(Pid, Alias, Peers) -> - lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers). - -%%% --------------------------------------------------------------------------- -%%% # remote_peer_up/4 -%%% --------------------------------------------------------------------------- - -remote_peer_up(Pid, Aliases, Caps, #state{use_shared_peers = true, - service = Svc, - shared_peers = PDict} - = S) -> - #diameter_service{applications = Apps} = Svc, - Update = lists:filter(fun(A) -> - lists:keymember(A, #diameter_app.alias, Apps) - end, - Aliases), - S#state{shared_peers = rpu(Pid, Caps, PDict, Update)}; - -remote_peer_up(_, _, _, #state{use_shared_peers = false} = S) -> - S. - -rpu(_, _, PDict, []) -> - PDict; -rpu(Pid, Caps, PDict, Aliases) -> - erlang:monitor(process, Pid), - T = {Pid, Caps}, - lists:foldl(fun(A,D) -> ?Dict:append(A, T, D) end, - PDict, - Aliases). - -%%% --------------------------------------------------------------------------- -%%% # remote_peer_down/2 -%%% --------------------------------------------------------------------------- - -remote_peer_down(Pid, #state{use_shared_peers = true, - shared_peers = PDict} - = S) -> - S#state{shared_peers = lists:foldl(fun(A,D) -> rpd(Pid, A, D) end, - PDict, - ?Dict:fetch_keys(PDict))}. - -rpd(Pid, Alias, PDict) -> - ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict). - -%%% --------------------------------------------------------------------------- -%%% find_transport/[34] -%%% -%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Initial call, from an arbitrary process. -find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) -> - #diameter_service{applications = Apps} = Svc, - ft(find_send_app(Alias, Apps), Msg, Opts, S); - -%% Relay or proxy send. -find_transport(#diameter_app{} = App, Msg, Opts, S) -> - ft(App, Msg, Opts, S). - -ft(#diameter_app{module = Mod, dictionary = D} = App, Msg, Opts, S) -> - #options{filter = Filter, - extra = Xtra} - = Opts, - pick_peer(App#diameter_app{module = Mod ++ Xtra}, - get_destination(Msg, D), - Filter, - S); -ft(false = No, _, _, _) -> - No. - -%% This can't be used if we're a relay and sending a message -%% in an application not known locally. (TODO) -find_send_app(Alias, Apps) -> - case lists:keyfind(Alias, #diameter_app.alias, Apps) of - #diameter_app{id = ?APP_ID_RELAY} -> - false; - T -> - T - end. - -%% Retransmission, in the service process. -find_transport([_,_] = RH, - Req, - #state{service = #diameter_service{pid = Pid, - applications = Apps}} - = S) - when self() == Pid -> - #request{app = Alias, - filter = Filter, - module = ModX} - = Req, - #diameter_app{} - = App - = lists:keyfind(Alias, #diameter_app.alias, Apps), - - pick_peer(App#diameter_app{module = ModX}, - RH, - Filter, - S). - -%% get_destination/2 - -get_destination(Msg, Dict) -> - [str(get_avp_value(Dict, 'Destination-Realm', Msg)), - str(get_avp_value(Dict, 'Destination-Host', Msg))]. - -%% This is not entirely correct. The avp could have an arity 1, in -%% which case an empty list is a DiameterIdentity of length 0 rather -%% than the list of no values we treat it as by mapping to undefined. -%% This behaviour is documented. -str([]) -> - undefined; -str(T) -> - T. - -%% get_avp_value/3 -%% -%% Find an AVP in a message of one of three forms: -%% -%% - a message record (as generated from a .dia spec) or -%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. -%% - a list of a #diameter_header{} followed by #diameter_avp{} records, -%% -%% In the first two forms a dictionary module is used at encode to -%% identify the type of the AVP and its arity in the message in -%% question. The third form allows messages to be sent as is, without -%% a dictionary, which is needed in the case of relay agents, for one. - -get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> - try - {Code, _, VId} = Dict:avp_header(Name), - [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> - C /= Code orelse V /= VId - end, - Avps), - avp_decode(Dict, Name, A) - catch - error: _ -> - undefined - end; - -get_avp_value(_, Name, [_MsgName | Avps]) -> - case lists:keyfind(Name, 1, Avps) of - {_, V} -> - V; - _ -> - undefined - end; - -%% Message is typically a record but not necessarily: diameter:call/4 -%% can be passed an arbitrary term. -get_avp_value(Dict, Name, Rec) -> - try - Dict:'#get-'(Name, Rec) - catch - error:_ -> - undefined - end. - -avp_decode(Dict, Name, #diameter_avp{value = undefined, - data = Bin}) -> - Dict:avp(decode, Bin, Name); -avp_decode(_, _, #diameter_avp{value = V}) -> - V. - -%%% --------------------------------------------------------------------------- -%%% # pick_peer(App, [DestRealm, DestHost], Filter, #state{}) -%%% -%%% Output: {TransportPid, #diameter_caps{}, App} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Find transports to a given realm/host. - -pick_peer(#diameter_app{alias = Alias} - = App, - [_,_] = RH, - Filter, - #state{local_peers = L, - shared_peers = S, - service_name = SvcName, - service = #diameter_service{pid = Pid}}) -> - pick_peer(peers(Alias, RH, Filter, L), - peers(Alias, RH, Filter, S), - Pid, - SvcName, - App). - -%% pick_peer/5 - -pick_peer([], [], _, _, _) -> - false; - -%% App state is mutable but we're not in the service process: go there. -pick_peer(Local, Remote, Pid, _SvcName, #diameter_app{mutable = true} = App) - when self() /= Pid -> - call_service(Pid, {pick_peer, Local, Remote, App}); - -%% App state isn't mutable or it is and we're in the service process: -%% do the deed. -pick_peer(Local, - Remote, - _Pid, - SvcName, - #diameter_app{module = ModX, - alias = Alias, - init_state = S, - mutable = M} - = App) -> - MFA = {ModX, pick_peer, [Local, Remote, SvcName]}, - - try state_cb(App, MFA) of - {ok, {TPid, #diameter_caps{} = Caps}} when is_pid(TPid) -> - {TPid, Caps, App}; - {{TPid, #diameter_caps{} = Caps}, ModS} when is_pid(TPid), M -> - mod_state(Alias, ModS), - {TPid, Caps, App}; - {false = No, ModS} when M -> - mod_state(Alias, ModS), - No; - {ok, false = No} -> - No; - false = No -> - No; - {{TPid, #diameter_caps{} = Caps}, S} when is_pid(TPid) -> - {TPid, Caps, App}; %% Accept returned state in the immutable - {false = No, S} -> %% case as long it isn't changed. - No; - T -> - diameter_lib:error_report({invalid, T, App}, MFA) - catch - E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA) - end. - -%% peers/4 - -peers(Alias, RH, Filter, Peers) -> - case ?Dict:find(Alias, Peers) of - {ok, L} -> - ps(L, RH, Filter, {[],[]}); - error -> - [] - end. - -%% Place a peer whose Destination-Host/Realm matches those of the -%% request at the front of the result list. Could add some sort of -%% 'sort' option to allow more control. - -ps([], _, _, {Ys, Ns}) -> - lists:reverse(Ys, Ns); -ps([{_TPid, #diameter_caps{} = Caps} = TC | Rest], RH, Filter, Acc) -> - ps(Rest, RH, Filter, pacc(caps_filter(Caps, RH, Filter), - caps_filter(Caps, RH, {all, [host, realm]}), - TC, - Acc)). - -pacc(true, true, Peer, {Ts, Fs}) -> - {[Peer|Ts], Fs}; -pacc(true, false, Peer, {Ts, Fs}) -> - {Ts, [Peer|Fs]}; -pacc(_, _, _, Acc) -> - Acc. - -%% caps_filter/3 - -caps_filter(C, RH, {neg, F}) -> - not caps_filter(C, RH, F); - -caps_filter(C, RH, {all, L}) - when is_list(L) -> - lists:all(fun(F) -> caps_filter(C, RH, F) end, L); - -caps_filter(C, RH, {any, L}) - when is_list(L) -> - lists:any(fun(F) -> caps_filter(C, RH, F) end, L); - -caps_filter(#diameter_caps{origin_host = {_,OH}}, [_,DH], host) -> - eq(undefined, DH, OH); - -caps_filter(#diameter_caps{origin_realm = {_,OR}}, [DR,_], realm) -> - eq(undefined, DR, OR); - -caps_filter(C, _, Filter) -> - caps_filter(C, Filter). - -%% caps_filter/2 - -caps_filter(_, none) -> - true; - -caps_filter(#diameter_caps{origin_host = {_,OH}}, {host, H}) -> - eq(any, H, OH); - -caps_filter(#diameter_caps{origin_realm = {_,OR}}, {realm, R}) -> - eq(any, R, OR); - -%% Anything else is expected to be an eval filter. Filter failure is -%% documented as being equivalent to a non-matching filter. - -caps_filter(C, T) -> - try - {eval, F} = T, - diameter_lib:eval([F,C]) - catch - _:_ -> false - end. - -eq(Any, Id, PeerId) -> - Any == Id orelse try - iolist_to_binary(Id) == iolist_to_binary(PeerId) - catch - _:_ -> false - end. -%% OctetString() can be specified as an iolist() so test for string -%% rather then term equality. - -%% transports/1 - -transports(#state{peerT = PeerT}) -> - ets:select(PeerT, [{#peer{conn = '$1', _ = '_'}, - [{'is_pid', '$1'}], - ['$1']}]). - -%%% --------------------------------------------------------------------------- -%%% # service_info/2 -%%% --------------------------------------------------------------------------- - -%% The config passed to diameter:start_service/2. --define(CAP_INFO, ['Origin-Host', - 'Origin-Realm', - 'Vendor-Id', - 'Product-Name', - 'Origin-State-Id', - 'Host-IP-Address', - 'Supported-Vendor-Id', - 'Auth-Application-Id', - 'Inband-Security-Id', - 'Acct-Application-Id', - 'Vendor-Specific-Application-Id', - 'Firmware-Revision']). - --define(ALL_INFO, [capabilities, - applications, - transport, - pending, - statistics]). - -service_info(Items, S) - when is_list(Items) -> - [{complete(I), service_info(I,S)} || I <- Items]; -service_info(Item, S) - when is_atom(Item) -> - service_info(Item, S, true). - -service_info(Item, #state{service = Svc} = S, Complete) -> - case Item of - name -> - S#state.service_name; - 'Origin-Host' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_host; - 'Origin-Realm' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_realm; - 'Vendor-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.vendor_id; - 'Product-Name' -> - (Svc#diameter_service.capabilities) - #diameter_caps.product_name; - 'Origin-State-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_state_id; - 'Host-IP-Address' -> - (Svc#diameter_service.capabilities) - #diameter_caps.host_ip_address; - 'Supported-Vendor-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.supported_vendor_id; - 'Auth-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.auth_application_id; - 'Inband-Security-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.inband_security_id; - 'Acct-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.acct_application_id; - 'Vendor-Specific-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.vendor_specific_application_id; - 'Firmware-Revision' -> - (Svc#diameter_service.capabilities) - #diameter_caps.firmware_revision; - capabilities -> service_info(?CAP_INFO, S); - applications -> info_apps(S); - transport -> info_transport(S); - pending -> info_pending(S); - statistics -> info_stats(S); - keys -> ?ALL_INFO ++ ?CAP_INFO; %% mostly for test - all -> service_info(?ALL_INFO, S); - _ when Complete -> service_info(complete(Item), S, false); - _ -> undefined - end. - -complete(Pre) -> - P = atom_to_list(Pre), - case [I || I <- [name | ?ALL_INFO] ++ ?CAP_INFO, - lists:prefix(P, atom_to_list(I))] - of - [I] -> I; - _ -> Pre - end. - -info_stats(#state{peerT = PeerT}) -> - Peers = ets:select(PeerT, [{#peer{ref = '$1', conn = '$2', _ = '_'}, - [{'is_pid', '$2'}], - [['$1', '$2']]}]), - diameter_stats:read(lists:append(Peers)). -%% TODO: include peer identities in return value - -info_transport(#state{peerT = PeerT, connT = ConnT}) -> - dict:fold(fun it/3, - [], - ets:foldl(fun(T,A) -> it_acc(ConnT, A, T) end, - dict:new(), - PeerT)). - -it(Ref, [[{type, connect} | _] = L], Acc) -> - [[{ref, Ref} | L] | Acc]; -it(Ref, [[{type, accept}, {options, Opts} | _] | _] = L, Acc) -> - [[{ref, Ref}, - {type, listen}, - {options, Opts}, - {accept, [lists:nthtail(2,A) || A <- L]}] - | Acc]. -%% Each entry has the same Opts. (TODO) - -it_acc(ConnT, Acc, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts, - op_state = OS, - started = T, - conn = TPid}) -> - dict:append(Ref, - [{type, Type}, - {options, Opts}, - {watchdog, {Pid, T, OS}} - | info_conn(ConnT, TPid)], - Acc). - -info_conn(ConnT, TPid) -> - info_conn(ets:lookup(ConnT, TPid)). - -info_conn([#conn{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> - [{peer, {Pid, T}}, - {apps, SApps}, - {caps, info_caps(Caps)}]; -info_conn([] = No) -> - No. - -info_caps(#diameter_caps{} = C) -> - lists:zip(record_info(fields, diameter_caps), tl(tuple_to_list(C))). - -info_apps(#state{service = #diameter_service{applications = Apps}}) -> - lists:map(fun mk_app/1, Apps). - -mk_app(#diameter_app{alias = Alias, - dictionary = Dict, - module = ModX, - id = Id}) -> - [{alias, Alias}, - {dictionary, Dict}, - {module, ModX}, - {id, Id}]. - -info_pending(#state{} = S) -> - MatchSpec = [{{'$1', - #request{transport = '$2', - from = '$3', - app = '$4', - _ = '_'}, - '_'}, - [?ORCOND([{'==', T, '$2'} || T <- transports(S)])], - [{{'$1', [{{app, '$4'}}, - {{transport, '$2'}}, - {{from, '$3'}}]}}]}], - - ets:select(?REQUEST_TABLE, MatchSpec). diff --git a/lib/diameter/src/app/diameter_service_sup.erl b/lib/diameter/src/app/diameter_service_sup.erl deleted file mode 100644 index 153fff902f..0000000000 --- a/lib/diameter/src/app/diameter_service_sup.erl +++ /dev/null @@ -1,64 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The supervisor of service processes. -%% - --module(diameter_service_sup). - --behaviour(supervisor). - --export([start_link/0, %% supervisor start - start_child/1]). %% service start - -%% supervisor callback --export([init/1]). - --define(NAME, ?MODULE). %% supervisor name - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% A service and its related processes (transport, peer_fwm and -%% watchdog) are all temporary since they're all restarted in -%% application code. A Transport and peer_fsm is restarted by a -%% watchdog as required by the RFC 3539 state machine, a watchdog is -%% restarted by service, and services are restarted by diameter_config. - -start_child(ServiceName) -> - supervisor:start_child(?NAME, [ServiceName]). - -%% init/1 - -init([]) -> - Mod = diameter_service, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/diameter_session.erl b/lib/diameter/src/app/diameter_session.erl deleted file mode 100644 index bb91e97f39..0000000000 --- a/lib/diameter/src/app/diameter_session.erl +++ /dev/null @@ -1,172 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_session). - --export([sequence/0, - session_id/1, - origin_state_id/0]). - -%% towards diameter_sup --export([init/0]). - --include("diameter_types.hrl"). - --define(INT64, 16#FFFFFFFFFFFFFFFF). --define(INT32, 16#FFFFFFFF). - -%% --------------------------------------------------------------------------- -%% # sequence/0 -%% -%% Output: 32-bit -%% --------------------------------------------------------------------------- - -%% 3588, 3: -%% -%% Hop-by-Hop Identifier -%% The Hop-by-Hop Identifier is an unsigned 32-bit integer field (in -%% network byte order) and aids in matching requests and replies. -%% The sender MUST ensure that the Hop-by-Hop identifier in a request -%% is unique on a given connection at any given time, and MAY attempt -%% to ensure that the number is unique across reboots. The sender of -%% an Answer message MUST ensure that the Hop-by-Hop Identifier field -%% contains the same value that was found in the corresponding -%% request. The Hop-by-Hop identifier is normally a monotonically -%% increasing number, whose start value was randomly generated. An -%% answer message that is received with an unknown Hop-by-Hop -%% Identifier MUST be discarded. -%% -%% End-to-End Identifier -%% The End-to-End Identifier is an unsigned 32-bit integer field (in -%% network byte order) and is used to detect duplicate messages. -%% Upon reboot implementations MAY set the high order 12 bits to -%% contain the low order 12 bits of current time, and the low order -%% 20 bits to a random value. Senders of request messages MUST -%% insert a unique identifier on each message. The identifier MUST -%% remain locally unique for a period of at least 4 minutes, even -%% across reboots. The originator of an Answer message MUST ensure -%% that the End-to-End Identifier field contains the same value that -%% was found in the corresponding request. The End-to-End Identifier -%% MUST NOT be modified by Diameter agents of any kind. The -%% combination of the Origin-Host (see Section 6.3) and this field is -%% used to detect duplicates. Duplicate requests SHOULD cause the -%% same answer to be transmitted (modulo the hop-by-hop Identifier -%% field and any routing AVPs that may be present), and MUST NOT -%% affect any state that was set when the original request was -%% processed. Duplicate answer messages that are to be locally -%% consumed (see Section 6.2) SHOULD be silently discarded. - --spec sequence() - -> 'Unsigned32'(). - -sequence() -> - Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT32, _SetVal = 0}, - ets:update_counter(diameter_sequence, sequence, Instr). - -%% --------------------------------------------------------------------------- -%% # origin_state_id/0 -%% --------------------------------------------------------------------------- - -%% 3588, 8.16: -%% -%% The Origin-State-Id AVP (AVP Code 278), of type Unsigned32, is a -%% monotonically increasing value that is advanced whenever a Diameter -%% entity restarts with loss of previous state, for example upon reboot. -%% Origin-State-Id MAY be included in any Diameter message, including -%% CER. -%% -%% A Diameter entity issuing this AVP MUST create a higher value for -%% this AVP each time its state is reset. A Diameter entity MAY set -%% Origin-State-Id to the time of startup, or it MAY use an incrementing -%% counter retained in non-volatile memory across restarts. - --spec origin_state_id() - -> 'Unsigned32'(). - -origin_state_id() -> - ets:lookup_element(diameter_sequence, origin_state_id, 2). - -%% --------------------------------------------------------------------------- -%% # session_id/1 -%% --------------------------------------------------------------------------- - -%% 3588, 8.8: -%% -%% The Session-Id MUST begin with the sender's identity encoded in the -%% DiameterIdentity type (see Section 4.4). The remainder of the -%% Session-Id is delimited by a ";" character, and MAY be any sequence -%% that the client can guarantee to be eternally unique; however, the -%% following format is recommended, (square brackets [] indicate an -%% optional element): -%% -%% ;;[;] -%% -%% and are decimal representations of the -%% high and low 32 bits of a monotonically increasing 64-bit value. The -%% 64-bit value is rendered in two part to simplify formatting by 32-bit -%% processors. At startup, the high 32 bits of the 64-bit value MAY be -%% initialized to the time, and the low 32 bits MAY be initialized to -%% zero. This will for practical purposes eliminate the possibility of -%% overlapping Session-Ids after a reboot, assuming the reboot process -%% takes longer than a second. Alternatively, an implementation MAY -%% keep track of the increasing value in non-volatile memory. -%% -%% is implementation specific but may include a modem's -%% device Id, a layer 2 address, timestamp, etc. - --spec session_id('DiameterIdentity'()) - -> 'OctetString'(). -%% Note that Session-Id has type UTF8String and that any OctetString -%% is a UTF8String. - -session_id(Host) -> - Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT64, _Set = 0}, - N = ets:update_counter(diameter_sequence, session_base, Instr), - Hi = N bsr 32, - Lo = N band ?INT32, - [Host, ";", integer_to_list(Hi), - ";", integer_to_list(Lo), - ";", atom_to_list(node())]. - -%% --------------------------------------------------------------------------- -%% # init/0 -%% --------------------------------------------------------------------------- - -init() -> - Now = now(), - random:seed(Now), - Time = time32(Now), - Seq = (?INT32 band (Time bsl 20)) bor (random:uniform(1 bsl 20) - 1), - ets:insert(diameter_sequence, [{origin_state_id, Time}, - {session_base, Time bsl 32}, - {sequence, Seq}]), - Time. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -%% The minimum value represented by a Time value. (See diameter_types.) -%% 32 bits extends to 2104. --define(TIME0, 62105714048). %% {{1968,1,20},{3,14,8}} - -time32(Now) -> - Time = calendar:now_to_universal_time(Now), - Diff = calendar:datetime_to_gregorian_seconds(Time) - ?TIME0, - Diff band ?INT32. diff --git a/lib/diameter/src/app/diameter_stats.erl b/lib/diameter/src/app/diameter_stats.erl deleted file mode 100644 index 71479afa95..0000000000 --- a/lib/diameter/src/app/diameter_stats.erl +++ /dev/null @@ -1,342 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Statistics collector. -%% - --module(diameter_stats). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([reg/1, reg/2, - incr/1, incr/2, incr/3, - read/1, - flush/0, flush/1]). - -%% supervisor callback --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% debug --export([state/0, - uptime/0]). - --include("diameter_internal.hrl"). - -%% ets table containing stats. reg(Pid, Ref) inserts a {Pid, Ref}, -%% incr(Counter, X, N) updates the counter keyed at {Counter, X}, and -%% Pid death causes counters keyed on {Counter, Pid} to be deleted and -%% added to those keyed on {Counter, Ref}. --define(TABLE, ?MODULE). - -%% Name of registered server. --define(SERVER, ?MODULE). - -%% Entries in the table. --define(REC(Key, Value), {Key, Value}). - -%% Server state. --record(state, {id = now()}). - --type counter() :: any(). --type contrib() :: any(). - -%%% --------------------------------------------------------------------------- -%%% # reg(Pid, Contrib) -%%% -%%% Description: Register a process as a contributor of statistics -%%% associated with a specified term. Statistics can be -%%% contributed by specifying either Pid or Contrib as -%%% the second argument to incr/3. Statistics contributed -%%% by Pid are folded into the corresponding entry for -%%% Contrib when the process dies. -%%% -%%% Contrib can be any term but should not be a pid -%%% passed as the first argument to reg/2. Subsequent -%%% registrations for the same Pid overwrite the association -%%% --------------------------------------------------------------------------- - --spec reg(pid(), contrib()) - -> true. - -reg(Pid, Contrib) - when is_pid(Pid) -> - call({reg, Pid, Contrib}). - --spec reg(contrib()) - -> true. - -reg(Ref) -> - reg(self(), Ref). - -%%% --------------------------------------------------------------------------- -%%% # incr(Counter, Contrib, N) -%%% -%%% Description: Increment a counter for the specified contributor. -%%% -%%% Contrib will typically be an argument passed to reg/2 -%%% but there's nothing that requires this. In particular, -%%% if Contrib is a pid that hasn't been registered then -%%% counters are unaffected by the death of the process. -%%% --------------------------------------------------------------------------- - --spec incr(counter(), contrib(), integer()) - -> integer(). - -incr(Ctr, Contrib, N) -> - update_counter({Ctr, Contrib}, N). - -incr(Ctr, N) - when is_integer(N) -> - incr(Ctr, self(), N); - -incr(Ctr, Contrib) -> - incr(Ctr, Contrib, 1). - -incr(Ctr) -> - incr(Ctr, self(), 1). - -%%% --------------------------------------------------------------------------- -%%% # read(Contribs) -%%% -%%% Description: Retrieve counters for the specified contributors. -%%% --------------------------------------------------------------------------- - --spec read([contrib()]) - -> [{contrib(), [{counter(), integer()}]}]. - -read(Contribs) -> - lists:foldl(fun(?REC({T,C}, N), D) -> orddict:append(C, {T,N}, D) end, - orddict:new(), - ets:select(?TABLE, [{?REC({'_', '$1'}, '_'), - [?ORCOND([{'=:=', '$1', {const, C}} - || C <- Contribs])], - ['$_']}])). - -%%% --------------------------------------------------------------------------- -%%% # flush(Contrib) -%%% -%%% Description: Retrieve and delete statistics for the specified -%%% contributor. -%%% -%%% If Contrib is a pid registered with reg/2 then statistics -%%% for both and its associated contributor are retrieved. -%%% --------------------------------------------------------------------------- - --spec flush(contrib()) - -> [{counter(), integer()}]. - -flush(Contrib) -> - try - call({flush, Contrib}) - catch - exit: _ -> - [] - end. - -flush() -> - flush(self()). - -%%% --------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init(_) -%%% -%%% Output: {ok, State} -%%% ---------------------------------------------------------- - -init([]) -> - ets:new(?TABLE, [named_table, ordered_set, public]), - {ok, #state{}}. - -%% ---------------------------------------------------------- -%% handle_call(Request, From, State) -%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call({reg, Pid, Contrib}, _From, State) -> - monitor(not ets:member(?TABLE, Pid), Pid), - {reply, insert(?REC(Pid, Contrib)), State}; - -handle_call({flush, Contrib}, _From, State) -> - {reply, fetch(Contrib), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%% ---------------------------------------------------------- -%% handle_cast(Request, State) -%% ---------------------------------------------------------- - -handle_cast({incr, Rec}, State) -> - update_counter(Rec), - {noreply, State}; - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% handle_info(Request, State) -%% ---------------------------------------------------------- - -handle_info({'DOWN', _MRef, process, Pid, _}, State) -> - down(Pid), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% terminate(Reason, State) -%% ---------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%% ---------------------------------------------------------- -%% code_change(OldVsn, State, Extra) -%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -%% monitor/2 - -monitor(true, Pid) -> - erlang:monitor(process, Pid); -monitor(false = No, _) -> - No. - -%% down/1 - -down(Pid) -> - L = ets:match_object(?TABLE, ?REC({'_', Pid}, '_')), - [?REC(_, Ref) = T] = lookup(Pid), - fold(Ref, L), - delete_object(T), - delete(L). - -%% Fold Pid-based entries into Ref-based ones. -fold(Ref, L) -> - lists:foreach(fun(?REC({K, _}, V)) -> update_counter({{K, Ref}, V}) end, - L). - -delete(Objs) -> - lists:foreach(fun delete_object/1, Objs). - -%% fetch/1 - -fetch(X) -> - MatchSpec = [{?REC({'_', '$1'}, '_'), - [?ORCOND([{'==', '$1', {const, T}} || T <- [X | ref(X)]])], - ['$_']}], - L = ets:select(?TABLE, MatchSpec), - delete(L), - D = lists:foldl(fun sum/2, dict:new(), L), - dict:to_list(D). - -sum({{Ctr, _}, N}, Dict) -> - dict:update(Ctr, fun(V) -> V+N end, N, Dict). - -ref(Pid) - when is_pid(Pid) -> - ets:select(?TABLE, [{?REC(Pid, '$1'), [], ['$1']}]); -ref(_) -> - []. - -%% update_counter/2 -%% -%% From an arbitrary request process. Cast to the server process to -%% insert a new element if the counter doesn't exists so that two -%% processes don't do so simultaneously. - -update_counter(Key, N) -> - try - ets:update_counter(?TABLE, Key, N) - catch - error: badarg -> - cast({incr, ?REC(Key, N)}) - end. - -%% update_counter/1 -%% -%% From the server process. - -update_counter(?REC(Key, N) = T) -> - try - ets:update_counter(?TABLE, Key, N) - catch - error: badarg -> - insert(T) - end. - -insert(T) -> - ets:insert(?TABLE, T). - -lookup(Key) -> - ets:lookup(?TABLE, Key). - -delete_object(T) -> - ets:delete_object(?TABLE, T). - -%% cast/1 - -cast(Msg) -> - gen_server:cast(?SERVER, Msg). - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_sup.erl b/lib/diameter/src/app/diameter_sup.erl deleted file mode 100644 index e5afd23dcd..0000000000 --- a/lib/diameter/src/app/diameter_sup.erl +++ /dev/null @@ -1,101 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The top supervisor for the diameter application. -%% - --module(diameter_sup). - --behaviour(supervisor). - -%% interface --export([start_link/0, %% supervisor start - tree/0]). %% supervision tree - -%% supervisor callback --export([init/1]). - --define(CHILDREN, [diameter_misc_sup, - diameter_watchdog_sup, - diameter_peer_fsm_sup, - diameter_transport_sup, - diameter_service_sup]). - --define(TABLES, [{diameter_sequence, [set]}, - {diameter_service, [set, {keypos, 3}]}, - {diameter_request, [bag]}, - {diameter_config, [bag, {keypos, 2}]}]). - -%% start_link/0 - -start_link() -> - SupName = {local, ?MODULE}, - supervisor:start_link(SupName, ?MODULE, []). - -%% init/1 - -init([]) -> - ets_new(?TABLES), - diameter_session:init(), - Flags = {one_for_one, 1, 5}, - ChildSpecs = lists:map(fun spec/1, ?CHILDREN), - {ok, {Flags, ChildSpecs}}. - -%% spec/1 - -spec(Mod) -> - {Mod, - {Mod, start_link, []}, - permanent, - 1000, - supervisor, - [Mod]}. - -%% ets_new/1 - -ets_new(List) - when is_list(List) -> - lists:foreach(fun ets_new/1, List); - -ets_new({Table, Opts}) -> - ets:new(Table, [named_table, public | Opts]). - -%% tree/0 - -tree() -> - [{?MODULE, whereis(?MODULE), tree(?MODULE)}]. - -tree(Sup) -> - lists:map(fun t/1, supervisor:which_children(Sup)). - -t({Name, Pid, supervisor, _}) -> - t(Name, Pid, tree(Pid)); -t({Name, Pid, worker, _}) -> - t(Name, Pid). - -t(undefined, Pid, Children) -> - {Pid, Children}; -t(Name, Pid, Children) -> - {Name, Pid, Children}. - -t(undefined, Pid) -> - Pid; -t(Name, Pid) -> - {Name, Pid}. diff --git a/lib/diameter/src/app/diameter_sync.erl b/lib/diameter/src/app/diameter_sync.erl deleted file mode 100644 index ce2db4b3a2..0000000000 --- a/lib/diameter/src/app/diameter_sync.erl +++ /dev/null @@ -1,550 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module implements a server that serializes requests in named -%% queues. A request is an MFA or fun and a name can be any term. A -%% request is applied in a dedicated process that terminates when -%% the request function returns. -%% - --module(diameter_sync). --behaviour(gen_server). - --export([call/4, call/5, - cast/4, cast/5, - carp/1, carp/2]). - -%% supervisor callback --export([start_link/0]). - -%% gen_server interface --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% test/debug --export([state/0, - uptime/0, - flush/1, - pending/0, - pending/1, - queues/0, - pids/1]). - --include("diameter_internal.hrl"). - -%% Locally registered server name. --define(SERVER, ?MODULE). - -%% Message to the server to queue a request ... --define(REQUEST(CallOrCast, Name, Req, Max, Timeout), - {request, CallOrCast, Name, Req, Max, Timeout}). - -%% ... and to retrieve the pid of the prevailing request process. --define(CARP(Name), - {carp, Name}). - -%% Forever ... --define(TIMEOUT, 30000). - -%% Server state. --record(state, - {time = now(), - pending = 0 :: non_neg_integer(), %% outstanding requests - monitor = new() :: ets:tid(), %% MonitorRef -> {Name, From} - queue = new() :: ets:tid()}). %% Name -> queue of {Pid, Ref} - -%% ---------------------------------------------------------- -%% # call(Node, Name, Req, Max, Timeout) -%% # call(Name, Req, Max, Timeout) -%% -%% Input: Name = term() identifying the queue in which the request is -%% to be evaluated. -%% Req = {M,F,A} -%% | {Fun, Arg} -%% | [Fun | Args] -%% | Fun -%% Max = Upper bound for the number of outstanding requests -%% in the named queue for Req to be queued. -%% If more than this number are in the queue then -%% 'rejected' is returned to the caller. Can be any -%% term but integer() | infinity is sufficient. -%% Timeout = 32 bit integer() number of milliseconds after which -%% request is cancelled (if not already started), causing -%% 'timeout' to be returned to the caller. -%% | infinity -%% -%% Output: Req() | rejected | timeout -%% -%% Description: Serialize a request in a named queue. Note that if -%% 'timeout' is returned and the request itself does not -%% return this atom then request has not been evaluated. -%% ---------------------------------------------------------- - -call(Name, Req, Max, Timeout) -> - call(node(), Name, Req, Max, Timeout). - -call(Node, Name, Req, Max, Timeout) -> - gen_call({?SERVER, Node}, ?REQUEST(call, Name, Req, Max, Timeout)). - -%%% ---------------------------------------------------------- -%%% # cast(Node, Name, Req, Max, Timeout) -%%% # cast(Name, Req, Max, Timeout) -%%% -%%% Output: ok | rejected | timeout -%%% -%%% Description: Serialize a request without returning the result to the -%%% caller. Returns after the task is queued. -%%% ---------------------------------------------------------- - -cast(Name, Req, Max, Timeout) -> - cast(node(), Name, Req, Max, Timeout). - -cast(Node, Name, Req, Max, Timeout) -> - gen_call({?SERVER, Node}, ?REQUEST(cast, Name, Req, Max, Timeout)). - -%% 'timeout' is only return if the server process that processes -%% requests isn't alive. Ditto for call/carp. - -%%% ---------------------------------------------------------- -%%% # carp(Node, Name) -%%% # carp(Name) -%%% -%%% Output: {value, Pid} | false | timeout -%%% -%%% Description: Return the pid of the process processing the task -%%% at the head of the named queue. Note that the value -%%% returned by subsequent calls changes as tasks are -%%% completed, each task executing in a dedicated -%%% process. The exit value of this process will be -%%% {value, Req()} if the task returns. -%%% ---------------------------------------------------------- - -%% The intention of this is to let a process enqueue a task that waits -%% for a message before completing, the target pid being retrieved -%% with carp/[12]. - -carp(Name) -> - carp(node(), Name). - -carp(Node, Name) -> - gen_call({?SERVER, Node}, ?CARP(Name)). - -%%% --------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -state() -> - call(state). - -uptime() -> - call(uptime). - -flush(Name) -> - call({flush, Name}). - -pending() -> - call(pending). - -pending(Name) -> - call({pending, Name}). - -queues() -> - call(queues). - -pids(Name) -> - call({pids, Name}). - -%%% ---------------------------------------------------------- -%%% # start_link() -%%% ---------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -%%% ---------------------------------------------------------- -%%% # init(_) -%%% ---------------------------------------------------------- - -init(_) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -%% Enqueue a new request. -handle_call(?REQUEST(Type, Name, Req, Max, Timeout), - From, - #state{queue = QD} = State) -> - T = find(Name, QD), - nq(queued(T) =< Max, T, {Type, From}, Name, Req, Timeout, State); - -handle_call(Request, From, State) -> - {reply, call(Request, From, State), State}. - -%% call/3 - -call(?CARP(Name), _, #state{queue = QD}) -> - pcar(find(Name, QD)); - -call(state, _, State) -> - State; - -call(uptime, _, #state{time = T}) -> - diameter_lib:now_diff(T); - -call({flush, Name}, _, #state{queue = QD}) -> - cancel(find(Name, QD)); - -call(pending, _, #state{pending = N}) -> - N; - -call({pending, Name}, _, #state{queue = QD}) -> - queued(find(Name, QD)); - -call(queues, _, #state{queue = QD}) -> - fetch_keys(QD); - -call({pids, Name}, _, #state{queue = QD}) -> - plist(find(Name, QD)); - -call(Req, From, _State) -> %% ignore - ?UNEXPECTED(handle_call, [Req, From]), - nok. - -%%% ---------------------------------------------------------- -%%% handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% handle_info(Request, State) -%%% ---------------------------------------------------------- - -handle_info(Request, State) -> - {noreply, info(Request, State)}. - -%% info/2 - -%% A request has completed execution or timed out. -info({'DOWN', MRef, process, Pid, Info}, - #state{pending = N, - monitor = MD, - queue = QD} - = State) -> - {Name, From} = fetch(MRef, MD), - reply(From, rc(Info)), - State#state{pending = N-1, - monitor = erase(MRef, MD), - queue = dq(fetch(Name, QD), Pid, Info, Name, QD)}; - -info(Info, State) -> - ?UNEXPECTED(handle_info, [Info]), - State. - -reply({call, From}, T) -> - gen_server:reply(From, T); -reply(cast, _) -> - ok. - -rc({value, T}) -> - T; -rc(_) -> - timeout. - -%%% ---------------------------------------------------------- -%%% code_change(OldVsn, State, Extra) -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%% ---------------------------------------------------------- -%%% terminate(Reason, State) -%%% ---------------------------------------------------------- - -terminate(_Reason, _State)-> - ok. - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -%% queued/1 - -queued({ok, {N,_}}) -> - N; -queued(error) -> - 0. - -%% nq/7 - -%% Maximum number of pending requests exceeded ... -nq(false, _, _, _Name, _Req, _Timeout, State) -> - {reply, rejected, State}; - -%% ... or not. -nq(true, T, From, Name, Req, Timeout, #state{pending = N, - monitor = MD, - queue = QD} - = State) -> - Ref = make_ref(), - Pid = init(Ref, Req, timeout(Timeout, T)), - MRef = erlang:monitor(process, Pid), - {noreply, State#state{pending = N+1, - monitor = store(MRef, {Name, from(From)}, MD), - queue = store(Name, nq(T, {Pid, Ref}), QD)}}. - -from({call, _} = T) -> - T; -from({cast = T, From}) -> - gen_server:reply(From, ok), - T. - -%% nq/2 - -%% Other requests in the queue: append. -nq({ok, {N,Q}}, T) -> - {N+1, queue:in(T,Q)}; - -%% Queue is empty: start execution. -nq(error, T) -> - go(T), - {1, queue:from_list([T])}. - -%% Don't timeout if the request is evaluated immediately so as to -%% avoid a race between getting a 'go' and a 'timeout'. Queueing a -%% request in an empty queue always results in execution. -timeout(_, error) -> - infinity; -timeout(Timeout, _) -> - Timeout. - -%% dq/5 -%% -%% A request process has terminated. - -dq({N,Q}, Pid, _Info, Name, QD) -> - {{value, T}, TQ} = queue:out(Q), - dq(N-1, Pid, T, TQ, Name, QD). - -%% dq/6 - -%% Request was at the head of the queue: start another. -dq(N, Pid, {Pid, _}, TQ, Name, QD) -> - dq(N, TQ, Name, QD); - -%% Or not: remove the offender from the queue. -dq(N, Pid, T, TQ, Name, QD) -> - store(Name, {N, req(Pid, queue:from_list([T]), TQ)}, QD). - -%% dq/4 - -%% Queue is empty: erase. -dq(0, TQ, Name, QD) -> - true = queue:is_empty(TQ), %% assert - erase(Name, QD); - -%% Start the next request. -dq(N, TQ, Name, QD) -> - go(queue:head(TQ)), - store(Name, {N, TQ}, QD). - -%% req/3 -%% -%% Find and remove the queue element for the specified pid. - -req(Pid, HQ, Q) -> - {{value, T}, TQ} = queue:out(Q), - req(Pid, T, HQ, TQ). - -req(Pid, {Pid, _}, HQ, TQ) -> - queue:join(HQ, TQ); -req(Pid, T, HQ, TQ) -> - req(Pid, queue:in(T,HQ), TQ). - -%% go/1 - -go({Pid, Ref}) -> - Pid ! {Ref, ok}. - -%% init/4 -%% -%% Start the dedicated process for handling a request. The exit value -%% is as promised by carp/1. - -init(Ref, Req, Timeout) -> - spawn(fun() -> exit(i(Ref, Req, Timeout)) end). - -i(Ref, Req, Timeout) -> - Timer = send_timeout(Ref, Timeout), - MRef = erlang:monitor(process, ?SERVER), - receive - {Ref, ok} -> %% Do the deed. - %% Ensure we don't leave messages in the mailbox since the - %% request itself might receive. Alternatively, could have - %% done the eval in a new process but then we'd have to - %% relay messages arriving at this one. - cancel_timer(Timer), - erlang:demonitor(MRef, [flush]), - %% Ref is to ensure that we don't extract any message that - %% a client may have sent after retrieving self() with - %% carp/1, there being no guarantee that the message - %% banged by go/1 is received before the pid becomes - %% accessible. - {value, eval(Req)}; - {Ref, timeout = T} -> - T; - {'DOWN', MRef, process, _Pid, _Info} = D -> %% server death - D - end. - -send_timeout(_Ref, infinity = No) -> - No; -send_timeout(Ref, Ms) -> - Msg = {Ref, timeout}, - TRef = erlang:send_after(Ms, self(), Msg), - {TRef, Msg}. - -cancel_timer(infinity = No) -> - No; -cancel_timer({TRef, Msg}) -> - flush(Msg, erlang:cancel_timer(TRef)). - -flush(Msg, false) -> %% Message has already been sent ... - %% 'error' should never happen but crash if it does so as not to - %% hang the process. - ok = receive Msg -> ok after ?TIMEOUT -> error end; -flush(_, _) -> %% ... or not. - ok. - -eval({M,F,A}) -> - apply(M,F,A); -eval([Fun | Args]) -> - apply(Fun, Args); -eval({Fun, A}) -> - Fun(A); -eval(Fun) -> - Fun(). - -%% pcar/1 - -pcar({ok, {_,Q}}) -> - {Pid, _Ref} = queue:head(Q), - {value, Pid}; -pcar(error) -> - false. - -%% plist/1 - -plist({ok, {_,Q}}) -> - lists:map(fun({Pid, _Ref}) -> Pid end, queue:to_list(Q)); -plist(error) -> - []. - -%% cancel/1 -%% -%% Cancel all but the active request from the named queue. Return the -%% number of requests cancelled. - -%% Just send timeout messages to each request to make them die. Note -%% that these are guaranteed to arrive before a go message after the -%% current request completes since both messages are sent from the -%% server process. -cancel({ok, {N,Q}}) -> - {_,TQ} = queue:split(1,Q), - foreach(fun({Pid, Ref}) -> Pid ! {Ref, timeout} end, N-1, TQ), - N-1; -cancel(error) -> - 0. - -%% foreach/3 - -foreach(_, 0, _) -> - ok; -foreach(Fun, N, Q) -> - Fun(queue:head(Q)), - foreach(Fun, N-1, queue:tail(Q)). - -%% call/1 - -%% gen_server:call/3 will exit if the target process dies. -call(Request) -> - try - gen_server:call(?SERVER, Request, ?TIMEOUT) - catch - exit: Reason -> - {error, Reason} - end. - -%% dict-like table manipulation. - -erase(Key, Dict) -> - ets:delete(Dict, Key), - Dict. - -fetch(Key, Dict) -> - {ok, V} = find(Key, Dict), - V. - -fetch_keys(Dict) -> - ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). - -find(Key, Dict) -> - case ets:lookup(Dict, Key) of - [{Key, V}] -> - {ok, V}; - [] -> - error - end. - -new() -> - ets:new(?MODULE, [set]). - -store(Key, Value, Dict) -> - store({Key, Value}, Dict). - -store({_,_} = T, Dict) -> - ets:insert(Dict, T), - Dict. - -%% gen_call/1 - -gen_call(Server, Req) -> - gen_call(Server, Req, infinity). - -gen_call(Server, Req, Timeout) -> - try - gen_server:call(Server, Req, Timeout) - catch - exit: _ -> - timeout - end. diff --git a/lib/diameter/src/app/diameter_types.erl b/lib/diameter/src/app/diameter_types.erl deleted file mode 100644 index 6b1b1b8d39..0000000000 --- a/lib/diameter/src/app/diameter_types.erl +++ /dev/null @@ -1,537 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_types). - -%% -%% Encode/decode of RFC 3588 Data Formats, Basic (section 4.2) and -%% Derived (section 4.3). -%% - -%% Basic types. --export(['OctetString'/2, - 'Integer32'/2, - 'Integer64'/2, - 'Unsigned32'/2, - 'Unsigned64'/2, - 'Float32'/2, - 'Float64'/2]). - -%% Derived types. --export(['Address'/2, - 'Time'/2, - 'UTF8String'/2, - 'DiameterIdentity'/2, - 'DiameterURI'/2, - 'IPFilterRule'/2, - 'QoSFilterRule'/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(UINT(N,X), ((0 =< X) andalso (X < 1 bsl N))). --define(SINT(N,X), ((-1*(1 bsl (N-1)) < X) andalso (X < 1 bsl (N-1)))). - -%% The Grouped and Enumerated types are dealt with directly in -%% generated decode modules by way of diameter_gen.hrl and -%% diameter_codec.erl. Padding and the setting of Length and other -%% fields are also dealt with there. - -%% 3588: -%% -%% DIAMETER_INVALID_AVP_LENGTH 5014 -%% The request contained an AVP with an invalid length. A Diameter -%% message indicating this error MUST include the offending AVPs -%% within a Failed-AVP AVP. -%% --define(INVALID_LENGTH(Bin), erlang:error({'DIAMETER', 5014, Bin})). - -%% ------------------------------------------------------------------------- -%% 3588, 4.2. Basic AVP Data Formats -%% -%% The Data field is zero or more octets and contains information -%% specific to the Attribute. The format and length of the Data field -%% is determined by the AVP Code and AVP Length fields. The format of -%% the Data field MUST be one of the following base data types or a data -%% type derived from the base data types. In the event that a new Basic -%% AVP Data Format is needed, a new version of this RFC must be created. -%% -------------------- - -'OctetString'(decode, Bin) - when is_binary(Bin) -> - binary_to_list(Bin); - -'OctetString'(encode = M, zero) -> - 'OctetString'(M, []); - -'OctetString'(encode, Str) -> - iolist_to_binary(Str). - -%% -------------------- - -'Integer32'(decode, <>) -> - X; - -'Integer32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Integer32'(encode = M, zero) -> - 'Integer32'(M, 0); - -'Integer32'(encode, I) - when ?SINT(32,I) -> - <>. - -%% -------------------- - -'Integer64'(decode, <>) -> - X; - -'Integer64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Integer64'(encode = M, zero) -> - 'Integer64'(M, 0); - -'Integer64'(encode, I) - when ?SINT(64,I) -> - <>. - -%% -------------------- - -'Unsigned32'(decode, <>) -> - X; - -'Unsigned32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Unsigned32'(encode = M, zero) -> - 'Unsigned32'(M, 0); - -'Unsigned32'(encode, I) - when ?UINT(32,I) -> - <>. - -%% -------------------- - -'Unsigned64'(decode, <>) -> - X; - -'Unsigned64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Unsigned64'(encode = M, zero) -> - 'Unsigned64'(M, 0); - -'Unsigned64'(encode, I) - when ?UINT(64,I) -> - <>. - -%% -------------------- - -%% Decent summaries of the IEEE floating point formats can be -%% found at http://en.wikipedia.org/wiki/IEEE_754-1985 and -%% http://www.psc.edu/general/software/packages/ieee/ieee.php. -%% -%% That the bit syntax uses these formats isn't well documented but -%% this does indeed appear to be the case. However, the bit syntax -%% only encodes numeric values, not the standard's (signed) infinity -%% or NaN. It also encodes any large value as 'infinity', never 'NaN'. -%% Treat these equivalently on decode for this reason. -%% -%% An alternative would be to decode infinity/NaN to the largest -%% possible float but could likely lead to misleading results if -%% arithmetic is performed on the decoded value. Better to be explicit -%% that precision has been lost. - -'Float32'(decode, <>) -> - choose(S, infinity, '-infinity'); - -'Float32'(decode, <>) -> - X; - -'Float32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Float32'(encode = M, zero) -> - 'Float32'(M, 0.0); - -'Float32'(encode, infinity) -> - <<0:1, 255:8, 0:23>>; - -'Float32'(encode, '-infinity') -> - <<1:1, 255:8, 0:23>>; - -'Float32'(encode, X) - when is_float(X) -> - <>. -%% Note that this could also encode infinity/-infinity for large -%% (signed) numeric values. Note also that precision is lost just in -%% using the floating point syntax. For example: -%% -%% 1> B = <<3.14159:32/float>>. -%% <<64,73,15,208>> -%% 2> <> = B. -%% <<64,73,15,208>> -%% 3> F. -%% 3.141590118408203 -%% -%% (The 64 bit type does better.) - -%% -------------------- - -%% The 64 bit format is entirely analogous to the 32 bit format. - -'Float64'(decode, <>) -> - choose(S, infinity, '-infinity'); - -'Float64'(decode, <>) -> - X; - -'Float64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Float64'(encode, infinity) -> - <<0:1, 2047:11, 0:52>>; - -'Float64'(encode, '-infinity') -> - <<1:1, 2047:11, 0:52>>; - -'Float64'(encode = M, zero) -> - 'Float64'(M, 0.0); - -'Float64'(encode, X) - when is_float(X) -> - <>. - -%% ------------------------------------------------------------------------- -%% 3588, 4.3. Derived AVP Data Formats -%% -%% In addition to using the Basic AVP Data Formats, applications may -%% define data formats derived from the Basic AVP Data Formats. An -%% application that defines new AVP Derived Data Formats MUST include -%% them in a section entitled "AVP Derived Data Formats", using the same -%% format as the definitions below. Each new definition must be either -%% defined or listed with a reference to the RFC that defines the -%% format. -%% -------------------- - -'Address'(encode, zero) -> - <<0:48>>; - -'Address'(decode, <<1:16, B/binary>>) - when size(B) == 4 -> - list_to_tuple(binary_to_list(B)); - -'Address'(decode, <<2:16, B/binary>>) - when size(B) == 16 -> - list_to_tuple(v6dec(B, [])); - -'Address'(decode, <> = B) - when 1 == A; - 2 == A -> - ?INVALID_LENGTH(B); - -'Address'(encode, T) -> - ipenc(diameter_lib:ipaddr(T)). - -ipenc(T) - when is_tuple(T), size(T) == 4 -> - B = list_to_binary(tuple_to_list(T)), - <<1:16, B/binary>>; - -ipenc(T) - when is_tuple(T), size(T) == 8 -> - B = v6enc(lists:reverse(tuple_to_list(T)), <<>>), - <<2:16, B/binary>>. - -v6dec(<>, Acc) -> - v6dec(B, [N | Acc]); - -v6dec(<<>>, Acc) -> - lists:reverse(Acc). - -v6enc([N | Rest], B) - when ?UINT(16,N) -> - v6enc(Rest, <>); - -v6enc([], B) -> - B. - -%% -------------------- - -%% A DiameterIdentity is a FQDN as definined in RFC 1035, which is at -%% least one character. - -'DiameterIdentity'(encode = M, zero) -> - 'OctetString'(M, [0]); - -'DiameterIdentity'(encode = M, X) -> - <<_,_/binary>> = 'OctetString'(M, X); - -'DiameterIdentity'(decode = M, <<_,_/binary>> = X) -> - 'OctetString'(M, X). - -%% -------------------- - -'DiameterURI'(decode, Bin) - when is_binary(Bin) -> - scan_uri(Bin); - -%% The minimal DiameterURI is "aaa://x", 7 characters. -'DiameterURI'(encode = M, zero) -> - 'OctetString'(M, lists:duplicate(0,7)); - -'DiameterURI'(encode, #diameter_uri{type = Type, - fqdn = D, - port = P, - transport = T, - protocol = Prot} - = U) -> - S = lists:append([atom_to_list(Type), "://", D, - ":", integer_to_list(P), - ";transport=", atom_to_list(T), - ";protocol=", atom_to_list(Prot)]), - U = scan_uri(S), %% assert - list_to_binary(S); - -'DiameterURI'(encode, Str) -> - Bin = iolist_to_binary(Str), - #diameter_uri{} = scan_uri(Bin), %% type check - Bin. - -%% -------------------- - -%% This minimal rule is "deny in 0 from 0.0.0.0 to 0.0.0.0", 33 characters. -'IPFilterRule'(encode = M, zero) -> - 'OctetString'(M, lists:duplicate(0,33)); - -%% TODO: parse grammar. -'IPFilterRule'(M, X) -> - 'OctetString'(M, X). - -%% -------------------- - -%% This minimal rule is the same as for an IPFilterRule. -'QoSFilterRule'(encode = M, zero = X) -> - 'IPFilterRule'(M, X); - -%% TODO: parse grammar. -'QoSFilterRule'(M, X) -> - 'OctetString'(M, X). - -%% -------------------- - -'UTF8String'(decode, Bin) -> - udec(Bin, []); - -'UTF8String'(encode = M, zero) -> - 'UTF8String'(M, []); - -'UTF8String'(encode, S) -> - uenc(S, []). - -udec(<<>>, Acc) -> - lists:reverse(Acc); - -udec(<>, Acc) -> - udec(Rest, [C | Acc]). - -uenc(E, Acc) - when E == []; - E == <<>> -> - list_to_binary(lists:reverse(Acc)); - -uenc(<>, Acc) -> - uenc(Rest, [<> | Acc]); - -uenc([[] | Rest], Acc) -> - uenc(Rest, Acc); - -uenc([[H|T] | Rest], Acc) -> - uenc([H, T | Rest], Acc); - -uenc([C | Rest], Acc) -> - uenc(Rest, [<> | Acc]). - -%% -------------------- - -%% RFC 3588, 4.3: -%% -%% Time -%% The Time format is derived from the OctetString AVP Base Format. -%% The string MUST contain four octets, in the same format as the -%% first four bytes are in the NTP timestamp format. The NTP -%% Timestamp format is defined in chapter 3 of [SNTP]. -%% -%% This represents the number of seconds since 0h on 1 January 1900 -%% with respect to the Coordinated Universal Time (UTC). -%% -%% On 6h 28m 16s UTC, 7 February 2036 the time value will overflow. -%% SNTP [SNTP] describes a procedure to extend the time to 2104. -%% This procedure MUST be supported by all DIAMETER nodes. - -%% RFC 2030, 3: -%% -%% As the NTP timestamp format has been in use for the last 17 years, -%% it remains a possibility that it will be in use 40 years from now -%% when the seconds field overflows. As it is probably inappropriate -%% to archive NTP timestamps before bit 0 was set in 1968, a -%% convenient way to extend the useful life of NTP timestamps is the -%% following convention: If bit 0 is set, the UTC time is in the -%% range 1968-2036 and UTC time is reckoned from 0h 0m 0s UTC on 1 -%% January 1900. If bit 0 is not set, the time is in the range 2036- -%% 2104 and UTC time is reckoned from 6h 28m 16s UTC on 7 February -%% 2036. Note that when calculating the correspondence, 2000 is not a -%% leap year. Note also that leap seconds are not counted in the -%% reckoning. -%% -%% The statement regarding year 2000 is wrong: errata id 518 at -%% http://www.rfc-editor.org/errata_search.php?rfc=2030 notes this. - --define(TIME_1900, 59958230400). %% {{1900,1,1},{0,0,0}} --define(TIME_2036, 64253197696). %% {{2036,2,7},{6,28,16}} -%% TIME_2036 = TIME_1900 + (1 bsl 32) - -%% Time maps [0, 1 bsl 31) onto [TIME_1900 + 1 bsl 31, TIME_2036 + 1 bsl 31) -%% by taking integers with the high-order bit set relative to TIME_1900 -%% and those without relative to TIME_2036. This corresponds to the -%% following dates. --define(TIME_MIN, {{1968,1,20},{3,14,8}}). %% TIME_1900 + 1 bsl 31 --define(TIME_MAX, {{2104,2,26},{9,42,24}}). %% TIME_2036 + 1 bsl 31 - -'Time'(decode, <>) -> - Offset = msb(1 == Time bsr 31), - calendar:gregorian_seconds_to_datetime(Time + Offset); - -'Time'(decode, B) -> - ?INVALID_LENGTH(B); - -'Time'(encode, {{_Y,_M,_D},{_HH,_MM,_SS}} = Datetime) - when ?TIME_MIN =< Datetime, Datetime < ?TIME_MAX -> - S = calendar:datetime_to_gregorian_seconds(Datetime), - T = S - msb(S < ?TIME_2036), - 0 = T bsr 32, %% sanity check - <>; - -'Time'(encode, zero) -> - <<0:32>>. - -%% =========================================================================== -%% =========================================================================== - -choose(0, X, _) -> X; -choose(1, _, X) -> X. - -msb(true) -> ?TIME_1900; -msb(false) -> ?TIME_2036. - -%% RFC 3588, 4.3: -%% -%% The DiameterURI MUST follow the Uniform Resource Identifiers (URI) -%% syntax [URI] rules specified below: -%% -%% "aaa://" FQDN [ port ] [ transport ] [ protocol ] -%% -%% ; No transport security -%% -%% "aaas://" FQDN [ port ] [ transport ] [ protocol ] -%% -%% ; Transport security used -%% -%% FQDN = Fully Qualified Host Name -%% -%% port = ":" 1*DIGIT -%% -%% ; One of the ports used to listen for -%% ; incoming connections. -%% ; If absent, -%% ; the default Diameter port (3868) is -%% ; assumed. -%% -%% transport = ";transport=" transport-protocol -%% -%% ; One of the transports used to listen -%% ; for incoming connections. If absent, -%% ; the default SCTP [SCTP] protocol is -%% ; assumed. UDP MUST NOT be used when -%% ; the aaa-protocol field is set to -%% ; diameter. -%% -%% transport-protocol = ( "tcp" / "sctp" / "udp" ) -%% -%% protocol = ";protocol=" aaa-protocol -%% -%% ; If absent, the default AAA protocol -%% ; is diameter. -%% -%% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) - -scan_uri(Bin) - when is_binary(Bin) -> - scan_uri(binary_to_list(Bin)); -scan_uri("aaa://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaa}); -scan_uri("aaas://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaas}). - -scan_fqdn(S, U) -> - {[_|_] = F, Rest} = lists:splitwith(fun is_fqdn/1, S), - scan_opt_port(Rest, U#diameter_uri{fqdn = F}). - -scan_opt_port(":" ++ S, U) -> - {[_|_] = P, Rest} = lists:splitwith(fun is_digit/1, S), - scan_opt_transport(Rest, U#diameter_uri{port = list_to_integer(P)}); -scan_opt_port(S, U) -> - scan_opt_transport(S, U). - -scan_opt_transport(";transport=" ++ S, U) -> - {P, Rest} = transport(S), - scan_opt_protocol(Rest, U#diameter_uri{transport = P}); -scan_opt_transport(S, U) -> - scan_opt_protocol(S, U). - -scan_opt_protocol(";protocol=" ++ S, U) -> - {P, ""} = protocol(S), - U#diameter_uri{protocol = P}; -scan_opt_protocol("", U) -> - U. - -transport("tcp" ++ S) -> - {tcp, S}; -transport("sctp" ++ S) -> - {sctp, S}; -transport("udp" ++ S) -> - {udp, S}. - -protocol("diameter" ++ S) -> - {diameter, S}; -protocol("radius" ++ S) -> - {radius, S}; -protocol("tacacs+" ++ S) -> - {'tacacs+', S}. - -is_fqdn(C) -> - is_digit(C) orelse is_alpha(C) orelse C == $. orelse C == $-. - -is_alpha(C) -> - ($a =< C andalso C =< $z) orelse ($A =< C andalso C =< $Z). - -is_digit(C) -> - $0 =< C andalso C =< $9. diff --git a/lib/diameter/src/app/diameter_types.hrl b/lib/diameter/src/app/diameter_types.hrl deleted file mode 100644 index 02bf8a74dd..0000000000 --- a/lib/diameter/src/app/diameter_types.hrl +++ /dev/null @@ -1,139 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Types for function specifications, primarily in diameter.erl. This -%% has nothing specifically to do with diameter_types.erl. -%% - --type evaluable() - :: {module(), atom(), list()} - | fun() - | nonempty_improper_list(evaluable(), list()). %% [evaluable() | Args] - --type app_alias() - :: any(). - --type service_name() - :: any(). - -%% Diameter basic types - --type 'OctetString'() :: iolist(). --type 'Integer32'() :: -2147483647..2147483647. --type 'Integer64'() :: -9223372036854775807..9223372036854775807. --type 'Unsigned32'() :: 0..4294967295. --type 'Unsigned64'() :: 0..18446744073709551615. --type 'Float32'() :: '-infinity' | float() | infinity. --type 'Float64'() :: '-infinity' | float() | infinity. --type 'Grouped'() :: list() | tuple(). - -%% Diameter derived types - --type 'Address'() - :: inet:ip_address() - | string(). - --type 'Time'() :: {{integer(), 1..12, 1..31}, - {0..23, 0..59, 0..59}}. --type 'UTF8String'() :: iolist(). --type 'DiameterIdentity'() :: 'OctetString'(). --type 'DiameterURI'() :: 'OctetString'(). --type 'Enumerated'() :: 'Integer32'(). --type 'IPFilterRule'() :: 'OctetString'(). --type 'QoSFilterRule'() :: 'OctetString'(). - -%% Capabilities options/avps on start_service/2 and/or add_transport/2 - --type capability() - :: {'Origin-Host', 'DiameterIdentity'()} - | {'Origin-Realm', 'DiameterIdentity'()} - | {'Host-IP-Address', ['Address'()]} - | {'Vendor-Id', 'Unsigned32'()} - | {'Product-Name', 'UTF8String'()} - | {'Supported-Vendor-Id', ['Unsigned32'()]} - | {'Auth-Application-Id', ['Unsigned32'()]} - | {'Vendor-Specific-Application-Id', ['Grouped'()]} - | {'Firmware-Revision', 'Unsigned32'()}. - -%% Filters for call/4 - --type peer_filter() - :: none - | host - | realm - | {host, any|'DiameterIdentity'()} - | {realm, any|'DiameterIdentity'()} - | {eval, evaluable()} - | {neg, peer_filter()} - | {all, [peer_filter()]} - | {any, [peer_filter()]}. - -%% Options passed to start_service/2 - --type service_opt() - :: capability() - | {application, [application_opt()]}. - --type application_opt() - :: {alias, app_alias()} - | {dictionary, module()} - | {module, app_module()} - | {state, any()} - | {call_mutates_state, boolean()} - | {answer_errors, callback|report|discard}. - --type app_module() - :: module() - | nonempty_improper_list(module(), list()). %% list with module() head - -%% Identifier returned by add_transport/2 - --type transport_ref() - :: reference(). - -%% Options passed to add_transport/2 - --type transport_opt() - :: {transport_module, atom()} - | {transport_config, any()} - | {applications, [app_alias()]} - | {capabilities, [capability()]} - | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} - | {reconnect_timer, 'Unsigned32'()} - | {private, any()}. - -%% Predicate passed to remove_transport/2 - --type transport_pred() - :: fun((reference(), connect|listen, list()) -> boolean()) - | fun((reference(), list()) -> boolean()) - | fun((list()) -> boolean()) - | reference() - | list() - | {connect|listen, transport_pred()} - | {atom(), atom(), list()}. - -%% Options passed to call/4 - --type call_opt() - :: {extra, list()} - | {filter, peer_filter()} - | {timeout, 'Unsigned32'()} - | detach. diff --git a/lib/diameter/src/app/diameter_watchdog.erl b/lib/diameter/src/app/diameter_watchdog.erl deleted file mode 100644 index b7c1491f4b..0000000000 --- a/lib/diameter/src/app/diameter_watchdog.erl +++ /dev/null @@ -1,571 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module implements (as a process) the state machine documented -%% in Appendix A of RFC 3539. -%% - --module(diameter_watchdog). --behaviour(gen_server). - -%% towards diameter_service --export([start/2]). - -%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% diameter_watchdog_sup callback --export([start_link/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(DEFAULT_TW_INIT, 30000). %% RFC 3539 ch 3.4.1 - --record(watchdog, - {%% PCB - Peer Control Block; see RFC 3539, Appendix A - status = initial :: initial | okay | suspect | down | reopen, - pending = false :: boolean(), - tw :: 6000..16#FFFFFFFF | {module(), atom(), list()}, - %% {M,F,A} -> integer() >= 0 - num_dwa = 0 :: -1 | non_neg_integer(), - %% number of DWAs received during reopen - %% end PCB - parent = self() :: pid(), - transport :: pid(), - tref :: reference(), %% reference for current watchdog timer - message_data}). %% term passed into diameter_service with message - -%% start/2 - -start({_,_} = Type, T) -> - {ok, Pid} = diameter_watchdog_sup:start_child({Type, self(), T}), - Pid. - -start_link(T) -> - {ok, _} = proc_lib:start_link(?MODULE, - init, - [T], - infinity, - diameter_lib:spawn_opts(server, [])). - -%% =========================================================================== -%% =========================================================================== - -%% init/1 - -init(T) -> - proc_lib:init_ack({ok, self()}), - gen_server:enter_loop(?MODULE, [], i(T)). - -i({T, Pid, {ConnT, Opts, SvcName, #diameter_service{applications = Apps, - capabilities = Caps} - = Svc}}) -> - {M,S,U} = now(), - random:seed(M,S,U), - putr(restart, {T, Opts, Svc}), %% save seeing it in trace - putr(dwr, dwr(Caps)), %% - #watchdog{parent = monitor(Pid), - transport = monitor(diameter_peer_fsm:start(T, Opts, Svc)), - tw = proplists:get_value(watchdog_timer, - Opts, - ?DEFAULT_TW_INIT), - message_data = {ConnT, SvcName, Apps}}. - -%% handle_call/3 - -handle_call(_, _, State) -> - {reply, nok, State}. - -%% handle_cast/2 - -handle_cast(_, State) -> - {noreply, State}. - -%% handle_info/2 - -handle_info(T, State) -> - case transition(T, State) of - ok -> - {noreply, State}; - #watchdog{status = X} = S -> - ?LOGC(X =/= State#watchdog.status, transition, X), - {noreply, S}; - stop -> - ?LOG(stop, T), - {stop, {shutdown, T}, State} - end. - -%% terminate/2 - -terminate(_, _) -> - ok. - -%% code_change/3 - -code_change(_, State, _) -> - {ok, State}. - -%% =========================================================================== -%% =========================================================================== - -%% transition/2 -%% -%% The state transitions documented here are extracted from RFC 3539, -%% the commentary is ours. - -%% Service or watchdog is telling the watchdog of an accepting -%% transport to die after reconnect_timer expiry or reestablished -%% connection (in another transport process) respectively. -transition(close, #watchdog{status = down}) -> - {{accept, _}, _, _} = getr(restart), %% assert - stop; -transition(close, #watchdog{}) -> - ok; - -%% Service is asking for the peer to be taken down gracefully. -transition({shutdown, Pid}, #watchdog{parent = Pid, - transport = undefined, - status = S}) -> - down = S, %% sanity check - stop; -transition({shutdown = T, Pid}, #watchdog{parent = Pid, - transport = TPid}) -> - TPid ! {T, self()}, - ok; - -%% Parent process has died, -transition({'DOWN', _, process, Pid, _Reason}, - #watchdog{parent = Pid}) -> - stop; - -%% Transport has accepted a connection. -transition({accepted = T, TPid}, #watchdog{transport = TPid, - parent = Pid}) -> - Pid ! {T, self(), TPid}, - ok; - -%% Transport is telling us that its impending death isn't failure. -transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> - stop; - -%% STATE Event Actions New State -%% ===== ------ ------- ---------- -%% INITIAL Connection up SetWatchdog() OKAY - -%% By construction, the watchdog timer isn't set until we move into -%% state okay as the result of the Peer State Machine reaching the -%% Open state. -%% -%% If we're an acceptor then we may be resuming a connection that went -%% down in another acceptor process, in which case this is the -%% transition below, from down into reopen. That is, it's not until -%% we know the identity of the peer (ie. now) that we know that we're -%% in state down rather than initial. - -transition({open, TPid, Hosts, T} = Open, - #watchdog{transport = TPid, - status = initial, - parent = Pid} - = S) -> - case okay(getr(restart), Hosts) of - okay -> - open(Pid, {TPid, T}), - set_watchdog(S#watchdog{status = okay}); - reopen -> - transition(Open, S#watchdog{status = down}) - end; - -%% DOWN Connection up NumDWA = 0 -%% SendWatchdog() -%% SetWatchdog() -%% Pending = TRUE REOPEN - -transition({open = P, TPid, _Hosts, T}, - #watchdog{transport = TPid, - status = down} - = S) -> - %% Store the info we need to notify the parent to reopen the - %% connection after the requisite DWA's are received, at which - %% time we eraser(open). - putr(P, {TPid, T}), - set_watchdog(send_watchdog(S#watchdog{status = reopen, - num_dwa = 0})); - -%% OKAY Connection down CloseConnection() -%% Failover() -%% SetWatchdog() DOWN -%% SUSPECT Connection down CloseConnection() -%% SetWatchdog() DOWN -%% REOPEN Connection down CloseConnection() -%% SetWatchdog() DOWN - -transition({'DOWN', _, process, TPid, _}, - #watchdog{transport = TPid, - status = initial}) -> - stop; - -transition({'DOWN', _, process, Pid, _}, - #watchdog{transport = Pid} - = S) -> - failover(S), - close(S), - set_watchdog(S#watchdog{status = down, - pending = false, - transport = undefined}); -%% Any outstanding pending (or other messages from the transport) will -%% have arrived before 'DOWN' since the message comes from the same -%% process. Note that we could also get this message in the initial -%% state. - -%% Incoming message. -transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> - recv(Name, Pkt, S); - -%% Current watchdog has timed out. -transition({timeout, TRef, tw}, #watchdog{tref = TRef} = S) -> - set_watchdog(timeout(S)); - -%% Timer was canceled after message was already sent. -transition({timeout, _, tw}, #watchdog{}) -> - ok; - -%% State query. -transition({state, Pid}, #watchdog{status = S}) -> - Pid ! {self(), S}, - ok. - -%% =========================================================================== - -monitor(Pid) -> - erlang:monitor(process, Pid), - Pid. - -putr(Key, Val) -> - put({?MODULE, Key}, Val). - -getr(Key) -> - get({?MODULE, Key}). - -eraser(Key) -> - erase({?MODULE, Key}). - -%% encode/1 - -encode(Msg) -> - #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg), - Bin. - -%% okay/2 - -okay({{accept, Ref}, _, _}, Hosts) -> - T = {?MODULE, connection, Ref, Hosts}, - diameter_reg:add(T), - okay(diameter_reg:match(T)); -%% Register before matching so that at least one of two registering -%% processes will match the other. (Which can't happen as long as -%% diameter_peer_fsm guarantees at most one open connection to the same -%% peer.) - -okay({{connect, _}, _, _}, _) -> - okay. - -%% The peer hasn't been connected recently ... -okay([{_,P}]) -> - P = self(), %% assert - okay; - -%% ... or it has. -okay(C) -> - [_|_] = [P ! close || {_,P} <- C, self() /= P], - reopen. - -%% set_watchdog/1 - -set_watchdog(#watchdog{tw = TwInit, - tref = TRef} - = S) -> - cancel(TRef), - S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)}. - -cancel(undefined) -> - ok; -cancel(TRef) -> - erlang:cancel_timer(TRef). - -tw(T) - when is_integer(T), T >= 6000 -> - T - 2000 + (random:uniform(4001) - 1); %% RFC3539 jitter of +/- 2 sec. -tw({M,F,A}) -> - apply(M,F,A). - -%% open/2 - -open(Pid, {_,_} = T) -> - Pid ! {connection_up, self(), T}. - -%% failover/1 - -failover(#watchdog{status = okay, - parent = Pid}) -> - Pid ! {connection_down, self()}; - -failover(_) -> - ok. - -%% close/1 - -close(#watchdog{status = down}) -> - ok; - -close(#watchdog{parent = Pid}) -> - {{T, _}, _, _} = getr(restart), - T == accept andalso (Pid ! {close, self()}). - -%% send_watchdog/1 - -send_watchdog(#watchdog{pending = false, - transport = TPid} - = S) -> - TPid ! {send, encode(getr(dwr))}, - ?LOG(send, 'DWR'), - S#watchdog{pending = true}. - -%% recv/3 - -recv(Name, Pkt, S) -> - try rcv(Name, S) of - #watchdog{} = NS -> - rcv(Name, Pkt, S), - NS - catch - throw: {?MODULE, throwaway, #watchdog{} = NS} -> - NS - end. - -%% rcv/3 - -rcv(N, _, _) - when N == 'CER'; - N == 'CEA'; - N == 'DWR'; - N == 'DWA'; - N == 'DPR'; - N == 'DPA' -> - false; - -rcv(_, Pkt, #watchdog{transport = TPid, - message_data = T}) -> - diameter_service:receive_message(TPid, Pkt, T). - -throwaway(S) -> - throw({?MODULE, throwaway, S}). - -%% rcv/2 - -%% INITIAL Receive DWA Pending = FALSE -%% Throwaway() INITIAL -%% INITIAL Receive non-DWA Throwaway() INITIAL - -rcv('DWA', #watchdog{status = initial} = S) -> - throwaway(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = initial} = S) -> - throwaway(S); - -%% DOWN Receive DWA Pending = FALSE -%% Throwaway() DOWN -%% DOWN Receive non-DWA Throwaway() DOWN - -rcv('DWA', #watchdog{status = down} = S) -> - throwaway(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = down} = S) -> - throwaway(S); - -%% OKAY Receive DWA Pending = FALSE -%% SetWatchdog() OKAY -%% OKAY Receive non-DWA SetWatchdog() OKAY - -rcv('DWA', #watchdog{status = okay} = S) -> - set_watchdog(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = okay} = S) -> - set_watchdog(S); - -%% SUSPECT Receive DWA Pending = FALSE -%% Failback() -%% SetWatchdog() OKAY -%% SUSPECT Receive non-DWA Failback() -%% SetWatchdog() OKAY - -rcv('DWA', #watchdog{status = suspect} = S) -> - failback(S), - set_watchdog(S#watchdog{status = okay, - pending = false}); - -rcv(_, #watchdog{status = suspect} = S) -> - failback(S), - set_watchdog(S#watchdog{status = okay}); - -%% REOPEN Receive DWA & Pending = FALSE -%% NumDWA == 2 NumDWA++ -%% Failback() OKAY - -rcv('DWA', #watchdog{status = reopen, - num_dwa = 2 = N, - parent = Pid} - = S) -> - open(Pid, eraser(open)), - S#watchdog{status = okay, - num_dwa = N+1, - pending = false}; - -%% REOPEN Receive DWA & Pending = FALSE -%% NumDWA < 2 NumDWA++ REOPEN - -rcv('DWA', #watchdog{status = reopen, - num_dwa = N} - = S) -> - S#watchdog{num_dwa = N+1, - pending = false}; - -%% REOPEN Receive non-DWA Throwaway() REOPEN - -rcv(_, #watchdog{status = reopen} = S) -> - throwaway(S). - -%% failback/1 - -failback(#watchdog{parent = Pid}) -> - Pid ! {connection_up, self()}. - -%% timeout/1 -%% -%% The caller sets the watchdog on the return value. - -%% OKAY Timer expires & SendWatchdog() -%% !Pending SetWatchdog() -%% Pending = TRUE OKAY -%% REOPEN Timer expires & SendWatchdog() -%% !Pending SetWatchdog() -%% Pending = TRUE REOPEN - -timeout(#watchdog{status = T, - pending = false} - = S) - when T == okay; - T == reopen -> - send_watchdog(S); - -%% OKAY Timer expires & Failover() -%% Pending SetWatchdog() SUSPECT - -timeout(#watchdog{status = okay, - pending = true} - = S) -> - failover(S), - S#watchdog{status = suspect}; - -%% SUSPECT Timer expires CloseConnection() -%% SetWatchdog() DOWN -%% REOPEN Timer expires & CloseConnection() -%% Pending & SetWatchdog() -%% NumDWA < 0 DOWN - -timeout(#watchdog{status = T, - pending = P, - num_dwa = N, - transport = TPid} - = S) - when T == suspect; - T == reopen, P, N < 0 -> - exit(TPid, shutdown), - close(S), - S#watchdog{status = down}; - -%% REOPEN Timer expires & NumDWA = -1 -%% Pending & SetWatchdog() -%% NumDWA >= 0 REOPEN - -timeout(#watchdog{status = reopen, - pending = true, - num_dwa = N} - = S) - when 0 =< N -> - S#watchdog{num_dwa = -1}; - -%% DOWN Timer expires AttemptOpen() -%% SetWatchdog() DOWN -%% INITIAL Timer expires AttemptOpen() -%% SetWatchdog() INITIAL - -%% RFC 3539, 3.4.1: -%% -%% [5] While the connection is in the closed state, the AAA client MUST -%% NOT attempt to send further watchdog messages on the connection. -%% However, after the connection is closed, the AAA client continues -%% to periodically attempt to reopen the connection. -%% -%% The AAA client SHOULD wait for the transport layer to report -%% connection failure before attempting again, but MAY choose to -%% bound this wait time by the watchdog interval, Tw. - -%% Don't bound, restarting the peer process only when the previous -%% process has died. We only need to handle state down since we start -%% the first watchdog when transitioning out of initial. - -timeout(#watchdog{status = down} = S) -> - restart(S). - -%% restart/1 - -restart(#watchdog{transport = undefined} = S) -> - restart(getr(restart), S); -restart(S) -> - S. - -%% Only restart the transport in the connecting case. For an accepting -%% transport, we've registered the peer connection when leaving state -%% initial and this is used by a new accepting process to realize that -%% it's actually in state down rather then initial when receiving -%% notification of an open connection. - -restart({{connect, _} = T, Opts, Svc}, #watchdog{parent = Pid} = S) -> - Pid ! {reconnect, self()}, - S#watchdog{transport = monitor(diameter_peer_fsm:start(T, Opts, Svc))}; -restart({{accept, _}, _, _}, S) -> - S. -%% Don't currently use Opts/Svc in the accept case but having them in -%% the process dictionary is helpful if the process dies unexpectedly. - -%% dwr/1 - -dwr(#diameter_caps{origin_host = OH, - origin_realm = OR, - origin_state_id = OSI}) -> - ['DWR', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Origin-State-Id', OSI}]. diff --git a/lib/diameter/src/app/diameter_watchdog_sup.erl b/lib/diameter/src/app/diameter_watchdog_sup.erl deleted file mode 100644 index fc837fe4ef..0000000000 --- a/lib/diameter/src/app/diameter_watchdog_sup.erl +++ /dev/null @@ -1,60 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Supervisor for all watchdog processes. -%% - --module(diameter_watchdog_sup). - --behaviour(supervisor). - -%% interface --export([start_link/0, %% supervisor start - start_child/1]). %% watchdog start - --export([init/1]). - --define(NAME, ?MODULE). %% supervisor name - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% Start a watchdog process. - -start_child(T) -> - supervisor:start_child(?NAME, [T]). - -%% init/1 - -init([]) -> - Mod = diameter_watchdog, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/modules.mk b/lib/diameter/src/app/modules.mk deleted file mode 100644 index 2b602cd713..0000000000 --- a/lib/diameter/src/app/modules.mk +++ /dev/null @@ -1,69 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% - -DICTIONARIES = \ - base_rfc3588 \ - base_accounting \ - relay - -RUNTIME_MODULES = \ - diameter \ - diameter_app \ - diameter_capx \ - diameter_config \ - diameter_codec \ - diameter_dict \ - diameter_lib \ - diameter_misc_sup \ - diameter_peer \ - diameter_peer_fsm \ - diameter_peer_fsm_sup \ - diameter_reg \ - diameter_service \ - diameter_service_sup \ - diameter_session \ - diameter_stats \ - diameter_sup \ - diameter_sync \ - diameter_types \ - diameter_watchdog \ - diameter_watchdog_sup - -HELP_MODULES = \ - diameter_callback \ - diameter_dbg \ - diameter_info - -INTERNAL_HRL_FILES = \ - diameter_internal.hrl \ - diameter_types.hrl - -EXTERNAL_HRL_FILES = \ - ../../include/diameter.hrl \ - ../../include/diameter_gen.hrl - -EXAMPLE_FILES = \ - ../../examples/GNUmakefile \ - ../../examples/peer.erl \ - ../../examples/client.erl \ - ../../examples/client_cb.erl \ - ../../examples/server.erl \ - ../../examples/server_cb.erl \ - ../../examples/relay.erl \ - ../../examples/relay_cb.erl diff --git a/lib/diameter/src/base/diameter.app.src b/lib/diameter/src/base/diameter.app.src new file mode 100644 index 0000000000..c092fdb022 --- /dev/null +++ b/lib/diameter/src/base/diameter.app.src @@ -0,0 +1,28 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +{application, diameter, + [{description, "Diameter protocol"}, + {vsn, "%VSN%"}, + {modules, [%MODULES%]}, + {registered, []}, + {applications, [stdlib, kernel]}, + {env, []}, + {mod, {diameter_app, []}} + ]}. diff --git a/lib/diameter/src/base/diameter.appup.src b/lib/diameter/src/base/diameter.appup.src new file mode 100644 index 0000000000..6d8ceadb92 --- /dev/null +++ b/lib/diameter/src/base/diameter.appup.src @@ -0,0 +1,47 @@ +%% This is an -*- erlang -*- file. +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +{"%VSN%", + [ + {"0.9", + [ + {load_module, diameter, soft_purge, soft_purge, []}, + {load_module, diameter_capx, soft_purge, soft_purge, []}, + {load_module, diameter_codec, soft_purge, soft_purge, [diameter_lib]}, + {load_module, diameter_lib, soft_purge, soft_purge, []}, + {load_module, diameter_types, soft_purge, soft_purge, []}, + {load_module, diameter_gen_base_accounting, soft_purge, soft_purge, []}, + {load_module, diameter_gen_base_rfc3588, soft_purge, soft_purge, []}, + {load_module, diameter_gen_relay, soft_purge, soft_purge, []}, + {update, diameter_service, soft, soft_purge, soft_purge, [diameter_lib]}, + {update, diameter_config, soft, soft_purge, soft_purge, []}, + {update, diameter_peer, soft, soft_purge, soft_purge, []}, + {update, diameter_peer_fsm, soft, soft_purge, soft_purge, [diameter_lib]}, + {update, diameter_reg, soft, soft_purge, soft_purge, []}, + {update, diameter_sctp, soft, soft_purge, soft_purge, []}, + {update, diameter_stats, soft, soft_purge, soft_purge, []}, + {update, diameter_sync, soft, soft_purge, soft_purge, []}, + {update, diameter_watchdog, soft, soft_purge, soft_purge, [diameter_lib]} + ] + } + ], + [ + ] +}. diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl new file mode 100644 index 0000000000..2f721421d8 --- /dev/null +++ b/lib/diameter/src/base/diameter.erl @@ -0,0 +1,190 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter). + +%% Configuration. +-export([start_service/2, + stop_service/1, + add_transport/2, + remove_transport/2, + subscribe/1, + unsubscribe/1]). + +%% Traffic. +-export([session_id/1, + origin_state_id/0, + call/3, + call/4]). + +%% Information. +-export([services/0, + service_info/2]). + +%% Start/stop the application. In a "real" application this should +%% typically be a consequence of specifying diameter in a release file +%% rather than by calling start/stop explicitly. +-export([start/0, + stop/0]). + +-include("diameter_internal.hrl"). +-include("diameter_types.hrl"). + +%%% -------------------------------------------------------------------------- +%%% start/0 +%%% -------------------------------------------------------------------------- + +-spec start() + -> ok + | {error, term()}. + +start() -> + application:start(?APPLICATION). + +%%% -------------------------------------------------------------------------- +%%% stop/0 +%%% -------------------------------------------------------------------------- + +-spec stop() + -> ok + | {error, term()}. + +stop() -> + application:stop(?APPLICATION). + +%%% -------------------------------------------------------------------------- +%%% start_service/2 +%%% -------------------------------------------------------------------------- + +-spec start_service(service_name(), [service_opt()]) + -> ok + | {error, term()}. + +start_service(SvcName, Opts) + when is_list(Opts) -> + diameter_config:start_service(SvcName, Opts). + +%%% -------------------------------------------------------------------------- +%%% stop_service/1 +%%% -------------------------------------------------------------------------- + +-spec stop_service(service_name()) + -> ok + | {error, term()}. + +stop_service(SvcName) -> + diameter_config:stop_service(SvcName). + +%%% -------------------------------------------------------------------------- +%%% services/0 +%%% -------------------------------------------------------------------------- + +-spec services() + -> [service_name()]. + +services() -> + [Name || {Name, _} <- diameter_service:services()]. + +%%% -------------------------------------------------------------------------- +%%% service_info/2 +%%% -------------------------------------------------------------------------- + +-spec service_info(service_name(), atom() | [atom()]) + -> any(). + +service_info(SvcName, Option) -> + diameter_service:info(SvcName, Option). + +%%% -------------------------------------------------------------------------- +%%% add_transport/3 +%%% -------------------------------------------------------------------------- + +-spec add_transport(service_name(), {listen|connect, [transport_opt()]}) + -> {ok, transport_ref()} + | {error, term()}. + +add_transport(SvcName, {T, Opts} = Cfg) + when is_list(Opts), (T == connect orelse T == listen) -> + diameter_config:add_transport(SvcName, Cfg). + +%%% -------------------------------------------------------------------------- +%%% remove_transport/2 +%%% -------------------------------------------------------------------------- + +-spec remove_transport(service_name(), transport_pred()) + -> ok | {error, term()}. + +remove_transport(SvcName, Pred) -> + diameter_config:remove_transport(SvcName, Pred). + +%%% -------------------------------------------------------------------------- +%%% # subscribe(SvcName) +%%% +%%% Description: Subscribe to #diameter_event{} messages for the specified +%%% service. +%%% -------------------------------------------------------------------------- + +-spec subscribe(service_name()) + -> true. + +subscribe(SvcName) -> + diameter_service:subscribe(SvcName). + +%%% -------------------------------------------------------------------------- +%%% # unsubscribe(SvcName) +%%% -------------------------------------------------------------------------- + +-spec unsubscribe(service_name()) + -> true. + +unsubscribe(SvcName) -> + diameter_service:unsubscribe(SvcName). + +%%% ---------------------------------------------------------- +%%% # session_id/1 +%%% ---------------------------------------------------------- + +-spec session_id('DiameterIdentity'()) + -> 'OctetString'(). + +session_id(Ident) -> + diameter_session:session_id(Ident). + +%%% ---------------------------------------------------------- +%%% # origin_state_id/0 +%%% ---------------------------------------------------------- + +-spec origin_state_id() + -> 'Unsigned32'(). + +origin_state_id() -> + diameter_session:origin_state_id(). + +%%% -------------------------------------------------------------------------- +%%% # call/[34] +%%% -------------------------------------------------------------------------- + +-spec call(service_name(), app_alias(), any(), [call_opt()]) + -> any(). + +call(SvcName, App, Message, Options) -> + diameter_service:call(SvcName, {alias, App}, Message, Options). + +call(SvcName, App, Message) -> + call(SvcName, App, Message, []). diff --git a/lib/diameter/src/base/diameter_app.erl b/lib/diameter/src/base/diameter_app.erl new file mode 100644 index 0000000000..600f7ff04d --- /dev/null +++ b/lib/diameter/src/base/diameter_app.erl @@ -0,0 +1,36 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_app). + +-behaviour(application). + +%% application callbacks +-export([start/2, + stop/1]). + +%% start/2 + +start(_Type, _Args) -> + diameter_sup:start_link(). + +%% stop/1 + +stop(_) -> + ok. diff --git a/lib/diameter/src/base/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl new file mode 100644 index 0000000000..6d5c8cdca1 --- /dev/null +++ b/lib/diameter/src/base/diameter_callback.erl @@ -0,0 +1,91 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% A minimal application callback module. +%% + +-module(diameter_callback). + +-export([peer_up/3, + peer_down/3, + pick_peer/4, + prepare_request/3, + prepare_retransmit/3, + handle_request/3, + handle_answer/4, + handle_error/4]). + +-include_lib("diameter/include/diameter.hrl"). + +%%% ---------------------------------------------------------- +%%% # peer_up/3 +%%% ---------------------------------------------------------- + +peer_up(_Svc, _Peer, State) -> + State. + +%%% ---------------------------------------------------------- +%%% # peer_down/3 +%%% ---------------------------------------------------------- + +peer_down(_SvcName, _Peer, State) -> + State. + +%%% ---------------------------------------------------------- +%%% # pick_peer/4 +%%% ---------------------------------------------------------- + +pick_peer([Peer|_], _, _SvcName, _State) -> + {ok, Peer}. + +%%% ---------------------------------------------------------- +%%% # prepare_request/3 +%%% ---------------------------------------------------------- + +prepare_request(Pkt, _SvcName, _Peer) -> + {send, Pkt}. + +%%% ---------------------------------------------------------- +%%% # prepare_retransmit/3 +%%% ---------------------------------------------------------- + +prepare_retransmit(Pkt, _SvcName, _Peer) -> + {send, Pkt}. + +%%% ---------------------------------------------------------- +%%% # handle_request/3 +%%% ---------------------------------------------------------- + +handle_request(_Pkt, _SvcName, _Peer) -> + {protocol_error, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED + +%%% ---------------------------------------------------------- +%%% # handle_answer/4 +%%% ---------------------------------------------------------- + +handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) -> + Ans. + +%%% --------------------------------------------------------------------------- +%%% # handle_error/4 +%%% --------------------------------------------------------------------------- + +handle_error(Reason, _Req, _SvcName, _Peer) -> + {error, Reason}. diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl new file mode 100644 index 0000000000..138e76411e --- /dev/null +++ b/lib/diameter/src/base/diameter_capx.erl @@ -0,0 +1,405 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This module builds CER and CEA records for use during capabilities +%% exchange. All of a CER/CEA is built from AVP values configured on +%% the service in question but values for Supported-Vendor-Id, +%% Vendor-Specific-Application-Id, Auth-Application-Id and +%% Acct-Application-id are also obtained using an older method that +%% remains only for backwards compatibility. With this method, each +%% dictionary module was required to export a cer/0 that returned a +%% diameter_base_CER record (or corresponding list, although the list +%% is also a later addition). Each returned CER contributes its member +%% values for the aforementioned four AVPs to the resulting CER, with +%% remaining AVP's either unspecified or identical to those configured +%% on the service. Auth-Application-Id and Acct-Application-id were +%% originally treated a little differently, each callback being +%% required to return either no value of the same value as the other +%% callbacks, but this coupled the callback modules unnecessarily. (A +%% union is backwards compatible to boot.) +%% +%% Values obtained from the service and callbacks are all included +%% when building a CER. Older code with only callback can continue to +%% use them, newer code should probably stick to service configuration +%% (since this is more explicit) or mix at their own peril. +%% +%% The cer/0 callback is now undocumented (despite never being fully +%% documented to begin with) and should be considered deprecated even +%% by those poor souls still using it. +%% + +-module(diameter_capx). + +-export([build_CER/1, + recv_CER/2, + recv_CEA/2, + make_caps/2]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). +-include("diameter_types.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). + +-define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). +-define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION'). +-define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). + +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + +%% =========================================================================== + +-type tried(T) :: {ok, T} | {error, {term(), list()}}. + +-spec build_CER(#diameter_caps{}) + -> tried(#diameter_base_CER{}). + +build_CER(Caps) -> + try_it([fun bCER/1, Caps]). + +-spec recv_CER(#diameter_base_CER{}, #diameter_service{}) + -> tried({['Unsigned32'()], #diameter_caps{}, #diameter_base_CEA{}}). + +recv_CER(CER, Svc) -> + try_it([fun rCER/2, CER, Svc]). + +-spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) + -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). + +recv_CEA(CEA, Svc) -> + try_it([fun rCEA/2, CEA, Svc]). + +make_caps(Caps, Opts) -> + try_it([fun mk_caps/2, Caps, Opts]). + +%% =========================================================================== +%% =========================================================================== + +try_it([Fun | Args]) -> + try apply(Fun, Args) of + T -> {ok, T} + catch + throw: ?FAILURE(Reason) -> {error, {Reason, Args}} + end. + +%% mk_caps/2 + +mk_caps(Caps0, Opts) -> + {Caps, _} = lists:foldl(fun set_cap/2, + {Caps0, #diameter_caps{_ = false}}, + Opts), + Caps. + +-define(SC(K,F), + set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) -> + {Caps#diameter_caps{F = cap(K, Val)}, C#diameter_caps{F = true}}). + +?SC('Origin-Host', origin_host); +?SC('Origin-Realm', origin_realm); +?SC('Host-IP-Address', host_ip_address); +?SC('Vendor-Id', vendor_id); +?SC('Product-Name', product_name); +?SC('Origin-State-Id', origin_state_id); +?SC('Supported-Vendor-Id', supported_vendor_id); +?SC('Auth-Application-Id', auth_application_id); +?SC('Inband-Security-Id', inband_security_id); +?SC('Acct-Application-Id', acct_application_id); +?SC('Vendor-Specific-Application-Id', vendor_specific_application_id); +?SC('Firmware-Revision', firmware_revision); + +set_cap({Key, _}, _) -> + ?THROW({duplicate, Key}). + +cap(K, V) + when K == 'Origin-Host'; + K == 'Origin-Realm'; + K == 'Vendor-Id'; + K == 'Product-Name' -> + V; + +cap('Host-IP-Address', Vs) + when is_list(Vs) -> + lists:map(fun ipaddr/1, Vs); + +cap('Firmware-Revision', V) -> + [V]; + +cap(_, Vs) + when is_list(Vs) -> + Vs; + +cap(K, V) -> + ?THROW({invalid, K, V}). + +ipaddr(A) -> + try + diameter_lib:ipaddr(A) + catch + error: {invalid_address, _} = T -> + ?THROW(T) + end. + +%% bCER/1 +%% +%% Build a CER record to send to a remote peer. + +%% Use the fact that diameter_caps has the same field names as CER. +bCER(#diameter_caps{} = Rec) -> + #diameter_base_CER{} + = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). + +%% rCER/2 +%% +%% Build a CEA record to send to a remote peer in response to an +%% incoming CER. RFC 3588 gives no guidance on what should be sent +%% here: should we advertise applications that the peer hasn't sent in +%% its CER (aside from the relay application) or not? If we send +%% applications that the peer hasn't advertised then the peer may have +%% to be aware of the possibility. If we don't then we just look like +%% a server that supports a subset (possibly) of what the client +%% advertised, so this feels like the path of least incompatibility. +%% However, the current draft standard (draft-ietf-dime-rfc3588bis-26, +%% expires 24 July 2011) says this in section 5.3, Capabilities +%% Exchange: +%% +%% The receiver of the Capabilities-Exchange-Request (CER) MUST +%% determine common applications by computing the intersection of its +%% own set of supported Application Id against all of the application +%% identifier AVPs (Auth-Application-Id, Acct-Application-Id and Vendor- +%% Specific-Application-Id) present in the CER. The value of the +%% Vendor-Id AVP in the Vendor-Specific-Application-Id MUST NOT be used +%% during computation. The sender of the Capabilities-Exchange-Answer +%% (CEA) SHOULD include all of its supported applications as a hint to +%% the receiver regarding all of its application capabilities. +%% +%% Both RFC and the draft also say this: +%% +%% The receiver only issues commands to its peers that have advertised +%% support for the Diameter application that defines the command. A +%% Diameter node MUST cache the supported applications in order to +%% ensure that unrecognized commands and/or AVPs are not unnecessarily +%% sent to a peer. +%% +%% That is, each side sends all of its capabilities and is responsible for +%% not sending commands that the peer doesn't support. + +%% 6.10. Inband-Security-Id AVP +%% +%% NO_INBAND_SECURITY 0 +%% This peer does not support TLS. This is the default value, if the +%% AVP is omitted. +%% +%% TLS 1 +%% This node supports TLS security, as defined by [TLS]. + +rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> + #diameter_base_CEA{} + = CEA + = cea_from_cer(bCER(LCaps)), + + RCaps = capx_to_caps(CER), + SApps = common_applications(LCaps, RCaps, Svc), + + {SApps, + RCaps, + build_CEA(SApps, + LCaps, + RCaps, + CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. + +%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION +%% in the CEA and SHOULD disconnect the transport. However, we have +%% no way to guarantee the send before disconnecting. + +build_CEA([], _, _, CEA) -> + CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; + +build_CEA(_, LCaps, RCaps, CEA) -> + case common_security(LCaps, RCaps) of + [] -> + CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; + [_] = IS -> + CEA#diameter_base_CEA{'Inband-Security-Id' = IS} + end. + +%% common_security/2 + +common_security(#diameter_caps{inband_security_id = LS}, + #diameter_caps{inband_security_id = RS}) -> + cs(LS, RS). + +%% Unspecified is equivalent to NO_INBAND_SECURITY. +cs([], RS) -> + cs([?NO_INBAND_SECURITY], RS); +cs(LS, []) -> + cs(LS, [?NO_INBAND_SECURITY]); + +%% Agree on TLS if both parties support it. When sending CEA, this is +%% to ensure the peer is clear that we will be expecting a TLS +%% handshake since there is no ssl:maybe_accept that would allow the +%% peer to choose between TLS or not upon reception of our CEA. When +%% receiving CEA it deals with a server that isn't explicit about its choice. +%% TODO: Make the choice configurable. +cs(LS, RS) -> + Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS), + ordsets:from_list(RS))), + case lists:member(?TLS, Is) of + true -> + [?TLS]; + false when [] == Is -> + Is; + false -> + [hd(Is)] %% probably NO_INBAND_SECURITY + end. +%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and +%% TLS but don't enforce this. In theory this allows some other +%% security mechanism we don't have to know about, although in +%% practice something there may be a need for more synchronization +%% than notification by way of an event subscription offers. + +%% cea_from_cer/1 + +%% CER is a subset of CEA, the latter adding Result-Code and a few +%% more AVP's. +cea_from_cer(#diameter_base_CER{} = CER) -> + lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, + #diameter_base_CEA{}, + record_info(fields, diameter_base_CER)). + +to_cea(CER, Field, CEA) -> + try ?BASE:'#get-'(Field, CER) of + V -> ?BASE:'#set-'({Field, V}, CEA) + catch + error: _ -> CEA + end. + +%% rCEA/2 + +rCEA(#diameter_base_CEA{'Result-Code' = RC} + = CEA, + #diameter_service{capabilities = LCaps} + = Svc) -> + RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), + + RCaps = capx_to_caps(CEA), + SApps = common_applications(LCaps, RCaps, Svc), + + [] == SApps andalso ?THROW(no_common_applications), + + IS = common_security(LCaps, RCaps), + + [] == IS andalso ?THROW(no_common_security), + + {SApps, IS, RCaps}; + +rCEA(CEA, _Svc) -> + ?THROW({invalid, CEA}). + +%% capx_to_caps/1 + +capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Host-IP-Address' = IP, + 'Vendor-Id' = VId, + 'Product-Name' = PN, + 'Origin-State-Id' = OSI, + 'Supported-Vendor-Id' = SV, + 'Auth-Application-Id' = Auth, + 'Inband-Security-Id' = IS, + 'Acct-Application-Id' = Acct, + 'Vendor-Specific-Application-Id' = VSA, + 'Firmware-Revision' = FR, + 'AVP' = X}) -> + #diameter_caps{origin_host = OH, + origin_realm = OR, + vendor_id = VId, + product_name = PN, + origin_state_id = OSI, + host_ip_address = IP, + supported_vendor_id = SV, + auth_application_id = Auth, + inband_security_id = IS, + acct_application_id = Acct, + vendor_specific_application_id = VSA, + firmware_revision = FR, + avp = X}; + +capx_to_caps(#diameter_base_CER{} = CER) -> + capx_to_caps(cea_from_cer(CER)). + +%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- + +%% common_applications/3 +%% +%% Identify the (local) applications to be supported on the connection +%% in question. + +common_applications(LCaps, RCaps, #diameter_service{applications = Apps}) -> + LA = app_union(LCaps), + RA = app_union(RCaps), + + lists:foldl(fun(I,A) -> ca(I, Apps, RA, A) end, [], LA). + +ca(Id, Apps, RA, Acc) -> + Relay = lists:member(?APP_ID_RELAY, RA), + #diameter_app{alias = Alias} = find_app(Id, Apps), + tcons(Relay %% peer is a relay + orelse ?APP_ID_RELAY == Id %% we're a relay + orelse lists:member(Id, RA), %% app is supported by the peer + Id, + Alias, + Acc). +%% 5.3 of the RFC states that a peer advertising itself as a relay must +%% be interpreted as having common applications. + +%% Extract the list of all application identifiers from Auth-Application-Id, +%% Acct-Application-Id and Vendor-Specific-Application-Id. +app_union(#diameter_caps{auth_application_id = U, + acct_application_id = C, + vendor_specific_application_id = V}) -> + set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)). + +vsa_apps(#'diameter_base_Vendor-Specific-Application-Id' + {'Auth-Application-Id' = U, + 'Acct-Application-Id' = C}) -> + U ++ C; +vsa_apps(L) -> + Rec = ?BASE:'#new-'('diameter_base_Vendor-Specific-Application-Id', L), + vsa_apps(Rec). + +%% It's a configuration error for a locally advertised application not +%% to be represented in Apps. Don't just match on lists:keyfind/3 in +%% order to generate a more helpful error. +find_app(Id, Apps) -> + case lists:keyfind(Id, #diameter_app.id, Apps) of + #diameter_app{} = A -> + A; + false -> + ?THROW({app_not_configured, Id}) + end. + +set_list(L) -> + sets:to_list(sets:from_list(L)). + +tcons(true, K, V, Acc) -> + [{K,V} | Acc]; +tcons(false, _, _, Acc) -> + Acc. diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl new file mode 100644 index 0000000000..d88f42fb7c --- /dev/null +++ b/lib/diameter/src/base/diameter_codec.erl @@ -0,0 +1,561 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_codec). + +-export([encode/2, + decode/2, + decode/3, + collect_avps/1, + decode_header/1, + sequence_numbers/1, + hop_by_hop_id/2, + msg_name/1, + msg_id/1]). + +%% Towards generated encoders (from diameter_gen.hrl). +-export([pack_avp/1, + pack_avp/2]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +-define(MASK(N,I), ((I) band (1 bsl (N)))). + +%% 0 1 2 3 +%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Version | Message Length | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | command flags | Command-Code | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Application-ID | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Hop-by-Hop Identifier | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | End-to-End Identifier | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | AVPs ... +%% +-+-+-+-+-+-+-+-+-+-+-+-+- + +%%% --------------------------------------------------------------------------- +%%% # encode/[2-4] +%%% --------------------------------------------------------------------------- + +encode(Mod, #diameter_packet{} = Pkt) -> + try + e(Mod, Pkt) + catch + error: Reason -> + %% Be verbose rather than letting the emulator truncate the + %% error report. + X = {Reason, ?STACK}, + diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}), + exit(X) + end; + +encode(Mod, Msg) -> + Seq = diameter_session:sequence(), + Hdr = #diameter_header{version = ?DIAMETER_VERSION, + end_to_end_id = Seq, + hop_by_hop_id = Seq}, + encode(Mod, #diameter_packet{header = Hdr, + msg = Msg}). + +e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> + Avps = encode_avps(As), + Length = size(Avps) + 20, + + #diameter_header{version = Vsn, + cmd_code = Code, + application_id = Aid, + hop_by_hop_id = Hid, + end_to_end_id = Eid} + = Hdr, + + Flags = make_flags(0, Hdr), + + Pkt#diameter_packet{bin = <>}; + +e(Mod0, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> + #diameter_header{version = Vsn, + hop_by_hop_id = Hid, + end_to_end_id = Eid} + = Hdr, + + {Mod, MsgName} = rec2msg(Mod0, Msg), + {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), + Flags = make_flags(Flags0, Hdr), + + Avps = encode_avps(Mod, MsgName, values(Msg)), + Length = size(Avps) + 20, + + Pkt#diameter_packet{header = Hdr#diameter_header + {length = Length, + cmd_code = Code, + application_id = Aid, + is_request = 0 /= ?MASK(7, Flags), + is_proxiable = 0 /= ?MASK(6, Flags), + is_error = 0 /= ?MASK(5, Flags), + is_retransmitted = 0 /= ?MASK(4, Flags)}, + bin = <>}. + +%% make_flags/2 + +make_flags(Flags0, #diameter_header{is_request = R, + is_proxiable = P, + is_error = E, + is_retransmitted = T}) -> + {Flags, 3} = lists:foldl(fun(B,{F,N}) -> {mf(B,F,N), N-1} end, + {Flags0, 7}, + [R,P,E,T]), + Flags. + +mf(undefined, F, _) -> + F; +mf(B, F, N) -> %% reset the affected bit + (F bxor (F band (1 bsl N))) bor bit(B, N). + +bit(true, N) -> 1 bsl N; +bit(false, _) -> 0. + +%% values/1 + +values([H|T]) + when is_atom(H) -> + T; +values(Avps) -> + Avps. + +%% encode_avps/3 + +%% Specifying values as a #diameter_avp list bypasses arity and other +%% checks: the values are expected to be already encoded and the AVP's +%% presented are simply sent. This is needed for relay agents, since +%% these have to be able to resend whatever comes. + +%% Message as a list of #diameter_avp{} ... +encode_avps(_, _, [#diameter_avp{} | _] = Avps) -> + encode_avps(reorder(Avps, [], Avps)); + +%% ... or as a tuple list or record. +encode_avps(Mod, MsgName, Values) -> + Mod:encode_avps(MsgName, Values). + +%% reorder/1 + +reorder([#diameter_avp{index = 0} | _] = Avps, Acc, _) -> + Avps ++ Acc; + +reorder([#diameter_avp{index = N} = A | Avps], Acc, _) + when is_integer(N) -> + lists:reverse(Avps, [A | Acc]); + +reorder([H | T], Acc, Avps) -> + reorder(T, [H | Acc], Avps); + +reorder([], Acc, _) -> + Acc. + +%% encode_avps/1 + +encode_avps(Avps) -> + list_to_binary(lists:map(fun pack_avp/1, Avps)). + +%% msg_header/3 + +msg_header(Mod, MsgName, Header) -> + {Code, Flags, ApplId} = h(Mod, MsgName, Header), + {Code, p(Flags, Header), ApplId}. + +%% 6.2 of 3588 requires the same 'P' bit on an answer as on the +%% request. + +p(Flags, #diameter_header{is_request = true, + is_proxiable = P}) -> + Flags band (2#10110000 bor choose(P, 2#01000000, 0)); +p(Flags, _) -> + Flags. + +h(Mod, 'answer-message' = MsgName, Header) -> + ?BASE = Mod, + #diameter_header{cmd_code = Code} = Header, + {_, Flags, ApplId} = ?BASE:msg_header(MsgName), + {Code, Flags, ApplId}; + +h(Mod, MsgName, _) -> + Mod:msg_header(MsgName). + +%% rec2msg/2 + +rec2msg(_, ['answer-message' = M | _]) -> + {?BASE, M}; + +rec2msg(Mod, [MsgName|_]) + when is_atom(MsgName) -> + {Mod, MsgName}; + +rec2msg(Mod, Rec) -> + R = element(1, Rec), + A = 'answer-message', + case ?BASE:msg2rec(A) of + R -> + {?BASE, A}; + _ -> + {Mod, Mod:rec2msg(R)} + end. + +%%% --------------------------------------------------------------------------- +%%% # decode/2 +%%% --------------------------------------------------------------------------- + +%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. + +decode(Mod, Pkt) -> + decode(Mod:id(), Mod, Pkt). + +%% If we're a relay application then just extract the avp's without +%% any decoding of their data since we don't know the application in +%% question. +decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> + case collect_avps(Pkt) of + {Bs, As} -> + Pkt#diameter_packet{avps = As, + errors = [Bs]}; + As -> + Pkt#diameter_packet{avps = As} + end; + +%% Otherwise decode using the dictionary. +decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) + when is_atom(Mod) -> + #diameter_header{cmd_code = CmdCode, + is_request = IsRequest, + is_error = IsError} + = Hdr, + + {M, MsgName} = if IsError andalso not IsRequest -> + {?BASE, 'answer-message'}; + true -> + {Mod, Mod:msg_name(CmdCode, IsRequest)} + end, + + decode_avps(MsgName, M, Pkt, collect_avps(Pkt)); + +decode(Id, Mod, Bin) + when is_bitstring(Bin) -> + decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). + +decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ... + ?LOG(invalid, Pkt#diameter_packet.bin), + #diameter_packet{errors = Failed} + = P + = decode_avps(MsgName, Mod, Pkt, Avps), + P#diameter_packet{errors = [Bs | Failed]}; + +decode_avps('', Mod, Pkt, Avps) -> %% unknown message ... + ?LOG(unknown, {Mod, Pkt#diameter_packet.header}), + Pkt#diameter_packet{avps = lists:reverse(Avps), + errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED +%% msg = undefined identifies this case. + +decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not + {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps), + ?LOGC([] /= Failed, failed, {Mod, Failed}), + Pkt#diameter_packet{msg = Rec, + errors = Failed, + avps = As}. + +%%% --------------------------------------------------------------------------- +%%% # decode_header/1 +%%% --------------------------------------------------------------------------- + +decode_header(<>) -> + <> + = CmdFlags, + %% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored + %% by the receiver. + + %% The RFC is quite unclear about the order of the bits in this + %% case. It writes + %% + %% 0 1 2 3 4 5 6 7 + %% +-+-+-+-+-+-+-+-+ + %% |R P E T r r r r| + %% +-+-+-+-+-+-+-+-+ + %% + %% in defining these but the scale refers to the (big endian) + %% transmission order, first to last, not the bit order. That is, + %% R is the high order bit. It's odd that a standard reserves + %% low-order bit rather than high-order ones. + + #diameter_header{version = Version, + length = MsgLength, + cmd_code = CmdCode, + application_id = ApplicationId, + hop_by_hop_id = HopByHopId, + end_to_end_id = EndToEndId, + is_request = 1 == R, + is_proxiable = 1 == P, + is_error = 1 == E, + is_retransmitted = 1 == T}; + +decode_header(_) -> + false. + +%%% --------------------------------------------------------------------------- +%%% # sequence_numbers/1 +%%% --------------------------------------------------------------------------- + +%% The End-To-End identifier must be unique for at least 4 minutes. We +%% maintain a 24-bit wraparound counter, and add an 8-bit persistent +%% wraparound counter. The 8-bit counter is incremented each time the +%% system is restarted. + +sequence_numbers(#diameter_packet{bin = Bin}) + when is_binary(Bin) -> + sequence_numbers(Bin); + +sequence_numbers(#diameter_packet{header = #diameter_header{} = H}) -> + sequence_numbers(H); + +sequence_numbers(#diameter_header{hop_by_hop_id = H, + end_to_end_id = E}) -> + {H,E}; + +sequence_numbers(<<_:12/binary, H:32, E:32, _/binary>>) -> + {H,E}. + +%%% --------------------------------------------------------------------------- +%%% # hop_by_hop_id/2 +%%% --------------------------------------------------------------------------- + +hop_by_hop_id(Id, <>) -> + <>. + +%%% --------------------------------------------------------------------------- +%%% # msg_name/1 +%%% --------------------------------------------------------------------------- + +msg_name(#diameter_header{application_id = ?APP_ID_COMMON, + cmd_code = C, + is_request = R}) -> + ?BASE:msg_name(C,R); + +msg_name(Hdr) -> + msg_id(Hdr). + +%% Note that messages in different applications could have the same +%% name. + +%%% --------------------------------------------------------------------------- +%%% # msg_id/1 +%%% --------------------------------------------------------------------------- + +msg_id(#diameter_packet{msg = [#diameter_header{} = Hdr | _]}) -> + msg_id(Hdr); + +msg_id(#diameter_packet{header = #diameter_header{} = Hdr}) -> + msg_id(Hdr); + +msg_id(#diameter_header{application_id = A, + cmd_code = C, + is_request = R}) -> + {A, C, if R -> 1; true -> 0 end}; + +msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> + {ApplId, CmdCode, Rbit}. + +%%% --------------------------------------------------------------------------- +%%% # collect_avps/1 +%%% --------------------------------------------------------------------------- + +%% Note that the returned list of AVP's is reversed relative to their +%% order in the binary. Note also that grouped avp's aren't unraveled, +%% only those at the top level. + +collect_avps(#diameter_packet{bin = Bin}) -> + <<_:20/binary, Avps/bitstring>> = Bin, + collect_avps(Avps); + +collect_avps(Bin) -> + collect_avps(Bin, 0, []). + +collect_avps(<<>>, _, Acc) -> + Acc; +collect_avps(Bin, N, Acc) -> + try split_avp(Bin) of + {Rest, AVP} -> + collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc]) + catch + ?FAILURE(_) -> + {Bin, Acc} + end. + +%% 0 1 2 3 +%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | AVP Code | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% |V M P r r r r r| AVP Length | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Vendor-ID (opt) | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Data ... +%% +-+-+-+-+-+-+-+-+ + +%% split_avp/1 + +split_avp(Bin) -> + 8 =< size(Bin) orelse ?THROW(truncated_header), + + <> + = Bin, + + DataSize = Length - 8, % size(Code+Flags+Length) = 8 octets + PadSize = (4 - (DataSize rem 4)) rem 4, + + DataSize + PadSize =< size(Rest) + orelse ?THROW(truncated_data), + + <> + = Rest, + <> + = Flags, + + 0 == Vbit orelse 4 =< size(Data) + orelse ?THROW(truncated_vendor_id), + + {Vid, D} = vid(Vbit, Data), + {R, #diameter_avp{code = Code, + vendor_id = Vid, + is_mandatory = 1 == Mbit, + need_encryption = 1 == Pbit, + data = D}}. + +%% The RFC is a little misleading when stating that OctetString is +%% padded to a 32-bit boundary while other types align naturally. All +%% other types are already multiples of 32 bits so there's no need to +%% distinguish between types here. Any invalid lengths will result in +%% decode error in diameter_types. + +vid(1, <>) -> + {Vid, Data}; +vid(0, Data) -> + {undefined, Data}. + +%%% --------------------------------------------------------------------------- +%%% # pack_avp/1 +%%% --------------------------------------------------------------------------- + +%% The normal case here is data as an #diameter_avp{} list or an +%% iolist, which are the cases that generated codec modules use. The +%% other case is as a convenience in the relay case in which the +%% dictionary doesn't know about specific AVP's. + +%% Grouped AVP whose components need packing ... +pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) -> + pack_avp(A#diameter_avp{data = encode_avps(Avps)}); + +%% ... data as a type/value tuple, possibly with header data, ... +pack_avp(#diameter_avp{data = {Type, Value}} = A) + when is_atom(Type) -> + pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)}); +pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) -> + pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value))); +pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}}) + when is_binary(Bin) -> + pack_avp(T, Bin); +pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> + {Code, _Flags, Vid} = Hdr = Dict:avp_header(Name), + {Name, Type} = Dict:avp_name(Code, Vid), + pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); + +%% ... or as an iolist. +pack_avp(#diameter_avp{code = Code, + vendor_id = V, + is_mandatory = M, + need_encryption = P, + data = Data}) -> + Flags = lists:foldl(fun flag_avp/2, 0, [{V /= undefined, 2#10000000}, + {M, 2#01000000}, + {P, 2#00100000}]), + pack_avp({Code, Flags, V}, iolist_to_binary(Data)). + +flag_avp({true, B}, F) -> + F bor B; +flag_avp({false, _}, F) -> + F. + +%%% --------------------------------------------------------------------------- +%%% # pack_avp/2 +%%% --------------------------------------------------------------------------- + +pack_avp({Code, Flags, VendorId}, Bin) + when is_binary(Bin) -> + Sz = size(Bin), + pack_avp(Code, Flags, VendorId, Sz, pad(Sz rem 4, Bin)). + +pad(0, Bin) -> + Bin; +pad(N, Bin) -> + P = 8*(4-N), + <>. +%% Note that padding is not included in the length field as mandated by +%% the RFC. + +%% pack_avp/5 +%% +%% Prepend the vendor id as required. + +pack_avp(Code, Flags, Vid, Sz, Bin) + when 0 == Flags band 2#10000000 -> + undefined = Vid, %% sanity check + pack_avp(Code, Flags, Sz, Bin); + +pack_avp(Code, Flags, Vid, Sz, Bin) -> + pack_avp(Code, Flags, Sz+4, <>). + +%% pack_avp/4 + +pack_avp(Code, Flags, Sz, Bin) -> + Length = Sz + 8, + <>. + +%% =========================================================================== + +choose(true, X, _) -> X; +choose(false, _, X) -> X. diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl new file mode 100644 index 0000000000..a6b48fe65b --- /dev/null +++ b/lib/diameter/src/base/diameter_config.erl @@ -0,0 +1,676 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This module writes service/transport configuration to the table +%% diameter_config, so that the config will survive service process +%% death, and then turns it into calls towards diameter_service. It +%% also restarts services upon their death. +%% +%% The table diameter_config is only written here while +%% diameter_service reads. This is all somewhat after the fact. Once +%% upon a time the config was only stored in the service process, +%% causing much grief if these processes died (which they did with +%% some regularity) and one was forced to reconfigure. This module was +%% then inserted into the service start in order to keep a more +%% permanent record of the config. That said, service processes are +%% now much more robust than they once were and crashing is a thing of +%% the past. +%% + +-module(diameter_config). +-compile({no_auto_import, [monitor/2]}). + +-behaviour(gen_server). + +-export([start_service/2, + stop_service/1, + add_transport/2, + remove_transport/2, + have_transport/2, + lookup/1]). + +%% child server start +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% diameter_sync requests. +-export([sync/1]). + +%% debug +-export([state/0, + uptime/0]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +%% Server state. +-record(state, {id = now()}). + +%% Registered name of the server. +-define(SERVER, ?MODULE). + +%% Table config is written to. +-define(TABLE, ?MODULE). + +%% Workaround for dialyzer's lack of understanding of match specs. +-type match(T) + :: T | '_' | '$1' | '$2' | '$3' | '$4'. + +%% Configuration records in ?TABLE. + +-record(service, + {name, + rec :: match(#diameter_service{}), + options :: match(list())}). + +-record(transport, + {service, %% name + ref = make_ref() :: match(reference()), + type :: match(connect | listen), + options :: match(list())}). + +%% Monitor entry in ?TABLE. +-record(monitor, {mref = make_ref() :: reference(), + service}). %% name + +%% Time to lay low before restarting a dead service. +-define(RESTART_SLEEP, 2000). + +%% A minimal diameter_caps for checking for valid capabilities values. +-define(EXAMPLE_CAPS, + #diameter_caps{origin_host = "TheHost", + origin_realm = "TheRealm", + host_ip_address = [{127,0,0,1}], + vendor_id = 42, + product_name = "TheProduct"}). + +-define(VALUES(Rec), tl(tuple_to_list(Rec))). + +%%% The return values below assume the server diameter_config is started. +%%% The functions will exit if it isn't. + +%% -------------------------------------------------------------------------- +%% # start_service(SvcName, Opts) +%% +%% Output: ok | {error, Reason} +%% -------------------------------------------------------------------------- + +start_service(SvcName, Opts) + when is_list(Opts) -> + start_rc(sync(SvcName, {start_service, SvcName, Opts})). + +start_rc({ok = T, _Pid}) -> + T; +start_rc({error, _} = No) -> + No; +start_rc(timeout) -> + {error, application_not_started}. + +%% -------------------------------------------------------------------------- +%% # stop_service(SvcName) +%% +%% Output: ok +%% -------------------------------------------------------------------------- + +stop_service(SvcName) -> + sync(SvcName, {stop_service, SvcName}). + +%% -------------------------------------------------------------------------- +%% # add_transport(SvcName, {Type, Opts}) +%% +%% Input: Type = connect | listen +%% +%% Output: {ok, Ref} | {error, Reason} +%% -------------------------------------------------------------------------- + +add_transport(SvcName, {T, Opts}) + when is_list(Opts), (T == connect orelse T == listen) -> + sync(SvcName, {add, SvcName, T, Opts}). + +%% -------------------------------------------------------------------------- +%% # remove_transport(SvcName, Pred) +%% +%% Input: Pred = arity 3 fun on transport ref, connect|listen and Opts, +%% returning true if the transport is to be removed, false if +%% not +%% | arity 2 fun on Ref and Opts only +%% | arity 1 fun on Opts only +%% | Opts matching all transports that have all of the specified +%% options +%% | Ref matching only the transport with this reference. +%% | {M,F,A} applied to Ref, connect|listen and Opts +%% | boolean() +%% +%% Output: ok | {error, Reason} +%% -------------------------------------------------------------------------- + +remove_transport(SvcName, Pred) -> + try + sync(SvcName, {remove, SvcName, pred(Pred)}) + catch + ?FAILURE(Reason) -> + {error, Reason} + end. + +pred(Pred) + when is_function(Pred, 3) -> + Pred; +pred(Pred) + when is_function(Pred, 2) -> + fun(R,_,O) -> Pred(R,O) end; +pred(Pred) + when is_function(Pred, 1) -> + fun(_,_,O) -> Pred(O) end; +pred(Opts) + when is_list(Opts) -> + fun(_,_,O) -> [] == Opts -- O end; +pred(Ref) + when is_reference(Ref) -> + fun(R,_,_) -> R == Ref end; +pred({M,F,A}) + when is_atom(M), is_atom(F), is_list(A) -> + fun(R,T,O) -> apply(M,F,[R,T,O|A]) end; +pred({Type, Pred}) -> %% backwards compatibility + P = pred(Pred), + fun(R,T,O) -> T == Type andalso P(R,T,O) end; +pred(B) + when is_boolean(B) -> + fun(_,_,_) -> B end; +pred(_) -> + ?THROW(pred). + +%% -------------------------------------------------------------------------- +%% # have_transport/2 +%% +%% Output: true | false +%% -------------------------------------------------------------------------- + +have_transport(SvcName, Ref) -> + member([{#transport{service = '$1', + ref = '$2', + _ = '_'}, + [{'andalso', {'=:=', '$1', {const, SvcName}}, + {'=:=', '$2', {const, Ref}}}], + [true]}]). + +%% -------------------------------------------------------------------------- +%% # lookup/1 +%% -------------------------------------------------------------------------- + +lookup(SvcName) -> + select([{#service{name = '$1', rec = '$2', options = '$3'}, + [{'=:=', '$1', {const, SvcName}}], + [{{'$1', '$2', '$3'}}]}, + {#transport{service = '$1', + ref = '$2', + type = '$3', + options = '$4'}, + [{'=:=', '$1', {const, SvcName}}], + [{{'$2', '$3', '$4'}}]}]). + +%% --------------------------------------------------------- +%% EXPORTED INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Module = ?MODULE, + Args = [], + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, Module, Args, Options). + +state() -> + call(state). + +uptime() -> + call(uptime). + +%%% ---------------------------------------------------------- +%%% # init/1 +%%% ---------------------------------------------------------- + +init([]) -> + {ok, #state{}}. + +%%% ---------------------------------------------------------- +%%% # handle_call/2 +%%% ---------------------------------------------------------- + +handle_call(state, _, State) -> + {reply, State, State}; + +handle_call(uptime, _, #state{id = Time} = State) -> + {reply, diameter_lib:now_diff(Time), State}; + +handle_call(Req, From, State) -> + ?UNEXPECTED([Req, From]), + Reply = {error, {bad_request, Req}}, + {reply, Reply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast/2 +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_info/2 +%%% ---------------------------------------------------------- + +%% A service process has died. This is most likely a consequence of +%% stop_service, in which case the restart will find no config for the +%% service and do nothing. The entry keyed on the monitor ref is only +%% removed as a result of the 'DOWN' notification however. +handle_info({'DOWN', MRef, process, _, Reason}, State) -> + [#monitor{service = SvcName} = T] = select([{#monitor{mref = MRef, + _ = '_'}, + [], + ['$_']}]), + queue_restart(Reason, SvcName), + delete_object(T), + {noreply, State}; + +handle_info({monitor, SvcName, Pid}, State) -> + monitor(Pid, SvcName), + {noreply, State}; + +handle_info({restart, SvcName}, State) -> + restart(SvcName), + {noreply, State}; + +handle_info(restart, State) -> + restart(), + {noreply, State}; + +handle_info(Info, State) -> + ?UNEXPECTED([Info]), + {noreply, State}. + +%%-------------------------------------------------------------------- +%% # terminate/2 +%%-------------------------------------------------------------------- + +terminate(_Reason, _State) -> + ok. + +%%% ---------------------------------------------------------- +%%% # code_change/3 +%%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% --------------------------------------------------------- +%% INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +insert(T) -> + ets:insert(?TABLE, T). + +%% ?TABLE is a bag: check only for a service entry. +have_service(SvcName) -> + member([{#service{name = '$1', _ = '_'}, + [{'=:=', '$1', {const, SvcName}}], + [true]}]). + +member(MatchSpec) -> + '$end_of_table' =/= ets:select(?TABLE, MatchSpec, 1). + +delete_object(T) -> + ets:delete_object(?TABLE, T). + +delete(Key) -> + ets:delete(?TABLE, Key). + +select(MatchSpec) -> + ets:select(?TABLE, MatchSpec). + +select_delete(MatchSpec) -> + ets:select_delete(?TABLE, MatchSpec). + +%% sync/2 +%% +%% Interface functions used to be implemented as calls to ?SERVER but +%% now serialize things per service instead since stopping a service +%% can take time if the server doesn't answer DPR. A caller who wants +%% to stop multiple services can then improve performance by spawning +%% processes to stop them concurrently. + +sync(SvcName, T) -> + diameter_sync:call({?MODULE, SvcName}, + {?MODULE, sync, [T]}, + infinity, + infinity). + +%% sync/1 + +sync({restart, SvcName}) -> + have_service(SvcName) andalso start(SvcName); + +sync({start_service, SvcName, Opts}) -> + try + start(have_service(SvcName), SvcName, Opts) + catch + ?FAILURE(Reason) -> {error, Reason} + end; + +sync({stop_service, SvcName}) -> + stop(SvcName); + +sync({add, SvcName, Type, Opts}) -> + try + add(SvcName, Type, Opts) + catch + ?FAILURE(Reason) -> {error, Reason} + end; + +sync({remove, SvcName, Pred}) -> + remove(select([{#transport{service = '$1', _ = '_'}, + [{'=:=', '$1', {const, SvcName}}], + ['$_']}]), + SvcName, + Pred). + +%% start/3 + +start(true, _, _) -> + {error, already_started}; +start(false, SvcName, Opts) -> + insert(make_config(SvcName, Opts)), + start(SvcName). + +%% start/1 + +start(SvcName) -> + RC = diameter_service:start(SvcName), + startmon(SvcName, RC), + RC. + +startmon(SvcName, {ok, Pid}) -> + ?SERVER ! {monitor, SvcName, Pid}; +startmon(_, {error, _}) -> + ok. + +monitor(Pid, SvcName) -> + MRef = erlang:monitor(process, Pid), + insert(#monitor{mref = MRef, service = SvcName}). + +%% queue_restart/2 + +%% Service has gone down on monitor death. Note that all service-related +%% config is deleted. +queue_restart({shutdown, {monitor, _}}, SvcName) -> + delete(SvcName); + +%% Application shutdown: ignore. +queue_restart(shutdown, _) -> + ok; + +%% Or not. +queue_restart(_, SvcName) -> + erlang:send_after(?RESTART_SLEEP, self(), {restart, SvcName}). + +%% restart/1 + +restart(SvcName) -> + sync(SvcName, {restart, SvcName}). + +%% restart/0 +%% +%% Start anything configured as required. Bang 'restart' to the server +%% to kick things into gear manually. (Not that it should be required +%% but it's been useful for test.) + +restart() -> + MatchSpec = [{#service{name = '$1', _ = '_'}, + [], + ['$1']}], + lists:foreach(fun restart/1, select(MatchSpec)). + +%% stop/1 + +stop(SvcName) -> + %% If the call to the service returns error for any reason other + %% than the process not being alive then deleting the config from + %% under it will surely bring it down. + diameter_service:stop(SvcName), + %% Delete only the service entry, not everything keyed on the name, + select_delete([{#service{name = '$1', _ = '_'}, + [{'=:=', '$1', {const, SvcName}}], + [true]}]), + ok. +%% Note that a transport has to be removed for its statistics to be +%% deleted. + +%% add/3 + +add(SvcName, Type, Opts) -> + %% Ensure usable capabilities. diameter_service:merge_service/2 + %% depends on this. + lists:foreach(fun(Os) -> + is_list(Os) orelse ?THROW({capabilities, Os}), + ok = encode_CER(Os) + end, + [Os || {capabilities, Os} <- Opts, is_list(Os)]), + + Ref = make_ref(), + T = {Ref, Type, Opts}, + %% The call to the service returns error if the service isn't + %% started yet, which is harmless. The transport will be started + %% when the service is in that case. + case start_transport(SvcName, T) of + ok -> + insert(#transport{service = SvcName, + ref = Ref, + type = Type, + options = Opts}), + {ok, Ref}; + {error, _} = No -> + No + end. + +start_transport(SvcName, T) -> + case diameter_service:start_transport(SvcName, T) of + {ok, _Pid} -> + ok; + {error, no_service} -> + ok; + {error, _} = No -> + No + end. + +%% remove/3 + +remove(L, SvcName, Pred) -> + rm(SvcName, lists:filter(fun(#transport{ref = R, type = T, options = O}) -> + Pred(R,T,O) + end, + L)). + +rm(_, []) -> + ok; +rm(SvcName, L) -> + Refs = lists:map(fun(#transport{ref = R}) -> R end, L), + case stop_transport(SvcName, Refs) of + ok -> + lists:foreach(fun delete_object/1, L); + {error, _} = No -> + No + end. + +stop_transport(SvcName, Refs) -> + case diameter_service:stop_transport(SvcName, Refs) of + ok -> + ok; + {error, no_service} -> + ok; + {error, _} = No -> + No + end. + +%% make_config/2 + +make_config(SvcName, Opts) -> + Apps = init_apps(Opts), + [] == Apps andalso ?THROW(no_apps), + + %% Use the fact that diameter_caps has the same field names as CER. + Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER) -- ['AVP'], + + COpts = [T || {K,_} = T <- Opts, lists:member(K, Fields)], + Caps = make_caps(#diameter_caps{}, COpts), + + ok = encode_CER(COpts), + + Os = split(Opts, [{[fun erlang:is_boolean/1], false, share_peers}, + {[fun erlang:is_boolean/1], false, use_shared_peers}, + {[fun erlang:is_pid/1, false], false, monitor}]), + %% share_peers and use_shared_peers are currently undocumented. + + #service{name = SvcName, + rec = #diameter_service{applications = Apps, + capabilities = Caps}, + options = Os}. + +make_caps(Caps, Opts) -> + case diameter_capx:make_caps(Caps, Opts) of + {ok, T} -> + T; + {error, {Reason, _}} -> + ?THROW(Reason) + end. + +%% Validate types by encoding a CER. +encode_CER(Opts) -> + {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts)), + + Hdr = #diameter_header{version = ?DIAMETER_VERSION, + end_to_end_id = 0, + hop_by_hop_id = 0}, + + try + diameter_codec:encode(?BASE, #diameter_packet{header = Hdr, + msg = CER}), + ok + catch + exit: Reason -> + ?THROW(Reason) + end. + +init_apps(Opts) -> + lists:foldl(fun app_acc/2, [], lists:reverse(Opts)). + +app_acc({application, Opts}, Acc) -> + is_list(Opts) orelse ?THROW({application, Opts}), + + [Dict, Mod] = get_opt([dictionary, module], Opts), + Alias = get_opt(alias, Opts, Dict), + ModS = get_opt(state, Opts, Alias), + M = get_opt(call_mutates_state, Opts, false), + A = get_opt(answer_errors, Opts, report), + [#diameter_app{alias = Alias, + dictionary = Dict, + id = cb(Dict, id), + module = init_mod(Mod), + init_state = ModS, + mutable = init_mutable(M), + answer_errors = init_answers(A)} + | Acc]; +app_acc(_, Acc) -> + Acc. + +init_mod(M) + when is_atom(M) -> + [M]; +init_mod([M|_] = L) + when is_atom(M) -> + L; +init_mod(M) -> + ?THROW({module, M}). + +init_mutable(M) + when M == true; + M == false -> + M; +init_mutable(M) -> + ?THROW({call_mutates_state, M}). + +init_answers(A) + when callback == A; + report == A; + discard == A -> + A; +init_answers(A) -> + ?THROW({answer_errors, A}). + +%% Get a single value at the specified key. +get_opt(Keys, List) + when is_list(Keys) -> + [get_opt(K, List) || K <- Keys]; +get_opt(Key, List) -> + case [V || {K,V} <- List, K == Key] of + [V] -> V; + _ -> ?THROW({arity, Key}) + end. + +%% Get an optional value at the specified key. +get_opt(Key, List, Def) -> + case [V || {K,V} <- List, K == Key] of + [] -> Def; + [V] -> V; + _ -> ?THROW({arity, Key}) + end. + +split(Opts, Defs) -> + [{K, value(D, Opts)} || {_,_,K} = D <- Defs]. + +value({Preds, Def, Key}, Opts) -> + V = get_opt(Key, Opts, Def), + lists:any(fun(P) -> pred(P,V) end, Preds) + orelse ?THROW({value, Key}), + V. + +pred(F, V) + when is_function(F) -> + F(V); +pred(T, V) -> + T == V. + +cb(M,F) -> + try M:F() of + V -> V + catch + E: Reason -> + ?THROW({callback, E, Reason, ?STACK}) + end. + +%% call/1 + +call(Request) -> + gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/base/diameter_dbg.erl b/lib/diameter/src/base/diameter_dbg.erl new file mode 100644 index 0000000000..5b0ac3a3b6 --- /dev/null +++ b/lib/diameter/src/base/diameter_dbg.erl @@ -0,0 +1,516 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_dbg). + +-export([table/1, + tables/0, + fields/1, + help/0, + modules/0, + versions/0, + version_info/0, + compiled/0, + procs/0, + latest/0, + nl/0, + log/4]). + +-export([diameter_config/0, + diameter_peer/0, + diameter_reg/0, + diameter_request/0, + diameter_sequence/0, + diameter_service/0, + diameter_stats/0]). + +-export([pp/1, + subscriptions/0, + children/0]). + +%% Trace help. +-export([tracer/0, tracer/1, + p/0, p/1, + stop/0, + tpl/1, + tp/1]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + + +-define(INFO, diameter_info). +-define(SEP(), ?INFO:sep()). + +-define(LOCAL, [diameter_config, + diameter_peer, + diameter_reg, + diameter_request, + diameter_sequence, + diameter_service, + diameter_stats]). + +-define(VALUES(Rec), tl(tuple_to_list(Rec))). + +log(_Slogan, _Mod, _Line, _Details) -> + ok. + +%%% ---------------------------------------------------------- +%%% # help() +%%% ---------------------------------------------------------- + +help() -> + not_yet_implemented. + +%%% ---------------------------------------------------------- +%%% # table(TableName) +%%% +%%% Input: TableName = diameter table containing record entries. +%%% +%%% Output: Count | undefined +%%% ---------------------------------------------------------- + +table(T) + when (T == diameter_peer) orelse (T == diameter_reg) -> + ?INFO:format(collect(T), fields(T), fun ?INFO:split/2); + +table(Table) + when is_atom(Table) -> + case fields(Table) of + undefined = No -> + No; + Fields -> + ?INFO:format(Table, Fields, fun split/2) + end. + +split([started, name | Fs], [S, N | Vs]) -> + {name, [started | Fs], N, [S | Vs]}; +split([[F|FT]|Fs], [Rec|Vs]) -> + [_, V | VT] = tuple_to_list(Rec), + {F, FT ++ Fs, V, VT ++ Vs}; +split([F|Fs], [V|Vs]) -> + {F, Fs, V, Vs}. + +%%% ---------------------------------------------------------- +%%% # TableName() +%%% ---------------------------------------------------------- + +-define(TABLE(Name), Name() -> table(Name)). + +?TABLE(diameter_config). +?TABLE(diameter_peer). +?TABLE(diameter_reg). +?TABLE(diameter_request). +?TABLE(diameter_sequence). +?TABLE(diameter_service). +?TABLE(diameter_stats). + +%%% ---------------------------------------------------------- +%%% # tables() +%%% +%%% Output: Number of records output. +%%% +%%% Description: Pretty-print records in diameter tables from all nodes. +%%% ---------------------------------------------------------- + +tables() -> + ?INFO:format(field(?LOCAL), fun split/3, fun collect/1). + +field(Tables) -> + lists:map(fun(T) -> {T, fields(T)} end, lists:sort(Tables)). + +split(_, Fs, Vs) -> + split(Fs, Vs). + +%%% ---------------------------------------------------------- +%%% # modules() +%%% ---------------------------------------------------------- + +modules() -> + Path = filename:join([appdir(), atom_to_list(?APPLICATION) ++ ".app"]), + {ok, [{application, ?APPLICATION, Attrs}]} = file:consult(Path), + {modules, Mods} = lists:keyfind(modules, 1, Attrs), + Mods. + +appdir() -> + [_|_] = code:lib_dir(?APPLICATION, ebin). + +%%% ---------------------------------------------------------- +%%% # versions() +%%% ---------------------------------------------------------- + +versions() -> + ?INFO:versions(modules()). + +%%% ---------------------------------------------------------- +%%% # versions() +%%% ---------------------------------------------------------- + +version_info() -> + ?INFO:version_info(modules()). + +%%% ---------------------------------------------------------- +%%% # compiled() +%%% ---------------------------------------------------------- + +compiled() -> + ?INFO:compiled(modules()). + +%%% ---------------------------------------------------------- +%%% procs() +%%% ---------------------------------------------------------- + +procs() -> + ?INFO:procs(?APPLICATION). + +%%% ---------------------------------------------------------- +%%% # latest() +%%% ---------------------------------------------------------- + +latest() -> + ?INFO:latest(modules()). + +%%% ---------------------------------------------------------- +%%% # nl() +%%% ---------------------------------------------------------- + +nl() -> + lists:foreach(fun(M) -> abcast = c:nl(M) end, modules()). + +%%% ---------------------------------------------------------- +%%% # pp(Bin) +%%% +%%% Description: Pretty-print a message binary. +%%% ---------------------------------------------------------- + +%% Network byte order = big endian. + +pp(<>) -> + ?SEP(), + ppp(["Version", + "Message length", + "[Actual length]", + "R(equest)", + "P(roxiable)", + "E(rror)", + "T(Potential retrans)", + "Reserved bits", + "Command code", + "Application id", + "Hop by hop id", + "End to end id"], + [Version, MsgLength, size(AVPs) + 20, + Rbit, Pbit, Ebit, Tbit, Reserved, + CmdCode, + ApplId, + HbHid, + E2Eid]), + N = avp_loop({AVPs, MsgLength - 20}, 0), + ?SEP(), + N; + +pp(<<_Version:8, MsgLength:24, _/binary>> = Bin) -> + {bad_message_length, MsgLength, size(Bin)}; + +pp(Bin) + when is_binary(Bin) -> + {truncated_binary, size(Bin)}; + +pp(_) -> + not_binary. + +%% avp_loop/2 + +avp_loop({Bin, Size}, N) -> + avp_loop(avp(Bin, Size), N+1); +avp_loop(ok, N) -> + N; +avp_loop([_E, _Rest] = L, N) -> + io:format("! ~s: ~p~n", L), + N; +avp_loop([E, Rest, Fmt | Values], N) + when is_binary(Rest) -> + io:format("! ~s (" ++ Fmt ++ "): ~p~n", [E|Values] ++ [Rest]), + N. + +%% avp/2 + +avp(<<>>, 0) -> + ok; +avp(<>, + Size) -> + avp(Code, Flags, Length, Rest, Size); +avp(Bin, _) -> + ["truncated AVP header", Bin]. + +%% avp/5 + +avp(Code, Flags, Length, Rest, Size) -> + <> + = Flags, + b(), + ppp(["AVP Code", + "V(endor)", + "M(andatory)", + "P(Security)", + "R(eserved)", + "Length"], + [Code, V, M, P, Res, Length]), + avp(V, Rest, Length - 8, Size - 8). + +%% avp/4 + +avp(1, <>, Length, Size) -> + ppp({"Vendor-ID", V}), + data(Data, Length - 4, Size - 4); +avp(1, Bin, _, _) -> + ["truncated Vendor-ID", Bin]; +avp(0, Data, Length, Size) -> + data(Data, Length, Size). + +data(Bin, Length, Size) + when size(Bin) >= Length -> + <> = Bin, + ppp({"Data", AVP}), + unpad(Rest, Size - Length, Length rem 4); + +data(Bin, _, _) -> + ["truncated AVP data", Bin]. + +%% Remove padding bytes up to the next word boundary. +unpad(Bin, Size, 0) -> + {Bin, Size}; +unpad(Bin, Size, N) -> + un(Bin, Size, 4 - N). + +un(Bin, Size, N) + when size(Bin) >= N -> + ppp({"Padding bytes", N}), + <> = Bin, + Bits = N*8, + case Pad of + <<0:Bits>> -> + {Rest, Size - N}; + _ -> + ["non-zero padding", Bin, "~p", N] + end; + +un(Bin, _, _) -> + ["truncated padding", Bin]. + +b() -> + io:format("#~n"). + +ppp(Fields, Values) -> + lists:foreach(fun ppp/1, lists:zip(Fields, Values)). + +ppp({Field, Value}) -> + io:format(": ~-22s : ~p~n", [Field, Value]). + +%%% ---------------------------------------------------------- +%%% # subscriptions() +%%% +%%% Output: list of {SvcName, Pid} +%%% ---------------------------------------------------------- + +subscriptions() -> + diameter_service:subscriptions(). + +%%% ---------------------------------------------------------- +%%% # children() +%%% ---------------------------------------------------------- + +children() -> + diameter_sup:tree(). + +%%% ---------------------------------------------------------- + +%% tracer/[12] + +tracer(Port) + when is_integer(Port) -> + dbg:tracer(port, dbg:trace_port(ip, Port)); + +tracer(Path) + when is_list(Path) -> + dbg:tracer(port, dbg:trace_port(file, Path)). + +tracer() -> + dbg:tracer(process, {fun p/2, ok}). + +p(T,_) -> + io:format("+ ~p~n", [T]). + +%% p/[01] + +p() -> + p([c,timestamp]). + +p(T) -> + dbg:p(all,T). + +%% stop/0 + +stop() -> + dbg:ctp(), + dbg:stop_clear(). + +%% tpl/1 +%% tp/1 + +tpl(T) -> + dbg(tpl, T). + +tp(T) -> + dbg(tp, T). + +%% dbg/2 + +dbg(F, L) + when is_list(L) -> + [dbg(F, X) || X <- L]; + +dbg(F, M) + when is_atom(M) -> + apply(dbg, F, [M, x]); + +dbg(F, T) + when is_tuple(T) -> + apply(dbg, F, tuple_to_list(T)). + +%% =========================================================================== +%% =========================================================================== + +%% collect/1 + +collect(diameter_peer) -> + lists:flatmap(fun peers/1, diameter:services()); + +collect(diameter_reg) -> + diameter_reg:terms(); + +collect(Name) -> + c(ets:info(Name), Name). + +c(undefined, _) -> + []; +c(_, Name) -> + ets:tab2list(Name). + +%% peers/1 + +peers(Name) -> + peers(Name, diameter:service_info(Name, transport)). + +peers(_, undefined) -> + []; +peers(Name, Ts) -> + lists:flatmap(fun(T) -> mk_peers(Name, T) end, Ts). + +mk_peers(Name, [_, {type, connect} | _] = Ts) -> + [[Name | mk_peer(Ts)]]; +mk_peers(Name, [R, {type, listen}, O, {accept = A, As}]) -> + [[Name | mk_peer([R, {type, A}, O | Ts])] || Ts <- As]. +%% This is a bit lame: service_info works to build this list and out +%% of something like what we want here and then we take it apart. + +mk_peer(Vs) -> + [Type, Ref, State, Opts, WPid, TPid, SApps, Caps] + = get_values(Vs, [type,ref,state,options,watchdog,peer,apps,caps]), + [Ref, State, [{type, Type} | Opts], s(WPid), s(TPid), SApps, Caps]. + +get_values(Vs, Ks) -> + [proplists:get_value(K, Vs) || K <- Ks]. + +s(undefined = T) -> + T; +s({Pid, _Started, _State}) -> + state(Pid); +s({Pid, _Started}) -> + state(Pid). + +%% Collect states from watchdog/transport pids. +state(Pid) -> + MRef = erlang:monitor(process, Pid), + Pid ! {state, self()}, + receive + {'DOWN', MRef, process, _, _} -> + Pid; + {Pid, _} = T -> + erlang:demonitor(MRef, [flush]), + T + end. + +%% fields/1 + +-define(FIELDS(Table), fields(Table) -> record_info(fields, Table)). + +fields(diameter_config) -> + []; + +fields(T) + when T == diameter_request; + T == diameter_sequence -> + fun kv/1; + +fields(diameter_stats) -> + fun({Ctr, N}) when not is_pid(Ctr) -> + {[counter, value], [Ctr, N]}; + (_) -> + [] + end; + +fields(diameter_service) -> + [started, + name, + record_info(fields, diameter_service), + peerT, + connT, + share_peers, + use_shared_peers, + shared_peers, + local_peers, + monitor]; + +?FIELDS(diameter_event); +?FIELDS(diameter_uri); +?FIELDS(diameter_avp); +?FIELDS(diameter_header); +?FIELDS(diameter_packet); +?FIELDS(diameter_app); +?FIELDS(diameter_caps); + +fields(diameter_peer) -> + [service, ref, state, options, watchdog, peer, applications, capabilities]; + +fields(diameter_reg) -> + [property, pids]; + +fields(_) -> + undefined. + +kv({_,_}) -> + [key, value]; +kv(_) -> + []. diff --git a/lib/diameter/src/base/diameter_dict.erl b/lib/diameter/src/base/diameter_dict.erl new file mode 100644 index 0000000000..3b9ba00a3f --- /dev/null +++ b/lib/diameter/src/base/diameter_dict.erl @@ -0,0 +1,153 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This module provide OTP's dict interface built on top of ets. +%% +%% Note that while the interface is the same as dict the semantics +%% aren't quite. A Dict here is just a table identifier (although +%% this fact can't be used if you want dict/ets-based implementations +%% to be interchangeable) so changes made to the Dict modify the +%% underlying table. For merge/3, the first argument table is modified. +%% +%% The underlying ets table implementing a dict is deleted when the +%% process from which new() was invoked exits and the dict is only +%% writable from this process. +%% +%% The reason for this is to be able to swap dict/ets-based +%% implementations: the former is easier to debug, the latter is +%% faster for larger tables. It's also just a nice interface even +%% when there's no need for swapability. +%% + +-module(diameter_dict). + +-export([append/3, + append_list/3, + erase/2, + fetch/2, + fetch_keys/1, + filter/2, + find/2, + fold/3, + from_list/1, + is_key/2, + map/2, + merge/3, + new/0, + store/3, + to_list/1, + update/3, + update/4, + update_counter/3]). + +%%% ---------------------------------------------------------- +%%% EXPORTED INTERNAL FUNCTIONS +%%% ---------------------------------------------------------- + +append(Key, Value, Dict) -> + append_list(Key, [Value], Dict). + +append_list(Key, ValueList, Dict) + when is_list(ValueList) -> + update(Key, fun(V) -> V ++ ValueList end, ValueList, Dict). + +erase(Key, Dict) -> + ets:delete(Dict, Key), + Dict. + +fetch(Key, Dict) -> + {ok, V} = find(Key, Dict), + V. + +fetch_keys(Dict) -> + ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). + +filter(Pred, Dict) -> + lists:foreach(fun({K,V}) -> filter(Pred(K,V), K, Dict) end, to_list(Dict)), + Dict. + +find(Key, Dict) -> + case ets:lookup(Dict, Key) of + [{Key, V}] -> + {ok, V}; + [] -> + error + end. + +fold(Fun, Acc0, Dict) -> + ets:foldl(fun({K,V}, Acc) -> Fun(K, V, Acc) end, Acc0, Dict). + +from_list(List) -> + lists:foldl(fun store/2, new(), List). + +is_key(Key, Dict) -> + ets:member(Dict, Key). + +map(Fun, Dict) -> + lists:foreach(fun({K,V}) -> store(K, Fun(K,V), Dict) end, to_list(Dict)), + Dict. + +merge(Fun, Dict1, Dict2) -> + fold(fun(K2,V2,_) -> + update(K2, fun(V1) -> Fun(K2, V1, V2) end, V2, Dict1) + end, + Dict1, + Dict2). + +new() -> + ets:new(?MODULE, [set]). + +store(Key, Value, Dict) -> + store({Key, Value}, Dict). + +to_list(Dict) -> + ets:tab2list(Dict). + +update(Key, Fun, Dict) -> + store(Key, Fun(fetch(Key, Dict)), Dict). + +update(Key, Fun, Initial, Dict) -> + store(Key, map(Key, Fun, Dict, Initial), Dict). + +update_counter(Key, Increment, Dict) + when is_integer(Increment) -> + update(Key, fun(V) -> V + Increment end, Increment, Dict). + +%%% --------------------------------------------------------- +%%% INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +store({_,_} = T, Dict) -> + ets:insert(Dict, T), + Dict. + +filter(true, _, _) -> + ok; +filter(false, K, Dict) -> + erase(K, Dict). + +map(Key, Fun, Dict, Error) -> + case find(Key, Dict) of + {ok, V} -> + Fun(V); + error -> + Error + end. + diff --git a/lib/diameter/src/base/diameter_info.erl b/lib/diameter/src/base/diameter_info.erl new file mode 100644 index 0000000000..39d32d07cd --- /dev/null +++ b/lib/diameter/src/base/diameter_info.erl @@ -0,0 +1,869 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_info). + +-export([usage/1, + format/1, + format/2, + format/3, + format/4, + table/2, + tables/1, + tables/2, + split/2, + split/3, + tab2list/1, + modules/1, + versions/1, + version_info/1, + attrs/2, + compiled/1, + procs/1, + latest/1, + list/1]). + +%% Support for rolling your own. +-export([sep/0, + sep/1, + widest/1, + p/1, + p/3]). + +-compile({no_auto_import,[max/2]}). + +-export([collect/2]). + +-define(LONG_TIMEOUT, 30000). +-define(VALUES(Rec), tl(tuple_to_list(Rec))). + +%%% ---------------------------------------------------------- +%%% # usage(String) +%%% ---------------------------------------------------------- + +usage(Usage) -> + sep($+), + io:format("+ ~p~n", [?MODULE]), + io:format("~n~s~n~n", [compact(Usage)]), + sep($+). + +%%% +%%% The function format/3, for pretty-printing tables, comes in +%%% several flavours. +%%% + +%%% ---------------------------------------------------------- +%%% # format(TableName, Fields, SplitFun) +%%% +%%% Input: TableName = atom() name of table. +%%% +%%% Fields = List of field names for the records maintained +%%% in the specified table. Can be empty, in which +%%% case entries are listed unadorned of field names +%%% and SplitFun is unused. +%%% | Integer, equivalent to a list with this many '' atoms. +%%% | Arity 1 fun mapping a table entry to a Fields list +%%% or a tuple {Fields, Values} of lists of the same +%%% length. +%%% +%%% If Fields is a list then its length must be the same +%%% as or one less than the size of the tuples contained +%%% in the table. (The values printed then being those +%%% in the tuple or record in question.) +%%% +%%% SplitFun = Arity 3 fun applied as +%%% +%%% SplitFun(TableName, Fields, Values) +%%% +%%% in order to obtain a tuple +%%% +%%% {Field, RestFields, Value, RestValues} +%%% +%%% for which Field/Value will be formatted on +%%% STDOUT. (This is to allow a value to be +%%% transformed before being output by returning a +%%% new value and/or replacing the remainder of +%%% the list.) The returned lists must have the +%%% same length and Field here is an atom, '' causing +%%% a value to be listed unadorned of the field name. +%%% +%%% Field can also be list of field names, in +%%% which case Value must be a record of the +%%% corresponding type. +%%% +%%% | Arity 2 fun applied as SplitFun(Fields, Values). +%%% +%%% Output: Count | undefined +%%% +%%% Count = Number of entries output. +%%% +%%% Description: Pretty-print records in a named table. +%%% ---------------------------------------------------------- + +format(Table, Fields, SFun) + when is_atom(Table), is_function(SFun, 2) -> + ft(ets:info(Table), Table, SFun, Fields); + +format(Table, Fields, SFun) + when is_atom(Table), is_function(SFun, 3) -> + format(Table, Fields, fun(Fs,Vs) -> SFun(Table, Fs, Vs) end); + +%%% ---------------------------------------------------------- +%%% # format(Recs, Fields, SplitFun) +%%% +%%% Input: Recs = list of records/tuples +%%% Fields = As for format(Table, Fields, SplitFun), a table +%%% entry there being a member of Recs. +%%% SplitFun = Arity 3 fun applied as above but with the TableName +%%% replaced by the first element of the records in +%%% question. +%%% | Arity 2 fun as for format/3. +%%% +%%% Output: length(Recs) +%%% +%%% Description: Pretty print records/tuples. +%%% ---------------------------------------------------------- + +format(Recs, Fields, SFun) + when is_list(Recs), is_function(SFun, 3) -> + lists:foldl(fun(R,A) -> f(recsplit(SFun, R), 0, Fields, R, A) end, + 0, + Recs); + +format(Recs, Fields, SFun) + when is_list(Recs), is_function(SFun, 2) -> + lists:foldl(fun(R,A) -> f(SFun, 0, Fields, R, A) end, + 0, + Recs); + +%%% ---------------------------------------------------------- +%%% # format(Tables, SplitFun, CollectFun) +%%% +%%% Input: Tables = list of {TableName, Fields}. +%%% SplitFun = As for format(Table, Fields, SplitFun). +%%% CollectFun = arity 1 fun mapping a table name to a list +%%% of elements. A non-list can be returned to indicate +%%% that the table in question doesn't exist. +%%% +%%% Output: Number of entries output. +%%% +%%% Description: Pretty-print records in a named tables as collected +%%% from known nodes. Each table listing is preceeded by +%%% a banner. +%%% ---------------------------------------------------------- + +format(Tables, SFun, CFun) + when is_list(Tables), is_function(CFun, 1) -> + format_remote(Tables, + SFun, + rpc:multicall(nodes(known), + ?MODULE, + collect, + [CFun, lists:map(fun({T,_}) -> T end, Tables)], + ?LONG_TIMEOUT)); + +%%% ---------------------------------------------------------- +%%% # format(LocalTables, RemoteTables, SplitFun, CollectFun) +%%% # format(LocalTables, RemoteTables, SplitFun) +%%% +%%% Input: LocalTables = list of {TableName, Fields}. +%%% | list of {TableName, Recs, Fields} +%%% RemoteTable = list of {TableName, Fields}. +%%% SplitFun, CollectFun = As for format(Table, CollectFun, SplitFun). +%%% +%%% Output: Number of entries output. +%%% +%%% Description: Pretty-print records in a named tables as collected +%%% from local and remote nodes. Each table listing is +%%% preceeded by a banner. +%%% ---------------------------------------------------------- + +format(Local, Remote, SFun) -> + format(Local, Remote, SFun, fun tab2list/1). + +format(Local, Remote, SFun, CFun) + when is_list(Local), is_list(Remote), is_function(CFun, 1) -> + format_local(Local, SFun) + format(Remote, SFun, CFun). + +%%% ---------------------------------------------------------- +%%% # format(Tables, SplitFun) +%%% ---------------------------------------------------------- + +format(Tables, SFun) + when is_list(Tables), (is_function(SFun, 2) or is_function(SFun, 3)) -> + format(Tables, SFun, fun tab2list/1); + +format(Tables, CFun) + when is_list(Tables), is_function(CFun, 1) -> + format(Tables, fun split/2, CFun). + +%%% ---------------------------------------------------------- +%%% # format(Table|Tables) +%%% ---------------------------------------------------------- + +format(Table) + when is_atom(Table) -> + format(Table, [], fun split/2); + +format(Tables) + when is_list(Tables) -> + format(Tables, fun split/2, fun tab2list/1). + +%%% ---------------------------------------------------------- +%%% # split(TableName, Fields, Values) +%%% +%%% Description: format/3 SplitFun that does nothing special. +%%% ---------------------------------------------------------- + +split([F|FT], [V|VT]) -> + {F, FT, V, VT}. + +split(_, Fs, Vs) -> + split(Fs, Vs). + +%%% ---------------------------------------------------------- +%%% # tab2list(TableName) +%%% +%%% Description: format/4 CollectFun that extracts records from an +%%% existing ets table. +%%% ---------------------------------------------------------- + +tab2list(Table) -> + case ets:info(Table) of + undefined = No -> + No; + _ -> + ets:tab2list(Table) + end. + +list(Table) -> + l(tab2list(Table)). + +l(undefined = No) -> + No; +l(List) + when is_list(List) -> + io:format("~p~n", [List]), + length(List). + +%%% ---------------------------------------------------------- +%%% # table(TableName, Fields) +%%% ---------------------------------------------------------- + +table(Table, Fields) -> + format(Table, Fields, fun split/2). + +%%% ---------------------------------------------------------- +%%% # tables(LocalTables, RemoteTables) +%%% ---------------------------------------------------------- + +tables(Local, Remote) -> + format(Local, Remote, fun split/2). + +%%% ---------------------------------------------------------- +%%% # tables(Tables) +%%% ---------------------------------------------------------- + +tables(Tables) -> + format(Tables, fun split/2). + +%%% ---------------------------------------------------------- +%%% # modules(Prefix|Prefixes) +%%% +%%% Input: Prefix = atom() +%%% +%%% Description: Return the list of all loaded modules with the +%%% specified prefix. +%%% ---------------------------------------------------------- + +modules(Prefix) + when is_atom(Prefix) -> + lists:sort(mods(Prefix)); + +modules(Prefixes) + when is_list(Prefixes) -> + lists:sort(lists:flatmap(fun modules/1, Prefixes)). + +mods(Prefix) -> + P = atom_to_list(Prefix), + lists:filter(fun(M) -> + lists:prefix(P, atom_to_list(M)) + end, + erlang:loaded()). + +%%% ---------------------------------------------------------- +%%% # versions(Modules|Prefix) +%%% +%%% Output: Number of modules listed. +%%% +%%% Description: List the versions of the specified modules. +%%% ---------------------------------------------------------- + +versions(Modules) -> + {SysInfo, OsInfo, ModInfo} = version_info(Modules), + sep(), + print_sys_info(SysInfo), + sep(), + print_os_info(OsInfo), + sep(), + print_mod_info(ModInfo), + sep(). + +%%% ---------------------------------------------------------- +%%% # attrs(Modules|Prefix, Attr|FormatFun) +%%% +%%% Output: Number of modules listed. +%%% +%%% Description: List an attribute from module_info. +%%% ---------------------------------------------------------- + +attrs(Modules, Attr) + when is_atom(Attr) -> + attrs(Modules, fun(W,M) -> attr(W, M, Attr, fun attr/1) end); + +attrs(Modules, Fun) + when is_list(Modules) -> + sep(), + W = 2 + widest(Modules), + N = lists:foldl(fun(M,A) -> Fun(W,M), A+1 end, 0, Modules), + sep(), + N; + +attrs(Prefix, Fun) -> + attrs(modules(Prefix), Fun). + +%% attr/1 + +attr(T) when is_atom(T) -> + atom_to_list(T); +attr(N) when is_integer(N) -> + integer_to_list(N); +attr(V) -> + case is_list(V) andalso lists:all(fun is_char/1, V) of + true -> %% string + V; + false -> + io_lib:format("~p", [V]) + end. + +is_char(C) -> + 0 =< C andalso C < 256. + +%% attr/4 + +attr(Width, Mod, Attr, VFun) -> + io:format(": ~*s~s~n", [-Width, Mod, attr(Mod, Attr, VFun)]). + +attr(Mod, Attr, VFun) -> + Key = key(Attr), + try + VFun(val(Attr, keyfetch(Attr, Mod:module_info(Key)))) + catch + _:_ -> + "-" + end. + +attr(Mod, Attr) -> + attr(Mod, Attr, fun attr/1). + +key(time) -> compile; +key(_) -> attributes. + +val(time, {_,_,_,_,_,_} = T) -> + lists:flatten(io_lib:format("~p-~2..0B-~2..0B ~2..0B:~2..0B:~2..0B", + tuple_to_list(T))); +val(_, [V]) -> + V. + +%%% ---------------------------------------------------------- +%%% # compiled(Modules|Prefix) +%%% +%%% Output: Number of modules listed. +%%% +%%% Description: List the compile times of the specified modules. +%%% ---------------------------------------------------------- + +compiled(Modules) + when is_list(Modules) -> + attrs(Modules, fun compiled/2); + +compiled(Prefix) -> + compiled(modules(Prefix)). + +compiled(Width, Mod) -> + io:format(": ~*s~19s ~s~n", [-Width, + Mod, + attr(Mod, time), + opt(attr(Mod, date))]). + +opt("-") -> + ""; +opt(D) -> + "(" ++ D ++ ")". + +%%% ---------------------------------------------------------- +%%% # procs(Pred|Prefix|Prefixes|Pid|Pids) +%%% +%%% Input: Pred = arity 2 fun returning true|false when applied to a +%%% pid and its process info. +%%% +%%% Output: Number of processes listed. +%%% +%%% Description: List process info for all local processes that test +%%% true with the specified predicate. With the prefix +%%% form, those processes that are either currently +%%% executing in, started executing in, or have a +%%% registered name with a specified prefix are listed. +%%% With the pid forms, only those process that are local +%%% are listed and those that are dead list only the pid +%%% itself. +%%% ---------------------------------------------------------- + +procs(Pred) + when is_function(Pred, 2) -> + procs(Pred, erlang:processes()); + +procs([]) -> + 0; + +procs(Prefix) + when is_atom(Prefix) -> + procs(fun(_,I) -> info(fun pre1/2, I, atom_to_list(Prefix)) end); + +procs(Prefixes) + when is_atom(hd(Prefixes)) -> + procs(fun(_,I) -> info(fun pre/2, I, Prefixes) end); + +procs(Pid) + when is_pid(Pid) -> + procs(fun true2/2, [Pid]); + +procs(Pids) + when is_list(Pids) -> + procs(fun true2/2, Pids). + +true2(_,_) -> + true. + +%% procs/2 + +procs(Pred, Pids) -> + Procs = lists:foldl(fun(P,A) -> + procs_acc(Pred, P, catch process_info(P), A) + end, + [], + Pids), + sep(0 < length(Procs)), + lists:foldl(fun(T,N) -> p(T), sep(), N+1 end, 0, Procs). + +procs_acc(_, Pid, undefined, Acc) -> %% dead + [[{pid, Pid}] | Acc]; +procs_acc(Pred, Pid, Info, Acc) + when is_list(Info) -> + p_acc(Pred(Pid, Info), Pid, Info, Acc); +procs_acc(_, _, _, Acc) -> + Acc. + +p_acc(true, Pid, Info, Acc) -> + [[{pid, Pid} | Info] | Acc]; +p_acc(false, _, _, Acc) -> + Acc. + +%% info/3 + +info(Pred, Info, T) -> + lists:any(fun(I) -> i(Pred, I, T) end, Info). + +i(Pred, {K, {M,_,_}}, T) + when K == current_function; + K == initial_call -> + Pred(M,T); +i(Pred, {registered_name, N}, T) -> + Pred(N,T); +i(_,_,_) -> + false. + +pre1(A, Pre) -> + lists:prefix(Pre, atom_to_list(A)). + +pre(A, Prefixes) -> + lists:any(fun(P) -> pre1(A, atom_to_list(P)) end, Prefixes). + +%%% ---------------------------------------------------------- +%%% # latest(Modules|Prefix) +%%% +%%% Output: {Mod, {Y,M,D,HH,MM,SS}, Version} +%%% +%%% Description: Return the compile time of the most recently compiled +%%% module from the specified non-empty list. The modules +%%% are assumed to exist. +%%% ---------------------------------------------------------- + +latest(Prefix) + when is_atom(Prefix) -> + latest(modules(Prefix)); + +latest([_|_] = Modules) -> + {Mod, T} + = hd(lists:sort(fun latest/2, lists:map(fun compile_time/1, Modules))), + {Mod, T, app_vsn(Mod)}. + +app_vsn(Mod) -> + keyfetch(app_vsn, Mod:module_info(attributes)). + +compile_time(Mod) -> + T = keyfetch(time, Mod:module_info(compile)), + {Mod, T}. + +latest({_,T1},{_,T2}) -> + T1 > T2. + +%%% ---------------------------------------------------------- +%%% version_info(Modules|Prefix) +%%% +%%% Output: {SysInfo, OSInfo, [ModInfo]} +%%% +%%% SysInfo = {Arch, Vers} +%%% OSInfo = {Vers, {Fam, Name}} +%%% ModInfo = {Vsn, AppVsn, Time, CompilerVsn} +%%% ---------------------------------------------------------- + +version_info(Prefix) + when is_atom(Prefix) -> + version_info(modules(Prefix)); + +version_info(Mods) + when is_list(Mods) -> + {sys_info(), os_info(), [{M, mod_version_info(M)} || M <- Mods]}. + +mod_version_info(Mod) -> + try + Info = Mod:module_info(), + [[Vsn], AppVsn] = get_values(attributes, [vsn, app_vsn], Info), + [Ver, Time] = get_values(compile, [version, time], Info), + [Vsn, AppVsn, Ver, Time] + catch + _:_ -> + [] + end. + +get_values(Attr, Keys, Info) -> + As = proplists:get_value(Attr, Info), + [proplists:get_value(K, As, "?") || K <- Keys]. + +sys_info() -> + [A,V] = [chomp(erlang:system_info(K)) || K <- [system_architecture, + system_version]], + {A,V}. + +os_info() -> + {os:version(), case os:type() of + {_Fam, _Name} = T -> + T; + Fam -> + {Fam, ""} + end}. + +chomp(S) -> + string:strip(S, right, $\n). + +print_sys_info({Arch, Ver}) -> + io:format("System info:~n" + " architecture : ~s~n" + " version : ~s~n", + [Arch, Ver]). + +print_os_info({Vsn, {Fam, Name}}) -> + io:format("OS info:~n" + " family : ~s ~s~n" + " version : ~s~n", + [str(Fam), bkt(str(Name)), vsn(Vsn)]). + +print_mod_info(Mods) -> + io:format("Module info:~n", []), + lists:foreach(fun print_mod/1, Mods). + +print_mod({Mod, []}) -> + io:format(" ~w:~n", [Mod]); +print_mod({Mod, [Vsn, AppVsn, Ver, {Year, Month, Day, Hour, Min, Sec}]}) -> + Time = io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", + [Year, Month, Day, Hour, Min, Sec]), + io:format(" ~w:~n" + " vsn : ~s~n" + " app_vsn : ~s~n" + " compiled : ~s~n" + " compiler : ~s~n", + [Mod, str(Vsn), str(AppVsn), Time, Ver]). + +str(A) + when is_atom(A) -> + atom_to_list(A); +str(S) + when is_list(S) -> + S; +str(T) -> + io_lib:format("~p", [T]). + +bkt("" = S) -> + S; +bkt(S) -> + [$[, S, $]]. + +vsn(T) when is_tuple(T) -> + case [[$., integer_to_list(N)] || N <- tuple_to_list(T)] of + [[$.,S] | Rest] -> + [S | Rest]; + [] = S -> + S + end; +vsn(T) -> + str(T). + +%%% ---------------------------------------------------------- +%%% ---------------------------------------------------------- + +%% p/1 + +p(Info) -> + W = 2 + widest([K || {K,_} <- Info]), + lists:foreach(fun({K,V}) -> p(W,K,V) end, Info). + +p(Width, Key, Value) -> + io:format(": ~*s: ~p~n", [-Width, Key, Value]). + +%% sep/[01] + +sep() -> + sep($#). + +sep(true) -> + sep(); +sep(false) -> + ok; + +sep(Ch) -> + io:format("~c~65c~n", [Ch, $-]). + +%% widest/1 + +widest(List) -> + lists:foldl(fun widest/2, 0, List). + +widest(T, Max) + when is_atom(T) -> + widest(atom_to_list(T), Max); + +widest(T, Max) + when is_integer(T) -> + widest(integer_to_list(T), Max); + +widest(T, Max) + when is_list(T) -> %% string + max(length(T), Max). + +pt(T) -> + io:format(": ~p~n", [T]). + +recsplit(SFun, Rec) -> + fun(Fs,Vs) -> SFun(element(1, Rec), Fs, Vs) end. + +max(A, B) -> + if A > B -> A; true -> B end. + +keyfetch(Key, List) -> + {Key,V} = lists:keyfind(Key, 1, List), + V. + +%% ft/4 + +ft(undefined = No, _, _, _) -> + No; + +ft(_, Table, SFun, Fields) -> + ets:foldl(fun(R,A) -> + f(SFun, 0, Fields, R, A) + end, + 0, + Table). + +%% f/5 + +f(SFun, Width, Fields, Rec, Count) -> + ff(SFun, Width, fields(Fields, Rec), Rec, Count). + +ff(SFun, Width, Fields, Rec, Count) -> + sep(0 == Count), + f(SFun, Width, Fields, Rec), + sep(), + Count+1. + +fields(N, _) + when is_integer(N), N >= 0 -> + lists:duplicate(N, ''); %% list values unadorned +fields(Fields, R) + when is_function(Fields, 1) -> + fields(Fields(R), R); +fields({Fields, Values} = T, _) + when length(Fields) == length(Values) -> + T; +fields(Fields, _) + when is_list(Fields) -> + Fields. %% list field/value pairs, or tuples if [] + +%% f/4 + +%% Empty fields list: just print the entry. +f(_, _, [], Rec) + when is_tuple(Rec) -> + pt(Rec); + +%% Otherwise list field names/values. +f(SFun, Width, {Fields, Values}, _) -> + f(SFun, Width, Fields, Values); + +f(SFun, Width, Fields, Rec) + when is_tuple(Rec) -> + f(SFun, Width, Fields, values(Fields, Rec)); + +f(_, _, [], []) -> + ok; + +f(SFun, Width, [HF | _] = Fields, Values) -> + {F, FT, V, VT} = SFun(Fields, Values), + if is_list(F) -> %% V is a record + break($>, HF), + f(SFun, Width, F, values(F,V)), + break($<, HF), + f(SFun, Width, FT, VT); + F == '' -> %% no field name: just list value + pt(V), + f(SFun, Width, FT, VT); + true -> %% list field/value. + W = max(Width, 1 + widest(Fields)), + p(W, F, V), + f(SFun, W, FT, VT) + end. + +values(Fields, Rec) + when length(Fields) == size(Rec) - 1 -> + ?VALUES(Rec); +values(Fields, T) + when length(Fields) == size(T) -> + tuple_to_list(T). + +%% format_local/2 + +format_local(Tables, SFun) -> + lists:foldl(fun(T,A) -> fl(SFun, T, A) end, 0, Tables). + +fl(SFun, {Table, Recs, Fields}, Count) -> + sep(), + io:format("# ~p~n", [Table]), + N = fmt(Recs, Fields, SFun), + sep(0 == N), + Count + N; + +fl(SFun, {Table, Fields}, Count) -> + fl(SFun, {Table, Table, Fields}, Count). + +%% fmt/3 + +fmt(T, Fields, SFun) -> + case format(T, Fields, SFun) of + undefined -> + 0; + N -> + N + end. + +%% break/2 + +break(C, T) -> + io:format("~c ~p~n", [C, T]). + +%% collect/2 +%% +%% Output: {[{TableName, Recs}, ...], node()} + +collect(CFun, TableNames) -> + {lists:foldl(fun(N,A) -> c(CFun, N, A) end, [], TableNames), node()}. + +c(CFun, TableName, Acc) -> + case CFun(TableName) of + Recs when is_list(Recs) -> + [{TableName, Recs} | Acc]; + _ -> + Acc + end. + +%% format_remote/3 + +format_remote(Tables, SFun, {Replies, BadNodes}) -> + N = lists:foldl(fun(T,A) -> fr(Tables, SFun, T, A) end, + 0, + Replies), + sep(0 == N andalso [] /= BadNodes), + lists:foreach(fun(Node) -> io:format("# no reply from ~p~n", [Node]) end, + BadNodes), + sep([] /= BadNodes), + N. + +fr(Tables, SFun, {List, Node}, Count) + when is_list(List) -> %% guard against {badrpc, Reason} + lists:foldl(fun({T,Recs}, C) -> fr(Tables, SFun, Node, T, Recs,C) end, + Count, + List); +fr(_, _, _, Count) -> + Count. + +fr(Tables, SFun, Node, Table, Recs, Count) -> + Fields = keyfetch(Table, Tables), + sep(), + io:format("# ~p@~p~n", [Table, Node]), + N = format(Recs, Fields, tblsplit(SFun, Table)), + sep(0 == N), + Count + N. + +tblsplit(SFun, Table) + when is_function(SFun, 3) -> + fun(Fs,Vs) -> SFun(Table, Fs, Vs) end; +tblsplit(SFun, _) + when is_function(SFun, 2) -> + SFun. + +%% compact/1 +%% +%% Strip whitespace from both ends of a string. + +compact(Str) -> + compact(Str, true). + +compact([Ch|Rest], B) + when Ch == $\n; + Ch == $ ; + Ch == $\t; + Ch == $\v; + Ch == $\r -> + compact(Rest, B); + +compact(Str, false) -> + Str; + +compact(Str, true) -> + lists:reverse(compact(lists:reverse(Str), false)). diff --git a/lib/diameter/src/base/diameter_internal.hrl b/lib/diameter/src/base/diameter_internal.hrl new file mode 100644 index 0000000000..63b35550a8 --- /dev/null +++ b/lib/diameter/src/base/diameter_internal.hrl @@ -0,0 +1,80 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% Our Erlang application. +-define(APPLICATION, diameter). + +%% The one and only. +-define(DIAMETER_VERSION, 1). + +%% Exception for use within a module with decent protection against +%% catching something we haven't thrown. Not foolproof but close +%% enough. ?MODULE is rudmentary protection against catching across +%% module boundaries, a root of much evil: always catch ?FAILURE(X), +%% never X. +-define(FAILURE(Reason), {{?MODULE}, {Reason}}). +-define(THROW(Reason), throw(?FAILURE(Reason))). + +%% A corresponding error when failure is the best option. +-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). + +%% Failure reports always get a stack trace. +-define(STACK, erlang:get_stacktrace()). + +%% Warning report for unexpected messages in various processes. +-define(UNEXPECTED(F,A), + diameter_lib:warning_report(unexpected, {?MODULE, F, A})). +-define(UNEXPECTED(A), ?UNEXPECTED(?FUNC, A)). + +%% Something to trace on. +-define(LOG(Slogan, Details), + diameter_lib:log(Slogan, ?MODULE, ?LINE, Details)). +-define(LOGC(Bool, Slogan, Details), ((Bool) andalso ?LOG(Slogan, Details))). + +%% Compensate for no builtin ?FUNC for use in log reports. +-define(FUNC, element(2, element(2, process_info(self(), current_function)))). + +%% Disjunctive match spec condition. 'false' is to ensure that there's at +%% least one condition. +-define(ORCOND(List), list_to_tuple(['orelse', false | List])). + +%% 3588, 2.4: +-define(APP_ID_COMMON, 0). +-define(APP_ID_RELAY, 16#FFFFFFFF). + +-define(BASE, diameter_gen_base_rfc3588). + +%%% --------------------------------------------------------- + +%%% RFC 3588, ch 2.6 Peer table +-record(diameter_peer, + {host_id, + statusT, + is_dynamic, + expiration, + tls_enabled}). + +%%% RFC 3588, ch 2.7 Realm-based routing table +-record(diameter_realm, + {name, + app_id, + local_action, % LOCAL | RELAY | PROXY | REDIRECT + server_id, + is_dynamic, + expiration}). diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl new file mode 100644 index 0000000000..362d593b24 --- /dev/null +++ b/lib/diameter/src/base/diameter_lib.erl @@ -0,0 +1,272 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_lib). + +-export([report/2, info_report/2, + error_report/2, + warning_report/2, + now_diff/1, + time/1, + eval/1, + ip4address/1, + ip6address/1, + ipaddr/1, + spawn_opts/2, + wait/1, + fold_tuple/3, + log/4]). + +-include("diameter_internal.hrl"). + +%% --------------------------------------------------------------------------- +%% # info_report(Reason, MFA) +%% +%% Input: Reason = Arbitrary term indicating the reason for the report. +%% MFA = {Module, Function, Args} to report. +%% +%% Output: true +%% --------------------------------------------------------------------------- + +report(Reason, MFA) -> + info_report(Reason, MFA). + +info_report(Reason, MFA) -> + report(fun error_logger:info_report/1, Reason, MFA), + true. + +%%% --------------------------------------------------------------------------- +%%% # error_report(Reason, MFA) +%%% # warning_report(Reason, MFA) +%%% +%%% Output: false +%%% --------------------------------------------------------------------------- + +error_report(Reason, MFA) -> + report(fun error_logger:error_report/1, Reason, MFA). + +warning_report(Reason, MFA) -> + report(fun error_logger:warning_report/1, Reason, MFA). + +report(Fun, Reason, MFA) -> + Fun([{why, Reason}, {who, self()}, {what, MFA}]), + false. + +%%% --------------------------------------------------------------------------- +%%% # now_diff(Time) +%%% +%%% Description: Return timer:now_diff(now(), Time) as an {H, M, S, MicroS} +%%% tuple instead of as integer microseconds. +%%% --------------------------------------------------------------------------- + +now_diff({_,_,_} = Time) -> + time(timer:now_diff(erlang:now(), Time)). + +%%% --------------------------------------------------------------------------- +%%% # time(Time) +%%% +%%% Input: Time = {MegaSec, Sec, MicroSec} +%%% | MicroSec +%%% +%%% Output: {H, M, S, MicroS} +%%% --------------------------------------------------------------------------- + +time({_,_,_} = Time) -> %% time of day + %% 24 hours = 24*60*60*1000000 = 86400000000 microsec + time(timer:now_diff(Time, {0,0,0}) rem 86400000000); + +time(Micro) -> %% elapsed time + Seconds = Micro div 1000000, + H = Seconds div 3600, + M = (Seconds rem 3600) div 60, + S = Seconds rem 60, + {H, M, S, Micro rem 1000000}. + +%%% --------------------------------------------------------------------------- +%%% # eval(Func) +%%% --------------------------------------------------------------------------- + +eval({M,F,A}) -> + apply(M,F,A); + +eval([{M,F,A} | X]) -> + apply(M, F, X ++ A); + +eval([[F|A] | X]) -> + eval([F | X ++ A]); + +eval([F|A]) -> + apply(F,A); + +eval({F}) -> + eval(F); + +eval(F) -> + F(). + +%%% --------------------------------------------------------------------------- +%%% # ip4address(Addr) +%%% +%%% Input: string() (eg. "10.0.0.1") +%%% | list of integer() +%%% | tuple of integer() +%%% +%%% Output: {_,_,_,_} of integer +%%% +%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} +%%% --------------------------------------------------------------------------- + +ip4address([_,_,_,_] = Addr) -> %% Length 4 string can't be an address. + ipaddr(list_to_tuple(Addr)); + +%% Be brutal. +ip4address(Addr) -> + try + {_,_,_,_} = ipaddr(Addr) + catch + error: _ -> + erlang:error({invalid_address, Addr, ?STACK}) + end. + +%%% --------------------------------------------------------------------------- +%%% # ip6address(Addr) +%%% +%%% Input: string() (eg. "1080::8:800:200C:417A") +%%% | list of integer() +%%% | tuple of integer() +%%% +%%% Output: {_,_,_,_,_,_,_,_} of integer +%%% +%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} +%%% --------------------------------------------------------------------------- + +ip6address([_,_,_,_,_,_,_,_] = Addr) -> %% Length 8 string can't be an address. + ipaddr(list_to_tuple(Addr)); + +%% Be brutal. +ip6address(Addr) -> + try + {_,_,_,_,_,_,_,_} = ipaddr(Addr) + catch + error: _ -> + erlang:error({invalid_address, Addr, ?STACK}) + end. + +%%% --------------------------------------------------------------------------- +%%% # ipaddr(Addr) +%%% +%%% Input: string() | tuple of integer() +%%% +%%% Output: {_,_,_,_} | {_,_,_,_,_,_,_,_} +%%% +%%% Exceptions: error: {invalid_address, erlang:get_stacktrace()} +%%% --------------------------------------------------------------------------- + +-spec ipaddr(string() | tuple()) + -> inet:ip_address(). + +%% Don't convert lists of integers since a length 8 list like +%% [$1,$0,$.,$0,$.,$0,$.,$1] is ambiguous: is it "10.0.0.1" or +%% "49:48:46:48:46:48:46:49"? +%% +%% RFC 2373 defines the format parsed for v6 addresses. + +%% Be brutal. +ipaddr(Addr) -> + try + ip(Addr) + catch + error: _ -> + erlang:error({invalid_address, ?STACK}) + end. + +%% Already a tuple: ensure non-negative integers of the right size. +ip(T) + when size(T) == 4; + size(T) == 8 -> + Bs = 2*size(T), + [] = lists:filter(fun(N) when 0 =< N -> 0 < N bsr Bs end, + tuple_to_list(T)), + T; + +%% Or not: convert from '.'/':'-separated decimal/hex. +ip(Addr) -> + {ok, A} = inet_parse:address(Addr), %% documented in inet(3) + A. + +%%% --------------------------------------------------------------------------- +%%% # spawn_opts(Type, Opts) +%%% --------------------------------------------------------------------------- + +%% TODO: config variables. + +spawn_opts(server, Opts) -> + opts(75000, Opts); +spawn_opts(worker, Opts) -> + opts(5000, Opts). + +opts(HeapSize, Opts) -> + [{min_heap_size, HeapSize} | lists:keydelete(min_heap_size, 1, Opts)]. + +%%% --------------------------------------------------------------------------- +%%% # wait(MRefs) +%%% --------------------------------------------------------------------------- + +wait(L) -> + w([erlang:monitor(process, P) || P <- L]). + +w([]) -> + ok; +w(L) -> + receive + {'DOWN', MRef, process, _, _} -> + w(lists:delete(MRef, L)) + end. + +%%% --------------------------------------------------------------------------- +%%% # fold_tuple(N, T0, T) +%%% --------------------------------------------------------------------------- + +%% Replace fields in T0 by those of T starting at index N, unless the +%% new value is 'undefined'. +%% +%% eg. fold_tuple(2, Hdr, #diameter_header{end_to_end_id = 42}) + +fold_tuple(_, T, undefined) -> + T; + +fold_tuple(N, T0, T1) -> + {_, T} = lists:foldl(fun(V, {I,_} = IT) -> {I+1, ft(V, IT)} end, + {N, T0}, + lists:nthtail(N-1, tuple_to_list(T1))), + T. + +ft(undefined, {_, T}) -> + T; +ft(Value, {Idx, T}) -> + setelement(Idx, T, Value). + +%%% ---------------------------------------------------------- +%%% # log(Slogan, Mod, Line, Details) +%%% +%%% Called to have something to trace on for happenings of interest. +%%% ---------------------------------------------------------- + +log(_, _, _, _) -> + ok. diff --git a/lib/diameter/src/base/diameter_misc_sup.erl b/lib/diameter/src/base/diameter_misc_sup.erl new file mode 100644 index 0000000000..4e40476f14 --- /dev/null +++ b/lib/diameter/src/base/diameter_misc_sup.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% The supervisor of the static server processes. +%% + +-module(diameter_misc_sup). + +-behaviour(supervisor). + +-export([start_link/0]). %% supervisor start + +%% supervisor callback +-export([init/1]). + +-define(CHILDREN, [diameter_sync, %% serialization + diameter_stats, %% statistics counter management + diameter_reg, %% service/property publishing + diameter_peer, %% remote peer manager + diameter_config]). %% configuration/restart + +%% start_link/0 + +start_link() -> + SupName = {local, ?MODULE}, + supervisor:start_link(SupName, ?MODULE, []). + +%% init/1 + +init([]) -> + Flags = {one_for_one, 1, 5}, + Workers = lists:map(fun spec/1, ?CHILDREN), + {ok, {Flags, Workers}}. + +spec(Mod) -> + {Mod, + {Mod, start_link, []}, + permanent, + 1000, + worker, + [Mod]}. diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl new file mode 100644 index 0000000000..3e78c4caef --- /dev/null +++ b/lib/diameter/src/base/diameter_peer.erl @@ -0,0 +1,225 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_peer). + +-behaviour(gen_server). + +%% Interface towards transport modules ... +-export([recv/2, + up/1, + up/2]). + +%% ... and the stack. +-export([start/3, + send/2, + close/1, + abort/1, + notify/2]). + +%% Server start. +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% debug +-export([state/0, + uptime/0]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +%% Registered name of the server. +-define(SERVER, ?MODULE). + +%% Server state. +-record(state, {id = now()}). + +%%% --------------------------------------------------------------------------- +%%% # notify/2 +%%% --------------------------------------------------------------------------- + +notify(SvcName, T) -> + rpc:abcast(nodes(), ?SERVER, {notify, SvcName, T}). + +%%% --------------------------------------------------------------------------- +%%% # start/3 +%%% --------------------------------------------------------------------------- + +start(T, Opts, #diameter_service{} = Svc) -> + {Mod, Cfg} = split_transport(Opts), + apply(Mod, start, [T, Svc, Cfg]). + +%%% --------------------------------------------------------------------------- +%%% # up/[12] +%%% --------------------------------------------------------------------------- + +up(Pid) -> %% accepting transport + ifc_send(Pid, {self(), connected}). + +up(Pid, Remote) -> %% connecting transport + ifc_send(Pid, {self(), connected, Remote}). + +%%% --------------------------------------------------------------------------- +%%% # recv/2 +%%% --------------------------------------------------------------------------- + +recv(Pid, Pkt) -> + ifc_send(Pid, {recv, Pkt}). + +%%% --------------------------------------------------------------------------- +%%% # send/2 +%%% --------------------------------------------------------------------------- + +send(Pid, #diameter_packet{transport_data = undefined, + bin = Bin}) -> + send(Pid, Bin); + +send(Pid, Pkt) -> + ifc_send(Pid, {send, Pkt}). + +%%% --------------------------------------------------------------------------- +%%% # close/1 +%%% --------------------------------------------------------------------------- + +close(Pid) -> + ifc_send(Pid, {close, self()}). + +%%% --------------------------------------------------------------------------- +%%% # abort/1 +%%% --------------------------------------------------------------------------- + +abort(Pid) -> + exit(Pid, shutdown). + +%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Module = ?MODULE, + Args = [], + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, Module, Args, Options). + +state() -> + call(state). + +uptime() -> + call(uptime). + +%%% ---------------------------------------------------------- +%%% # init(Role) +%%% ---------------------------------------------------------- + +init([]) -> + {ok, #state{}}. + +%%% ---------------------------------------------------------- +%%% # handle_call(Request, From, State) +%%% ---------------------------------------------------------- + +handle_call(state, _, State) -> + {reply, State, State}; + +handle_call(uptime, _, #state{id = Time} = State) -> + {reply, diameter_lib:now_diff(Time), State}; + +handle_call(Req, From, State) -> + ?UNEXPECTED([Req, From]), + {reply, nok, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_info(Request, State) +%%% ---------------------------------------------------------- + +%% Remote service is distributing a message. +handle_info({notify, SvcName, T}, S) -> + bang(diameter_service:whois(SvcName), T), + {noreply, S}; + +handle_info(Info, State) -> + ?UNEXPECTED([Info]), + {noreply, State}. + +%% ---------------------------------------------------------- +%% terminate(Reason, State) +%% ---------------------------------------------------------- + +terminate(_Reason, _State) -> + ok. + +%% ---------------------------------------------------------- +%% code_change(OldVsn, State, Extra) +%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% --------------------------------------------------------- +%% INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +%% ifc_send/2 +%% +%% Send something over the transport interface. + +ifc_send(Pid, T) -> + Pid ! {diameter, T}. + +%% bang/2 + +bang(undefined = No, _) -> + No; +bang(Pid, T) -> + Pid ! T. + +%% split_transport/1 +%% +%% Split options into transport module, transport config and +%% remaining options. + +split_transport(Opts) -> + {[M,C], _} = proplists:split(Opts, [transport_module, + transport_config]), + {value(M, diameter_tcp), value(C, [])}. + +value([{_,V}], _) -> + V; +value([], V) -> + V. + +%% call/1 + +call(Request) -> + gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl new file mode 100644 index 0000000000..282fa2742f --- /dev/null +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -0,0 +1,777 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This module implements (as a process) the RFC 3588 Peer State +%% Machine modulo the necessity of adapting the peer election to the +%% fact that we don't know the identity of a peer until we've +%% received a CER/CEA from it. +%% + +-module(diameter_peer_fsm). +-behaviour(gen_server). + +%% Interface towards diameter_watchdog. +-export([start/3]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +%% diameter_peer_fsm_sup callback +-export([start_link/1]). + +%% internal callbacks +-export([match/1]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). +-include("diameter_types.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). + +-define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). +-define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). + +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + +-define(LOOP_TIMEOUT, 2000). + +%% RFC 3588: +%% +%% Timeout An application-defined timer has expired while waiting +%% for some event. +%% +-define(EVENT_TIMEOUT, 10000). + +%% How long to wait for a DPA in response to DPR before simply +%% aborting. Used to distinguish between shutdown and not but there's +%% not really any need. Stopping a service will require a timeout if +%% the peer doesn't answer DPR so the value should be short-ish. +-define(DPA_TIMEOUT, 1000). + +-record(state, + {state = 'Wait-Conn-Ack' %% state of RFC 3588 Peer State Machine + :: 'Wait-Conn-Ack' | recv_CER | 'Wait-CEA' | 'Open', + mode :: accept | connect | {connect, reference()}, + parent :: pid(), + transport :: pid(), + service :: #diameter_service{}, + dpr = false :: false | {'Unsigned32'(), 'Unsigned32'()}}). + %% | hop by hop and end to end identifiers + +%% There are non-3588 states possible as a consequence of 5.6.1 of the +%% standard and the corresponding problem for incoming CEA's: we don't +%% know who we're talking to until either a CER or CEA has been +%% received. The CEA problem in particular makes it impossible to +%% follow the state machine exactly as documented in 3588: there can +%% be no election until the CEA arrives and we have an Origin-Host to +%% elect. + +%% +%% Once upon a time start/2 started a process akin to that started by +%% start/3 below, which in turn started a watchdog/transport process +%% with the result that the watchdog could send DWR/DWA regardless of +%% whether or not the corresponding Peer State Machine was in its open +%% state; that is, before capabilities exchange had taken place. This +%% is not what RFC's 3588 and 3539 say (albeit not very clearly). +%% Watchdog messages are only exchanged on *open* connections, so the +%% 3539 state machine is more naturally placed on top of the 3588 Peer +%% State Machine rather than closer to the transport. This is what we +%% now do below: connect/accept call diameter_watchdog and return the +%% pid of the watchdog process, and the watchdog in turn calls start/3 +%% below to start the process implementing the Peer State Machine. The +%% former is a "peer" in diameter_service while the latter is a +%% "conn". In a sense, diameter_service sees the watchdog as +%% implementing the Peer State Machine and the process implemented +%% here as being the transport, not being aware of the watchdog at +%% all. +%% + +%%% --------------------------------------------------------------------------- +%%% # start({connect|accept, Ref}, Opts, Service) +%%% +%%% Output: Pid +%%% --------------------------------------------------------------------------- + +%% diameter_config requires a non-empty list of applications on the +%% service but diameter_service then constrains the list to any +%% specified on the transport in question. Check here that the list is +%% still non-empty. + +start({_, Ref} = Type, Opts, #diameter_service{applications = Apps} = Svc) -> + [] /= Apps orelse ?ERROR({no_apps, Type, Opts}), + T = {self(), Type, Opts, Svc}, + {ok, Pid} = diameter_peer_fsm_sup:start_child(T), + diameter_stats:reg(Pid, Ref), + Pid. + +start_link(T) -> + {ok, _} = proc_lib:start_link(?MODULE, + init, + [T], + infinity, + diameter_lib:spawn_opts(server, [])). + +%%% --------------------------------------------------------------------------- +%%% --------------------------------------------------------------------------- + +%% init/1 + +init(T) -> + proc_lib:init_ack({ok, self()}), + gen_server:enter_loop(?MODULE, [], i(T)). + +i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> + putr(dwa, dwa(Caps)), + {ok, TPid, Svc} = start_transport(T, Opts, Svc0), + erlang:monitor(process, TPid), + erlang:monitor(process, WPid), + #state{parent = WPid, + transport = TPid, + mode = M, + service = Svc}. +%% The transport returns its local ip addresses so that different +%% transports on the same service can use different local addresses. +%% The local addresses are put into Host-IP-Address avps here when +%% sending capabilities exchange messages. +%% +%% Invalid transport config may cause us to crash but note that the +%% watchdog start (start/2) succeeds regardless so as not to crash the +%% service. + +start_transport(T, Opts, Svc) -> + case diameter_peer:start(T, Opts, Svc) of + {ok, TPid} -> + {ok, TPid, Svc}; + {ok, TPid, [_|_] = Addrs} -> + #diameter_service{capabilities = Caps0} = Svc, + Caps = Caps0#diameter_caps{host_ip_address = Addrs}, + {ok, TPid, Svc#diameter_service{capabilities = Caps}}; + No -> + exit({shutdown, No}) + end. + +%% handle_call/3 + +handle_call(_, _, State) -> + {reply, nok, State}. + +%% handle_cast/2 + +handle_cast(_, State) -> + {noreply, State}. + +%% handle_info/1 + +handle_info(T, #state{} = State) -> + try transition(T, State) of + ok -> + {noreply, State}; + #state{state = X} = S -> + ?LOGC(X =/= State#state.state, transition, X), + {noreply, S}; + {stop, Reason} -> + ?LOG(stop, Reason), + x(Reason, State); + stop -> + ?LOG(stop, T), + x(T, State) + catch + throw: {?MODULE, Tag, Reason} -> + ?LOG(Tag, {Reason, T}), + {stop, {shutdown, Reason}, State} + end. + +x(Reason, #state{} = S) -> + close_wd(Reason, S), + {stop, {shutdown, Reason}, S}. + +%% terminate/2 + +terminate(_, _) -> + ok. + +%% code_change/3 + +code_change(_, State, _) -> + {ok, State}. + +%%% --------------------------------------------------------------------------- +%%% --------------------------------------------------------------------------- + +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + +%% transition/2 + +%% Connection to peer. +transition({diameter, {TPid, connected, Remote}}, + #state{state = PS, + mode = M} + = S) -> + 'Wait-Conn-Ack' = PS, %% assert + connect = M, %% + send_CER(S#state{mode = {M, Remote}, + transport = TPid}); + +%% Connection from peer. +transition({diameter, {TPid, connected}}, + #state{state = PS, + mode = M, + parent = Pid} + = S) -> + 'Wait-Conn-Ack' = PS, %% assert + accept = M, %% + Pid ! {accepted, self()}, + start_timer(S#state{state = recv_CER, + transport = TPid}); + +%% Incoming message from the transport. +transition({diameter, {recv, Pkt}}, S) -> + recv(Pkt, S); + +%% Timeout when still in the same state ... +transition({timeout, PS}, #state{state = PS}) -> + stop; + +%% ... or not. +transition({timeout, _}, _) -> + ok; + +%% Outgoing message. +transition({send, Msg}, #state{transport = TPid}) -> + send(TPid, Msg), + ok; + +%% Request for graceful shutdown. +transition({shutdown, Pid}, #state{parent = Pid, dpr = false} = S) -> + dpr(?GOAWAY, S); +transition({shutdown, Pid}, #state{parent = Pid}) -> + ok; + +%% Application shutdown. +transition(shutdown, #state{dpr = false} = S) -> + dpr(?REBOOT, S); +transition(shutdown, _) -> %% DPR already send: ensure expected timeout + dpa_timer(), + ok; + +%% Request to close the transport connection. +transition({close = T, Pid}, #state{parent = Pid, + transport = TPid}) -> + diameter_peer:close(TPid), + {stop, T}; + +%% DPA reception has timed out. +transition(dpa_timeout, _) -> + stop; + +%% Someone wants to know a resolved port: forward to the transport process. +transition({resolve_port, _Pid} = T, #state{transport = TPid}) -> + TPid ! T, + ok; + +%% Parent or transport has died. +transition({'DOWN', _, process, P, _}, + #state{parent = Pid, + transport = TPid}) + when P == Pid; + P == TPid -> + stop; + +%% State query. +transition({state, Pid}, #state{state = S, transport = TPid}) -> + Pid ! {self(), [S, TPid]}, + ok. + +%% Crash on anything unexpected. + +%% send_CER/1 + +send_CER(#state{mode = {connect, Remote}, + service = #diameter_service{capabilities = Caps}, + transport = TPid} + = S) -> + req_send_CER(Caps#diameter_caps.origin_host, Remote) + orelse + close(connected, S), + CER = build_CER(S), + ?LOG(send, 'CER'), + send(TPid, encode(CER)), + start_timer(S#state{state = 'Wait-CEA'}). + +%% Register ourselves as connecting to the remote endpoint in +%% question. This isn't strictly necessary since a peer implementing +%% the 3588 Peer State Machine should reject duplicate connection's +%% from the same peer but there's little point in us setting up a +%% duplicate connection in the first place. This could also include +%% the transport protocol being used but since we're blind to +%% transport just avoid duplicate connections to the same host/port. +req_send_CER(OriginHost, Remote) -> + register_everywhere({?MODULE, connection, OriginHost, {remote, Remote}}). + +%% start_timer/1 + +start_timer(#state{state = PS} = S) -> + erlang:send_after(?EVENT_TIMEOUT, self(), {timeout, PS}), + S. + +%% build_CER/1 + +build_CER(#state{service = #diameter_service{capabilities = Caps}}) -> + {ok, CER} = diameter_capx:build_CER(Caps), + CER. + +%% encode/1 + +encode(Rec) -> + #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Rec), + Bin. + +%% recv/2 + +%% RFC 3588 has result code 5015 for an invalid length but if a +%% transport is detecting message boundaries using the length header +%% then a length error will likely lead to further errors. + +recv(#diameter_packet{header = #diameter_header{length = Len} + = Hdr, + bin = Bin}, + S) + when Len < 20; + (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) -> + discard(invalid_message_length, recv, [size(Bin), + bit_size(Bin) rem 8, + Hdr, + S]); + +recv(#diameter_packet{header = #diameter_header{} = Hdr} + = Pkt, + #state{parent = Pid} + = S) -> + Name = diameter_codec:msg_name(Hdr), + Pid ! {recv, self(), Name, Pkt}, + diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received + rcv(Name, Pkt, S); + +recv(#diameter_packet{header = undefined, + bin = Bin} + = Pkt, + S) -> + recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S); + +recv(Bin, S) + when is_binary(Bin) -> + recv(#diameter_packet{bin = Bin}, S); + +recv(#diameter_packet{header = false} = Pkt, S) -> + discard(truncated_header, recv, [Pkt, S]). + +msg_id({_,_,_} = T, _) -> + T; +msg_id(_, Hdr) -> + diameter_codec:msg_id(Hdr). + +%% Treat invalid length as a transport error and die. Especially in +%% the TCP case, in which there's no telling where the next message +%% begins in the incoming byte stream, keeping a crippled connection +%% alive may just make things worse. + +discard(Reason, F, A) -> + diameter_stats:incr(Reason), + diameter_lib:warning_report(Reason, {?MODULE, F, A}), + throw({?MODULE, abort, Reason}). + +%% rcv/3 + +%% Incoming CEA. +rcv('CEA', Pkt, #state{state = 'Wait-CEA'} = S) -> + handle_CEA(Pkt, S); + +%% Incoming CER +rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> + handle_request(N, Pkt, S); + +%% Anything but CER/CEA in a non-Open state is an error, as is +%% CER/CEA in anything but recv_CER/Wait-CEA. +rcv(Name, _, #state{state = PS}) + when PS /= 'Open'; + Name == 'CER'; + Name == 'CEA' -> + {stop, {Name, PS}}; + +rcv(N, Pkt, S) + when N == 'DWR'; + N == 'DPR' -> + handle_request(N, Pkt, S); + +%% DPA even though we haven't sent DPR: ignore. +rcv('DPA', _Pkt, #state{dpr = false}) -> + ok; + +%% DPA in response to DPR. We could check the sequence numbers but +%% don't bother, just close. +rcv('DPA' = N, _Pkt, #state{transport = TPid}) -> + diameter_peer:close(TPid), + {stop, N}; + +rcv(_, _, _) -> + ok. + +%% send/2 + +%% Msg here could be a #diameter_packet or a binary depending on who's +%% sending. In particular, the watchdog will send DWR as a binary +%% while messages coming from clients will be in a #diameter_packet. +send(Pid, Msg) -> + diameter_stats:incr({diameter_codec:msg_id(Msg), send}), + diameter_peer:send(Pid, Msg). + +%% handle_request/3 + +handle_request(Type, #diameter_packet{} = Pkt, S) -> + ?LOG(recv, Type), + send_answer(Type, diameter_codec:decode(?BASE, Pkt), S). + +%% send_answer/3 + +send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> + #diameter_packet{header = #diameter_header{version = V, + end_to_end_id = Eid, + hop_by_hop_id = Hid, + is_proxiable = P}, + transport_data = TD} + = ReqPkt, + + {Answer, PostF} = build_answer(Type, V, ReqPkt, S), + + Pkt = #diameter_packet{header = #diameter_header{version = V, + end_to_end_id = Eid, + hop_by_hop_id = Hid, + is_proxiable = P}, + msg = Answer, + transport_data = TD}, + + send(TPid, diameter_codec:encode(?BASE, Pkt)), + eval(PostF, S). + +eval([F|A], S) -> + apply(F, A ++ [S]); +eval(ok, S) -> + S. + +%% build_answer/4 + +build_answer('CER', + ?DIAMETER_VERSION, + #diameter_packet{msg = CER, + header = #diameter_header{is_error = false}, + errors = []} + = Pkt, + #state{service = Svc} + = S) -> + #diameter_service{capabilities = #diameter_caps{origin_host = OH}} + = Svc, + + {SupportedApps, + #diameter_caps{origin_host = DH} = RCaps, + #diameter_base_CEA{'Result-Code' = RC} + = CEA} + = recv_CER(CER, S), + + try + 2001 == RC %% DIAMETER_SUCCESS + orelse ?THROW({sent_CEA, RC}), + register_everywhere({?MODULE, connection, OH, DH}) + orelse ?THROW({election_lost, 4003}), + #diameter_base_CEA{'Inband-Security-Id' = [IS]} + = CEA, + {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]} + catch + ?FAILURE({Reason, RC}) -> + {answer('CER', S) ++ [{'Result-Code', RC}], + [fun close/2, {'CER', Reason, DH}]} + end; + +%% The error checks below are similar to those in diameter_service for +%% other messages. Should factor out the commonality. + +build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) -> + FailedAvp = failed_avp([A || {_,A} <- Es]), + Ans = answer(answer(Type, S), V, H, Es), + {set(Ans, FailedAvp), if 'CER' == Type -> + [fun close/2, {Type, V, Pkt}]; + true -> + ok + end}. + +failed_avp([] = No) -> + No; +failed_avp(Avps) -> + [{'Failed-AVP', [[{'AVP', Avps}]]}]. + +set(Ans, []) -> + Ans; +set(['answer-message' | _] = Ans, FailedAvp) -> + Ans ++ [{'AVP', [FailedAvp]}]; +set([_|_] = Ans, FailedAvp) -> + Ans ++ FailedAvp. + +answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) -> + ['answer-message', OH, OR, {'Result-Code', 3008}]; + +answer([_, OH, OR | _], _, _, [Bs|_]) + when is_bitstring(Bs) -> + ['answer-message', OH, OR, {'Result-Code', 3009}]; + +answer(Ans, ?DIAMETER_VERSION, _, Es) -> + Ans ++ [{'Result-Code', rc(Es)}]; + +answer(Ans, _, _, _) -> + Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION + +rc([]) -> + 2001; %% DIAMETER_SUCCESS +rc([{RC,_}|_]) -> + RC; +rc([RC|_]) -> + RC. + +%% DIAMETER_INVALID_HDR_BITS 3008 +%% A request was received whose bits in the Diameter header were +%% either set to an invalid combination, or to a value that is +%% inconsistent with the command code's definition. + +%% DIAMETER_INVALID_AVP_BITS 3009 +%% A request was received that included an AVP whose flag bits are +%% set to an unrecognized value, or that is inconsistent with the +%% AVP's definition. + +%% ELECTION_LOST 4003 +%% The peer has determined that it has lost the election process and +%% has therefore disconnected the transport connection. + +%% DIAMETER_NO_COMMON_APPLICATION 5010 +%% This error is returned when a CER message is received, and there +%% are no common applications supported between the peers. + +%% DIAMETER_UNSUPPORTED_VERSION 5011 +%% This error is returned when a request was received, whose version +%% number is unsupported. + +%% answer/2 + +answer('DWR', _) -> + getr(dwa); + +answer(Name, #state{service = #diameter_service{capabilities = Caps}}) -> + a(Name, Caps). + +a('CER', #diameter_caps{vendor_id = Vid, + origin_host = Host, + origin_realm = Realm, + host_ip_address = Addrs, + product_name = Name}) -> + ['CEA', {'Origin-Host', Host}, + {'Origin-Realm', Realm}, + {'Host-IP-Address', Addrs}, + {'Vendor-Id', Vid}, + {'Product-Name', Name}]; + +a('DPR', #diameter_caps{origin_host = Host, + origin_realm = Realm}) -> + ['DPA', {'Origin-Host', Host}, + {'Origin-Realm', Realm}]. + +%% recv_CER/2 + +recv_CER(CER, #state{service = Svc}) -> + {ok, T} = diameter_capx:recv_CER(CER, Svc), + T. + +%% handle_CEA/1 + +handle_CEA(#diameter_packet{header = #diameter_header{version = V}, + bin = Bin} + = Pkt, + #state{service = #diameter_service{capabilities = LCaps}} + = S) + when is_binary(Bin) -> + ?LOG(recv, 'CEA'), + + ?DIAMETER_VERSION == V orelse close({version, V}, S), + + #diameter_packet{msg = CEA, errors = Errors} + = DPkt + = diameter_codec:decode(?BASE, Pkt), + + [] == Errors orelse close({errors, Errors}, S), + + {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps} + = recv_CEA(CEA, S), + + #diameter_caps{origin_host = OH} + = LCaps, + + %% Ensure that we don't already have a connection to the peer in + %% question. This isn't the peer election of 3588 except in the + %% sense that, since we don't know who we're talking to until we + %% receive a CER/CEA, the first that arrives wins the right to a + %% connection with the peer. + + register_everywhere({?MODULE, connection, OH, DH}) + orelse close({'CEA', DH}, S), + + open(DPkt, SApps, RCaps, {connect, IS}, S). + +%% recv_CEA/2 + +recv_CEA(CEA, #state{service = Svc} = S) -> + case diameter_capx:recv_CEA(CEA, Svc) of + {ok, {_,_}} -> %% return from old code + close({'CEA', update}, S); + {ok, {[], _, _}} -> + close({'CEA', no_common_application}, S); + {ok, {_, [], _}} -> + close({'CEA', no_common_security}, S); + {ok, {_,_,_} = T} -> + T; + {error, Reason} -> + close({'CEA', Reason}, S) + end. + +%% open/5 + +open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid, + service = Svc} + = S) -> + #diameter_service{capabilities = #diameter_caps{origin_host = OH, + inband_security_id = LS} + = LCaps} + = Svc, + #diameter_caps{origin_host = DH} + = RCaps, + + tls_ack(lists:member(?TLS, LS), Type, IS, S), + Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, + + S#state{state = 'Open'}. + +%% We've advertised TLS support: tell the transport the result +%% and expect a reply when the handshake is complete. +tls_ack(true, Type, IS, #state{transport = TPid} = S) -> + Ref = make_ref(), + MRef = erlang:monitor(process, TPid), + TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, + receive + {diameter, {tls, Ref}} -> + erlang:demonitor(MRef, [flush]); + {'DOWN', MRef, process, _, _} = T -> + close({tls_ack, T}, S) + end; + +%% Or not. Don't send anything to the transport so that transports +%% not supporting TLS work as before without modification. +tls_ack(false, _, _, _) -> + ok. + +capz(#diameter_caps{} = L, #diameter_caps{} = R) -> + #diameter_caps{} + = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), + tl(tuple_to_list(R)))]). + +%% close/2 + +%% Tell the watchdog that our death isn't due to transport failure. +close(Reason, #state{parent = Pid}) -> + close_wd(Reason, Pid), + throw({?MODULE, close, Reason}). + +%% close_wd/2 + +%% Ensure the watchdog dies if DPR has been sent ... +close_wd(_, #state{dpr = false}) -> + ok; +close_wd(Reason, #state{parent = Pid}) -> + close_wd(Reason, Pid); + +%% ... or otherwise +close_wd(Reason, Pid) -> + Pid ! {close, self(), Reason}. + +%% dwa/1 + +dwa(#diameter_caps{origin_host = OH, + origin_realm = OR, + origin_state_id = OSI}) -> + ['DWA', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Origin-State-Id', OSI}]. + +%% dpr/2 + +dpr(Cause, #state{transport = TPid, + service = #diameter_service{capabilities = Caps}} + = S) -> + #diameter_caps{origin_host = OH, + origin_realm = OR} + = Caps, + + Bin = encode(['DPR', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Disconnect-Cause', Cause}]), + send(TPid, Bin), + dpa_timer(), + ?LOG(send, 'DPR'), + S#state{dpr = diameter_codec:sequence_numbers(Bin)}. + +dpa_timer() -> + erlang:send_after(?DPA_TIMEOUT, self(), dpa_timeout). + +%% register_everywhere/1 +%% +%% Register a term and ensure it's not registered elsewhere. Note that +%% two process that simultaneously register the same term may well +%% both fail to do so this isn't foolproof. + +register_everywhere(T) -> + diameter_reg:add_new(T) + andalso unregistered(T). + +unregistered(T) -> + {ResL, _} = rpc:multicall(?MODULE, match, [{node(), T}]), + lists:all(fun(L) -> [] == L end, ResL). + +match({Node, _}) + when Node == node() -> + []; +match({_, T}) -> + try + diameter_reg:match(T) + catch + _:_ -> [] + end. diff --git a/lib/diameter/src/base/diameter_peer_fsm_sup.erl b/lib/diameter/src/base/diameter_peer_fsm_sup.erl new file mode 100644 index 0000000000..995eaf74d0 --- /dev/null +++ b/lib/diameter/src/base/diameter_peer_fsm_sup.erl @@ -0,0 +1,63 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% The supervisor of peer_fsm processes. +%% + +-module(diameter_peer_fsm_sup). + +-behaviour(supervisor). + +-define(NAME, ?MODULE). %% supervisor name + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- + +-export([start_link/0, %% supervisor start + start_child/1]). %% peer fsm start + +-export([init/1]). + +%% start_link/0 + +start_link() -> + SupName = {local, ?NAME}, + supervisor:start_link(SupName, ?MODULE, []). + +%% start_child/1 +%% +%% Start a peer_fsm process. + +start_child(T) -> + supervisor:start_child(?NAME, [T]). + +%% init/1 + +init([]) -> + Mod = diameter_peer_fsm, + Flags = {simple_one_for_one, 0, 1}, + ChildSpec = {Mod, + {Mod, start_link, []}, + temporary, + 1000, + worker, + [Mod]}, + {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl new file mode 100644 index 0000000000..882b9da238 --- /dev/null +++ b/lib/diameter/src/base/diameter_reg.erl @@ -0,0 +1,327 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% The module implements a simple term -> pid registry. +%% + +-module(diameter_reg). +-compile({no_auto_import, [monitor/2]}). + +-behaviour(gen_server). + +-export([add/1, + add_new/1, + del/1, + repl/2, + match/1]). + +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% test +-export([pids/0, + terms/0]). + +%% debug +-export([state/0, + uptime/0]). + +-include("diameter_internal.hrl"). + +-define(SERVER, ?MODULE). +-define(TABLE, ?MODULE). + +%% Table entry used to keep from starting more than one monitor on the +%% same process. This isn't a problem but there's no point in starting +%% multiple monitors if we can avoid it. Note that we can't have a 2-tuple +%% keyed on Pid since a registered term can be anything. Want the entry +%% keyed on Pid so that lookup is fast. +-define(MONITOR(Pid, MRef), {Pid, monitor, MRef}). + +%% Table entry containing the Term -> Pid mapping. +-define(MAPPING(Term, Pid), {Term, Pid}). + +-record(state, {id = now()}). + +%%% ---------------------------------------------------------- +%%% # add(T) +%%% +%%% Input: Term = term() +%%% +%%% Output: true +%%% +%%% Description: Associate the specified term with self(). The list of pids +%%% having this or other assocations can be retrieved using +%%% match/1. +%%% +%%% An association is removed when the calling process dies +%%% or as a result of calling del/1. Adding the same term +%%% more than once is equivalent to adding it exactly once. +%%% +%%% Note that since match/1 takes a pattern as argument, +%%% specifying a term that contains match variables is +%%% probably not a good idea +%%% ---------------------------------------------------------- + +-spec add(any()) + -> true. + +add(T) -> + call({add, fun ets:insert/2, T, self()}). + +%%% ---------------------------------------------------------- +%%% # add_new(T) +%%% +%%% Input: T = term() +%%% +%%% Output: true | false +%%% +%%% Description: Like add/1 but only one process is allowed to have the +%%% the association, false being returned if an association +%%% already exists. +%%% ---------------------------------------------------------- + +-spec add_new(any()) + -> boolean(). + +add_new(T) -> + call({add, fun insert_new/2, T, self()}). + +%%% ---------------------------------------------------------- +%%% # repl(T, NewT) +%%% +%%% Input: T, NewT = term() +%%% +%%% Output: true | false +%%% +%%% Description: Like add/1 but only replace an existing association on T, +%%% false being returned if it doesn't exist. +%%% ---------------------------------------------------------- + +-spec repl(any(), any()) + -> boolean(). + +repl(T, U) -> + call({repl, T, U, self()}). + +%%% ---------------------------------------------------------- +%%% # del(Term) +%%% +%%% Input: Term = term() +%%% +%%% Output: true +%%% +%%% Description: Remove any existing association of Term with self(). +%%% ---------------------------------------------------------- + +-spec del(any()) + -> true. + +del(T) -> + call({del, T, self()}). + +%%% ---------------------------------------------------------- +%%% # match(Pat) +%%% +%%% Input: Pat = pattern in the sense of ets:match_object/2. +%%% +%%% Output: list of {Term, Pid} +%%% +%%% Description: Return the list of associations whose Term, as specified +%%% to add/1 or add_new/1, matches the specified pattern. +%%% +%%% Note that there's no guarantee that the returned processes +%%% are still alive. (Although one that isn't will soon have +%%% its associations removed.) +%%% ---------------------------------------------------------- + +-spec match(tuple()) + -> [{term(), pid()}]. + +match(Pat) -> + ets:match_object(?TABLE, ?MAPPING(Pat, '_')). + +%% --------------------------------------------------------- +%% EXPORTED INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, ?MODULE, [], Options). + +state() -> + call(state). + +uptime() -> + call(uptime). + +%% pids/0 +%% +%% Output: list of {Pid, [Term, ...]} + +pids() -> + to_list(fun swap/1). + +to_list(Fun) -> + ets:foldl(fun(T,A) -> acc(Fun, T, A) end, orddict:new(), ?TABLE). + +acc(Fun, ?MAPPING(Term, Pid), Dict) -> + append(Fun({Term, Pid}), Dict); +acc(_, _, Dict) -> + Dict. + +append({K,V}, Dict) -> + orddict:append(K, V, Dict). + +id(T) -> T. + +%% terms/0 +%% +%% Output: list of {Term, [Pid, ...]} + +terms() -> + to_list(fun id/1). + +swap({X,Y}) -> {Y,X}. + +%%% ---------------------------------------------------------- +%%% # init(Role) +%%% +%%% Output: {ok, State} +%%% ---------------------------------------------------------- + +init(_) -> + ets:new(?TABLE, [bag, named_table]), + {ok, #state{}}. + +%%% ---------------------------------------------------------- +%%% # handle_call(Request, From, State) +%%% ---------------------------------------------------------- + +handle_call({add, Fun, Key, Pid}, _, State) -> + B = Fun(?TABLE, {Key, Pid}), + monitor(B andalso no_monitor(Pid), Pid), + {reply, B, State}; + +handle_call({del, Key, Pid}, _, State) -> + {reply, ets:delete_object(?TABLE, ?MAPPING(Key, Pid)), State}; + +handle_call({repl, T, U, Pid}, _, State) -> + MatchSpec = [{?MAPPING('$1', Pid), + [{'=:=', '$1', {const, T}}], + ['$_']}], + {reply, repl(ets:select(?TABLE, MatchSpec), U, Pid), State}; + +handle_call(state, _, State) -> + {reply, State, State}; + +handle_call(uptime, _, #state{id = Time} = State) -> + {reply, diameter_lib:now_diff(Time), State}; + +handle_call(Req, From, State) -> + ?UNEXPECTED([Req, From]), + {reply, nok, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State)-> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_info(Request, State) +%%% ---------------------------------------------------------- + +handle_info({'DOWN', MRef, process, Pid, _}, State) -> + ets:delete_object(?TABLE, ?MONITOR(Pid, MRef)), + ets:match_delete(?TABLE, ?MAPPING('_', Pid)), + {noreply, State}; + +handle_info(Info, State) -> + ?UNEXPECTED([Info]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% # terminate(Reason, State) +%%% ---------------------------------------------------------- + +terminate(_Reason, _State)-> + ok. + +%%% ---------------------------------------------------------- +%%% # code_change(OldVsn, State, Extra) +%%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% --------------------------------------------------------- +%% INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +monitor(true, Pid) -> + ets:insert(?TABLE, ?MONITOR(Pid, erlang:monitor(process, Pid))); +monitor(false, _) -> + ok. + +%% Do we need a monitor for the specified Pid? +no_monitor(Pid) -> + [] == ets:match_object(?TABLE, ?MONITOR(Pid, '_')). + +%% insert_new/2 + +insert_new(?TABLE, {Key, _} = T) -> + flush(ets:lookup(?TABLE, Key)), + ets:insert_new(?TABLE, T). + +%% Remove any processes that are dead but for which we may not have +%% received 'DOWN' yet. This is to ensure that add_new can be used +%% to register a unique name each time a process restarts. +flush(List) -> + lists:foreach(fun({_,P} = T) -> + del(erlang:is_process_alive(P), T) + end, + List). + +del(Alive, T) -> + Alive orelse ets:delete_object(?TABLE, T). + +%% repl/3 + +repl([?MAPPING(_, Pid) = M], Key, Pid) -> + ets:delete_object(?TABLE, M), + true = ets:insert(?TABLE, ?MAPPING(Key, Pid)); +repl([], _, _) -> + false. + +%% call/1 + +call(Request) -> + gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl new file mode 100644 index 0000000000..421e36ccf5 --- /dev/null +++ b/lib/diameter/src/base/diameter_service.erl @@ -0,0 +1,2903 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Implements the process that represents a service. +%% + +-module(diameter_service). +-behaviour(gen_server). + +-export([start/1, + stop/1, + start_transport/2, + stop_transport/2, + info/2, + call/4]). + +%% towards diameter_watchdog +-export([receive_message/3]). + +%% service supervisor +-export([start_link/1]). + +-export([subscribe/1, + unsubscribe/1, + subscriptions/1, + subscriptions/0, + services/0, + services/1, + whois/1, + flush_stats/1]). + +%% test/debug +-export([call_module/3, + state/1, + uptime/1]). + +%%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +%% Other callbacks. +-export([send/1]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). +-include("diameter_types.hrl"). + +-define(STATE_UP, up). +-define(STATE_DOWN, down). + +-define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1 +-define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests +-define(RESTART_TC, 1000). %% if restart was this recent + +%% Used to be able to swap this with anything else dict-like but now +%% rely on the fact that a service's #state{} record does not change +%% in storing in it ?STATE table and not always going through the +%% service process. In particular, rely on the fact that operations on +%% a ?Dict don't change the handle to it. +-define(Dict, diameter_dict). + +%% Table containing outgoing requests for which a reply has yet to be +%% received. +-define(REQUEST_TABLE, diameter_request). + +%% Maintains state in a table. In contrast to previously, a service's +%% stat is not constant and is accessed outside of the service +%% process. +-define(STATE_TABLE, ?MODULE). + +%% Workaround for dialyzer's lack of understanding of match specs. +-type match(T) + :: T | '_' | '$1' | '$2' | '$3' | '$4'. + +%% State of service gen_server. +-record(state, + {id = now(), + service_name, %% as passed to start_service/2, key in ?STATE_TABLE + service :: #diameter_service{}, + peerT = ets_new(peers) :: ets:tid(), %% #peer{} at start_fsm + connT = ets_new(conns) :: ets:tid(), %% #conn{} at connection_up + share_peers = false :: boolean(), %% broadcast peers to remote nodes? + use_shared_peers = false :: boolean(), %% use broadcasted peers? + shared_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] + local_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] + monitor = false :: false | pid()}). %% process to die with +%% shared_peers reflects the peers broadcast from remote nodes. Note +%% that the state term itself doesn't change, which is relevant for +%% the stateless application callbacks since the state is retrieved +%% from ?STATE_TABLE from outside the service process. The pid in the +%% service record is used to determine whether or not we need to call +%% the process for a pick_peer callback. + +%% Record representing a watchdog process. +-record(peer, + {pid :: match(pid()), + type :: match(connect | accept), + ref :: match(reference()), %% key into diameter_config + options :: match([transport_opt()]), %% as passed to start_transport + op_state = ?STATE_DOWN :: match(?STATE_DOWN | ?STATE_UP), + started = now(), %% at process start + conn = false :: match(boolean() | pid())}). + %% true at accept, pid() at connection_up (connT key) + +%% Record representing a peer_fsm process. +-record(conn, + {pid :: pid(), + apps :: [{0..16#FFFFFFFF, app_alias()}], %% {Id, Alias} + caps :: #diameter_caps{}, + started = now(), %% at process start + peer :: pid()}). %% key into peerT + +%% Record stored in diameter_request for each outgoing request. +-record(request, + {from, %% arg 2 of handle_call/3 + handler :: match(pid()), %% request process + transport :: match(pid()), %% peer process + caps :: match(#diameter_caps{}), + app :: match(app_alias()), %% #diameter_app.alias + dictionary :: match(module()), %% #diameter_app.dictionary + module :: match(nonempty_improper_list(module(), list())), + %% #diameter_app.module + filter :: match(peer_filter()), + packet :: match(#diameter_packet{})}). + +%% Record call/4 options are parsed into. +-record(options, + {filter = none :: peer_filter(), + extra = [] :: list(), + timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, + detach = false :: boolean()}). + +%% Since RFC 3588 requires that a Diameter agent not modify End-to-End +%% Identifiers, the possibility of explicitly setting an End-to-End +%% Identifier would be needed to be able to implement an agent in +%% which one side of the communication is not implemented on top of +%% diameter. For example, Diameter being sent or received encapsulated +%% in some other protocol, or even another Diameter stack in a +%% non-Erlang environment. (Not that this is likely to be a normal +%% case.) +%% +%% The implemented solution is not an option but to respect any header +%% values set in a diameter_header record returned from a +%% prepare_request callback. A call to diameter:call/4 can communicate +%% values to the callback using the 'extra' option if so desired. + +%%% --------------------------------------------------------------------------- +%%% # start(SvcName) +%%% --------------------------------------------------------------------------- + +start(SvcName) -> + diameter_service_sup:start_child(SvcName). + +start_link(SvcName) -> + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(?MODULE, [SvcName], Options). +%% Put the arbitrary term SvcName in a list in case we ever want to +%% send more than this and need to distinguish old from new. + +%%% --------------------------------------------------------------------------- +%%% # stop(SvcName) +%%% --------------------------------------------------------------------------- + +stop(SvcName) -> + case whois(SvcName) of + undefined -> + {error, not_started}; + Pid -> + stop(call_service(Pid, stop), Pid) + end. + +stop(ok, Pid) -> + MRef = erlang:monitor(process, Pid), + receive {'DOWN', MRef, process, _, _} -> ok end; +stop(No, _) -> + No. + +%%% --------------------------------------------------------------------------- +%%% # start_transport(SvcName, {Ref, Type, Opts}) +%%% --------------------------------------------------------------------------- + +start_transport(SvcName, {_,_,_} = T) -> + call_service_by_name(SvcName, {start, T}). + +%%% --------------------------------------------------------------------------- +%%% # stop_transport(SvcName, Refs) +%%% --------------------------------------------------------------------------- + +stop_transport(_, []) -> + ok; +stop_transport(SvcName, [_|_] = Refs) -> + call_service_by_name(SvcName, {stop, Refs}). + +%%% --------------------------------------------------------------------------- +%%% # info(SvcName, Item) +%%% --------------------------------------------------------------------------- + +info(SvcName, Item) -> + info_rc(call_service_by_name(SvcName, {info, Item})). + +info_rc({error, _}) -> + undefined; +info_rc(Info) -> + Info. + +%%% --------------------------------------------------------------------------- +%%% # receive_message(TPid, Pkt, MessageData) +%%% --------------------------------------------------------------------------- + +%% Handle an incoming message in the watchdog process. This used to +%% come through the service process but this avoids that becoming a +%% bottleneck. + +receive_message(TPid, Pkt, T) + when is_pid(TPid) -> + #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, + recv(R, (not R) andalso lookup_request(Pkt, TPid), TPid, Pkt, T). + +%% Incoming request ... +recv(true, false, TPid, Pkt, T) -> + try + spawn(fun() -> recv_request(TPid, Pkt, T) end) + catch + error: system_limit = E -> %% discard + ?LOG({error, E}, now()) + end; + +%% ... answer to known request ... +recv(false, #request{from = {_, Ref}, handler = Pid} = Req, _, Pkt, _) -> + Pid ! {answer, Ref, Req, Pkt}; +%% Note that failover could have happened prior to this message being +%% received and triggering failback. That is, both a failover message +%% and answer may be on their way to the handler process. In the worst +%% case the request process gets notification of the failover and +%% sends to the alternate peer before an answer arrives, so it's +%% always the case that we can receive more than one answer after +%% failover. The first answer received by the request process wins, +%% any others are discarded. + +%% ... or not. +recv(false, false, _, _, _) -> + ok. + +%%% --------------------------------------------------------------------------- +%%% # call(SvcName, App, Msg, Options) +%%% --------------------------------------------------------------------------- + +call(SvcName, App, Msg, Options) + when is_list(Options) -> + Rec = make_options(Options), + Ref = make_ref(), + Caller = {self(), Ref}, + Fun = fun() -> exit({Ref, call(SvcName, App, Msg, Rec, Caller)}) end, + try spawn_monitor(Fun) of + {_, MRef} -> + recv(MRef, Ref, Rec#options.detach, false) + catch + error: system_limit = E -> + {error, E} + end. + +%% Don't rely on gen_server:call/3 for the timeout handling since it +%% makes no guarantees about not leaving a reply message in the +%% mailbox if we catch its exit at timeout. It currently *can* do so, +%% which is also undocumented. + +recv(MRef, _, true, true) -> + erlang:demonitor(MRef, [flush]), + ok; + +recv(MRef, Ref, Detach, Sent) -> + receive + Ref -> %% send has been attempted + recv(MRef, Ref, Detach, true); + {'DOWN', MRef, process, _, Reason} -> + call_rc(Reason, Ref, Sent) + end. + +%% call/5 has returned ... +call_rc({Ref, Ans}, Ref, _) -> + Ans; + +%% ... or not. In this case failure/encode are documented. +call_rc(_, _, Sent) -> + {error, choose(Sent, failure, encode)}. + +%% call/5 +%% +%% In the process spawned for the outgoing request. + +call(SvcName, App, Msg, Opts, Caller) -> + c(ets:lookup(?STATE_TABLE, SvcName), App, Msg, Opts, Caller). + +c([#state{service_name = SvcName} = S], App, Msg, Opts, Caller) -> + case find_transport(App, Msg, Opts, S) of + {_,_,_} = T -> + send_request(T, Msg, Opts, Caller, SvcName); + false -> + {error, no_connection}; + {error, _} = No -> + No + end; + +c([], _, _, _, _) -> + {error, no_service}. + +%% make_options/1 + +make_options(Options) -> + lists:foldl(fun mo/2, #options{}, Options). + +mo({timeout, T}, Rec) + when is_integer(T), 0 =< T -> + Rec#options{timeout = T}; + +mo({filter, F}, #options{filter = none} = Rec) -> + Rec#options{filter = F}; +mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> + Rec#options{filter = {all, [F | Fs]}}; +mo({filter, F}, #options{filter = F0} = Rec) -> + Rec#options{filter = {all, [F0, F]}}; + +mo({extra, L}, #options{extra = X} = Rec) + when is_list(L) -> + Rec#options{extra = X ++ L}; + +mo(detach, Rec) -> + Rec#options{detach = true}; + +mo(T, _) -> + ?ERROR({invalid_option, T}). + +%%% --------------------------------------------------------------------------- +%%% # subscribe(SvcName) +%%% # unsubscribe(SvcName) +%%% --------------------------------------------------------------------------- + +subscribe(SvcName) -> + diameter_reg:add({?MODULE, subscriber, SvcName}). + +unsubscribe(SvcName) -> + diameter_reg:del({?MODULE, subscriber, SvcName}). + +subscriptions(Pat) -> + pmap(diameter_reg:match({?MODULE, subscriber, Pat})). + +subscriptions() -> + subscriptions('_'). + +pmap(Props) -> + lists:map(fun({{?MODULE, _, Name}, Pid}) -> {Name, Pid} end, Props). + +%%% --------------------------------------------------------------------------- +%%% # services(Pattern) +%%% --------------------------------------------------------------------------- + +services(Pat) -> + pmap(diameter_reg:match({?MODULE, service, Pat})). + +services() -> + services('_'). + +whois(SvcName) -> + case diameter_reg:match({?MODULE, service, SvcName}) of + [{_, Pid}] -> + Pid; + [] -> + undefined + end. + +%%% --------------------------------------------------------------------------- +%%% # flush_stats/1 +%%% +%%% Output: list of {{SvcName, Alias, Counter}, Value} +%%% --------------------------------------------------------------------------- + +flush_stats(TPid) -> + diameter_stats:flush(TPid). + +%% =========================================================================== +%% =========================================================================== + +state(Svc) -> + call_service(Svc, state). + +uptime(Svc) -> + call_service(Svc, uptime). + +%% call_module/3 + +call_module(Service, AppMod, Request) -> + call_service(Service, {call_module, AppMod, Request}). + +%%% --------------------------------------------------------------------------- +%%% # init([SvcName]) +%%% --------------------------------------------------------------------------- + +init([SvcName]) -> + process_flag(trap_exit, true), %% ensure terminate(shutdown, _) + i(SvcName, diameter_reg:add_new({?MODULE, service, SvcName})). + +i(SvcName, true) -> + {ok, i(SvcName)}; +i(_, false) -> + {stop, {shutdown, already_started}}. + +%%% --------------------------------------------------------------------------- +%%% # handle_call(Req, From, State) +%%% --------------------------------------------------------------------------- + +handle_call(state, _, S) -> + {reply, S, S}; + +handle_call(uptime, _, #state{id = T} = S) -> + {reply, diameter_lib:now_diff(T), S}; + +%% Start a transport. +handle_call({start, {Ref, Type, Opts}}, _From, S) -> + {reply, start(Ref, {Type, Opts}, S), S}; + +%% Stop transports. +handle_call({stop, Refs}, _From, S) -> + shutdown(Refs, S), + {reply, ok, S}; + +%% pick_peer with mutable state +handle_call({pick_peer, Local, Remote, App}, _From, S) -> + #diameter_app{mutable = true} = App, %% assert + {reply, pick_peer(Local, Remote, self(), S#state.service_name, App), S}; + +handle_call({call_module, AppMod, Req}, From, S) -> + call_module(AppMod, Req, From, S); + +handle_call({info, Item}, _From, S) -> + {reply, service_info(Item, S), S}; + +handle_call(stop, _From, S) -> + shutdown(S), + {stop, normal, ok, S}; +%% The server currently isn't guaranteed to be dead when the caller +%% gets the reply. We deal with this in the call to the server, +%% stating a monitor that waits for DOWN before returning. + +handle_call(Req, From, S) -> + unexpected(handle_call, [Req, From], S), + {reply, nok, S}. + +%%% --------------------------------------------------------------------------- +%%% # handle_cast(Req, State) +%%% --------------------------------------------------------------------------- + +handle_cast(Req, S) -> + unexpected(handle_cast, [Req], S), + {noreply, S}. + +%%% --------------------------------------------------------------------------- +%%% # handle_info(Req, State) +%%% --------------------------------------------------------------------------- + +handle_info(T,S) -> + case transition(T,S) of + ok -> + {noreply, S}; + #state{} = NS -> + {noreply, NS}; + {stop, Reason} -> + {stop, {shutdown, Reason}, S} + end. + +%% transition/2 + +%% Peer process is telling us to start a new accept process. +transition({accepted, Pid, TPid}, S) -> + accepted(Pid, TPid, S), + ok; + +%% Peer process has a new open connection. +transition({connection_up, Pid, T}, S) -> + connection_up(Pid, T, S); + +%% Peer process has left state open. +transition({connection_down, Pid}, S) -> + connection_down(Pid, S); + +%% Peer process has returned to state open. +transition({connection_up, Pid}, S) -> + connection_up(Pid, S); + +%% Accepting transport has lost connectivity. +transition({close, Pid}, S) -> + close(Pid, S), + ok; + +%% Connecting transport is being restarted by watchdog. +transition({reconnect, Pid}, S) -> + reconnect(Pid, S), + ok; + +%% Monitor process has died. Just die with a reason that tells +%% diameter_config about the happening. If a cleaner shutdown is +%% required then someone should stop us. +transition({'DOWN', MRef, process, _, Reason}, #state{monitor = MRef}) -> + {stop, {monitor, Reason}}; + +%% Local peer process has died. +transition({'DOWN', _, process, Pid, Reason}, S) + when node(Pid) == node() -> + peer_down(Pid, Reason, S); + +%% Remote service wants to know about shared transports. +transition({service, Pid}, S) -> + share_peers(Pid, S), + ok; + +%% Remote service is communicating a shared peer. +transition({peer, TPid, Aliases, Caps}, S) -> + remote_peer_up(TPid, Aliases, Caps, S); + +%% Remote peer process has died. +transition({'DOWN', _, process, TPid, _}, S) -> + remote_peer_down(TPid, S); + +%% Restart after tc expiry. +transition({tc_timeout, T}, S) -> + tc_timeout(T, S), + ok; + +%% Request process is telling us it may have missed a failover message +%% after a transport went down and the service process looked up +%% outstanding requests. +transition({failover, TRef, Seqs}, S) -> + failover(TRef, Seqs, S), + ok; + +transition(Req, S) -> + unexpected(handle_info, [Req], S), + ok. + +%%% --------------------------------------------------------------------------- +%%% # terminate(Reason, State) +%%% --------------------------------------------------------------------------- + +terminate(Reason, #state{service_name = Name} = S) -> + ets:delete(?STATE_TABLE, Name), + shutdown == Reason %% application shutdown + andalso shutdown(S). + +%%% --------------------------------------------------------------------------- +%%% # code_change(FromVsn, State, Extra) +%%% --------------------------------------------------------------------------- + +code_change(FromVsn, + #state{service_name = SvcName, + service = #diameter_service{applications = Apps}} + = S, + Extra) -> + lists:foreach(fun(A) -> + code_change(FromVsn, SvcName, Extra, A) + end, + Apps), + {ok, S}. + +code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> + {ok, S} = cb(A, code_change, [FromVsn, + mod_state(Alias), + Extra, + SvcName]), + mod_state(Alias, S). + +%% =========================================================================== +%% =========================================================================== + +unexpected(F, A, #state{service_name = Name}) -> + ?UNEXPECTED(F, A ++ [Name]). + +cb([_|_] = M, F, A) -> + eval(M, F, A); +cb(Rec, F, A) -> + {_, M} = app(Rec), + eval(M, F, A). + +app(#request{app = A, module = M}) -> + {A,M}; +app(#diameter_app{alias = A, module = M}) -> + {A,M}. + +eval([M|X], F, A) -> + apply(M, F, A ++ X). + +%% Callback with state. + +state_cb(#diameter_app{mutable = false, init_state = S}, {ModX, F, A}) -> + eval(ModX, F, A ++ [S]); + +state_cb(#diameter_app{mutable = true, alias = Alias}, {_,_,_} = MFA) -> + state_cb(MFA, Alias); + +state_cb({ModX,F,A}, Alias) + when is_list(ModX) -> + eval(ModX, F, A ++ [mod_state(Alias)]). + +choose(true, X, _) -> X; +choose(false, _, X) -> X. + +ets_new(Tbl) -> + ets:new(Tbl, [{keypos, 2}]). + +insert(Tbl, Rec) -> + ets:insert(Tbl, Rec), + Rec. + +monitor(Pid) -> + erlang:monitor(process, Pid), + Pid. + +%% Using the process dictionary for the callback state was initially +%% just a way to make what was horrendous trace (big state record and +%% much else everywhere) somewhat more readable. There's not as much +%% need for it now but it's no worse (except possibly that we don't +%% see the table identifier being passed around) than an ets table so +%% keep it. + +mod_state(Alias) -> + get({?MODULE, mod_state, Alias}). + +mod_state(Alias, ModS) -> + put({?MODULE, mod_state, Alias}, ModS). + +%% have_transport/2 + +have_transport(SvcName, Ref) -> + [] /= diameter_config:have_transport(SvcName, Ref). + +%%% --------------------------------------------------------------------------- +%%% # shutdown/2 +%%% --------------------------------------------------------------------------- + +shutdown(Refs, #state{peerT = PeerT}) -> + ets:foldl(fun(P,ok) -> s(P, Refs), ok end, ok, PeerT). + +s(#peer{ref = Ref, pid = Pid}, Refs) -> + s(lists:member(Ref, Refs), Pid); + +s(true, Pid) -> + Pid ! {shutdown, self()}; %% 'DOWN' will cleanup as usual +s(false, _) -> + ok. + +%%% --------------------------------------------------------------------------- +%%% # shutdown/1 +%%% --------------------------------------------------------------------------- + +shutdown(#state{peerT = PeerT}) -> + %% A transport might not be alive to receive the shutdown request + %% but give those that are a chance to shutdown gracefully. + wait(fun st/2, PeerT), + %% Kill the watchdogs explicitly in case there was no transport. + wait(fun sw/2, PeerT). + +wait(Fun, T) -> + diameter_lib:wait(ets:foldl(Fun, [], T)). + +st(#peer{conn = B}, Acc) + when is_boolean(B) -> + Acc; +st(#peer{conn = Pid}, Acc) -> + Pid ! shutdown, + [Pid | Acc]. + +sw(#peer{pid = Pid}, Acc) -> + exit(Pid, shutdown), + [Pid | Acc]. + +%%% --------------------------------------------------------------------------- +%%% # call_service/2 +%%% --------------------------------------------------------------------------- + +call_service(Pid, Req) + when is_pid(Pid) -> + cs(Pid, Req); +call_service(SvcName, Req) -> + call_service_by_name(SvcName, Req). + +call_service_by_name(SvcName, Req) -> + cs(whois(SvcName), Req). + +cs(Pid, Req) + when is_pid(Pid) -> + try + gen_server:call(Pid, Req, infinity) + catch + E: Reason when E == exit -> + {error, {E, Reason}} + end; + +cs(undefined, _) -> + {error, no_service}. + +%%% --------------------------------------------------------------------------- +%%% # i/1 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Intialize the state of a service gen_server. + +i(SvcName) -> + %% Split the config into a server state and a list of transports. + {#state{} = S, CL} = lists:foldl(fun cfg_acc/2, + {false, []}, + diameter_config:lookup(SvcName)), + + %% Publish the state in order to be able to access it outside of + %% the service process. Originally table identifiers were only + %% known to the service process but we now want to provide the + %% option of application callbacks being 'stateless' in order to + %% avoid having to go through a common process. (Eg. An agent that + %% sends a request for every incoming request.) + true = ets:insert_new(?STATE_TABLE, S), + + %% Start fsms for each transport. + lists:foreach(fun(T) -> start_fsm(T,S) end, CL), + + init_shared(S), + S. + +cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts}, + {false, Acc}) -> + lists:foreach(fun init_mod/1, Apps), + S = #state{service_name = SvcName, + service = Rec#diameter_service{pid = self()}, + share_peers = get_value(share_peers, Opts), + use_shared_peers = get_value(use_shared_peers, Opts), + monitor = mref(get_value(monitor, Opts))}, + {S, Acc}; + +cfg_acc({_Ref, Type, _Opts} = T, {S, Acc}) + when Type == connect; + Type == listen -> + {S, [T | Acc]}. + +mref(false = No) -> + No; +mref(P) -> + erlang:monitor(process, P). + +init_shared(#state{use_shared_peers = true, + service_name = Svc}) -> + diameter_peer:notify(Svc, {service, self()}); +init_shared(#state{use_shared_peers = false}) -> + ok. + +init_mod(#diameter_app{alias = Alias, + init_state = S}) -> + mod_state(Alias, S). + +start_fsm({Ref, Type, Opts}, S) -> + start(Ref, {Type, Opts}, S). + +get_value(Key, Vs) -> + {_, V} = lists:keyfind(Key, 1, Vs), + V. + +%%% --------------------------------------------------------------------------- +%%% # start/3 +%%% --------------------------------------------------------------------------- + +%% If the initial start/3 at service/transport start succeeds then +%% subsequent calls to start/4 on the same service will also succeed +%% since they involve the same call to merge_service/2. We merge here +%% rather than earlier since the service may not yet be configured +%% when the transport is configured. + +start(Ref, {T, Opts}, S) + when T == connect; + T == listen -> + try + {ok, start(Ref, type(T), Opts, S)} + catch + ?FAILURE(Reason) -> + {error, Reason} + end. +%% TODO: don't actually raise any errors yet + +%% There used to be a difference here between the handling of +%% configured listening and connecting transports but now we simply +%% tell the transport_module to start an accepting or connecting +%% process respectively, the transport implementation initiating +%% listening on a port as required. +type(listen) -> accept; +type(accept) -> listen; +type(connect = T) -> T. + +%% start/4 + +start(Ref, Type, Opts, #state{peerT = PeerT, + connT = ConnT, + service_name = SvcName, + service = Svc}) + when Type == connect; + Type == accept -> + Pid = monitor(s(Type, Ref, {ConnT, + Opts, + SvcName, + merge_service(Opts, Svc)})), + insert(PeerT, #peer{pid = Pid, + type = Type, + ref = Ref, + options = Opts}), + Pid. + +%% Note that the service record passed into the watchdog is the merged +%% record so that each watchdog (and peer_fsm) may get a different +%% record. This record is what is passed back into application +%% callbacks. + +s(Type, Ref, T) -> + diameter_watchdog:start({Type, Ref}, T). + +%% merge_service/2 + +merge_service(Opts, Svc) -> + lists:foldl(fun ms/2, Svc, Opts). + +%% Limit the applications known to the fsm to those in the 'apps' +%% option. That this might be empty is checked by the fsm. It's not +%% checked at config-time since there's no requirement that the +%% service be configured first. (Which could be considered a bit odd.) +ms({applications, As}, #diameter_service{applications = Apps} = S) + when is_list(As) -> + S#diameter_service{applications + = [A || A <- Apps, + lists:member(A#diameter_app.alias, As)]}; + +%% The fact that all capabilities can be configured on the transports +%% means that the service doesn't necessarily represent a single +%% locally implemented Diameter peer as identified by Origin-Host: a +%% transport can configure its own Origin-Host. This means that the +%% service little more than a placeholder for default capabilities +%% plus a list of applications that individual transports can choose +%% to support (or not). +ms({capabilities, Opts}, #diameter_service{capabilities = Caps0} = Svc) + when is_list(Opts) -> + %% make_caps has already succeeded in diameter_config so it will succeed + %% again here. + {ok, Caps} = diameter_capx:make_caps(Caps0, Opts), + Svc#diameter_service{capabilities = Caps}; + +ms(_, Svc) -> + Svc. + +%%% --------------------------------------------------------------------------- +%%% # accepted/3 +%%% --------------------------------------------------------------------------- + +accepted(Pid, _TPid, #state{peerT = PeerT} = S) -> + #peer{ref = Ref, type = accept = T, conn = false, options = Opts} + = P + = fetch(PeerT, Pid), + insert(PeerT, P#peer{conn = true}), %% mark replacement transport started + start(Ref, T, Opts, S). %% start new peer + +fetch(Tid, Key) -> + [T] = ets:lookup(Tid, Key), + T. + +%%% --------------------------------------------------------------------------- +%%% # connection_up/3 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Peer process has reached the open state. + +connection_up(Pid, {TPid, {Caps, SApps, Pkt}}, #state{peerT = PeerT, + connT = ConnT} + = S) -> + P = fetch(PeerT, Pid), + C = #conn{pid = TPid, + apps = SApps, + caps = Caps, + peer = Pid}, + + insert(ConnT, C), + connection_up([Pkt], P#peer{conn = TPid}, C, S). + +%%% --------------------------------------------------------------------------- +%%% # connection_up/2 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Peer process has transitioned back into the open state. Note that there +%% has been no new capabilties exchange in this case. + +connection_up(Pid, #state{peerT = PeerT, + connT = ConnT} + = S) -> + #peer{conn = TPid} = P = fetch(PeerT, Pid), + C = fetch(ConnT, TPid), + connection_up([], P, C, S). + +%% connection_up/4 + +connection_up(T, P, C, #state{peerT = PeerT, + local_peers = LDict, + service_name = SvcName, + service + = #diameter_service{applications = Apps}} + = S) -> + #peer{conn = TPid, op_state = ?STATE_DOWN} + = P, + #conn{apps = SApps, caps = Caps} + = C, + + insert(PeerT, P#peer{op_state = ?STATE_UP}), + + request_peer_up(TPid), + report_status(up, P, C, S, T), + S#state{local_peers = insert_local_peer(SApps, + {{TPid, Caps}, {SvcName, Apps}}, + LDict)}. + +insert_local_peer(SApps, T, LDict) -> + lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). + +ilp({Id, Alias}, {TC, SA}, LDict) -> + init_conn(Id, Alias, TC, SA), + ?Dict:append(Alias, TC, LDict). + +init_conn(Id, Alias, TC, {SvcName, Apps}) -> + #diameter_app{module = ModX, + id = Id} %% assert + = find_app(Alias, Apps), + + peer_cb({ModX, peer_up, [SvcName, TC]}, Alias). + +find_app(Alias, Apps) -> + lists:keyfind(Alias, #diameter_app.alias, Apps). + +%% A failing peer callback brings down the service. In the case of +%% peer_up we could just kill the transport and emit an error but for +%% peer_down we have no way to cleanup any state change that peer_up +%% may have introduced. +peer_cb(MFA, Alias) -> + try state_cb(MFA, Alias) of + ModS -> + mod_state(Alias, ModS) + catch + E: Reason -> + ?ERROR({E, Reason, MFA, ?STACK}) + end. + +%%% --------------------------------------------------------------------------- +%%% # connection_down/2 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Peer process has transitioned out of the open state. + +connection_down(Pid, #state{peerT = PeerT, + connT = ConnT} + = S) -> + #peer{conn = TPid} + = P + = fetch(PeerT, Pid), + + C = fetch(ConnT, TPid), + insert(PeerT, P#peer{op_state = ?STATE_DOWN}), + connection_down(P,C,S). + +%% connection_down/3 + +connection_down(#peer{conn = TPid, + op_state = ?STATE_UP} + = P, + #conn{caps = Caps, + apps = SApps} + = C, + #state{service_name = SvcName, + service = #diameter_service{applications = Apps}, + local_peers = LDict} + = S) -> + report_status(down, P, C, S, []), + NewS = S#state{local_peers + = remove_local_peer(SApps, + {{TPid, Caps}, {SvcName, Apps}}, + LDict)}, + request_peer_down(TPid, NewS), + NewS. + +remove_local_peer(SApps, T, LDict) -> + lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). + +rlp({Id, Alias}, {TC, SA}, LDict) -> + L = ?Dict:fetch(Alias, LDict), + down_conn(Id, Alias, TC, SA), + ?Dict:store(Alias, lists:delete(TC, L), LDict). + +down_conn(Id, Alias, TC, {SvcName, Apps}) -> + #diameter_app{module = ModX, + id = Id} %% assert + = find_app(Alias, Apps), + + peer_cb({ModX, peer_down, [SvcName, TC]}, Alias). + +%%% --------------------------------------------------------------------------- +%%% # peer_down/3 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Peer process has died. + +peer_down(Pid, _Reason, #state{peerT = PeerT} = S) -> + P = fetch(PeerT, Pid), + ets:delete_object(PeerT, P), + restart(P,S), + peer_down(P,S). + +%% peer_down/2 + +%% The peer has never come up ... +peer_down(#peer{conn = B}, S) + when is_boolean(B) -> + S; + +%% ... or it has. +peer_down(#peer{ref = Ref, + conn = TPid, + type = Type, + options = Opts} + = P, + #state{service_name = SvcName, + connT = ConnT} + = S) -> + #conn{caps = Caps} + = C + = fetch(ConnT, TPid), + ets:delete_object(ConnT, C), + try + pd(P,C,S) + after + send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}}) + end. + +pd(#peer{op_state = ?STATE_DOWN}, _, S) -> + S; +pd(#peer{op_state = ?STATE_UP} = P, C, S) -> + connection_down(P,C,S). + +%% restart/2 + +restart(P,S) -> + q_restart(restart(P), S). + +%% restart/1 + +%% Always try to reconnect. +restart(#peer{ref = Ref, + type = connect = T, + options = Opts, + started = Time}) -> + {Time, {Ref, T, Opts}}; + +%% Transport connection hasn't yet been accepted ... +restart(#peer{ref = Ref, + type = accept = T, + options = Opts, + conn = false, + started = Time}) -> + {Time, {Ref, T, Opts}}; + +%% ... or it has: a replacement transport has already been spawned. +restart(#peer{type = accept}) -> + false. + +%% q_restart/2 + +%% Start the reconnect timer. +q_restart({Time, {_Ref, Type, Opts} = T}, S) -> + start_tc(tc(Time, default_tc(Type, Opts)), T, S); +q_restart(false, _) -> + ok. + +%% RFC 3588, 2.1: +%% +%% When no transport connection exists with a peer, an attempt to +%% connect SHOULD be periodically made. This behavior is handled via +%% the Tc timer, whose recommended value is 30 seconds. There are +%% certain exceptions to this rule, such as when a peer has terminated +%% the transport connection stating that it does not wish to +%% communicate. + +default_tc(connect, Opts) -> + proplists:get_value(reconnect_timer, Opts, ?DEFAULT_TC); +default_tc(accept, _) -> + 0. + +%% Bound tc below if the peer was restarted recently to avoid +%% continuous in case of faulty config or other problems. +tc(Time, Tc) -> + choose(Tc > ?RESTART_TC + orelse timer:now_diff(now(), Time) > 1000*?RESTART_TC, + Tc, + ?RESTART_TC). + +start_tc(0, T, S) -> + tc_timeout(T, S); +start_tc(Tc, T, _) -> + erlang:send_after(Tc, self(), {tc_timeout, T}). + +%% tc_timeout/2 + +tc_timeout({Ref, _Type, _Opts} = T, #state{service_name = SvcName} = S) -> + tc(have_transport(SvcName, Ref), T, S). + +tc(true, {Ref, Type, Opts}, #state{service_name = SvcName} + = S) -> + send_event(SvcName, {reconnect, Ref, Opts}), + start(Ref, Type, Opts, S); +tc(false = No, _, _) -> %% removed + No. + +%%% --------------------------------------------------------------------------- +%%% # close/2 +%%% --------------------------------------------------------------------------- + +%% The watchdog doesn't start a new fsm in the accept case, it +%% simply stays alive until someone tells it to die in order for +%% another watchdog to be able to detect that it should transition +%% from initial into reopen rather than okay. That someone is either +%% the accepting watchdog upon reception of a CER from the previously +%% connected peer, or us after reconnect_timer timeout. + +close(Pid, #state{service_name = SvcName, + peerT = PeerT}) -> + #peer{pid = Pid, + type = accept, + ref = Ref, + options = Opts} + = fetch(PeerT, Pid), + + c(Pid, have_transport(SvcName, Ref), Opts). + +%% Tell watchdog to (maybe) die later ... +c(Pid, true, Opts) -> + Tc = proplists:get_value(reconnect_timer, Opts, 2*?DEFAULT_TC), + erlang:send_after(Tc, Pid, close); + +%% ... or now. +c(Pid, false, _Opts) -> + Pid ! close. + +%% The RFC's only document the behaviour of Tc, our reconnect_timer, +%% for the establishment of connections but we also give +%% reconnect_timer semantics for a listener, being the time within +%% which a new connection attempt is expected of a connecting peer. +%% The value should be greater than the peer's Tc + jitter. + +%%% --------------------------------------------------------------------------- +%%% # reconnect/2 +%%% --------------------------------------------------------------------------- + +reconnect(Pid, #state{service_name = SvcName, + peerT = PeerT}) -> + #peer{ref = Ref, + type = connect, + options = Opts} + = fetch(PeerT, Pid), + send_event(SvcName, {reconnect, Ref, Opts}). + +%%% --------------------------------------------------------------------------- +%%% # call_module/4 +%%% --------------------------------------------------------------------------- + +%% Backwards compatibility and never documented/advertised. May be +%% removed. + +call_module(Mod, Req, From, #state{service + = #diameter_service{applications = Apps}, + service_name = Svc} + = S) -> + case cm([A || A <- Apps, Mod == hd(A#diameter_app.module)], + Req, + From, + Svc) + of + {reply = T, RC} -> + {T, RC, S}; + noreply = T -> + {T, S}; + Reason -> + {reply, {error, Reason}, S} + end. + +cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> + MFA = {ModX, handle_call, [Req, From, Svc]}, + + try state_cb(MFA, Alias) of + {noreply = T, ModS} -> + mod_state(Alias, ModS), + T; + {reply = T, RC, ModS} -> + mod_state(Alias, ModS), + {T, RC}; + T -> + diameter_lib:error_report({invalid, T}, MFA), + invalid + catch + E: Reason -> + diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA), + failure + end; + +cm([], _, _, _) -> + unknown; + +cm([_,_|_], _, _, _) -> + multiple. + +%%% --------------------------------------------------------------------------- +%%% # send_request/5 +%%% --------------------------------------------------------------------------- + +%% Send an outgoing request in its dedicated process. +%% +%% Note that both encode of the outgoing request and of the received +%% answer happens in this process. It's also this process that replies +%% to the caller. The service process only handles the state-retaining +%% callbacks. +%% +%% The mod field of the #diameter_app{} here includes any extra +%% arguments passed to diameter:call/2. + +send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> + #diameter_app{module = ModX} + = App, + + Pkt = make_packet(Msg), + + case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of + {send, P} -> + send_request(make_packet(P, Pkt), + TPid, + Caps, + App, + Opts, + Caller, + SvcName); + {discard, Reason} -> + {error, Reason}; + discard -> + {error, discarded}; + T -> + ?ERROR({invalid_return, prepare_request, App, T}) + end. + +%% make_packet/1 +%% +%% Turn an outgoing request as passed to call/4 into a diameter_packet +%% record in preparation for a prepare_request callback. + +make_packet(Bin) + when is_binary(Bin) -> + #diameter_packet{header = diameter_codec:decode_header(Bin), + bin = Bin}; + +make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) -> + Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]}; + +make_packet(#diameter_packet{header = Hdr} = Pkt) -> + Pkt#diameter_packet{header = make_header(Hdr)}; + +make_packet(Msg) -> + make_packet(#diameter_packet{msg = Msg}). + +%% make_header/1 + +make_header(undefined) -> + Seq = diameter_session:sequence(), + make_header(#diameter_header{end_to_end_id = Seq, + hop_by_hop_id = Seq}); + +make_header(#diameter_header{version = undefined} = Hdr) -> + make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); + +make_header(#diameter_header{end_to_end_id = undefined} = H) -> + Seq = diameter_session:sequence(), + make_header(H#diameter_header{end_to_end_id = Seq}); + +make_header(#diameter_header{hop_by_hop_id = undefined} = H) -> + Seq = diameter_session:sequence(), + make_header(H#diameter_header{hop_by_hop_id = Seq}); + +make_header(#diameter_header{} = Hdr) -> + Hdr; + +make_header(T) -> + ?ERROR({invalid_header, T}). + +%% make_packet/2 +%% +%% Reconstruct a diameter_packet from the return value of +%% prepare_request or prepare_retransmit callback. + +make_packet(Bin, _) + when is_binary(Bin) -> + make_packet(Bin); + +make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> + Pkt; + +%% Returning a diameter_packet with no header from a prepare_request +%% or prepare_retransmit callback retains the header passed into it. +%% This is primarily so that the end to end and hop by hop identifiers +%% are retained. +make_packet(#diameter_packet{header = Hdr} = Pkt, + #diameter_packet{header = Hdr0}) -> + Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; + +make_packet(Msg, Pkt) -> + Pkt#diameter_packet{msg = Msg}. + +%% fold_record/2 + +fold_record(undefined, R) -> + R; +fold_record(Rec, R) -> + diameter_lib:fold_tuple(2, Rec, R). + +%% send_request/7 + +send_request(Pkt, TPid, Caps, App, Opts, Caller, SvcName) -> + #diameter_app{alias = Alias, + dictionary = Dict, + module = ModX, + answer_errors = AE} + = App, + + EPkt = encode(Dict, Pkt), + + #options{filter = Filter, + timeout = Timeout} + = Opts, + + Req = #request{packet = Pkt, + from = Caller, + handler = self(), + transport = TPid, + caps = Caps, + app = Alias, + filter = Filter, + dictionary = Dict, + module = ModX}, + + try + TRef = send_request(TPid, EPkt, Req, Timeout), + ack(Caller), + handle_answer(SvcName, AE, recv_answer(Timeout, SvcName, {TRef, Req})) + after + erase_request(EPkt) + end. + +%% Tell caller a send has been attempted. +ack({Pid, Ref}) -> + Pid ! Ref. + +%% recv_answer/3 + +recv_answer(Timeout, + SvcName, + {TRef, #request{from = {_, Ref}, packet = RPkt} = Req} + = T) -> + + %% Matching on TRef below ensures we ignore messages that pertain + %% to a previous transport prior to failover. The answer message + %% includes the #request{} since it's not necessarily Req; that + %% is, from the last peer to which we've transmitted. + + receive + {answer = A, Ref, Rq, Pkt} -> %% Answer from peer + {A, Rq, Pkt}; + {timeout = Reason, TRef, _} -> %% No timely reply + {error, Req, Reason}; + {failover = Reason, TRef, false} -> %% No alternate peer + {error, Req, Reason}; + {failover, TRef, Transport} -> %% Resend to alternate peer + try_retransmit(Timeout, SvcName, Req, Transport); + {failover, TRef} -> %% May have missed failover notification + Seqs = diameter_codec:sequence_numbers(RPkt), + Pid = whois(SvcName), + is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}), + recv_answer(Timeout, SvcName, T) + end. +%% Note that failover starts a new timer and that expiry of an old +%% timer value is ignored. This means that an answer could be accepted +%% from a peer after timeout in the case of failover. + +try_retransmit(Timeout, SvcName, Req, Transport) -> + try retransmit(Transport, Req, SvcName, Timeout) of + T -> recv_answer(Timeout, SvcName, T) + catch + ?FAILURE(Reason) -> {error, Req, Reason} + end. + +%% handle_error/3 + +handle_error(Req, Reason, SvcName) -> + #request{module = ModX, + packet = Pkt, + transport = TPid, + caps = Caps} + = Req, + cb(ModX, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). + +msg(#diameter_packet{msg = undefined, bin = Bin}) -> + Bin; +msg(#diameter_packet{msg = Msg}) -> + Msg. + +%% encode/2 + +%% Note that prepare_request can return a diameter_packet containing +%% header or transport_data. Even allow the returned record to contain +%% an encoded binary. This isn't the usual case but could some in +%% handy, for test at least. (For example, to send garbage.) + +%% The normal case: encode the returned message. +encode(Dict, #diameter_packet{msg = Msg, bin = undefined} = Pkt) -> + D = pick_dictionary([Dict, ?BASE], Msg), + diameter_codec:encode(D, Pkt); + +%% Callback has returned an encoded binary: just send. +encode(_, #diameter_packet{} = Pkt) -> + Pkt. + +%% pick_dictionary/2 + +%% Pick the first dictionary that declares the application id in the +%% specified header. +pick_dictionary(Ds, [#diameter_header{application_id = Id} | _]) -> + pd(Ds, fun(D) -> Id = D:id() end); + +%% Pick the first dictionary that knows the specified message name. +pick_dictionary(Ds, [MsgName|_]) -> + pd(Ds, fun(D) -> D:msg2rec(MsgName) end); + +%% Pick the first dictionary that knows the name of the specified +%% message record. +pick_dictionary(Ds, Rec) -> + Name = element(1, Rec), + pd(Ds, fun(D) -> D:rec2msg(Name) end). + +pd([D|Ds], F) -> + try + F(D), + D + catch + error:_ -> + pd(Ds, F) + end; + +pd([], _) -> + ?ERROR(no_dictionary). + +%% send_request/4 + +send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout) + when node() == node(TPid) -> + %% Store the outgoing request before sending to avoid a race with + %% reply reception. + TRef = store_request(TPid, Bin, Req, Timeout), + send(TPid, Pkt), + TRef; + +%% Send using a remote transport: spawn a process on the remote node +%% to relay the answer. +send_request(TPid, #diameter_packet{} = Pkt, Req, Timeout) -> + TRef = erlang:start_timer(Timeout, self(), timeout), + T = {TPid, Pkt, Req, Timeout, TRef}, + spawn(node(TPid), ?MODULE, send, [T]), + TRef. + +%% send/1 + +send({TPid, Pkt, #request{handler = Pid} = Req, Timeout, TRef}) -> + Ref = send_request(TPid, Pkt, Req#request{handler = self()}, Timeout), + Pid ! reref(receive T -> T end, Ref, TRef). + +reref({T, Ref, R}, Ref, TRef) -> + {T, TRef, R}; +reref(T, _, _) -> + T. + +%% send/2 + +send(Pid, Pkt) -> + Pid ! {send, Pkt}. + +%% retransmit/4 + +retransmit({TPid, Caps, #diameter_app{alias = Alias} = App}, + #request{app = Alias, + packet = Pkt} + = Req, + SvcName, + Timeout) -> + have_request(Pkt, TPid) %% Don't failover to a peer we've + andalso ?THROW(timeout), %% already sent to. + + case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of + {send, P} -> + retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout); + {discard, Reason} -> + ?THROW(Reason); + discard -> + ?THROW(discarded); + T -> + ?ERROR({invalid_return, prepare_retransmit, App, T}) + end. + +%% retransmit/5 + +retransmit(Pkt, TPid, Caps, #request{dictionary = Dict} = Req, Timeout) -> + EPkt = encode(Dict, Pkt), + + NewReq = Req#request{transport = TPid, + packet = Pkt, + caps = Caps}, + + ?LOG(retransmission, NewReq), + TRef = send_request(TPid, EPkt, NewReq, Timeout), + {TRef, NewReq}. + +%% store_request/4 + +store_request(TPid, Bin, Req, Timeout) -> + Seqs = diameter_codec:sequence_numbers(Bin), + TRef = erlang:start_timer(Timeout, self(), timeout), + ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), + ets:member(?REQUEST_TABLE, TPid) + orelse (self() ! {failover, TRef}), %% possibly missed failover + TRef. + +%% lookup_request/2 + +lookup_request(Msg, TPid) + when is_pid(TPid) -> + lookup(Msg, TPid, '_'); + +lookup_request(Msg, TRef) + when is_reference(TRef) -> + lookup(Msg, '_', TRef). + +lookup(Msg, TPid, TRef) -> + Seqs = diameter_codec:sequence_numbers(Msg), + Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, TRef}, + [], + ['$_']}], + case ets:select(?REQUEST_TABLE, Spec) of + [{_, Req, _}] -> + Req; + [] -> + false + end. + +%% erase_request/1 + +erase_request(Pkt) -> + ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). + +%% match_requests/1 + +match_requests(TPid) -> + Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, + ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). + +%% have_request/2 + +have_request(Pkt, TPid) -> + Seqs = diameter_codec:sequence_numbers(Pkt), + Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, + '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). + +%% request_peer_up/1 + +request_peer_up(TPid) -> + ets:insert(?REQUEST_TABLE, {TPid}). + +%% request_peer_down/2 + +request_peer_down(TPid, S) -> + ets:delete(?REQUEST_TABLE, TPid), + lists:foreach(fun(T) -> failover(T,S) end, match_requests(TPid)). +%% Note that a request process can store its request after failover +%% notifications are sent here: store_request/4 sends the notification +%% in that case. Note also that we'll send as many notifications to a +%% given handler as there are peers its sent to. All but one of these +%% will be ignored. + +%%% --------------------------------------------------------------------------- +%%% recv_request/3 +%%% --------------------------------------------------------------------------- + +recv_request(TPid, Pkt, {ConnT, SvcName, Apps}) -> + try ets:lookup(ConnT, TPid) of + [C] -> + recv_request(C, TPid, Pkt, SvcName, Apps); + [] -> %% transport has gone down + ok + catch + error: badarg -> %% service has gone down (and taken table with it) + ok + end. + +%% recv_request/5 + +recv_request(#conn{apps = SApps, caps = Caps}, TPid, Pkt, SvcName, Apps) -> + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}} + = Caps, + + #diameter_packet{header = #diameter_header{application_id = Id}} + = Pkt, + + recv_request(find_recv_app(Id, SApps), + {SvcName, OH, OR}, + TPid, + Apps, + Caps, + Pkt). + +%% find_recv_app/2 + +%% No one should be sending the relay identifier. +find_recv_app(?APP_ID_RELAY, _) -> + false; + +%% With any other id we either support it locally or as a relay. +find_recv_app(Id, SApps) -> + keyfind([Id, ?APP_ID_RELAY], 1, SApps). + +%% keyfind/3 + +keyfind([], _, _) -> + false; +keyfind([Key | Rest], Pos, L) -> + case lists:keyfind(Key, Pos, L) of + false -> + keyfind(Rest, Pos, L); + T -> + T + end. + +%% recv_request/6 + +recv_request({Id, Alias}, T, TPid, Apps, Caps, Pkt) -> + #diameter_app{dictionary = Dict} + = A + = find_app(Alias, Apps), + recv_request(T, {TPid, Caps}, A, diameter_codec:decode(Id, Dict, Pkt)); +%% Note that the decode is different depending on whether or not Id is +%% ?APP_ID_RELAY. + +%% DIAMETER_APPLICATION_UNSUPPORTED 3007 +%% A request was sent for an application that is not supported. + +recv_request(false, T, TPid, _, _, Pkt) -> + As = collect_avps(Pkt), + protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}). + +collect_avps(Pkt) -> + case diameter_codec:collect_avps(Pkt) of + {_Bs, As} -> + As; + As -> + As + end. + +%% recv_request/4 + +%% Wrong number of bits somewhere in the message: reply. +%% +%% DIAMETER_INVALID_AVP_BITS 3009 +%% A request was received that included an AVP whose flag bits are +%% set to an unrecognized value, or that is inconsistent with the +%% AVP's definition. +%% +recv_request(T, {TPid, _}, _, #diameter_packet{errors = [Bs | _]} = Pkt) + when is_bitstring(Bs) -> + protocol_error(3009, T, TPid, Pkt); + +%% Either we support this application but don't recognize the command +%% or we're a relay and the command isn't proxiable. +%% +%% DIAMETER_COMMAND_UNSUPPORTED 3001 +%% The Request contained a Command-Code that the receiver did not +%% recognize or support. This MUST be used when a Diameter node +%% receives an experimental command that it does not understand. +%% +recv_request(T, + {TPid, _}, + #diameter_app{id = Id}, + #diameter_packet{header = #diameter_header{is_proxiable = P}, + msg = M} + = Pkt) + when ?APP_ID_RELAY /= Id, undefined == M; + ?APP_ID_RELAY == Id, not P -> + protocol_error(3001, T, TPid, Pkt); + +%% Error bit was set on a request. +%% +%% DIAMETER_INVALID_HDR_BITS 3008 +%% A request was received whose bits in the Diameter header were +%% either set to an invalid combination, or to a value that is +%% inconsistent with the command code's definition. +%% +recv_request(T, + {TPid, _}, + _, + #diameter_packet{header = #diameter_header{is_error = true}} + = Pkt) -> + protocol_error(3008, T, TPid, Pkt); + +%% A message in a locally supported application or a proxiable message +%% in the relay application. Don't distinguish between the two since +%% each application has its own callback config. That is, the user can +%% easily distinguish between the two cases. +recv_request(T, TC, App, Pkt) -> + request_cb(T, TC, App, examine(Pkt)). + +%% Note that there may still be errors but these aren't protocol +%% (3xxx) errors that lead to an answer-message. + +request_cb({SvcName, _OH, _OR} = T, TC, App, Pkt) -> + request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), App, T, TC, Pkt). + +%% examine/1 +%% +%% Look for errors in a decoded message. Length errors result in +%% decode failure in diameter_codec. + +examine(#diameter_packet{header = #diameter_header{version + = ?DIAMETER_VERSION}} + = Pkt) -> + Pkt; + +%% DIAMETER_UNSUPPORTED_VERSION 5011 +%% This error is returned when a request was received, whose version +%% number is unsupported. + +examine(#diameter_packet{errors = Es} = Pkt) -> + Pkt#diameter_packet{errors = [5011 | Es]}. +%% It's odd/unfortunate that this isn't a protocol error. + +%% request_cb/5 + +%% A reply may be an answer-message, constructed either here or by +%% the handle_request callback. The header from the incoming request +%% is passed into the encode so that it can retrieve the relevant +%% command code in this case. It will also then ignore Dict and use +%% the base encoder. +request_cb({reply, Ans}, + #diameter_app{dictionary = Dict}, + _, + {TPid, _}, + Pkt) -> + reply(Ans, Dict, TPid, Pkt); + +%% An 3xxx result code, for which the E-bit is set in the header. +request_cb({protocol_error, RC}, _, T, {TPid, _}, Pkt) + when 3000 =< RC, RC < 4000 -> + protocol_error(RC, T, TPid, Pkt); + +%% RFC 3588 says we must reply 3001 to anything unrecognized or +%% unsupported. 'noreply' is undocumented (and inappropriately named) +%% backwards compatibility for this, protocol_error the documented +%% alternative. +request_cb(noreply, _, T, {TPid, _}, Pkt) -> + protocol_error(3001, T, TPid, Pkt); + +%% Relay a request to another peer. This is equivalent to doing an +%% explicit call/4 with the message in question except that (1) a loop +%% will be detected by examining Route-Record AVP's, (3) a +%% Route-Record AVP will be added to the outgoing request and (3) the +%% End-to-End Identifier will default to that in the +%% #diameter_header{} without the need for an end_to_end_identifier +%% option. +%% +%% relay and proxy are similar in that they require the same handling +%% with respect to Route-Record and End-to-End identifier. The +%% difference is that a proxy advertises specific applications, while +%% a relay advertises the relay application. If a callback doesn't +%% want to distinguish between the cases in the callback return value +%% then 'resend' is a neutral alternative. +%% +request_cb({A, Opts}, + #diameter_app{id = Id} + = App, + T, + TC, + Pkt) + when A == relay, Id == ?APP_ID_RELAY; + A == proxy, Id /= ?APP_ID_RELAY; + A == resend -> + resend(Opts, App, T, TC, Pkt); + +request_cb(discard, _, _, _, _) -> + ok; + +request_cb({eval, RC, F}, App, T, TC, Pkt) -> + request_cb(RC, App, T, TC, Pkt), + diameter_lib:eval(F). + +%% protocol_error/4 + +protocol_error(RC, {_, OH, OR}, TPid, #diameter_packet{avps = Avps} = Pkt) -> + ?LOG({error, RC}, Pkt), + reply(answer_message({OH, OR, RC}, Avps), ?BASE, TPid, Pkt). + +%% resend/5 +%% +%% Resend a message as a relay or proxy agent. + +resend(Opts, + #diameter_app{} = App, + {_SvcName, OH, _OR} = T, + {_TPid, _Caps} = TC, + #diameter_packet{avps = Avps} = Pkt) -> + {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'), + resend(is_loop(Code, Vid, OH, Avps), Opts, App, T, TC, Pkt). + +%% DIAMETER_LOOP_DETECTED 3005 +%% An agent detected a loop while trying to get the message to the +%% intended recipient. The message MAY be sent to an alternate peer, +%% if one is available, but the peer reporting the error has +%% identified a configuration problem. + +resend(true, _, _, T, {TPid, _}, Pkt) -> %% Route-Record loop + protocol_error(3005, T, TPid, Pkt); + +%% 6.1.8. Relaying and Proxying Requests +%% +%% A relay or proxy agent MUST append a Route-Record AVP to all requests +%% forwarded. The AVP contains the identity of the peer the request was +%% received from. + +resend(false, + Opts, + App, + {SvcName, _, _} = T, + {TPid, #diameter_caps{origin_host = {_, OH}}}, + #diameter_packet{header = Hdr0, + avps = Avps} + = Pkt) -> + Route = #diameter_avp{data = {?BASE, 'Route-Record', OH}}, + Seq = diameter_session:sequence(), + Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, + Msg = [Hdr, Route | Avps], + resend(call(SvcName, App, Msg, Opts), T, TPid, Pkt). +%% The incoming request is relayed with the addition of a +%% Route-Record. Note the requirement on the return from call/4 below, +%% which places a requirement on the value returned by the +%% handle_answer callback of the application module in question. +%% +%% Note that there's nothing stopping the request from being relayed +%% back to the sender. A pick_peer callback may want to avoid this but +%% a smart peer might recognize the potential loop and choose another +%% route. A less smart one will probably just relay the request back +%% again and force us to detect the loop. A pick_peer that wants to +%% avoid this can specify filter to avoid the possibility. +%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. +%% +%% RFC 6.3 says that a relay agent does not modify Origin-Host but +%% says nothing about a proxy. Assume it should behave the same way. + +%% resend/4 +%% +%% Relay a reply to a relayed request. + +%% Answer from the peer: reset the hop by hop identifier and send. +resend(#diameter_packet{bin = B} + = Pkt, + _, + TPid, + #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, + transport_data = TD}) -> + send(TPid, Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), + transport_data = TD}); +%% TODO: counters + +%% Or not: DIAMETER_UNABLE_TO_DELIVER. +resend(_, T, TPid, Pkt) -> + protocol_error(3002, T, TPid, Pkt). + +%% is_loop/4 +%% +%% Is there a Route-Record AVP with our Origin-Host? + +is_loop(Code, + Vid, + Bin, + [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> + true; + +is_loop(_, _, _, []) -> + false; + +is_loop(Code, Vid, OH, [_ | Avps]) + when is_binary(OH) -> + is_loop(Code, Vid, OH, Avps); + +is_loop(Code, Vid, OH, Avps) -> + is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps). + +%% reply/4 +%% +%% Send a locally originating reply. + +%% No errors or a diameter_header/avp list. +reply(Msg, Dict, TPid, #diameter_packet{errors = Es, + transport_data = TD} + = ReqPkt) + when [] == Es; + is_record(hd(Msg), diameter_header) -> + Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)), + incr(send, Pkt, Dict, TPid), %% count result codes in sent answers + send(TPid, Pkt#diameter_packet{transport_data = TD}); + +%% Or not: set Result-Code and Failed-AVP AVP's. +reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) -> + reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), + Dict, + TPid, + Pkt#diameter_packet{errors = []}). + +%% make_reply_packet/2 + +%% Binaries and header/avp lists are sent as-is. +make_reply_packet(Bin, _) + when is_binary(Bin) -> + #diameter_packet{bin = Bin}; +make_reply_packet([#diameter_header{} | _] = Msg, _) -> + #diameter_packet{msg = Msg}; + +%% Otherwise a reply message clears the R and T flags and retains the +%% P flag. The E flag will be set at encode. +make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) -> + Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, + is_request = false, + is_error = undefined, + is_retransmitted = false}, + #diameter_packet{header = Hdr, + msg = Msg}. + +%% rc/1 + +rc({RC, _}) -> + RC; +rc(RC) -> + RC. + +%% rc/4 + +rc(Rec, RC, Failed, Dict) + when is_integer(RC) -> + set(Rec, [{'Result-Code', RC} | failed_avp(Rec, Failed, Dict)], Dict). + +%% Reply as name and tuple list ... +set([_|_] = Ans, Avps, _) -> + Ans ++ Avps; %% Values nearer tail take precedence. + +%% ... or record. +set(Rec, Avps, Dict) -> + Dict:'#set-'(Avps, Rec). + +%% failed_avp/3 + +failed_avp(_, [] = No, _) -> + No; + +failed_avp(Rec, Failed, Dict) -> + [fa(Rec, [{'AVP', Failed}], Dict)]. + +%% Reply as name and tuple list ... +fa([MsgName | Values], FailedAvp, Dict) -> + R = Dict:msg2rec(MsgName), + try + Dict:'#info-'(R, {index, 'Failed-AVP'}), + {'Failed-AVP', [FailedAvp]} + catch + error: _ -> + Avps = proplists:get_value('AVP', Values, []), + A = #diameter_avp{name = 'Failed-AVP', + value = FailedAvp}, + {'AVP', [A|Avps]} + end; + +%% ... or record. +fa(Rec, FailedAvp, Dict) -> + try + {'Failed-AVP', [FailedAvp]} + catch + error: _ -> + Avps = Dict:'get-'('AVP', Rec), + A = #diameter_avp{name = 'Failed-AVP', + value = FailedAvp}, + {'AVP', [A|Avps]} + end. + +%% 3. Diameter Header +%% +%% E(rror) - If set, the message contains a protocol error, +%% and the message will not conform to the ABNF +%% described for this command. Messages with the 'E' +%% bit set are commonly referred to as error +%% messages. This bit MUST NOT be set in request +%% messages. See Section 7.2. + +%% 3.2. Command Code ABNF specification +%% +%% e-bit = ", ERR" +%% ; If present, the 'E' bit in the Command +%% ; Flags is set, indicating that the answer +%% ; message contains a Result-Code AVP in +%% ; the "protocol error" class. + +%% 7.1.3. Protocol Errors +%% +%% Errors that fall within the Protocol Error category SHOULD be treated +%% on a per-hop basis, and Diameter proxies MAY attempt to correct the +%% error, if it is possible. Note that these and only these errors MUST +%% only be used in answer messages whose 'E' bit is set. + +%% Thus, only construct answers to protocol errors. Other errors +%% require an message-specific answer and must be handled by the +%% application. + +%% 6.2. Diameter Answer Processing +%% +%% When a request is locally processed, the following procedures MUST be +%% applied to create the associated answer, in addition to any +%% additional procedures that MAY be discussed in the Diameter +%% application defining the command: +%% +%% - The same Hop-by-Hop identifier in the request is used in the +%% answer. +%% +%% - The local host's identity is encoded in the Origin-Host AVP. +%% +%% - The Destination-Host and Destination-Realm AVPs MUST NOT be +%% present in the answer message. +%% +%% - The Result-Code AVP is added with its value indicating success or +%% failure. +%% +%% - If the Session-Id is present in the request, it MUST be included +%% in the answer. +%% +%% - Any Proxy-Info AVPs in the request MUST be added to the answer +%% message, in the same order they were present in the request. +%% +%% - The 'P' bit is set to the same value as the one in the request. +%% +%% - The same End-to-End identifier in the request is used in the +%% answer. +%% +%% Note that the error messages (see Section 7.3) are also subjected to +%% the above processing rules. + +%% 7.3. Error-Message AVP +%% +%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY +%% accompany a Result-Code AVP as a human readable error message. The +%% Error-Message AVP is not intended to be useful in real-time, and +%% SHOULD NOT be expected to be parsed by network entities. + +%% answer_message/2 + +answer_message({OH, OR, RC}, Avps) -> + {Code, _, Vid} = ?BASE:avp_header('Session-Id'), + ['answer-message', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Result-Code', RC} + | session_id(Code, Vid, Avps)]. + +session_id(Code, Vid, Avps) + when is_list(Avps) -> + try + {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), + [{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}] + catch + error: _ -> + [] + end. + +%% find_avp/3 + +find_avp(Code, Vid, Avps) + when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> + find(fun(A) -> is_avp(Code, Vid, A) end, Avps). + +%% The final argument here could be a list of AVP's, depending on the case, +%% but we're only searching at the top level. +is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> + true; +is_avp(_, _, _) -> + false. + +find(_, []) -> + false; +find(Pred, [H|T]) -> + case Pred(H) of + true -> + {value, H}; + false -> + find(Pred, T) + end. + +%% 7. Error Handling +%% +%% There are certain Result-Code AVP application errors that require +%% additional AVPs to be present in the answer. In these cases, the +%% Diameter node that sets the Result-Code AVP to indicate the error +%% MUST add the AVPs. Examples are: +%% +%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) +%% set, causes an answer to be sent with the Result-Code AVP set to +%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the +%% offending AVP. +%% +%% - An AVP that is received with an unrecognized value causes an +%% answer to be returned with the Result-Code AVP set to +%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the +%% AVP causing the error. +%% +%% - A command is received with an AVP that is omitted, yet is +%% mandatory according to the command's ABNF. The receiver issues an +%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and +%% creates an AVP with the AVP Code and other fields set as expected +%% in the missing AVP. The created AVP is then added to the Failed- +%% AVP AVP. +%% +%% The Result-Code AVP describes the error that the Diameter node +%% encountered in its processing. In case there are multiple errors, +%% the Diameter node MUST report only the first error it encountered +%% (detected possibly in some implementation dependent order). The +%% specific errors that can be described by this AVP are described in +%% the following section. + +%% 7.5. Failed-AVP AVP +%% +%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides +%% debugging information in cases where a request is rejected or not +%% fully processed due to erroneous information in a specific AVP. The +%% value of the Result-Code AVP will provide information on the reason +%% for the Failed-AVP AVP. +%% +%% The possible reasons for this AVP are the presence of an improperly +%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP +%% value, the omission of a required AVP, the presence of an explicitly +%% excluded AVP (see tables in Section 10), or the presence of two or +%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 +%% occurrences. +%% +%% A Diameter message MAY contain one Failed-AVP AVP, containing the +%% entire AVP that could not be processed successfully. If the failure +%% reason is omission of a required AVP, an AVP with the missing AVP +%% code, the missing vendor id, and a zero filled payload of the minimum +%% required length for the omitted AVP will be added. + +%%% --------------------------------------------------------------------------- +%%% # handle_answer/3 +%%% --------------------------------------------------------------------------- + +%% Process an answer message in call-specific process. + +handle_answer(SvcName, _, {error, Req, Reason}) -> + handle_error(Req, Reason, SvcName); + +handle_answer(SvcName, + AnswerErrors, + {answer, #request{dictionary = Dict} = Req, Pkt}) -> + a(examine(diameter_codec:decode(Dict, Pkt)), + SvcName, + AnswerErrors, + Req). + +%% We don't really need to do a full decode if we're a relay and will +%% just resend with a new hop by hop identifier, but might a proxy +%% want to examine the answer? + +a(#diameter_packet{errors = []} + = Pkt, + SvcName, + AE, + #request{transport = TPid, + dictionary = Dict, + caps = Caps, + packet = P} + = Req) -> + try + incr(in, Pkt, Dict, TPid) + of + _ -> + cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]) + catch + exit: {invalid_error_bit, _} = E -> + e(Pkt#diameter_packet{errors = [E]}, SvcName, AE, Req) + end; + +a(#diameter_packet{} = Pkt, SvcName, AE, Req) -> + e(Pkt, SvcName, AE, Req). + +e(Pkt, SvcName, callback, #request{transport = TPid, + caps = Caps, + packet = Pkt} + = Req) -> + cb(Req, handle_answer, [Pkt, msg(Pkt), SvcName, {TPid, Caps}]); +e(Pkt, SvcName, report, Req) -> + x(errors, handle_answer, [SvcName, Req, Pkt]); +e(Pkt, SvcName, discard, Req) -> + x({errors, handle_answer, [SvcName, Req, Pkt]}). + +%% Note that we don't check that the application id in the answer's +%% header is what we expect. (TODO: Does the rfc says anything about +%% this?) + +%% incr/4 +%% +%% Increment a stats counter for an incoming or outgoing message. + +%% TODO: fix +incr(_, #diameter_packet{msg = undefined}, _, _) -> + ok; + +incr(Dir, Pkt, Dict, TPid) + when is_pid(TPid) -> + #diameter_packet{header = #diameter_header{is_error = E} + = Hdr, + msg = Rec} + = Pkt, + + D = choose(E, ?BASE, Dict), + RC = int(get_avp_value(D, 'Result-Code', Rec)), + PE = is_protocol_error(RC), + + %% Check that the E bit is set only for 3xxx result codes. + (not (E orelse PE)) + orelse (E andalso PE) + orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), + + Ctr = rc_counter(D, Rec, RC), + is_tuple(Ctr) + andalso incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). + +%% incr/2 + +incr(TPid, Counter) -> + diameter_stats:incr(Counter, TPid, 1). + +%% RFC 3588, 7.6: +%% +%% All Diameter answer messages defined in vendor-specific +%% applications MUST include either one Result-Code AVP or one +%% Experimental-Result AVP. +%% +%% Maintain statistics assuming one or the other, not both, which is +%% surely the intent of the RFC. + +rc_counter(_, _, RC) + when is_integer(RC) -> + {'Result-Code', RC}; +rc_counter(D, Rec, _) -> + rcc(get_avp_value(D, 'Experimental-Result', Rec)). + +%% Outgoing answers may be in any of the forms messages can be sent +%% in. Incoming messages will be records. We're assuming here that the +%% arity of the result code AVP's is 0 or 1. + +rcc([{_,_,RC} = T]) + when is_integer(RC) -> + T; +rcc({_,_,RC} = T) + when is_integer(RC) -> + T; +rcc(_) -> + undefined. + +int([N]) + when is_integer(N) -> + N; +int(N) + when is_integer(N) -> + N; +int(_) -> + undefined. + +is_protocol_error(RC) -> + 3000 =< RC andalso RC < 4000. + +-spec x(any(), atom(), list()) -> no_return(). + +%% Warn and exit request process on errors in an incoming answer. +x(Reason, F, A) -> + diameter_lib:warning_report(Reason, {?MODULE, F, A}), + x(Reason). + +x(T) -> + exit(T). + +%%% --------------------------------------------------------------------------- +%%% # failover/[23] +%%% --------------------------------------------------------------------------- + +%% Failover as a consequence of request_peer_down/2. +failover({_, #request{handler = Pid} = Req, TRef}, S) -> + Pid ! {failover, TRef, rt(Req, S)}. + +%% Failover as a consequence of store_request/4. +failover(TRef, Seqs, S) + when is_reference(TRef) -> + case lookup_request(Seqs, TRef) of + #request{} = Req -> + failover({Seqs, Req, TRef}, S); + false -> + ok + end. + +%% prepare_request returned a binary ... +rt(#request{packet = #diameter_packet{msg = undefined}}, _) -> + false; %% TODO: Not what we should do. + +%% ... or not. +rt(#request{packet = #diameter_packet{msg = Msg}, dictionary = D} = Req, S) -> + find_transport(get_destination(Msg, D), Req, S). + +%%% --------------------------------------------------------------------------- +%%% # report_status/5 +%%% --------------------------------------------------------------------------- + +report_status(Status, + #peer{ref = Ref, + conn = TPid, + type = Type, + options = Opts}, + #conn{apps = [_|_] = As, + caps = Caps}, + #state{service_name = SvcName} + = S, + Extra) -> + share_peer(Status, Caps, As, TPid, S), + Info = [Status, Ref, {TPid, Caps}, {type(Type), Opts} | Extra], + send_event(SvcName, list_to_tuple(Info)). + +%% send_event/2 + +send_event(SvcName, Info) -> + send_event(#diameter_event{service = SvcName, + info = Info}). + +send_event(#diameter_event{service = SvcName} = E) -> + lists:foreach(fun({_, Pid}) -> Pid ! E end, subscriptions(SvcName)). + +%%% --------------------------------------------------------------------------- +%%% # share_peer/5 +%%% --------------------------------------------------------------------------- + +share_peer(up, Caps, Aliases, TPid, #state{share_peers = true, + service_name = Svc}) -> + diameter_peer:notify(Svc, {peer, TPid, Aliases, Caps}); + +share_peer(_, _, _, _, _) -> + ok. + +%%% --------------------------------------------------------------------------- +%%% # share_peers/2 +%%% --------------------------------------------------------------------------- + +share_peers(Pid, #state{share_peers = true, + local_peers = PDict}) -> + ?Dict:fold(fun(A,Ps,ok) -> sp(Pid, A, Ps), ok end, ok, PDict); + +share_peers(_, #state{share_peers = false}) -> + ok. + +sp(Pid, Alias, Peers) -> + lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers). + +%%% --------------------------------------------------------------------------- +%%% # remote_peer_up/4 +%%% --------------------------------------------------------------------------- + +remote_peer_up(Pid, Aliases, Caps, #state{use_shared_peers = true, + service = Svc, + shared_peers = PDict} + = S) -> + #diameter_service{applications = Apps} = Svc, + Update = lists:filter(fun(A) -> + lists:keymember(A, #diameter_app.alias, Apps) + end, + Aliases), + S#state{shared_peers = rpu(Pid, Caps, PDict, Update)}; + +remote_peer_up(_, _, _, #state{use_shared_peers = false} = S) -> + S. + +rpu(_, _, PDict, []) -> + PDict; +rpu(Pid, Caps, PDict, Aliases) -> + erlang:monitor(process, Pid), + T = {Pid, Caps}, + lists:foldl(fun(A,D) -> ?Dict:append(A, T, D) end, + PDict, + Aliases). + +%%% --------------------------------------------------------------------------- +%%% # remote_peer_down/2 +%%% --------------------------------------------------------------------------- + +remote_peer_down(Pid, #state{use_shared_peers = true, + shared_peers = PDict} + = S) -> + S#state{shared_peers = lists:foldl(fun(A,D) -> rpd(Pid, A, D) end, + PDict, + ?Dict:fetch_keys(PDict))}. + +rpd(Pid, Alias, PDict) -> + ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict). + +%%% --------------------------------------------------------------------------- +%%% find_transport/[34] +%%% +%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}} +%%% | false +%%% | {error, Reason} +%%% --------------------------------------------------------------------------- + +%% Initial call, from an arbitrary process. +find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) -> + #diameter_service{applications = Apps} = Svc, + ft(find_send_app(Alias, Apps), Msg, Opts, S); + +%% Relay or proxy send. +find_transport(#diameter_app{} = App, Msg, Opts, S) -> + ft(App, Msg, Opts, S). + +ft(#diameter_app{module = Mod, dictionary = D} = App, Msg, Opts, S) -> + #options{filter = Filter, + extra = Xtra} + = Opts, + pick_peer(App#diameter_app{module = Mod ++ Xtra}, + get_destination(Msg, D), + Filter, + S); +ft(false = No, _, _, _) -> + No. + +%% This can't be used if we're a relay and sending a message +%% in an application not known locally. (TODO) +find_send_app(Alias, Apps) -> + case lists:keyfind(Alias, #diameter_app.alias, Apps) of + #diameter_app{id = ?APP_ID_RELAY} -> + false; + T -> + T + end. + +%% Retransmission, in the service process. +find_transport([_,_] = RH, + Req, + #state{service = #diameter_service{pid = Pid, + applications = Apps}} + = S) + when self() == Pid -> + #request{app = Alias, + filter = Filter, + module = ModX} + = Req, + #diameter_app{} + = App + = lists:keyfind(Alias, #diameter_app.alias, Apps), + + pick_peer(App#diameter_app{module = ModX}, + RH, + Filter, + S). + +%% get_destination/2 + +get_destination(Msg, Dict) -> + [str(get_avp_value(Dict, 'Destination-Realm', Msg)), + str(get_avp_value(Dict, 'Destination-Host', Msg))]. + +%% This is not entirely correct. The avp could have an arity 1, in +%% which case an empty list is a DiameterIdentity of length 0 rather +%% than the list of no values we treat it as by mapping to undefined. +%% This behaviour is documented. +str([]) -> + undefined; +str(T) -> + T. + +%% get_avp_value/3 +%% +%% Find an AVP in a message of one of three forms: +%% +%% - a message record (as generated from a .dia spec) or +%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. +%% - a list of a #diameter_header{} followed by #diameter_avp{} records, +%% +%% In the first two forms a dictionary module is used at encode to +%% identify the type of the AVP and its arity in the message in +%% question. The third form allows messages to be sent as is, without +%% a dictionary, which is needed in the case of relay agents, for one. + +get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> + try + {Code, _, VId} = Dict:avp_header(Name), + [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> + C /= Code orelse V /= VId + end, + Avps), + avp_decode(Dict, Name, A) + catch + error: _ -> + undefined + end; + +get_avp_value(_, Name, [_MsgName | Avps]) -> + case lists:keyfind(Name, 1, Avps) of + {_, V} -> + V; + _ -> + undefined + end; + +%% Message is typically a record but not necessarily: diameter:call/4 +%% can be passed an arbitrary term. +get_avp_value(Dict, Name, Rec) -> + try + Dict:'#get-'(Name, Rec) + catch + error:_ -> + undefined + end. + +avp_decode(Dict, Name, #diameter_avp{value = undefined, + data = Bin}) -> + Dict:avp(decode, Bin, Name); +avp_decode(_, _, #diameter_avp{value = V}) -> + V. + +%%% --------------------------------------------------------------------------- +%%% # pick_peer(App, [DestRealm, DestHost], Filter, #state{}) +%%% +%%% Output: {TransportPid, #diameter_caps{}, App} +%%% | false +%%% | {error, Reason} +%%% --------------------------------------------------------------------------- + +%% Find transports to a given realm/host. + +pick_peer(#diameter_app{alias = Alias} + = App, + [_,_] = RH, + Filter, + #state{local_peers = L, + shared_peers = S, + service_name = SvcName, + service = #diameter_service{pid = Pid}}) -> + pick_peer(peers(Alias, RH, Filter, L), + peers(Alias, RH, Filter, S), + Pid, + SvcName, + App). + +%% pick_peer/5 + +pick_peer([], [], _, _, _) -> + false; + +%% App state is mutable but we're not in the service process: go there. +pick_peer(Local, Remote, Pid, _SvcName, #diameter_app{mutable = true} = App) + when self() /= Pid -> + call_service(Pid, {pick_peer, Local, Remote, App}); + +%% App state isn't mutable or it is and we're in the service process: +%% do the deed. +pick_peer(Local, + Remote, + _Pid, + SvcName, + #diameter_app{module = ModX, + alias = Alias, + init_state = S, + mutable = M} + = App) -> + MFA = {ModX, pick_peer, [Local, Remote, SvcName]}, + + try state_cb(App, MFA) of + {ok, {TPid, #diameter_caps{} = Caps}} when is_pid(TPid) -> + {TPid, Caps, App}; + {{TPid, #diameter_caps{} = Caps}, ModS} when is_pid(TPid), M -> + mod_state(Alias, ModS), + {TPid, Caps, App}; + {false = No, ModS} when M -> + mod_state(Alias, ModS), + No; + {ok, false = No} -> + No; + false = No -> + No; + {{TPid, #diameter_caps{} = Caps}, S} when is_pid(TPid) -> + {TPid, Caps, App}; %% Accept returned state in the immutable + {false = No, S} -> %% case as long it isn't changed. + No; + T -> + diameter_lib:error_report({invalid, T, App}, MFA) + catch + E: Reason -> + diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA) + end. + +%% peers/4 + +peers(Alias, RH, Filter, Peers) -> + case ?Dict:find(Alias, Peers) of + {ok, L} -> + ps(L, RH, Filter, {[],[]}); + error -> + [] + end. + +%% Place a peer whose Destination-Host/Realm matches those of the +%% request at the front of the result list. Could add some sort of +%% 'sort' option to allow more control. + +ps([], _, _, {Ys, Ns}) -> + lists:reverse(Ys, Ns); +ps([{_TPid, #diameter_caps{} = Caps} = TC | Rest], RH, Filter, Acc) -> + ps(Rest, RH, Filter, pacc(caps_filter(Caps, RH, Filter), + caps_filter(Caps, RH, {all, [host, realm]}), + TC, + Acc)). + +pacc(true, true, Peer, {Ts, Fs}) -> + {[Peer|Ts], Fs}; +pacc(true, false, Peer, {Ts, Fs}) -> + {Ts, [Peer|Fs]}; +pacc(_, _, _, Acc) -> + Acc. + +%% caps_filter/3 + +caps_filter(C, RH, {neg, F}) -> + not caps_filter(C, RH, F); + +caps_filter(C, RH, {all, L}) + when is_list(L) -> + lists:all(fun(F) -> caps_filter(C, RH, F) end, L); + +caps_filter(C, RH, {any, L}) + when is_list(L) -> + lists:any(fun(F) -> caps_filter(C, RH, F) end, L); + +caps_filter(#diameter_caps{origin_host = {_,OH}}, [_,DH], host) -> + eq(undefined, DH, OH); + +caps_filter(#diameter_caps{origin_realm = {_,OR}}, [DR,_], realm) -> + eq(undefined, DR, OR); + +caps_filter(C, _, Filter) -> + caps_filter(C, Filter). + +%% caps_filter/2 + +caps_filter(_, none) -> + true; + +caps_filter(#diameter_caps{origin_host = {_,OH}}, {host, H}) -> + eq(any, H, OH); + +caps_filter(#diameter_caps{origin_realm = {_,OR}}, {realm, R}) -> + eq(any, R, OR); + +%% Anything else is expected to be an eval filter. Filter failure is +%% documented as being equivalent to a non-matching filter. + +caps_filter(C, T) -> + try + {eval, F} = T, + diameter_lib:eval([F,C]) + catch + _:_ -> false + end. + +eq(Any, Id, PeerId) -> + Any == Id orelse try + iolist_to_binary(Id) == iolist_to_binary(PeerId) + catch + _:_ -> false + end. +%% OctetString() can be specified as an iolist() so test for string +%% rather then term equality. + +%% transports/1 + +transports(#state{peerT = PeerT}) -> + ets:select(PeerT, [{#peer{conn = '$1', _ = '_'}, + [{'is_pid', '$1'}], + ['$1']}]). + +%%% --------------------------------------------------------------------------- +%%% # service_info/2 +%%% --------------------------------------------------------------------------- + +%% The config passed to diameter:start_service/2. +-define(CAP_INFO, ['Origin-Host', + 'Origin-Realm', + 'Vendor-Id', + 'Product-Name', + 'Origin-State-Id', + 'Host-IP-Address', + 'Supported-Vendor-Id', + 'Auth-Application-Id', + 'Inband-Security-Id', + 'Acct-Application-Id', + 'Vendor-Specific-Application-Id', + 'Firmware-Revision']). + +-define(ALL_INFO, [capabilities, + applications, + transport, + pending, + statistics]). + +service_info(Items, S) + when is_list(Items) -> + [{complete(I), service_info(I,S)} || I <- Items]; +service_info(Item, S) + when is_atom(Item) -> + service_info(Item, S, true). + +service_info(Item, #state{service = Svc} = S, Complete) -> + case Item of + name -> + S#state.service_name; + 'Origin-Host' -> + (Svc#diameter_service.capabilities) + #diameter_caps.origin_host; + 'Origin-Realm' -> + (Svc#diameter_service.capabilities) + #diameter_caps.origin_realm; + 'Vendor-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.vendor_id; + 'Product-Name' -> + (Svc#diameter_service.capabilities) + #diameter_caps.product_name; + 'Origin-State-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.origin_state_id; + 'Host-IP-Address' -> + (Svc#diameter_service.capabilities) + #diameter_caps.host_ip_address; + 'Supported-Vendor-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.supported_vendor_id; + 'Auth-Application-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.auth_application_id; + 'Inband-Security-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.inband_security_id; + 'Acct-Application-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.acct_application_id; + 'Vendor-Specific-Application-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.vendor_specific_application_id; + 'Firmware-Revision' -> + (Svc#diameter_service.capabilities) + #diameter_caps.firmware_revision; + capabilities -> service_info(?CAP_INFO, S); + applications -> info_apps(S); + transport -> info_transport(S); + pending -> info_pending(S); + statistics -> info_stats(S); + keys -> ?ALL_INFO ++ ?CAP_INFO; %% mostly for test + all -> service_info(?ALL_INFO, S); + _ when Complete -> service_info(complete(Item), S, false); + _ -> undefined + end. + +complete(Pre) -> + P = atom_to_list(Pre), + case [I || I <- [name | ?ALL_INFO] ++ ?CAP_INFO, + lists:prefix(P, atom_to_list(I))] + of + [I] -> I; + _ -> Pre + end. + +info_stats(#state{peerT = PeerT}) -> + Peers = ets:select(PeerT, [{#peer{ref = '$1', conn = '$2', _ = '_'}, + [{'is_pid', '$2'}], + [['$1', '$2']]}]), + diameter_stats:read(lists:append(Peers)). +%% TODO: include peer identities in return value + +info_transport(#state{peerT = PeerT, connT = ConnT}) -> + dict:fold(fun it/3, + [], + ets:foldl(fun(T,A) -> it_acc(ConnT, A, T) end, + dict:new(), + PeerT)). + +it(Ref, [[{type, connect} | _] = L], Acc) -> + [[{ref, Ref} | L] | Acc]; +it(Ref, [[{type, accept}, {options, Opts} | _] | _] = L, Acc) -> + [[{ref, Ref}, + {type, listen}, + {options, Opts}, + {accept, [lists:nthtail(2,A) || A <- L]}] + | Acc]. +%% Each entry has the same Opts. (TODO) + +it_acc(ConnT, Acc, #peer{pid = Pid, + type = Type, + ref = Ref, + options = Opts, + op_state = OS, + started = T, + conn = TPid}) -> + dict:append(Ref, + [{type, Type}, + {options, Opts}, + {watchdog, {Pid, T, OS}} + | info_conn(ConnT, TPid)], + Acc). + +info_conn(ConnT, TPid) -> + info_conn(ets:lookup(ConnT, TPid)). + +info_conn([#conn{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> + [{peer, {Pid, T}}, + {apps, SApps}, + {caps, info_caps(Caps)}]; +info_conn([] = No) -> + No. + +info_caps(#diameter_caps{} = C) -> + lists:zip(record_info(fields, diameter_caps), tl(tuple_to_list(C))). + +info_apps(#state{service = #diameter_service{applications = Apps}}) -> + lists:map(fun mk_app/1, Apps). + +mk_app(#diameter_app{alias = Alias, + dictionary = Dict, + module = ModX, + id = Id}) -> + [{alias, Alias}, + {dictionary, Dict}, + {module, ModX}, + {id, Id}]. + +info_pending(#state{} = S) -> + MatchSpec = [{{'$1', + #request{transport = '$2', + from = '$3', + app = '$4', + _ = '_'}, + '_'}, + [?ORCOND([{'==', T, '$2'} || T <- transports(S)])], + [{{'$1', [{{app, '$4'}}, + {{transport, '$2'}}, + {{from, '$3'}}]}}]}], + + ets:select(?REQUEST_TABLE, MatchSpec). diff --git a/lib/diameter/src/base/diameter_service_sup.erl b/lib/diameter/src/base/diameter_service_sup.erl new file mode 100644 index 0000000000..153fff902f --- /dev/null +++ b/lib/diameter/src/base/diameter_service_sup.erl @@ -0,0 +1,64 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% The supervisor of service processes. +%% + +-module(diameter_service_sup). + +-behaviour(supervisor). + +-export([start_link/0, %% supervisor start + start_child/1]). %% service start + +%% supervisor callback +-export([init/1]). + +-define(NAME, ?MODULE). %% supervisor name + +%% start_link/0 + +start_link() -> + SupName = {local, ?NAME}, + supervisor:start_link(SupName, ?MODULE, []). + +%% start_child/1 +%% +%% A service and its related processes (transport, peer_fwm and +%% watchdog) are all temporary since they're all restarted in +%% application code. A Transport and peer_fsm is restarted by a +%% watchdog as required by the RFC 3539 state machine, a watchdog is +%% restarted by service, and services are restarted by diameter_config. + +start_child(ServiceName) -> + supervisor:start_child(?NAME, [ServiceName]). + +%% init/1 + +init([]) -> + Mod = diameter_service, + Flags = {simple_one_for_one, 0, 1}, + ChildSpec = {Mod, + {Mod, start_link, []}, + temporary, + 1000, + worker, + [Mod]}, + {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/base/diameter_session.erl b/lib/diameter/src/base/diameter_session.erl new file mode 100644 index 0000000000..bb91e97f39 --- /dev/null +++ b/lib/diameter/src/base/diameter_session.erl @@ -0,0 +1,172 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_session). + +-export([sequence/0, + session_id/1, + origin_state_id/0]). + +%% towards diameter_sup +-export([init/0]). + +-include("diameter_types.hrl"). + +-define(INT64, 16#FFFFFFFFFFFFFFFF). +-define(INT32, 16#FFFFFFFF). + +%% --------------------------------------------------------------------------- +%% # sequence/0 +%% +%% Output: 32-bit +%% --------------------------------------------------------------------------- + +%% 3588, 3: +%% +%% Hop-by-Hop Identifier +%% The Hop-by-Hop Identifier is an unsigned 32-bit integer field (in +%% network byte order) and aids in matching requests and replies. +%% The sender MUST ensure that the Hop-by-Hop identifier in a request +%% is unique on a given connection at any given time, and MAY attempt +%% to ensure that the number is unique across reboots. The sender of +%% an Answer message MUST ensure that the Hop-by-Hop Identifier field +%% contains the same value that was found in the corresponding +%% request. The Hop-by-Hop identifier is normally a monotonically +%% increasing number, whose start value was randomly generated. An +%% answer message that is received with an unknown Hop-by-Hop +%% Identifier MUST be discarded. +%% +%% End-to-End Identifier +%% The End-to-End Identifier is an unsigned 32-bit integer field (in +%% network byte order) and is used to detect duplicate messages. +%% Upon reboot implementations MAY set the high order 12 bits to +%% contain the low order 12 bits of current time, and the low order +%% 20 bits to a random value. Senders of request messages MUST +%% insert a unique identifier on each message. The identifier MUST +%% remain locally unique for a period of at least 4 minutes, even +%% across reboots. The originator of an Answer message MUST ensure +%% that the End-to-End Identifier field contains the same value that +%% was found in the corresponding request. The End-to-End Identifier +%% MUST NOT be modified by Diameter agents of any kind. The +%% combination of the Origin-Host (see Section 6.3) and this field is +%% used to detect duplicates. Duplicate requests SHOULD cause the +%% same answer to be transmitted (modulo the hop-by-hop Identifier +%% field and any routing AVPs that may be present), and MUST NOT +%% affect any state that was set when the original request was +%% processed. Duplicate answer messages that are to be locally +%% consumed (see Section 6.2) SHOULD be silently discarded. + +-spec sequence() + -> 'Unsigned32'(). + +sequence() -> + Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT32, _SetVal = 0}, + ets:update_counter(diameter_sequence, sequence, Instr). + +%% --------------------------------------------------------------------------- +%% # origin_state_id/0 +%% --------------------------------------------------------------------------- + +%% 3588, 8.16: +%% +%% The Origin-State-Id AVP (AVP Code 278), of type Unsigned32, is a +%% monotonically increasing value that is advanced whenever a Diameter +%% entity restarts with loss of previous state, for example upon reboot. +%% Origin-State-Id MAY be included in any Diameter message, including +%% CER. +%% +%% A Diameter entity issuing this AVP MUST create a higher value for +%% this AVP each time its state is reset. A Diameter entity MAY set +%% Origin-State-Id to the time of startup, or it MAY use an incrementing +%% counter retained in non-volatile memory across restarts. + +-spec origin_state_id() + -> 'Unsigned32'(). + +origin_state_id() -> + ets:lookup_element(diameter_sequence, origin_state_id, 2). + +%% --------------------------------------------------------------------------- +%% # session_id/1 +%% --------------------------------------------------------------------------- + +%% 3588, 8.8: +%% +%% The Session-Id MUST begin with the sender's identity encoded in the +%% DiameterIdentity type (see Section 4.4). The remainder of the +%% Session-Id is delimited by a ";" character, and MAY be any sequence +%% that the client can guarantee to be eternally unique; however, the +%% following format is recommended, (square brackets [] indicate an +%% optional element): +%% +%% ;;[;] +%% +%% and are decimal representations of the +%% high and low 32 bits of a monotonically increasing 64-bit value. The +%% 64-bit value is rendered in two part to simplify formatting by 32-bit +%% processors. At startup, the high 32 bits of the 64-bit value MAY be +%% initialized to the time, and the low 32 bits MAY be initialized to +%% zero. This will for practical purposes eliminate the possibility of +%% overlapping Session-Ids after a reboot, assuming the reboot process +%% takes longer than a second. Alternatively, an implementation MAY +%% keep track of the increasing value in non-volatile memory. +%% +%% is implementation specific but may include a modem's +%% device Id, a layer 2 address, timestamp, etc. + +-spec session_id('DiameterIdentity'()) + -> 'OctetString'(). +%% Note that Session-Id has type UTF8String and that any OctetString +%% is a UTF8String. + +session_id(Host) -> + Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT64, _Set = 0}, + N = ets:update_counter(diameter_sequence, session_base, Instr), + Hi = N bsr 32, + Lo = N band ?INT32, + [Host, ";", integer_to_list(Hi), + ";", integer_to_list(Lo), + ";", atom_to_list(node())]. + +%% --------------------------------------------------------------------------- +%% # init/0 +%% --------------------------------------------------------------------------- + +init() -> + Now = now(), + random:seed(Now), + Time = time32(Now), + Seq = (?INT32 band (Time bsl 20)) bor (random:uniform(1 bsl 20) - 1), + ets:insert(diameter_sequence, [{origin_state_id, Time}, + {session_base, Time bsl 32}, + {sequence, Seq}]), + Time. + +%% --------------------------------------------------------- +%% INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +%% The minimum value represented by a Time value. (See diameter_types.) +%% 32 bits extends to 2104. +-define(TIME0, 62105714048). %% {{1968,1,20},{3,14,8}} + +time32(Now) -> + Time = calendar:now_to_universal_time(Now), + Diff = calendar:datetime_to_gregorian_seconds(Time) - ?TIME0, + Diff band ?INT32. diff --git a/lib/diameter/src/base/diameter_stats.erl b/lib/diameter/src/base/diameter_stats.erl new file mode 100644 index 0000000000..71479afa95 --- /dev/null +++ b/lib/diameter/src/base/diameter_stats.erl @@ -0,0 +1,342 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Statistics collector. +%% + +-module(diameter_stats). +-compile({no_auto_import, [monitor/2]}). + +-behaviour(gen_server). + +-export([reg/1, reg/2, + incr/1, incr/2, incr/3, + read/1, + flush/0, flush/1]). + +%% supervisor callback +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% debug +-export([state/0, + uptime/0]). + +-include("diameter_internal.hrl"). + +%% ets table containing stats. reg(Pid, Ref) inserts a {Pid, Ref}, +%% incr(Counter, X, N) updates the counter keyed at {Counter, X}, and +%% Pid death causes counters keyed on {Counter, Pid} to be deleted and +%% added to those keyed on {Counter, Ref}. +-define(TABLE, ?MODULE). + +%% Name of registered server. +-define(SERVER, ?MODULE). + +%% Entries in the table. +-define(REC(Key, Value), {Key, Value}). + +%% Server state. +-record(state, {id = now()}). + +-type counter() :: any(). +-type contrib() :: any(). + +%%% --------------------------------------------------------------------------- +%%% # reg(Pid, Contrib) +%%% +%%% Description: Register a process as a contributor of statistics +%%% associated with a specified term. Statistics can be +%%% contributed by specifying either Pid or Contrib as +%%% the second argument to incr/3. Statistics contributed +%%% by Pid are folded into the corresponding entry for +%%% Contrib when the process dies. +%%% +%%% Contrib can be any term but should not be a pid +%%% passed as the first argument to reg/2. Subsequent +%%% registrations for the same Pid overwrite the association +%%% --------------------------------------------------------------------------- + +-spec reg(pid(), contrib()) + -> true. + +reg(Pid, Contrib) + when is_pid(Pid) -> + call({reg, Pid, Contrib}). + +-spec reg(contrib()) + -> true. + +reg(Ref) -> + reg(self(), Ref). + +%%% --------------------------------------------------------------------------- +%%% # incr(Counter, Contrib, N) +%%% +%%% Description: Increment a counter for the specified contributor. +%%% +%%% Contrib will typically be an argument passed to reg/2 +%%% but there's nothing that requires this. In particular, +%%% if Contrib is a pid that hasn't been registered then +%%% counters are unaffected by the death of the process. +%%% --------------------------------------------------------------------------- + +-spec incr(counter(), contrib(), integer()) + -> integer(). + +incr(Ctr, Contrib, N) -> + update_counter({Ctr, Contrib}, N). + +incr(Ctr, N) + when is_integer(N) -> + incr(Ctr, self(), N); + +incr(Ctr, Contrib) -> + incr(Ctr, Contrib, 1). + +incr(Ctr) -> + incr(Ctr, self(), 1). + +%%% --------------------------------------------------------------------------- +%%% # read(Contribs) +%%% +%%% Description: Retrieve counters for the specified contributors. +%%% --------------------------------------------------------------------------- + +-spec read([contrib()]) + -> [{contrib(), [{counter(), integer()}]}]. + +read(Contribs) -> + lists:foldl(fun(?REC({T,C}, N), D) -> orddict:append(C, {T,N}, D) end, + orddict:new(), + ets:select(?TABLE, [{?REC({'_', '$1'}, '_'), + [?ORCOND([{'=:=', '$1', {const, C}} + || C <- Contribs])], + ['$_']}])). + +%%% --------------------------------------------------------------------------- +%%% # flush(Contrib) +%%% +%%% Description: Retrieve and delete statistics for the specified +%%% contributor. +%%% +%%% If Contrib is a pid registered with reg/2 then statistics +%%% for both and its associated contributor are retrieved. +%%% --------------------------------------------------------------------------- + +-spec flush(contrib()) + -> [{counter(), integer()}]. + +flush(Contrib) -> + try + call({flush, Contrib}) + catch + exit: _ -> + [] + end. + +flush() -> + flush(self()). + +%%% --------------------------------------------------------- +%%% EXPORTED INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Module = ?MODULE, + Args = [], + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, Module, Args, Options). + +state() -> + call(state). + +uptime() -> + call(uptime). + +%%% ---------------------------------------------------------- +%%% # init(_) +%%% +%%% Output: {ok, State} +%%% ---------------------------------------------------------- + +init([]) -> + ets:new(?TABLE, [named_table, ordered_set, public]), + {ok, #state{}}. + +%% ---------------------------------------------------------- +%% handle_call(Request, From, State) +%% ---------------------------------------------------------- + +handle_call(state, _, State) -> + {reply, State, State}; + +handle_call(uptime, _, #state{id = Time} = State) -> + {reply, diameter_lib:now_diff(Time), State}; + +handle_call({reg, Pid, Contrib}, _From, State) -> + monitor(not ets:member(?TABLE, Pid), Pid), + {reply, insert(?REC(Pid, Contrib)), State}; + +handle_call({flush, Contrib}, _From, State) -> + {reply, fetch(Contrib), State}; + +handle_call(Req, From, State) -> + ?UNEXPECTED([Req, From]), + {reply, nok, State}. + +%% ---------------------------------------------------------- +%% handle_cast(Request, State) +%% ---------------------------------------------------------- + +handle_cast({incr, Rec}, State) -> + update_counter(Rec), + {noreply, State}; + +handle_cast(Msg, State) -> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%% ---------------------------------------------------------- +%% handle_info(Request, State) +%% ---------------------------------------------------------- + +handle_info({'DOWN', _MRef, process, Pid, _}, State) -> + down(Pid), + {noreply, State}; + +handle_info(Info, State) -> + ?UNEXPECTED([Info]), + {noreply, State}. + +%% ---------------------------------------------------------- +%% terminate(Reason, State) +%% ---------------------------------------------------------- + +terminate(_Reason, _State) -> + ok. + +%% ---------------------------------------------------------- +%% code_change(OldVsn, State, Extra) +%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%% --------------------------------------------------------- +%%% INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +%% monitor/2 + +monitor(true, Pid) -> + erlang:monitor(process, Pid); +monitor(false = No, _) -> + No. + +%% down/1 + +down(Pid) -> + L = ets:match_object(?TABLE, ?REC({'_', Pid}, '_')), + [?REC(_, Ref) = T] = lookup(Pid), + fold(Ref, L), + delete_object(T), + delete(L). + +%% Fold Pid-based entries into Ref-based ones. +fold(Ref, L) -> + lists:foreach(fun(?REC({K, _}, V)) -> update_counter({{K, Ref}, V}) end, + L). + +delete(Objs) -> + lists:foreach(fun delete_object/1, Objs). + +%% fetch/1 + +fetch(X) -> + MatchSpec = [{?REC({'_', '$1'}, '_'), + [?ORCOND([{'==', '$1', {const, T}} || T <- [X | ref(X)]])], + ['$_']}], + L = ets:select(?TABLE, MatchSpec), + delete(L), + D = lists:foldl(fun sum/2, dict:new(), L), + dict:to_list(D). + +sum({{Ctr, _}, N}, Dict) -> + dict:update(Ctr, fun(V) -> V+N end, N, Dict). + +ref(Pid) + when is_pid(Pid) -> + ets:select(?TABLE, [{?REC(Pid, '$1'), [], ['$1']}]); +ref(_) -> + []. + +%% update_counter/2 +%% +%% From an arbitrary request process. Cast to the server process to +%% insert a new element if the counter doesn't exists so that two +%% processes don't do so simultaneously. + +update_counter(Key, N) -> + try + ets:update_counter(?TABLE, Key, N) + catch + error: badarg -> + cast({incr, ?REC(Key, N)}) + end. + +%% update_counter/1 +%% +%% From the server process. + +update_counter(?REC(Key, N) = T) -> + try + ets:update_counter(?TABLE, Key, N) + catch + error: badarg -> + insert(T) + end. + +insert(T) -> + ets:insert(?TABLE, T). + +lookup(Key) -> + ets:lookup(?TABLE, Key). + +delete_object(T) -> + ets:delete_object(?TABLE, T). + +%% cast/1 + +cast(Msg) -> + gen_server:cast(?SERVER, Msg). + +%% call/1 + +call(Request) -> + gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/base/diameter_sup.erl b/lib/diameter/src/base/diameter_sup.erl new file mode 100644 index 0000000000..e5afd23dcd --- /dev/null +++ b/lib/diameter/src/base/diameter_sup.erl @@ -0,0 +1,101 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% The top supervisor for the diameter application. +%% + +-module(diameter_sup). + +-behaviour(supervisor). + +%% interface +-export([start_link/0, %% supervisor start + tree/0]). %% supervision tree + +%% supervisor callback +-export([init/1]). + +-define(CHILDREN, [diameter_misc_sup, + diameter_watchdog_sup, + diameter_peer_fsm_sup, + diameter_transport_sup, + diameter_service_sup]). + +-define(TABLES, [{diameter_sequence, [set]}, + {diameter_service, [set, {keypos, 3}]}, + {diameter_request, [bag]}, + {diameter_config, [bag, {keypos, 2}]}]). + +%% start_link/0 + +start_link() -> + SupName = {local, ?MODULE}, + supervisor:start_link(SupName, ?MODULE, []). + +%% init/1 + +init([]) -> + ets_new(?TABLES), + diameter_session:init(), + Flags = {one_for_one, 1, 5}, + ChildSpecs = lists:map(fun spec/1, ?CHILDREN), + {ok, {Flags, ChildSpecs}}. + +%% spec/1 + +spec(Mod) -> + {Mod, + {Mod, start_link, []}, + permanent, + 1000, + supervisor, + [Mod]}. + +%% ets_new/1 + +ets_new(List) + when is_list(List) -> + lists:foreach(fun ets_new/1, List); + +ets_new({Table, Opts}) -> + ets:new(Table, [named_table, public | Opts]). + +%% tree/0 + +tree() -> + [{?MODULE, whereis(?MODULE), tree(?MODULE)}]. + +tree(Sup) -> + lists:map(fun t/1, supervisor:which_children(Sup)). + +t({Name, Pid, supervisor, _}) -> + t(Name, Pid, tree(Pid)); +t({Name, Pid, worker, _}) -> + t(Name, Pid). + +t(undefined, Pid, Children) -> + {Pid, Children}; +t(Name, Pid, Children) -> + {Name, Pid, Children}. + +t(undefined, Pid) -> + Pid; +t(Name, Pid) -> + {Name, Pid}. diff --git a/lib/diameter/src/base/diameter_sync.erl b/lib/diameter/src/base/diameter_sync.erl new file mode 100644 index 0000000000..ce2db4b3a2 --- /dev/null +++ b/lib/diameter/src/base/diameter_sync.erl @@ -0,0 +1,550 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This module implements a server that serializes requests in named +%% queues. A request is an MFA or fun and a name can be any term. A +%% request is applied in a dedicated process that terminates when +%% the request function returns. +%% + +-module(diameter_sync). +-behaviour(gen_server). + +-export([call/4, call/5, + cast/4, cast/5, + carp/1, carp/2]). + +%% supervisor callback +-export([start_link/0]). + +%% gen_server interface +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% test/debug +-export([state/0, + uptime/0, + flush/1, + pending/0, + pending/1, + queues/0, + pids/1]). + +-include("diameter_internal.hrl"). + +%% Locally registered server name. +-define(SERVER, ?MODULE). + +%% Message to the server to queue a request ... +-define(REQUEST(CallOrCast, Name, Req, Max, Timeout), + {request, CallOrCast, Name, Req, Max, Timeout}). + +%% ... and to retrieve the pid of the prevailing request process. +-define(CARP(Name), + {carp, Name}). + +%% Forever ... +-define(TIMEOUT, 30000). + +%% Server state. +-record(state, + {time = now(), + pending = 0 :: non_neg_integer(), %% outstanding requests + monitor = new() :: ets:tid(), %% MonitorRef -> {Name, From} + queue = new() :: ets:tid()}). %% Name -> queue of {Pid, Ref} + +%% ---------------------------------------------------------- +%% # call(Node, Name, Req, Max, Timeout) +%% # call(Name, Req, Max, Timeout) +%% +%% Input: Name = term() identifying the queue in which the request is +%% to be evaluated. +%% Req = {M,F,A} +%% | {Fun, Arg} +%% | [Fun | Args] +%% | Fun +%% Max = Upper bound for the number of outstanding requests +%% in the named queue for Req to be queued. +%% If more than this number are in the queue then +%% 'rejected' is returned to the caller. Can be any +%% term but integer() | infinity is sufficient. +%% Timeout = 32 bit integer() number of milliseconds after which +%% request is cancelled (if not already started), causing +%% 'timeout' to be returned to the caller. +%% | infinity +%% +%% Output: Req() | rejected | timeout +%% +%% Description: Serialize a request in a named queue. Note that if +%% 'timeout' is returned and the request itself does not +%% return this atom then request has not been evaluated. +%% ---------------------------------------------------------- + +call(Name, Req, Max, Timeout) -> + call(node(), Name, Req, Max, Timeout). + +call(Node, Name, Req, Max, Timeout) -> + gen_call({?SERVER, Node}, ?REQUEST(call, Name, Req, Max, Timeout)). + +%%% ---------------------------------------------------------- +%%% # cast(Node, Name, Req, Max, Timeout) +%%% # cast(Name, Req, Max, Timeout) +%%% +%%% Output: ok | rejected | timeout +%%% +%%% Description: Serialize a request without returning the result to the +%%% caller. Returns after the task is queued. +%%% ---------------------------------------------------------- + +cast(Name, Req, Max, Timeout) -> + cast(node(), Name, Req, Max, Timeout). + +cast(Node, Name, Req, Max, Timeout) -> + gen_call({?SERVER, Node}, ?REQUEST(cast, Name, Req, Max, Timeout)). + +%% 'timeout' is only return if the server process that processes +%% requests isn't alive. Ditto for call/carp. + +%%% ---------------------------------------------------------- +%%% # carp(Node, Name) +%%% # carp(Name) +%%% +%%% Output: {value, Pid} | false | timeout +%%% +%%% Description: Return the pid of the process processing the task +%%% at the head of the named queue. Note that the value +%%% returned by subsequent calls changes as tasks are +%%% completed, each task executing in a dedicated +%%% process. The exit value of this process will be +%%% {value, Req()} if the task returns. +%%% ---------------------------------------------------------- + +%% The intention of this is to let a process enqueue a task that waits +%% for a message before completing, the target pid being retrieved +%% with carp/[12]. + +carp(Name) -> + carp(node(), Name). + +carp(Node, Name) -> + gen_call({?SERVER, Node}, ?CARP(Name)). + +%%% --------------------------------------------------------- +%%% EXPORTED INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +state() -> + call(state). + +uptime() -> + call(uptime). + +flush(Name) -> + call({flush, Name}). + +pending() -> + call(pending). + +pending(Name) -> + call({pending, Name}). + +queues() -> + call(queues). + +pids(Name) -> + call({pids, Name}). + +%%% ---------------------------------------------------------- +%%% # start_link() +%%% ---------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Module = ?MODULE, + Args = [], + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, Module, Args, Options). + +%%% ---------------------------------------------------------- +%%% # init(_) +%%% ---------------------------------------------------------- + +init(_) -> + {ok, #state{}}. + +%%% ---------------------------------------------------------- +%%% # handle_call(Request, From, State) +%%% ---------------------------------------------------------- + +%% Enqueue a new request. +handle_call(?REQUEST(Type, Name, Req, Max, Timeout), + From, + #state{queue = QD} = State) -> + T = find(Name, QD), + nq(queued(T) =< Max, T, {Type, From}, Name, Req, Timeout, State); + +handle_call(Request, From, State) -> + {reply, call(Request, From, State), State}. + +%% call/3 + +call(?CARP(Name), _, #state{queue = QD}) -> + pcar(find(Name, QD)); + +call(state, _, State) -> + State; + +call(uptime, _, #state{time = T}) -> + diameter_lib:now_diff(T); + +call({flush, Name}, _, #state{queue = QD}) -> + cancel(find(Name, QD)); + +call(pending, _, #state{pending = N}) -> + N; + +call({pending, Name}, _, #state{queue = QD}) -> + queued(find(Name, QD)); + +call(queues, _, #state{queue = QD}) -> + fetch_keys(QD); + +call({pids, Name}, _, #state{queue = QD}) -> + plist(find(Name, QD)); + +call(Req, From, _State) -> %% ignore + ?UNEXPECTED(handle_call, [Req, From]), + nok. + +%%% ---------------------------------------------------------- +%%% handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% handle_info(Request, State) +%%% ---------------------------------------------------------- + +handle_info(Request, State) -> + {noreply, info(Request, State)}. + +%% info/2 + +%% A request has completed execution or timed out. +info({'DOWN', MRef, process, Pid, Info}, + #state{pending = N, + monitor = MD, + queue = QD} + = State) -> + {Name, From} = fetch(MRef, MD), + reply(From, rc(Info)), + State#state{pending = N-1, + monitor = erase(MRef, MD), + queue = dq(fetch(Name, QD), Pid, Info, Name, QD)}; + +info(Info, State) -> + ?UNEXPECTED(handle_info, [Info]), + State. + +reply({call, From}, T) -> + gen_server:reply(From, T); +reply(cast, _) -> + ok. + +rc({value, T}) -> + T; +rc(_) -> + timeout. + +%%% ---------------------------------------------------------- +%%% code_change(OldVsn, State, Extra) +%%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%% ---------------------------------------------------------- +%%% terminate(Reason, State) +%%% ---------------------------------------------------------- + +terminate(_Reason, _State)-> + ok. + +%%% --------------------------------------------------------- +%%% INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +%% queued/1 + +queued({ok, {N,_}}) -> + N; +queued(error) -> + 0. + +%% nq/7 + +%% Maximum number of pending requests exceeded ... +nq(false, _, _, _Name, _Req, _Timeout, State) -> + {reply, rejected, State}; + +%% ... or not. +nq(true, T, From, Name, Req, Timeout, #state{pending = N, + monitor = MD, + queue = QD} + = State) -> + Ref = make_ref(), + Pid = init(Ref, Req, timeout(Timeout, T)), + MRef = erlang:monitor(process, Pid), + {noreply, State#state{pending = N+1, + monitor = store(MRef, {Name, from(From)}, MD), + queue = store(Name, nq(T, {Pid, Ref}), QD)}}. + +from({call, _} = T) -> + T; +from({cast = T, From}) -> + gen_server:reply(From, ok), + T. + +%% nq/2 + +%% Other requests in the queue: append. +nq({ok, {N,Q}}, T) -> + {N+1, queue:in(T,Q)}; + +%% Queue is empty: start execution. +nq(error, T) -> + go(T), + {1, queue:from_list([T])}. + +%% Don't timeout if the request is evaluated immediately so as to +%% avoid a race between getting a 'go' and a 'timeout'. Queueing a +%% request in an empty queue always results in execution. +timeout(_, error) -> + infinity; +timeout(Timeout, _) -> + Timeout. + +%% dq/5 +%% +%% A request process has terminated. + +dq({N,Q}, Pid, _Info, Name, QD) -> + {{value, T}, TQ} = queue:out(Q), + dq(N-1, Pid, T, TQ, Name, QD). + +%% dq/6 + +%% Request was at the head of the queue: start another. +dq(N, Pid, {Pid, _}, TQ, Name, QD) -> + dq(N, TQ, Name, QD); + +%% Or not: remove the offender from the queue. +dq(N, Pid, T, TQ, Name, QD) -> + store(Name, {N, req(Pid, queue:from_list([T]), TQ)}, QD). + +%% dq/4 + +%% Queue is empty: erase. +dq(0, TQ, Name, QD) -> + true = queue:is_empty(TQ), %% assert + erase(Name, QD); + +%% Start the next request. +dq(N, TQ, Name, QD) -> + go(queue:head(TQ)), + store(Name, {N, TQ}, QD). + +%% req/3 +%% +%% Find and remove the queue element for the specified pid. + +req(Pid, HQ, Q) -> + {{value, T}, TQ} = queue:out(Q), + req(Pid, T, HQ, TQ). + +req(Pid, {Pid, _}, HQ, TQ) -> + queue:join(HQ, TQ); +req(Pid, T, HQ, TQ) -> + req(Pid, queue:in(T,HQ), TQ). + +%% go/1 + +go({Pid, Ref}) -> + Pid ! {Ref, ok}. + +%% init/4 +%% +%% Start the dedicated process for handling a request. The exit value +%% is as promised by carp/1. + +init(Ref, Req, Timeout) -> + spawn(fun() -> exit(i(Ref, Req, Timeout)) end). + +i(Ref, Req, Timeout) -> + Timer = send_timeout(Ref, Timeout), + MRef = erlang:monitor(process, ?SERVER), + receive + {Ref, ok} -> %% Do the deed. + %% Ensure we don't leave messages in the mailbox since the + %% request itself might receive. Alternatively, could have + %% done the eval in a new process but then we'd have to + %% relay messages arriving at this one. + cancel_timer(Timer), + erlang:demonitor(MRef, [flush]), + %% Ref is to ensure that we don't extract any message that + %% a client may have sent after retrieving self() with + %% carp/1, there being no guarantee that the message + %% banged by go/1 is received before the pid becomes + %% accessible. + {value, eval(Req)}; + {Ref, timeout = T} -> + T; + {'DOWN', MRef, process, _Pid, _Info} = D -> %% server death + D + end. + +send_timeout(_Ref, infinity = No) -> + No; +send_timeout(Ref, Ms) -> + Msg = {Ref, timeout}, + TRef = erlang:send_after(Ms, self(), Msg), + {TRef, Msg}. + +cancel_timer(infinity = No) -> + No; +cancel_timer({TRef, Msg}) -> + flush(Msg, erlang:cancel_timer(TRef)). + +flush(Msg, false) -> %% Message has already been sent ... + %% 'error' should never happen but crash if it does so as not to + %% hang the process. + ok = receive Msg -> ok after ?TIMEOUT -> error end; +flush(_, _) -> %% ... or not. + ok. + +eval({M,F,A}) -> + apply(M,F,A); +eval([Fun | Args]) -> + apply(Fun, Args); +eval({Fun, A}) -> + Fun(A); +eval(Fun) -> + Fun(). + +%% pcar/1 + +pcar({ok, {_,Q}}) -> + {Pid, _Ref} = queue:head(Q), + {value, Pid}; +pcar(error) -> + false. + +%% plist/1 + +plist({ok, {_,Q}}) -> + lists:map(fun({Pid, _Ref}) -> Pid end, queue:to_list(Q)); +plist(error) -> + []. + +%% cancel/1 +%% +%% Cancel all but the active request from the named queue. Return the +%% number of requests cancelled. + +%% Just send timeout messages to each request to make them die. Note +%% that these are guaranteed to arrive before a go message after the +%% current request completes since both messages are sent from the +%% server process. +cancel({ok, {N,Q}}) -> + {_,TQ} = queue:split(1,Q), + foreach(fun({Pid, Ref}) -> Pid ! {Ref, timeout} end, N-1, TQ), + N-1; +cancel(error) -> + 0. + +%% foreach/3 + +foreach(_, 0, _) -> + ok; +foreach(Fun, N, Q) -> + Fun(queue:head(Q)), + foreach(Fun, N-1, queue:tail(Q)). + +%% call/1 + +%% gen_server:call/3 will exit if the target process dies. +call(Request) -> + try + gen_server:call(?SERVER, Request, ?TIMEOUT) + catch + exit: Reason -> + {error, Reason} + end. + +%% dict-like table manipulation. + +erase(Key, Dict) -> + ets:delete(Dict, Key), + Dict. + +fetch(Key, Dict) -> + {ok, V} = find(Key, Dict), + V. + +fetch_keys(Dict) -> + ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). + +find(Key, Dict) -> + case ets:lookup(Dict, Key) of + [{Key, V}] -> + {ok, V}; + [] -> + error + end. + +new() -> + ets:new(?MODULE, [set]). + +store(Key, Value, Dict) -> + store({Key, Value}, Dict). + +store({_,_} = T, Dict) -> + ets:insert(Dict, T), + Dict. + +%% gen_call/1 + +gen_call(Server, Req) -> + gen_call(Server, Req, infinity). + +gen_call(Server, Req, Timeout) -> + try + gen_server:call(Server, Req, Timeout) + catch + exit: _ -> + timeout + end. diff --git a/lib/diameter/src/base/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl new file mode 100644 index 0000000000..6b1b1b8d39 --- /dev/null +++ b/lib/diameter/src/base/diameter_types.erl @@ -0,0 +1,537 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(diameter_types). + +%% +%% Encode/decode of RFC 3588 Data Formats, Basic (section 4.2) and +%% Derived (section 4.3). +%% + +%% Basic types. +-export(['OctetString'/2, + 'Integer32'/2, + 'Integer64'/2, + 'Unsigned32'/2, + 'Unsigned64'/2, + 'Float32'/2, + 'Float64'/2]). + +%% Derived types. +-export(['Address'/2, + 'Time'/2, + 'UTF8String'/2, + 'DiameterIdentity'/2, + 'DiameterURI'/2, + 'IPFilterRule'/2, + 'QoSFilterRule'/2]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +-define(UINT(N,X), ((0 =< X) andalso (X < 1 bsl N))). +-define(SINT(N,X), ((-1*(1 bsl (N-1)) < X) andalso (X < 1 bsl (N-1)))). + +%% The Grouped and Enumerated types are dealt with directly in +%% generated decode modules by way of diameter_gen.hrl and +%% diameter_codec.erl. Padding and the setting of Length and other +%% fields are also dealt with there. + +%% 3588: +%% +%% DIAMETER_INVALID_AVP_LENGTH 5014 +%% The request contained an AVP with an invalid length. A Diameter +%% message indicating this error MUST include the offending AVPs +%% within a Failed-AVP AVP. +%% +-define(INVALID_LENGTH(Bin), erlang:error({'DIAMETER', 5014, Bin})). + +%% ------------------------------------------------------------------------- +%% 3588, 4.2. Basic AVP Data Formats +%% +%% The Data field is zero or more octets and contains information +%% specific to the Attribute. The format and length of the Data field +%% is determined by the AVP Code and AVP Length fields. The format of +%% the Data field MUST be one of the following base data types or a data +%% type derived from the base data types. In the event that a new Basic +%% AVP Data Format is needed, a new version of this RFC must be created. +%% -------------------- + +'OctetString'(decode, Bin) + when is_binary(Bin) -> + binary_to_list(Bin); + +'OctetString'(encode = M, zero) -> + 'OctetString'(M, []); + +'OctetString'(encode, Str) -> + iolist_to_binary(Str). + +%% -------------------- + +'Integer32'(decode, <>) -> + X; + +'Integer32'(decode, B) -> + ?INVALID_LENGTH(B); + +'Integer32'(encode = M, zero) -> + 'Integer32'(M, 0); + +'Integer32'(encode, I) + when ?SINT(32,I) -> + <>. + +%% -------------------- + +'Integer64'(decode, <>) -> + X; + +'Integer64'(decode, B) -> + ?INVALID_LENGTH(B); + +'Integer64'(encode = M, zero) -> + 'Integer64'(M, 0); + +'Integer64'(encode, I) + when ?SINT(64,I) -> + <>. + +%% -------------------- + +'Unsigned32'(decode, <>) -> + X; + +'Unsigned32'(decode, B) -> + ?INVALID_LENGTH(B); + +'Unsigned32'(encode = M, zero) -> + 'Unsigned32'(M, 0); + +'Unsigned32'(encode, I) + when ?UINT(32,I) -> + <>. + +%% -------------------- + +'Unsigned64'(decode, <>) -> + X; + +'Unsigned64'(decode, B) -> + ?INVALID_LENGTH(B); + +'Unsigned64'(encode = M, zero) -> + 'Unsigned64'(M, 0); + +'Unsigned64'(encode, I) + when ?UINT(64,I) -> + <>. + +%% -------------------- + +%% Decent summaries of the IEEE floating point formats can be +%% found at http://en.wikipedia.org/wiki/IEEE_754-1985 and +%% http://www.psc.edu/general/software/packages/ieee/ieee.php. +%% +%% That the bit syntax uses these formats isn't well documented but +%% this does indeed appear to be the case. However, the bit syntax +%% only encodes numeric values, not the standard's (signed) infinity +%% or NaN. It also encodes any large value as 'infinity', never 'NaN'. +%% Treat these equivalently on decode for this reason. +%% +%% An alternative would be to decode infinity/NaN to the largest +%% possible float but could likely lead to misleading results if +%% arithmetic is performed on the decoded value. Better to be explicit +%% that precision has been lost. + +'Float32'(decode, <>) -> + choose(S, infinity, '-infinity'); + +'Float32'(decode, <>) -> + X; + +'Float32'(decode, B) -> + ?INVALID_LENGTH(B); + +'Float32'(encode = M, zero) -> + 'Float32'(M, 0.0); + +'Float32'(encode, infinity) -> + <<0:1, 255:8, 0:23>>; + +'Float32'(encode, '-infinity') -> + <<1:1, 255:8, 0:23>>; + +'Float32'(encode, X) + when is_float(X) -> + <>. +%% Note that this could also encode infinity/-infinity for large +%% (signed) numeric values. Note also that precision is lost just in +%% using the floating point syntax. For example: +%% +%% 1> B = <<3.14159:32/float>>. +%% <<64,73,15,208>> +%% 2> <> = B. +%% <<64,73,15,208>> +%% 3> F. +%% 3.141590118408203 +%% +%% (The 64 bit type does better.) + +%% -------------------- + +%% The 64 bit format is entirely analogous to the 32 bit format. + +'Float64'(decode, <>) -> + choose(S, infinity, '-infinity'); + +'Float64'(decode, <>) -> + X; + +'Float64'(decode, B) -> + ?INVALID_LENGTH(B); + +'Float64'(encode, infinity) -> + <<0:1, 2047:11, 0:52>>; + +'Float64'(encode, '-infinity') -> + <<1:1, 2047:11, 0:52>>; + +'Float64'(encode = M, zero) -> + 'Float64'(M, 0.0); + +'Float64'(encode, X) + when is_float(X) -> + <>. + +%% ------------------------------------------------------------------------- +%% 3588, 4.3. Derived AVP Data Formats +%% +%% In addition to using the Basic AVP Data Formats, applications may +%% define data formats derived from the Basic AVP Data Formats. An +%% application that defines new AVP Derived Data Formats MUST include +%% them in a section entitled "AVP Derived Data Formats", using the same +%% format as the definitions below. Each new definition must be either +%% defined or listed with a reference to the RFC that defines the +%% format. +%% -------------------- + +'Address'(encode, zero) -> + <<0:48>>; + +'Address'(decode, <<1:16, B/binary>>) + when size(B) == 4 -> + list_to_tuple(binary_to_list(B)); + +'Address'(decode, <<2:16, B/binary>>) + when size(B) == 16 -> + list_to_tuple(v6dec(B, [])); + +'Address'(decode, <> = B) + when 1 == A; + 2 == A -> + ?INVALID_LENGTH(B); + +'Address'(encode, T) -> + ipenc(diameter_lib:ipaddr(T)). + +ipenc(T) + when is_tuple(T), size(T) == 4 -> + B = list_to_binary(tuple_to_list(T)), + <<1:16, B/binary>>; + +ipenc(T) + when is_tuple(T), size(T) == 8 -> + B = v6enc(lists:reverse(tuple_to_list(T)), <<>>), + <<2:16, B/binary>>. + +v6dec(<>, Acc) -> + v6dec(B, [N | Acc]); + +v6dec(<<>>, Acc) -> + lists:reverse(Acc). + +v6enc([N | Rest], B) + when ?UINT(16,N) -> + v6enc(Rest, <>); + +v6enc([], B) -> + B. + +%% -------------------- + +%% A DiameterIdentity is a FQDN as definined in RFC 1035, which is at +%% least one character. + +'DiameterIdentity'(encode = M, zero) -> + 'OctetString'(M, [0]); + +'DiameterIdentity'(encode = M, X) -> + <<_,_/binary>> = 'OctetString'(M, X); + +'DiameterIdentity'(decode = M, <<_,_/binary>> = X) -> + 'OctetString'(M, X). + +%% -------------------- + +'DiameterURI'(decode, Bin) + when is_binary(Bin) -> + scan_uri(Bin); + +%% The minimal DiameterURI is "aaa://x", 7 characters. +'DiameterURI'(encode = M, zero) -> + 'OctetString'(M, lists:duplicate(0,7)); + +'DiameterURI'(encode, #diameter_uri{type = Type, + fqdn = D, + port = P, + transport = T, + protocol = Prot} + = U) -> + S = lists:append([atom_to_list(Type), "://", D, + ":", integer_to_list(P), + ";transport=", atom_to_list(T), + ";protocol=", atom_to_list(Prot)]), + U = scan_uri(S), %% assert + list_to_binary(S); + +'DiameterURI'(encode, Str) -> + Bin = iolist_to_binary(Str), + #diameter_uri{} = scan_uri(Bin), %% type check + Bin. + +%% -------------------- + +%% This minimal rule is "deny in 0 from 0.0.0.0 to 0.0.0.0", 33 characters. +'IPFilterRule'(encode = M, zero) -> + 'OctetString'(M, lists:duplicate(0,33)); + +%% TODO: parse grammar. +'IPFilterRule'(M, X) -> + 'OctetString'(M, X). + +%% -------------------- + +%% This minimal rule is the same as for an IPFilterRule. +'QoSFilterRule'(encode = M, zero = X) -> + 'IPFilterRule'(M, X); + +%% TODO: parse grammar. +'QoSFilterRule'(M, X) -> + 'OctetString'(M, X). + +%% -------------------- + +'UTF8String'(decode, Bin) -> + udec(Bin, []); + +'UTF8String'(encode = M, zero) -> + 'UTF8String'(M, []); + +'UTF8String'(encode, S) -> + uenc(S, []). + +udec(<<>>, Acc) -> + lists:reverse(Acc); + +udec(<>, Acc) -> + udec(Rest, [C | Acc]). + +uenc(E, Acc) + when E == []; + E == <<>> -> + list_to_binary(lists:reverse(Acc)); + +uenc(<>, Acc) -> + uenc(Rest, [<> | Acc]); + +uenc([[] | Rest], Acc) -> + uenc(Rest, Acc); + +uenc([[H|T] | Rest], Acc) -> + uenc([H, T | Rest], Acc); + +uenc([C | Rest], Acc) -> + uenc(Rest, [<> | Acc]). + +%% -------------------- + +%% RFC 3588, 4.3: +%% +%% Time +%% The Time format is derived from the OctetString AVP Base Format. +%% The string MUST contain four octets, in the same format as the +%% first four bytes are in the NTP timestamp format. The NTP +%% Timestamp format is defined in chapter 3 of [SNTP]. +%% +%% This represents the number of seconds since 0h on 1 January 1900 +%% with respect to the Coordinated Universal Time (UTC). +%% +%% On 6h 28m 16s UTC, 7 February 2036 the time value will overflow. +%% SNTP [SNTP] describes a procedure to extend the time to 2104. +%% This procedure MUST be supported by all DIAMETER nodes. + +%% RFC 2030, 3: +%% +%% As the NTP timestamp format has been in use for the last 17 years, +%% it remains a possibility that it will be in use 40 years from now +%% when the seconds field overflows. As it is probably inappropriate +%% to archive NTP timestamps before bit 0 was set in 1968, a +%% convenient way to extend the useful life of NTP timestamps is the +%% following convention: If bit 0 is set, the UTC time is in the +%% range 1968-2036 and UTC time is reckoned from 0h 0m 0s UTC on 1 +%% January 1900. If bit 0 is not set, the time is in the range 2036- +%% 2104 and UTC time is reckoned from 6h 28m 16s UTC on 7 February +%% 2036. Note that when calculating the correspondence, 2000 is not a +%% leap year. Note also that leap seconds are not counted in the +%% reckoning. +%% +%% The statement regarding year 2000 is wrong: errata id 518 at +%% http://www.rfc-editor.org/errata_search.php?rfc=2030 notes this. + +-define(TIME_1900, 59958230400). %% {{1900,1,1},{0,0,0}} +-define(TIME_2036, 64253197696). %% {{2036,2,7},{6,28,16}} +%% TIME_2036 = TIME_1900 + (1 bsl 32) + +%% Time maps [0, 1 bsl 31) onto [TIME_1900 + 1 bsl 31, TIME_2036 + 1 bsl 31) +%% by taking integers with the high-order bit set relative to TIME_1900 +%% and those without relative to TIME_2036. This corresponds to the +%% following dates. +-define(TIME_MIN, {{1968,1,20},{3,14,8}}). %% TIME_1900 + 1 bsl 31 +-define(TIME_MAX, {{2104,2,26},{9,42,24}}). %% TIME_2036 + 1 bsl 31 + +'Time'(decode, <>) -> + Offset = msb(1 == Time bsr 31), + calendar:gregorian_seconds_to_datetime(Time + Offset); + +'Time'(decode, B) -> + ?INVALID_LENGTH(B); + +'Time'(encode, {{_Y,_M,_D},{_HH,_MM,_SS}} = Datetime) + when ?TIME_MIN =< Datetime, Datetime < ?TIME_MAX -> + S = calendar:datetime_to_gregorian_seconds(Datetime), + T = S - msb(S < ?TIME_2036), + 0 = T bsr 32, %% sanity check + <>; + +'Time'(encode, zero) -> + <<0:32>>. + +%% =========================================================================== +%% =========================================================================== + +choose(0, X, _) -> X; +choose(1, _, X) -> X. + +msb(true) -> ?TIME_1900; +msb(false) -> ?TIME_2036. + +%% RFC 3588, 4.3: +%% +%% The DiameterURI MUST follow the Uniform Resource Identifiers (URI) +%% syntax [URI] rules specified below: +%% +%% "aaa://" FQDN [ port ] [ transport ] [ protocol ] +%% +%% ; No transport security +%% +%% "aaas://" FQDN [ port ] [ transport ] [ protocol ] +%% +%% ; Transport security used +%% +%% FQDN = Fully Qualified Host Name +%% +%% port = ":" 1*DIGIT +%% +%% ; One of the ports used to listen for +%% ; incoming connections. +%% ; If absent, +%% ; the default Diameter port (3868) is +%% ; assumed. +%% +%% transport = ";transport=" transport-protocol +%% +%% ; One of the transports used to listen +%% ; for incoming connections. If absent, +%% ; the default SCTP [SCTP] protocol is +%% ; assumed. UDP MUST NOT be used when +%% ; the aaa-protocol field is set to +%% ; diameter. +%% +%% transport-protocol = ( "tcp" / "sctp" / "udp" ) +%% +%% protocol = ";protocol=" aaa-protocol +%% +%% ; If absent, the default AAA protocol +%% ; is diameter. +%% +%% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) + +scan_uri(Bin) + when is_binary(Bin) -> + scan_uri(binary_to_list(Bin)); +scan_uri("aaa://" ++ Rest) -> + scan_fqdn(Rest, #diameter_uri{type = aaa}); +scan_uri("aaas://" ++ Rest) -> + scan_fqdn(Rest, #diameter_uri{type = aaas}). + +scan_fqdn(S, U) -> + {[_|_] = F, Rest} = lists:splitwith(fun is_fqdn/1, S), + scan_opt_port(Rest, U#diameter_uri{fqdn = F}). + +scan_opt_port(":" ++ S, U) -> + {[_|_] = P, Rest} = lists:splitwith(fun is_digit/1, S), + scan_opt_transport(Rest, U#diameter_uri{port = list_to_integer(P)}); +scan_opt_port(S, U) -> + scan_opt_transport(S, U). + +scan_opt_transport(";transport=" ++ S, U) -> + {P, Rest} = transport(S), + scan_opt_protocol(Rest, U#diameter_uri{transport = P}); +scan_opt_transport(S, U) -> + scan_opt_protocol(S, U). + +scan_opt_protocol(";protocol=" ++ S, U) -> + {P, ""} = protocol(S), + U#diameter_uri{protocol = P}; +scan_opt_protocol("", U) -> + U. + +transport("tcp" ++ S) -> + {tcp, S}; +transport("sctp" ++ S) -> + {sctp, S}; +transport("udp" ++ S) -> + {udp, S}. + +protocol("diameter" ++ S) -> + {diameter, S}; +protocol("radius" ++ S) -> + {radius, S}; +protocol("tacacs+" ++ S) -> + {'tacacs+', S}. + +is_fqdn(C) -> + is_digit(C) orelse is_alpha(C) orelse C == $. orelse C == $-. + +is_alpha(C) -> + ($a =< C andalso C =< $z) orelse ($A =< C andalso C =< $Z). + +is_digit(C) -> + $0 =< C andalso C =< $9. diff --git a/lib/diameter/src/base/diameter_types.hrl b/lib/diameter/src/base/diameter_types.hrl new file mode 100644 index 0000000000..02bf8a74dd --- /dev/null +++ b/lib/diameter/src/base/diameter_types.hrl @@ -0,0 +1,139 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Types for function specifications, primarily in diameter.erl. This +%% has nothing specifically to do with diameter_types.erl. +%% + +-type evaluable() + :: {module(), atom(), list()} + | fun() + | nonempty_improper_list(evaluable(), list()). %% [evaluable() | Args] + +-type app_alias() + :: any(). + +-type service_name() + :: any(). + +%% Diameter basic types + +-type 'OctetString'() :: iolist(). +-type 'Integer32'() :: -2147483647..2147483647. +-type 'Integer64'() :: -9223372036854775807..9223372036854775807. +-type 'Unsigned32'() :: 0..4294967295. +-type 'Unsigned64'() :: 0..18446744073709551615. +-type 'Float32'() :: '-infinity' | float() | infinity. +-type 'Float64'() :: '-infinity' | float() | infinity. +-type 'Grouped'() :: list() | tuple(). + +%% Diameter derived types + +-type 'Address'() + :: inet:ip_address() + | string(). + +-type 'Time'() :: {{integer(), 1..12, 1..31}, + {0..23, 0..59, 0..59}}. +-type 'UTF8String'() :: iolist(). +-type 'DiameterIdentity'() :: 'OctetString'(). +-type 'DiameterURI'() :: 'OctetString'(). +-type 'Enumerated'() :: 'Integer32'(). +-type 'IPFilterRule'() :: 'OctetString'(). +-type 'QoSFilterRule'() :: 'OctetString'(). + +%% Capabilities options/avps on start_service/2 and/or add_transport/2 + +-type capability() + :: {'Origin-Host', 'DiameterIdentity'()} + | {'Origin-Realm', 'DiameterIdentity'()} + | {'Host-IP-Address', ['Address'()]} + | {'Vendor-Id', 'Unsigned32'()} + | {'Product-Name', 'UTF8String'()} + | {'Supported-Vendor-Id', ['Unsigned32'()]} + | {'Auth-Application-Id', ['Unsigned32'()]} + | {'Vendor-Specific-Application-Id', ['Grouped'()]} + | {'Firmware-Revision', 'Unsigned32'()}. + +%% Filters for call/4 + +-type peer_filter() + :: none + | host + | realm + | {host, any|'DiameterIdentity'()} + | {realm, any|'DiameterIdentity'()} + | {eval, evaluable()} + | {neg, peer_filter()} + | {all, [peer_filter()]} + | {any, [peer_filter()]}. + +%% Options passed to start_service/2 + +-type service_opt() + :: capability() + | {application, [application_opt()]}. + +-type application_opt() + :: {alias, app_alias()} + | {dictionary, module()} + | {module, app_module()} + | {state, any()} + | {call_mutates_state, boolean()} + | {answer_errors, callback|report|discard}. + +-type app_module() + :: module() + | nonempty_improper_list(module(), list()). %% list with module() head + +%% Identifier returned by add_transport/2 + +-type transport_ref() + :: reference(). + +%% Options passed to add_transport/2 + +-type transport_opt() + :: {transport_module, atom()} + | {transport_config, any()} + | {applications, [app_alias()]} + | {capabilities, [capability()]} + | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} + | {reconnect_timer, 'Unsigned32'()} + | {private, any()}. + +%% Predicate passed to remove_transport/2 + +-type transport_pred() + :: fun((reference(), connect|listen, list()) -> boolean()) + | fun((reference(), list()) -> boolean()) + | fun((list()) -> boolean()) + | reference() + | list() + | {connect|listen, transport_pred()} + | {atom(), atom(), list()}. + +%% Options passed to call/4 + +-type call_opt() + :: {extra, list()} + | {filter, peer_filter()} + | {timeout, 'Unsigned32'()} + | detach. diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl new file mode 100644 index 0000000000..b7c1491f4b --- /dev/null +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -0,0 +1,571 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% This module implements (as a process) the state machine documented +%% in Appendix A of RFC 3539. +%% + +-module(diameter_watchdog). +-behaviour(gen_server). + +%% towards diameter_service +-export([start/2]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +%% diameter_watchdog_sup callback +-export([start_link/1]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +-define(DEFAULT_TW_INIT, 30000). %% RFC 3539 ch 3.4.1 + +-record(watchdog, + {%% PCB - Peer Control Block; see RFC 3539, Appendix A + status = initial :: initial | okay | suspect | down | reopen, + pending = false :: boolean(), + tw :: 6000..16#FFFFFFFF | {module(), atom(), list()}, + %% {M,F,A} -> integer() >= 0 + num_dwa = 0 :: -1 | non_neg_integer(), + %% number of DWAs received during reopen + %% end PCB + parent = self() :: pid(), + transport :: pid(), + tref :: reference(), %% reference for current watchdog timer + message_data}). %% term passed into diameter_service with message + +%% start/2 + +start({_,_} = Type, T) -> + {ok, Pid} = diameter_watchdog_sup:start_child({Type, self(), T}), + Pid. + +start_link(T) -> + {ok, _} = proc_lib:start_link(?MODULE, + init, + [T], + infinity, + diameter_lib:spawn_opts(server, [])). + +%% =========================================================================== +%% =========================================================================== + +%% init/1 + +init(T) -> + proc_lib:init_ack({ok, self()}), + gen_server:enter_loop(?MODULE, [], i(T)). + +i({T, Pid, {ConnT, Opts, SvcName, #diameter_service{applications = Apps, + capabilities = Caps} + = Svc}}) -> + {M,S,U} = now(), + random:seed(M,S,U), + putr(restart, {T, Opts, Svc}), %% save seeing it in trace + putr(dwr, dwr(Caps)), %% + #watchdog{parent = monitor(Pid), + transport = monitor(diameter_peer_fsm:start(T, Opts, Svc)), + tw = proplists:get_value(watchdog_timer, + Opts, + ?DEFAULT_TW_INIT), + message_data = {ConnT, SvcName, Apps}}. + +%% handle_call/3 + +handle_call(_, _, State) -> + {reply, nok, State}. + +%% handle_cast/2 + +handle_cast(_, State) -> + {noreply, State}. + +%% handle_info/2 + +handle_info(T, State) -> + case transition(T, State) of + ok -> + {noreply, State}; + #watchdog{status = X} = S -> + ?LOGC(X =/= State#watchdog.status, transition, X), + {noreply, S}; + stop -> + ?LOG(stop, T), + {stop, {shutdown, T}, State} + end. + +%% terminate/2 + +terminate(_, _) -> + ok. + +%% code_change/3 + +code_change(_, State, _) -> + {ok, State}. + +%% =========================================================================== +%% =========================================================================== + +%% transition/2 +%% +%% The state transitions documented here are extracted from RFC 3539, +%% the commentary is ours. + +%% Service or watchdog is telling the watchdog of an accepting +%% transport to die after reconnect_timer expiry or reestablished +%% connection (in another transport process) respectively. +transition(close, #watchdog{status = down}) -> + {{accept, _}, _, _} = getr(restart), %% assert + stop; +transition(close, #watchdog{}) -> + ok; + +%% Service is asking for the peer to be taken down gracefully. +transition({shutdown, Pid}, #watchdog{parent = Pid, + transport = undefined, + status = S}) -> + down = S, %% sanity check + stop; +transition({shutdown = T, Pid}, #watchdog{parent = Pid, + transport = TPid}) -> + TPid ! {T, self()}, + ok; + +%% Parent process has died, +transition({'DOWN', _, process, Pid, _Reason}, + #watchdog{parent = Pid}) -> + stop; + +%% Transport has accepted a connection. +transition({accepted = T, TPid}, #watchdog{transport = TPid, + parent = Pid}) -> + Pid ! {T, self(), TPid}, + ok; + +%% Transport is telling us that its impending death isn't failure. +transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> + stop; + +%% STATE Event Actions New State +%% ===== ------ ------- ---------- +%% INITIAL Connection up SetWatchdog() OKAY + +%% By construction, the watchdog timer isn't set until we move into +%% state okay as the result of the Peer State Machine reaching the +%% Open state. +%% +%% If we're an acceptor then we may be resuming a connection that went +%% down in another acceptor process, in which case this is the +%% transition below, from down into reopen. That is, it's not until +%% we know the identity of the peer (ie. now) that we know that we're +%% in state down rather than initial. + +transition({open, TPid, Hosts, T} = Open, + #watchdog{transport = TPid, + status = initial, + parent = Pid} + = S) -> + case okay(getr(restart), Hosts) of + okay -> + open(Pid, {TPid, T}), + set_watchdog(S#watchdog{status = okay}); + reopen -> + transition(Open, S#watchdog{status = down}) + end; + +%% DOWN Connection up NumDWA = 0 +%% SendWatchdog() +%% SetWatchdog() +%% Pending = TRUE REOPEN + +transition({open = P, TPid, _Hosts, T}, + #watchdog{transport = TPid, + status = down} + = S) -> + %% Store the info we need to notify the parent to reopen the + %% connection after the requisite DWA's are received, at which + %% time we eraser(open). + putr(P, {TPid, T}), + set_watchdog(send_watchdog(S#watchdog{status = reopen, + num_dwa = 0})); + +%% OKAY Connection down CloseConnection() +%% Failover() +%% SetWatchdog() DOWN +%% SUSPECT Connection down CloseConnection() +%% SetWatchdog() DOWN +%% REOPEN Connection down CloseConnection() +%% SetWatchdog() DOWN + +transition({'DOWN', _, process, TPid, _}, + #watchdog{transport = TPid, + status = initial}) -> + stop; + +transition({'DOWN', _, process, Pid, _}, + #watchdog{transport = Pid} + = S) -> + failover(S), + close(S), + set_watchdog(S#watchdog{status = down, + pending = false, + transport = undefined}); +%% Any outstanding pending (or other messages from the transport) will +%% have arrived before 'DOWN' since the message comes from the same +%% process. Note that we could also get this message in the initial +%% state. + +%% Incoming message. +transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> + recv(Name, Pkt, S); + +%% Current watchdog has timed out. +transition({timeout, TRef, tw}, #watchdog{tref = TRef} = S) -> + set_watchdog(timeout(S)); + +%% Timer was canceled after message was already sent. +transition({timeout, _, tw}, #watchdog{}) -> + ok; + +%% State query. +transition({state, Pid}, #watchdog{status = S}) -> + Pid ! {self(), S}, + ok. + +%% =========================================================================== + +monitor(Pid) -> + erlang:monitor(process, Pid), + Pid. + +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + +eraser(Key) -> + erase({?MODULE, Key}). + +%% encode/1 + +encode(Msg) -> + #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg), + Bin. + +%% okay/2 + +okay({{accept, Ref}, _, _}, Hosts) -> + T = {?MODULE, connection, Ref, Hosts}, + diameter_reg:add(T), + okay(diameter_reg:match(T)); +%% Register before matching so that at least one of two registering +%% processes will match the other. (Which can't happen as long as +%% diameter_peer_fsm guarantees at most one open connection to the same +%% peer.) + +okay({{connect, _}, _, _}, _) -> + okay. + +%% The peer hasn't been connected recently ... +okay([{_,P}]) -> + P = self(), %% assert + okay; + +%% ... or it has. +okay(C) -> + [_|_] = [P ! close || {_,P} <- C, self() /= P], + reopen. + +%% set_watchdog/1 + +set_watchdog(#watchdog{tw = TwInit, + tref = TRef} + = S) -> + cancel(TRef), + S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)}. + +cancel(undefined) -> + ok; +cancel(TRef) -> + erlang:cancel_timer(TRef). + +tw(T) + when is_integer(T), T >= 6000 -> + T - 2000 + (random:uniform(4001) - 1); %% RFC3539 jitter of +/- 2 sec. +tw({M,F,A}) -> + apply(M,F,A). + +%% open/2 + +open(Pid, {_,_} = T) -> + Pid ! {connection_up, self(), T}. + +%% failover/1 + +failover(#watchdog{status = okay, + parent = Pid}) -> + Pid ! {connection_down, self()}; + +failover(_) -> + ok. + +%% close/1 + +close(#watchdog{status = down}) -> + ok; + +close(#watchdog{parent = Pid}) -> + {{T, _}, _, _} = getr(restart), + T == accept andalso (Pid ! {close, self()}). + +%% send_watchdog/1 + +send_watchdog(#watchdog{pending = false, + transport = TPid} + = S) -> + TPid ! {send, encode(getr(dwr))}, + ?LOG(send, 'DWR'), + S#watchdog{pending = true}. + +%% recv/3 + +recv(Name, Pkt, S) -> + try rcv(Name, S) of + #watchdog{} = NS -> + rcv(Name, Pkt, S), + NS + catch + throw: {?MODULE, throwaway, #watchdog{} = NS} -> + NS + end. + +%% rcv/3 + +rcv(N, _, _) + when N == 'CER'; + N == 'CEA'; + N == 'DWR'; + N == 'DWA'; + N == 'DPR'; + N == 'DPA' -> + false; + +rcv(_, Pkt, #watchdog{transport = TPid, + message_data = T}) -> + diameter_service:receive_message(TPid, Pkt, T). + +throwaway(S) -> + throw({?MODULE, throwaway, S}). + +%% rcv/2 + +%% INITIAL Receive DWA Pending = FALSE +%% Throwaway() INITIAL +%% INITIAL Receive non-DWA Throwaway() INITIAL + +rcv('DWA', #watchdog{status = initial} = S) -> + throwaway(S#watchdog{pending = false}); + +rcv(_, #watchdog{status = initial} = S) -> + throwaway(S); + +%% DOWN Receive DWA Pending = FALSE +%% Throwaway() DOWN +%% DOWN Receive non-DWA Throwaway() DOWN + +rcv('DWA', #watchdog{status = down} = S) -> + throwaway(S#watchdog{pending = false}); + +rcv(_, #watchdog{status = down} = S) -> + throwaway(S); + +%% OKAY Receive DWA Pending = FALSE +%% SetWatchdog() OKAY +%% OKAY Receive non-DWA SetWatchdog() OKAY + +rcv('DWA', #watchdog{status = okay} = S) -> + set_watchdog(S#watchdog{pending = false}); + +rcv(_, #watchdog{status = okay} = S) -> + set_watchdog(S); + +%% SUSPECT Receive DWA Pending = FALSE +%% Failback() +%% SetWatchdog() OKAY +%% SUSPECT Receive non-DWA Failback() +%% SetWatchdog() OKAY + +rcv('DWA', #watchdog{status = suspect} = S) -> + failback(S), + set_watchdog(S#watchdog{status = okay, + pending = false}); + +rcv(_, #watchdog{status = suspect} = S) -> + failback(S), + set_watchdog(S#watchdog{status = okay}); + +%% REOPEN Receive DWA & Pending = FALSE +%% NumDWA == 2 NumDWA++ +%% Failback() OKAY + +rcv('DWA', #watchdog{status = reopen, + num_dwa = 2 = N, + parent = Pid} + = S) -> + open(Pid, eraser(open)), + S#watchdog{status = okay, + num_dwa = N+1, + pending = false}; + +%% REOPEN Receive DWA & Pending = FALSE +%% NumDWA < 2 NumDWA++ REOPEN + +rcv('DWA', #watchdog{status = reopen, + num_dwa = N} + = S) -> + S#watchdog{num_dwa = N+1, + pending = false}; + +%% REOPEN Receive non-DWA Throwaway() REOPEN + +rcv(_, #watchdog{status = reopen} = S) -> + throwaway(S). + +%% failback/1 + +failback(#watchdog{parent = Pid}) -> + Pid ! {connection_up, self()}. + +%% timeout/1 +%% +%% The caller sets the watchdog on the return value. + +%% OKAY Timer expires & SendWatchdog() +%% !Pending SetWatchdog() +%% Pending = TRUE OKAY +%% REOPEN Timer expires & SendWatchdog() +%% !Pending SetWatchdog() +%% Pending = TRUE REOPEN + +timeout(#watchdog{status = T, + pending = false} + = S) + when T == okay; + T == reopen -> + send_watchdog(S); + +%% OKAY Timer expires & Failover() +%% Pending SetWatchdog() SUSPECT + +timeout(#watchdog{status = okay, + pending = true} + = S) -> + failover(S), + S#watchdog{status = suspect}; + +%% SUSPECT Timer expires CloseConnection() +%% SetWatchdog() DOWN +%% REOPEN Timer expires & CloseConnection() +%% Pending & SetWatchdog() +%% NumDWA < 0 DOWN + +timeout(#watchdog{status = T, + pending = P, + num_dwa = N, + transport = TPid} + = S) + when T == suspect; + T == reopen, P, N < 0 -> + exit(TPid, shutdown), + close(S), + S#watchdog{status = down}; + +%% REOPEN Timer expires & NumDWA = -1 +%% Pending & SetWatchdog() +%% NumDWA >= 0 REOPEN + +timeout(#watchdog{status = reopen, + pending = true, + num_dwa = N} + = S) + when 0 =< N -> + S#watchdog{num_dwa = -1}; + +%% DOWN Timer expires AttemptOpen() +%% SetWatchdog() DOWN +%% INITIAL Timer expires AttemptOpen() +%% SetWatchdog() INITIAL + +%% RFC 3539, 3.4.1: +%% +%% [5] While the connection is in the closed state, the AAA client MUST +%% NOT attempt to send further watchdog messages on the connection. +%% However, after the connection is closed, the AAA client continues +%% to periodically attempt to reopen the connection. +%% +%% The AAA client SHOULD wait for the transport layer to report +%% connection failure before attempting again, but MAY choose to +%% bound this wait time by the watchdog interval, Tw. + +%% Don't bound, restarting the peer process only when the previous +%% process has died. We only need to handle state down since we start +%% the first watchdog when transitioning out of initial. + +timeout(#watchdog{status = down} = S) -> + restart(S). + +%% restart/1 + +restart(#watchdog{transport = undefined} = S) -> + restart(getr(restart), S); +restart(S) -> + S. + +%% Only restart the transport in the connecting case. For an accepting +%% transport, we've registered the peer connection when leaving state +%% initial and this is used by a new accepting process to realize that +%% it's actually in state down rather then initial when receiving +%% notification of an open connection. + +restart({{connect, _} = T, Opts, Svc}, #watchdog{parent = Pid} = S) -> + Pid ! {reconnect, self()}, + S#watchdog{transport = monitor(diameter_peer_fsm:start(T, Opts, Svc))}; +restart({{accept, _}, _, _}, S) -> + S. +%% Don't currently use Opts/Svc in the accept case but having them in +%% the process dictionary is helpful if the process dies unexpectedly. + +%% dwr/1 + +dwr(#diameter_caps{origin_host = OH, + origin_realm = OR, + origin_state_id = OSI}) -> + ['DWR', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Origin-State-Id', OSI}]. diff --git a/lib/diameter/src/base/diameter_watchdog_sup.erl b/lib/diameter/src/base/diameter_watchdog_sup.erl new file mode 100644 index 0000000000..fc837fe4ef --- /dev/null +++ b/lib/diameter/src/base/diameter_watchdog_sup.erl @@ -0,0 +1,60 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Supervisor for all watchdog processes. +%% + +-module(diameter_watchdog_sup). + +-behaviour(supervisor). + +%% interface +-export([start_link/0, %% supervisor start + start_child/1]). %% watchdog start + +-export([init/1]). + +-define(NAME, ?MODULE). %% supervisor name + +%% start_link/0 + +start_link() -> + SupName = {local, ?NAME}, + supervisor:start_link(SupName, ?MODULE, []). + +%% start_child/1 +%% +%% Start a watchdog process. + +start_child(T) -> + supervisor:start_child(?NAME, [T]). + +%% init/1 + +init([]) -> + Mod = diameter_watchdog, + Flags = {simple_one_for_one, 0, 1}, + ChildSpec = {Mod, + {Mod, start_link, []}, + temporary, + 1000, + worker, + [Mod]}, + {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/compiler/.gitignore b/lib/diameter/src/compiler/.gitignore deleted file mode 100644 index d9f072e262..0000000000 --- a/lib/diameter/src/compiler/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ - -/depend.mk - diff --git a/lib/diameter/src/compiler/Makefile b/lib/diameter/src/compiler/Makefile deleted file mode 100644 index 779013bfbc..0000000000 --- a/lib/diameter/src/compiler/Makefile +++ /dev/null @@ -1,131 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -ERL_FILES = \ - $(MODULES:%=%.erl) - -TARGET_FILES = \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include ../app/diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "HRL_FILES = $(HRL_FILES)" - @echo "" - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo "" - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/src/compiler - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src/compiler - -release_docs_spec: - -force: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -depend: depend.mk - -# Generate dependencies makefile. -depend.mk: ../app/depend.sed $(ERL_FILES) Makefile - for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done \ - > $@ - --include depend.mk - -.PHONY: clean debug depend docs force info opt release_docs_spec release_spec diff --git a/lib/diameter/src/compiler/modules.mk b/lib/diameter/src/compiler/modules.mk deleted file mode 100644 index 6fbc8fa8d4..0000000000 --- a/lib/diameter/src/compiler/modules.mk +++ /dev/null @@ -1,29 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% - -MODULES = \ - diameter_codegen \ - diameter_exprecs \ - diameter_spec_scan \ - diameter_spec_util \ - diameter_make - -HRL_FILES = \ - diameter_forms.hrl - diff --git a/lib/diameter/src/depend.sed b/lib/diameter/src/depend.sed new file mode 100644 index 0000000000..8f999f646f --- /dev/null +++ b/lib/diameter/src/depend.sed @@ -0,0 +1,51 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010-2011. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# Extract include dependencies from .erl files. First line of input +# is the path to the module in question (minus the .erl extension), +# the rest is the contents of the module. +# + +1{ + s@^[^/]*/@@ + h + d +} + +# Only interested in includes of diameter hrls. +/^-include/!d +/"diameter/!d + +# Extract the name of the included files in one of two forms: +# +# $(INCDIR)/diameter.hrl +# diameter_internal.hrl + +s@^-include_lib(".*/@$(INCDIR)/@ +s@^-include("@@ +s@".*@@ + +# Retrieve the path to our module from the hold space, morph it +# into a beam path and turn it into a dependency like this: +# +# $(EBIN)/diameter_service.$(EMULATOR): $(INCDIR)/diameter.hrl + +G +s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@ diff --git a/lib/diameter/src/gen/.gitignore b/lib/diameter/src/gen/.gitignore new file mode 100644 index 0000000000..d490642eb7 --- /dev/null +++ b/lib/diameter/src/gen/.gitignore @@ -0,0 +1,2 @@ + +/diameter_gen*rl diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk new file mode 100644 index 0000000000..ef72bab17b --- /dev/null +++ b/lib/diameter/src/modules.mk @@ -0,0 +1,93 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode + +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010-2011. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% + +# Runtime dictionary files in ./dict. Modules will be generated from +# these are included in the app file. +RT_DICTS = \ + base_rfc3588 \ + base_accounting \ + relay + +# Handwritten (runtime) modules included in the app file. +RT_MODULES = \ + base/diameter \ + base/diameter_app \ + base/diameter_capx \ + base/diameter_config \ + base/diameter_codec \ + base/diameter_dict \ + base/diameter_lib \ + base/diameter_misc_sup \ + base/diameter_peer \ + base/diameter_peer_fsm \ + base/diameter_peer_fsm_sup \ + base/diameter_reg \ + base/diameter_service \ + base/diameter_service_sup \ + base/diameter_session \ + base/diameter_stats \ + base/diameter_sup \ + base/diameter_sync \ + base/diameter_types \ + base/diameter_watchdog \ + base/diameter_watchdog_sup \ + transport/diameter_etcp \ + transport/diameter_etcp_sup \ + transport/diameter_tcp \ + transport/diameter_tcp_sup \ + transport/diameter_sctp \ + transport/diameter_sctp_sup \ + transport/diameter_transport_sup + +# Handwritten (compile time) modules not included in the app file. +CT_MODULES = \ + base/diameter_callback \ + base/diameter_dbg \ + base/diameter_info \ + compiler/diameter_codegen \ + compiler/diameter_exprecs \ + compiler/diameter_spec_scan \ + compiler/diameter_spec_util \ + compiler/diameter_make + +# Released hrl files intended for public consumption. +EXTERNAL_HRL_FILES = \ + ../include/diameter.hrl \ + ../include/diameter_gen.hrl + +# Release hrl files intended for private use. +INTERNAL_HRL_FILES = \ + base/diameter_internal.hrl \ + base/diameter_types.hrl \ + compiler/diameter_forms.hrl + +# Released files relative to ../bin. +BINS = \ + diameterc + +# Released files relative to ../examples. +EXAMPLES = \ + GNUmakefile \ + peer.erl \ + client.erl \ + client_cb.erl \ + server.erl \ + server_cb.erl \ + relay.erl \ + relay_cb.erl diff --git a/lib/diameter/src/subdirs.mk b/lib/diameter/src/subdirs.mk deleted file mode 100644 index 3e12d935bc..0000000000 --- a/lib/diameter/src/subdirs.mk +++ /dev/null @@ -1,21 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% - -SUB_DIRS = compiler app transport -SUB_DIRECTORIES = $(SUB_DIRS) \ No newline at end of file diff --git a/lib/diameter/src/transport/.gitignore b/lib/diameter/src/transport/.gitignore deleted file mode 100644 index d9f072e262..0000000000 --- a/lib/diameter/src/transport/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ - -/depend.mk - diff --git a/lib/diameter/src/transport/Makefile b/lib/diameter/src/transport/Makefile deleted file mode 100644 index 4b53100fd2..0000000000 --- a/lib/diameter/src/transport/Makefile +++ /dev/null @@ -1,141 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- - -include ../../vsn.mk -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -ERL_FILES = \ - $(MODULES:%=%.erl) - -TARGET_FILES = \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include ../app/diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "HRL_FILES = $(HRL_FILES)" - @echo "" - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo "" - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# Invoked from ../app to add modules to the app file. -$(APP_TARGET): force - M=`echo $(MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ - echo "/%TRANSPORT_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ - | ed -s $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src/transport - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src/transport - -release_docs_spec: - -force: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -depend: depend.mk - -# Generate dependencies makefile. -depend.mk: ../app/depend.sed $(ERL_FILES) Makefile - for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done \ - > $@ - --include depend.mk - -.PHONY: clean debug depend docs force info opt release_docs_spec release_spec diff --git a/lib/diameter/src/transport/modules.mk b/lib/diameter/src/transport/modules.mk deleted file mode 100644 index a0dc3cf2c0..0000000000 --- a/lib/diameter/src/transport/modules.mk +++ /dev/null @@ -1,29 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% - -MODULES = \ - diameter_etcp \ - diameter_etcp_sup \ - diameter_tcp \ - diameter_tcp_sup \ - diameter_sctp \ - diameter_sctp_sup \ - diameter_transport_sup - -HRL_FILES = diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index 04e686c969..8df7cc85fe 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -17,15 +17,14 @@ # %CopyrightEnd% ifeq ($(ERL_TOP),) -TOP = $(DIAMETER_TOP) +include $(DIAMETER_TOP)/make/target.mk +include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk else -TOP = $(ERL_TOP) -DIAMETER_TOP = $(TOP)/lib/diameter +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk +DIAMETER_TOP = $(ERL_TOP)/lib/diameter endif -include $(TOP)/make/target.mk -include $(TOP)/make/$(TARGET)/otp.mk - # ---------------------------------------------------- # Application version # ---------------------------------------------------- @@ -63,13 +62,11 @@ RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) # FLAGS # ---------------------------------------------------- -include ../src/app/diameter.mk - # This is only used to compile suite locally when running with a # target like 'all' below. Target release_tests only installs source. -ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \ +ERL_COMPILE_FLAGS += +warn_unused_vars \ -DDIAMETER_CT=true \ - -I $(DIAMETER_TOP)/src/app + -I $(DIAMETER_TOP)/src/gen # ---------------------------------------------------- # Targets @@ -156,7 +153,11 @@ log: # Release Targets # ---------------------------------------------------- -include $(TOP)/make/otp_release_targets.mk +ifeq ($(ERL_TOP),) +include $(DIAMETER_TOP)/make/release_targets.mk +else +include $(ERL_TOP)/make/otp_release_targets.mk +endif release_spec: -- cgit v1.2.3 From 28580ff54b09710358ad366975289ef9a86bb867 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 16 Oct 2011 12:10:08 +0200 Subject: Use secondary expansion for src subdirectory rules Makes for a quieter rule with no recursion. --- lib/diameter/src/Makefile | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index a72bf4420b..861fc0c435 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -171,11 +171,6 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk app: $(APP_TARGET) $(APPUP_TARGET) dict: $(DICT_ERL_FILES) -# Make the modules from a subdirectory. -$(TARGET_DIRS:%/=%): - $(MAKE) \ - $(patsubst $@/%,$(EBIN)/%.$(EMULATOR),$(filter $@/%,$(TARGET_MODULES))) - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -241,3 +236,9 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PHONY: app clean depend dict info release_subdir .PHONY: debug opt release_docs_spec release_spec .PHONY: $(TARGET_DIRS:%/=%) + +.SECONDEXPANSION: + +# Make the modules from a subdirectory. +$(TARGET_DIRS:%/=%): \ + $$(patsubst $$@/%,$(EBIN)/%.$(EMULATOR),$$(filter $$@/%,$(TARGET_MODULES))) -- cgit v1.2.3 From 36a4d64ae7f39448ceb7c87bc4c8c0a9a9b72e1c Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Tue, 14 Jun 2011 15:34:11 +0200 Subject: Make epp search directory of current file first when including another file The expected behaviour of a C-style preprocessor (such as Erlang's epp) is to allow a header file to include another header file in the same directory even though that directory is not explicitly in the include path, and even if the actual include path might reference another directory containing a file with the same name. For example, if src/foo.erl explicitly includes "../include/foo.hrl", then foo.hrl should be able to include "bar.hrl" in that same directory even though "../include" might not be in the search path, and even if another file named bar.hrl could be found using the search path it should not override the one in the same directory as foo.hrl. In Erlang, the most common situation is that a user of an installed application includes a main public header file using include_lib ("appname/include/foo.hrl") and that file includes a secondary header file "bar.hrl". However, if it does this using include_lib, it causes a bootstrapping problem - in the build environment for the application itself, the application is not necessarily found by name. On the other hand, if foo.hrl uses a plain include, then bar.hrl might be found when the application is built (if explicit paths are set in the makefils) but not later on when a user includes the main header file of the installed application via include_lib. By making -include always look in the directory of the current file before it uses the search path, this problem is remedied, and include directives behave in a more intuitive way. This completes a partial fix in R11 that only worked for include_lib(). --- lib/stdlib/src/epp.erl | 28 ++++++++++++++---------- lib/stdlib/test/epp_SUITE.erl | 20 +++++++++++++++-- lib/stdlib/test/epp_SUITE_data/bar.hrl | 4 ++++ lib/stdlib/test/epp_SUITE_data/include/bar.hrl | 3 +++ lib/stdlib/test/epp_SUITE_data/include/foo.hrl | 4 ++++ lib/stdlib/test/epp_SUITE_data/include_local.erl | 6 +++++ 6 files changed, 51 insertions(+), 14 deletions(-) create mode 100644 lib/stdlib/test/epp_SUITE_data/bar.hrl create mode 100644 lib/stdlib/test/epp_SUITE_data/include/bar.hrl create mode 100644 lib/stdlib/test/epp_SUITE_data/include/foo.hrl create mode 100644 lib/stdlib/test/epp_SUITE_data/include_local.erl diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 230a4a0612..ccc14610d7 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -267,8 +267,10 @@ init_server(Pid, Name, File, AtLocation, Path, Pdm, Pre) -> case user_predef(Pdm, Ms0) of {ok,Ms1} -> epp_reply(Pid, {ok,self()}), + %% ensure directory of current source file is first in path + Path1 = [filename:dirname(Name) | Path], St = #epp{file=File, location=AtLocation, delta=0, name=Name, - name2=Name, path=Path, macs=Ms1, pre_opened = Pre}, + name2=Name, path=Path1, macs=Ms1, pre_opened = Pre}, From = wait_request(St), enter_file_reply(From, Name, AtLocation, AtLocation), wait_req_scan(St); @@ -360,18 +362,18 @@ wait_req_skip(St, Sis) -> From = wait_request(St), skip_toks(From, St, Sis). -%% enter_file(Path, FileName, IncludeToken, From, EppState) +%% enter_file(FileName, IncludeToken, From, EppState) %% leave_file(From, EppState) %% Handle entering and leaving included files. Notify caller when the %% current file is changed. Note it is an error to exit a file if we are %% in a conditional. These functions never return. -enter_file(_Path, _NewName, Inc, From, St) +enter_file(_NewName, Inc, From, St) when length(St#epp.sstk) >= 8 -> epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include"}}}), wait_req_scan(St); -enter_file(Path, NewName, Inc, From, St) -> - case file:path_open(Path, NewName, [read]) of +enter_file(NewName, Inc, From, St) -> + case file:path_open(St#epp.path, NewName, [read]) of {ok,NewF,Pname} -> Loc = start_loc(St#epp.location), wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); @@ -384,13 +386,16 @@ enter_file(Path, NewName, Inc, From, St) -> %% Set epp to use this file and "enter" it. enter_file2(NewF, Pname, From, St, AtLocation) -> - enter_file2(NewF, Pname, From, St, AtLocation, []). - -enter_file2(NewF, Pname, From, St, AtLocation, ExtraPath) -> Loc = start_loc(AtLocation), enter_file_reply(From, Pname, Loc, AtLocation), Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St#epp.macs), - Path = St#epp.path ++ ExtraPath, + %% update the head of the include path to be the directory of the new + %% source file, so that an included file can always include other files + %% relative to its current location (this is also how C does it); note + %% that the directory of the parent source file (the previous head of + %% the path) must be dropped, otherwise the path used within the current + %% file will depend on the order of file inclusions in the parent files + Path = [filename:dirname(Pname) | tl(St#epp.path)], #epp{file=NewF,location=Loc,name=Pname,delta=0, sstk=[St|St#epp.sstk],path=Path,macs=Ms}. @@ -655,7 +660,7 @@ scan_undef(_Toks, Undef, From, St) -> scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) -> NewName = expand_var(NewName0), - enter_file(St#epp.path, NewName, Inc, From, St); + enter_file(NewName, Inc, From, St); scan_include(_Toks, Inc, From, St) -> epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include}}}), wait_req_scan(St). @@ -687,9 +692,8 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], LibName = fname_join([LibDir | Rest]), case file:open(LibName, [read]) of {ok,NewF} -> - ExtraPath = [filename:dirname(LibName)], wait_req_scan(enter_file2(NewF, LibName, From, - St, Loc, ExtraPath)); + St, Loc)); {error,_E2} -> epp_reply(From, {error,{abs_loc(Inc),epp, diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 57f3f4eddb..e58022f4da 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -20,7 +20,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). --export([rec_1/1, predef_mac/1, +-export([rec_1/1, include_local/1, predef_mac/1, upcase_mac_1/1, upcase_mac_2/1, variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, @@ -63,7 +63,7 @@ end_per_testcase(_, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [rec_1, {group, upcase_mac}, predef_mac, + [rec_1, {group, upcase_mac}, include_local, predef_mac, {group, variable}, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, overload_mac, otp_8388, otp_8470, otp_8503, otp_8562, @@ -97,6 +97,22 @@ rec_1(Config) when is_list(Config) -> ?line check_errors(List), ok. +include_local(doc) -> + []; +include_local(suite) -> + []; +include_local(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line File = filename:join(DataDir, "include_local.erl"), + %% include_local.erl includes include/foo.hrl which + %% includes bar.hrl (also in include/) without requiring + %% any additional include path, and overriding any file + %% of the same name that the path points to + ?line {ok, List} = epp:parse_file(File, [DataDir], []), + ?line {value, {attribute,_,a,{true,true}}} = + lists:keysearch(a,3,List), + ok. + %%% Here is a little reimplementation of epp:parse_file, which times out %%% after 4 seconds if the epp server doesn't respond. If we use the %%% regular epp:parse_file, the test case will time out, and then epp diff --git a/lib/stdlib/test/epp_SUITE_data/bar.hrl b/lib/stdlib/test/epp_SUITE_data/bar.hrl new file mode 100644 index 0000000000..01c527d549 --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/bar.hrl @@ -0,0 +1,4 @@ +%% should not be included from include/foo.hrl even though the +%% include path points here - include/bar.hrl overrides it + +-define(BAR_HRL, false). diff --git a/lib/stdlib/test/epp_SUITE_data/include/bar.hrl b/lib/stdlib/test/epp_SUITE_data/include/bar.hrl new file mode 100644 index 0000000000..038d3c900e --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include/bar.hrl @@ -0,0 +1,3 @@ +%% included from foo.hrl in same directory + +-define(BAR_HRL, true). diff --git a/lib/stdlib/test/epp_SUITE_data/include/foo.hrl b/lib/stdlib/test/epp_SUITE_data/include/foo.hrl new file mode 100644 index 0000000000..a6dfa3d18a --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include/foo.hrl @@ -0,0 +1,4 @@ +%% includes bar.hrl in same directory + +-define(FOO_HRL, true). +-include("bar.hrl"). diff --git a/lib/stdlib/test/epp_SUITE_data/include_local.erl b/lib/stdlib/test/epp_SUITE_data/include_local.erl new file mode 100644 index 0000000000..c8e155a064 --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include_local.erl @@ -0,0 +1,6 @@ + +-module(include_local). + +-include("include/foo.hrl"). + +-a({?FOO_HRL, ?BAR_HRL}). -- cgit v1.2.3 From f0db3eff30b298e765a9af78a86f4865cad21da8 Mon Sep 17 00:00:00 2001 From: Paul Guyot Date: Tue, 6 Sep 2011 14:38:39 +0200 Subject: [crypto] Add DES and Triple DES cipher feedback (CFB) mode functions --- lib/crypto/c_src/crypto.c | 48 ++++++++++++++++++ lib/crypto/doc/src/crypto.xml | 79 ++++++++++++++++++++++++++++- lib/crypto/src/crypto.erl | 51 +++++++++++++++++++ lib/crypto/test/crypto_SUITE.erl | 104 +++++++++++++++++++++++++++++++++++++-- 4 files changed, 278 insertions(+), 4 deletions(-) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index c781ccb302..10fe333d18 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -134,8 +134,10 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -210,8 +212,10 @@ static ErlNifFunc nif_funcs[] = { {"hmac_final", 1, hmac_final}, {"hmac_final_n", 2, hmac_final}, {"des_cbc_crypt", 4, des_cbc_crypt}, + {"des_cfb_crypt", 4, des_cfb_crypt}, {"des_ecb_crypt", 3, des_ecb_crypt}, {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, + {"des_ede3_cfb_crypt", 6, des_ede3_cfb_crypt}, {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, @@ -693,6 +697,25 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a return ret; } +static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Ivec, Text, IsEncrypt) */ + ErlNifBinary key, ivec, text; + DES_key_schedule schedule; + DES_cblock ivec_clone; /* writable copy */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { + return enif_make_badarg(env); + } + memcpy(&ivec_clone, ivec.data, 8); + DES_set_key((const_DES_cblock*)key.data, &schedule); + DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), + 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); + return ret; +} + static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, Text/Cipher, IsEncrypt) */ ErlNifBinary key, text; @@ -735,6 +758,31 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T return ret; } +static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ + ErlNifBinary key1, key2, key3, ivec, text; + DES_key_schedule schedule1, schedule2, schedule3; + DES_cblock ivec_clone; /* writable copy */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8 + || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[4], &text)) { + return enif_make_badarg(env); + } + + memcpy(&ivec_clone, ivec.data, 8); + DES_set_key((const_DES_cblock*)key1.data, &schedule1); + DES_set_key((const_DES_cblock*)key2.data, &schedule2); + DES_set_key((const_DES_cblock*)key3.data, &schedule3); + DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), + 8, text.size, &schedule1, &schedule2, &schedule3, + &ivec_clone, (argv[5] == atom_true)); + return ret; +} + static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data, IsEncrypt) */ ErlNifBinary key, ivec, text; diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 179ba4498c..110ab5b746 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -403,6 +403,51 @@ Mpint() = >]]> data from the previous iteration step.

+ + des_cfb_encrypt(Key, IVec, Text) -> Cipher + Encrypt Textaccording to DES in CFB mode + + Key = Text = iolist() | binary() + IVec = Cipher = binary() + + +

Encrypts Text according to DES in 8-bit CFB + mode. Key is the DES key, and IVec is an + arbitrary initializing vector. The lengths of Key and + IVec must be 64 bits (8 bytes).

+ + + + des_cfb_decrypt(Key, IVec, Cipher) -> Text + Decrypt Cipheraccording to DES in CFB mode + + Key = Cipher = iolist() | binary() + IVec = Text = binary() + + +

Decrypts Cipher according to DES in 8-bit CFB mode. + Key is the DES key, and IVec is an arbitrary + initializing vector. Key and IVec must have + the same values as those used when encrypting. The lengths of + Key and IVec must be 64 bits (8 bytes).

+ + + + des_cfb_ivec(IVec, Data) -> NextIVec + Get IVec to be used in next iteration of + des_cfb_[ecrypt|decrypt] + + IVec = iolist() | binary() + Data = iolist() | binary() + NextIVec = binary() + + +

Returns the IVec to be used in a next iteration of + des_cfb_[encrypt|decrypt]. IVec is the vector + used in the previous iteration step. Data is the encrypted + data from the previous iteration step.

+ + des3_cbc_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher Encrypt Textaccording to DES3 in CBC mode @@ -421,7 +466,7 @@ Mpint() = >]]> des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text - Decrypt Cipheraccording to DES in CBC mode + Decrypt Cipheraccording to DES3 in CBC mode Key1 = Key2 = Key3 = Cipher = iolist() | binary() IVec = Text = binary() @@ -437,6 +482,38 @@ Mpint() = >]]> Key3, and IVec must be 64 bits (8 bytes).

 + + des3_cfb_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher + Encrypt Textaccording to DES3 in CFB mode + + Key1 =Key2 = Key3 Text = iolist() | binary() + IVec = Cipher = binary() + + +

Encrypts Text according to DES3 in 8-bit CFB + mode. Key1, Key2, Key3, are the DES + keys, and IVec is an arbitrary initializing + vector. The lengths of each of Key1, Key2, + Key3 and IVec must be 64 bits (8 bytes).

+ + + + des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text + Decrypt Cipheraccording to DES3 in CFB mode + + Key1 = Key2 = Key3 = Cipher = iolist() | binary() + IVec = Text = binary() + + +

Decrypts Cipher according to DES3 in 8-bit CFB mode. + Key1, Key2, Key3 are the DES key, and + IVec is an arbitrary initializing vector. + Key1, Key2, Key3 and IVec must + and IVec must have the same values as those used when + encrypting. The lengths of Key1, Key2, + Key3, and IVec must be 64 bits (8 bytes).

+ + des_ecb_encrypt(Key, Text) -> Cipher diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index c35dfcebab..862f3df0f8 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -31,7 +31,9 @@ -export([hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). -export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]). -export([des_ecb_encrypt/2, des_ecb_decrypt/2]). +-export([des_cfb_encrypt/3, des_cfb_decrypt/3, des_cfb_ivec/2]). -export([des3_cbc_encrypt/5, des3_cbc_decrypt/5]). +-export([des3_cfb_encrypt/5, des3_cfb_decrypt/5]). -export([blowfish_ecb_encrypt/2, blowfish_ecb_decrypt/2]). -export([blowfish_cbc_encrypt/3, blowfish_cbc_decrypt/3]). -export([blowfish_cfb64_encrypt/3, blowfish_cfb64_decrypt/3]). @@ -68,8 +70,10 @@ sha_mac, sha_mac_96, sha_mac_init, sha_mac_update, sha_mac_final, des_cbc_encrypt, des_cbc_decrypt, + des_cfb_encrypt, des_cfb_decrypt, des_ecb_encrypt, des_ecb_decrypt, des_ede3_cbc_encrypt, des_ede3_cbc_decrypt, + des_ede3_cfb_encrypt, des_ede3_cfb_decrypt, aes_cfb_128_encrypt, aes_cfb_128_decrypt, rand_bytes, strong_rand_bytes, @@ -293,6 +297,33 @@ des_cbc_ivec(Data) when is_binary(Data) -> des_cbc_ivec(Data) when is_list(Data) -> des_cbc_ivec(list_to_binary(Data)). +%% +%% DES - in 8-bits cipher feedback mode (CFB) +%% +-spec des_cfb_encrypt(iodata(), binary(), iodata()) -> binary(). +-spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary(). + +des_cfb_encrypt(Key, IVec, Data) -> + des_cfb_crypt(Key, IVec, Data, true). + +des_cfb_decrypt(Key, IVec, Data) -> + des_cfb_crypt(Key, IVec, Data, false). + +des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + +%% +%% dec_cfb_ivec(IVec, Data) -> binary() +%% +%% Returns the IVec to be used in the next iteration of +%% des_cfb_[encrypt|decrypt]. +%% +-spec des_cfb_ivec(iodata(), iodata()) -> binary(). + +des_cfb_ivec(IVec, Data) -> + IVecAndData = list_to_binary([IVec, Data]), + {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), + NewIVec. + %% %% DES - in electronic codebook mode (ECB) %% @@ -325,6 +356,26 @@ des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. +%% +%% DES3 - in 8-bits cipher feedback mode (CFB) +%% +-spec des3_cfb_encrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> + binary(). +-spec des3_cfb_decrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> + binary(). + +des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data). +des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true). + +des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data). +des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false). + +des_ede3_cfb_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + %% %% Blowfish %% diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 283aadb6ea..b86575ad21 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -44,7 +44,11 @@ md5_mac_io/1, des_cbc/1, des_cbc_iter/1, + des_cfb/1, + des_cfb_iter/1, des_ecb/1, + des3_cbc/1, + des3_cfb/1, aes_cfb/1, aes_cbc/1, aes_cbc_iter/1, @@ -75,8 +79,8 @@ all() -> md5_mac_io, sha, sha_update, hmac_update_sha, hmac_update_sha_n, hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5, %% sha256, sha256_update, sha512,sha512_update, - des_cbc, aes_cfb, aes_cbc, - aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, + des_cbc, des_cfb, des3_cbc, des3_cfb, aes_cfb, aes_cbc, + aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_cfb_iter, des_ecb, rand_uniform_test, strong_rand_test, rsa_verify_test, dsa_verify_test, rsa_sign_test, dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test, @@ -291,7 +295,7 @@ sha(Config) when is_list(Config) -> hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). -%% +%% hmac_update_sha_n(doc) -> ["Request a larger-than-allowed SHA1 HMAC using hmac_init, hmac_update, and hmac_final_n. " "Expected values for examples are generated using crypto:sha_mac." ]; @@ -544,6 +548,40 @@ des_cbc_iter(Config) when is_list(Config) -> ?line m(Cipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" "0f683788499a7c05f6")). +%% +%% +des_cfb(doc) -> + "Encrypt and decrypt according to CFB DES. and check the result. " + "Example is from FIPS-81."; +des_cfb(suite) -> + []; +des_cfb(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the", + ?line Cipher = crypto:des_cfb_encrypt(Key, IVec, Plain), + ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")), + ?line m(list_to_binary(Plain), + crypto:des_cfb_decrypt(Key, IVec, Cipher)). + +%% +%% +des_cfb_iter(doc) -> + "Encrypt and decrypt according to CFB DES in two steps, and " + "check the result. Example is from FIPS-81."; +des_cfb_iter(suite) -> + []; +des_cfb_iter(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain1 = "Now i", + ?line Plain2 = "s the", + ?line Cipher1 = crypto:des_cfb_encrypt(Key, IVec, Plain1), + ?line IVec2 = crypto:des_cfb_ivec(IVec, Cipher1), + ?line Cipher2 = crypto:des_cfb_encrypt(Key, IVec2, Plain2), + ?line Cipher = list_to_binary([Cipher1, Cipher2]), + ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")). + %% %% des_ecb(doc) -> @@ -566,6 +604,66 @@ des_ecb(Config) when is_list(Config) -> ?line Cipher6 = crypto:des_ecb_decrypt(Key, hexstr2bin("893d51ec4b563b53")), ?line m(Cipher6, <<"for all ">>). +%% +%% +des3_cbc(doc) -> + "Encrypt and decrypt according to CBC 3DES, and check the result."; +des3_cbc(suite) -> + []; +des3_cbc(Config) when is_list(Config) -> + ?line Key1 = hexstr2bin("0123456789abcdef"), + ?line Key2 = hexstr2bin("fedcba9876543210"), + ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain), + ?line m(Cipher, hexstr2bin("8a2667ee5577267cd9b1af2c5a0480" + "0bac1ae66970fb2b89")), + ?line m(list_to_binary(Plain), + crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("eb33ec6ede2c8e90f6877e77b95d5" + "4c83cee22907f7f0041ca1b7abe202bfafe")), + ?line m(list_to_binary(Plain2), + crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher2)), + + ?line Key = hexstr2bin("0123456789abcdef"), + ?line DESCipher = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain), + ?line m(DESCipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" + "0f683788499a7c05f6")), + ?line m(list_to_binary(Plain), + crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher)), + ?line DESCipher2 = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain2), + ?line m(DESCipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" + "9484521388fa59ae67d58d2e77e86062733")), + ?line m(list_to_binary(Plain2), + crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher2)). + +%% +%% +des3_cfb(doc) -> + "Encrypt and decrypt according to CFB 3DES, and check the result."; +des3_cfb(suite) -> + []; +des3_cfb(Config) when is_list(Config) -> + ?line Key1 = hexstr2bin("0123456789abcdef"), + ?line Key2 = hexstr2bin("fedcba9876543210"), + ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain), + ?line m(Cipher, hexstr2bin("fc0ba7a20646ba53cc8bff263f0937" + "1deab42a00666db02c")), + ?line m(list_to_binary(Plain), + crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("8582c59ac01897422632c0accb66c" + "e413f5efab838fce7e41e2ba67705bad5bc")), + ?line m(list_to_binary(Plain2), + crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher2)). + %% %% aes_cfb(doc) -> -- cgit v1.2.3 From f8f2b8fbf9c19e582b21bb701d38f8fb769821e8 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Tue, 6 Sep 2011 14:41:26 +0200 Subject: [crypto] Remove swedish characters from test code --- lib/crypto/test/crypto_SUITE.erl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index b86575ad21..21df8b5526 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -1323,8 +1323,8 @@ rc4_test(doc) -> rc4_test(suite) -> []; rc4_test(Config) when is_list(Config) -> - CT1 = <<"hej på dig">>, - R1 = <<71,112,14,44,140,33,212,144,155,47>>, + CT1 = <<"Yo baby yo">>, + R1 = <<118,122,68,110,157,166,141,212,139,39>>, K = "apaapa", R1 = crypto:rc4_encrypt(K, CT1), CT1 = crypto:rc4_encrypt(K, R1), @@ -1338,14 +1338,14 @@ rc4_stream_test(doc) -> rc4_stream_test(suite) -> []; rc4_stream_test(Config) when is_list(Config) -> - CT1 = <<"hej">>, - CT2 = <<" på dig">>, + CT1 = <<"Yo ">>, + CT2 = <<"baby yo">>, K = "apaapa", State0 = crypto:rc4_set_key(K), {State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1), {_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2), R = list_to_binary([R1, R2]), - <<71,112,14,44,140,33,212,144,155,47>> = R, + <<118,122,68,110,157,166,141,212,139,39>> = R, ok. blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."]; -- cgit v1.2.3 From 0f5d56109d7b51298a2c90dae1b11ba5819471b2 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 16 Oct 2011 12:27:23 +0200 Subject: Simpler release targets for src subdirectories --- lib/diameter/src/Makefile | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 861fc0c435..f6ceb7217f 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -194,15 +194,12 @@ release_spec: opt $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) \ $(RELSYSDIR)/include $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples - for dir in $(TARGET_DIRS); do \ - $(MAKE) release_subdir SRCDIR=$$dir; \ - done + $(MAKE) $(TARGET_DIRS:%/=release_src_%) -release_subdir: - [ -d "$(SRCDIR)" ] - $(INSTALL_DATA) $(filter $(SRCDIR)%,$(TARGET_MODULES:%=%.erl) \ - $(INTERNAL_HRL_FILES)) \ - $(RELSYSDIR)/src/$(SRCDIR) +$(TARGET_DIRS:%/=release_src_%): release_src_%: + $(INSTALL_DATA) $(filter $*/%,$(TARGET_MODULES:%=%.erl) \ + $(INTERNAL_HRL_FILES)) \ + $(RELSYSDIR)/src/$* release_docs_spec: @@ -235,7 +232,7 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) .PHONY: app clean depend dict info release_subdir .PHONY: debug opt release_docs_spec release_spec -.PHONY: $(TARGET_DIRS:%/=%) +.PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) .SECONDEXPANSION: -- cgit v1.2.3 From af9759875f237353339fad921ad82a712f889dcc Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 17 Oct 2011 18:36:51 +0200 Subject: Need absolute -pa for bootstrap build Otherwise include_lib will fail. --- lib/diameter/src/Makefile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index f6ceb7217f..6b3a5e340e 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -106,9 +106,11 @@ ERL_COMPILE_FLAGS += \ +'{parse_transform,sys_pre_attributes}' \ +'{attribute,insert,app_vsn,$(APP_VSN)}' \ +warn_unused_vars \ - -pa $(EBIN) \ + -pa $(realpath $(EBIN)) \ -I $(INCDIR) \ -I gen +# -pa is so that we can include_lib from our include directory. The +# path has to be absolute to contain the application name. # ---------------------------------------------------- # Targets -- cgit v1.2.3 From d76f146406eff8650969253708291c98a4110351 Mon Sep 17 00:00:00 2001 From: Tuncer Ayaz Date: Fri, 13 May 2011 17:27:29 +0200 Subject: erts: convert variadic nif funs into inline funs --- erts/emulator/beam/erl_nif_api_funcs.h | 194 +++++++++++++++++++++++++++++++++ 1 file changed, 194 insertions(+) diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 18f2c022eb..0753c56c9b 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -266,6 +266,195 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); */ #endif + +#if defined(__GNUC__) + +# define ERL_NIF_INLINE __inline__ + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_tuple(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_tuple(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_tuple(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_tuple(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_tuple(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_tuple(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_tuple(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_tuple(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_tuple9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_tuple(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list1(ErlNifEnv* env, + ERL_NIF_TERM e1) +{ + return enif_make_list(env, 1, e1); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list2(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2) +{ + return enif_make_list(env, 2, e1, e2); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list3(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3) +{ + return enif_make_list(env, 3, e1, e2, e3); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list4(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4) +{ + return enif_make_list(env, 4, e1, e2, e3, e4); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list5(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5) +{ + return enif_make_list(env, 5, e1, e2, e3, e4, e5); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list6(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6) +{ + return enif_make_list(env, 6, e1, e2, e3, e4, e5, e6); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list7(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7) +{ + return enif_make_list(env, 7, e1, e2, e3, e4, e5, e6, e7); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list8(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8) +{ + return enif_make_list(env, 8, e1, e2, e3, e4, e5, e6, e7, e8); +} + +static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env, + ERL_NIF_TERM e1, + ERL_NIF_TERM e2, + ERL_NIF_TERM e3, + ERL_NIF_TERM e4, + ERL_NIF_TERM e5, + ERL_NIF_TERM e6, + ERL_NIF_TERM e7, + ERL_NIF_TERM e8, + ERL_NIF_TERM e9) +{ + return enif_make_list(env, 9, e1, e2, e3, e4, e5, e6, e7, e8, e9); +} + +# undef ERL_NIF_INLINE + +#else + #ifndef enif_make_list1 # define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1) # define enif_make_list2(ENV,E1,E2) enif_make_list(ENV,2,E1,E2) @@ -285,6 +474,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); # define enif_make_tuple7(ENV,E1,E2,E3,E4,E5,E6,E7) enif_make_tuple(ENV,7,E1,E2,E3,E4,E5,E6,E7) # define enif_make_tuple8(ENV,E1,E2,E3,E4,E5,E6,E7,E8) enif_make_tuple(ENV,8,E1,E2,E3,E4,E5,E6,E7,E8) # define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) +#endif + +#endif /* defined(__GNUC__) */ + +#ifndef enif_make_pid # define enif_make_pid(ENV, PID) ((const ERL_NIF_TERM)((PID)->pid)) -- cgit v1.2.3 From ec153fa6d7ba58a741e18f36b12736ec55243d35 Mon Sep 17 00:00:00 2001 From: Lukas Larsson Date: Wed, 19 Oct 2011 15:41:23 +0200 Subject: Update documentation after changes in integer and float comparison --- system/doc/reference_manual/expressions.xml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 497d7eb464..5673f2494e 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -561,11 +561,15 @@ number < atom < reference < fun < port < pid < tuple < list

Lists are compared element by element. Tuples are ordered by size, two tuples with the same size are compared element by element.

-

If one of the compared terms is an integer and the other a - float, the integer is first converted into a float, unless the - operator is one of =:= and =/=. If the integer is too big to fit - in a float no conversion is done, but the order is determined by - inspecting the sign of the numbers.

+

When comparing an integer to a float, the term with the lesser + precision will be converted into the other term's type, unless the + operator is one of =:= and =/=. A float is more precise than + an integer until all significant figures of the float are to the left of + the decimal point. This happens when the float is larger/smaller then + +/-9007199254740992.0. The conversion strategy is changed + depending on the size of the float because otherwise comparison of large + floats and integers would loose their transitivity.

+

Returns the Boolean value of the expression, true or false.

Examples:

-- cgit v1.2.3 From ff1fb99fb54ef93cd778366993a448fde2b44d82 Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Wed, 19 Oct 2011 16:28:10 +0200 Subject: Fix erroneous merge resolution Previously removed code erroneously reappeared in a merge to the master branch (ec36499d7e329b4dc69a1a3be3422eac7907c260). --- erts/aclocal.m4 | 3 --- 1 file changed, 3 deletions(-) diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 27f643921e..bd228a2d1f 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -1366,9 +1366,6 @@ case "$GCC-$host_cpu" in ;; esac -test $enable_ethread_pre_pentium4_compatibility = yes && - AC_DEFINE(ETHR_PRE_PENTIUM4_COMPAT, 1, [Define if you want compatibility with x86 processors before pentium4.]) - AC_DEFINE(ETHR_HAVE_ETHREAD_DEFINES, 1, \ [Define if you have all ethread defines]) -- cgit v1.2.3 From 955bbc378a146611929551cdabcfe63264a570ac Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 16 Oct 2011 15:09:35 +0200 Subject: Minor tweaks and cleanup Tweak some comments and variable names, move things around a bit (default src target is now opt, not debug), only clean what's built, use +warn_export_vars. --- lib/diameter/src/Makefile | 101 ++++++++++++++++++++----------------------- lib/diameter/src/modules.mk | 14 +++--- lib/diameter/test/Makefile | 77 ++++++++++++++------------------- lib/diameter/test/modules.mk | 2 +- 4 files changed, 88 insertions(+), 106 deletions(-) diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 6b3a5e340e..ea1e43875e 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -46,15 +46,14 @@ INCDIR = ../include VPATH = .:base:compiler:transport:gen # ---------------------------------------------------- -# Target Specs +# Target specs # ---------------------------------------------------- include modules.mk -DICT_FILES = $(RT_DICTS:%=dict/%.dia) -DICT_MODULES = $(RT_DICTS:%=gen/diameter_gen_%) -DICT_ERL_FILES = $(DICT_MODULES:%=%.erl) -DICT_HRL_FILES = $(DICT_MODULES:%=%.hrl) +DICT_MODULES = $(DICTS:%=gen/diameter_gen_%) +DICT_ERLS = $(DICT_MODULES:%=%.erl) +DICT_HRLS = $(DICT_MODULES:%=%.hrl) # Modules to build before compiling dictionaries. COMPILER_MODULES = $(filter compiler/%, $(CT_MODULES)) @@ -91,11 +90,8 @@ APPUP_FILE = diameter.appup APPUP_SRC = $(APPUP_FILE).src APPUP_TARGET = $(EBIN)/$(APPUP_FILE) -EXAMPLE_FILES = $(EXAMPLES:%=../examples/%) -BIN_FILES = $(BINS:%=../bin/%) - # ---------------------------------------------------- -# FLAGS +# Flags # ---------------------------------------------------- ifeq ($(TYPE),debug) @@ -105,27 +101,39 @@ endif ERL_COMPILE_FLAGS += \ +'{parse_transform,sys_pre_attributes}' \ +'{attribute,insert,app_vsn,$(APP_VSN)}' \ + +warn_export_vars \ +warn_unused_vars \ -pa $(realpath $(EBIN)) \ -I $(INCDIR) \ -I gen -# -pa is so that we can include_lib from our include directory. The -# path has to be absolute to contain the application name. +# -pa is to be able to include_lib from the include directory: the +# path must contain the application name. # ---------------------------------------------------- # Targets # ---------------------------------------------------- +# erl/hrl from dictionary file. +gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia + ../bin/diameterc -o gen -i $(EBIN) $< + +opt: $(TARGET_FILES) + debug: @$(MAKE) TYPE=debug opt -opt: $(TARGET_FILES) +# Generate the app file. +$(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk + M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ + sed -e 's;%VSN%;$(VSN);' \ + -e "s;%MODULES%;$$M;" \ + $< > $@ -clean: - rm -f $(TARGET_FILES) $(DICT_ERL_FILES) $(DICT_HRL_FILES) - rm -f $(APP_TARGET) $(APPUP_TARGET) - rm -f errs core *~ gen/diameter_gen_*.forms gen/diameter_gen_*.spec - rm -f depend.mk +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +app: $(APP_TARGET) $(APPUP_TARGET) +dict: $(DICT_ERLS) docs: @@ -133,7 +141,7 @@ list = echo $(1):; echo $($(1)) | tr ' ' '\n' | sort | sed 's@^@ @' info: @echo ======================================== - @$(call list,RT_DICTS) + @$(call list,DICTS) @echo @$(call list,RT_MODULES) @echo @@ -143,38 +151,21 @@ info: @echo @$(call list,TARGET_DIRS) @echo - @$(call list,EXTERNAL_HRL_FILES) + @$(call list,EXTERNAL_HRLS) @echo - @$(call list,INTERNAL_HRL_FILES) + @$(call list,INTERNAL_HRLS) @echo - @$(call list,EXAMPLE_FILES) + @$(call list,EXAMPLES) @echo - @$(call list,BIN_FILES) + @$(call list,BINS) @echo ======================================== -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# erl/hrl from dictionary file. -gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia - ../bin/diameterc -o gen -i $(EBIN) $< - -# Generate the app file. -$(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk - M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ - sed -e 's;%VSN%;$(VSN);' \ - -e "s;%MODULES%;$$M;" \ - $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -app: $(APP_TARGET) $(APPUP_TARGET) -dict: $(DICT_ERL_FILES) +clean: + rm -f $(TARGET_FILES) $(DICT_ERLS) $(DICT_HRLS) + rm -f depend.mk # ---------------------------------------------------- -# Release Target +# Release targets # ---------------------------------------------------- ifeq ($(ERL_TOP),) @@ -186,21 +177,21 @@ endif release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/bin \ $(RELSYSDIR)/ebin \ - $(RELSYSDIR)/src/dict \ - $(TARGET_DIRS:%=$(RELSYSDIR)/src/%) \ + $(RELSYSDIR)/examples \ $(RELSYSDIR)/include \ - $(RELSYSDIR)/examples - $(INSTALL_SCRIPT) $(BIN_FILES) $(RELSYSDIR)/bin + $(RELSYSDIR)/src/dict \ + $(TARGET_DIRS:%/=$(RELSYSDIR)/src/%) + $(INSTALL_SCRIPT) $(BINS:%=../bin/%) $(RELSYSDIR)/bin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(DICT_FILES) $(RELSYSDIR)/src/dict - $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) \ + $(INSTALL_DATA) $(EXAMPLES:%=../examples/%) $(RELSYSDIR)/examples + $(INSTALL_DATA) $(EXTERNAL_HRLS:%=../include/%) $(DICT_HRLS) \ $(RELSYSDIR)/include - $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples + $(INSTALL_DATA) $(DICTS:%=dict/%.dia) $(RELSYSDIR)/src/dict $(MAKE) $(TARGET_DIRS:%/=release_src_%) $(TARGET_DIRS:%/=release_src_%): release_src_%: $(INSTALL_DATA) $(filter $*/%,$(TARGET_MODULES:%=%.erl) \ - $(INTERNAL_HRL_FILES)) \ + $(INTERNAL_HRLS)) \ $(RELSYSDIR)/src/$* release_docs_spec: @@ -231,13 +222,17 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile -include depend.mk -.PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) +.PRECIOUS: $(DICT_ERLS) $(DICT_HRLS) .PHONY: app clean depend dict info release_subdir .PHONY: debug opt release_docs_spec release_spec .PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) +# ---------------------------------------------------- +# Targets using secondary expansion +# ---------------------------------------------------- + .SECONDEXPANSION: -# Make the modules from a subdirectory. +# Make beams from a subdirectory. $(TARGET_DIRS:%/=%): \ $$(patsubst $$@/%,$(EBIN)/%.$(EMULATOR),$$(filter $$@/%,$(TARGET_MODULES))) diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk index ef72bab17b..c7cbe598af 100644 --- a/lib/diameter/src/modules.mk +++ b/lib/diameter/src/modules.mk @@ -19,7 +19,7 @@ # Runtime dictionary files in ./dict. Modules will be generated from # these are included in the app file. -RT_DICTS = \ +DICTS = \ base_rfc3588 \ base_accounting \ relay @@ -66,13 +66,13 @@ CT_MODULES = \ compiler/diameter_spec_util \ compiler/diameter_make -# Released hrl files intended for public consumption. -EXTERNAL_HRL_FILES = \ - ../include/diameter.hrl \ - ../include/diameter_gen.hrl +# Released hrl files in ../include intended for public consumption. +EXTERNAL_HRLS = \ + diameter.hrl \ + diameter_gen.hrl -# Release hrl files intended for private use. -INTERNAL_HRL_FILES = \ +# Released hrl files intended for private use. +INTERNAL_HRLS = \ base/diameter_internal.hrl \ base/diameter_types.hrl \ compiler/diameter_forms.hrl diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index 8df7cc85fe..69bcabbfbb 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -22,7 +22,6 @@ include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk else include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -DIAMETER_TOP = $(ERL_TOP)/lib/diameter endif # ---------------------------------------------------- @@ -45,18 +44,11 @@ RELSYSDIR = $(RELEASE_PATH)/diameter_test include modules.mk -EBIN = . - -HRL_FILES = $(INTERNAL_HRL_FILES) -ERL_FILES = $(MODULES:%=%.erl) - -SOURCE = $(HRL_FILES) $(ERL_FILES) +ERL_FILES = $(MODULES:%=%.erl) TARGET_FILES = $(MODULES:%=%.$(EMULATOR)) SUITE_MODULES = $(filter diameter_%_SUITE, $(MODULES)) -SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) - -RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) +SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) # ---------------------------------------------------- # FLAGS @@ -64,9 +56,10 @@ RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) # This is only used to compile suite locally when running with a # target like 'all' below. Target release_tests only installs source. -ERL_COMPILE_FLAGS += +warn_unused_vars \ +ERL_COMPILE_FLAGS += +warn_export_vars \ + +warn_unused_vars \ -DDIAMETER_CT=true \ - -I $(DIAMETER_TOP)/src/gen + -I ../src/gen # ---------------------------------------------------- # Targets @@ -82,62 +75,52 @@ clean: realclean: clean rm -rf log - rm -f errs core *~ - -.PHONY: all tests debug opt clean realclean docs: +list = echo $(1):; echo $($(1)) | tr ' ' '\n' | sort | sed 's@^@ @' + info: - @echo "TARGET_FILES = $(TARGET_FILES)" + @echo ======================================== + @$(call list,MODULES) @echo - @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)" - @echo "ERL = $(ERL)" - @echo "ERLC = $(ERLC)" - @echo - @echo "HRL_FILES = $(HRL_FILES)" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo - @echo "SUITE_MODULES = $(SUITE_MODULES)" - @echo "SUITES = $(SUITES)" + @$(call list,HRL_FILES) @echo + @$(call list,SUITES) + @echo ======================================== help: + @echo ======================================== + @echo "Useful targets:" @echo - @echo "Targets:" - @echo - @echo " all" - @echo " Run all test suites." + @echo " all:" + @echo " Compile and run all test suites." @echo - @echo " $(SUITES)" - @echo " Run a specific test suite." + @echo " $(SUITES):" + @echo " Compile and run a specific test suite." @echo - @echo " tests" + @echo " beam:" @echo " Compile all test-code." @echo - @echo " clean | realclean" + @echo " clean | realclean:" @echo " Remove generated files." @echo - @echo " info" - @echo " Prints various environment variables." - @echo " May be useful when debugging this Makefile." - @echo - @echo " help" - @echo " Print this info." - @echo + @echo " info:" + @echo " Echo some interesting variables." + @echo ======================================== -.PHONY: docs info help +.PHONY: all beam clean debug docs help info opt realclean tests # ---------------------------------------------------- # Special Targets # ---------------------------------------------------- # Exit with a non-zero status if the output looks to indicate failure. -# diameter_ct:run/1 itself can't tell (it seems). +# diameter_ct:run/1 itself can't tell (it seems). The absolute -pa is +# because ct will change directories. $(SUITES): log tests $(ERL) -noshell \ - -pa $(DIAMETER_TOP)/ebin \ + -pa $(realpath ../ebin) \ -sname diameter_test_$@ \ -s diameter_ct run diameter_$@_SUITE \ -s init stop \ @@ -165,7 +148,11 @@ release_docs_spec: release_tests_spec: $(INSTALL_DIR) $(RELSYSDIR) - $(INSTALL_DATA) $(RELTEST_FILES) $(RELSYSDIR) + $(INSTALL_DATA) $(TEST_SPEC_FILE) \ + $(COVER_SPEC_FILE) \ + $(HRL_FILES) \ + $(ERL_FILES) \ + $(RELSYSDIR) .PHONY: release_spec release_docs_spec release_test_specs diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index 531aca2799..75fdd0bd1d 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -38,5 +38,5 @@ MODULES = \ diameter_tls_SUITE \ diameter_failover_SUITE -INTERNAL_HRL_FILES = \ +HRL_FILES = \ diameter_ct.hrl -- cgit v1.2.3 From e89a59263762c1b625b1b054784b73112fb440a3 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Tue, 18 Oct 2011 14:10:53 +0200 Subject: Dumb down opt/release targets to make 3.80 --- lib/diameter/src/Makefile | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index ea1e43875e..15196bc002 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -42,6 +42,9 @@ RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) EBIN = ../ebin INCDIR = ../include +# Dumbed down to make 3.80. In 3.81 and later it's just $(realpath $(EBIN)). +ABS_EBIN := $(shell cd $(EBIN) && pwd) + # Where make should look for dependencies. VPATH = .:base:compiler:transport:gen @@ -103,7 +106,7 @@ ERL_COMPILE_FLAGS += \ +'{attribute,insert,app_vsn,$(APP_VSN)}' \ +warn_export_vars \ +warn_unused_vars \ - -pa $(realpath $(EBIN)) \ + -pa $(ABS_EBIN) \ -I $(INCDIR) \ -I gen # -pa is to be able to include_lib from the include directory: the @@ -228,7 +231,7 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) # ---------------------------------------------------- -# Targets using secondary expansion +# Targets using secondary expansion (make >= 3.81) # ---------------------------------------------------- .SECONDEXPANSION: -- cgit v1.2.3 From 6c048c57a4714e033f484ff79425ce847e9a43e9 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Wed, 19 Oct 2011 11:55:46 +0200 Subject: Dumb down release target to Solaris /usr/ucb/install --- lib/diameter/src/Makefile | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 15196bc002..a057632d15 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -177,13 +177,12 @@ else include $(ERL_TOP)/make/otp_release_targets.mk endif +# Can't $(INSTALL_DIR) more than on directory at a time on Solaris. + release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/bin \ - $(RELSYSDIR)/ebin \ - $(RELSYSDIR)/examples \ - $(RELSYSDIR)/include \ - $(RELSYSDIR)/src/dict \ - $(TARGET_DIRS:%/=$(RELSYSDIR)/src/%) + for d in bin ebin examples include src/dict $(TARGET_DIRS:%/=src/%); do \ + $(INSTALL_DIR) $(RELSYSDIR)/$$d; \ + done $(INSTALL_SCRIPT) $(BINS:%=../bin/%) $(RELSYSDIR)/bin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(EXAMPLES:%=../examples/%) $(RELSYSDIR)/examples -- cgit v1.2.3 From 98df4ff16c9018bd61d04f35b0bdd92c9fb16942 Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 17 Oct 2011 13:53:25 +0200 Subject: Fix a few tests that used to fail on the HiPE platform --- lib/stdlib/test/dets_SUITE.erl | 195 +++++++++++++++++++++-------------------- lib/stdlib/test/epp_SUITE.erl | 13 ++- lib/stdlib/test/ets_SUITE.erl | 21 +++-- 3 files changed, 123 insertions(+), 106 deletions(-) diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 63767aeda6..6f77cff2b9 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1865,10 +1865,10 @@ fixtable(Config, Version) when is_list(Config) -> ?line {ok, _} = dets:open_file(T, Args), %% badarg - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:safe_fixtable(no_table,true)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[T,undefined],_}|_]}} = - (catch dets:safe_fixtable(T,undefined)), + ?line check_badarg(catch dets:safe_fixtable(no_table,true), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:safe_fixtable(T,undefined), + dets, safe_fixtable, [T,undefined]), %% The table is not allowed to grow while the elements are inserted: @@ -1948,22 +1948,22 @@ match(Config, Version) -> %% match, badarg MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:match(no_table, '_')), - ?line {'EXIT', {badarg, [{dets,match,[T,'_',not_a_number],_}|_]}} = - (catch dets:match(T, '_', not_a_number)), + ?line check_badarg(catch dets:match(no_table, '_'), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:match(T, '_', not_a_number), + dets, match, [T,'_',not_a_number]), ?line {EC1, _} = dets:select(T, MSpec, 1), - ?line {'EXIT', {badarg, [{dets,match,[EC1],_}|_]}} = - (catch dets:match(EC1)), + ?line check_badarg(catch dets:match(EC1), + dets, match, [EC1]), %% match_object, badarg - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:match_object(no_table, '_')), - ?line {'EXIT', {badarg, [{dets,match_object,[T,'_',not_a_number],_}|_]}} = - (catch dets:match_object(T, '_', not_a_number)), + ?line check_badarg(catch dets:match_object(no_table, '_'), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:match_object(T, '_', not_a_number), + dets, match_object, [T,'_',not_a_number]), ?line {EC2, _} = dets:select(T, MSpec, 1), - ?line {'EXIT', {badarg, [{dets,match_object,[EC2],_}|_]}} = - (catch dets:match_object(EC2)), + ?line check_badarg(catch dets:match_object(EC2), + dets, match_object, [EC2]), dets:safe_fixtable(T, true), ?line {[_, _], C1} = dets:match_object(T, '_', 2), @@ -2126,17 +2126,17 @@ select(Config, Version) -> %% badarg MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:select(no_table, MSpec)), - ?line {'EXIT', {badarg, [{dets,select,[T,<<17>>],_}|_]}} = - (catch dets:select(T, <<17>>)), - ?line {'EXIT', {badarg, [{dets,select,[T,[]],_}|_]}} = - (catch dets:select(T, [])), - ?line {'EXIT', {badarg, [{dets,select,[T,MSpec,not_a_number],_}|_]}} = - (catch dets:select(T, MSpec, not_a_number)), + ?line check_badarg(catch dets:select(no_table, MSpec), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:select(T, <<17>>), + dets, select, [T,<<17>>]), + ?line check_badarg(catch dets:select(T, []), + dets, select, [T,[]]), + ?line check_badarg(catch dets:select(T, MSpec, not_a_number), + dets, select, [T,MSpec,not_a_number]), ?line {EC, _} = dets:match(T, '_', 1), - ?line {'EXIT', {badarg, [{dets,select,[EC],_}|_]}} = - (catch dets:select(EC)), + ?line check_badarg(catch dets:select(EC), + dets, select, [EC]), AllSpec = [{'_',[],['$_']}], @@ -2218,8 +2218,8 @@ update_counter(Config) when is_list(Config) -> ?line file:delete(Fname), P0 = pps(), - ?line {'EXIT', {badarg, [{dets,update_counter,[no_table,1,1],_}|_]}} = - (catch dets:update_counter(no_table, 1, 1)), + ?line check_badarg(catch dets:update_counter(no_table, 1, 1), + dets, update_counter, [no_table,1,1]), Args = [{file,Fname},{keypos,2}], ?line {ok, _} = dets:open_file(T, [{type,set} | Args]), @@ -2262,67 +2262,66 @@ badarg(Config) when is_list(Config) -> %% badargs are tested in match, select and fixtable too. %% open - ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple},[]],_}|_]}} = - (catch dets:open_file({a,tuple},[])), - ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple}],_}|_]}} = - (catch dets:open_file({a,tuple})), - ?line {'EXIT', {badarg, [{dets,open_file,[file,[foo]],_}|_]}} = - (catch dets:open_file(file,[foo])), - ?line {'EXIT', {badarg,[{dets,open_file, - [{hej,san},[{type,set}|3]],_}|_]}} = - (catch dets:open_file({hej,san},[{type,set}|3])), + ?line check_badarg(catch dets:open_file({a,tuple},[]), + dets, open_file, [{a,tuple},[]]), + ?line check_badarg(catch dets:open_file({a,tuple}), + dets, open_file,[{a,tuple}]), + ?line check_badarg(catch dets:open_file(file,[foo]), + dets, open_file, [file,[foo]]), + ?line check_badarg(catch dets:open_file({hej,san},[{type,set}|3]), + dets, open_file, [{hej,san},[{type,set}|3]]), %% insert - ?line {'EXIT', {badarg, [{dets,insert,[no_table,{1,2}],_}|_]}} = - (catch dets:insert(no_table, {1,2})), - ?line {'EXIT', {badarg, [{dets,insert,[no_table,[{1,2}]],_}|_]}} = - (catch dets:insert(no_table, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,insert,[T,{1,2}],_}|_]}} = - (catch dets:insert(T, {1,2})), - ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2}]],_}|_]}} = - (catch dets:insert(T, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2,3}|3]],_}|_]}} = - (catch dets:insert(T, [{1,2,3} | 3])), + ?line check_badarg(catch dets:insert(no_table, {1,2}), + dets, insert, [no_table,{1,2}]), + ?line check_badarg(catch dets:insert(no_table, [{1,2}]), + dets, insert, [no_table,[{1,2}]]), + ?line check_badarg(catch dets:insert(T, {1,2}), + dets, insert, [T,{1,2}]), + ?line check_badarg(catch dets:insert(T, [{1,2}]), + dets, insert, [T,[{1,2}]]), + ?line check_badarg(catch dets:insert(T, [{1,2,3} | 3]), + dets, insert, [T,[{1,2,3}|3]]), %% lookup{_keys} - ?line {'EXIT', {badarg, [{dets,lookup_keys,[badarg,[]],_}|_]}} = - (catch dets:lookup_keys(T, [])), - ?line {'EXIT', {badarg, [{dets,lookup,[no_table,1],_}|_]}} = - (catch dets:lookup(no_table, 1)), - ?line {'EXIT', {badarg, [{dets,lookup_keys,[T,[1|2]],_}|_]}} = - (catch dets:lookup_keys(T, [1 | 2])), + ?line check_badarg(catch dets:lookup_keys(T, []), + dets, lookup_keys, [badarg,[]]), + ?line check_badarg(catch dets:lookup(no_table, 1), + dets, lookup, [no_table,1]), + ?line check_badarg(catch dets:lookup_keys(T, [1 | 2]), + dets, lookup_keys, [T,[1|2]]), %% member - ?line {'EXIT', {badarg, [{dets,member,[no_table,1],_}|_]}} = - (catch dets:member(no_table, 1)), + ?line check_badarg(catch dets:member(no_table, 1), + dets, member, [no_table,1]), %% sync - ?line {'EXIT', {badarg, [{dets,sync,[no_table],_}|_]}} = - (catch dets:sync(no_table)), + ?line check_badarg(catch dets:sync(no_table), + dets, sync, [no_table]), %% delete{_keys} - ?line {'EXIT', {badarg, [{dets,delete,[no_table,1],_}|_]}} = - (catch dets:delete(no_table, 1)), + ?line check_badarg(catch dets:delete(no_table, 1), + dets, delete, [no_table,1]), %% delete_object - ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,{1,2,3}],_}|_]}} = - (catch dets:delete_object(no_table, {1,2,3})), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,{1,2}],_}|_]}} = - (catch dets:delete_object(T, {1,2})), - ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,[{1,2,3}]],_}|_]}} = - (catch dets:delete_object(no_table, [{1,2,3}])), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2}]],_}|_]}} = - (catch dets:delete_object(T, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2,3}|3]],_}|_]}} = - (catch dets:delete_object(T, [{1,2,3} | 3])), + ?line check_badarg(catch dets:delete_object(no_table, {1,2,3}), + dets, delete_object, [no_table,{1,2,3}]), + ?line check_badarg(catch dets:delete_object(T, {1,2}), + dets, delete_object, [T,{1,2}]), + ?line check_badarg(catch dets:delete_object(no_table, [{1,2,3}]), + dets, delete_object, [no_table,[{1,2,3}]]), + ?line check_badarg(catch dets:delete_object(T, [{1,2}]), + dets, delete_object, [T,[{1,2}]]), + ?line check_badarg(catch dets:delete_object(T, [{1,2,3} | 3]), + dets, delete_object, [T,[{1,2,3}|3]]), %% first,next,slot - ?line {'EXIT', {badarg, [{dets,first,[no_table],_}|_]}} = - (catch dets:first(no_table)), - ?line {'EXIT', {badarg, [{dets,next,[no_table,1],_}|_]}} = - (catch dets:next(no_table, 1)), - ?line {'EXIT', {badarg, [{dets,slot,[no_table,0],_}|_]}} = - (catch dets:slot(no_table, 0)), + ?line check_badarg(catch dets:first(no_table), + dets, first, [no_table]), + ?line check_badarg(catch dets:next(no_table, 1), + dets, next, [no_table,1]), + ?line check_badarg(catch dets:slot(no_table, 0), + dets, slot, [no_table,0]), %% info ?line undefined = dets:info(no_table), @@ -2330,27 +2329,27 @@ badarg(Config) when is_list(Config) -> ?line undefined = dets:info(T, foo), %% match_delete - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:match_delete(no_table, '_')), + ?line check_badarg(catch dets:match_delete(no_table, '_'), + dets, safe_fixtable, [no_table,true]), %% delete_all_objects - ?line {'EXIT', {badarg, [{dets,delete_all_objects,[no_table],_}|_]}} = - (catch dets:delete_all_objects(no_table)), + ?line check_badarg(catch dets:delete_all_objects(no_table), + dets, delete_all_objects, [no_table]), %% select_delete MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:select_delete(no_table, MSpec)), - ?line {'EXIT', {badarg, [{dets,select_delete,[T, <<17>>],_}|_]}} = - (catch dets:select_delete(T, <<17>>)), + ?line check_badarg(catch dets:select_delete(no_table, MSpec), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:select_delete(T, <<17>>), + dets, select_delete, [T, <<17>>]), %% traverse, fold - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:traverse(no_table, fun(_) -> continue end)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:foldl(fun(_, A) -> A end, [], no_table)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = - (catch dets:foldr(fun(_, A) -> A end, [], no_table)), + ?line check_badarg(catch dets:traverse(no_table, fun(_) -> continue end), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:foldl(fun(_, A) -> A end, [], no_table), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:foldr(fun(_, A) -> A end, [], no_table), + dets, safe_fixtable, [no_table,true]), %% close ?line ok = dets:close(T), @@ -2358,15 +2357,16 @@ badarg(Config) when is_list(Config) -> ?line {error, not_owner} = dets:close(T), %% init_table - ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]],_}|_]}} = - (catch dets:init_table(no_table, fun(X) -> X end)), - ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]],_}|_]}} = - (catch dets:init_table(no_table, fun(X) -> X end, [])), + IF = fun(X) -> X end, + ?line check_badarg(catch dets:init_table(no_table, IF), + dets, init_table, [no_table,IF,[]]), + ?line check_badarg(catch dets:init_table(no_table, IF, []), + dets, init_table, [no_table,IF,[]]), %% from_ets Ets = ets:new(ets,[]), - ?line {'EXIT', {badarg,[{dets,from_ets,[no_table,_],_}|_]}} = - (catch dets:from_ets(no_table, Ets)), + ?line check_badarg(catch dets:from_ets(no_table, Ets), + dets, from_ets, [no_table,Ets]), ets:delete(Ets), ?line {ok, T} = dets:open_file(T, Args), @@ -4358,6 +4358,11 @@ bad_object({error,{{bad_object,_}, FileName}}, FileName) -> bad_object({error,{{{bad_object,_,_},_,_,_}, FileName}}, FileName) -> ok. % Debug. +check_badarg({'EXIT', {badarg, [{M,F,Args,_} | _]}}, M, F, Args) -> + true; +check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) -> + true = test_server:is_native(M) andalso length(Args) =:= A. + check_pps(P0) -> case pps() of P0 -> diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index e58022f4da..f79414db49 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -250,16 +250,23 @@ otp_4871(Config) when is_list(Config) -> %% so there are some sanity checks before killing. ?line {ok,Epp} = epp:open(File, []), timer:sleep(1), - ?line {current_function,{epp,_,_}} = process_info(Epp, current_function), + ?line true = current_module(Epp, epp), ?line {monitored_by,[Io]} = process_info(Epp, monitored_by), - ?line {current_function,{file_io_server,_,_}} = - process_info(Io, current_function), + ?line true = current_module(Io, file_io_server), ?line exit(Io, emulate_crash), timer:sleep(1), ?line {error,{_Line,epp,cannot_parse}} = otp_4871_parse_file(Epp), ?line epp:close(Epp), ok. +current_module(Pid, Mod) -> + case process_info(Pid, current_function) of + {current_function, undefined} -> + true = test_server:is_native(Mod); + {current_function, {Mod, _, _}} -> + true + end. + otp_4871_parse_file(Epp) -> case epp:parse_erl_form(Epp) of {ok,_} -> otp_4871_parse_file(Epp); diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index e048764a55..2f4958760b 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -795,21 +795,26 @@ t_ets_dets(Config, Opts) -> ?line true = ets:from_dets(ETab,DTab), ?line 3000 = ets:info(ETab,size), ?line ets:delete(ETab), - ?line {'EXIT',{badarg,[{ets,to_dets,[ETab,DTab],_}|_]}} = - (catch ets:to_dets(ETab,DTab)), - ?line {'EXIT',{badarg,[{ets,from_dets,[ETab,DTab],_}|_]}} = - (catch ets:from_dets(ETab,DTab)), + ?line check_badarg(catch ets:to_dets(ETab,DTab), + ets, to_dets, [ETab,DTab]), + ?line check_badarg(catch ets:from_dets(ETab,DTab), + ets, from_dets, [ETab,DTab]), ?line ETab2 = ets_new(x,Opts), ?line filltabint(ETab2,3000), ?line dets:close(DTab), - ?line {'EXIT',{badarg,[{ets,to_dets,[ETab2,DTab],_}|_]}} = - (catch ets:to_dets(ETab2,DTab)), - ?line {'EXIT',{badarg,[{ets,from_dets,[ETab2,DTab],_}|_]}} = - (catch ets:from_dets(ETab2,DTab)), + ?line check_badarg(catch ets:to_dets(ETab2,DTab), + ets, to_dets, [ETab2,DTab]), + ?line check_badarg(catch ets:from_dets(ETab2,DTab), + ets, from_dets, [ETab2,DTab]), ?line ets:delete(ETab2), ?line (catch file:delete(Fname)), ok. +check_badarg({'EXIT', {badarg, [{M,F,Args,_} | _]}}, M, F, Args) -> + true; +check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) -> + true = test_server:is_native(M) andalso length(Args) =:= A. + t_delete_all_objects(doc) -> ["Test ets:delete_all_objects/1"]; t_delete_all_objects(suite) -> -- cgit v1.2.3 From 0133d7aeabeabca47d112b039823d0ba492905cb Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Fri, 21 Oct 2011 11:43:57 +0200 Subject: Flush trace file driver before stopping dbg Earlier dbg:stop only did erlang:trace_delivered and did not flush the trace file driver. Therefore there could still be trace messages that were delivered to the driver (guaranteed by erlang:trace_delivered) but not yet written to the file. This commit adds this flushing on each node before the dbg process terminates. --- lib/runtime_tools/src/dbg.erl | 52 +++++++++++++++++++++---------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 446de63064..385047ee73 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -32,7 +32,7 @@ -export([fun2ms/1]). %% Local exports --export([erlang_trace/3,get_info/0]). +-export([erlang_trace/3,get_info/0,deliver_and_flush/1]). %% Debug exports -export([wrap_presort/2, wrap_sort/2, wrap_postsort/1, wrap_sortfix/2, @@ -348,17 +348,16 @@ trace_port_control(Operation) -> trace_port_control(node(), Operation). trace_port_control(Node, flush) -> - Ref = erlang:trace_delivered(all), - receive - {trace_delivered,all,Ref} -> ok - end, - case trace_port_control(Node, $f, "") of - {ok, [0]} -> - ok; - {ok, _} -> - {error, not_supported_by_trace_driver}; - Other -> - Other + case get_tracer(Node) of + {ok, Port} when is_port(Port) -> + case catch rpc:call(Node,?MODULE,deliver_and_flush,[Port]) of + [0] -> + ok; + _ -> + {error, not_supported_by_trace_driver} + end; + _ -> + {error, no_trace_driver} end; trace_port_control(Node,get_listen_port) -> case trace_port_control(Node,$p, "") of @@ -378,7 +377,14 @@ trace_port_control(Node, Command, Arg) -> {error, no_trace_driver} end. - +%% A bit more than just flush - it also makes sure all trace messages +%% are delivered first, before flushing the driver. +deliver_and_flush(Port) -> + Ref = erlang:trace_delivered(all), + receive + {trace_delivered,all,Ref} -> ok + end, + erlang:port_control(Port, $f, ""). trace_port(file, {Filename, wrap, Tail}) -> @@ -684,18 +690,12 @@ loop({C,T}=SurviveLinks, Table) -> %% tracing on the node it removes from the list of active trace nodes, %% we will call erlang:trace_delivered/1 on ALL nodes that we have %% connections to. - Delivered = fun() -> - Ref = erlang:trace_delivered(all), - receive - {trace_delivered,all,Ref} -> ok - end - end, - catch rpc:multicall(nodes(), erlang, apply, [Delivered,[]]), - Ref = erlang:trace_delivered(all), - receive - {trace_delivered,all,Ref} -> - exit(done) - end; + %% If it is a file trace driver, we will also flush the port. + lists:foreach(fun({Node,{_Relay,Port}}) -> + rpc:call(Node,?MODULE,deliver_and_flush,[Port]) + end, + get()), + exit(done); {From, {link_to, Pid}} -> case (catch link(Pid)) of {'EXIT', Reason} -> -- cgit v1.2.3 From c2e6879aee84f04b2132a52580219b13ce586a13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Fri, 21 Oct 2011 17:30:37 +0200 Subject: eprof: Fix invalid references to removed functions --- lib/tools/doc/src/eprof.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/tools/doc/src/eprof.xml b/lib/tools/doc/src/eprof.xml index 6d68c90768..1dbc41ec8e 100644 --- a/lib/tools/doc/src/eprof.xml +++ b/lib/tools/doc/src/eprof.xml @@ -147,7 +147,7 @@

This function ensures that the results displayed by - analyse/0 and total_analyse/0 are printed both to + analyze/0,1,2 are printed both to the file File and the screen.

 -- cgit v1.2.3 From 32c475cfe5bbc2c2eb55d83102112233d799a01a Mon Sep 17 00:00:00 2001 From: Andreas Schultz Date: Mon, 3 Oct 2011 12:46:12 +0200 Subject: fix handling of block_decipher/5 failure A wrong decryption key would cause a badmatch in generic_block_cipher_from_bin/2. The try in block_decipher/5 was probably intendend to deal with that, but was misplace for this. Additionaly, generating a failure alert erly, without computing the record MAC, creates vector for a timing attack on CBC padding (for details check TLS 1.2 RFC 5246, Sect. 6.2.3.2.). This attach vector and the counter meassure applies to all SSL/TLS versions. As a counter messure, compute the MAC even when decryption or padding checks fail. A invalid padding will force a MAC failure by intentionaly invalidating the content. --- lib/ssl/src/ssl_cipher.erl | 80 +++++++++++++------ lib/ssl/test/Makefile | 2 + lib/ssl/test/ssl_cipher_SUITE.erl | 163 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 220 insertions(+), 25 deletions(-) create mode 100644 lib/ssl/test/ssl_cipher_SUITE.erl diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72f02a4362..95a5efd6d0 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -154,18 +154,23 @@ decipher(?AES, HashSz, CipherState, Fragment, Version) -> block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment, Version) -> - try Fun(Key, IV, Fragment) of - Text -> - GBC = generic_block_cipher_from_bin(Text, HashSz), - case is_correct_padding(GBC, Version) of - true -> - Content = GBC#generic_block_cipher.content, - Mac = GBC#generic_block_cipher.mac, - CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)}, - {Content, Mac, CipherState1}; - false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) - end + try + Text = Fun(Key, IV, Fragment), + GBC = generic_block_cipher_from_bin(Text, HashSz), + Content = GBC#generic_block_cipher.content, + Mac = GBC#generic_block_cipher.mac, + CipherState1 = CipherState0#cipher_state{iv=next_iv(Fragment, IV)}, + case is_correct_padding(GBC, Version) of + true -> + {Content, Mac, CipherState1}; + false -> + %% decryption failed or invalid padding, + %% intentionally break Content to make + %% sure a packet with a an invalid padding + %% but otherwise correct data will fail + %% the MAC test later + {<<16#F0, Content/binary>>, Mac, CipherState1} + end catch _:_ -> %% This is a DECRYPTION_FAILED but @@ -500,14 +505,38 @@ hash_size(md5) -> hash_size(sha) -> 20. +%% RFC 5246: 6.2.3.2. CBC Block Cipher +%% +%% Implementation note: Canvel et al. [CBCTIME] have demonstrated a +%% timing attack on CBC padding based on the time required to compute +%% the MAC. In order to defend against this attack, implementations +%% MUST ensure that record processing time is essentially the same +%% whether or not the padding is correct. In general, the best way to +%% do this is to compute the MAC even if the padding is incorrect, and +%% only then reject the packet. For instance, if the pad appears to be +%% incorrect, the implementation might assume a zero-length pad and then +%% compute the MAC. This leaves a small timing channel, since MAC +%% performance depends to some extent on the size of the data fragment, +%% but it is not believed to be large enough to be exploitable, due to +%% the large block size of existing MACs and the small size of the +%% timing signal. +%% +%% implementation note: +%% We return the original (possibly invalid) PadLength in any case. +%% A invalid PadLength will be cought by is_correct_padding/2 +%% generic_block_cipher_from_bin(T, HashSize) -> Sz1 = byte_size(T) - 1, - <<_:Sz1/binary, ?BYTE(PadLength)>> = T, + <<_:Sz1/binary, ?BYTE(PadLength0)>> = T, + PadLength = if + PadLength0 >= Sz1 -> 0; + true -> PadLength0 + end, CompressedLength = byte_size(T) - PadLength - 1 - HashSize, <> = T, + Padding:PadLength/binary, ?BYTE(PadLength0)>> = T, #generic_block_cipher{content=Content, mac=Mac, - padding=Padding, padding_length=PadLength}. + padding=Padding, padding_length=PadLength0}. generic_stream_cipher_from_bin(T, HashSz) -> Sz = byte_size(T), @@ -516,17 +545,18 @@ generic_stream_cipher_from_bin(T, HashSz) -> #generic_stream_cipher{content=Content, mac=Mac}. -is_correct_padding(_, {3, 0}) -> - true; -%% For interoperability reasons we do not check the padding in TLS 1.0 as it -%% is not strictly required and breaks interopability with for instance -%% Google. -is_correct_padding(_, {3, 1}) -> - true; +%% For interoperability reasons we do not check the padding content in +%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks +%% interopability with for instance Google. +is_correct_padding(#generic_block_cipher{padding_length = Len, + padding = Padding}, {3, N}) + when N == 0; N == 1 -> + Len == byte_size(Padding); %% Padding must be check in TLS 1.1 and after -is_correct_padding(#generic_block_cipher{padding_length = Len, padding = Padding}, _) -> - list_to_binary(lists:duplicate(Len, Len)) == Padding. - +is_correct_padding(#generic_block_cipher{padding_length = Len, + padding = Padding}, _) -> + Len == byte_size(Padding) andalso + list_to_binary(lists:duplicate(Len, Len)) == Padding. get_padding(Length, BlockSize) -> get_padding_aux(BlockSize, Length rem BlockSize). diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 23a9a23190..6b1da63d08 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -39,6 +39,7 @@ MODULES = \ ssl_basic_SUITE \ ssl_handshake_SUITE \ ssl_packet_SUITE \ + ssl_cipher_SUITE \ ssl_payload_SUITE \ ssl_to_openssl_SUITE \ ssl_session_cache_SUITE \ @@ -55,6 +56,7 @@ HRL_FILES_SRC = \ ssl_internal.hrl\ ssl_alert.hrl \ ssl_handshake.hrl \ + ssl_cipher.hrl \ ssl_record.hrl HRL_FILES_INC = diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl new file mode 100644 index 0000000000..87478e13bc --- /dev/null +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -0,0 +1,163 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% 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_cipher_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-include("ssl_internal.hrl"). +-include("ssl_record.hrl"). +-include("ssl_cipher.hrl"). + +-define(TIMEOUT, 600000). + +%% Test server callback functions +%%-------------------------------------------------------------------- +%% Function: init_per_suite(Config) -> Config +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Initialization before the whole suite +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + try crypto:start() of + ok -> + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. +%%-------------------------------------------------------------------- +%% Function: end_per_suite(Config) -> _ +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after the whole suite +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + ssl:stop(), + application:stop(crypto). + +%%-------------------------------------------------------------------- +%% Function: init_per_testcase(TestCase, Config) -> Config +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Initialization before each test case +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%% Description: Initialization before each test case +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config0) -> + Config = lists:keydelete(watchdog, 1, Config0), + Dog = ssl_test_lib:timetrap(?TIMEOUT), + [{watchdog, Dog} | Config]. + +%%-------------------------------------------------------------------- +%% Function: end_per_testcase(TestCase, Config) -> _ +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after each test case +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, Config) -> + Dog = ?config(watchdog, Config), + case Dog of + undefined -> + ok; + _ -> + test_server:timetrap_cancel(Dog) + end. + +%%-------------------------------------------------------------------- +%% Function: all(Clause) -> TestCases +%% Clause - atom() - suite | doc +%% TestCases - [Case] +%% Case - atom() +%% Name of a test case. +%% Description: Returns a list of all test cases in this test suite +%%-------------------------------------------------------------------- +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [aes_decipher_good, aes_decipher_fail]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +%% Test cases starts here. +%%-------------------------------------------------------------------- +aes_decipher_good(doc) -> + ["Decipher a known cryptotext."]; + +aes_decipher_good(suite) -> + []; + +aes_decipher_good(Config) when is_list(Config) -> + HashSz = 32, + CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, + Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, + Version = {3,3}, + Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56,72,69,76,76,79,10>>, + Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, + {Content, Mac, CipherState1} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + ok. + +%%-------------------------------------------------------------------- + +aes_decipher_fail(doc) -> + ["Decipher a known cryptotext."]; + +aes_decipher_fail(suite) -> + []; + +%% same as above, last byte of key replaced +aes_decipher_fail(Config) when is_list(Config) -> + HashSz = 32, + CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, + Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, + Version = {3,3}, + {Content, Mac, CipherState1} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + 32 = byte_size(Content), + 32 = byte_size(Mac), + ok. + +%%-------------------------------------------------------------------- -- cgit v1.2.3 From 43c4a54a25e83a33a8383b7a96af20ecd14f10de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 24 Oct 2011 13:57:40 +0200 Subject: otp: Update profiling doc with eprof --- system/doc/efficiency_guide/profiling.xml | 57 ++++++++++++++++++++----------- 1 file changed, 37 insertions(+), 20 deletions(-) diff --git a/system/doc/efficiency_guide/profiling.xml b/system/doc/efficiency_guide/profiling.xml index 13165a0ede..65ba4b3369 100644 --- a/system/doc/efficiency_guide/profiling.xml +++ b/system/doc/efficiency_guide/profiling.xml @@ -40,9 +40,13 @@

Erlang/OTP contains several tools to help finding bottlenecks.

-

fprof and eprof provide the most detailed information - about where the time is spent, but they significantly slow downs the - programs they profile.

+

fprof provide the most detailed information + about where the time is spent, but it significantly slows down the + program it profiles.

+ +

eprof provides time information of each function used + in the program. No callgraph is produced but eprof has + considerable less impact on the program profiled.

If the program is too big to be profiled by fprof or eprof, cover and cprof could be used to locate parts of the @@ -50,7 +54,7 @@ eprof.

cover provides execution counts per line per process, - with less overhead than fprof/eprof. Execution counts can + with less overhead than fprof. Execution counts can with some caution be used to locate potential performance bottlenecks. The most lightweight tool is cprof, but it only provides execution counts on a function basis (for all processes, not per process).

@@ -102,35 +106,45 @@
fprof -

fprof measures the execution time for each function, +

+ fprof measures the execution time for each function, both own time i.e how much time a function has used for its own execution, and accumulated time i.e. including called functions. The values are displayed per process. You also get to know how many times each function has been called. fprof is based on trace to file in order to minimize runtime performance impact. Using fprof is just a - matter of calling a few library functions, see fprof manual - page under the application tools.

-

fprof was introduced in version R8 of Erlang/OTP. Its - predecessor eprof that is based on the Erlang trace BIFs, - is still available, see eprof manual page under the - application tools. Eprof shows how much time has been used by - each process, and in which function calls this time has been - spent. Time is shown as percentage of total time, not as - absolute time.

+ matter of calling a few library functions, see + fprof + manual page under the application tools.fprof was introduced in + version R8 of Erlang/OTP. +

+
+ eprof +

+ eprof is based on the Erlang trace_info BIFs. Eprof shows how much time has been used by + each process, and in which function calls this time has been + spent. Time is shown as percentage of total time and absolute time. + See eprof for + additional information. +

+
+
cover -

cover's primary use is coverage analysis to verify +

+ cover's primary use is coverage analysis to verify test cases, making sure all relevant code is covered. cover counts how many times each executable line of code is executed when a program is run. This is done on a per module basis. Of course this information can be used to determine what code is run very frequently and could therefore be subject for optimization. Using cover is just a matter of - calling a few library functions, see cover manual - page under the application tools.

+ calling a few library functions, see + cover + manual page under the application tools.

@@ -139,8 +153,11 @@ cover regarding features. It counts how many times each function is called when the program is run, on a per module basis. cprof has a low performance degradation effect (versus - fprof and eprof) and does not need to recompile - any modules to profile (versus cover).

+ fprof) and does not need to recompile + any modules to profile (versus cover). + See cprof manual page for additional + information. +

@@ -170,7 +187,7 @@ eprof per process/function to screen/file medium - significant slowdown + small slowdown yes only total no -- cgit v1.2.3 From 3326bd4efa5ff4965a1bab2f6451a4bf47ca0ebb Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Tue, 25 Oct 2011 10:19:42 +0200 Subject: Upped the version number. Some cosmetics related to the profile tool. --- lib/megaco/test/megaco_codec_v1_test.erl | 4 ++-- lib/megaco/test/megaco_codec_v2_test.erl | 4 ++-- lib/megaco/vsn.mk | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/megaco/test/megaco_codec_v1_test.erl b/lib/megaco/test/megaco_codec_v1_test.erl index 3a548c4d9e..e9c19605dd 100644 --- a/lib/megaco/test/megaco_codec_v1_test.erl +++ b/lib/megaco/test/megaco_codec_v1_test.erl @@ -371,9 +371,9 @@ profile_decode_text_messages(Slogan, Codec, Config, Msgs0) -> decode_text_messages(Codec, Config, Bins, []) end, %% Make a dry run, just to make sure all modules are loaded: - io:format("make a dry run..~n", []), + io:format("make a dry run...~n", []), (catch Fun()), - io:format("make the run..~n", []), + io:format("make the run...~n", []), megaco_profile:profile(Slogan, Fun). %% (catch megaco_codec_v1_test:profile_encode_compact_text_messages()). diff --git a/lib/megaco/test/megaco_codec_v2_test.erl b/lib/megaco/test/megaco_codec_v2_test.erl index c3a80febba..1d3fcb36e9 100644 --- a/lib/megaco/test/megaco_codec_v2_test.erl +++ b/lib/megaco/test/megaco_codec_v2_test.erl @@ -346,9 +346,9 @@ profile_decode_text_messages(Slogan, Codec, Config, Msgs0) -> decode_text_messages(Codec, Config, Bins, []) end, %% Make a dry run, just to make sure all modules are loaded: - io:format("make a dry run..~n", []), + io:format("make a dry run...~n", []), (catch Fun()), - io:format("make the run..~n", []), + io:format("make the run...~n", []), megaco_profile:profile(Slogan, Fun). %% (catch megaco_codec_v2_test:profile_encode_compact_text_messages()). diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index c1476488ca..35acffcb64 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.15.1.1 +MEGACO_VSN = 3.15.1.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" -- cgit v1.2.3 From b0e8fa11c98c9a2bad42ac2f8f411a84bc937398 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Tue, 25 Oct 2011 10:20:45 +0200 Subject: =?UTF-8?q?H=E5kan=20Mattsson=20rewrote=20the=20profile=20tool.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/megaco/test/megaco_profile.erl | 343 ++++++++++++++++++++++++++++--------- 1 file changed, 258 insertions(+), 85 deletions(-) diff --git a/lib/megaco/test/megaco_profile.erl b/lib/megaco/test/megaco_profile.erl index d0b62610e1..344c551970 100644 --- a/lib/megaco/test/megaco_profile.erl +++ b/lib/megaco/test/megaco_profile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -24,50 +24,102 @@ -module(megaco_profile). --export([profile/2]). - +-export([profile/2, prepare/2, analyse/1, + fprof_to_calltree/1, fprof_to_calltree/2, fprof_to_calltree/3]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Execute Fun and profile it with fprof. -profile(Slogan, Fun) when is_function(Fun) -> +profile(Slogan, Fun) when is_function(Fun, 0) -> Pids = [self()], - profile(Slogan, Fun, Pids). + {ok, TraceFile} = prepare(Slogan, Pids), + Res = (catch Fun()), + {ok, _DestFile} = analyse(Slogan), + ok = file:delete(TraceFile), + {ok, _TreeFile} = fprof_to_calltree(Slogan), + Res. -profile(Slogan, Fun, Pids) -> +%% Prepare for tracing +prepare(Slogan, Pids) -> TraceFile = lists:concat(["profile_", Slogan, "-fprof.trace"]), - DestFile = lists:concat(["profile_", Slogan, ".fprof"]), - TreeFile = lists:concat(["profile_", Slogan, ".calltree"]), - erlang:garbage_collect(), {ok, _Pid} = fprof:start(), + erlang:garbage_collect(), TraceOpts = [start, - {cpu_time, false}, - {procs, Pids}, - {file, TraceFile} + {cpu_time, false}, + {procs, Pids}, + {file, TraceFile} ], - ok = fprof:trace(TraceOpts), - Res = (catch Fun()), - ok = fprof:trace(stop), - ok = fprof:profile([{file, TraceFile}]), - ok = fprof:analyse([{dest, DestFile}]), - ok = fprof:stop(), - ok = file:delete(TraceFile), - reformat_total(DestFile, TreeFile), - Res. + ok = fprof:trace(TraceOpts), + {ok, TraceFile}. -reformat_total(FromFile, ToFile) -> - {ok, ConsultedFromFile} = file:consult(FromFile), - [_AnalysisOpts, [Totals] | Terms] = ConsultedFromFile, - {totals, _, TotalAcc, _} = Totals, +%% Stop tracing and analyse it +analyse(Slogan) -> + fprof:trace(stop), + TraceFile = lists:concat(["profile_", Slogan, "-fprof.trace"]), + DestFile = lists:concat(["profile_", Slogan, ".fprof"]), + try + case fprof:profile([{file, TraceFile}]) of + ok -> + ok = fprof:analyse([{dest, DestFile}, {totals, false}]), + {ok, DestFile}; + {error, Reason} -> + {error, Reason} + end + after + fprof:stop() + end. + +fprof_to_calltree(Slogan) -> + fprof_to_calltree(Slogan, 0). + +fprof_to_calltree(Slogan, MinPercent) -> + DestFile = lists:concat(["profile_", Slogan, ".fprof"]), + TreeFile = lists:concat(["profile_", Slogan, ".calltree"]), + fprof_to_calltree(DestFile, TreeFile, MinPercent). + +%% Create a calltree from an fprof file +fprof_to_calltree(FromFile, ToFile, MinPercent) -> + ReplyTo = self(), + Ref = make_ref(), + spawn_link(fun() -> + ReplyTo ! {Ref, do_fprof_to_calltree(FromFile, ToFile, MinPercent)} + end), + wait_for_reply(Ref). + +wait_for_reply(Ref) -> + receive + {Ref, Res} -> + Res; + {'EXIT', normal} -> + wait_for_reply(Ref); + {'EXIT', Reason} -> + exit(Reason) + end. + +do_fprof_to_calltree(FromFile, ToFile, MinPercent) -> {ok, Fd} = file:open(ToFile, [write, raw]), - Indent = "", - log(Fd, Indent, TotalAcc, Totals), - Processes = split_processes(Terms, [], []), - Reformat = fun(P) -> reformat_process(Fd, " " ++ Indent, TotalAcc, P) end, - lists:foreach(Reformat, Processes), - file:close(Fd). + {ok, ConsultedFromFile} = file:consult(FromFile), + [_AnalysisOpts, [_Totals] | Terms] = ConsultedFromFile, + Processes = split_processes(Terms, [], []), + Indent = "", + Summary = collapse_processes(Processes), + {_Label, _Cnt, Acc, _Own, _Roots, Details} = Summary, + %% log(Fd, Label, Indent, Acc, {Label, Cnt, Acc, Own}, [], 0), + gen_calltree(Fd, Indent, Acc, Summary, MinPercent), + Delim = io_lib:format("\n~80..=c\n\n", [$=]), + Write = + fun(P) -> + file:write(Fd, Delim), + gen_calltree(Fd, Indent, Acc, P, MinPercent) + end, + lists:foreach(Write, Processes), + file:write(Fd, Delim), + gen_details(Fd, Acc, Details), + file:close(Fd), + {ok, ToFile}. +%% Split all fprof terms into a list of processes split_processes([H | T], ProcAcc, TotalAcc) -> if is_tuple(H) -> @@ -75,64 +127,185 @@ split_processes([H | T], ProcAcc, TotalAcc) -> is_list(H), ProcAcc =:= [] -> split_processes(T, [H], TotalAcc); is_list(H) -> - split_processes(T, [H], [lists:reverse(ProcAcc) | TotalAcc]) + ProcAcc2 = rearrange_process(lists:reverse(ProcAcc)), + split_processes(T, [H], [ProcAcc2 | TotalAcc]) end; split_processes([], [], TotalAcc) -> - lists:reverse(TotalAcc); + lists:reverse(lists:keysort(3, TotalAcc)); split_processes([], ProcAcc, TotalAcc) -> - lists:reverse([lists:reverse(ProcAcc) | TotalAcc]). - -reformat_process(Fd, Indent, TotalAcc, Terms) -> - case Terms of - [[{ProcLabel, _, _, _}] | All] -> ok; - [[{ProcLabel,_,_,_} | _] | All] -> ok - end, - [{_, {TopKey, TopCnt, TopAcc, TopOwn}, _} | _] = All, - Process = {ProcLabel, TopCnt, TopAcc, TopOwn}, - log(Fd, Indent, TotalAcc, Process), - reformat_calls(Fd, " " ++ Indent, TotalAcc, TopKey, All, []). - -reformat_calls(Fd, Indent, TotalAcc, Key, Terms, Stack) -> - {_CalledBy, Current, Calls} = find(Key, Terms), - log(Fd, Indent, TotalAcc, Current), - case lists:member(Key, Stack) of - true -> - ok; - false -> - case Key of - {io_lib, _, _} -> - ok; - {disk_log, _, _} -> - ok; - {lists, flatten, _} -> - ok; - {lists, keysort, _} -> - ok; - _ -> - Fun = fun({NextKey, _, _, _}) -> - reformat_calls(Fd, - " " ++ Indent, - TotalAcc, - NextKey, - Terms, - [Key | Stack]) - end, - lists:foreach(Fun, Calls) - end + ProcAcc2 = rearrange_process(lists:reverse(ProcAcc)), + lists:reverse(lists:keysort(3, [ProcAcc2 | TotalAcc])). + +%% Rearrange the raw process list into a more useful format +rearrange_process([[{Label, _Cnt, _Acc, _Own} | _ ] | Details]) -> + do_rearrange_process(Details, Details, Label, [], []). + +do_rearrange_process([{CalledBy, Current, _Calls} | T], Orig, Label, Roots, Undefs) -> + case [{undefined, Cnt, safe_max(Acc, Own), Own} || + {undefined, Cnt, Acc, Own} <- CalledBy] of + [] -> + do_rearrange_process(T, Orig, Label, Roots, Undefs); + NewUndefs -> + do_rearrange_process(T, Orig, Label, [Current | Roots], NewUndefs ++ Undefs) + end; +do_rearrange_process([], Details, Label, Roots, Undefs) -> + [{undefined, Cnt, Acc, Own}] = collapse_calls(Undefs, []), + Details2 = sort_details(3, Details), + {Label, Cnt, Acc, Own, lists:reverse(lists:keysort(3, Roots)), Details2}. + +%% Compute a summary of the rearranged process info +collapse_processes(Processes) -> + Headers = lists:map(fun({_L, C, A, O, _R, _D}) -> {"SUMMARY", C, A, O} end, + Processes), + [{Label, Cnt, Acc, Own}] = collapse_calls(Headers, []), + Details = lists:flatmap(fun({_L, _C, _A, _O, _R, D}) -> D end, Processes), + Details2 = do_collapse_processes(sort_details(1, Details), []), + Roots = lists:flatmap(fun({_L, _C, _A, _O, R, _D}) -> R end, Processes), + RootMFAs = lists:usort([MFA || {MFA, _, _, _} <- Roots]), + Roots2 = [R || RootMFA <- RootMFAs, + {_, {MFA, _, _, _} = R, _} <- Details2, + MFA =:= RootMFA], + Roots3 = collapse_calls(Roots2, []), + {Label, Cnt, Acc, Own, Roots3, Details2}. + +do_collapse_processes([{CalledBy1, {MFA, Cnt1, Acc1, Own1}, Calls1} | T1], + [{CalledBy2, {MFA, Cnt2, Acc2, Own2}, Calls2} | T2]) -> + Cnt = Cnt1 + Cnt2, + Acc = Acc1 + Acc2, + Own = Own1 + Own2, + Current = {MFA, Cnt, Acc, Own}, + CalledBy0 = CalledBy1 ++ CalledBy2, + Calls0 = Calls1 ++ Calls2, + CalledBy = collapse_calls(lists:keysort(3, CalledBy0), []), + Calls = collapse_calls(lists:keysort(3, Calls0), []), + do_collapse_processes(T1, [{CalledBy, Current, Calls} | T2]); +do_collapse_processes([{CalledBy, Current, Calls} | T1], + T2) -> + do_collapse_processes(T1, [{CalledBy, Current, Calls} | T2]); +do_collapse_processes([], + T2) -> + sort_details(3, T2). + +%% Reverse sort on acc field +sort_details(Pos, Details) -> + Pivot = fun({_CalledBy1, Current1, _Calls1}, + {_CalledBy2, Current2, _Calls2}) -> + element(Pos, Current1) =< element(Pos, Current2) + end, + lists:reverse(lists:sort(Pivot, Details)). + +%% Compute a summary from a list of call tuples +collapse_calls([{MFA, Cnt1, Acc1, Own1} | T1], + [{MFA, Cnt2, Acc2, Own2} | T2]) -> + Cnt = Cnt1 + Cnt2, + Acc = safe_sum(Acc1, Acc2), + Own = Own1 + Own2, + collapse_calls(T1, [{MFA, Cnt, Acc, Own} | T2]); +collapse_calls([{MFA, Cnt, Acc, Own} | T1], + T2) -> + collapse_calls(T1, [{MFA, Cnt, Acc, Own} | T2]); +collapse_calls([], + T2) -> + lists:reverse(lists:keysort(3, T2)). + +safe_sum(Int1, Int2) -> + if + Int1 =:= undefined -> Int2; + Int2 =:= undefined -> Int1; + true -> Int1 + Int2 + end. + +safe_max(Int1, Int2) -> + if + Int1 =:= undefined -> + io:format("111\n", []), + Int2; + Int2 =:= undefined -> + io:format("222\n", []), + Int1; + Int2 > Int1 -> Int2; + true -> Int1 + end. + +%% Compute a calltree and write it to file +gen_calltree(Fd, Indent, TotalAcc, {Label, Cnt, Acc, Own, Roots, Details}, MinPercent) -> + Header = {Label, Cnt, Acc, Own}, + MetaLabel = "Process", + Diff = length(Label) - length(MetaLabel), + IoList = io_lib:format("~s~s Lvl Pct Cnt Acc Own Calls => MFA\n", + [MetaLabel, lists:duplicate(Diff, $\ )]), + file:write(Fd, IoList), + log(Fd, Label, Indent, TotalAcc, Header, Roots, MinPercent), + NewIndent = " " ++ Indent, + Fun = fun({MFA, _C, _A, _O}) -> + [put_detail(Label, D) || D <- Details], + gen_calls(Fd, Label, NewIndent, TotalAcc, MFA, MinPercent) + end, + lists:foreach(Fun, Roots). + +gen_calls(Fd, Label, Indent, TotalAcc, MFA, MinPercent) -> + case get_detail(Label, MFA) of + {read, {_CalledBy, Current, _Calls}} -> + log(Fd, Label, Indent, TotalAcc, Current, -1, MinPercent); + {unread, {_CalledBy, Current, Calls}} -> + log(Fd, Label, Indent, TotalAcc, Current, Calls, MinPercent), + NewIndent = " " ++ Indent, + Fun = fun({NextMFA, _, _, _}) -> + gen_calls(Fd, Label, NewIndent, TotalAcc, + NextMFA, MinPercent) + end, + lists:foreach(Fun, Calls) + end. + +put_detail(Label, {_, {MFA, _, _, _}, _} = Detail) -> + put({Label, MFA}, {unread, Detail}). + +get_detail(Label, MFA) -> + Val = get({Label, MFA}), + case Val of + {unread, Detail} -> + put({Label, MFA}, {read, Detail}), + Val; + {read, _Detail} -> + Val + end. + +gen_details(Fd, Total, Details) -> + IoList = io_lib:format("Pct Cnt Acc Own MFA\n", []), + file:write(Fd, IoList), + do_gen_details(Fd, Total, Details). + +do_gen_details(Fd, Total, [{_CalledBy, {MFA, Cnt, Acc, Own}, _Calls} | Details]) -> + MFAStr = io_lib:format("~p", [MFA]), + {_, Percent} = calc_percent(Acc, Own, Total), + IoList = io_lib:format("~3.. B% ~10.3B ~10.3f ~10.3f => ~s\n", + [Percent, Cnt, Acc, Own, MFAStr]), + file:write(Fd, IoList), + do_gen_details(Fd, Total, Details); +do_gen_details(_Fd, _Total, []) -> + ok. + +log(Fd, Label, Indent, Acc, Current, Calls, MinPercent) when is_list(Calls) -> + log(Fd, Label, Indent, Acc, Current, length(Calls), MinPercent); +log(Fd, Label, Indent, Total, {MFA, Cnt, Acc, Own}, N, MinPercent) -> + {Max, Percent} = calc_percent(Acc, Own, Total), + if + Percent >= MinPercent -> + do_log(Fd, Label, Indent, Percent, MFA, Cnt, Max, Own, N); + true -> + ok end. -find(Key, [{_, {Key, _, _, _}, _} = H | _]) -> - H; -find(Key, [{_, {_, _, _, _}, _} | T]) -> - find(Key, T). - -log(Fd, Indent, Total, {Label, Cnt, Acc, Own}) -> - Percent = case Acc of - undefined -> 100; - _ -> trunc((lists:max([Acc, Own]) * 100) / Total) - end, - Label2 = io_lib:format("~p", [Label]), - IoList = io_lib:format("~s~p% ~s \t~p \t~p \t~p\n", - [Indent, Percent, Label2, Cnt, trunc(Acc), trunc(Own)]), +do_log(Fd, Label, Indent, Percent, MFA, Cnt, Acc, Own, N) -> + MFAStr = io_lib:format("~p", [MFA]), + CallsStr = io_lib:format(" ~5.. s ", [lists:concat([N])]), + IoList = io_lib:format("~s ~3.. B " + "~s~3.. B% ~10.. B ~10.. B ~10.. B ~s => ~s\n", + [Label, length(Indent) div 2, + Indent, Percent, Cnt, + round(Acc), round(Own), CallsStr, MFAStr]), file:write(Fd, IoList). +calc_percent(Acc, Own, Total) -> + Max = safe_max(Acc, Own), + {Max, round((Max * 100) / Total)}. -- cgit v1.2.3 From fe084d5d867de8839385c3652a0f727f97500a0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 9 Aug 2011 14:17:44 +0200 Subject: inviso: Eliminate use of deprecated regexp module --- lib/inviso/src/inviso_tool_lib.erl | 8 ++++---- lib/runtime_tools/src/inviso_rt.erl | 4 ++-- lib/runtime_tools/src/inviso_rt_lib.erl | 16 ++++++++-------- lib/runtime_tools/test/inviso_SUITE.erl | 22 ++++++++++++---------- 4 files changed, 26 insertions(+), 24 deletions(-) diff --git a/lib/inviso/src/inviso_tool_lib.erl b/lib/inviso/src/inviso_tool_lib.erl index 7953acedd6..f221c4b6de 100644 --- a/lib/inviso/src/inviso_tool_lib.erl +++ b/lib/inviso/src/inviso_tool_lib.erl @@ -19,7 +19,7 @@ %% Support module to the inviso tool. %% %% Authors: -%% Lennart Öhman, lennart.ohman@st.se +%% Lennart Öhman, lennart.ohman@st.se %% ----------------------------------------------------------------------------- -module(inviso_tool_lib). @@ -145,10 +145,10 @@ expand_module_names_2(Nodes,DirStr,ModStr,Opts) -> %% Always returns a regexp or {error,Reason}. expand_module_names_special_regexp(Str) -> StrLen=length(Str), - case regexp:first_match(Str,"[0-9a-zA-Z_/]*") of - {match,1,StrLen} -> % Ok, it is the special case. + case re:run(Str,"[0-9a-zA-Z_/]*") of + {match,[{0,StrLen}]} -> % Ok, it is the special case. {ok,".*"++Str++".*"}; % Convert it to a proper regexp. - {match,_,_} -> + {match,_} -> {ok,Str}; % Keep it and hope it is a regexp. nomatch -> {ok,Str}; % Keep it and hope it is a regexp. diff --git a/lib/runtime_tools/src/inviso_rt.erl b/lib/runtime_tools/src/inviso_rt.erl index ac7ac2a584..b162f5b045 100644 --- a/lib/runtime_tools/src/inviso_rt.erl +++ b/lib/runtime_tools/src/inviso_rt.erl @@ -2359,8 +2359,8 @@ list_wrapset(Prefix,Suffix) -> list_wrapset_2([File|Rest],RegExp) -> Length=length(File), - case regexp:first_match(File,RegExp) of - {match,1,Length} -> % This is a member of the set. + case re:run(File,RegExp) of + {match,[{0,Length}]} -> % This is a member of the set. [File|list_wrapset_2(Rest,RegExp)]; _ -> list_wrapset_2(Rest,RegExp) diff --git a/lib/runtime_tools/src/inviso_rt_lib.erl b/lib/runtime_tools/src/inviso_rt_lib.erl index 2c6964e53e..ee6a72ae0c 100644 --- a/lib/runtime_tools/src/inviso_rt_lib.erl +++ b/lib/runtime_tools/src/inviso_rt_lib.erl @@ -197,15 +197,15 @@ match_modules(RegExpDir,RegExpMod,Actions) -> handle_expand_regexp_2([{Mod,Path}|Rest],RegExpDir,RegExpMod,Result) -> ModStr=atom_to_list(Mod), ModLen=length(ModStr), - case regexp:first_match(ModStr,RegExpMod) of - {match,1,ModLen} -> % Ok, The regexp matches the module. + case re:run(ModStr,RegExpMod) of + {match,[{0,ModLen}]} -> % Ok, The regexp matches the module. if is_list(RegExpDir),is_atom(Path) -> % Preloaded or covercompiled... handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,Result); is_list(RegExpDir),is_list(Path) -> % Dir reg-exp is used! PathOnly=filename:dirname(Path), % Must remove beam-file name. - case regexp:first_match(PathOnly,RegExpDir) of - {match,_,_} -> % Did find a match, that is enough! + case re:run(PathOnly,RegExpDir,[{capture,none}]) of + match -> % Did find a match, that is enough! handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,[Mod|Result]); _ -> % Either error or nomatch. handle_expand_regexp_2(Rest,RegExpDir,RegExpMod,Result) @@ -233,8 +233,8 @@ handle_expand_regexp_3([Path|Rest],RegExpDir,RegExpMod,AllLoaded,Result) -> volumerelative -> % Only on Windows!? filename:absname(Path) end, - case regexp:first_match(AbsPath,RegExpDir) of - {match,_,_} -> % Ok, the directory is allowed. + case re:run(AbsPath,RegExpDir,[{capture,none}]) of + match -> % Ok, the directory is allowed. NewResult=handle_expand_regexp_3_1(Path,RegExpMod,AllLoaded,Result), handle_expand_regexp_3(Rest,RegExpDir,RegExpMod,AllLoaded,NewResult); _ -> % This directory does not qualify. @@ -262,8 +262,8 @@ handle_expand_regexp_3_2([File|Rest],RegExpMod,AllLoaded,Result) -> case {lists:keysearch(Mod,1,AllLoaded),lists:member(Mod,Result)} of {false,false} -> % This module is not tried before. ModLen=length(ModStr), - case regexp:first_match(ModStr,RegExpMod) of - {match,1,ModLen} -> % This module satisfies the regexp. + case re:run(ModStr,RegExpMod) of + {match,[{0,ModLen}]} -> % This module satisfies the regexp. handle_expand_regexp_3_2(Rest,RegExpMod,AllLoaded,[Mod|Result]); _ -> % Error or not perfect match. handle_expand_regexp_3_2(Rest,RegExpMod,AllLoaded,Result) diff --git a/lib/runtime_tools/test/inviso_SUITE.erl b/lib/runtime_tools/test/inviso_SUITE.erl index 3ae8d34dd6..758867cf45 100644 --- a/lib/runtime_tools/test/inviso_SUITE.erl +++ b/lib/runtime_tools/test/inviso_SUITE.erl @@ -1380,9 +1380,10 @@ fetch_log_dist_trace_2(Config) -> io:format("~p~n",[NodeResults]), CheckFun=fun({N,{complete,[{trace_log,FileResults1},{ti_log,[{ok,TiFile}]}]}}) -> Fun2=fun({ok,File}) -> - {match,1,_}= - regexp:first_match(File, - "^"++"p1"++Name++atom_to_list(N)), + match= + re:run(File, + "^"++"p1"++Name++atom_to_list(N), + [{capture,none}]), true; (_) -> false @@ -1425,8 +1426,8 @@ fetch_log_dist_trace_3(Config) -> CheckFun=fun({N,{ok,[{trace_log,PrivDir2,[F1,F2]},{ti_log,PrivDir2,[F3]}]}})-> PrivDir2=PrivDir, RegExp="^"++Name++atom_to_list(N)++"[0-9]+"++"\.log", - {match,1,_}=regexp:first_match(F1,RegExp), - {match,1,_}=regexp:first_match(F2,RegExp), + match=re:run(F1,RegExp,[{capture,none}]), + match=re:run(F2,RegExp,[{capture,none}]), F3=Name++"_ti_"++atom_to_list(N)++".ti", true; (_) -> @@ -1439,9 +1440,10 @@ fetch_log_dist_trace_3(Config) -> io:format("~p~n",[NodeResults2]), CheckFun2=fun({N,{complete,[{trace_log,FileResults1},{ti_log,[{ok,TiFile}]}]}}) -> Fun2=fun({ok,File}) -> - {match,1,_}= - regexp:first_match(File, - "^"++"p1"++Name++atom_to_list(N)), + match= + re:run(File, + "^"++"p1"++Name++atom_to_list(N), + [{capture,none}]), true; (_) -> false @@ -2649,8 +2651,8 @@ check_on_nodes([],_,_,_,_) -> how_many_files_regexp([],_,N) -> {ok,N}; how_many_files_regexp([FName|Rest],RegExp,N) -> - case regexp:first_match(FName,RegExp) of - {match,1,_} -> + case re:run(FName,RegExp,[{capture,none}]) of + match -> how_many_files_regexp(Rest,RegExp,N+1); nomatch -> how_many_files_regexp(Rest,RegExp,N); -- cgit v1.2.3 From 9e034e51ca0f051b62e389545b3f5a56b9cec393 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 25 Aug 2011 12:08:29 +0200 Subject: gs: Eliminate use of deprecated regexp module --- lib/gs/src/gstk_editor.erl | 4 ++-- lib/gs/src/gstk_generic.erl | 2 +- lib/gs/src/gstk_image.erl | 4 ++-- lib/gs/src/tool_utils.erl | 3 ++- 4 files changed, 7 insertions(+), 6 deletions(-) diff --git a/lib/gs/src/gstk_editor.erl b/lib/gs/src/gstk_editor.erl index 3e0c8240e4..8cc7021cc6 100644 --- a/lib/gs/src/gstk_editor.erl +++ b/lib/gs/src/gstk_editor.erl @@ -243,14 +243,14 @@ option(Option, Gstkid, _MainW, DB, Editor) -> Editor, " ins ",AI," ", gstk:to_ascii(Text)]}; clear -> {c, [Editor, " delete 1.0 end"]}; {load, File} -> - {ok, F2,_} = regexp:gsub(File, [92,92], "/"), + F2 = re:replace(File, [92,92], "/", [global,{return,list}]), case gstk:call(["ed_load ", Editor, " ", gstk:to_ascii(F2)]) of {result, _} -> none; {bad_result,Re} -> {error,{no_such_file,editor,load,F2,Re}} end; {save, File} -> - {ok, F2,_} = regexp:gsub(File, [92,92], "/"), + F2 = re:replace(File, [92,92], "/", [global,{return,list}]), case gstk:call(["ed_save ",Editor," ",gstk:to_ascii(F2)]) of {result, _} -> none; {bad_result,Re} -> diff --git a/lib/gs/src/gstk_generic.erl b/lib/gs/src/gstk_generic.erl index 3ddb69efc5..2cc6c4c2d3 100644 --- a/lib/gs/src/gstk_generic.erl +++ b/lib/gs/src/gstk_generic.erl @@ -414,7 +414,7 @@ gen_font(_Opt,Gstkid,_TkW,DB,_ExtraArg) -> gen_label({text,Text},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) -> out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -text ", gstk:to_ascii(Text), " -bi {}"|S],P,C); gen_label({image,Img},Opts,Gstkid,TkW,DB,ExtraArg,S,P,C) -> - {ok, I2,_} = regexp:gsub(Img, [92,92], "/"), + I2 = re:replace(Img, [92,92], "/", [global,{return,list}]), out_opts(Opts,Gstkid,TkW,DB,ExtraArg,[" -bi \"@", I2, "\" -text {}"|S],P,C). gen_label(_Opt,_Gstkid,TkW,_DB,_ExtraArg) -> case gstk:call([TkW, " cg -bit"]) of diff --git a/lib/gs/src/gstk_image.erl b/lib/gs/src/gstk_image.erl index 5ad37cf6de..9adbe42386 100644 --- a/lib/gs/src/gstk_image.erl +++ b/lib/gs/src/gstk_image.erl @@ -227,10 +227,10 @@ event(DB, Gstkid, Etype, Edata, Args) -> option(Option, Gstkid, _Canvas, _DB, _AItem) -> case Option of {bitmap, Bitmap} -> - {ok, BF,_} = regexp:gsub(Bitmap, [92,92], "/"), + BF = re:replace(Bitmap, [92,92], "/", [global,{return,list}]), {s, [" -bi @", BF]}; {load_gif, File} -> - {ok, F2,_} = regexp:gsub(File, [92,92], "/"), + F2 = re:replace(File, [92,92], "/", [global,{return,list}]), {Photo_item, _item} = Gstkid#gstkid.widget_data, {c,[Photo_item, " configure -file ", gstk:to_ascii(F2)]}; {pix_val, {Coords,Color}} -> diff --git a/lib/gs/src/tool_utils.erl b/lib/gs/src/tool_utils.erl index b07e92c4f0..d09af5f22f 100644 --- a/lib/gs/src/tool_utils.erl +++ b/lib/gs/src/tool_utils.erl @@ -98,7 +98,8 @@ open_help_default(Parent, File) -> _Else -> "netscape -remote \"openURL(file:" ++ File ++ ")\"" end; {win32,_AnyType} -> - "netscape.exe -h " ++ regexp:gsub(File,"\\\\","/"); + "netscape.exe -h " ++ + re:replace(File,"\\\\","/",[global,{return,list}]); _Other -> unknown end; -- cgit v1.2.3 From b22894a3b82675d88b06428fe38eceeef8ca3870 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 25 Aug 2011 14:02:43 +0200 Subject: tv: Eliminate use of deprecated regexp module --- lib/tv/src/tv_db_search.erl | 32 +++++--------------------------- 1 file changed, 5 insertions(+), 27 deletions(-) diff --git a/lib/tv/src/tv_db_search.erl b/lib/tv/src/tv_db_search.erl index edd3c188e2..7634bc63b6 100644 --- a/lib/tv/src/tv_db_search.erl +++ b/lib/tv/src/tv_db_search.erl @@ -244,10 +244,10 @@ get_entry_text() -> string_to_regexp(Str) -> - case regexp:parse(Str) of + case re:compile(Str) of {ok, RegExp} -> {ok, RegExp}; - _Error -> + {error, _Error} -> case get(error_msg_mode) of normal -> {error, {not_a_regexp, "Please enter a regular expression!"}}; @@ -410,33 +410,11 @@ search_for_regexp(Pattern, Elem, ListAsStr) -> lists:flatten(tv_io_lib:write(Elem)) end, - case regexp:first_match(ListToSearch, Pattern) of - {match, _, _} -> + case re:run(ListToSearch, Pattern, [{capture,none}]) of + match -> found; - _Other -> + nomatch -> not_found - %% The code below shall be used instead if it is desired to - %% compare each *element* in the tuples to the regular expression, - %% i.e., treat each element as a new line/string. - %% The difference is most easily explained through an example: - %% If we treat each tuple as a new line/string, the regular expression - %% "^{win" will match the string "{win, 1, 2, 3}", but not the string - %% "{1, {win,2}}". - %% If we treat each element as a new line/string, the RE "^{win" will match - %% both strings above. - - %% SearchList = tuple_to_list(Elem), - %% case lists:dropwhile( - %% fun(H) -> - %% nomatch == regexp:first_match(lists:flatten(io_lib:write(H)), - %% Pattern) - %% end, - %% SearchList) of - %% [] -> - %% not_found; - %% _AnyList -> - %% found - %% end end. -- cgit v1.2.3 From b5599c98a4e38c029b1cf00f46a2323c83f59f1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 26 Aug 2011 09:08:52 +0200 Subject: appmon: Eliminate use of deprecated regexp module --- lib/appmon/src/appmon_web.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/appmon/src/appmon_web.erl b/lib/appmon/src/appmon_web.erl index fb7144246c..7c0451c3c3 100644 --- a/lib/appmon/src/appmon_web.erl +++ b/lib/appmon/src/appmon_web.erl @@ -578,9 +578,9 @@ htmlify_pid([],New)-> %% the HTTP protocol %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% urlify_pid(Pid) -> - case regexp:first_match(Pid,"[<].*[>]") of - {match,Start,Len}-> - "%3C"++string:substr(Pid,Start+1,Len-2)++"%3E"; + case re:run(Pid,"[<](.*)[>]",[{capture,all_but_first,list}]) of + {match,[PidStr]}-> + "%3C"++PidStr++"%3E"; _-> Pid end. -- cgit v1.2.3 From a527bdefdd7232a4f9d180d097dbec383542f245 Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Fri, 21 Oct 2011 11:06:18 +0200 Subject: Cleanup after testcases in ttb_SUITE Slave nodes were earlier stopped inside each test case. If a test case failed before this point, a slave node would survive and it might interfere with the next test case causing multiple failures. This commit moves the stopping of slave nodes out to a separate function for each test case - called during end_per_testcase. A minor correction is also done in ttb:ensure_no_overloaded_nodes - the reply message sent back from the ttb process is tagged so only the expected message will be picked from the message queue. Otherwise, for instance nodedown messages from the monitoring of slave nodes (by the test cases) could be received here. Finally, the sleep timer when waiting for trace messages to arrive over tcp/ip is extended a bit since test cases sometimes failed with missing trace messages here. --- lib/observer/src/ttb.erl | 6 +- lib/observer/test/ttb_SUITE.erl | 284 ++++++++++++++++++++++++--------------- lib/observer/test/ttb_helper.erl | 2 +- 3 files changed, 180 insertions(+), 112 deletions(-) diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 072aa165e7..ce88de6852 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -519,7 +519,7 @@ ensure_no_overloaded_nodes() -> []; _ -> ?MODULE ! {get_overloaded, self()}, - receive O -> O end + receive {overloaded,O} -> O end end, case Overloaded of [] -> ok; @@ -715,7 +715,7 @@ loop(NodeInfo, SessionInfo) -> lists:keydelete(overloaded, 1, SessionInfo)}, loop(NodeInfo, [{overloaded, [Node|Overloaded]} | SI]); {get_overloaded, Pid} -> - Pid ! proplists:get_value(overloaded, SessionInfo, []), + Pid ! {overloaded,proplists:get_value(overloaded, SessionInfo, [])}, loop(NodeInfo, SessionInfo); trace_started -> case proplists:get_value(timer, SessionInfo) of diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index 1fd8b4c892..f8647bd087 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -46,9 +46,12 @@ init_per_testcase(_Case, Config) -> os:cmd("rm -rf ttb_last_config"), ?line Dog=test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> +end_per_testcase(Case, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog), + try apply(?MODULE,Case,[cleanup,Config]) + catch error:undef -> ok + end, ok. suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -119,7 +122,6 @@ file(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?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")), @@ -130,6 +132,9 @@ file(Config) when is_list(Config) -> end_of_trace] = flush(), ok. +file(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + file_no_pi(suite) -> []; file_no_pi(doc) -> @@ -150,7 +155,6 @@ file_no_pi(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?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")), @@ -163,6 +167,10 @@ file_no_pi(Config) when is_list(Config) -> ?line true = is_pid(RemoteProc), ok. +file_no_pi(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + + file_fetch(suite) -> []; file_fetch(doc) -> @@ -201,7 +209,6 @@ file_fetch(Config) when is_list(Config) -> ?line [StoreString] = ?t:capture_get(), ?line UploadDir = lists:last(string:tokens(lists:flatten(StoreString),"$ \n")), - ?line ?t:stop_node(OtherNode), %% check that files are no longer in original directories... ?line ok = check_gone(ThisDir,atom_to_list(Node)++"-file_fetch"), @@ -228,6 +235,10 @@ file_fetch(Config) when is_list(Config) -> ?line ok = file:set_cwd(Cwd), ok. +file_fetch(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + + wrap(suite) -> []; wrap(doc) -> @@ -251,7 +262,6 @@ wrap(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ttb:stop([nofetch]), - ?line ?t:stop_node(OtherNode), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(Node)++"-wrap.*.wrp")), ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, @@ -280,6 +290,9 @@ wrap(Config) when is_list(Config) -> end_of_trace] = flush(), ok. +wrap(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + wrap_merge(suite) -> []; wrap_merge(doc) -> @@ -303,7 +316,6 @@ wrap_merge(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ttb:stop([nofetch]), - ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-wrap_merge.*.wrp"), @@ -318,6 +330,9 @@ wrap_merge(Config) when is_list(Config) -> end_of_trace] = flush(), ok. +wrap_merge(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + wrap_merge_fetch_format(suite) -> []; @@ -348,7 +363,6 @@ wrap_merge_fetch_format(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ttb:stop([format]), - ?line ?t:stop_node(OtherNode), ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, @@ -360,6 +374,8 @@ wrap_merge_fetch_format(Config) when is_list(Config) -> ?line ok = file:set_cwd(Cwd), ok. +wrap_merge_fetch_format(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). write_config1(suite) -> []; @@ -384,7 +400,6 @@ write_config1(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ttb:stop([nofetch]), - ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config1"), @@ -410,6 +425,10 @@ write_config1(Config) when is_list(Config) -> end, ok. + +write_config1(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + write_config2(suite) -> []; write_config2(doc) -> @@ -433,7 +452,6 @@ write_config2(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ttb:stop([nofetch]), - ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config2"), @@ -459,6 +477,10 @@ write_config2(Config) when is_list(Config) -> end, ok. +write_config2(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + + write_config3(suite) -> []; write_config3(doc) -> @@ -496,7 +518,6 @@ write_config3(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ttb:stop([nofetch]), - ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config3"), @@ -522,6 +543,10 @@ write_config3(Config) when is_list(Config) -> end, ok. +write_config3(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + + history(suite) -> []; @@ -552,14 +577,15 @@ history(Config) when is_list(Config) -> ?line ok = ttb:run_history([3,4]), ?line ?MODULE:foo(), ?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_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. - + +history(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). write_trace_info(suite) -> @@ -582,7 +608,6 @@ write_trace_info(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?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, @@ -594,6 +619,9 @@ write_trace_info(Config) when is_list(Config) -> ok. +write_trace_info(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + seq_trace(suite) -> []; @@ -680,7 +708,6 @@ 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([nofetch]), - ?line ?t:stop_node(RemoteNode), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(RemoteNode)++"-diskless")), @@ -688,6 +715,9 @@ diskless(Config) when is_list(Config) -> end_of_trace] = flush(), ok. +diskless(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + diskless_wrap(suite) -> []; diskless_wrap(doc) -> @@ -707,7 +737,6 @@ diskless_wrap(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([nofetch]), - ?line ?t:stop_node(RemoteNode), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(RemoteNode)++"-diskless.*.wrp")), @@ -715,6 +744,9 @@ diskless_wrap(Config) when is_list(Config) -> end_of_trace] = flush(), ok. +diskless_wrap(cleanup,_Config) -> + ?line ?t:stop_node(ttb_helper:get_node(node2)). + otp_4967_1(suite) -> []; otp_4967_1(doc) -> @@ -767,8 +799,6 @@ otp_4967_2(Config) when is_list(Config) -> ok. - - myhandler(_Fd,Trace,_,Relay) -> Relay ! Trace, Relay. @@ -872,6 +902,27 @@ start_client_and_server() -> ?line ttb_helper:clear(), {ServerNode, ClientNode}. +stop_client_and_server() -> + ClientNode = ttb_helper:get_node(client), + ServerNode = ttb_helper:get_node(server), + erlang:monitor_node(ClientNode,true), + erlang:monitor_node(ServerNode,true), + ?line ?t:stop_node(ClientNode), + ?line ?t:stop_node(ServerNode), + wait_for_client_and_server_stop(ClientNode,ServerNode). + +wait_for_client_and_server_stop(undefined,undefined) -> + ok; +wait_for_client_and_server_stop(ClientNode,ServerNode) -> + receive + {nodedown,ClientNode} -> + erlang:monitor_node(ClientNode,false), + wait_for_client_and_server_stop(undefined,ServerNode); + {nodedown,ServerNode} -> + erlang:monitor_node(ServerNode,false), + wait_for_client_and_server_stop(ClientNode,undefined) + end. + begin_trace(ServerNode, ClientNode, Dest) -> ?line {ok, _} = ttb:tracer([ServerNode,ClientNode],[{file, Dest}]), @@ -912,10 +963,12 @@ fetch_when_no_option_given(Config) when is_list(Config) -> 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*")). +fetch_when_no_option_given(cleanup,_Config) -> + ?line stop_client_and_server(). + + basic_ttb_run_ip_port(suite) -> []; basic_ttb_run_ip_port(doc) -> @@ -924,9 +977,9 @@ 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). + ?line check_size(10, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode). +basic_ttb_run_ip_port(cleanup,_Config) -> + ?line stop_client_and_server(). basic_ttb_run_file_port(suite) -> []; @@ -936,9 +989,9 @@ 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). + ?line check_size(10, ?FNAME, ?OUTPUT, ServerNode, ClientNode). +basic_ttb_run_file_port(cleanup,_Config) -> + ?line stop_client_and_server(). return_fetch_dir_implies_fetch(suite) -> []; @@ -948,9 +1001,9 @@ 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). + ?line {_,_} = ttb:stop([return_fetch_dir]). +return_fetch_dir_implies_fetch(cleanup,_Config) -> + ?line stop_client_and_server(). logfile_name_in_fetch_dir(suite) -> []; @@ -960,11 +1013,11 @@ 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. +logfile_name_in_fetch_dir(cleanup,_Config) -> + ?line stop_client_and_server(). upload_to_my_logdir(suite) -> []; @@ -975,10 +1028,10 @@ upload_to_my_logdir(Config) when is_list(Config) -> ?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_logdir(cleanup,_Config) -> + ?line stop_client_and_server(). upload_to_my_existing_logdir(suite) -> []; @@ -990,9 +1043,9 @@ upload_to_my_existing_logdir(Config) when is_list(Config) -> ?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). + ?line {stopped,_} = ttb:stop(return_fetch_dir). +upload_to_my_existing_logdir(cleanup,_Config) -> + ?line stop_client_and_server(). fetch_with_options_not_as_list(suite) -> []; @@ -1003,11 +1056,11 @@ fetch_with_options_not_as_list(Config) when is_list(Config) -> ?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). +fetch_with_options_not_as_list(cleanup,_Config) -> + ?line stop_client_and_server(). error_when_formatting_multiple_files_4393(suite) -> []; @@ -1018,11 +1071,11 @@ error_when_formatting_multiple_files_4393(Config) when is_list(Config) -> ?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 Files = [filename:join(Dir, atom_to_list(ServerNode) ++ "-" ++ ?FNAME), + filename:join(Dir, atom_to_list(ClientNode) ++ "-" ++ ?FNAME)], ?line ok = ttb:format(Files). +error_when_formatting_multiple_files_4393(cleanup,_Config) -> + ?line stop_client_and_server(). format_on_trace_stop(suite) -> []; @@ -1034,10 +1087,10 @@ format_on_trace_stop(Config) when is_list(Config) -> ?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"). +format_on_trace_stop(cleanup,_Config) -> + ?line stop_client_and_server(). %% The following three tests are for the issue "fixes fetch fail when nodes on the same host %% have different cwd" @@ -1050,9 +1103,9 @@ trace_to_remote_files_on_localhost_with_different_pwd(Config) when is_list(Confi ?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_remote_files_on_localhost_with_different_pwd(cleanup,_Config) -> + ?line stop_client_and_server(). trace_to_local_files_on_localhost_with_different_pwd(suite) -> []; @@ -1063,9 +1116,9 @@ trace_to_local_files_on_localhost_with_different_pwd(Config) when is_list(Config ?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_local_files_on_localhost_with_different_pwd(cleanup,_Config) -> + ?line stop_client_and_server(). trace_to_remote_files_on_localhost_with_different_pwd_abs(suite) -> []; @@ -1078,9 +1131,9 @@ trace_to_remote_files_on_localhost_with_different_pwd_abs(Config) when is_list(C ?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_to_remote_files_on_localhost_with_different_pwd_abs(cleanup,_Config) -> + ?line stop_client_and_server(). %% Trace is not affected by changes of cwd on control node or remote nodes during tracing %% (three tests) @@ -1100,9 +1153,9 @@ changing_cwd_on_control_node(Config) when is_list(Config) -> ?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(cleanup,_Config) -> + ?line stop_client_and_server(). changing_cwd_on_control_node_with_local_trace(suite) -> []; @@ -1120,9 +1173,9 @@ changing_cwd_on_control_node_with_local_trace(Config) when is_list(Config) -> ?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(cleanup,_Config) -> + ?line stop_client_and_server(). changing_cwd_on_remote_node(suite) -> []; @@ -1138,9 +1191,9 @@ changing_cwd_on_remote_node(Config) when is_list(Config) -> ?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 true = (2*(NumMsgs + 1) == length(Ret)). +changing_cwd_on_remote_node(cleanup,_Config) -> + ?line stop_client_and_server(). one_command_trace_setup(suite) -> []; @@ -1148,19 +1201,19 @@ 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:start_trace([ClientNode, ServerNode], + [{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). +one_command_trace_setup(cleanup,_Config) -> + ?line stop_client_and_server(). dbg_style_fetch(suite) -> []; @@ -1169,12 +1222,12 @@ dbg_style_fetch(doc) -> 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 ttb:start_trace([ClientNode, ServerNode], + [{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("."))), @@ -1182,15 +1235,15 @@ dbg_style_fetch(Config) when is_list(Config) -> %%+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)], + ttb:start_trace([ClientNode, ServerNode], [{server, received, '_', []}, - {client, put, 1, []}, - {client, get, '_', []}], + {client, put, 1, []}, + {client, get, '_', []}], {all, call}, [{shell, only}]), - ?line ttb:stop(), - ?line ?t:stop_node(ServerNode), - ?line ?t:stop_node(ClientNode). + ?line ttb:stop(). +dbg_style_fetch(cleanup,_Config) -> + ?line stop_client_and_server(). shell_tracing_init(suite) -> []; @@ -1198,19 +1251,19 @@ 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:tracer([ClientNode, ServerNode], shell), ?line ttb:stop(), - ?line ttb:tracer([ttb_helper:get_node(client), ttb_helper:get_node(server)], + ?line ttb:tracer([ClientNode, ServerNode], [{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. + ?line local_client_required_on_shell_tracing = + try ttb:tracer([ClientNode, ServerNode],[{file, ?FNAME}, shell]) + catch + exit:local_client_required_on_shell_tracing -> + local_client_required_on_shell_tracing + end. +shell_tracing_init(cleanup,_Config) -> + ?line stop_client_and_server(). only_one_state_for_format_handler(suite) -> []; @@ -1221,11 +1274,11 @@ only_one_state_for_format_handler(Config) when is_list(Config) -> ?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_for_format_handler(cleanup,_Config) -> + ?line stop_client_and_server(). only_one_state_with_default_format_handler(suite) -> []; @@ -1236,10 +1289,10 @@ only_one_state_with_default_format_handler(Config) when is_list(Config) -> ?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_default_format_handler(cleanup,_Config) -> + ?line stop_client_and_server(). only_one_state_with_initial_format_handler(suite) -> []; @@ -1255,11 +1308,11 @@ only_one_state_with_initial_format_handler(Config) when is_list(Config) -> ?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. +only_one_state_with_initial_format_handler(cleanup,_Config) -> + ?line stop_client_and_server(). run_trace_with_shortcut(Shortcut, Ret, F) -> ?line {ServerNode, ClientNode} = start_client_and_server(), @@ -1271,8 +1324,7 @@ run_trace_with_shortcut(Shortcut, Ret, F) -> ?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). + ?line stop_client_and_server(). fun_for(return) -> {codestr, "fun(_) -> return_trace() end"}; @@ -1286,6 +1338,8 @@ run_trace_with_shortcut1(doc) -> 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_shortcut1(cleanup,_Config) -> + ?line stop_client_and_server(). run_trace_with_shortcut2(suite) -> []; @@ -1294,6 +1348,8 @@ run_trace_with_shortcut2(doc) -> 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_shortcut2(cleanup,_Config) -> + ?line stop_client_and_server(). run_trace_with_shortcut3(suite) -> []; @@ -1302,6 +1358,8 @@ run_trace_with_shortcut3(doc) -> 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_shortcut3(cleanup,_Config) -> + ?line stop_client_and_server(). run_trace_with_shortcut4(suite) -> []; @@ -1310,6 +1368,8 @@ run_trace_with_shortcut4(doc) -> 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). +run_trace_with_shortcut4(cleanup,_Config) -> + ?line stop_client_and_server(). cant_specify_local_and_flush(suite) -> []; @@ -1317,13 +1377,15 @@ 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). + ?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. +cant_specify_local_and_flush(cleanup,_Config) -> + ?line stop_client_and_server(). trace_sorted_by_default(suite) -> []; @@ -1334,11 +1396,11 @@ trace_sorted_by_default(Config) when is_list(Config) -> ?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. +trace_sorted_by_default(cleanup,_Config) -> + ?line stop_client_and_server(). disable_sorting(suite) -> []; @@ -1349,11 +1411,11 @@ disable_sorting(Config) when is_list(Config) -> ?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. +disable_sorting(cleanup,_Config) -> + ?line stop_client_and_server(). %% ----------------------------------------------------------------------------- %% tests for autoresume of tracing @@ -1367,6 +1429,8 @@ 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(cleanup,_Config) -> + ?line stop_client_and_server(). trace_resumed_after_node_restart_ip(suite) -> []; @@ -1376,6 +1440,8 @@ 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_ip(cleanup,_Config) -> + ?line stop_client_and_server(). trace_resumed_after_node_restart_wrap(suite) -> []; @@ -1385,6 +1451,8 @@ 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(cleanup,_Config) -> + ?line stop_client_and_server(). trace_resumed_after_node_restart_wrap_mult(suite) -> []; @@ -1394,18 +1462,18 @@ 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). +trace_resumed_after_node_restart_wrap_mult(cleanup,_Config) -> + ?line stop_client_and_server(). 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,_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). diff --git a/lib/observer/test/ttb_helper.erl b/lib/observer/test/ttb_helper.erl index 19fdc0e159..76b06cd3ce 100644 --- a/lib/observer/test/ttb_helper.erl +++ b/lib/observer/test/ttb_helper.erl @@ -70,7 +70,7 @@ msgs(N) -> 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 + timer:sleep(200). %% allow trace messages to arrive over tcp/ip run() -> ttb({local, "A"}), -- cgit v1.2.3 From ecdf8f06ccd9506084676e496222e0697730728d Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Wed, 26 Oct 2011 10:07:05 +0200 Subject: Adjust ttb_SUITE to work better on windows There is a problem with long paths on windows, which causes some of the ttb logs in this suite not to be created. To go around this, the original priv_dir from the Config is no longer used for writing the logs. Instead a new priv_dir is created in the data_dir - which makes the path much shorter. There is also a problem caused by the lower resolution of the system clock on windows. It makes the test cases for sorting trace messages fail. To get around this a sleep of 2 ms is added in "appropriate places", and also the messages sent between client and server when creating the trace log for these test cases is now better synched. The cleanup functions, which terminate slave nodes, was called in end_per_testcase. However, it seems to be a bug in the test_server which causes this to hang if the test case failed with a timetrap_timeout. Workaround for this is to do the cleanup in init_per_testcase instead - i.e. make sure that nodes that are to be started by the test case do not already live when the test case starts. --- lib/observer/test/client.erl | 2 +- lib/observer/test/server.erl | 3 +- lib/observer/test/ttb_SUITE.erl | 86 +++++++++++++++++++++++++++++------------ 3 files changed, 64 insertions(+), 27 deletions(-) diff --git a/lib/observer/test/client.erl b/lib/observer/test/client.erl index e756f9d6e8..90b72d3f8f 100644 --- a/lib/observer/test/client.erl +++ b/lib/observer/test/client.erl @@ -23,6 +23,6 @@ get() -> put(Thing) -> erlang:send({server,server_node()}, {put,self(),Thing}), - receive ok -> ok + receive ok -> timer:sleep(2), ok after 1000 -> no_reply end. diff --git a/lib/observer/test/server.erl b/lib/observer/test/server.erl index c1b1fea562..f6d3542c96 100644 --- a/lib/observer/test/server.erl +++ b/lib/observer/test/server.erl @@ -16,8 +16,9 @@ stop() -> loop(Data, Num) -> receive - {put,From,Ting} -> From ! ok, + {put,From,Ting} -> timer:sleep(2), received(From,Ting), + From ! ok, loop([Ting|Data], Num+1); {get,From} -> From ! Data, loop(Data, Num+1); diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index f8647bd087..695d41b48a 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -37,21 +37,32 @@ -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"), +init_per_testcase(Case, Config) -> ?line Dog=test_server:timetrap(?default_timeout), + ttb:stop(), + rm(?OUTPUT), + [rm(Upload) || Upload<-filelib:wildcard("ttb_upload*")], + rm(?DIRNAME), + [rm(At) || At <- filelib:wildcard("*@*")], + rm("ttb_last_config"), + %% Workaround for bug(?) in test_server - if the test case fails + %% with a timetrap timeout, then end_per_testcase will run with + %% faulty group_leader - which in turn makes test_server:stop_node + %% hang (stop_node is called by most of the cleanup functions). + %% Therefore we do the cleanup before each testcase instead - this + %% is obviously not 100% correct, but it will at least make sure + %% that the nodes which are to be started in a test case at are + %% terminated. + try apply(?MODULE,Case,[cleanup,Config]) + catch error:undef -> ok + end, [{watchdog, Dog}|Config]. end_per_testcase(Case, Config) -> + %% try apply(?MODULE,Case,[cleanup,Config]) + %% catch error:undef -> ok + %% end, Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog), - try apply(?MODULE,Case,[cleanup,Config]) - catch error:undef -> ok - end, ok. suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -84,6 +95,7 @@ groups() -> []. init_per_suite(Config) -> + clean_priv_dir(Config), Config. end_per_suite(_Config) -> @@ -105,7 +117,7 @@ file(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"file"), ?line {ok,[Node]} = ttb:tracer(Node,[{file, File}, @@ -144,7 +156,7 @@ file_no_pi(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"file"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, File}, @@ -180,7 +192,7 @@ file_fetch(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line ThisDir = filename:join(Privdir,this), ?line ok = file:make_dir(ThisDir), ?line OtherDir = filename:join(Privdir,other), @@ -248,7 +260,7 @@ wrap(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"wrap"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, {wrap,File,200,3}}, @@ -302,7 +314,7 @@ wrap_merge(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"wrap_merge"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, {wrap,File,200,3}}, @@ -343,7 +355,7 @@ wrap_merge_fetch_format(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"wrap_merge_fetch_format"), %% I'm setting priv_dir as cwd, so ttb_upload directory is created there @@ -387,7 +399,7 @@ write_config1(Config) when is_list(Config) -> ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"write_config1"), ?line ok = ttb:write_config(File, [{ttb,tracer,[[Node,OtherNode], @@ -438,7 +450,7 @@ write_config2(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"write_config2"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, File}, @@ -490,7 +502,7 @@ write_config3(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"write_config3"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, File}, @@ -559,7 +571,7 @@ history(Config) when is_list(Config) -> ?line S = self(), ?line Nodes = [Node,OtherNode], - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"history"), ?line StartOpts = [{file, File}, {handler,{fun myhandler/4, S}}], @@ -597,7 +609,7 @@ write_trace_info(Config) when is_list(Config) -> ?line {ok,OtherNode} = ?t:start_node(node2,slave,[]), ?line c:nl(?MODULE), ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"write_trace_info"), ?line {ok,[_,_]} = ttb:tracer([Node,OtherNode],[{file, File}, @@ -630,7 +642,7 @@ seq_trace(doc) -> seq_trace(Config) when is_list(Config) -> ?line S = self(), - ?line Privdir=?config(priv_dir, Config), + ?line Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"seq_trace"), ?line {ok,[Node]} = ttb:tracer(node(),[{file,File}, {handler,{fun myhandler/4, S}}]), @@ -697,7 +709,7 @@ diskless(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 Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"diskless"), ?line {ok,[RemoteNode]} = ttb:tracer([RemoteNode],[{file, {local, File}}, @@ -726,7 +738,7 @@ 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 Privdir=priv_dir(Config), ?line File = filename:join(Privdir,"diskless"), ?line {ok,[RemoteNode]} = ttb:tracer([RemoteNode],[{file, {local, {wrap,File,200,3}}}, @@ -765,7 +777,7 @@ otp_4967_2(doc) -> ["OTP-4967: Trace message sent to {Name, Node}"]; otp_4967_2(Config) when is_list(Config) -> io:format("1: ~p",[now()]), - ?line Privdir = ?config(priv_dir,Config), + ?line Privdir = priv_dir(Config), io:format("2: ~p",[now()]), ?line File = filename:join(Privdir,"otp_4967"), io:format("3: ~p",[now()]), @@ -1496,3 +1508,27 @@ helper_msgs(N, TracingType) -> _ -> ttb_helper:msgs(N) end. + +priv_dir(Conf) -> + %% Due to problem with long paths on windows => creating a new + %% priv_dir under data_dir + Dir = filename:absname(filename:join(?config(data_dir, Conf),priv_dir)), + filelib:ensure_dir(filename:join(Dir,"*")), + Dir. + +clean_priv_dir(Config) -> + PrivDir = priv_dir(Config), + case filelib:is_dir(PrivDir) of + true -> rm(PrivDir); + false -> ok + end. + +rm(This) -> + case filelib:is_dir(This) of + true -> + {ok,Files} = file:list_dir(This), + [rm(filename:join(This,F)) || F <- Files], + file:del_dir(This); + false -> + file:delete(This) + end. -- cgit v1.2.3 From 1d6a8d2c28f6a113ab123f74d8a647d14779baf1 Mon Sep 17 00:00:00 2001 From: Siri Hansen Date: Thu, 27 Oct 2011 10:40:16 +0200 Subject: Close ip_to_file trace port in ttb:stop This is a relay port opened from the IP trace client when tracing diskless nodes. The port was not closed properly in ttb:stop, which caused problems on windows since the file could not be moved to the upload directory before the file descriptor was closed. --- lib/observer/src/ttb.erl | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 072aa165e7..d2d9010c0f 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -687,6 +687,11 @@ loop(NodeInfo, SessionInfo) -> {MetaFile,undefined} end, loop(dict:store(Node,{AbsoluteMetaFile,MetaPid},NodeInfo), SessionInfo); + {ip_to_file_trace_port,Port,Sender} -> + Ports = proplists:get_value(ip_to_file_trace_ports, SessionInfo, []), + NewSessionInfo = [{ip_to_file_trace_ports,[Port|Ports]}|SessionInfo], + Sender ! {?MODULE,ok}, + loop(NodeInfo, NewSessionInfo); {get_nodes,Sender} -> Sender ! {?MODULE,dict:fetch_keys(NodeInfo)}, loop(NodeInfo, SessionInfo); @@ -736,7 +741,7 @@ loop(NodeInfo, SessionInfo) -> end end. -do_stop(nofetch, Sender, NodeInfo, _) -> +do_stop(nofetch, Sender, NodeInfo, SessionInfo) -> write_config(?last_config, all), dict:fold( fun(Node,{_,MetaPid},_) -> @@ -744,6 +749,7 @@ do_stop(nofetch, Sender, NodeInfo, _) -> end, ok, NodeInfo), + stop_ip_to_file_trace_ports(SessionInfo), dbg:stop_clear(), ets:delete(?history_table), Sender ! {?MODULE, stopped}; @@ -766,6 +772,7 @@ do_stop({FetchOrFormat, UserDir}, Sender, NodeInfo, SessionInfo) -> end, [], NodeInfo), + stop_ip_to_file_trace_ports(SessionInfo), dbg:stop_clear(), AllNodes = lists:map( @@ -784,6 +791,19 @@ do_stop({FetchOrFormat, UserDir}, Sender, NodeInfo, SessionInfo) -> end, Sender ! {?MODULE,{stopped,Absname}}. +stop_ip_to_file_trace_ports(SessionInfo) -> + lists:foreach(fun(Port) -> + case lists:member(Port,erlang:ports()) of + true -> + dbg:deliver_and_flush(Port), + erlang:port_close(Port); + false -> + ok + end + end, + proplists:get_value(ip_to_file_trace_ports,SessionInfo,[])). + + make_node_dead(Node, NodeInfo, SessionInfo) -> {MetaFile,_} = dict:fetch(Node, NodeInfo), NewDeadNodes = [{Node, MetaFile} | proplists:get_value(dead_nodes, SessionInfo)], @@ -1263,6 +1283,9 @@ ip_to_file(Trace, {_, only} = 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(), + %% Store the port so it can be properly closed + ?MODULE ! {ip_to_file_trace_port, Port, self()}, + receive {?MODULE,ok} -> ok end, case Trace of {metadata, _, _} -> ok; Trace -> show_trace(Trace, ShellOutput) -- cgit v1.2.3 From 043335119b1625d04d87c33851749a9f742b024a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 9 Aug 2011 10:40:37 +0200 Subject: xmerl test suite: Eliminate use of deprecated regexp module --- lib/xmerl/test/xmerl_test_lib.erl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/xmerl/test/xmerl_test_lib.erl b/lib/xmerl/test/xmerl_test_lib.erl index a83956c076..e82ad283b2 100644 --- a/lib/xmerl/test/xmerl_test_lib.erl +++ b/lib/xmerl/test/xmerl_test_lib.erl @@ -87,6 +87,6 @@ keysearch_delete(Key,N,List) -> %% the original data directory. get_data_dir(Config) -> - Data0 = ?config(data_dir, Config), - {ok,Data,_} = regexp:sub(Data0, "xmerl_sax_std_SUITE", "xmerl_std_SUITE"), - Data. + Data = ?config(data_dir, Config), + Opts = [{return,list}], + re:replace(Data, "xmerl_sax_std_SUITE", "xmerl_std_SUITE", Opts). -- cgit v1.2.3 From f772969e11e114e2060730cb618b7b528bfc5172 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 9 Aug 2011 11:10:20 +0200 Subject: tools test suite: Eliminate use of deprecated regexp module Also extend the test suite so that the changed code will be executed. --- lib/tools/test/eprof_SUITE_data/ed.script | 2 ++ lib/tools/test/eprof_SUITE_data/eed.erl | 39 +++++++++++++++++-------------- 2 files changed, 23 insertions(+), 18 deletions(-) diff --git a/lib/tools/test/eprof_SUITE_data/ed.script b/lib/tools/test/eprof_SUITE_data/ed.script index 94531a9e98..fe1625bc50 100644 --- a/lib/tools/test/eprof_SUITE_data/ed.script +++ b/lib/tools/test/eprof_SUITE_data/ed.script @@ -1,5 +1,7 @@ H r eed.erl +1,$s/Created :/Skapad :/p +/^cmd_line/,/^file/-1p g/^[a-z][a-zA-Z_]*\(/i\ %%% -------------------------------------------------------------\ %%% A stupid function header.\ diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl index 0175abdd0e..75524a4f2c 100644 --- a/lib/tools/test/eprof_SUITE_data/eed.erl +++ b/lib/tools/test/eprof_SUITE_data/eed.erl @@ -238,8 +238,8 @@ scan_forward(End, Patt0, State) -> scan_forward1(Dot+1, After, NewState, Rest). scan_forward1(Linenum, [Line|Rest], State, RestCmd) -> - case regexp:first_match(Line#line.contents, State#state.pattern) of - {match, _, _} -> + case re:run(Line#line.contents, State#state.pattern, [{capture, none}]) of + match -> {ok, Linenum, RestCmd, State}; nomatch -> scan_forward1(Linenum+1, Rest, State, RestCmd) @@ -259,8 +259,9 @@ scan_forward2(0, [], State, RestCmd) -> scan_forward2(Linenum, [Line|Rest], State, RestCmd) -> case scan_forward2(Linenum-1, Rest, State, RestCmd) of false -> - case regexp:first_match(Line#line.contents, State#state.pattern) of - {match, _, _} -> + case re:run(Line#line.contents, State#state.pattern, + [{capture, none}]) of + match -> {ok, Linenum, RestCmd, State}; nomatch -> false @@ -612,9 +613,10 @@ subst_command([Sep|Cmd0], [First, Last], St0) -> St1 = save_for_undo(St0), {ok, Cmd1, St2} = get_pattern(Sep, Cmd0, St1), {ok, Replacement, Cmd2} = get_replacement(Sep, Cmd1), - {ok, Sub, Cmd3} = subst_check_gflag(Cmd2), + {ok, Opts, Cmd3} = subst_check_gflag(Cmd2), St3 = check_trailing_p(Cmd3, St2), - subst_command(Last-First+1, Sub, Replacement, move_to(First-1, St3), nomatch); + subst_command(Last-First+1, Opts, Replacement, + move_to(First-1, St3), nomatch); subst_command([], _, _) -> error(bad_delimiter). @@ -622,21 +624,22 @@ subst_command(0, _, _, _, nomatch) -> error(nomatch); subst_command(0, _, _, _, StLast) when record(StLast, state) -> StLast; -subst_command(Left, Sub, Repl, St0, LastMatch) -> +subst_command(Left, Opts, Repl, St0, LastMatch) -> St1 = next_line(St0), [Line|_] = St1#state.upto_dot, - case regexp:Sub(Line#line.contents, St1#state.pattern, Repl) of - {ok, _, 0} -> - subst_command(Left-1, Sub, Repl, St1, LastMatch); - {ok, NewContents, _} -> + Contents = Line#line.contents, + case re:replace(Contents, St1#state.pattern, Repl, Opts) of + Contents -> + subst_command(Left-1, Opts, Repl, St1, LastMatch); + NewContents -> %% XXX This doesn't work with marks. St2 = delete_current_line(St1), St3 = insert_line(NewContents, St2), - subst_command(Left-1, Sub, Repl, St3, St3) + subst_command(Left-1, Opts, Repl, St3, St3) end. -subst_check_gflag([$g|Cmd]) -> {ok, gsub, Cmd}; -subst_check_gflag(Cmd) -> {ok, sub, Cmd}. +subst_check_gflag([$g|Cmd]) -> {ok, [global,{return,list}], Cmd}; +subst_check_gflag(Cmd) -> {ok, [{return,list}], Cmd}. %% u - undo @@ -721,7 +724,7 @@ get_pattern(End, Cmd, State) -> get_pattern(End, [End|Rest], State, []) when State#state.pattern /= undefined -> {ok, Rest, State}; get_pattern(End, [End|Rest], State, Result) -> - case regexp:parse(lists:reverse(Result)) of + case re:compile(lists:reverse(Result)) of {error, _} -> error(bad_pattern); {ok, Re} -> @@ -765,9 +768,9 @@ match(State) when State#state.dot == 0 -> match(State) -> [Line|_] = State#state.upto_dot, Re = State#state.pattern, - case regexp:first_match(Line#line.contents, Re) of - {match, _, _} -> true; - nomatch -> false + case re:run(Line#line.contents, Re, [{capture, none}]) of + match -> true; + nomatch -> false end. skip_blanks([$ |Rest]) -> -- cgit v1.2.3 From 3077842ea7098c51b0b0e5b4fad88fbe5e8e29a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 9 Aug 2011 11:21:57 +0200 Subject: tools test suite: Eliminate compilation warnings for the eed module --- lib/tools/test/eprof_SUITE_data/eed.erl | 52 +++++++++++++++++---------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/lib/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl index 75524a4f2c..520c5f3dd1 100644 --- a/lib/tools/test/eprof_SUITE_data/eed.erl +++ b/lib/tools/test/eprof_SUITE_data/eed.erl @@ -10,6 +10,8 @@ -export([edit/0, edit/1, file/1, cmd_line/1]). +-compile({no_auto_import,[error/1]}). + -record(state, {dot = 0, % Line number of dot. upto_dot = [], % Lines up to dot (reversed). after_dot = [], % Lines after dot. @@ -60,7 +62,7 @@ loop(St0) -> ok; {error, Reason} -> loop(print_error(Reason, St1)); - St2 when record(St2, state) -> + St2 when is_record(St2, state) -> loop(St2) end. @@ -68,7 +70,7 @@ command(Cmd, St) -> case parse_command(Cmd, St) of quit -> quit; - St1 when function(St1#state.print) -> + St1 when is_function(St1#state.print) -> if St1#state.dot /= 0 -> print_current(St1); @@ -76,7 +78,7 @@ command(Cmd, St) -> ok end, St1#state{print=false}; - St1 when record(St1, state) -> + St1 when is_record(St1, state) -> St1 end. @@ -103,13 +105,13 @@ get_input([C|Rest], St, Result) -> get_line1(Io, Prompt, Result) -> get_line2(Io, io:get_line(Io, Prompt), Result). -get_line2(Io, eof, []) -> +get_line2(_Io, eof, []) -> eof; -get_line2(Io, eof, Result) -> +get_line2(_Io, eof, Result) -> lists:reverse(Result); get_line2(Io, [$\\, $\n], Result) -> get_line1(Io, '', [$\n|Result]); -get_line2(Io, [$\n], Result) -> +get_line2(_Io, [$\n], Result) -> lists:reverse(Result, [$\n]); get_line2(Io, [C|Rest], Result) -> get_line2(Io, Rest, [C|Result]). @@ -193,7 +195,7 @@ get_one1([$+|Rest], Sum, St) -> get_one2({ok, 1, Rest}, 1, Sum, St); get_one1([$-|Rest], Sum, St) -> get_one2({ok, 1, Rest}, -1, Sum, St); -get_one1(Cmd, false, St) -> +get_one1(_Cmd, false, _St) -> false; get_one1(Cmd, Sum, St) -> {ok, Sum, Cmd, St}. @@ -222,13 +224,13 @@ get_address([$', Mark|Rest], St) when $a =< Mark, Mark =< $z -> false -> {ok, 0, Rest, St} end; -get_address([$'|Rest], State) -> +get_address([$'|_Rest], _State) -> error(bad_mark); get_address([$/|Rest], State) -> scan_forward($/, Rest, State); -get_address([$?|Rest], State) -> +get_address([$?|_Rest], _State) -> error(not_implemented); -get_address(Cmd, St) -> +get_address(_Cmd, _St) -> false. scan_forward(End, Patt0, State) -> @@ -254,7 +256,7 @@ scan_forward1(_, [], State, RestCmd) -> Other end. -scan_forward2(0, [], State, RestCmd) -> +scan_forward2(0, [], _State, _RestCmd) -> false; scan_forward2(Linenum, [Line|Rest], State, RestCmd) -> case scan_forward2(Linenum-1, Rest, State, RestCmd) of @@ -297,7 +299,7 @@ parse_cmd_char($t, Cont) -> Cont(fun transpose_command/3, 2, dot); parse_cmd_char($u, Cont) -> Cont(fun undo_command/3, 0, none); parse_cmd_char($v, Cont) -> Cont(fun vglobal_command/3, 2, all); parse_cmd_char($w, Cont) -> Cont(fun write_command/3, 2, all); -parse_cmd_char(_, Cont) -> error(bad_command). +parse_cmd_char(_, _Cont) -> error(bad_command). execute_command(Fun, NumLines, Def, State, Nums, Rest) -> Lines = check_lines(NumLines, Def, Nums, State), @@ -381,7 +383,7 @@ change_command(Rest, Lines, St0) -> %% (.,.)d - delete lines -delete_command(Rest, [0, Last], St) -> +delete_command(_Rest, [0, _Last], _St) -> error(bad_linenum); delete_command(Rest, [First, Last], St0) -> St1 = check_trailing_p(Rest, save_for_undo(St0)), @@ -397,7 +399,7 @@ delete(Left, St0) -> %% e file - replace buffer with new file -enter_command(Name, [], St) when St#state.modified == true -> +enter_command(_Name, [], St) when St#state.modified == true -> error(buffer_modified); enter_command(Name, [], St0) -> enter_always_command(Name, [], St0). @@ -440,7 +442,7 @@ mark(Sense, [First, Last], St0) -> St1 = move_to(Last, St0), mark1(Sense, First-1, St1). -mark1(Sense, First, St) when St#state.dot == First -> +mark1(_Sense, First, St) when St#state.dot == First -> St; mark1(Sense, First, St) -> [Line|Prev] = St#state.upto_dot, @@ -508,16 +510,16 @@ help_always_command([], [], St) -> %% (.)i - insert text -insert_command(Rest, [0], State) -> +insert_command(_Rest, [0], _State) -> error(bad_linenum); insert_command(Rest, [Line], State) -> append_command(Rest, [Line-1], State). %% (.)kx - mark line -mark_command(_, [0], St) -> +mark_command(_, [0], _St) -> error(bad_linenum); -mark_command([Mark|Rest], [Line], St) when $a =< Mark, Mark =< $z -> +mark_command([Mark|_Rest], [_Line], _St) when $a =< Mark, Mark =< $z -> error(not_implemented); mark_command(_, _, _) -> error(bad_mark). @@ -529,12 +531,12 @@ list_command(Rest, Lines, St) -> %% (.,.)m - move lines -move_command(Cmd, [First, Last], St) -> +move_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). %% (.,.)t - copy lines -transpose_command(Cmd, [First, Last], St) -> +transpose_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). %% (.,.)n - print lines with line numbers @@ -605,9 +607,9 @@ read(After, Name, St0) -> subst_command(_, [0, _], _) -> error(bad_linenum); -subst_command([$ |Cmd0], [First, Last], St0) -> +subst_command([$ |_Cmd0], [_First, _Last], _St0) -> error(bad_delimiter); -subst_command([$\n|Cmd0], [First, Last], St0) -> +subst_command([$\n|_Cmd0], [_First, _Last], _St0) -> error(bad_delimiter); subst_command([Sep|Cmd0], [First, Last], St0) -> St1 = save_for_undo(St0), @@ -622,7 +624,7 @@ subst_command([], _, _) -> subst_command(0, _, _, _, nomatch) -> error(nomatch); -subst_command(0, _, _, _, StLast) when record(StLast, state) -> +subst_command(0, _, _, _, StLast) when is_record(StLast, state) -> StLast; subst_command(Left, Opts, Repl, St0, LastMatch) -> St1 = next_line(St0), @@ -652,7 +654,7 @@ undo_command(_, _, _) -> %% (1,$)w - write buffer to file -write_command(Cmd, [First, Last], St) -> +write_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). @@ -757,7 +759,7 @@ check_trailing_p([$p], St) -> St#state{print=fun(Line, _) -> io:put_chars(Line) end}; check_trailing_p([], State) -> State; -check_trailing_p(Other, State) -> +check_trailing_p(_Other, _State) -> error(garbage_after_command). error(Reason) -> -- cgit v1.2.3 From 69542150b2863a2b715e03682539ec68402cb0ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 26 Aug 2011 10:09:27 +0200 Subject: erl_interface tests: Eliminate use of deprecated regexp module --- lib/erl_interface/test/all_SUITE_data/init_tc.erl | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/lib/erl_interface/test/all_SUITE_data/init_tc.erl b/lib/erl_interface/test/all_SUITE_data/init_tc.erl index 8157d590fc..8db4667bf9 100644 --- a/lib/erl_interface/test/all_SUITE_data/init_tc.erl +++ b/lib/erl_interface/test/all_SUITE_data/init_tc.erl @@ -40,23 +40,11 @@ run([]) -> run1(Name) -> CFile = Name ++ ".c", {ok, Bin} = file:read_file(CFile), - String = binary_to_list(Bin), - - %% This ConstPart stuff is because you can't retrieve part of a match. - %% Long live Perl! - - ConstPart = "\nTESTCASE\\(", - ConstPartLen = 10, - {match, Matches} = regexp:matches(String, ConstPart++"[_a-zA-Z]*"), - Cases = get_names(Matches, ConstPartLen, Bin, []), + RE = "\nTESTCASE\\(([_a-zA-Z]*)\\)", + {match, Cases0} = re:run(Bin, RE, [{capture,all_but_first,list},global]), + Cases = lists:concat(Cases0), generate(Name, Cases). -get_names([{Start, Length}|Rest], Skip, Bin, Result) -> - Name = binary_to_list(Bin, Start+Skip, Start+Length-1), - get_names(Rest, Skip, Bin, [Name|Result]); -get_names([], _Skip, _Bin, Result) -> - lists:reverse(Result). - generate(TcName, Cases) -> Hrl = TcName ++ "_cases.hrl", {ok, HrlFile} = file:open(Hrl, write), -- cgit v1.2.3 From ba794ccff6038903271f5d81c3a0ce1674a430be Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 26 Aug 2011 11:02:05 +0200 Subject: erl_html_tools: Eliminate mention of deprecated regexp module --- system/doc/top/src/erl_html_tools.erl | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/system/doc/top/src/erl_html_tools.erl b/system/doc/top/src/erl_html_tools.erl index bb6a9a9f0a..1e2b8c86af 100644 --- a/system/doc/top/src/erl_html_tools.erl +++ b/system/doc/top/src/erl_html_tools.erl @@ -624,17 +624,9 @@ lines_to_key_value([Line | Lines]) -> end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Extensions to the 'regexp' module. +% Regular expression helpers. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% is_match(Ex, Re) -> -%% case regexp:first_match(Ex, Re) of -%% {match, _, _} -> -%% true; -%% nomatch -> -%% false -%% end. - %% -type gsub(String, RegExp, Fun, Acc) -> subres(). %% Substitute every match of the regular expression RegExp with the %% string returned from the function Fun(Match, Acc). Accept pre-parsed -- cgit v1.2.3 From 4db2084d5742e54a35da5326ea0d20eac3a3f2c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 26 Aug 2011 10:18:45 +0200 Subject: erts/nt_SUITE: Eliminate use of deprecated regexp module --- erts/test/nt_SUITE.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl index 7d6da28ad6..f9bd15a0ce 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.erl @@ -490,12 +490,12 @@ middleman(Waitfor) -> match_event(_X, []) -> nomatch; match_event({Time,Cat,Fac,Sev,Mes},[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Tail]) -> - case regexp:match(Mes,MesRE) of - {match,_,_} -> + case re:run(Mes,MesRE,[{capture,none}]) of + match -> %%io:format("Match!~n"), {ok,{Pid,Ref,Time,Mes},Tail}; - _Z -> - %%io:format("No match (~p)~n",[_Z]), + nomatch -> + %%io:format("No match~n"), case match_event({Time,Cat,Fac,Sev,Mes},Tail) of {ok,X,Rest} -> {ok,X,[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Rest]}; -- cgit v1.2.3 From 14417cb51972e0116a89ab546933e2073c459bf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 26 Aug 2011 09:33:26 +0200 Subject: erts/z_SUITE: Eliminate use of deprecated regexp module --- erts/test/z_SUITE.erl | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index 8fceab32a6..482ecb8fba 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_SUITE.erl @@ -166,9 +166,12 @@ core_search_conf(RunByTS, DBTop, XDir) -> file_inspect(#core_search_conf{file = File}, Core) -> FRes0 = os:cmd(File ++ " " ++ Core), - FRes = case regexp:match(FRes0, Core) of - {match, S, E} -> + FRes = case string:str(FRes0, Core) of + 0 -> + FRes0; + S -> L = length(FRes0), + E = length(Core), case S of 1 -> lists:sublist(FRes0, E+1, L+1); @@ -178,19 +181,13 @@ file_inspect(#core_search_conf{file = File}, Core) -> " " ++ lists:sublist(FRes0, E+1, L+1) - end; - _ -> FRes0 + end end, - case regexp:match(FRes, "[Tt][Ee][Xx][Tt]") of + case re:run(FRes, "text|ascii", [caseless,{capture,none}]) of + match -> + not_a_core; nomatch -> - case regexp:match(FRes, "[Aa][Ss][Cc][Ii][Ii]") of - nomatch -> - probably_a_core; - _ -> - not_a_core - end; - _ -> - not_a_core + probably_a_core end. mk_readable(F) -> -- cgit v1.2.3 From 3e8720728abe875683ad54fa4d93ba83df609f57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 26 Oct 2011 15:37:43 +0200 Subject: erl_tidy: Eliminate two references to 'regexp' in the documentation --- lib/syntax_tools/src/erl_tidy.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index 1cfdc7234a..09efc9c392 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -103,7 +103,7 @@ dir(Dir) -> %%
{regexp, string()}
%% %%
The value denotes a regular expression (see module -%% `regexp'). Tidying will only be applied to those +%% `re'). Tidying will only be applied to those %% regular files whose names match this pattern. The default %% value is `".*\\.erl$"', which matches normal %% Erlang source file names.
@@ -124,7 +124,7 @@ dir(Dir) -> %% %% See the function {@link file/2} for further options. %% -%% @see //stdlib/regexp +%% @see //stdlib/re %% @see file/2 -record(dir, {follow_links = false :: boolean(), -- cgit v1.2.3 From 688002a16af52b2348fbc9e285ef4df32ee0e5fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 20 Oct 2011 14:30:21 +0200 Subject: doc Makefiles: Eliminate DOCSUPPORT ifdefs Some applications still have support for an ancient documentation build system. Eliminate the DOCSUPPORT define in otp.mk.in and the not taken arm of the ifdefs in the Makefiles. --- lib/asn1/doc/src/Makefile | 90 ----------------------- lib/common_test/doc/src/Makefile | 15 ---- lib/cosEvent/doc/src/Makefile | 84 ---------------------- lib/cosEventDomain/doc/src/Makefile | 87 ---------------------- lib/cosFileTransfer/doc/src/Makefile | 87 ---------------------- lib/cosNotification/doc/src/Makefile | 86 ---------------------- lib/cosProperty/doc/src/Makefile | 98 ------------------------- lib/cosTime/doc/src/Makefile | 86 ---------------------- lib/cosTransactions/doc/src/Makefile | 86 ---------------------- lib/diameter/doc/src/Makefile | 6 -- lib/diameter/make/rules.mk.in | 2 - lib/edoc/doc/Makefile | 9 --- lib/ic/doc/src/Makefile | 103 -------------------------- lib/inets/doc/src/Makefile | 96 ------------------------- lib/megaco/doc/src/Makefile | 105 --------------------------- lib/mnesia/doc/src/Makefile | 86 ---------------------- lib/odbc/doc/src/Makefile | 87 ---------------------- lib/orber/doc/src/Makefile | 89 ----------------------- lib/public_key/doc/src/Makefile | 86 ---------------------- lib/snmp/doc/src/Makefile | 136 ----------------------------------- lib/ssh/doc/src/Makefile | 85 ---------------------- lib/syntax_tools/doc/Makefile | 9 --- lib/test_server/doc/src/Makefile | 6 -- lib/tv/doc/src/Makefile | 83 --------------------- make/otp.mk.in | 2 - 25 files changed, 1709 deletions(-) diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile index d29225f6c9..566173837c 100644 --- a/lib/asn1/doc/src/Makefile +++ b/lib/asn1/doc/src/Makefile @@ -27,15 +27,6 @@ include ../../vsn.mk VSN=$(ASN1_VSN) APPLICATION=asn1 - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -86,34 +77,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) \ - $(BOOK_FILES:%.xml=%.sgml) part.tex -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -126,8 +93,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -142,32 +107,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f $(GEN_XML) errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -179,8 +118,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -191,31 +128,4 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(HTML_APPHISTORY) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif - release_spec: - - - diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index 3ea6ae65d5..964f7c76c1 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -138,12 +138,6 @@ man: $(MAN6_FILES) $(MAN3_FILES) $(MAN1_FILES) debug opt: -# -# checkout make.dep before generating new dependecies -# -#make_doc_depend: xml -# docdepend > make.dep - clean clean_docs: rm -f $(CT_XML_FILES) rm -rf $(HTMLDIR)/* @@ -176,12 +170,3 @@ release_docs_spec: docs release_spec: release_tests_spec: - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -include make.dep -# DO NOT DELETE - - diff --git a/lib/cosEvent/doc/src/Makefile b/lib/cosEvent/doc/src/Makefile index 4b76a64b7d..db2f7e6da5 100644 --- a/lib/cosEvent/doc/src/Makefile +++ b/lib/cosEvent/doc/src/Makefile @@ -26,13 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(COSEVENT_VSN) APPLICATION=cosEvent -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif # ---------------------------------------------------- # Release directory specification @@ -98,32 +91,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -136,8 +107,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -153,31 +122,6 @@ clean clean_docs: rm -f errs core *~ rm -f $(JD_HTML) $(JD_PACK) -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -192,8 +136,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -204,30 +146,4 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif - release_spec: - diff --git a/lib/cosEventDomain/doc/src/Makefile b/lib/cosEventDomain/doc/src/Makefile index 6a0d3c353a..b2cdef278a 100644 --- a/lib/cosEventDomain/doc/src/Makefile +++ b/lib/cosEventDomain/doc/src/Makefile @@ -27,14 +27,6 @@ include ../../vsn.mk VSN=$(COSEVENTDOMAIN_VSN) APPLICATION=cosEventDomain -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -93,33 +85,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -132,8 +101,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -149,32 +116,6 @@ clean clean_docs: rm -f errs core *~ rm -f $(JD_HTML) $(JD_PACK) -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -189,9 +130,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk - -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -201,30 +139,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosFileTransfer/doc/src/Makefile b/lib/cosFileTransfer/doc/src/Makefile index 2286db43ff..e62738daba 100644 --- a/lib/cosFileTransfer/doc/src/Makefile +++ b/lib/cosFileTransfer/doc/src/Makefile @@ -26,14 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(COSFILETRANSFER_VSN) APPLICATION=cosFileTransfer -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification @@ -97,33 +89,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -136,8 +105,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -152,32 +119,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -192,9 +133,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk - -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -204,30 +142,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosNotification/doc/src/Makefile b/lib/cosNotification/doc/src/Makefile index bfdd2f1f8c..2ead9aba7b 100644 --- a/lib/cosNotification/doc/src/Makefile +++ b/lib/cosNotification/doc/src/Makefile @@ -27,14 +27,6 @@ include ../../vsn.mk VSN=$(COSNOTIFICATION_VSN) APPLICATION=cosNotification -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -122,33 +114,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -161,8 +130,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -177,32 +144,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -217,8 +158,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -228,30 +167,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosProperty/doc/src/Makefile b/lib/cosProperty/doc/src/Makefile index baf995d35e..d4c89ff44f 100644 --- a/lib/cosProperty/doc/src/Makefile +++ b/lib/cosProperty/doc/src/Makefile @@ -27,14 +27,6 @@ include ../../vsn.mk VSN=$(COSPROPERTY_VSN) APPLICATION=cosProperty -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -99,35 +91,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) MAN6_FILES = $(XML_REF6_FILES:%.xml=$(MAN6DIR)/%.6) - -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_REF6_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -140,8 +107,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -156,42 +121,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -tex_users_guide: $(TEX_FILES_USERS_GUIDE) -tex_ref_man: $(TEX_FILES_REF_MAN) -tex: tex_users_guide tex_ref_man $(TEX_FILES_BOOK) - -$(DOCDIR)/latexlog: $(BOOK_FILES:%.xml=%.dvi) - -fgrep -i "latex warning" $(BOOK_FILES:%.xml=%.log) >$(DOCDIR)/latexlog - -clean_tex: - -rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - -clean: - rm -f ../html/* $(MAN3_FILES) $(MAN6_FILES) $(TEX_FILES_USERS_GUIDE) - rm -f *xmls_output *xmls_errs - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) $(MAN6_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -206,8 +135,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -217,30 +144,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosTime/doc/src/Makefile b/lib/cosTime/doc/src/Makefile index 83abc5e7c2..af418896aa 100644 --- a/lib/cosTime/doc/src/Makefile +++ b/lib/cosTime/doc/src/Makefile @@ -27,14 +27,6 @@ include ../../vsn.mk VSN=$(COSTIME_VSN) APPLICATION=cosTime -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -93,33 +85,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -132,8 +101,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -148,32 +115,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -188,8 +129,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -199,30 +138,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/cosTransactions/doc/src/Makefile b/lib/cosTransactions/doc/src/Makefile index 1af9ed24b7..7d959cbc8f 100644 --- a/lib/cosTransactions/doc/src/Makefile +++ b/lib/cosTransactions/doc/src/Makefile @@ -27,14 +27,6 @@ include ../../vsn.mk VSN=$(COSTRANSACTIONS_VSN) APPLICATION=cosTransactions -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -97,33 +89,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf - -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -136,8 +105,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -152,32 +119,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -192,8 +133,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -203,30 +142,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/diameter/doc/src/Makefile b/lib/diameter/doc/src/Makefile index 1453138cb6..bc3e649e6b 100644 --- a/lib/diameter/doc/src/Makefile +++ b/lib/diameter/doc/src/Makefile @@ -126,8 +126,6 @@ debug opt: info: @echo "->Makefile<-" @echo "" - @echo "DOCSUPPORT = $(DOCSUPPORT)" - @echo "" @echo "INDEX_FILE = $(INDEX_FILE)" @echo "INDEX_SRC = $(INDEX_SRC)" @echo "INDEX_TARGET = $(INDEX_TARGET)" @@ -141,10 +139,6 @@ info: @echo "" @echo "GIF_FILES = $(GIF_FILES)" @echo "" - @echo "TEX_FILES_USERS_GUIDE = $(TEX_FILES_USERS_GUIDE)" - @echo "TEX_FILES_REF_MAN = $(TEX_FILES_REF_MAN)" - @echo "TEX_FILES_BOOK = $(TEX_FILES_BOOK)" - @echo "" @echo "MAN1_FILES = $(MAN1_FILES)" @echo "MAN3_FILES = $(MAN3_FILES)" @echo "MAN4_FILES = $(MAN4_FILES)" diff --git a/lib/diameter/make/rules.mk.in b/lib/diameter/make/rules.mk.in index 6318f2bc9c..cd3c297d75 100644 --- a/lib/diameter/make/rules.mk.in +++ b/lib/diameter/make/rules.mk.in @@ -112,8 +112,6 @@ $(EBIN)/%.beam: $(ESRC)/%.erl # ---------------------------------------------------- # export VSN -# DOCSUPPORT = 1 - # TOPDOCDIR=../../../../doc DOCDIR = .. diff --git a/lib/edoc/doc/Makefile b/lib/edoc/doc/Makefile index c5f68b25d0..7a59809d9b 100644 --- a/lib/edoc/doc/Makefile +++ b/lib/edoc/doc/Makefile @@ -78,12 +78,3 @@ release_docs_spec: docs release_spec: - - - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- -#-include make.dep - - diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile index f255183e1f..1e93578cb1 100644 --- a/lib/ic/doc/src/Makefile +++ b/lib/ic/doc/src/Makefile @@ -26,13 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(IC_VSN) APPLICATION=ic -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif # ---------------------------------------------------- # Java specific @@ -96,32 +89,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - JAVA_SOURCE_FILES = \ Holder.java \ BooleanHolder.java \ @@ -209,8 +180,6 @@ JAVADOCFLAGS = \ $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - ifneq (,$(JAVA)) docs: pdf html man $(JAVADOC_GENERATED_FILES) else @@ -229,34 +198,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html $(JAVADOC_GENERATED_FILES) gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - rm -rf $(JAVA_OUT_DIR) - rm -f JAVADOC-GENERATED - -endif - $(JAVADOC_GENERATED_FILES): JAVADOC-GENERATED JAVADOC-GENERATED: $(JAVA_SOURCE_FILES:%=$(JAVA_SOURCE_DIR)/%) @@ -278,8 +219,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -289,46 +228,4 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) -ifneq (,$(JAVA)) - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/resources - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson/otp - $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic - $(INSTALL_DATA) $(JAVADOC_INDEX_HTML_FILES) \ - $(RELSYSDIR)/doc/html/java - $(INSTALL_DATA) $(JD_GIF_FILES) \ - $(RELSYSDIR)/doc/html/java/resources - $(INSTALL_DATA) $(JAVADOC_PACK_HTML_FILES) \ - $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic -endif - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif - - release_spec: - - diff --git a/lib/inets/doc/src/Makefile b/lib/inets/doc/src/Makefile index e4cb0c4e48..82f2a5829f 100644 --- a/lib/inets/doc/src/Makefile +++ b/lib/inets/doc/src/Makefile @@ -26,16 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../../vsn.mk VSN=$(INETS_VSN) - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -98,37 +88,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = \ - $(XML_PART_FILES:%.xml=%.tex) \ - $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_REF6_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -TOP_HTML_FILES = - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -141,8 +104,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man ldocs: local_docs @@ -156,33 +117,6 @@ html: gifs $(HTML_REF_MAN_FILE) clean clean_docs: clean_html clean_man clean_pdf rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(TOP_HTML_FILES) gifs - -clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - -clean: clean_tex clean_html clean_man - rm -f *.xmls_output *.xmls_errs - rm -f $(TOP_PDF_FILE) - rm -f errs core *~ -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -204,10 +138,7 @@ clean_man: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs - @echo "release_docs_spec(docs) when DOCSUPPORT=$DOCSUPPORT" $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf $(INSTALL_DIR) $(RELSYSDIR)/doc/html @@ -215,33 +146,6 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - @echo "release_docs_spec(pdf)" - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - @echo "release_docs_spec(ps)" - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - @echo "release_docs_spec(docs)" - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: diff --git a/lib/megaco/doc/src/Makefile b/lib/megaco/doc/src/Makefile index 4b3c117b20..f782afc3f6 100644 --- a/lib/megaco/doc/src/Makefile +++ b/lib/megaco/doc/src/Makefile @@ -26,14 +26,6 @@ include ../../vsn.mk VSN=$(MEGACO_VSN) APPLICATION=megaco -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -73,35 +65,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi $(APP_FILE) - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - - -TOP_HTML_FILES = $(INDEX_TARGET) - -endif - INDEX_FILE = index.html INDEX_SRC = $(INDEX_FILE).src INDEX_TARGET = $(DOCDIR)/$(INDEX_FILE) @@ -131,8 +98,6 @@ $(HTMLDIR)/%.jpg: %.jpg $(HTMLDIR)/%.png: %.png $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man ldocs: local_docs $(INDEX_TARGET) @@ -147,41 +112,6 @@ clean clean_docs: clean_html clean_man rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html imgs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: imgs $(HTML_FILES) $(TOP_HTML_FILES) - -mhtml: html $(HTML_REF3_FILES) $(HTML_CHAPTER_FILES) - -clean: clean_html clean_man clean_pdf - rm -f core *~ - rm -f *.aux *.cites *.citeshd *.dvi *.idx *.ilg *.ind - rm -f *.indhd *.lof *.lofhd *.lot *.lothd *.otpdef - rm -f *.otpuse *.terms *.termshd *.toc *.makeindexlog *.dvipslog - rm -f *.bib *.bbl *.blg *.bibhd - -clean_pdf: - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f $(TEX_FILES_USERS_GUIDE) - rm -f $(TEX_FILES_REF_MAN) - rm -f $(TEX_FILES_BOOK) - -endif - clean_man: rm -f $(MAN3DIR)/* @@ -203,8 +133,6 @@ debug opt: info: @echo "->Makefile<-" @echo "" - @echo "DOCSUPPORT = $(DOCSUPPORT)" - @echo "" @echo "INDEX_FILE = $(INDEX_FILE)" @echo "INDEX_SRC = $(INDEX_SRC)" @echo "INDEX_TARGET = $(INDEX_TARGET)" @@ -216,10 +144,6 @@ info: @echo "" @echo "IMG_FILES = $(IMG_FILES)" @echo "" - @echo "TEX_FILES_USERS_GUIDE = $(TEX_FILES_USERS_GUIDE)" - @echo "TEX_FILES_REF_MAN = $(TEX_FILES_REF_MAN)" - @echo "TEX_FILES_BOOK = $(TEX_FILES_BOOK)" - @echo "" @echo "MAN3_FILES = $(MAN3_FILES)" @echo "" @echo "HTML_FILES = $(HTML_FILES)" @@ -236,8 +160,6 @@ info: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -250,33 +172,6 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/standard $(INSTALL_DATA) $(STANDARDS) $(RELSYSDIR)/doc/standard -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(IMG_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(TOP_HTML_FILES) $(RELSYSDIR)/doc - $(INSTALL_DIR) $(RELSYSDIR)/doc/standard - $(INSTALL_DATA) $(STANDARDS) $(RELSYSDIR)/doc/standard -endif -endif - -endif - release_spec: $(HTMLDIR)/megaco_architecture.html: megaco_architecture.xml diff --git a/lib/mnesia/doc/src/Makefile b/lib/mnesia/doc/src/Makefile index f45b5137a3..f2e581f9d3 100644 --- a/lib/mnesia/doc/src/Makefile +++ b/lib/mnesia/doc/src/Makefile @@ -28,14 +28,6 @@ include ../../vsn.mk VSN=$(MNESIA_VSN) APPLICATION=mnesia -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -105,31 +97,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -142,8 +113,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -158,33 +127,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -199,8 +141,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -211,30 +151,4 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif - - release_spec: - diff --git a/lib/odbc/doc/src/Makefile b/lib/odbc/doc/src/Makefile index e2f09733d0..3e648d854d 100644 --- a/lib/odbc/doc/src/Makefile +++ b/lib/odbc/doc/src/Makefile @@ -28,14 +28,6 @@ include ../../vsn.mk VSN=$(ODBC_VSN) APPLICATION=odbc -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -89,32 +81,10 @@ EXTRA_FILES = $(DEFAULT_GIF_FILES) \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -128,8 +98,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif # Copy them to ../html $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -144,32 +112,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) # We depend just to copy them to ../html @@ -182,8 +124,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -193,32 +133,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif release_spec: - - - - diff --git a/lib/orber/doc/src/Makefile b/lib/orber/doc/src/Makefile index b8e26d5ba3..8a555cb408 100644 --- a/lib/orber/doc/src/Makefile +++ b/lib/orber/doc/src/Makefile @@ -27,14 +27,6 @@ include ../../vsn.mk VSN=$(ORBER_VSN) APPLICATION=orber -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -128,32 +120,10 @@ EXTRA_FILES = summary.html.src \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -167,8 +137,6 @@ $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -184,35 +152,6 @@ clean clean_docs: rm -f errs core *~ rm -f $(JD_HTML) $(JD_PACK) -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(INTERNAL_HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTMLDIR)/* - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - rm -f $(JD_HTML) $(JD_PACK) - -endif - - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -224,9 +163,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk - -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -236,30 +172,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - -endif -endif - -endif release_spec: - diff --git a/lib/public_key/doc/src/Makefile b/lib/public_key/doc/src/Makefile index afb17399da..9616a96195 100644 --- a/lib/public_key/doc/src/Makefile +++ b/lib/public_key/doc/src/Makefile @@ -28,14 +28,6 @@ include ../../vsn.mk VSN=$(PUBLIC_KEY_VSN) APPLICATION=public_key -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -79,33 +71,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_PART_FILES:%.xml=%.tex) \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = public_key-$(VSN).pdf -TOP_PS_FILE = public_key-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -118,8 +87,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -134,33 +101,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ min_head.gif \ - $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -173,8 +113,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -184,30 +122,6 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif - release_spec: info: diff --git a/lib/snmp/doc/src/Makefile b/lib/snmp/doc/src/Makefile index aa9431477c..df597c8ba7 100644 --- a/lib/snmp/doc/src/Makefile +++ b/lib/snmp/doc/src/Makefile @@ -27,14 +27,6 @@ include ../../vsn.mk VSN = $(SNMP_VSN) APPLICATION=snmp -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -88,40 +80,10 @@ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) MAN7_FILES = $(MIB_FILES:$(MIBSDIR)/%.mib=$(MAN7DIR)/%.7) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = \ - $(XML_REF1_FILES:%.xml=%.tex) \ - $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_REF6_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_PART_FILES = $(XML_PART_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = snmp-$(VSN).pdf -TOP_PS_FILE = snmp-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - @echo "building $(TOP_PDF_FILE)" - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - @echo "building $(TOP_PS_FILE)" - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -TOP_HTML_FILES = $(INDEX_TARGET) - -endif - INDEX_FILE = index.html INDEX_SRC = $(INDEX_FILE).src INDEX_TARGET = $(DOCDIR)/$(INDEX_FILE) @@ -141,8 +103,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif # Copy them to ../html $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man ldocs: local_docs $(INDEX_TARGET) @@ -157,47 +117,6 @@ html2: html $(INDEX_TARGET) clean clean_docs: clean_html clean_man clean_pdf rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) $(TOP_HTML_FILES) gifs - -html2: gifs $(TOP_HTML_FILES) $(HTML_FILES) $(HTML_REF1_FILES) $(HTML_REF3_FILES) $(HTML_REF6_FILES) $(HTML_CHAP_FILES) - -clean: clean_tex clean_html clean_man clean_docs - - -clean_tex: - @echo "cleaning tex:" - rm -f $(TEX_FILES_USERS_GUIDE) - rm -f $(TEX_FILES_REF_MAN) - rm -f $(TEX_PART_FILES) - rm -f $(TEX_FILES_BOOK) - -clean_docs: - @echo "cleaning docs:" - rm -f $(TOP_PDF_FILE) - rm -f $(TOP_PS_FILE) - rm -f core $(LATEX_CLEAN) - - -$(HTML_PART_FILES): notes.xml - -endif - $(INDEX_TARGET): $(INDEX_SRC) ../../vsn.mk # Create top make file sed -e 's;%VSN%;$(VSN);' $< > $@ # inserting version number @@ -250,8 +169,6 @@ $(MAN1DIR)/snmpc.1: snmpc_cmd.xml include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -268,55 +185,13 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man7 $(INSTALL_DATA) $(MAN7DIR)/* $(RELEASE_PATH)/man/man7 -else - - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man1 - $(INSTALL_DATA) $(MAN1_FILES) $(RELEASE_PATH)/man/man1 - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 - $(INSTALL_DIR) $(RELEASE_PATH)/man/man6 - $(INSTALL_DATA) $(MAN6_FILES) $(RELEASE_PATH)/man/man6 - $(INSTALL_DIR) $(RELEASE_PATH)/man/man7 - $(INSTALL_DATA) $(MAN7_FILES) $(RELEASE_PATH)/man/man7 - $(INSTALL_DATA) $(TOP_HTML_FILES) \ - $(RELSYSDIR)/doc -endif -endif - -endif - release_spec: -ifdef DOCSUPPORT info: info_xml info_man info_html @echo "MAN1DIR: $(MAN1DIR)" @echo "MAN3DIR: $(MAN3DIR)" @echo "MAN6DIR: $(MAN6DIR)" @echo "MAN7DIR: $(MAN7DIR)" -else -info: info_xml info_man info_html info_tex - @echo "DVI2PS = $(DVI2PS)" - @echo "DVIPS_FLAGS = $(DVIPS_FLAGS)" - @echo "" - @echo "DISTILL = $(DISTILL)" - @echo "DISTILL_FLAGS = $(DISTILL_FLAGS)" -endif info_man: @echo "man files:" @@ -362,14 +237,3 @@ info_html: @echo "HTML_REF3_FILES = $(HTML_REF3_FILES)" @echo "HTML_REF6_FILES = $(HTML_REF6_FILES)" @echo "HTML_CHAP_FILES = $(HTML_CHAP_FILES)" - -info_tex: - @echo "tex files:" - @echo "TEX_FILES_USERS_GUIDE = $(TEX_FILES_USERS_GUIDE)" - @echo "TEX_FILES_REF_MAN = $(TEX_FILES_REF_MAN)" - @echo "TEX_PART_FILES = $(TEX_PART_FILES)" - @echo "TEX_FILES_BOOK = $(TEX_FILES_BOOK)" - -ifndef DOCSUPPORT -include depend.mk -endif diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile index c4d8d9901c..c97c99cf52 100644 --- a/lib/ssh/doc/src/Makefile +++ b/lib/ssh/doc/src/Makefile @@ -28,15 +28,6 @@ include ../../vsn.mk VSN=$(SSH_VSN) APPLICATION=ssh -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -76,33 +67,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf -TOP_PS_FILE = $(APPLICATION)-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -115,8 +83,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -131,32 +97,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ *xmls_output *xmls_errs $(LATEX_CLEAN) - -endif - man: $(MAN3_FILES) @@ -168,8 +108,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -179,28 +117,5 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif release_spec: diff --git a/lib/syntax_tools/doc/Makefile b/lib/syntax_tools/doc/Makefile index 6afd16f669..d9981de880 100644 --- a/lib/syntax_tools/doc/Makefile +++ b/lib/syntax_tools/doc/Makefile @@ -78,12 +78,3 @@ release_docs_spec: docs release_spec: - - - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- -#-include make.dep - - diff --git a/lib/test_server/doc/src/Makefile b/lib/test_server/doc/src/Makefile index c7ba415e5b..f0be284324 100644 --- a/lib/test_server/doc/src/Makefile +++ b/lib/test_server/doc/src/Makefile @@ -133,9 +133,3 @@ release_docs_spec: docs release_spec: release_tests_spec: - -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -include make.dep diff --git a/lib/tv/doc/src/Makefile b/lib/tv/doc/src/Makefile index f30e0307a9..5a41b28d48 100644 --- a/lib/tv/doc/src/Makefile +++ b/lib/tv/doc/src/Makefile @@ -25,14 +25,6 @@ include ../../vsn.mk VSN=$(TV_VSN) APPLICATION=tv -# ---------------------------------------------------- -# Include dependency -# ---------------------------------------------------- - -ifndef DOCSUPPORT -include make.dep -endif - # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -89,32 +81,10 @@ EXTRA_FILES = \ MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -ifdef DOCSUPPORT - HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf -else - -TEX_FILES_BOOK = \ - $(BOOK_FILES:%.xml=%.tex) -TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ - $(XML_APPLICATION_FILES:%.xml=%.tex) -TEX_FILES_USERS_GUIDE = \ - $(XML_CHAPTER_FILES:%.xml=%.tex) - -TOP_PDF_FILE = tv-$(VSN).pdf -TOP_PS_FILE = tv-$(VSN).ps - -$(TOP_PDF_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ - -$(TOP_PS_FILE): book.dvi ../../vsn.mk - $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ - -endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -127,8 +97,6 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -ifdef DOCSUPPORT - docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) @@ -144,31 +112,6 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -else - -ifeq ($(DOCTYPE),pdf) -docs: pdf -else -ifeq ($(DOCTYPE),ps) -docs: ps -else -docs: html gifs man -endif -endif - -pdf: $(TOP_PDF_FILE) - -ps: $(TOP_PS_FILE) - -html: $(HTML_FILES) gifs - -clean clean_docs clean_tex: - rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) - rm -f $(HTML_FILES) $(MAN3_FILES) - rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) - rm -f errs core *~ $(LATEX_CLEAN) -endif - man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) @@ -181,8 +124,6 @@ debug opt: # ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk -ifdef DOCSUPPORT - release_docs_spec: docs $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf @@ -193,29 +134,5 @@ release_docs_spec: docs $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -else - -ifeq ($(DOCTYPE),pdf) -release_docs_spec: pdf - $(INSTALL_DIR) $(RELEASE_PATH)/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf -else -ifeq ($(DOCTYPE),ps) -release_docs_spec: ps - $(INSTALL_DIR) $(RELEASE_PATH)/ps - $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps -else -release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 -endif -endif - -endif - release_spec: diff --git a/make/otp.mk.in b/make/otp.mk.in index 4dd309b6ec..b138dd7d8e 100644 --- a/make/otp.mk.in +++ b/make/otp.mk.in @@ -190,8 +190,6 @@ EMACS_COMPILE_OPTIONS=-q --no-site-file -batch -f batch-byte-compile # ---------------------------------------------------- export VSN -DOCSUPPORT = 1 - TOPDOCDIR=../../../../doc DOCDIR = .. -- cgit v1.2.3 From c8053ef7b602e8c47b6fa8919b9bbff996d3a81b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 20 Oct 2011 14:17:52 +0200 Subject: Remove unused */doc/src/make.dep files These dependency files was once used when building the documentation, but are no longer needed. --- erts/doc/src/make.dep | 32 ----------- lib/appmon/doc/src/make.dep | 26 --------- lib/asn1/doc/src/make.dep | 31 ---------- lib/common_test/doc/src/make.dep | 27 --------- lib/compiler/doc/src/make.dep | 19 ------ lib/cosEvent/doc/src/make.dep | 34 ----------- lib/cosEventDomain/doc/src/make.dep | 23 -------- lib/cosFileTransfer/doc/src/make.dep | 30 ---------- lib/cosNotification/doc/src/make.dep | 48 ---------------- lib/cosProperty/doc/src/make.dep | 26 --------- lib/cosTime/doc/src/make.dep | 22 ------- lib/cosTransactions/doc/src/make.dep | 27 --------- lib/crypto/doc/src/make.dep | 20 ------- lib/debugger/doc/src/make.dep | 29 ---------- lib/dialyzer/doc/src/make.dep | 20 ------- lib/edoc/doc/src/make.dep | 21 ------- lib/erl_interface/doc/src/make.dep | 24 -------- lib/eunit/doc/src/make.dep | 19 ------ lib/gs/doc/src/make.dep | 58 ------------------- lib/hipe/doc/src/make.dep | 13 ----- lib/ic/doc/src/make.dep | 24 -------- lib/inets/doc/src/make.dep | 47 --------------- lib/inviso/doc/src/make.dep | 27 --------- lib/jinterface/doc/src/make.dep | 20 ------- lib/kernel/doc/src/make.dep | 28 --------- lib/megaco/doc/src/make.dep | 59 ------------------- lib/mnesia/doc/src/make.dep | 46 --------------- lib/observer/doc/src/make.dep | 29 ---------- lib/odbc/doc/src/make.dep | 27 --------- lib/orber/doc/src/make.dep | 62 -------------------- lib/os_mon/doc/src/make.dep | 21 ------- lib/otp_mibs/doc/src/make.dep | 20 ------- lib/parsetools/doc/src/make.dep | 21 ------- lib/percept/doc/src/make.dep | 34 ----------- lib/pman/doc/src/make.dep | 26 --------- lib/public_key/doc/src/make.dep | 21 ------- lib/reltool/doc/src/make.dep | 20 ------- lib/runtime_tools/doc/src/make.dep | 20 ------- lib/sasl/doc/src/make.dep | 22 ------- lib/snmp/doc/src/depend.mk | 83 --------------------------- lib/snmp/doc/src/make.dep | 77 ------------------------- lib/ssh/doc/src/make.dep | 19 ------ lib/stdlib/doc/src/make.dep | 40 ------------- lib/syntax_tools/doc/src/make.dep | 22 ------- lib/test_server/doc/src/make.dep | 24 -------- lib/toolbar/doc/src/make.dep | 26 --------- lib/tools/doc/src/make.dep | 33 ----------- lib/tv/doc/src/make.dep | 32 ----------- lib/webtool/doc/src/make.dep | 20 ------- lib/wx/doc/src/make.dep | 13 ----- lib/xmerl/doc/src/make.dep | 24 -------- system/doc/design_principles/make.dep | 31 ---------- system/doc/efficiency_guide/make.dep | 16 ------ system/doc/embedded/make.dep | 14 ----- system/doc/getting_started/make.dep | 14 ----- system/doc/installation_guide/make.dep | 13 ----- system/doc/oam/make.dep | 26 --------- system/doc/programming_examples/make.dep | 20 ------- system/doc/reference_manual/make.dep | 16 ------ system/doc/system_architecture_intro/make.dep | 13 ----- system/doc/system_principles/make.dep | 14 ----- system/doc/tutorial/make.dep | 35 ----------- 62 files changed, 1748 deletions(-) delete mode 100644 erts/doc/src/make.dep delete mode 100644 lib/appmon/doc/src/make.dep delete mode 100644 lib/asn1/doc/src/make.dep delete mode 100644 lib/common_test/doc/src/make.dep delete mode 100644 lib/compiler/doc/src/make.dep delete mode 100644 lib/cosEvent/doc/src/make.dep delete mode 100644 lib/cosEventDomain/doc/src/make.dep delete mode 100644 lib/cosFileTransfer/doc/src/make.dep delete mode 100644 lib/cosNotification/doc/src/make.dep delete mode 100644 lib/cosProperty/doc/src/make.dep delete mode 100644 lib/cosTime/doc/src/make.dep delete mode 100644 lib/cosTransactions/doc/src/make.dep delete mode 100644 lib/crypto/doc/src/make.dep delete mode 100644 lib/debugger/doc/src/make.dep delete mode 100755 lib/dialyzer/doc/src/make.dep delete mode 100644 lib/edoc/doc/src/make.dep delete mode 100644 lib/erl_interface/doc/src/make.dep delete mode 100644 lib/eunit/doc/src/make.dep delete mode 100644 lib/gs/doc/src/make.dep delete mode 100644 lib/hipe/doc/src/make.dep delete mode 100644 lib/ic/doc/src/make.dep delete mode 100644 lib/inets/doc/src/make.dep delete mode 100644 lib/inviso/doc/src/make.dep delete mode 100644 lib/jinterface/doc/src/make.dep delete mode 100644 lib/kernel/doc/src/make.dep delete mode 100644 lib/megaco/doc/src/make.dep delete mode 100644 lib/mnesia/doc/src/make.dep delete mode 100644 lib/observer/doc/src/make.dep delete mode 100644 lib/odbc/doc/src/make.dep delete mode 100644 lib/orber/doc/src/make.dep delete mode 100644 lib/os_mon/doc/src/make.dep delete mode 100644 lib/otp_mibs/doc/src/make.dep delete mode 100644 lib/parsetools/doc/src/make.dep delete mode 100644 lib/percept/doc/src/make.dep delete mode 100644 lib/pman/doc/src/make.dep delete mode 100644 lib/public_key/doc/src/make.dep delete mode 100644 lib/reltool/doc/src/make.dep delete mode 100644 lib/runtime_tools/doc/src/make.dep delete mode 100644 lib/sasl/doc/src/make.dep delete mode 100644 lib/snmp/doc/src/depend.mk delete mode 100644 lib/snmp/doc/src/make.dep delete mode 100644 lib/ssh/doc/src/make.dep delete mode 100644 lib/stdlib/doc/src/make.dep delete mode 100644 lib/syntax_tools/doc/src/make.dep delete mode 100644 lib/test_server/doc/src/make.dep delete mode 100644 lib/toolbar/doc/src/make.dep delete mode 100644 lib/tools/doc/src/make.dep delete mode 100644 lib/tv/doc/src/make.dep delete mode 100644 lib/webtool/doc/src/make.dep delete mode 100644 lib/wx/doc/src/make.dep delete mode 100644 lib/xmerl/doc/src/make.dep delete mode 100644 system/doc/design_principles/make.dep delete mode 100644 system/doc/efficiency_guide/make.dep delete mode 100644 system/doc/embedded/make.dep delete mode 100644 system/doc/getting_started/make.dep delete mode 100644 system/doc/installation_guide/make.dep delete mode 100644 system/doc/oam/make.dep delete mode 100644 system/doc/programming_examples/make.dep delete mode 100644 system/doc/reference_manual/make.dep delete mode 100644 system/doc/system_architecture_intro/make.dep delete mode 100644 system/doc/system_principles/make.dep delete mode 100644 system/doc/tutorial/make.dep diff --git a/erts/doc/src/make.dep b/erts/doc/src/make.dep deleted file mode 100644 index 98bac78235..0000000000 --- a/erts/doc/src/make.dep +++ /dev/null @@ -1,32 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/gandalf/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: absform.tex alt_dist.tex book.tex crash_dump.tex \ - driver.tex driver_entry.tex epmd.tex erl.tex \ - erl_dist_protocol.tex erl_driver.tex erl_ext_dist.tex \ - erl_prim_loader.tex erl_set_memory_block.tex \ - erlang.tex erlc.tex erlsrv.tex erts_alloc.tex \ - escript.tex inet_cfg.tex init.tex match_spec.tex \ - part.tex ref_man.tex run_erl.tex start.tex \ - start_erl.tex tty.tex werl.tex zlib.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: erl_ext_fig.ps - diff --git a/lib/appmon/doc/src/make.dep b/lib/appmon/doc/src/make.dep deleted file mode 100644 index ce0d7571a3..0000000000 --- a/lib/appmon/doc/src/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: appmon.tex appmon_chapter.tex book.tex part.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: app_win.ps listbox_win.ps main_win.ps pinfo_win.ps - diff --git a/lib/asn1/doc/src/make.dep b/lib/asn1/doc/src/make.dep deleted file mode 100644 index eb2c0e9a98..0000000000 --- a/lib/asn1/doc/src/make.dep +++ /dev/null @@ -1,31 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/gandalf/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: asn1_spec.tex asn1_ug.tex asn1ct.tex asn1rt.tex \ - book.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -asn1_spec.tex: Seq.asn Seq.asn1config - -book.tex: part.xml ref_man.xml - -asn1_ug.tex: ../../../../system/doc/definitions/cite.defs - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: exclusive_Win_But.ps selective_TypeList.ps \ - selective_Window2.ps - diff --git a/lib/common_test/doc/src/make.dep b/lib/common_test/doc/src/make.dep deleted file mode 100644 index e34075888d..0000000000 --- a/lib/common_test/doc/src/make.dep +++ /dev/null @@ -1,27 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: basics_chapter.tex book.tex common_test_app.tex \ - config_file_chapter.tex cover_chapter.tex \ - ct.tex ct_cover.tex ct_ftp.tex ct_master.tex \ - ct_master_chapter.tex ct_rpc.tex ct_snmp.tex \ - ct_ssh.tex ct_telnet.tex dependencies_chapter.tex \ - event_handler_chapter.tex example_chapter.tex \ - install_chapter.tex part.tex ref_man.tex run_test.tex \ - run_test_chapter.tex test_structure_chapter.tex \ - unix_telnet.tex why_test_chapter.tex write_test_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/compiler/doc/src/make.dep b/lib/compiler/doc/src/make.dep deleted file mode 100644 index f5c097afad..0000000000 --- a/lib/compiler/doc/src/make.dep +++ /dev/null @@ -1,19 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex compile.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/cosEvent/doc/src/make.dep b/lib/cosEvent/doc/src/make.dep deleted file mode 100644 index b8a95c2d58..0000000000 --- a/lib/cosEvent/doc/src/make.dep +++ /dev/null @@ -1,34 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosEventChannelAdmin.tex CosEventChannelAdmin_ConsumerAdmin.tex \ - CosEventChannelAdmin_EventChannel.tex CosEventChannelAdmin_ProxyPullConsumer.tex \ - CosEventChannelAdmin_ProxyPullSupplier.tex \ - CosEventChannelAdmin_ProxyPushConsumer.tex \ - CosEventChannelAdmin_ProxyPushSupplier.tex \ - CosEventChannelAdmin_SupplierAdmin.tex book.tex \ - ch_contents.tex ch_event_service.tex ch_introduction.tex \ - cosEventApp.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -CosEventChannelAdmin.tex: ../../src/CosEventChannelAdmin.idl - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: e_s_components.ps e_s_models.ps - diff --git a/lib/cosEventDomain/doc/src/make.dep b/lib/cosEventDomain/doc/src/make.dep deleted file mode 100644 index 2f3f1ae53d..0000000000 --- a/lib/cosEventDomain/doc/src/make.dep +++ /dev/null @@ -1,23 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosEventDomainAdmin.tex CosEventDomainAdmin_EventDomain.tex \ - CosEventDomainAdmin_EventDomainFactory.tex \ - book.tex ch_QoS.tex ch_contents.tex ch_event_domain_service.tex \ - ch_introduction.tex cosEventDomainApp.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/cosFileTransfer/doc/src/make.dep b/lib/cosFileTransfer/doc/src/make.dep deleted file mode 100644 index 3be0c185c3..0000000000 --- a/lib/cosFileTransfer/doc/src/make.dep +++ /dev/null @@ -1,30 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosFileTransfer_Directory.tex CosFileTransfer_File.tex \ - CosFileTransfer_FileIterator.tex CosFileTransfer_FileTransferSession.tex \ - CosFileTransfer_VirtualFileSystem.tex book.tex \ - ch_contents.tex ch_example.tex ch_install.tex \ - ch_introduction.tex ch_system.tex cosFileTransferApp.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosFileTransfer.ps - diff --git a/lib/cosNotification/doc/src/make.dep b/lib/cosNotification/doc/src/make.dep deleted file mode 100644 index 031a2b3e98..0000000000 --- a/lib/cosNotification/doc/src/make.dep +++ /dev/null @@ -1,48 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosNotification.tex CosNotification_AdminPropertiesAdmin.tex \ - CosNotification_QoSAdmin.tex CosNotifyChannelAdmin_ConsumerAdmin.tex \ - CosNotifyChannelAdmin_EventChannel.tex CosNotifyChannelAdmin_EventChannelFactory.tex \ - CosNotifyChannelAdmin_ProxyConsumer.tex CosNotifyChannelAdmin_ProxyPullConsumer.tex \ - CosNotifyChannelAdmin_ProxyPullSupplier.tex \ - CosNotifyChannelAdmin_ProxyPushConsumer.tex \ - CosNotifyChannelAdmin_ProxyPushSupplier.tex \ - CosNotifyChannelAdmin_ProxySupplier.tex CosNotifyChannelAdmin_SequenceProxyPullConsumer.tex \ - CosNotifyChannelAdmin_SequenceProxyPullSupplier.tex \ - CosNotifyChannelAdmin_SequenceProxyPushConsumer.tex \ - CosNotifyChannelAdmin_SequenceProxyPushSupplier.tex \ - CosNotifyChannelAdmin_StructuredProxyPullConsumer.tex \ - CosNotifyChannelAdmin_StructuredProxyPullSupplier.tex \ - CosNotifyChannelAdmin_StructuredProxyPushConsumer.tex \ - CosNotifyChannelAdmin_StructuredProxyPushSupplier.tex \ - CosNotifyChannelAdmin_SupplierAdmin.tex CosNotifyComm_NotifyPublish.tex \ - CosNotifyComm_NotifySubscribe.tex CosNotifyFilter_Filter.tex \ - CosNotifyFilter_FilterAdmin.tex CosNotifyFilter_FilterFactory.tex \ - CosNotifyFilter_MappingFilter.tex book.tex \ - ch_BNF.tex ch_QoS.tex ch_contents.tex ch_example.tex \ - ch_install.tex ch_introduction.tex ch_system.tex \ - cosNotificationApp.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: eventstructure.ps - -book.dvi: notificationFlow.ps - diff --git a/lib/cosProperty/doc/src/make.dep b/lib/cosProperty/doc/src/make.dep deleted file mode 100644 index 383af54244..0000000000 --- a/lib/cosProperty/doc/src/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosPropertyService_PropertiesIterator.tex \ - CosPropertyService_PropertyNamesIterator.tex \ - CosPropertyService_PropertySet.tex CosPropertyService_PropertySetDef.tex \ - CosPropertyService_PropertySetDefFactory.tex \ - CosPropertyService_PropertySetFactory.tex \ - book.tex ch_contents.tex ch_example.tex ch_install.tex \ - ch_introduction.tex cosProperty.tex part.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/cosTime/doc/src/make.dep b/lib/cosTime/doc/src/make.dep deleted file mode 100644 index 69a584ab95..0000000000 --- a/lib/cosTime/doc/src/make.dep +++ /dev/null @@ -1,22 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosTime_TIO.tex CosTime_TimeService.tex CosTime_UTO.tex \ - CosTimerEvent_TimerEventHandler.tex CosTimerEvent_TimerEventService.tex \ - book.tex ch_contents.tex ch_example.tex ch_install.tex \ - ch_introduction.tex cosTime.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/cosTransactions/doc/src/make.dep b/lib/cosTransactions/doc/src/make.dep deleted file mode 100644 index bd45aea286..0000000000 --- a/lib/cosTransactions/doc/src/make.dep +++ /dev/null @@ -1,27 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosTransactions_Control.tex CosTransactions_Coordinator.tex \ - CosTransactions_RecoveryCoordinator.tex CosTransactions_Resource.tex \ - CosTransactions_SubtransactionAwareResource.tex \ - CosTransactions_Terminator.tex CosTransactions_TransactionFactory.tex \ - book.tex ch_contents.tex ch_example.tex ch_install.tex \ - ch_introduction.tex ch_skeletons.tex cosTransactions.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -ch_example.tex: ../../../../system/doc/definitions/term.defs - diff --git a/lib/crypto/doc/src/make.dep b/lib/crypto/doc/src/make.dep deleted file mode 100644 index 73b090bbb6..0000000000 --- a/lib/crypto/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex crypto.tex crypto_app.tex licenses.tex \ - ref_man.tex usersguide.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/debugger/doc/src/make.dep b/lib/debugger/doc/src/make.dep deleted file mode 100644 index c11fd3c21c..0000000000 --- a/lib/debugger/doc/src/make.dep +++ /dev/null @@ -1,29 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex debugger.tex debugger_chapter.tex \ - i.tex int.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: part.xml ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: images/attach.ps images/cond_break_dialog.ps \ - images/function_break_dialog.ps images/interpret.ps \ - images/line_break_dialog.ps images/monitor.ps \ - images/view.ps - diff --git a/lib/dialyzer/doc/src/make.dep b/lib/dialyzer/doc/src/make.dep deleted file mode 100755 index f8177cd419..0000000000 --- a/lib/dialyzer/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex dialyzer.tex dialyzer_chapter.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/edoc/doc/src/make.dep b/lib/edoc/doc/src/make.dep deleted file mode 100644 index b46e36314f..0000000000 --- a/lib/edoc/doc/src/make.dep +++ /dev/null @@ -1,21 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex chapter.tex edoc.tex edoc_doclet.tex \ - edoc_extract.tex edoc_layout.tex edoc_lib.tex \ - edoc_run.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/erl_interface/doc/src/make.dep b/lib/erl_interface/doc/src/make.dep deleted file mode 100644 index 3f43cf64fe..0000000000 --- a/lib/erl_interface/doc/src/make.dep +++ /dev/null @@ -1,24 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin//docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex ei.tex ei_connect.tex ei_users_guide.tex \ - erl_call.tex erl_connect.tex erl_error.tex \ - erl_eterm.tex erl_format.tex erl_global.tex \ - erl_malloc.tex erl_marshal.tex part_ei.tex \ - ref_man.tex ref_man_ei.tex ref_man_erl_interface.tex \ - registry.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml ref_man_ei.xml ref_man_erl_interface.xml - diff --git a/lib/eunit/doc/src/make.dep b/lib/eunit/doc/src/make.dep deleted file mode 100644 index d68f888403..0000000000 --- a/lib/eunit/doc/src/make.dep +++ /dev/null @@ -1,19 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex chapter.tex eunit.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/gs/doc/src/make.dep b/lib/gs/doc/src/make.dep deleted file mode 100644 index b33ed3b2de..0000000000 --- a/lib/gs/doc/src/make.dep +++ /dev/null @@ -1,58 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex gs.tex gs_chapter1.tex gs_chapter2.tex \ - gs_chapter3.tex gs_chapter4.tex gs_chapter5.tex \ - gs_chapter6.tex gs_chapter7.tex gs_chapter8.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -gs_chapter2.tex: examples/ex1.erl examples/ex2.erl - -gs_chapter4.tex: examples/ex3.erl examples/ex4.erl examples/ex5.erl \ - examples/ex6.erl - -gs_chapter5.tex: examples/ex15.erl - -gs_chapter6.tex: examples/ex16.erl - -gs_chapter7.tex: examples/ex17.erl - -gs_chapter8.tex: examples/ex10.erl examples/ex11.erl examples/ex12.erl \ - examples/ex13.erl examples/ex14.erl examples/ex7.erl \ - examples/ex8.erl examples/ex9.erl - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: pics/gs1-1-image-1.ps pics/gs1-1-image-2.ps \ - pics/gs1-1-image-3.ps - -book.dvi: pics/ex1.ps pics/gs1-1-image-4.ps - -book.dvi: pics/ex15.ps - -book.dvi: pics/ex16.ps - -book.dvi: pics/packer1.ps pics/packer2.ps - -book.dvi: pics/arc.ps pics/buttons.ps pics/ex10.ps pics/ex11.ps \ - pics/ex12.ps pics/ex13.ps pics/ex14.ps pics/ex8.ps \ - pics/ex9.ps pics/image.ps pics/line.ps pics/oval.ps \ - pics/polygon.ps pics/rectangle.ps pics/text.ps \ - pics/window.ps - diff --git a/lib/hipe/doc/src/make.dep b/lib/hipe/doc/src/make.dep deleted file mode 100644 index d5f5844c21..0000000000 --- a/lib/hipe/doc/src/make.dep +++ /dev/null @@ -1,13 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex - diff --git a/lib/ic/doc/src/make.dep b/lib/ic/doc/src/make.dep deleted file mode 100644 index 64694ee85a..0000000000 --- a/lib/ic/doc/src/make.dep +++ /dev/null @@ -1,24 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex c-part.tex ch_basic_idl.tex ch_c_client.tex \ - ch_c_corba_env.tex ch_c_mapping.tex ch_c_server.tex \ - ch_erl_genserv.tex ch_erl_plain.tex ch_ic_protocol.tex \ - ch_introduction.tex ch_java.tex erl-part.tex \ - ic.tex ic_c_protocol.tex ic_clib.tex java-part.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/inets/doc/src/make.dep b/lib/inets/doc/src/make.dep deleted file mode 100644 index 8deb7e7a5a..0000000000 --- a/lib/inets/doc/src/make.dep +++ /dev/null @@ -1,47 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2010. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# 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% -# -# - -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex ftp.tex ftp_client.tex httpc.tex http_client.tex \ - http_server.tex httpd.tex httpd_conf.tex httpd_socket.tex \ - httpd_util.tex inets.tex inets_services.tex \ - mod_alias.tex mod_auth.tex mod_esi.tex mod_security.tex \ - part.tex ref_man.tex tftp.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -ftp.tex: ../../../../system/doc/definitions/term.defs - -inets_services.tex: ../../../../system/doc/definitions/term.defs - diff --git a/lib/inviso/doc/src/make.dep b/lib/inviso/doc/src/make.dep deleted file mode 100644 index 9459f74e6d..0000000000 --- a/lib/inviso/doc/src/make.dep +++ /dev/null @@ -1,27 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex inviso.tex inviso_as_lib.tex inviso_chapter.tex \ - inviso_lfm.tex inviso_lfm_tpfreader.tex inviso_rt.tex \ - inviso_rt_meta.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: inviso_users_guide_pic1.ps - diff --git a/lib/jinterface/doc/src/make.dep b/lib/jinterface/doc/src/make.dep deleted file mode 100644 index a1b3c322c6..0000000000 --- a/lib/jinterface/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex jinterface.tex jinterface_users_guide.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/kernel/doc/src/make.dep b/lib/kernel/doc/src/make.dep deleted file mode 100644 index f79d1c6367..0000000000 --- a/lib/kernel/doc/src/make.dep +++ /dev/null @@ -1,28 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: app.tex application.tex auth.tex book.tex \ - code.tex config.tex disk_log.tex erl_boot_server.tex \ - erl_ddll.tex erl_prim_loader_stub.tex erlang_stub.tex \ - error_handler.tex error_logger.tex file.tex \ - gen_sctp.tex gen_tcp.tex gen_udp.tex global.tex \ - global_group.tex heart.tex inet.tex inet_res.tex \ - init_stub.tex kernel_app.tex net_adm.tex net_kernel.tex \ - os.tex packages.tex pg2.tex ref_man.tex rpc.tex \ - seq_trace.tex user.tex wrap_log_reader.tex \ - zlib_stub.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/megaco/doc/src/make.dep b/lib/megaco/doc/src/make.dep deleted file mode 100644 index 0e2040ab50..0000000000 --- a/lib/megaco/doc/src/make.dep +++ /dev/null @@ -1,59 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2001-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% - -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex megaco.tex megaco_architecture.tex \ - megaco_codec_meas.tex \ - megaco_codec_mstone1.tex megaco_codec_mstone2.tex \ - megaco_codec_transform.tex \ - megaco_debug.tex megaco_edist_compress.tex \ - megaco_encode.tex megaco_encoder.tex megaco_examples.tex \ - megaco_flex_scanner.tex megaco_intro.tex megaco_mib.tex \ - megaco_performance.tex megaco_run.tex megaco_tcp.tex \ - megaco_transport.tex megaco_transport_mechanisms.tex \ - megaco_udp.tex megaco_user.tex part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: call_flow.ps call_flow_cont.ps distr_node_config.ps \ - megaco_sys_arch.ps single_node_config.ps - -book.dvi: mstone1.ps - -book.dvi: MG-startup_flow_noMID.ps MGC_startup_call_flow.ps \ - MG_startup_call_flow.ps - diff --git a/lib/mnesia/doc/src/make.dep b/lib/mnesia/doc/src/make.dep deleted file mode 100644 index 6e79484cb3..0000000000 --- a/lib/mnesia/doc/src/make.dep +++ /dev/null @@ -1,46 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: Mnesia_App_A.tex Mnesia_App_B.tex Mnesia_App_C.tex \ - Mnesia_App_D.tex Mnesia_chap1.tex Mnesia_chap2.tex \ - Mnesia_chap3.tex Mnesia_chap4.tex Mnesia_chap5.tex \ - Mnesia_chap7.tex Mnesia_chap8.tex book.tex \ - mnesia.tex mnesia_frag_hash.tex mnesia_registry.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -Mnesia_App_B.tex: ../../src/mnesia_backup.erl - -Mnesia_App_C.tex: ../../src/mnesia_frag.erl - -Mnesia_App_D.tex: ../../src/mnesia_frag_hash.erl - -Mnesia_chap2.tex: company.erl company.hrl - -Mnesia_chap3.tex: company.erl - -Mnesia_chap4.tex: company.erl - -Mnesia_chap5.tex: FRUITS company.erl company_o.erl company_o.hrl - -Mnesia_chap7.tex: bup.erl - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: company.ps - diff --git a/lib/observer/doc/src/make.dep b/lib/observer/doc/src/make.dep deleted file mode 100644 index 3c1b3df771..0000000000 --- a/lib/observer/doc/src/make.dep +++ /dev/null @@ -1,29 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex crashdump.tex crashdump_ug.tex etop.tex \ - etop_ug.tex observer_app.tex part.tex ref_man.tex \ - ttb.tex ttb_ug.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: etop_5.ps etop_lines.ps etop_main.ps etop_opt.ps - -book.dvi: et_modsprocs.ps et_processes.ps - diff --git a/lib/odbc/doc/src/make.dep b/lib/odbc/doc/src/make.dep deleted file mode 100644 index d62e8dd8f0..0000000000 --- a/lib/odbc/doc/src/make.dep +++ /dev/null @@ -1,27 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex databases.tex error_handling.tex \ - getting_started.tex introduction.tex odbc.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: odbc_app_arc.ps - diff --git a/lib/orber/doc/src/make.dep b/lib/orber/doc/src/make.dep deleted file mode 100644 index cf5aad747d..0000000000 --- a/lib/orber/doc/src/make.dep +++ /dev/null @@ -1,62 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: CosNaming.tex CosNaming_BindingIterator.tex \ - CosNaming_NamingContext.tex CosNaming_NamingContextExt.tex \ - Module_Interface.tex any.tex book.tex ch_contents.tex \ - ch_debugging.tex ch_exceptions.tex \ - ch_idl_to_erlang_mapping.tex ch_ifr.tex ch_install.tex \ - ch_interceptors.tex ch_introduction.tex ch_naming_service.tex \ - ch_orber_kernel.tex ch_orberweb.tex ch_security.tex \ - ch_stubs.tex corba.tex corba_object.tex example_part.tex \ - fixed.tex interceptors.tex intro_part.tex \ - lname.tex lname_component.tex orber.tex orber_acl.tex \ - orber_diagnostics.tex orber_ifr.tex orber_tc.tex \ - ref_man.tex tools_debugging_part.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -ch_contents.tex: ../../../../system/doc/definitions/term.defs - -ch_idl_to_erlang_mapping.tex: ../../../../system/doc/definitions/term.defs - -ch_install.tex: ../../../../system/doc/definitions/term.defs - -ch_introduction.tex: ../../../../system/doc/definitions/term.defs - -ch_naming_service.tex: ../../../../system/doc/definitions/term.defs - -ch_orber_kernel.tex: ../../../../system/doc/definitions/term.defs - -orber_ifr.tex: ../../../../system/doc/definitions/term.defs - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: firewall_nat.ps - -book.dvi: interceptor_operations.ps - -book.dvi: dependent.ps orbs.ps - -book.dvi: name.ps - -book.dvi: iiop.ps theORB.ps - -book.dvi: dataframe1.ps dataframe2.ps dataframe3.ps \ - dataframe4.ps dataframe5.ps dataframe6.ps \ - dataframe7.ps dataframe8.ps menuframe.ps - diff --git a/lib/os_mon/doc/src/make.dep b/lib/os_mon/doc/src/make.dep deleted file mode 100644 index b657f2e036..0000000000 --- a/lib/os_mon/doc/src/make.dep +++ /dev/null @@ -1,21 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex cpu_sup.tex disksup.tex memsup.tex \ - nteventlog.tex os_mon.tex os_mon_mib.tex os_sup.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/otp_mibs/doc/src/make.dep b/lib/otp_mibs/doc/src/make.dep deleted file mode 100644 index 2885155315..0000000000 --- a/lib/otp_mibs/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex introduction.tex mibs.tex otp_mib.tex \ - part.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/parsetools/doc/src/make.dep b/lib/parsetools/doc/src/make.dep deleted file mode 100644 index 3a09ecdedd..0000000000 --- a/lib/parsetools/doc/src/make.dep +++ /dev/null @@ -1,21 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex leex.tex ref_man.tex yecc.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -ref_man.tex: ../../../../system/doc/definitions/term.defs - diff --git a/lib/percept/doc/src/make.dep b/lib/percept/doc/src/make.dep deleted file mode 100644 index df16cffd4f..0000000000 --- a/lib/percept/doc/src/make.dep +++ /dev/null @@ -1,34 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex egd.tex egd_ug.tex part.tex percept.tex \ - percept_profile.tex percept_ug.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -egd_ug.tex: img.erl img_esi.erl - -percept_ug.tex: sorter.erl - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: img_esi_result.ps test1.ps test2.ps test3.ps \ - test4.ps - -book.dvi: percept_compare.ps percept_overview.ps percept_processes.ps \ - percept_processinfo.ps - diff --git a/lib/pman/doc/src/make.dep b/lib/pman/doc/src/make.dep deleted file mode 100644 index 2f6a8a06cd..0000000000 --- a/lib/pman/doc/src/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex pman.tex pman_chapter.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: main_window.ps options.ps trace.ps - diff --git a/lib/public_key/doc/src/make.dep b/lib/public_key/doc/src/make.dep deleted file mode 100644 index 2675556f1b..0000000000 --- a/lib/public_key/doc/src/make.dep +++ /dev/null @@ -1,21 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex cert_records.tex introduction.tex \ - part.tex public_key.tex public_key_records.tex \ - ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/reltool/doc/src/make.dep b/lib/reltool/doc/src/make.dep deleted file mode 100644 index 59e77e8162..0000000000 --- a/lib/reltool/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex reltool.tex \ - reltool_examples.tex reltool_intro.tex reltool_usage.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/runtime_tools/doc/src/make.dep b/lib/runtime_tools/doc/src/make.dep deleted file mode 100644 index 85eae88adf..0000000000 --- a/lib/runtime_tools/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex dbg.tex erts_alloc_config.tex refman.tex \ - runtime_tools_app.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: refman.xml - diff --git a/lib/sasl/doc/src/make.dep b/lib/sasl/doc/src/make.dep deleted file mode 100644 index 4843b7934a..0000000000 --- a/lib/sasl/doc/src/make.dep +++ /dev/null @@ -1,22 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: alarm_handler.tex appup.tex book.tex error_logging.tex \ - overload.tex part.tex rb.tex ref_man.tex rel.tex \ - release_handler.tex relup.tex sasl_app.tex \ - sasl_intro.tex script.tex systools.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/snmp/doc/src/depend.mk b/lib/snmp/doc/src/depend.mk deleted file mode 100644 index 20a523dd8c..0000000000 --- a/lib/snmp/doc/src/depend.mk +++ /dev/null @@ -1,83 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2004-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% - -$(HTMLDIR)/part_notes.html: \ - part_notes_history.xml \ - part_notes.xml \ - notes_history.xml \ - notes.xml - -$(HTMLDIR)/part.html: \ - part.xml \ - snmp_intro.xml \ - snmp_agent_funct_descr.xml \ - snmp_manager_funct_descr.xml \ - snmp_mib_compiler.xml \ - snmp_config.xml \ - snmp_agent_config_files.xml \ - snmp_manager_config_files.xml \ - snmp_impl_example_agent.xml \ - snmp_impl_example_manager.xml \ - snmp_instr_functions.xml \ - snmp_def_instr_functions.xml \ - snmp_agent_netif.xml \ - snmp_manager_netif.xml \ - snmp_audit_trail_log.xml \ - snmp_advanced_agent.xml \ - snmp_app_a.xml \ - snmp_app_b.xml - -$(HTMLDIR)/ref_man.html: \ - ref_man.xml \ - snmp_app.xml \ - snmp.xml \ - snmpc.xml \ - snmpc_cmd.xml \ - snmpa.xml \ - snmpa_conf.xml \ - snmpa_discovery_handler.xml \ - snmpa_error_report.xml \ - snmpa_error.xml \ - snmpa_error_io.xml \ - snmpa_error_logger.xml \ - snmpa_local_db.xml \ - snmpa_mpd.xml \ - snmpa_network_interface.xml \ - snmpa_network_interface_filter.xml \ - snmpa_notification_delivery_info_receiver.xml \ - snmpa_notification_filter.xml \ - snmpa_supervisor.xml \ - snmp_community_mib.xml \ - snmp_framework_mib.xml \ - snmp_generic.xml \ - snmp_index.xml \ - snmp_notification_mib.xml \ - snmp_pdus.xml \ - snmp_standard_mib.xml \ - snmp_target_mib.xml \ - snmp_user_based_sm_mib.xml \ - snmp_view_based_acm_mib.xml \ - snmpm.xml \ - snmpm_conf.xml \ - snmpm_mpd.xml \ - snmpm_network_interface.xml \ - snmpm_network_interface_filter.xml \ - snmpm_user.xml - - diff --git a/lib/snmp/doc/src/make.dep b/lib/snmp/doc/src/make.dep deleted file mode 100644 index 223e197f25..0000000000 --- a/lib/snmp/doc/src/make.dep +++ /dev/null @@ -1,77 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# 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 -# 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% - -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex snmp.tex snmp_advanced_agent.tex \ - snmp_agent_config_files.tex snmp_agent_funct_descr.tex \ - snmp_agent_netif.tex snmp_app.tex snmp_app_a.tex \ - snmp_app_b.tex snmp_audit_trail_log.tex \ - snmp_community_mib.tex \ - snmp_config.tex snmp_def_instr_functions.tex \ - snmp_framework_mib.tex snmp_generic.tex \ - snmp_impl_example_agent.tex \ - snmp_impl_example_manager.tex snmp_index.tex \ - snmp_instr_functions.tex snmp_intro.tex \ - snmp_manager_config_files.tex \ - snmp_manager_funct_descr.tex snmp_manager_netif.tex \ - snmp_mib_compiler.tex snmp_notification_mib.tex \ - snmp_pdus.tex snmp_standard_mib.tex snmp_target_mib.tex \ - snmp_user_based_sm_mib.tex snmp_view_based_acm_mib.tex \ - snmpa.tex snmpa_conf.tex snmpa_error.tex snmpa_error_io.tex \ - snmpa_error_logger.tex snmpa_error_report.tex \ - snmpa_local_db.tex snmpa_mpd.tex \ - snmpa_discovery_handler.tex \ - snmpa_network_interface.tex \ - snmpa_network_interface_filter.tex \ - snmpa_notification_delivery_info_receiver.tex \ - snmpa_notification_filter.tex \ - snmpa_supervisor.tex \ - snmpc.tex snmpc_cmd.tex snmpm.tex snmpm_conf.tex snmpm_mpd.tex \ - snmpm_network_interface.tex snmpm_network_interface_filter.tex \ - snmpm_user.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: MIB_mechanism.ps snmp-um-1-image-1.ps snmp-um-1-image-2.ps \ - snmp-um-1-image-3.ps - -book.dvi: snmp_agent_netif_1.ps - -book.dvi: getnext1.ps getnext2.ps getnext3.ps getnext4.ps - -book.dvi: snmp_manager_netif_1.ps - diff --git a/lib/ssh/doc/src/make.dep b/lib/ssh/doc/src/make.dep deleted file mode 100644 index cfe2f9617b..0000000000 --- a/lib/ssh/doc/src/make.dep +++ /dev/null @@ -1,19 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex ref_man.tex ssh.tex ssh_channel.tex \ - ssh_connection.tex ssh_sftp.tex ssh_sftpd.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml diff --git a/lib/stdlib/doc/src/make.dep b/lib/stdlib/doc/src/make.dep deleted file mode 100644 index 48ee6209ef..0000000000 --- a/lib/stdlib/doc/src/make.dep +++ /dev/null @@ -1,40 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: array.tex base64.tex beam_lib.tex book.tex \ - c.tex calendar.tex dets.tex dict.tex digraph.tex \ - digraph_utils.tex epp.tex erl_eval.tex erl_expand_records.tex \ - erl_id_trans.tex erl_internal.tex erl_lint.tex \ - erl_parse.tex erl_pp.tex erl_scan.tex erl_tar.tex \ - ets.tex file_sorter.tex filelib.tex filename.tex \ - gb_sets.tex gb_trees.tex gen_event.tex gen_fsm.tex \ - gen_server.tex io.tex io_lib.tex io_protocol.tex \ - lib.tex lists.tex log_mf_h.tex math.tex ms_transform.tex \ - orddict.tex ordsets.tex part.tex pg.tex pool.tex \ - proc_lib.tex proplists.tex qlc.tex queue.tex \ - random.tex re.tex ref_man.tex regexp.tex sets.tex \ - shell.tex shell_default.tex slave.tex sofs.tex \ - stdlib_app.tex string.tex supervisor.tex supervisor_bridge.tex \ - sys.tex timer.tex unicode.tex unicode_usage.tex \ - win32reg.tex zip.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: ushell1.ps - diff --git a/lib/syntax_tools/doc/src/make.dep b/lib/syntax_tools/doc/src/make.dep deleted file mode 100644 index acc76857bb..0000000000 --- a/lib/syntax_tools/doc/src/make.dep +++ /dev/null @@ -1,22 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex chapter.tex epp_dodger.tex erl_comment_scan.tex \ - erl_prettypr.tex erl_recomment.tex erl_syntax.tex \ - erl_syntax_lib.tex erl_tidy.tex igor.tex part.tex \ - prettypr.tex ref_man.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/test_server/doc/src/make.dep b/lib/test_server/doc/src/make.dep deleted file mode 100644 index ee9100bd08..0000000000 --- a/lib/test_server/doc/src/make.dep +++ /dev/null @@ -1,24 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: basics_chapter.tex book.tex example_chapter.tex \ - part.tex ref_man.tex run_test_chapter.tex \ - test_server_app.tex test_server_ctrl.tex \ - test_server.tex test_spec_chapter.tex \ - write_framework_chapter.tex \ - write_test_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/toolbar/doc/src/make.dep b/lib/toolbar/doc/src/make.dep deleted file mode 100644 index d93ff2a315..0000000000 --- a/lib/toolbar/doc/src/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex toolbar.tex \ - toolbar_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: bar.ps create_tool.ps - diff --git a/lib/tools/doc/src/make.dep b/lib/tools/doc/src/make.dep deleted file mode 100644 index 11fa090d6f..0000000000 --- a/lib/tools/doc/src/make.dep +++ /dev/null @@ -1,33 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex cover.tex cover_chapter.tex cprof.tex \ - cprof_chapter.tex eprof.tex erlang_mode.tex \ - erlang_mode_chapter.tex fprof.tex fprof_chapter.tex \ - instrument.tex make.tex part.tex ref_man.tex \ - tags.tex xref.tex xref_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -cprof.tex: ../../../../system/doc/definitions/term.defs - -xref.tex: ../../../../system/doc/definitions/term.defs - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: venn1.ps venn2.ps - diff --git a/lib/tv/doc/src/make.dep b/lib/tv/doc/src/make.dep deleted file mode 100644 index 8437e320c6..0000000000 --- a/lib/tv/doc/src/make.dep +++ /dev/null @@ -1,32 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex table_visualizer_chapter.tex \ - tv.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: info_window.ps set_poll_int.ps tv_create_table.ps \ - tv_record_editor_mnesia.ps tv_row_marked.ps \ - tv_row_marked_popup.ps tv_search_result.ps \ - tv_search_window.ps tv_start.ps tv_start_mnesia.ps \ - tv_start_other_node.ps tv_start_pid_sorted.ps \ - tv_start_system.ps tv_start_system_unreadable.ps \ - tv_table_browser.ps tv_table_browser_updated.ps - diff --git a/lib/webtool/doc/src/make.dep b/lib/webtool/doc/src/make.dep deleted file mode 100644 index 87526b3f73..0000000000 --- a/lib/webtool/doc/src/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex start_webtool.tex \ - webtool.tex webtool_chapter.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - diff --git a/lib/wx/doc/src/make.dep b/lib/wx/doc/src/make.dep deleted file mode 100644 index 91001be438..0000000000 --- a/lib/wx/doc/src/make.dep +++ /dev/null @@ -1,13 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex chapter.tex part.tex - diff --git a/lib/xmerl/doc/src/make.dep b/lib/xmerl/doc/src/make.dep deleted file mode 100644 index 9c303fc41c..0000000000 --- a/lib/xmerl/doc/src/make.dep +++ /dev/null @@ -1,24 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex ref_man.tex xmerl.tex xmerl_eventp.tex \ - xmerl_scan.tex xmerl_ug.tex xmerl_xpath.tex \ - xmerl_xs.tex xmerl_xsd.tex xmerl_sax_parser.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -book.tex: ref_man.xml - -xmerl_ug.tex: motorcycles.txt motorcycles2html.erl motorcycles_dtd.txt \ - new_motorcycles.txt new_motorcycles2.txt - diff --git a/system/doc/design_principles/make.dep b/system/doc/design_principles/make.dep deleted file mode 100644 index 05dd2333fb..0000000000 --- a/system/doc/design_principles/make.dep +++ /dev/null @@ -1,31 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/gandalf/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: applications.tex appup_cookbook.tex book.tex \ - des_princ.tex distributed_applications.tex \ - events.tex fsm.tex gen_server_concepts.tex \ - included_applications.tex part.tex release_handling.tex \ - release_structure.tex spec_proc.tex sup_princ.tex - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: sup6.ps - -book.dvi: dist1.ps dist2.ps dist3.ps dist4.ps dist5.ps - -book.dvi: clientserver.ps - -book.dvi: inclappls.ps - -book.dvi: sup4.ps sup5.ps - diff --git a/system/doc/efficiency_guide/make.dep b/system/doc/efficiency_guide/make.dep deleted file mode 100644 index afa3bd0516..0000000000 --- a/system/doc/efficiency_guide/make.dep +++ /dev/null @@ -1,16 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: advanced.tex binaryhandling.tex book.tex commoncaveats.tex \ - drivers.tex functions.tex introduction.tex listhandling.tex \ - myths.tex part.tex processes.tex profiling.tex \ - tablesDatabases.tex - diff --git a/system/doc/embedded/make.dep b/system/doc/embedded/make.dep deleted file mode 100644 index 9949a3ac96..0000000000 --- a/system/doc/embedded/make.dep +++ /dev/null @@ -1,14 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex embedded_nt.tex embedded_solaris.tex \ - part.tex vxworks.tex - diff --git a/system/doc/getting_started/make.dep b/system/doc/getting_started/make.dep deleted file mode 100644 index 69b177f77c..0000000000 --- a/system/doc/getting_started/make.dep +++ /dev/null @@ -1,14 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex conc_prog.tex intro.tex part.tex \ - records_macros.tex robustness.tex seq_prog.tex - diff --git a/system/doc/installation_guide/make.dep b/system/doc/installation_guide/make.dep deleted file mode 100644 index 3878f4ac9d..0000000000 --- a/system/doc/installation_guide/make.dep +++ /dev/null @@ -1,13 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex install-binary.tex part.tex verification.tex - diff --git a/system/doc/oam/make.dep b/system/doc/oam/make.dep deleted file mode 100644 index 3694df9f1b..0000000000 --- a/system/doc/oam/make.dep +++ /dev/null @@ -1,26 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex oam_intro.tex part.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -oam_intro.tex: ../../../system/doc/definitions/term.defs - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: snmp_model_1.ps snmp_model_2.ps snmp_model_3.ps \ - terminology.ps - diff --git a/system/doc/programming_examples/make.dep b/system/doc/programming_examples/make.dep deleted file mode 100644 index b0655f56b3..0000000000 --- a/system/doc/programming_examples/make.dep +++ /dev/null @@ -1,20 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: bit_syntax.tex book.tex funs.tex list_comprehensions.tex \ - part.tex records.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -funs.tex: fun_test.erl funparse.erl funs1.erl - diff --git a/system/doc/reference_manual/make.dep b/system/doc/reference_manual/make.dep deleted file mode 100644 index 0e7687448c..0000000000 --- a/system/doc/reference_manual/make.dep +++ /dev/null @@ -1,16 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex code_loading.tex data_types.tex distributed.tex \ - errors.tex expressions.tex functions.tex introduction.tex \ - macros.tex modules.tex part.tex patterns.tex \ - ports.tex processes.tex records.tex - diff --git a/system/doc/system_architecture_intro/make.dep b/system/doc/system_architecture_intro/make.dep deleted file mode 100644 index 6b7bd860a0..0000000000 --- a/system/doc/system_architecture_intro/make.dep +++ /dev/null @@ -1,13 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex part.tex sys_arch_intro.tex - diff --git a/system/doc/system_principles/make.dep b/system/doc/system_principles/make.dep deleted file mode 100644 index 28753ca5a0..0000000000 --- a/system/doc/system_principles/make.dep +++ /dev/null @@ -1,14 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex create_target.tex error_logging.tex \ - part.tex system_principles.tex - diff --git a/system/doc/tutorial/make.dep b/system/doc/tutorial/make.dep deleted file mode 100644 index e9f77ab439..0000000000 --- a/system/doc/tutorial/make.dep +++ /dev/null @@ -1,35 +0,0 @@ -# ---------------------------------------------------- -# >>>> Do not edit this file <<<< -# This file was automaticly generated by -# /home/otp/bin/docdepend -# ---------------------------------------------------- - - -# ---------------------------------------------------- -# TeX files that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: book.tex c_port.tex c_portdriver.tex cnode.tex \ - erl_interface.tex example.tex introduction.tex \ - overview.tex part.tex - -# ---------------------------------------------------- -# Source inlined when transforming from source to LaTeX -# ---------------------------------------------------- - -c_port.tex: port.c - -c_portdriver.tex: port_driver.c - -cnode.tex: complex3.erl - -example.tex: complex.c - -# ---------------------------------------------------- -# Pictures that the DVI file depend on -# ---------------------------------------------------- - -book.dvi: port.ps - -book.dvi: port_driver.ps - -- cgit v1.2.3 From 7738a364192d95e82e45349b99dd177c660fb314 Mon Sep 17 00:00:00 2001 From: Sverker Eriksson Date: Thu, 27 Oct 2011 15:48:19 +0200 Subject: erts: Make erl_nif.h compile with gcc on Windows and some added comments --- erts/emulator/beam/erl_nif_api_funcs.h | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 0753c56c9b..6396af09d0 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -267,7 +267,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); #endif -#if defined(__GNUC__) +#if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) + +/* Inline functions for compile time type checking of arguments to + variadic functions. +*/ # define ERL_NIF_INLINE __inline__ @@ -453,7 +457,7 @@ static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env, # undef ERL_NIF_INLINE -#else +#else /* fallback with macros */ #ifndef enif_make_list1 # define enif_make_list1(ENV,E1) enif_make_list(ENV,1,E1) @@ -476,7 +480,7 @@ static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env, # define enif_make_tuple9(ENV,E1,E2,E3,E4,E5,E6,E7,E8,E9) enif_make_tuple(ENV,9,E1,E2,E3,E4,E5,E6,E7,E8,E9) #endif -#endif /* defined(__GNUC__) */ +#endif /* __GNUC__ && !WIN32 */ #ifndef enif_make_pid -- cgit v1.2.3 From 7d5028832f3638852be41bb32a328859d8d11f93 Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Tue, 1 Nov 2011 12:56:49 +0100 Subject: Skipping the dist test case. Needs a major re-write (sometime). --- lib/megaco/test/megaco_mess_test.erl | 92 +++++++++++++++++++++++++++--------- lib/megaco/test/megaco_test_lib.erl | 10 ++-- 2 files changed, 76 insertions(+), 26 deletions(-) diff --git a/lib/megaco/test/megaco_mess_test.erl b/lib/megaco/test/megaco_mess_test.erl index ded1506271..383e3df774 100644 --- a/lib/megaco/test/megaco_mess_test.erl +++ b/lib/megaco/test/megaco_mess_test.erl @@ -34,12 +34,12 @@ %% -compile(export_all). -export([ - all/0,groups/0,init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, + all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + init_per_testcase/2, end_per_testcase/2, connect/1, - request_and_reply_plain/1, request_and_no_reply/1, @@ -347,39 +347,83 @@ end_per_testcase(Case, Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% all() -> - [connect, {group, request_and_reply}, - {group, pending_ack}, dist, {group, tickets}]. + [ + connect, + {group, request_and_reply}, + {group, pending_ack}, + dist, + {group, tickets} + ]. groups() -> - [{request_and_reply, [], - [request_and_reply_plain, request_and_no_reply, + [ + {request_and_reply, [], + [request_and_reply_plain, + request_and_no_reply, request_and_reply_pending_ack_no_pending, request_and_reply_pending_ack_one_pending, single_trans_req_and_reply, single_trans_req_and_reply_sendopts, - request_and_reply_and_ack, request_and_reply_and_no_ack, + request_and_reply_and_ack, + request_and_reply_and_no_ack, request_and_reply_and_late_ack, trans_req_and_reply_and_req]}, {pending_ack, [], [pending_ack_plain, request_and_pending_and_late_reply]}, {tickets, [], - [otp_4359, otp_4836, otp_5805, otp_5881, otp_5887, - otp_6253, otp_6275, otp_6276, {group, otp_6442}, - {group, otp_6865}, otp_7189, otp_7259, otp_7713, - {group, otp_8183}, otp_8212]}, + [otp_4359, + otp_4836, + otp_5805, + otp_5881, + otp_5887, + otp_6253, + otp_6275, + otp_6276, + {group, otp_6442}, + {group, otp_6865}, + otp_7189, + otp_7259, + otp_7713, + {group, otp_8183}, + otp_8212]}, {otp_6442, [], - [otp_6442_resend_request1, otp_6442_resend_request2, - otp_6442_resend_reply1, otp_6442_resend_reply2]}, + [otp_6442_resend_request1, + otp_6442_resend_request2, + otp_6442_resend_reply1, + otp_6442_resend_reply2]}, {otp_6865, [], [otp_6865_request_and_reply_plain_extra1, otp_6865_request_and_reply_plain_extra2]}, - {otp_8183, [], [otp_8183_request1]}]. + {otp_8183, [], [otp_8183_request1]} + ]. + + +init_per_suite(Config) -> + io:format("~w:init_per_suite -> entry with" + "~n Config: ~p" + "~n", [?MODULE, Config]), + Config. + +end_per_suite(_Config) -> + io:format("~w:end_per_suite -> entry with" + "~n _Config: ~p" + "~n", [?MODULE, _Config]), + ok. + init_per_group(_GroupName, Config) -> + io:format("~w:init_per_group -> entry with" + "~n _GroupName: ~p" + "~n Config: ~p" + "~n", [?MODULE, _GroupName, Config]), Config. end_per_group(_GroupName, Config) -> + io:format("~w:end_per_group -> entry with" + "~n _GroupName: ~p" + "~n Config: ~p" + "~n", [?MODULE, _GroupName, Config]), Config. @@ -394,12 +438,16 @@ connect(Config) when is_list(Config) -> PrelMid = preliminary_mid, MgMid = ipv4_mid(4711), + d("connect -> start megaco app",[]), ?VERIFY(ok, application:start(megaco)), + d("connect -> start (MG) user ~p",[MgMid]), ?VERIFY(ok, megaco:start_user(MgMid, [{send_mod, bad_send_mod}, {request_timer, infinity}, {reply_timer, infinity}])), + d("connect -> get receive info for ~p",[MgMid]), MgRH = user_info(MgMid, receive_handle), + d("connect -> (MG) try connect to MGC",[]), {ok, PrelCH} = ?VERIFY({ok, _}, megaco:connect(MgRH, PrelMid, sh, self())), connections([PrelCH]), @@ -6776,16 +6824,12 @@ rapalr_mg_notify_request_ar(Rid, Tid, Cid) -> - - - - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% dist(suite) -> []; dist(Config) when is_list(Config) -> + ?SKIP("Needs a re-write..."), [_Local, Dist] = ?ACQUIRE_NODES(2, Config), d("dist -> start proxy",[]), megaco_mess_user_test:start_proxy(), @@ -6897,7 +6941,11 @@ dist(Config) when is_list(Config) -> ?VERIFY(ok, application:stop(megaco)), ?RECEIVE([]), - d("dist -> done",[]), + + d("dist -> stop proxy",[]), + megaco_mess_user_test:stop_proxy(), + + d("dist -> done", []), ok. diff --git a/lib/megaco/test/megaco_test_lib.erl b/lib/megaco/test/megaco_test_lib.erl index 41f6c2c4cb..282fd91b44 100644 --- a/lib/megaco/test/megaco_test_lib.erl +++ b/lib/megaco/test/megaco_test_lib.erl @@ -21,6 +21,7 @@ %%---------------------------------------------------------------------- %% Purpose: Lightweight test server %%---------------------------------------------------------------------- +%% -module(megaco_test_lib). @@ -684,7 +685,7 @@ skip(Actual, File, Line) -> fatal_skip(Actual, File, Line) -> error(Actual, File, Line), - exit(shutdown). + exit({skipped, {fatal, Actual, File, Line}}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -749,6 +750,7 @@ proxy_loop(OwnId, Controller) -> proxy_loop(OwnId, Controller) end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test server callbacks init_per_testcase(_Case, Config) -> @@ -852,10 +854,10 @@ watchdog(Pid, Time) -> prepare_test_case(Actions, N, Config, File, Line) -> OrigNodes = lookup_config(nodes, Config), TestNodes = lookup_config(nodenames, Config), %% For testserver - This = node(), + This = node(), SomeNodes = OrigNodes ++ (TestNodes -- OrigNodes), - AllNodes = [This | (SomeNodes -- [This])], - Nodes = pick_n_nodes(N, AllNodes, File, Line), + AllNodes = [This | (SomeNodes -- [This])], + Nodes = pick_n_nodes(N, AllNodes, File, Line), start_nodes(Nodes, File, Line), do_prepare_test_case(Actions, Nodes, Config, File, Line). -- cgit v1.2.3 From 82e41d4b3a57774a23a57d345637a0e19e8727d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 31 Oct 2011 14:00:42 +0100 Subject: beam_load.c: Clarify error message when loading unsupported BEAM files Make it clear for the user what has happened and how to fix it when an attempt is made to load a BEAM file containing new instructions that the current run-time system cannot handle. Suggested-by: Thomas Lindgren --- erts/emulator/beam/beam_load.c | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index de4b32b238..57f5ad0a62 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1570,10 +1570,15 @@ read_code_header(LoaderState* stp) /* * Verify the number of the highest opcode used. */ - GetInt(stp, 4, opcode_max); if (opcode_max > MAX_GENERIC_OPCODE) { - LoadError2(stp, "use of opcode %d; this emulator supports only up to %d", + LoadError2(stp, + "This BEAM file was compiled for a later version" + " of the run-time system than " ERLANG_OTP_RELEASE ".\n" + " To fix this, please recompile this module with an " + ERLANG_OTP_RELEASE " compiler.\n" + " (Use of opcode %d; this emulator supports " + "only up to %d.)", opcode_max, MAX_GENERIC_OPCODE); } -- cgit v1.2.3 From 71f2687e53ef52ae94ab3569a601456d1e906a59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 26 May 2010 11:49:25 +0200 Subject: beam_loader: Support external funs in the literal pool A future release of the compiler might want to treat external funs as literals. Make sure that the loader can cope with an export entry being created from both an entry in the literal pool and from the export table (i.e. if an external fun refers to an exported function in the same module). --- erts/emulator/beam/beam_bif_load.c | 2 -- erts/emulator/beam/beam_load.c | 8 ++++++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 2561d7a630..8c1f85ea37 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -66,8 +66,6 @@ load_module_2(BIF_ALIST_2) erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_smp_block_system(0); - erts_export_consolidate(); - hp = HAlloc(BIF_P, 3); sz = binary_size(BIF_ARG_2); if ((i = erts_load_module(BIF_P, 0, diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 57f5ad0a62..d82b5dbcac 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -757,6 +757,14 @@ bin_load(Process *c_p, ErtsProcLocks c_p_locks, } } + /* + * Since the literal table *may* have contained external + * funs (containing references to export entries), now is + * the time to consolidate the export tables. + */ + + erts_export_consolidate(); + /* * Load the code chunk. */ -- cgit v1.2.3 From b9e610cf12419c6ffe2c19df4f70009bd98ae50c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 30 May 2010 08:27:57 +0200 Subject: Test calling a parameterized module within a fun It is tempting to transform code such as: fun(X) -> M:foo(X) end to: fun M:foo/1 Unfortunately, that transformation is not safe if M happens to be a parameterized module. Add a test case so that we don't attempt to do such an optimization in the future. --- lib/compiler/test/pmod_SUITE.erl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl index 9a317b5762..3d02adaf52 100644 --- a/lib/compiler/test/pmod_SUITE.erl +++ b/lib/compiler/test/pmod_SUITE.erl @@ -96,6 +96,10 @@ basic_1(Config, Opts) -> ?line error = Prop4:bar_bar({s,a,b}), ?line error = Prop4:bar_bar([]), + %% Call from a fun. + Fun = fun(Arg) -> Prop4:bar(Arg) end, + ?line ok = Fun({s,0}), + ok. otp_8447(Config) when is_list(Config) -> -- cgit v1.2.3 From 33c08d87a9395ae088eebcad9fb62193d26b6846 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 26 May 2010 15:50:59 +0200 Subject: Reference manual: Improve the documentation for external funs --- system/doc/reference_manual/code_loading.xml | 4 ++-- system/doc/reference_manual/expressions.xml | 7 +++++-- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/system/doc/reference_manual/code_loading.xml b/system/doc/reference_manual/code_loading.xml index f56e1ff408..3ea72a4057 100644 --- a/system/doc/reference_manual/code_loading.xml +++ b/system/doc/reference_manual/code_loading.xml @@ -112,8 +112,8 @@ loop() -> code_switch to it. The process then will make a fully qualified call to m:loop() and change to current code. Note that m:loop/0 must be exported.

-

For code replacement of funs to work, the tuple syntax - {Module,FunctionName} must be used to represent the fun.

+

For code replacement of funs to work, the syntax + fun Module:FunctionName/Arity should be used.

diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index c24b1110a4..4d211ae1d3 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -995,13 +995,16 @@ fun (Arg1,...,ArgN) -> Name(Arg1,...,ArgN) end

In Module:Name/Arity, Module and Name are atoms and Arity is an integer. A fun defined in this way will refer to the function Name - with arity Arity in the latest version of module Module. + with arity Arity in the latest version of module + Module. A fun defined in this way will not be dependent on + the code for module in which it is defined.

When applied to a number N of arguments, a tuple {Module,FunctionName} is interpreted as a fun, referring to the function FunctionName with arity N in the module Module. The function must be exported. - This usage is deprecated. + This usage is deprecated. Use fun Module:Name/Arity + instead. See Function Calls for an example.

More examples can be found in Programming Examples.

-- cgit v1.2.3 From 841ef48db4b8df0e8a057d5d006e10c3b7e4f325 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 4 Nov 2011 11:12:03 +0100 Subject: beam_type: Improve FP optimizations in the presence of line numbers Allow line/1 instructions to be part of a sequence of floating point instructions to avoid outputting fclearerror / fcheckerror around every floating point instruction. --- lib/compiler/src/beam_type.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 7fdb8d072a..0c51251f1b 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -168,6 +168,8 @@ simplify_float_1([{set,[D0],[A,B],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Ts0, simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> Acc = flush_all(Rs0, Is0, Acc0), simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); +simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, [I|Acc]); simplify_float_1([I|Is]=Is0, Ts0, Rs0, Acc0) -> Ts = update(I, Ts0), {Rs,Acc} = flush(Rs0, Is0, Acc0), -- cgit v1.2.3 From 887c163802c7c39decd727240cd307964a1d692b Mon Sep 17 00:00:00 2001 From: Micael Karlberg Date: Fri, 4 Nov 2011 12:25:59 +0100 Subject: Updated release notes and appup file. OTP-9679 --- lib/megaco/doc/src/notes.xml | 43 +++++++++++++++++++++++++++++++++++++ lib/megaco/src/app/megaco.appup.src | 11 ++++++++++ 2 files changed, 54 insertions(+) diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index 2aba8db71b..80123e3810 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,6 +36,49 @@ section is the version number of Megaco.

+
Megaco 3.15.1.2 + +

Version 3.15.1.2 supports code replacement in runtime from/to + version 3.15.1.1, 3.15.1 and 3.15.

+ +
+ Improvements and new features + + + + + +

The profiling test tool has been rewritten.

+

Håkan Mattsson

+

Own Id: OTP-9679

+ + + + +
+ +
+ Fixed bugs and malfunctions + +

-

+ + + +
+ +
+ +
Megaco 3.15.1.1

Version 3.15.1.1 supports code replacement in runtime from/to diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 7107178d1a..7f6fe0c733 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -139,10 +139,17 @@ %% | %% v %% 3.15.1.1 +%% | +%% v +%% 3.15.1.2 %% %% {"%VSN%", [ + {"3.15.1.1", + [ + ] + }, {"3.15.1", [ ] @@ -160,6 +167,10 @@ } ], [ + {"3.15.1.1", + [ + ] + }, {"3.15.1", [ ] -- cgit v1.2.3 From ff432e262e65243cbc983fcb002527f8fae8c78b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 9 Apr 2010 15:50:17 +0200 Subject: EEP-23: Allow variables in fun M:F/A Currently, the external fun syntax "fun M:F/A" only supports literals. That is, "fun lists:reverse/1" is allowed but not "fun M:F/A". In many real-life situations, some or all of M, F, A are not known until run-time, and one is forced to either use the undocumented erlang:make_fun/3 BIF or to use a "tuple fun" (which is deprecated). EEP-23 suggests that the parser (erl_parse) should immediately transform "fun M:F/A" to "erlang:make_fun(M, F, A)". We have not followed that approach in this implementation, because we want the abstract code to mirror the source code as closely as possible, and we also consider erlang:make_fun/3 to be an implementation detail that we might want to remove in the future. Instead, we will change the abstract format for "fun M:F/A" (in a way that is not backwards compatible), and while we are at it, we will move the translation from "fun M:F/A" to "erlang:make_fun(M, F, A)" from sys_pre_expand down to the v3_core pass. We will also update the debugger and xref to use the new format. We did consider making the abstract format backward compatible if no variables were used in the fun, but decided against it. Keeping it backward compatible would mean that there would be different abstract formats for the no-variable and variable case, and tools would have to handle both formats, probably forever. Reference: http://www.erlang.org/eeps/eep-0023.html --- erts/doc/src/absform.xml | 3 +- erts/emulator/test/code_SUITE.erl | 3 +- lib/compiler/src/sys_pre_expand.erl | 11 ++- lib/compiler/src/v3_core.erl | 7 ++ lib/compiler/test/fun_SUITE.erl | 52 +++++++++++++- lib/debugger/src/dbg_ieval.erl | 15 ++++ lib/debugger/src/dbg_iload.erl | 8 +++ lib/debugger/test/fun_SUITE.erl | 52 +++++++++++++- lib/stdlib/examples/erl_id_trans.erl | 9 ++- lib/stdlib/src/erl_eval.erl | 3 +- lib/stdlib/src/erl_lint.erl | 9 ++- lib/stdlib/src/erl_parse.yrl | 12 +++- lib/stdlib/src/erl_pp.erl | 10 ++- lib/stdlib/src/qlc.erl | 5 +- lib/stdlib/test/erl_eval_SUITE.erl | 6 ++ lib/stdlib/test/erl_pp_SUITE.erl | 5 +- lib/stdlib/test/qlc_SUITE.erl | 2 +- lib/syntax_tools/src/erl_syntax.erl | 7 +- lib/tools/src/xref_reader.erl | 25 ++++--- lib/tools/test/xref_SUITE.erl | 87 +++++++++++++++++++++++- lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam | Bin 0 -> 1116 bytes lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl | 18 +++++ system/doc/reference_manual/expressions.xml | 3 +- 23 files changed, 315 insertions(+), 37 deletions(-) create mode 100644 lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam create mode 100644 lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 4c84412dd6..88e8b284fb 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -285,7 +285,8 @@ If E is , then Rep(E) = . If E is , then - Rep(E) = . + Rep(E) = . + (Before the R15 release: Rep(E) = .) If E is where each is a function clause then Rep(E) = . diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 29cbdedd17..db26655c15 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -278,7 +278,8 @@ t_check_old_code(Config) when is_list(Config) -> external_fun(Config) when is_list(Config) -> ?line false = erlang:function_exported(another_code_test, x, 1), - ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1), + AnotherCodeTest = id(another_code_test), + ExtFun = fun AnotherCodeTest:x/1, ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), ?line false = erlang:function_exported(another_code_test, x, 1), ?line false = lists:member(another_code_test, erlang:loaded()), diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 0fa1fea09f..7facbafb6d 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -554,9 +554,14 @@ fun_tq(Lf, {function,F,A}=Function, St0) -> {{'fun',Lf,Function,{Index,Uniq,Fname}}, St2#expand{fun_index=Index+1}} end; -fun_tq(L, {function,M,F,A}, St) -> - {{call,L,{remote,L,{atom,L,erlang},{atom,L,make_fun}}, - [{atom,L,M},{atom,L,F},{integer,L,A}]},St}; +fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) -> + %% This is the old format for external funs, generated by a pre-R15 + %% compiler. That means that a tool, such as the debugger or xref, + %% directly invoked this module with the abstract code from a + %% pre-R15 BEAM file. Be helpful, and translate it to the new format. + fun_tq(L, {function,{atom,L,M},{atom,L,F},{integer,L,A}}, St); +fun_tq(Lf, {function,_,_,_}=ExtFun, St) -> + {{'fun',Lf,ExtFun},St}; fun_tq(Lf, {clauses,Cs0}, St0) -> Uniq = erlang:hash(Cs0, (1 bsl 27)-1), {Cs1,St1} = fun_clauses(Cs0, St0), diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 6f3590b156..6885405ae0 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -573,6 +573,13 @@ expr({'catch',L,E0}, St0) -> expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> Lanno = lineno_anno(L, St), {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St}; +expr({'fun',L,{function,M,F,A}}, St0) -> + {As,Aps,St1} = safe_list([M,F,A], St0), + Lanno = lineno_anno(L, St1), + {#icall{anno=#a{anno=Lanno}, + module=#c_literal{val=erlang}, + name=#c_literal{val=make_fun}, + args=As},Aps,St1}; expr({'fun',L,{clauses,Cs},Id}, St) -> fun_tq(Id, Cs, L, St); expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 368a5815bf..6067ee8e06 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -20,7 +20,11 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1]). + test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1, + external/1]). + +%% Internal export. +-export([call_me/1]). -include_lib("test_server/include/test_server.hrl"). @@ -28,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [test1, overwritten_fun, otp_7202, bif_fun]. + [test1,overwritten_fun,otp_7202,bif_fun,external]. groups() -> []. @@ -45,7 +49,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - %%% The help functions below are copied from emulator:bs_construct_SUITE. -define(T(B, L), {B, ??B, L}). @@ -152,4 +155,47 @@ bif_fun(Config) when is_list(Config) -> ?line F = fun abs/1, ?line 5 = F(-5), ok. + +-define(APPLY(M, F, A), (fun(Fun) -> {ok,{a,b}} = Fun({a,b}) end)(fun M:F/A)). +-define(APPLY2(M, F, A), + (fun(Map) -> + Id = fun(I) -> I end, + List = [x,y], + List = Map(Id, List), + {type,external} = erlang:fun_info(Map, type) + end)(fun M:F/A)). +external(Config) when is_list(Config) -> + Mod = id(?MODULE), + Func = id(call_me), + Arity = id(1), + + ?APPLY(?MODULE, call_me, 1), + ?APPLY(?MODULE, call_me, Arity), + ?APPLY(?MODULE, Func, 1), + ?APPLY(?MODULE, Func, Arity), + ?APPLY(Mod, call_me, 1), + ?APPLY(Mod, call_me, Arity), + ?APPLY(Mod, Func, 1), + ?APPLY(Mod, Func, Arity), + + ListsMod = id(lists), + ListsMap = id(map), + ListsArity = id(2), + + ?APPLY2(lists, map, 2), + ?APPLY2(lists, map, ListsArity), + ?APPLY2(lists, ListsMap, 2), + ?APPLY2(lists, ListsMap, ListsArity), + ?APPLY2(ListsMod, map, 2), + ?APPLY2(ListsMod, map, ListsArity), + ?APPLY2(ListsMod, ListsMap, 2), + ?APPLY2(ListsMod, ListsMap, ListsArity), + + ok. + +call_me(I) -> + {ok,I}. + +id(I) -> + I. diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index df725ed9e5..2e88c35741 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -768,6 +768,21 @@ expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> end, {value,Fun,Bs}; +%% Construct an external fun. +expr({make_ext_fun,Line,MFA0}, Bs0, Ieval0) -> + {[M,F,A],Bs} = eval_list(MFA0, Bs0, Ieval0), + try erlang:make_fun(M, F, A) of + Value -> + {value,Value,Bs} + catch + error:badarg -> + Ieval1 = Ieval0#ieval{line=Line}, + Ieval2 = dbg_istk:push(Bs0, Ieval1, false), + Ieval = Ieval2#ieval{module=erlang,function=make_fun, + arguments=[M,F,A],line=-1}, + exception(error, badarg, Bs, Ieval, true) + end; + %% Common test adaptation expr({call_remote,0,ct_line,line,As0,Lc}, Bs0, Ieval0) -> {As,_Bs} = eval_list(As0, Bs0, Ieval0), diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index ce5631e45f..3c95ef8068 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -369,6 +369,14 @@ expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> As = new_vars(A, Line), Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], {make_fun,Line,Name,Cs}; +expr({'fun',Line,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) + when 0 =< A, A =< 255 -> + %% New format in R15 for fun M:F/A (literal values). + {value,Line,erlang:make_fun(M, F, A)}; +expr({'fun',Line,{function,M,F,A}}, _Lc) -> + %% New format in R15 for fun M:F/A (one or more variables). + MFA = expr_list([M,F,A]), + {make_ext_fun,Line,MFA}; expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> {dbg,Line,self,[]}; expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> diff --git a/lib/debugger/test/fun_SUITE.erl b/lib/debugger/test/fun_SUITE.erl index 8103d9c692..a06cdc7165 100644 --- a/lib/debugger/test/fun_SUITE.erl +++ b/lib/debugger/test/fun_SUITE.erl @@ -24,8 +24,10 @@ init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, good_call/1,bad_apply/1,bad_fun_call/1,badarity/1, - ext_badarity/1,otp_6061/1]). --export([nothing/0]). + ext_badarity/1,otp_6061/1,external/1]). + +%% Internal exports. +-export([nothing/0,call_me/1]). -include_lib("test_server/include/test_server.hrl"). @@ -46,7 +48,7 @@ end_per_group(_GroupName, Config) -> cases() -> [good_call, bad_apply, bad_fun_call, badarity, - ext_badarity, otp_6061]. + ext_badarity, otp_6061, external]. init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), @@ -244,3 +246,47 @@ test_otp_6061(Starter) -> fun() -> Starter ! working end, fun() -> Starter ! not_working end], lists:foreach(fun(P)->(lists:nth(P,PassesF))() end,Passes). + +-define(APPLY(M, F, A), (fun(Fun) -> {ok,{a,b}} = Fun({a,b}) end)(fun M:F/A)). +-define(APPLY2(M, F, A), + (fun(Map) -> + Id = fun(I) -> I end, + List = [x,y], + List = Map(Id, List), + {type,external} = erlang:fun_info(Map, type) + end)(fun M:F/A)). + +external(Config) when is_list(Config) -> + Mod = id(?MODULE), + Func = id(call_me), + Arity = id(1), + + ?APPLY(?MODULE, call_me, 1), + ?APPLY(?MODULE, call_me, Arity), + ?APPLY(?MODULE, Func, 1), + ?APPLY(?MODULE, Func, Arity), + ?APPLY(Mod, call_me, 1), + ?APPLY(Mod, call_me, Arity), + ?APPLY(Mod, Func, 1), + ?APPLY(Mod, Func, Arity), + + ListsMod = id(lists), + ListsMap = id(map), + ListsArity = id(2), + + ?APPLY2(lists, map, 2), + ?APPLY2(lists, map, ListsArity), + ?APPLY2(lists, ListsMap, 2), + ?APPLY2(lists, ListsMap, ListsArity), + ?APPLY2(ListsMod, map, 2), + ?APPLY2(ListsMod, map, ListsArity), + ?APPLY2(ListsMod, ListsMap, 2), + ?APPLY2(ListsMod, ListsMap, ListsArity), + + ok. + +call_me(I) -> + {ok,I}. + +id(I) -> + I. diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index b63acdd40a..72e41d6473 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -419,7 +419,14 @@ expr({'fun',Line,Body}) -> {'fun',Line,{clauses,Cs1}}; {function,F,A} -> {'fun',Line,{function,F,A}}; - {function,M,F,A} -> %R10B-6: fun M:F/A. + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% R10B-6: fun M:F/A. (Backward compatibility) + {'fun',Line,{function,M,F,A}}; + {function,M0,F0,A0} -> + %% R15: fun M:F/A with variables. + M = expr(M0), + F = expr(F0), + A = expr(A0), {'fun',Line,{function,M,F,A}} end; expr({call,Line,F0,As0}) -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 4f4fa16040..88a0094d57 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -256,7 +256,8 @@ expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) -> expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) -> {value,T,Bs} = expr(E, Bs0, Lf, Ef, none), receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs); -expr({'fun',_Line,{function,Mod,Name,Arity}}, Bs, _Lf, _Ef, RBs) -> +expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> + {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef), F = erlang:make_fun(Mod, Name, Arity), ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 78b996d94b..5d45260fe9 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2127,8 +2127,13 @@ expr({'fun',Line,Body}, Vt, St) -> true -> {[],St}; false -> {[],call_function(Line, F, A, St)} end; - {function,_M,_F,_A} -> - {[],St} + {function,M,F,A} when is_atom(M), is_atom(F), is_integer(A) -> + %% Compatibility with pre-R15 abstract format. + {[],St}; + {function,M,F,A} -> + %% New in R15. + {Bvt, St1} = expr_list([M,F,A], Vt, St), + {vtupdate(Bvt, Vt),St1} end; expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 709bd83e6f..928c10f7f2 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -35,7 +35,7 @@ tuple %struct record_expr record_tuple record_field record_fields if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr -fun_expr fun_clause fun_clauses +fun_expr fun_clause fun_clauses atom_or_var integer_or_var try_expr try_catch try_clause try_clauses query_expr function_call argument_list exprs guard @@ -395,11 +395,17 @@ receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : fun_expr -> 'fun' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. -fun_expr -> 'fun' atom ':' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4'),element(3,'$6')}}. +fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : + {'fun',?line('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : build_fun(?line('$1'), '$2'). +atom_or_var -> atom : '$1'. +atom_or_var -> var : '$1'. + +integer_or_var -> integer : '$1'. +integer_or_var -> var : '$1'. + fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 7dc19f2e9b..6b5aa951cf 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -457,8 +457,16 @@ lexpr({'fun',_,{function,F,A}}, _Prec, _Hook) -> leaf(format("fun ~w/~w", [F,A])); lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Hook) -> {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))}; -lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) -> +lexpr({'fun',_,{function,M,F,A}}, _Prec, _Hook) + when is_atom(M), is_atom(F), is_integer(A) -> + %% For backward compatibility with pre-R15 abstract format. leaf(format("fun ~w:~w/~w", [M,F,A])); +lexpr({'fun',_,{function,M,F,A}}, _Prec, Hook) -> + %% New format in R15. + NameItem = lexpr(M, Hook), + CallItem = lexpr(F, Hook), + ArityItem = lexpr(A, Hook), + ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Hook) -> {list,[{first,'fun',fun_clauses(Cs, Hook)},'end']}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Hook) -> diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index f5e180b4bd..2b691e6abf 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1272,7 +1272,10 @@ abstr_term(Fun, Line) when is_function(Fun) -> case erlang:fun_info(Fun, type) of {type, external} -> {module, Module} = erlang:fun_info(Fun, module), - {'fun', Line, {function,Module,Name,Arity}}; + {'fun', Line, {function, + {atom,Line,Module}, + {atom,Line,Name}, + {integer,Line,Arity}}}; {type, local} -> {'fun', Line, {function,Name,Arity}} end diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 784c7cb86e..369d8b224e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1036,6 +1036,12 @@ funs(Config) when is_list(Config) -> lists:usort([run_many_args(SAs) || SAs <- many_args(MaxArgs)]), ?line {'EXIT',{{argument_limit,_},_}} = (catch run_many_args(many_args1(MaxArgs+1))), + + ?line check(fun() -> M = lists, F = fun M:reverse/1, + [1,2] = F([2,1]), ok end, + "begin M = lists, F = fun M:reverse/1," + " [1,2] = F([2,1]), ok end.", + ok), ok. run_many_args({S, As}) -> diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 280c95b1aa..64853ca078 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -116,7 +116,6 @@ func(Config) when is_list(Config) -> {func_3, <<"t() -> fun t/0.">>}, {func_4, - %% Has already been expanded away in sys_pre_expand. <<"t() -> fun modul:foo/3.">>}, {func_5, % 'when' is moved down one line <<"tkjlksjflksdjflsdjlk() @@ -127,7 +126,9 @@ func(Config) when is_list(Config) -> <<"t() -> (fun() -> true - end)().">>} + end)().">>}, + {func_7, + <<"t(M, F, A) -> fun M:F/A.">>} ], ?line compile(Config, Ts), ok. diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 98eeaee118..8a9d8f7883 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -6632,7 +6632,7 @@ otp_7232(Config) when is_list(Config) -> {call,_, {remote,_,{atom,_,qlc},{atom,_,sort}}, [{cons,_, - {'fun',_,{function,math,sqrt,_}}, + {'fun',_,{function,{atom,_,math},{atom,_,sqrt},_}}, {cons,_, {string,_,\"<0.4.1>\"}, % could use list_to_pid.. {cons,_,{string,_,\"#Ref<\"++_},{nil,_}}}}, diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 9df5f26454..7f58fda519 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -6093,11 +6093,16 @@ implicit_fun_name(Node) -> {'fun', Pos, {function, Atom, Arity}} -> arity_qualifier(set_pos(atom(Atom), Pos), set_pos(integer(Arity), Pos)); - {'fun', Pos, {function, Module, Atom, Arity}} -> + {'fun', Pos, {function, Module, Atom, Arity}} + when is_atom(Module), is_atom(Atom), is_integer(Arity) -> + %% Backward compatibility with pre-R15 abstract format. module_qualifier(set_pos(atom(Module), Pos), arity_qualifier( set_pos(atom(Atom), Pos), set_pos(integer(Arity), Pos))); + {'fun', Pos, {function, Module, Atom, Arity}} -> + %% New in R15: fun M:F/A. + module_qualifier(Module, arity_qualifier(Atom, Arity)); Node1 -> data(Node1) end. diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl index d22f0df164..92f0c45c7b 100644 --- a/lib/tools/src/xref_reader.erl +++ b/lib/tools/src/xref_reader.erl @@ -158,15 +158,20 @@ expr({'try',_Line,Es,Scs,Ccs,As}, S) -> S2 = clauses(Scs, S1), S3 = clauses(Ccs, S2), expr(As, S3); -expr({call, Line, - {remote, _, {atom,_,erlang}, {atom,_,make_fun}}, - [{atom,_,Mod}, {atom,_,Fun}, {integer,_,Arity}]}, S) -> - %% Added in R10B-6. M:F/A. - expr({'fun', Line, {function, Mod, Fun, Arity}}, S); -expr({'fun', Line, {function, Mod, Name, Arity}}, S) -> - %% Added in R10B-6. M:F/A. +expr({'fun', Line, {function, {atom,_,Mod}, + {atom,_,Name}, + {integer,_,Arity}}}, S) -> + %% New format in R15. M:F/A (literals). As = lists:duplicate(Arity, {atom, Line, foo}), external_call(Mod, Name, As, Line, false, S); +expr({'fun', Line, {function, Mod, Name, {integer,_,Arity}}}, S) -> + %% New format in R15. M:F/A (one or more variables). + As = lists:duplicate(Arity, {atom, Line, foo}), + external_call(erlang, apply, [Mod, Name, list2term(As)], Line, true, S); +expr({'fun', Line, {function, Mod, Name, _Arity}}, S) -> + %% New format in R15. M:F/A (one or more variables). + As = {var, Line, '_'}, + external_call(erlang, apply, [Mod, Name, As], Line, true, S); expr({'fun', Line, {function, Name, Arity}, _Extra}, S) -> %% Added in R8. handle_call(local, S#xrefr.module, Name, Arity, Line, S); @@ -286,10 +291,10 @@ check_funarg(W, ArgsList, Line, S) -> expr(ArgsList, S1). funarg({'fun', _, _Clauses, _Extra}, _S) -> true; -funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars); -funarg({call,_,{remote,_,{atom,_,erlang},{atom,_,make_fun}},_MFA}, _S) -> - %% R10B-6. M:F/A. +funarg({'fun', _, {function,_,_,_}}, _S) -> + %% New abstract format for fun M:F/A in R15. true; +funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars); funarg(_, _S) -> false. fun_args(apply2, [FunArg, Args]) -> {FunArg, Args}; diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index 2f83ab4995..e0876381ca 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -46,7 +46,8 @@ -export([ add/1, default/1, info/1, lib/1, read/1, read2/1, remove/1, replace/1, update/1, deprecated/1, trycatch/1, - abstract_modules/1, fun_mfa/1, qlc/1]). + abstract_modules/1, fun_mfa/1, fun_mfa_r14/1, + fun_mfa_vars/1, qlc/1]). -export([ analyze/1, basic/1, md/1, q/1, variables/1, unused_locals/1]). @@ -82,7 +83,7 @@ groups() -> {files, [], [add, default, info, lib, read, read2, remove, replace, update, deprecated, trycatch, abstract_modules, fun_mfa, - qlc]}, + fun_mfa_r14, fun_mfa_vars, qlc]}, {analyses, [], [analyze, basic, md, q, variables, unused_locals]}, {misc, [], [format_error, otp_7423, otp_7831]}]. @@ -1771,6 +1772,88 @@ fun_mfa(Conf) when is_list(Conf) -> ?line ok = file:delete(Beam), ok. +%% Same as the previous test case, except that we use a BEAM file +%% that was compiled by an R14 compiler to test backward compatibility. +fun_mfa_r14(Conf) when is_list(Conf) -> + Dir = ?config(data_dir, Conf), + MFile = fname(Dir, "fun_mfa_r14"), + + A = fun_mfa_r14, + {ok, _} = xref:start(s), + {ok, A} = xref:add_module(s, MFile, {warnings,false}), + {ok, [{{{A,t,0},{'$M_EXPR','$F_EXPR',0}},[7]}, + {{{A,t,0},{A,t,0}},[6]}, + {{{A,t1,0},{'$M_EXPR','$F_EXPR',0}},[11]}, + {{{A,t1,0},{A,t,0}},[10]}, + {{{A,t2,0},{A,t,0}},[14]}, + {{{A,t3,0},{A,t3,0}},[17]}]} = + xref:q(s, "(Lin) E"), + + ok = check_state(s), + xref:stop(s), + + ok. + +%% fun M:F/A with varibles. +fun_mfa_vars(Conf) when is_list(Conf) -> + Dir = ?copydir, + File = fname(Dir, "fun_mfa_vars.erl"), + MFile = fname(Dir, "fun_mfa_vars"), + Beam = fname(Dir, "fun_mfa_vars.beam"), + Test = <<"-module(fun_mfa_vars). + + -export([t/1, t1/1, t2/3]). + + t(Mod) -> + F = fun Mod:bar/2, + (F)(a, b). + + t1(Name) -> + F = fun ?MODULE:Name/1, + (F)(a). + + t2(Mod, Name, Arity) -> + F = fun Mod:Name/Arity, + (F)(a). + + t3(Arity) -> + F = fun ?MODULE:t/Arity, + (F)(1, 2, 3). + + t4(Mod, Name) -> + F = fun Mod:Name/3, + (F)(a, b, c). + + t5(Mod, Arity) -> + F = fun Mod:t/Arity, + (F)(). + ">>, + + ok = file:write_file(File, Test), + A = fun_mfa_vars, + {ok, A} = compile:file(File, [report,debug_info,{outdir,Dir}]), + {ok, _} = xref:start(s), + {ok, A} = xref:add_module(s, MFile, {warnings,false}), + {ok, [{{{A,t,1},{'$M_EXPR','$F_EXPR',2}},[7]}, + {{{A,t,1},{'$M_EXPR',bar,2}},[6]}, + {{{A,t1,1},{'$M_EXPR','$F_EXPR',1}},[11]}, + {{{A,t1,1},{A,'$F_EXPR',1}},[10]}, + {{{A,t2,3},{'$M_EXPR','$F_EXPR',-1}},[14]}, + {{{A,t2,3},{'$M_EXPR','$F_EXPR',1}},[15]}, + {{{A,t3,1},{'$M_EXPR','$F_EXPR',3}},[19]}, + {{{A,t3,1},{fun_mfa_vars,t,-1}},[18]}, + {{{A,t4,2},{'$M_EXPR','$F_EXPR',3}},[22,23]}, + {{{A,t5,2},{'$M_EXPR','$F_EXPR',0}},[27]}, + {{{A,t5,2},{'$M_EXPR',t,-1}},[26]}]} = + xref:q(s, "(Lin) E"), + + ok = check_state(s), + xref:stop(s), + + ok = file:delete(File), + ok = file:delete(Beam), + ok. + qlc(suite) -> []; qlc(doc) -> ["OTP-5195: A bug fix when using qlc:q/1,2."]; qlc(Conf) when is_list(Conf) -> diff --git a/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam new file mode 100644 index 0000000000..4645525690 Binary files /dev/null and b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.beam differ diff --git a/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl new file mode 100644 index 0000000000..293bd83a8b --- /dev/null +++ b/lib/tools/test/xref_SUITE_data/fun_mfa_r14.erl @@ -0,0 +1,18 @@ +-module(fun_mfa_r14). + +-export([t/0, t1/0, t2/0, t3/0]). + +t() -> + F = fun ?MODULE:t/0, + (F)(). + +t1() -> + F = fun t/0, + (F)(). + +t2() -> + fun ?MODULE:t/0(). + +t3() -> + fun t3/0(). + diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 4d211ae1d3..43d46d87cc 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -993,7 +993,8 @@ fun Module:Name/Arity 

 fun (Arg1,...,ArgN) -> Name(Arg1,...,ArgN) end

In Module:Name/Arity, Module and Name are atoms - and Arity is an integer. + and Arity is an integer. Starting from the R15 release, + Module, Name, and Arity may also be variables. A fun defined in this way will refer to the function Name with arity Arity in the latest version of module Module. A fun defined in this way will not be dependent on -- cgit v1.2.3 From af5edfe20b24116fa892a37a746f4053fde6039b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 29 Sep 2011 08:13:24 +0200 Subject: beam_asm: Strenghten the calculation of Uniq for funs Funs are identified by a triple, , where Module is the module name, Uniq is a 27 bit hash value of some intermediate representation of the code for the fun, and index is a small integer. When a fun is loaded, the triple for the fun will be compared to previously loaded funs. If all elements in the triple in the newly loaded fun are the same, the newly loaded fun will replace the previous fun. The idea is that if Uniq are the same, the code for the fun is also the same. The problem is that Uniq is only based on the intermediate representation of the fun itself. If the fun calls local functions in the same module, Uniq may remain the same even if the behavior of the fun has been changed. See http://erlang.org/pipermail/erlang-bugs/2007-June/000368.htlm for an example. As a long-term plan to fix this problem, the NewIndex and NewUniq fields was added to each fun in the R8 release (where NewUniq is the MD5 of the BEAM code for the module). Unfortunately, it turns out that the compiler does not assign unique value to NewIndex (if it isn't tested, it doesn't work), so we cannot use the triple as identification. It would be possible to use , but that seems ugly. Therefore, fix the problem by making Uniq more unique by taking 27 bits from the MD5 for the BEAM code. That only requires a change to the compiler. Also update a test case for cover, which now fails because of the stronger Uniq calculation. (The comment in test case about why the Pid2 process survived is not correct.) --- erts/doc/src/erlang.xml | 9 +++- erts/emulator/test/code_SUITE.erl | 28 +++++++++++- .../test/code_SUITE_data/fun_confusion.erl | 31 +++++++++++++ lib/compiler/src/beam_asm.erl | 52 +++++++++++++++------- lib/compiler/src/beam_dict.erl | 13 +++--- lib/tools/test/cover_SUITE.erl | 31 +++++-------- lib/tools/test/cover_SUITE_data/otp_6115/f1.erl | 11 ++--- 7 files changed, 123 insertions(+), 52 deletions(-) create mode 100644 erts/emulator/test/code_SUITE_data/fun_confusion.erl diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 45b66a4909..5d7ff7613b 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1196,11 +1196,16 @@ true {new_uniq, Uniq} -

Uniq (a binary) is a unique value for this fun.

+

Uniq (a binary) is a unique value for this fun. + It is calculated from the compiled code for the entire module.

{uniq, Uniq} -

Uniq (an integer) is a unique value for this fun.

+

Uniq (an integer) is a unique value for this fun. + Starting in the R15 release, this integer is calculated from + the compiled code for the entire module. Before R15, this + integer was based on only the body of the fun. +

diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 29cbdedd17..6bce448842 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -25,7 +25,7 @@ t_check_process_code_ets/1, external_fun/1,get_chunk/1,module_md5/1,make_stub/1, make_stub_many_funs/1,constant_pools/1, - false_dependency/1,coverage/1]). + false_dependency/1,coverage/1,fun_confusion/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,7 @@ all() -> [new_binary_types, t_check_process_code, t_check_process_code_ets, t_check_old_code, external_fun, get_chunk, module_md5, make_stub, make_stub_many_funs, - constant_pools, false_dependency, coverage]. + constant_pools, false_dependency, coverage, fun_confusion]. groups() -> []. @@ -555,6 +555,30 @@ coverage(Config) when is_list(Config) -> ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), ok. +fun_confusion(Config) when is_list(Config) -> + Data = ?config(data_dir, Config), + Src = filename:join(Data, "fun_confusion"), + Mod = fun_confusion, + + %% Load first version of module. + compile_load(Mod, Src, 1), + F1 = Mod:f(), + 1 = F1(), + + %% Load second version of module. + compile_load(Mod, Src, 2), + F2 = Mod:f(), + + %% F1 should refer to the old code, not the newly loaded code. + 1 = F1(), + 2 = F2(), + ok. + +compile_load(Mod, Src, Ver) -> + {ok,Mod,Code1} = compile:file(Src, [binary,{d,version,Ver}]), + {module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1), + ok. + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> diff --git a/erts/emulator/test/code_SUITE_data/fun_confusion.erl b/erts/emulator/test/code_SUITE_data/fun_confusion.erl new file mode 100644 index 0000000000..16000861df --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/fun_confusion.erl @@ -0,0 +1,31 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(fun_confusion). + +-export([f/0]). + +f() -> + fun() -> version() end. + +version() -> + %% Changing the value returned here should change + %% the identity of the fun in f/0. + ?version. + diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 6e63c4d0f2..9b46abe697 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -146,8 +146,10 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> Essentials0 = [AtomChunk,CodeChunk,StringChunk,ImportChunk, ExpChunk,LambdaChunk,LiteralChunk], - Essentials = [iolist_to_binary(C) || C <- Essentials0], - {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, Essentials), + Essentials1 = [iolist_to_binary(C) || C <- Essentials0], + MD5 = module_md5(Essentials1), + Essentials = finalize_fun_table(Essentials1, MD5), + {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, MD5), AttrChunk = chunk(<<"Attr">>, Attributes), CompileChunk = chunk(<<"CInf">>, Compile), @@ -166,6 +168,24 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> end, build_form(<<"BEAM">>, Chunks). +%% finalize_fun_table(Essentials, MD5) -> FinalizedEssentials +%% Update the 'old_uniq' field in the entry for each fun in the +%% 'FunT' chunk. We'll use part of the MD5 for the module as a +%% unique value. + +finalize_fun_table(Essentials, MD5) -> + [finalize_fun_table_1(E, MD5) || E <- Essentials]. + +finalize_fun_table_1(<<"FunT",Keep:8/binary,Table0/binary>>, MD5) -> + <> = MD5, + Table = finalize_fun_table_2(Table0, Uniq, <<>>), + <<"FunT",Keep/binary,Table/binary>>; +finalize_fun_table_1(Chunk, _) -> Chunk. + +finalize_fun_table_2(<>, Uniq, Acc) -> + finalize_fun_table_2(T, Uniq, <>); +finalize_fun_table_2(<<>>, _, Acc) -> Acc. + %% Build an IFF form. build_form(Id, Chunks0) when byte_size(Id) =:= 4, is_list(Chunks0) -> @@ -202,7 +222,7 @@ flatten_exports(Exps) -> flatten_imports(Imps) -> list_to_binary(map(fun({M,F,A}) -> <> end, Imps)). -build_attributes(Opts, SourceFile, Attr, Essentials) -> +build_attributes(Opts, SourceFile, Attr, MD5) -> Misc = case member(slim, Opts) of false -> {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), @@ -210,7 +230,7 @@ build_attributes(Opts, SourceFile, Attr, Essentials) -> true -> [] end, Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], - {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}. + {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}. build_line_table(Dict) -> {NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} = @@ -243,32 +263,30 @@ encode_line_items([], _) -> []. %% We'll not change an existing 'vsn' attribute. %% -calc_vsn(Attr, Essentials0) -> +set_vsn_attribute(Attr, MD5) -> case keymember(vsn, 1, Attr) of true -> Attr; false -> - Essentials = filter_essentials(Essentials0), - <> = erlang:md5(Essentials), + <> = MD5, [{vsn,[Number]}|Attr] end. +module_md5(Essentials0) -> + Essentials = filter_essentials(Essentials0), + erlang:md5(Essentials). + %% filter_essentials([Chunk]) -> [Chunk'] %% Filter essentials so that we obtain the same MD5 as code:module_md5/1 and -%% beam_lib:md5/1 would calculate for this module. +%% beam_lib:md5/1 would calculate for this module. Note that at this +%% point, the 'old_uniq' entry for each fun in the 'FunT' chunk is zeroed, +%% so there is no need to go through the 'FunT' chunk. -filter_essentials([<<"FunT",_Sz:4/binary,Entries:4/binary,Table0/binary>>|T]) -> - Table = filter_funtab(Table0, <<0:32>>), - [Entries,Table|filter_essentials(T)]; filter_essentials([<<_Tag:4/binary,Sz:32,Data:Sz/binary,_Padding/binary>>|T]) -> [Data|filter_essentials(T)]; filter_essentials([<<>>|T]) -> filter_essentials(T); filter_essentials([]) -> []. -filter_funtab(<>, Zero) -> - [Important,Zero|filter_funtab(T, Zero)]; -filter_funtab(<<>>, _) -> []. - bif_type(fnegate, 1) -> {op,fnegate}; bif_type(fadd, 2) -> {op,fadd}; bif_type(fsub, 2) -> {op,fsub}; @@ -310,8 +328,8 @@ make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail|Ops], Dict); make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail,Op,Live|Ops++[Dst]], Dict); -make_op({make_fun2,{f,Lbl},Index,OldUniq,NumFree}, Dict0) -> - {Fun,Dict} = beam_dict:lambda(Lbl, Index, OldUniq, NumFree, Dict0), +make_op({make_fun2,{f,Lbl},Index,_OldUniq,NumFree}, Dict0) -> + {Fun,Dict} = beam_dict:lambda(Lbl, Index, NumFree, Dict0), make_op({make_fun2,Fun}, Dict); make_op({kill,Y}, Dict) -> make_op({init,Y}, Dict); diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index ee76623976..f82a8f2e3e 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -22,7 +22,7 @@ -export([new/0,opcode/2,highest_opcode/1, atom/2,local/4,export/4,import/4, - string/2,lambda/5,literal/2,line/2,fname/2, + string/2,lambda/4,literal/2,line/2,fname/2, atom_table/1,local_table/1,export_table/1,import_table/1, string_table/1,lambda_table/1,literal_table/1, line_table/1]). @@ -133,13 +133,16 @@ string(Str, Dict) when is_list(Str) -> {NextOffset-Offset,Dict} end. -%% Returns the index for a funentry (adding it to the table if necessary). -%% lambda(Lbl, Index, Uniq, NumFree, Dict) -> {Index,Dict'} --spec lambda(label(), non_neg_integer(), integer(), non_neg_integer(), bdict()) -> +%% Returns the index for a fun entry. +%% lambda(Lbl, Index, NumFree, Dict) -> {Index,Dict'} +-spec lambda(label(), non_neg_integer(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, Index, OldUniq, NumFree, #asm{lambdas=Lambdas0}=Dict) -> +lambda(Lbl, Index, NumFree, #asm{lambdas=Lambdas0}=Dict) -> OldIndex = length(Lambdas0), + %% Initialize OldUniq to 0. It will be set to an unique value + %% based on the MD5 checksum of the BEAM code for the module. + OldUniq = 0, Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], {OldIndex,Dict#asm{lambdas=Lambdas}}. diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index fe7f92de78..881a3c2997 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -583,21 +583,14 @@ otp_6115_1(Config) -> %% called -- running cover compiled code when there is no cover %% server and thus no ets tables to bump counters in, makes no %% sense. - ?line Pid1 = f1:start_fail(), - - %% If f1 is cover compiled, a process P is started with a - %% reference to the fun created in start_ok/0, and - %% cover:stop() is called, then P should survive. - %% This is because (the fun held by) P always references the current - %% version of the module, and is thus not affected by the cover - %% compiled version being unloaded. - ?line Pid2 = f1:start_ok(), + Pid1 = f1:start_a(), + Pid2 = f1:start_b(), %% Now stop cover ?line cover:stop(), - %% Ensure that f1 is loaded (and not cover compiled), that Pid1 - %% is dead and Pid2 is alive, but with no reference to old code + %% Ensure that f1 is loaded (and not cover compiled), and that + %% both Pid1 and Pid2 are dead. case code:which(f1) of Beam when is_list(Beam) -> ok; @@ -608,19 +601,15 @@ otp_6115_1(Config) -> undefined -> ok; _PI1 -> - RefToOldP = erlang:check_process_code(Pid1, f1), - ?line ?t:fail({"Pid1 still alive", RefToOldP}) + RefToOldP1 = erlang:check_process_code(Pid1, f1), + ?t:fail({"Pid1 still alive", RefToOldP1}) end, case process_info(Pid2) of - PI2 when is_list(PI2) -> - case erlang:check_process_code(Pid2, f2) of - false -> - ok; - true -> - ?line ?t:fail("Pid2 has ref to old code") - end; undefined -> - ?line ?t:fail("Pid2 has died") + ok; + _PI2 -> + RefToOldP2 = erlang:check_process_code(Pid1, f2), + ?t:fail({"Pid2 still alive", RefToOldP2}) end, ?line file:set_cwd(CWD), diff --git a/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl b/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl index b659e5d818..5399b33f19 100644 --- a/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl +++ b/lib/tools/test/cover_SUITE_data/otp_6115/f1.erl @@ -1,12 +1,13 @@ -module(f1). --export([start_fail/0, start_ok/0]). +-export([start_a/0, start_b/0]). -start_fail() -> +start_a() -> f2:start(fun() -> - io:format("this does not work\n",[]) + ok end). -start_ok() -> +start_b() -> f2:start(fun fun1/0). + fun1() -> - io:format("this works\n",[]). + ok. -- cgit v1.2.3 From a772f06a2de3b83e8b21072eeae837e05f7b46e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 29 Sep 2011 15:05:20 +0200 Subject: beam_asm: Fix broken NewIndex in fun entries The calculation of the NewIndex field in fun entries is broken: the sys_pre_expand and v3_kernel modules keep separate index counters starting at zero; thus there is no guarantee that each fun within a module will have its own unique NewIndex. We don't really need the NewIndex any more (see below), but since we do need the NewUniq field, we should fix NewIndex for cleanliness sake. The simplest way is to assign NewIndex as late as possible, namely in beam_asm, and to set it to the same value as Index. Historical Note: Why NewIndex Was Introduced There was once an idea that the debugger should be able to interpret only a single function in a module (for speed). To make sure that interpreted funs could be called from BEAM code and vice versa, the fun identification must be visible in the abstract code. Therefore a NewIndex field was introduced in each fun in the abstract code. However, it turned out that interpreting single functions does not play well with aggressive code optimization. For example, in this code: f() -> X = 1, fun() -> X+2 end. the variable X will seem to be free in the fun, but an aggressive optimizer will replace X with 1 in the fun; thus the fun will no longer have any free variables. Therefore, the debugger will always interpret entire modules. --- lib/compiler/src/beam_asm.erl | 4 ++-- lib/compiler/src/beam_dict.erl | 10 ++++++---- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 9b46abe697..4a9c12dfea 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -328,8 +328,8 @@ make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail|Ops], Dict); make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail,Op,Live|Ops++[Dst]], Dict); -make_op({make_fun2,{f,Lbl},Index,_OldUniq,NumFree}, Dict0) -> - {Fun,Dict} = beam_dict:lambda(Lbl, Index, NumFree, Dict0), +make_op({make_fun2,{f,Lbl},_Index,_OldUniq,NumFree}, Dict0) -> + {Fun,Dict} = beam_dict:lambda(Lbl, NumFree, Dict0), make_op({make_fun2,Fun}, Dict); make_op({kill,Y}, Dict) -> make_op({init,Y}, Dict); diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index f82a8f2e3e..531968b3c8 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -22,7 +22,7 @@ -export([new/0,opcode/2,highest_opcode/1, atom/2,local/4,export/4,import/4, - string/2,lambda/4,literal/2,line/2,fname/2, + string/2,lambda/3,literal/2,line/2,fname/2, atom_table/1,local_table/1,export_table/1,import_table/1, string_table/1,lambda_table/1,literal_table/1, line_table/1]). @@ -134,12 +134,14 @@ string(Str, Dict) when is_list(Str) -> end. %% Returns the index for a fun entry. -%% lambda(Lbl, Index, NumFree, Dict) -> {Index,Dict'} --spec lambda(label(), non_neg_integer(), non_neg_integer(), bdict()) -> +%% lambda(Lbl, NumFree, Dict) -> {Index,Dict'} +-spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, Index, NumFree, #asm{lambdas=Lambdas0}=Dict) -> +lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) -> OldIndex = length(Lambdas0), + %% Set Index the same as OldIndex. + Index = OldIndex, %% Initialize OldUniq to 0. It will be set to an unique value %% based on the MD5 checksum of the BEAM code for the module. OldUniq = 0, -- cgit v1.2.3 From 7f434109e62fb7b36a350240729aeed2477fd594 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sat, 8 Oct 2011 10:06:13 +0200 Subject: compiler: Eliminate use of deprecated erlang:hash/2 Now that beam_asm computes the Index and Uniq values for funs, there is no need to compute those values in the sys_pre_expand and v3_kernel modules, thus eliminating the calls to the deprecated erlang:hash/2 function. It would be tempting to stop generating the name for the fun in sys_pre_expand so that we did not have to add the Info field to a tuple. But: * The debugger depends on the name being there. (Simple solution: Let the debugger generate the name itself.) * When a fun has been inlined into another function, the fun name in 'id' annotation will be used to notice the inlining and change the final clause of the top-level case from generating a 'function_clause' exception to a case_clause exception. (Possible workaround: Have the inliner set an inlined attribute on functions that have been inlined, or have the inliner rewrite 'function_clause' exceptions itself.) --- lib/compiler/src/sys_pre_expand.erl | 23 +++++++++-------------- lib/compiler/src/v3_kernel.erl | 22 ++++++++++------------ 2 files changed, 19 insertions(+), 26 deletions(-) diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 0fa1fea09f..4fabcd947b 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -31,8 +31,6 @@ -import(ordsets, [from_list/1,add_element/2,union/2]). -import(lists, [member/2,foldl/3,foldr/3]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). - -include("../include/erl_bits.hrl"). -record(expand, {module=[], %Module name @@ -49,7 +47,6 @@ func=[], %Current function arity=[], %Arity for current function fcount=0, %Local fun count - fun_index=0, %Global index for funs bitdefault, bittypes }). @@ -542,28 +539,26 @@ lc_tq(_Line, [], St0) -> %% "Implicit" funs {'fun', Line, {function, F, A}} are not changed. fun_tq(Lf, {function,F,A}=Function, St0) -> - {As,St1} = new_vars(A, Lf, St0), - Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], case erl_internal:bif(F, A) of true -> + {As,St1} = new_vars(A, Lf, St0), + Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], fun_tq(Lf, {clauses,Cs}, St1); false -> - Index = St0#expand.fun_index, - Uniq = erlang:hash(Cs, (1 bsl 27)-1), - {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,Function,{Index,Uniq,Fname}}, - St2#expand{fun_index=Index+1}} + {Fname,St1} = new_fun_name(St0), + Index = Uniq = 0, + {{'fun',Lf,Function,{Index,Uniq,Fname}},St1} end; fun_tq(L, {function,M,F,A}, St) -> {{call,L,{remote,L,{atom,L,erlang},{atom,L,make_fun}}, [{atom,L,M},{atom,L,F},{integer,L,A}]},St}; fun_tq(Lf, {clauses,Cs0}, St0) -> - Uniq = erlang:hash(Cs0, (1 bsl 27)-1), {Cs1,St1} = fun_clauses(Cs0, St0), - Index = St1#expand.fun_index, {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}}, - St2#expand{fun_index=Index+1}}. + %% Set dummy values for Index and Uniq -- the real values will + %% be assigned by beam_asm. + Index = Uniq = 0, + {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> {H,St1} = head(H0, St0), diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 4e06b464a4..47e5e49a76 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -84,8 +84,6 @@ keymember/3,keyfind/3]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). - -include("core_parse.hrl"). -include("v3_kernel.hrl"). @@ -1658,31 +1656,31 @@ uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> {Ns,St3} = new_vars(1 - length(Rs0), St2), Rs1 = Rs0 ++ Ns, {#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3}; -uexpr(#ifun{anno=A,vars=Vs,body=B0}=IFun, {break,Rs}, St0) -> +uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> {B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function Ns = lit_list_vars(Vs), Free = subtract(Bu, Ns), %Free variables in fun Fvs = make_vars(Free), Arity = length(Vs) + length(Free), - {{Index,Uniq,Fname}, St3} = + {Fname,St} = case lists:keyfind(id, 1, A) of - {id,Id} -> - {Id, St1}; + {id,{_,_,Fname0}} -> + {Fname0,St1}; false -> - %% No id annotation. Must invent one. - I = St1#kern.fcount, - U = erlang:hash(IFun, (1 bsl 27)-1), - {N, St2} = new_fun_name(St1), - {{I,U,N}, St2} + %% No id annotation. Must invent a fun name. + new_fun_name(St1) end, Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, vars=Vs ++ Fvs,body=B1}, + %% Set dummy values for Index and Uniq -- the real values will + %% be assigned by beam_asm. + Index = Uniq = 0, {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, op=#k_internal{name=make_fun,arity=length(Free)+3}, args=[#k_atom{val=Fname},#k_int{val=Arity}, #k_int{val=Index},#k_int{val=Uniq}|Fvs], ret=Rs}, - Free,add_local_function(Fun, St3)}; + Free,add_local_function(Fun, St)}; uexpr(Lit, {break,Rs}, St) -> %% Transform literals to puts here. %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), -- cgit v1.2.3 From b2cd72d36c5dbd559659213ca6d0d1fab3df8aa1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 9 Oct 2011 10:13:59 +0200 Subject: sys_pre_expand: Remove incorrect comment sys_pre_expand does not keep track of used or new variables (and have not done since about the time Core Erlang was introduced). --- lib/compiler/src/sys_pre_expand.erl | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 4fabcd947b..63dea024b4 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -535,7 +535,6 @@ lc_tq(_Line, [], St0) -> %% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an %% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the %% name of a BIF (erl_lint has checked that it is not an import). -%% Process the body sequence directly to get the new and used variables. %% "Implicit" funs {'fun', Line, {function, F, A}} are not changed. fun_tq(Lf, {function,F,A}=Function, St0) -> -- cgit v1.2.3 From 2c18949bf1edfda523ae15229e94a8400bb1870c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 7 Nov 2011 14:04:44 +0100 Subject: Update primary bootstrap --- bootstrap/lib/compiler/ebin/beam_asm.beam | Bin 11096 -> 11640 bytes bootstrap/lib/compiler/ebin/beam_block.beam | Bin 14388 -> 14388 bytes bootstrap/lib/compiler/ebin/beam_bool.beam | Bin 16160 -> 16160 bytes bootstrap/lib/compiler/ebin/beam_bsm.beam | Bin 13728 -> 13728 bytes bootstrap/lib/compiler/ebin/beam_clean.beam | Bin 11468 -> 11468 bytes bootstrap/lib/compiler/ebin/beam_dead.beam | Bin 11880 -> 11880 bytes bootstrap/lib/compiler/ebin/beam_dict.beam | Bin 5360 -> 5364 bytes bootstrap/lib/compiler/ebin/beam_disasm.beam | Bin 24968 -> 24968 bytes bootstrap/lib/compiler/ebin/beam_jump.beam | Bin 9516 -> 9516 bytes bootstrap/lib/compiler/ebin/beam_listing.beam | Bin 2904 -> 2904 bytes bootstrap/lib/compiler/ebin/beam_receive.beam | Bin 5832 -> 5832 bytes bootstrap/lib/compiler/ebin/beam_trim.beam | Bin 8568 -> 8568 bytes bootstrap/lib/compiler/ebin/beam_type.beam | Bin 13820 -> 13820 bytes bootstrap/lib/compiler/ebin/beam_utils.beam | Bin 14532 -> 14532 bytes bootstrap/lib/compiler/ebin/beam_validator.beam | Bin 34328 -> 34328 bytes bootstrap/lib/compiler/ebin/cerl_inline.beam | Bin 37300 -> 37300 bytes bootstrap/lib/compiler/ebin/cerl_trees.beam | Bin 18960 -> 18960 bytes bootstrap/lib/compiler/ebin/compile.beam | Bin 36920 -> 36920 bytes bootstrap/lib/compiler/ebin/core_lib.beam | Bin 5468 -> 5468 bytes bootstrap/lib/compiler/ebin/core_lint.beam | Bin 11632 -> 11632 bytes bootstrap/lib/compiler/ebin/core_pp.beam | Bin 12124 -> 12124 bytes bootstrap/lib/compiler/ebin/rec_env.beam | Bin 4780 -> 4780 bytes bootstrap/lib/compiler/ebin/sys_core_dsetel.beam | Bin 6996 -> 6996 bytes bootstrap/lib/compiler/ebin/sys_core_fold.beam | Bin 47520 -> 47520 bytes bootstrap/lib/compiler/ebin/sys_core_inline.beam | Bin 4212 -> 4212 bytes bootstrap/lib/compiler/ebin/sys_pre_expand.beam | Bin 16504 -> 16188 bytes bootstrap/lib/compiler/ebin/v3_codegen.beam | Bin 53752 -> 53752 bytes bootstrap/lib/compiler/ebin/v3_core.beam | Bin 50836 -> 50988 bytes bootstrap/lib/compiler/ebin/v3_kernel.beam | Bin 44748 -> 44604 bytes bootstrap/lib/compiler/ebin/v3_kernel_pp.beam | Bin 11828 -> 11828 bytes bootstrap/lib/compiler/ebin/v3_life.beam | Bin 23528 -> 23528 bytes bootstrap/lib/kernel/ebin/application.beam | Bin 2940 -> 3772 bytes .../lib/kernel/ebin/application_controller.beam | Bin 30684 -> 30684 bytes bootstrap/lib/kernel/ebin/application_master.beam | Bin 6352 -> 6352 bytes bootstrap/lib/kernel/ebin/code.beam | Bin 6732 -> 6732 bytes bootstrap/lib/kernel/ebin/code_server.beam | Bin 25956 -> 25956 bytes bootstrap/lib/kernel/ebin/disk_log.beam | Bin 36248 -> 36444 bytes bootstrap/lib/kernel/ebin/disk_log_server.beam | Bin 6408 -> 6408 bytes bootstrap/lib/kernel/ebin/dist_ac.beam | Bin 26708 -> 26708 bytes bootstrap/lib/kernel/ebin/erts_debug.beam | Bin 2808 -> 2808 bytes bootstrap/lib/kernel/ebin/file_io_server.beam | Bin 14196 -> 14196 bytes bootstrap/lib/kernel/ebin/file_server.beam | Bin 5124 -> 5124 bytes bootstrap/lib/kernel/ebin/global.beam | Bin 32236 -> 32236 bytes bootstrap/lib/kernel/ebin/global_group.beam | Bin 17728 -> 17728 bytes bootstrap/lib/kernel/ebin/group.beam | Bin 11776 -> 11776 bytes bootstrap/lib/kernel/ebin/hipe_unified_loader.beam | Bin 12540 -> 12540 bytes bootstrap/lib/kernel/ebin/inet.beam | Bin 19688 -> 19688 bytes bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam | Bin 6256 -> 6256 bytes bootstrap/lib/kernel/ebin/inet_config.beam | Bin 8192 -> 8192 bytes bootstrap/lib/kernel/ebin/inet_db.beam | Bin 26424 -> 26424 bytes bootstrap/lib/kernel/ebin/inet_gethost_native.beam | Bin 10500 -> 10500 bytes bootstrap/lib/kernel/ebin/inet_parse.beam | Bin 13056 -> 13056 bytes bootstrap/lib/kernel/ebin/inet_res.beam | Bin 14816 -> 14816 bytes bootstrap/lib/kernel/ebin/inet_tcp_dist.beam | Bin 6540 -> 6540 bytes bootstrap/lib/kernel/ebin/kernel_config.beam | Bin 2720 -> 2720 bytes bootstrap/lib/kernel/ebin/net_kernel.beam | Bin 22720 -> 22720 bytes bootstrap/lib/kernel/ebin/os.beam | Bin 5228 -> 5228 bytes bootstrap/lib/kernel/ebin/packages.beam | Bin 2244 -> 2244 bytes bootstrap/lib/kernel/ebin/pg2.beam | Bin 7696 -> 7696 bytes bootstrap/lib/kernel/ebin/rpc.beam | Bin 8748 -> 8748 bytes bootstrap/lib/kernel/ebin/standard_error.beam | Bin 3636 -> 3636 bytes bootstrap/lib/kernel/ebin/user.beam | Bin 12360 -> 12360 bytes bootstrap/lib/kernel/ebin/user_drv.beam | Bin 10084 -> 10308 bytes bootstrap/lib/stdlib/ebin/array.beam | Bin 12036 -> 12036 bytes bootstrap/lib/stdlib/ebin/beam_lib.beam | Bin 18220 -> 18220 bytes bootstrap/lib/stdlib/ebin/c.beam | Bin 13932 -> 13932 bytes bootstrap/lib/stdlib/ebin/dets.beam | Bin 53204 -> 53468 bytes bootstrap/lib/stdlib/ebin/dets_server.beam | Bin 7020 -> 7020 bytes bootstrap/lib/stdlib/ebin/dets_utils.beam | Bin 28864 -> 28864 bytes bootstrap/lib/stdlib/ebin/dets_v8.beam | Bin 27508 -> 27520 bytes bootstrap/lib/stdlib/ebin/dets_v9.beam | Bin 50272 -> 50104 bytes bootstrap/lib/stdlib/ebin/dict.beam | Bin 9140 -> 9140 bytes bootstrap/lib/stdlib/ebin/digraph.beam | Bin 8320 -> 8320 bytes bootstrap/lib/stdlib/ebin/digraph_utils.beam | Bin 6800 -> 6800 bytes bootstrap/lib/stdlib/ebin/epp.beam | Bin 24216 -> 24188 bytes bootstrap/lib/stdlib/ebin/erl_compile.beam | Bin 5076 -> 5076 bytes bootstrap/lib/stdlib/ebin/erl_eval.beam | Bin 23480 -> 23552 bytes bootstrap/lib/stdlib/ebin/erl_expand_records.beam | Bin 21812 -> 21812 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 84792 -> 84904 bytes bootstrap/lib/stdlib/ebin/erl_parse.beam | Bin 71068 -> 71496 bytes bootstrap/lib/stdlib/ebin/erl_pp.beam | Bin 23228 -> 23344 bytes bootstrap/lib/stdlib/ebin/erl_scan.beam | Bin 31776 -> 31776 bytes bootstrap/lib/stdlib/ebin/erl_tar.beam | Bin 15352 -> 15352 bytes bootstrap/lib/stdlib/ebin/escript.beam | Bin 17044 -> 17044 bytes bootstrap/lib/stdlib/ebin/ets.beam | Bin 20048 -> 20048 bytes bootstrap/lib/stdlib/ebin/file_sorter.beam | Bin 30608 -> 30608 bytes bootstrap/lib/stdlib/ebin/gen_event.beam | Bin 12900 -> 17412 bytes bootstrap/lib/stdlib/ebin/gen_fsm.beam | Bin 9412 -> 14764 bytes bootstrap/lib/stdlib/ebin/gen_server.beam | Bin 12508 -> 16780 bytes bootstrap/lib/stdlib/ebin/io_lib_pretty.beam | Bin 12372 -> 12372 bytes bootstrap/lib/stdlib/ebin/lib.beam | Bin 9072 -> 9072 bytes bootstrap/lib/stdlib/ebin/lists.beam | Bin 29204 -> 29204 bytes bootstrap/lib/stdlib/ebin/log_mf_h.beam | Bin 2644 -> 2644 bytes bootstrap/lib/stdlib/ebin/ms_transform.beam | Bin 20316 -> 20224 bytes bootstrap/lib/stdlib/ebin/orddict.beam | Bin 2748 -> 2748 bytes bootstrap/lib/stdlib/ebin/pool.beam | Bin 3848 -> 3848 bytes bootstrap/lib/stdlib/ebin/proc_lib.beam | Bin 9200 -> 9200 bytes bootstrap/lib/stdlib/ebin/qlc.beam | Bin 69344 -> 69376 bytes bootstrap/lib/stdlib/ebin/qlc_pt.beam | Bin 71592 -> 71592 bytes bootstrap/lib/stdlib/ebin/random.beam | Bin 1580 -> 1576 bytes bootstrap/lib/stdlib/ebin/re.beam | Bin 12376 -> 12376 bytes bootstrap/lib/stdlib/ebin/sets.beam | Bin 7020 -> 7020 bytes bootstrap/lib/stdlib/ebin/shell.beam | Bin 30568 -> 30568 bytes bootstrap/lib/stdlib/ebin/sofs.beam | Bin 41096 -> 41096 bytes bootstrap/lib/stdlib/ebin/supervisor.beam | Bin 18136 -> 21220 bytes bootstrap/lib/stdlib/ebin/supervisor_bridge.beam | Bin 1980 -> 2760 bytes bootstrap/lib/stdlib/ebin/sys.beam | Bin 7328 -> 7328 bytes bootstrap/lib/stdlib/ebin/timer.beam | Bin 5452 -> 5452 bytes bootstrap/lib/stdlib/ebin/unicode.beam | Bin 11552 -> 11552 bytes bootstrap/lib/stdlib/ebin/zip.beam | Bin 26824 -> 26824 bytes 110 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam index c14ccc2e7b..103ed82529 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_asm.beam and b/bootstrap/lib/compiler/ebin/beam_asm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam index 8983932f86..a5699221fe 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_block.beam and b/bootstrap/lib/compiler/ebin/beam_block.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam index e540fe227b..d8f91ec36d 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_bool.beam and b/bootstrap/lib/compiler/ebin/beam_bool.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam index bde0cff4cb..02f82a9341 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_bsm.beam and b/bootstrap/lib/compiler/ebin/beam_bsm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam index b902d84ffa..70523ca134 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_clean.beam and b/bootstrap/lib/compiler/ebin/beam_clean.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam index 449ce06f60..b177adb455 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_dead.beam and b/bootstrap/lib/compiler/ebin/beam_dead.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam index 2811a0e705..81e62b0a7d 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_dict.beam and b/bootstrap/lib/compiler/ebin/beam_dict.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam index 0d4f028d48..377c738709 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_disasm.beam and b/bootstrap/lib/compiler/ebin/beam_disasm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam index ea93fca2a0..f45b8d3124 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_jump.beam and b/bootstrap/lib/compiler/ebin/beam_jump.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_listing.beam b/bootstrap/lib/compiler/ebin/beam_listing.beam index f0503e4674..662edc0651 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_listing.beam and b/bootstrap/lib/compiler/ebin/beam_listing.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam index 0836e118c9..ae873a1082 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_receive.beam and b/bootstrap/lib/compiler/ebin/beam_receive.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam index 04d3416ef2..b1275f787a 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_trim.beam and b/bootstrap/lib/compiler/ebin/beam_trim.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam index e0a09eb146..67e6dbd8a1 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_type.beam and b/bootstrap/lib/compiler/ebin/beam_type.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam index a8bb6ec1a2..b80810bfb2 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_utils.beam and b/bootstrap/lib/compiler/ebin/beam_utils.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam index 02226a600a..211c56424e 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_validator.beam and b/bootstrap/lib/compiler/ebin/beam_validator.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam index e6f76ad0d4..582604e3cc 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_inline.beam and b/bootstrap/lib/compiler/ebin/cerl_inline.beam differ diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam index b2d79c924c..673954eaac 100644 Binary files a/bootstrap/lib/compiler/ebin/cerl_trees.beam and b/bootstrap/lib/compiler/ebin/cerl_trees.beam differ diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam index 4985e3d6da..bead5a1399 100644 Binary files a/bootstrap/lib/compiler/ebin/compile.beam and b/bootstrap/lib/compiler/ebin/compile.beam differ diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam index 2421df60bd..ddb5278d00 100644 Binary files a/bootstrap/lib/compiler/ebin/core_lib.beam and b/bootstrap/lib/compiler/ebin/core_lib.beam differ diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam index de6f3e5c25..225fa95aea 100644 Binary files a/bootstrap/lib/compiler/ebin/core_lint.beam and b/bootstrap/lib/compiler/ebin/core_lint.beam differ diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam index 9d812001b8..f1841d810b 100644 Binary files a/bootstrap/lib/compiler/ebin/core_pp.beam and b/bootstrap/lib/compiler/ebin/core_pp.beam differ diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam index c04176da61..91a86d9855 100644 Binary files a/bootstrap/lib/compiler/ebin/rec_env.beam and b/bootstrap/lib/compiler/ebin/rec_env.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam index 4a44c53aed..0764734cb1 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam and b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam index 2ed16cc07a..b07afc0938 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_fold.beam and b/bootstrap/lib/compiler/ebin/sys_core_fold.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam index 3d6f3103e0..5b9e9d7c3e 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_core_inline.beam and b/bootstrap/lib/compiler/ebin/sys_core_inline.beam differ diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam index 9d1629d9d4..12664c7270 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam and b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam index dbc5fb5e3a..3a8d68a611 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_codegen.beam and b/bootstrap/lib/compiler/ebin/v3_codegen.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam index 817938781d..ff7144c2bc 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_core.beam and b/bootstrap/lib/compiler/ebin/v3_core.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam index a52d44b32e..48b89b374b 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_kernel.beam and b/bootstrap/lib/compiler/ebin/v3_kernel.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam index 4bec626689..485aa63dcb 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam and b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_life.beam b/bootstrap/lib/compiler/ebin/v3_life.beam index d3ffc45a26..b7996884f4 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_life.beam and b/bootstrap/lib/compiler/ebin/v3_life.beam differ diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam index be05505c35..5bdfcefb87 100644 Binary files a/bootstrap/lib/kernel/ebin/application.beam and b/bootstrap/lib/kernel/ebin/application.beam differ diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam index 996836d78e..565691df01 100644 Binary files a/bootstrap/lib/kernel/ebin/application_controller.beam and b/bootstrap/lib/kernel/ebin/application_controller.beam differ diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam index 98bd12a42f..4d1098bcec 100644 Binary files a/bootstrap/lib/kernel/ebin/application_master.beam and b/bootstrap/lib/kernel/ebin/application_master.beam differ diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam index 580dc1f888..3d2bf91b93 100644 Binary files a/bootstrap/lib/kernel/ebin/code.beam and b/bootstrap/lib/kernel/ebin/code.beam differ diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam index 9ed647a94b..f0be53008b 100644 Binary files a/bootstrap/lib/kernel/ebin/code_server.beam and b/bootstrap/lib/kernel/ebin/code_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam index 15953c9931..cd01c579bf 100644 Binary files a/bootstrap/lib/kernel/ebin/disk_log.beam and b/bootstrap/lib/kernel/ebin/disk_log.beam differ diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam index 96c17f1586..39197f3995 100644 Binary files a/bootstrap/lib/kernel/ebin/disk_log_server.beam and b/bootstrap/lib/kernel/ebin/disk_log_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam index d20390087d..c86598a689 100644 Binary files a/bootstrap/lib/kernel/ebin/dist_ac.beam and b/bootstrap/lib/kernel/ebin/dist_ac.beam differ diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam index b812127f18..b7bf2ea58e 100644 Binary files a/bootstrap/lib/kernel/ebin/erts_debug.beam and b/bootstrap/lib/kernel/ebin/erts_debug.beam differ diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam index b35b96d8f0..3783cd7b11 100644 Binary files a/bootstrap/lib/kernel/ebin/file_io_server.beam and b/bootstrap/lib/kernel/ebin/file_io_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam index 71e2ad8c0d..7b03c3ea0d 100644 Binary files a/bootstrap/lib/kernel/ebin/file_server.beam and b/bootstrap/lib/kernel/ebin/file_server.beam differ diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam index a9e0e2c0d1..8049d8d729 100644 Binary files a/bootstrap/lib/kernel/ebin/global.beam and b/bootstrap/lib/kernel/ebin/global.beam differ diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam index c6fe47b456..f1e6fa219e 100644 Binary files a/bootstrap/lib/kernel/ebin/global_group.beam and b/bootstrap/lib/kernel/ebin/global_group.beam differ diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam index b8d55c4e29..67f78948d4 100644 Binary files a/bootstrap/lib/kernel/ebin/group.beam and b/bootstrap/lib/kernel/ebin/group.beam differ diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam index b638157e11..c4a1a850a7 100644 Binary files a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam and b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam index 0c4607063d..5a483c6265 100644 Binary files a/bootstrap/lib/kernel/ebin/inet.beam and b/bootstrap/lib/kernel/ebin/inet.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam index 145e039f7e..1bc785fa37 100644 Binary files a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam and b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam index d937ef4a7b..fc1e2c8387 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_config.beam and b/bootstrap/lib/kernel/ebin/inet_config.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam index ee3fbaa584..d2c636d21f 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_db.beam and b/bootstrap/lib/kernel/ebin/inet_db.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam index c53ecfb42a..4bf616ad46 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam and b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam index f8d3102da7..14ca272933 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_parse.beam and b/bootstrap/lib/kernel/ebin/inet_parse.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam index c0f00a0c12..9e8e9fa4de 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_res.beam and b/bootstrap/lib/kernel/ebin/inet_res.beam differ diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam index b382eebf92..22f2db4182 100644 Binary files a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam and b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam differ diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam index 40228eeeee..c5a63b6217 100644 Binary files a/bootstrap/lib/kernel/ebin/kernel_config.beam and b/bootstrap/lib/kernel/ebin/kernel_config.beam differ diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam index 8c8786eeb9..451d054667 100644 Binary files a/bootstrap/lib/kernel/ebin/net_kernel.beam and b/bootstrap/lib/kernel/ebin/net_kernel.beam differ diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam index df333e054e..1291f1cdfa 100644 Binary files a/bootstrap/lib/kernel/ebin/os.beam and b/bootstrap/lib/kernel/ebin/os.beam differ diff --git a/bootstrap/lib/kernel/ebin/packages.beam b/bootstrap/lib/kernel/ebin/packages.beam index c507624578..511c6a6e74 100644 Binary files a/bootstrap/lib/kernel/ebin/packages.beam and b/bootstrap/lib/kernel/ebin/packages.beam differ diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam index 4e6817fc97..439bbc24f2 100644 Binary files a/bootstrap/lib/kernel/ebin/pg2.beam and b/bootstrap/lib/kernel/ebin/pg2.beam differ diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam index 19391982e8..4355f300e9 100644 Binary files a/bootstrap/lib/kernel/ebin/rpc.beam and b/bootstrap/lib/kernel/ebin/rpc.beam differ diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam index e0232d9e54..f34c1a9bd1 100644 Binary files a/bootstrap/lib/kernel/ebin/standard_error.beam and b/bootstrap/lib/kernel/ebin/standard_error.beam differ diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam index df47a14304..6433bcf859 100644 Binary files a/bootstrap/lib/kernel/ebin/user.beam and b/bootstrap/lib/kernel/ebin/user.beam differ diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam index c2b4fef911..15b09a5f93 100644 Binary files a/bootstrap/lib/kernel/ebin/user_drv.beam and b/bootstrap/lib/kernel/ebin/user_drv.beam differ diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam index ea41ab7a42..8741e4d5df 100644 Binary files a/bootstrap/lib/stdlib/ebin/array.beam and b/bootstrap/lib/stdlib/ebin/array.beam differ diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam index 67a8554abe..b1f5baf3b8 100644 Binary files a/bootstrap/lib/stdlib/ebin/beam_lib.beam and b/bootstrap/lib/stdlib/ebin/beam_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam index bd37facf37..8c69197cbc 100644 Binary files a/bootstrap/lib/stdlib/ebin/c.beam and b/bootstrap/lib/stdlib/ebin/c.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam index b53a1357ff..47cc5e70bb 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets.beam and b/bootstrap/lib/stdlib/ebin/dets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam index c120ee12e3..d71185c9dd 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_server.beam and b/bootstrap/lib/stdlib/ebin/dets_server.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam index 0a9420daa2..a372faf6ac 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_utils.beam and b/bootstrap/lib/stdlib/ebin/dets_utils.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_v8.beam b/bootstrap/lib/stdlib/ebin/dets_v8.beam index 3ede6f8d47..a20f0469ce 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_v8.beam and b/bootstrap/lib/stdlib/ebin/dets_v8.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam index 1ac657a547..a52d126adf 100644 Binary files a/bootstrap/lib/stdlib/ebin/dets_v9.beam and b/bootstrap/lib/stdlib/ebin/dets_v9.beam differ diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam index c5676edc4a..35e67d6c59 100644 Binary files a/bootstrap/lib/stdlib/ebin/dict.beam and b/bootstrap/lib/stdlib/ebin/dict.beam differ diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam index 78814b1ad3..2c1788668d 100644 Binary files a/bootstrap/lib/stdlib/ebin/digraph.beam and b/bootstrap/lib/stdlib/ebin/digraph.beam differ diff --git a/bootstrap/lib/stdlib/ebin/digraph_utils.beam b/bootstrap/lib/stdlib/ebin/digraph_utils.beam index ac2c41d2b7..a578c67e00 100644 Binary files a/bootstrap/lib/stdlib/ebin/digraph_utils.beam and b/bootstrap/lib/stdlib/ebin/digraph_utils.beam differ diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam index d809fc21f6..0cc31bcac9 100644 Binary files a/bootstrap/lib/stdlib/ebin/epp.beam and b/bootstrap/lib/stdlib/ebin/epp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam index deb6b97657..1ce1d02ef0 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_compile.beam and b/bootstrap/lib/stdlib/ebin/erl_compile.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam index 6aff9793a6..3184aabc87 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_eval.beam and b/bootstrap/lib/stdlib/ebin/erl_eval.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam index a5431e7f04..c5c1d71941 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam and b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index c0c8cd7cdd..7b1eaf1f15 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index 097c378dbd..c026e8401f 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam index 4416e29c9f..2c32b68322 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_pp.beam and b/bootstrap/lib/stdlib/ebin/erl_pp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam index c331d61d21..b5e7c1c24e 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_scan.beam and b/bootstrap/lib/stdlib/ebin/erl_scan.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam index d9c3186502..9de0e978e3 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_tar.beam and b/bootstrap/lib/stdlib/ebin/erl_tar.beam differ diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam index ed0e6b0d66..18066abf53 100644 Binary files a/bootstrap/lib/stdlib/ebin/escript.beam and b/bootstrap/lib/stdlib/ebin/escript.beam differ diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam index bcd7a65cc8..8bc5103946 100644 Binary files a/bootstrap/lib/stdlib/ebin/ets.beam and b/bootstrap/lib/stdlib/ebin/ets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam index 95fba9495b..0c910821f6 100644 Binary files a/bootstrap/lib/stdlib/ebin/file_sorter.beam and b/bootstrap/lib/stdlib/ebin/file_sorter.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam index 8137fe9570..95188a534a 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_event.beam and b/bootstrap/lib/stdlib/ebin/gen_event.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam index 5f46d56d18..5ee3a82cb6 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_fsm.beam and b/bootstrap/lib/stdlib/ebin/gen_fsm.beam differ diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam index d5ab30b170..e37fa78649 100644 Binary files a/bootstrap/lib/stdlib/ebin/gen_server.beam and b/bootstrap/lib/stdlib/ebin/gen_server.beam differ diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam index ea2de10690..f7a239e18c 100644 Binary files a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam and b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam differ diff --git a/bootstrap/lib/stdlib/ebin/lib.beam b/bootstrap/lib/stdlib/ebin/lib.beam index f2f40ef868..5d44d3f8f1 100644 Binary files a/bootstrap/lib/stdlib/ebin/lib.beam and b/bootstrap/lib/stdlib/ebin/lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam index 3d422580e9..5e23551fb3 100644 Binary files a/bootstrap/lib/stdlib/ebin/lists.beam and b/bootstrap/lib/stdlib/ebin/lists.beam differ diff --git a/bootstrap/lib/stdlib/ebin/log_mf_h.beam b/bootstrap/lib/stdlib/ebin/log_mf_h.beam index 25a8d64b78..fdb417b71e 100644 Binary files a/bootstrap/lib/stdlib/ebin/log_mf_h.beam and b/bootstrap/lib/stdlib/ebin/log_mf_h.beam differ diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam index 1ca5210612..1af64e9d63 100644 Binary files a/bootstrap/lib/stdlib/ebin/ms_transform.beam and b/bootstrap/lib/stdlib/ebin/ms_transform.beam differ diff --git a/bootstrap/lib/stdlib/ebin/orddict.beam b/bootstrap/lib/stdlib/ebin/orddict.beam index 76245fcd5e..6892fd2c9e 100644 Binary files a/bootstrap/lib/stdlib/ebin/orddict.beam and b/bootstrap/lib/stdlib/ebin/orddict.beam differ diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam index 43c8763e8f..a16364e1d9 100644 Binary files a/bootstrap/lib/stdlib/ebin/pool.beam and b/bootstrap/lib/stdlib/ebin/pool.beam differ diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam index 704bd8a23d..6b5c081480 100644 Binary files a/bootstrap/lib/stdlib/ebin/proc_lib.beam and b/bootstrap/lib/stdlib/ebin/proc_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam index 4e1b8a80d1..1576557a09 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc.beam and b/bootstrap/lib/stdlib/ebin/qlc.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam index 805f63930b..805203b00e 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc_pt.beam and b/bootstrap/lib/stdlib/ebin/qlc_pt.beam differ diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam index 1ee81ea68e..9df28216b0 100644 Binary files a/bootstrap/lib/stdlib/ebin/random.beam and b/bootstrap/lib/stdlib/ebin/random.beam differ diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam index 22d753562d..85125291e9 100644 Binary files a/bootstrap/lib/stdlib/ebin/re.beam and b/bootstrap/lib/stdlib/ebin/re.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sets.beam b/bootstrap/lib/stdlib/ebin/sets.beam index a08222f3d3..5ac7691a8f 100644 Binary files a/bootstrap/lib/stdlib/ebin/sets.beam and b/bootstrap/lib/stdlib/ebin/sets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam index 50a60ed5b4..2a853ea58c 100644 Binary files a/bootstrap/lib/stdlib/ebin/shell.beam and b/bootstrap/lib/stdlib/ebin/shell.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam index b1bc6498a6..5d9b1bd6c0 100644 Binary files a/bootstrap/lib/stdlib/ebin/sofs.beam and b/bootstrap/lib/stdlib/ebin/sofs.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index 54ff535fc3..d1fe9e0cf5 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam index 2fa7bc7050..6480117b9e 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam and b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam differ diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam index 499d558dc0..724dfed4e6 100644 Binary files a/bootstrap/lib/stdlib/ebin/sys.beam and b/bootstrap/lib/stdlib/ebin/sys.beam differ diff --git a/bootstrap/lib/stdlib/ebin/timer.beam b/bootstrap/lib/stdlib/ebin/timer.beam index f60983e084..5f8f714a78 100644 Binary files a/bootstrap/lib/stdlib/ebin/timer.beam and b/bootstrap/lib/stdlib/ebin/timer.beam differ diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam index 28e3c03640..b560f13933 100644 Binary files a/bootstrap/lib/stdlib/ebin/unicode.beam and b/bootstrap/lib/stdlib/ebin/unicode.beam differ diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam index 59d4697510..051c688e73 100644 Binary files a/bootstrap/lib/stdlib/ebin/zip.beam and b/bootstrap/lib/stdlib/ebin/zip.beam differ -- cgit v1.2.3 From 3d5cdb216fa5652bd8552ef4fa4eee310e543b42 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 4 Sep 2011 09:27:50 +0200 Subject: Optimize filename:basename/1 to produce less garbage In most cases, we can simply return a tail of the flattened filename. --- lib/stdlib/src/filename.erl | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index b9665d7dec..2fc9128e4e 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -147,9 +147,10 @@ basename(Name) when is_binary(Name) -> end; basename(Name0) -> - Name = flatten(Name0), + Name1 = flatten(Name0), {DirSep2, DrvSep} = separators(), - basename1(skip_prefix(Name, DrvSep), [], DirSep2). + Name = skip_prefix(Name1, DrvSep), + basename1(Name, Name, DirSep2). win_basenameb(<>) when ?IS_DRIVELETTER(Letter) -> basenameb(Rest,[<<"/">>,<<"\\">>]); @@ -167,16 +168,18 @@ basenameb(Bin,Sep) -> -basename1([$/|[]], Tail, DirSep2) -> - basename1([], Tail, DirSep2); +basename1([$/], Tail0, _DirSep2) -> + %% End of filename -- must get rid of trailing directory separator. + [_|Tail] = lists:reverse(Tail0), + lists:reverse(Tail); basename1([$/|Rest], _Tail, DirSep2) -> - basename1(Rest, [], DirSep2); + basename1(Rest, Rest, DirSep2); basename1([DirSep2|Rest], Tail, DirSep2) when is_integer(DirSep2) -> basename1([$/|Rest], Tail, DirSep2); basename1([Char|Rest], Tail, DirSep2) when is_integer(Char) -> - basename1(Rest, [Char|Tail], DirSep2); + basename1(Rest, Tail, DirSep2); basename1([], Tail, _DirSep2) -> - lists:reverse(Tail). + Tail. skip_prefix(Name, false) -> Name; -- cgit v1.2.3 From 7e35f3585ae396b7e19a4a5d09f1b378806d523a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 15:39:56 +0100 Subject: erts: remove debug variables in beam_bp --- erts/emulator/beam/beam_bp.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 773baad01f..c90795c343 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -612,9 +612,13 @@ static void bp_hash_delete(bp_time_hash_t *hash) { static void bp_time_diff(bp_data_time_item_t *item, /* out */ process_breakpoint_time_t *pbt, /* in */ Uint ms, Uint s, Uint us) { - int dms,ds,dus; + int ds,dus; +#ifdef DEBUG + int dms; + dms = ms - pbt->ms; +#endif ds = s - pbt->s; dus = us - pbt->us; @@ -622,7 +626,9 @@ static void bp_time_diff(bp_data_time_item_t *item, /* out */ * this is ok. */ +#ifdef DEBUG ASSERT(dms >= 0 || ds >= 0 || dus >= 0); +#endif if (dus < 0) { dus += 1000000; -- cgit v1.2.3 From b37aca2a4ac3e79c39ab4dd588eda2b6bd77d311 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 15:41:27 +0100 Subject: erts: "initialized" is only used with CHLDWTHR --- erts/emulator/sys/unix/sys.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 82d2c64d81..94ec8dc8a0 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -2892,8 +2892,8 @@ smp_sig_notify(char c) static void * signal_dispatcher_thread_func(void *unused) { - int initialized = 0; #if !CHLDWTHR + int initialized = 0; int notify_check_children = 0; #endif #ifdef ERTS_ENABLE_LOCK_CHECK @@ -2933,8 +2933,8 @@ signal_dispatcher_thread_func(void *unused) */ switch (buf[i]) { case 0: /* Emulator initialized */ - initialized = 1; #if !CHLDWTHR + initialized = 1; if (!notify_check_children) #endif break; -- cgit v1.2.3 From 3a1e846e08b28fd38df5fa36c4b5ec13c420d1d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 15:44:37 +0100 Subject: erts: Remove unused variable in ttsl_drv --- erts/emulator/drivers/unix/ttsl_drv.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index d782b044a9..45d39a559f 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -242,7 +242,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) #ifndef HAVE_TERMCAP return ERL_DRV_ERROR_GENERAL; #else - char *s, *t, c, *l; + char *s, *t, *l; int canon, echo, sig; /* Terminal characteristics */ int flag; extern int using_oldshell; /* set this to let the rest of erts know */ @@ -262,7 +262,6 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) s++; /* Find end of this argument (start of next) and insert NUL. */ if ((t = strchr(s, ' '))) { - c = *t; *t = '\0'; } if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) { -- cgit v1.2.3 From 5e8fa1d015f87dcbf2e6b84d5cc4161478851f41 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 15:45:28 +0100 Subject: erts: Remove lock_check debug variables --- erts/emulator/beam/erl_process_lock.c | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 83379d7352..b4d20480c5 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -669,7 +669,9 @@ proc_safelock(Process *a_proc, ErtsProcLocks b_need_locks) { Process *p1, *p2; +#ifdef ERTS_ENABLE_LOCK_CHECK Eterm pid1, pid2; +#endif erts_pix_lock_t *pix_lck1, *pix_lck2; ErtsProcLocks need_locks1, have_locks1, need_locks2, have_locks2; ErtsProcLocks unlock_mask; @@ -684,24 +686,32 @@ proc_safelock(Process *a_proc, if (a_proc) { if (a_proc->id < b_proc->id) { p1 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = a_proc->id; +#endif pix_lck1 = a_pix_lck; need_locks1 = a_need_locks; have_locks1 = a_have_locks; p2 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = b_proc->id; +#endif pix_lck2 = b_pix_lck; need_locks2 = b_need_locks; have_locks2 = b_have_locks; } else if (a_proc->id > b_proc->id) { p1 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = b_proc->id; +#endif pix_lck1 = b_pix_lck; need_locks1 = b_need_locks; have_locks1 = b_have_locks; p2 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = a_proc->id; +#endif pix_lck2 = a_pix_lck; need_locks2 = a_need_locks; have_locks2 = a_have_locks; @@ -710,12 +720,16 @@ proc_safelock(Process *a_proc, ERTS_LC_ASSERT(a_proc == b_proc); ERTS_LC_ASSERT(a_proc->id == b_proc->id); p1 = a_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = a_proc->id; +#endif pix_lck1 = a_pix_lck; need_locks1 = a_need_locks | b_need_locks; have_locks1 = a_have_locks | b_have_locks; p2 = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = 0; +#endif pix_lck2 = NULL; need_locks2 = 0; have_locks2 = 0; @@ -723,12 +737,16 @@ proc_safelock(Process *a_proc, } else { p1 = b_proc; +#ifdef ERTS_ENABLE_LOCK_CHECK pid1 = b_proc->id; +#endif pix_lck1 = b_pix_lck; need_locks1 = b_need_locks; have_locks1 = b_have_locks; p2 = NULL; +#ifdef ERTS_ENABLE_LOCK_CHECK pid2 = 0; +#endif pix_lck2 = NULL; need_locks2 = 0; have_locks2 = 0; -- cgit v1.2.3 From 4ceec9775e33de5587ed31b3c1902825ad0a0996 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 15:47:26 +0100 Subject: erts: Remove dead code in efile_drv --- erts/emulator/drivers/common/efile_drv.c | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 68987b3493..52f1b5312b 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -2493,13 +2493,20 @@ file_flush(ErlDrvData e) { static int file_control(ErlDrvData e, unsigned int command, char* buf, int len, char **rbuf, int rlen) { + /* + * warning: variable ‘desc’ set but not used + * [-Wunused-but-set-variable] + * ... no kidding ... + * + * file_descriptor *desc = (file_descriptor *)e; switch (command) { default: return 0; - } /* switch (command) */ + } ASSERT(0); - desc = NULL; /* XXX Avoid warning while empty switch */ + desc = NULL; + */ return 0; } -- cgit v1.2.3 From 23e1f63738cef1a82e2dc18fe395ac208fdee5fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 15:54:39 +0100 Subject: erts: Remove debug variables in erl_db --- erts/emulator/beam/erl_db.c | 11 ++++++++++- erts/emulator/beam/erl_db_util.c | 7 ++++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 0327850cb9..ee6e1771d0 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1297,7 +1297,9 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) Uint32 status; Sint keypos; int is_named, is_fine_locked, frequent_read, is_compressed; +#ifdef DEBUG int cret; +#endif DeclareTmpHeap(meta_tuple,3,BIF_P); DbTableMethod* meth; erts_smp_rwmtx_t *mmtl; @@ -1445,7 +1447,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.fixations = NULL; tb->common.compress = is_compressed; - cret = meth->db_create(BIF_P, tb); +#ifdef DEBUG + cret = +#endif + meth->db_create(BIF_P, tb); ASSERT(cret == DB_ERROR_NONE); erts_smp_spin_lock(&meta_main_tab_main_lock); @@ -2606,7 +2611,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) int i; Eterm* hp; /*Process* rp = NULL;*/ + /* If/when we implement lockless private tables: Eterm owner; + */ if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) { @@ -2615,7 +2622,9 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } + /* If/when we implement lockless private tables: owner = tb->common.owner; + */ /* If/when we implement lockless private tables: if ((tb->common.status & DB_PRIVATE) && owner != BIF_P->id) { diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 7dfbb2ed02..42079a7cee 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2846,7 +2846,9 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) Uint new_sz = offset + db_size_dbterm_comp(tb, obj); byte* basep; DbTerm* newp; +#ifdef DEBUG byte* top; +#endif ASSERT(tb->compress); if (old != 0) { @@ -2868,7 +2870,10 @@ void* db_store_term_comp(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) } newp->size = size_object(obj); - top = copy_to_comp(tb, obj, newp, new_sz); +#ifdef DEBUG + top = +#endif + copy_to_comp(tb, obj, newp, new_sz); ASSERT(top <= basep + new_sz); /* ToDo: Maybe realloc if ((basep+new_sz) - top) > WASTED_SPACE_LIMIT */ -- cgit v1.2.3 From 7566b2afc2a3bd509ea0bf744e87770643ce3477 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 15:57:09 +0100 Subject: erts: Remove cp on exiting and trapping processes --- erts/emulator/beam/bif.c | 9 +++------ erts/emulator/beam/bif.h | 11 +++++++++++ 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 5b3261077b..76086860dd 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -4291,8 +4291,7 @@ void erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_data, ret); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_data, ret); } } @@ -4300,8 +4299,7 @@ void erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid) { if (skip_current_msgq(c_p)) { - Eterm unused; - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_reason, am_undefined); } } @@ -4316,7 +4314,6 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, { ASSERT(is_atom(module) && is_atom(function)); if (skip_current_msgq(c_p)) { - Eterm unused; Eterm term; Eterm *hp; int i; @@ -4328,7 +4325,7 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, hp += 2; } term = TUPLE3(hp, module, function, term); - ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_apply, term); + ERTS_BIF_PREP_TRAP3_NO_RET(await_proc_exit_trap, c_p, pid, am_apply, term); } } diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 8faa09feb8..66f152a6ea 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -160,6 +160,17 @@ do { \ (Ret) = THE_NON_VALUE; \ } while (0) +#define ERTS_BIF_PREP_TRAP3_NO_RET(Trap, Proc, A0, A1, A2)\ +do { \ + (Proc)->arity = 3; \ + (Proc)->def_arg_reg[0] = (Eterm) (A0); \ + (Proc)->def_arg_reg[1] = (Eterm) (A1); \ + (Proc)->def_arg_reg[2] = (Eterm) (A2); \ + *((UWord *) (UWord) ((Proc)->def_arg_reg + 3)) = (UWord) ((Trap)->address); \ + (Proc)->freason = TRAP; \ +} while (0) + + #define BIF_TRAP0(p, Trap_) do { \ (p)->arity = 0; \ *((UWord *) (UWord) ((p)->def_arg_reg + 3)) = (UWord) ((Trap_)->address); \ -- cgit v1.2.3 From 02d6b0770538dcb2f0be1755b6db2139498a47b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 15:59:16 +0100 Subject: erts: Remove debug variable in list_to_binary --- erts/emulator/beam/binary.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 1fb39c6c67..29461877c5 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -356,8 +356,10 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) { Eterm bin; Uint size; - int offset; byte* bytes; +#ifdef DEBUG + int offset; +#endif if (is_nil(arg)) { BIF_RET(new_binary(p,(byte*)"",0)); @@ -372,7 +374,11 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) } bin = new_binary(p, (byte *)NULL, size); bytes = binary_bytes(bin); - offset = io_list_to_buf(arg, (char*) bytes, size); +#ifdef DEBUG + offset = +#endif + io_list_to_buf(arg, (char*) bytes, size); + ASSERT(offset == 0); BIF_RET(bin); -- cgit v1.2.3 From 4e73d4bee3fd7744ebaf9f672a0ab5bc6528301f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 7 Nov 2011 16:01:21 +0100 Subject: erts: Remove unused variable in enif_make_binary --- erts/emulator/beam/erl_nif.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 51f1fad811..224931c3fb 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -681,6 +681,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ErlSubBin* sb; Eterm orig; Uint offset, bit_offset, bit_size; +#ifdef DEBUG unsigned src_size; ASSERT(is_binary(bin_term)); @@ -688,6 +689,7 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ASSERT(pos <= src_size); ASSERT(size <= src_size); ASSERT(pos + size <= src_size); +#endif sb = (ErlSubBin*) alloc_heap(env, ERL_SUB_BIN_SIZE); ERTS_GET_REAL_BIN(bin_term, orig, offset, bit_offset, bit_size); sb->thing_word = HEADER_SUB_BIN; -- cgit v1.2.3