aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/test
diff options
context:
space:
mode:
Diffstat (limited to 'lib/diameter/test')
-rw-r--r--lib/diameter/test/.gitignore3
-rw-r--r--lib/diameter/test/Makefile184
-rw-r--r--lib/diameter/test/depend.sed31
-rw-r--r--lib/diameter/test/diameter.cover6
-rw-r--r--lib/diameter/test/diameter.spec1
-rw-r--r--lib/diameter/test/diameter_app_SUITE.erl257
-rw-r--r--lib/diameter/test/diameter_codec_SUITE.erl76
-rw-r--r--lib/diameter/test/diameter_codec_test.erl500
-rw-r--r--lib/diameter/test/diameter_ct.erl55
-rw-r--r--lib/diameter/test/diameter_ct.hrl21
-rw-r--r--lib/diameter/test/diameter_dict_SUITE.erl151
-rw-r--r--lib/diameter/test/diameter_enum.erl406
-rw-r--r--lib/diameter/test/diameter_reg_SUITE.erl119
-rw-r--r--lib/diameter/test/diameter_relay_SUITE.erl415
-rw-r--r--lib/diameter/test/diameter_stats_SUITE.erl92
-rw-r--r--lib/diameter/test/diameter_sync_SUITE.erl139
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl779
-rw-r--r--lib/diameter/test/diameter_transport_SUITE.erl458
-rw-r--r--lib/diameter/test/diameter_util.erl177
-rw-r--r--lib/diameter/test/diameter_watchdog_SUITE.erl540
-rw-r--r--lib/diameter/test/modules.mk40
21 files changed, 4450 insertions, 0 deletions
diff --git a/lib/diameter/test/.gitignore b/lib/diameter/test/.gitignore
new file mode 100644
index 0000000000..df38dfc5e3
--- /dev/null
+++ b/lib/diameter/test/.gitignore
@@ -0,0 +1,3 @@
+
+/log
+/depend.mk
diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile
new file mode 100644
index 0000000000..dba1f126dc
--- /dev/null
+++ b/lib/diameter/test/Makefile
@@ -0,0 +1,184 @@
+#
+# %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%
+
+ifeq ($(ERL_TOP),)
+TOP = $(DIAMETER_TOP)
+else
+TOP = $(ERL_TOP)
+DIAMETER_TOP = $(TOP)/lib/diameter
+endif
+
+include $(TOP)/make/target.mk
+include $(TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+
+include ../vsn.mk
+
+VSN = $(DIAMETER_VSN)
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+
+RELSYSDIR = $(RELEASE_PATH)/diameter_test
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+include modules.mk
+
+EBIN = .
+
+HRL_FILES = $(INTERNAL_HRL_FILES)
+ERL_FILES = $(MODULES:%=%.erl)
+
+SOURCE = $(HRL_FILES) $(ERL_FILES)
+TARGET_FILES = $(MODULES:%=%.$(EMULATOR))
+
+SUITE_MODULES = $(filter diameter_%_SUITE, $(MODULES))
+SUITES = $(SUITE_MODULES:diameter_%_SUITE=%)
+
+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) \
+ -DDIAMETER_CT=true \
+ -I $(DIAMETER_TOP)/src/app
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+all: $(SUITES)
+
+tests debug opt: $(TARGET_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+ rm -f depend.mk
+
+realclean: clean
+ rm -rf log
+ rm -f errs core *~
+
+.PHONY: all tests debug opt clean realclean
+
+docs:
+
+info:
+ @echo "TARGET_FILES = $(TARGET_FILES)"
+ @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)"
+ @echo
+
+help:
+ @echo
+ @echo "Targets:"
+ @echo
+ @echo " all"
+ @echo " Run all test suites."
+ @echo
+ @echo " $(SUITES)"
+ @echo " Run a specific test suite."
+ @echo
+ @echo " tests"
+ @echo " Compile all test-code."
+ @echo
+ @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
+
+.PHONY: docs info help
+
+# ----------------------------------------------------
+# 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).
+$(SUITES): log tests
+ $(ERL) -noshell \
+ -pa $(DIAMETER_TOP)/ebin \
+ -sname diameter_test_$@ \
+ -s diameter_ct run diameter_$@_SUITE \
+ -s init stop \
+ | awk '1{rc=0} {print} / FAILED /{rc=1} END{exit rc}'
+# Shorter in sed but requires a GNU extension (ie. Q).
+
+log:
+ mkdir $@
+
+.PHONY: $(SUITES)
+
+# ----------------------------------------------------
+# Release Targets
+# ----------------------------------------------------
+
+include $(TOP)/make/otp_release_targets.mk
+
+release_spec:
+
+release_docs_spec:
+
+release_tests_spec:
+ $(INSTALL_DIR) $(RELSYSDIR)
+ $(INSTALL_DATA) $(RELTEST_FILES) $(RELSYSDIR)
+
+.PHONY: release_spec release_docs_spec release_test_specs
+
+# ----------------------------------------------------
+
+depend: depend.mk
+
+# Generate dependencies makefile.
+depend.mk: depend.sed $(MODULES:%=%.erl) Makefile
+ (for f in $(MODULES); do \
+ sed -f $< $$f.erl | sed "s@/@/$$f@"; \
+ done) \
+ > $@
+
+-include depend.mk
+
+.PHONY: depend
diff --git a/lib/diameter/test/depend.sed b/lib/diameter/test/depend.sed
new file mode 100644
index 0000000000..a399eb45f0
--- /dev/null
+++ b/lib/diameter/test/depend.sed
@@ -0,0 +1,31 @@
+#
+# %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 local include dependencies from .erl files. The output is massaged
+# further in Makefile.
+#
+
+/^-include/!d
+/^-include_lib/d
+/diameter_gen/d
+
+s@^-include("@@
+s@".*@@
+s@^@$(EBIN)/.$(EMULATOR): @
diff --git a/lib/diameter/test/diameter.cover b/lib/diameter/test/diameter.cover
new file mode 100644
index 0000000000..5fde6c7d01
--- /dev/null
+++ b/lib/diameter/test/diameter.cover
@@ -0,0 +1,6 @@
+%% -*- erlang -*-
+{exclude,
+ [
+ ]
+}.
+
diff --git a/lib/diameter/test/diameter.spec b/lib/diameter/test/diameter.spec
new file mode 100644
index 0000000000..fae7863bec
--- /dev/null
+++ b/lib/diameter/test/diameter.spec
@@ -0,0 +1 @@
+{suites, "../diameter_test", all}.
diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl
new file mode 100644
index 0000000000..104785b4e6
--- /dev/null
+++ b/lib/diameter/test/diameter_app_SUITE.erl
@@ -0,0 +1,257 @@
+%%
+%% %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 based on the contents of the diameter app file.
+%%
+
+-module(diameter_app_SUITE).
+
+-export([suite/0,
+ all/0,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([keys/1,
+ vsn/1,
+ modules/1,
+ exports/1,
+ release/1,
+ xref/1,
+ relup/1]).
+
+-include("diameter_ct.hrl").
+
+-define(A, list_to_atom).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [keys,
+ vsn,
+ modules,
+ exports,
+ release,
+ xref,
+ relup].
+
+init_per_suite(Config) ->
+ [{application, ?APP, App}] = diameter_util:consult(?APP, app),
+ [{app, App} | Config].
+
+end_per_suite(_Config) ->
+ ok.
+
+%% ===========================================================================
+%% # keys/1
+%%
+%% Ensure that the app file contains selected keys. Some of these would
+%% also be caught by other testcases.
+%% ===========================================================================
+
+keys(Config) ->
+ App = fetch(app, Config),
+ [] = lists:filter(fun(K) -> not lists:keymember(K, 1, App) end,
+ [vsn, description, modules, registered, applications]).
+
+%% ===========================================================================
+%% # vsn/1
+%%
+%% Ensure that our app version sticks to convention.
+%% ===========================================================================
+
+vsn(Config) ->
+ true = is_vsn(fetch(vsn, fetch(app, Config))).
+
+%% ===========================================================================
+%% # modules/1
+%%
+%% Ensure that the app file modules and installed modules differ by
+%% compiler/help modules.
+%% ===========================================================================
+
+modules(Config) ->
+ Mods = fetch(modules, fetch(app, Config)),
+ Installed = code_mods(),
+ Help = [diameter_callback,
+ diameter_codegen,
+ diameter_dbg,
+ diameter_exprecs,
+ diameter_info,
+ diameter_spec_scan,
+ diameter_spec_util],
+ {[], Help} = {Mods -- Installed, lists:sort(Installed -- Mods)}.
+
+code_mods() ->
+ Dir = code:lib_dir(?APP, ebin),
+ {ok, Files} = file:list_dir(Dir),
+ [?A(lists:reverse(R)) || N <- Files, "maeb." ++ R <- [lists:reverse(N)]].
+
+%% ===========================================================================
+%% # exports/1
+%%
+%% Ensure that no module does export_all.
+%% ===========================================================================
+
+exports(Config) ->
+ Mods = fetch(modules, fetch(app, Config)),
+ [] = [M || M <- Mods, exports_all(M)].
+
+exports_all(Mod) ->
+ Opts = fetch(options, Mod:module_info(compile)),
+
+ is_list(Opts) andalso lists:member(export_all, Opts).
+
+%% ===========================================================================
+%% # release/1
+%%
+%% Ensure that it's possible to build a minimal release with our app file.
+%% ===========================================================================
+
+release(Config) ->
+ App = fetch(app, Config),
+ Rel = {release,
+ {"diameter test release", fetch(vsn, App)},
+ {erts, erlang:system_info(version)},
+ [{A, appvsn(A)} || A <- fetch(applications, App)]},
+ Dir = fetch(priv_dir, Config),
+ ok = write_file(filename:join([Dir, "diameter_test.rel"]), Rel),
+ {ok, _, []} = systools:make_script("diameter_test", [{path, [Dir]},
+ {outdir, Dir},
+ silent]).
+
+appvsn(Name) ->
+ [{application, Name, App}] = diameter_util:consult(Name, app),
+ fetch(vsn, App).
+
+%% ===========================================================================
+%% # xref/1
+%%
+%% Ensure that no function in our application calls an undefined function.
+%% ===========================================================================
+
+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.
+
+ {ok, XRef} = xref:start(make_name(xref_test_name)),
+ ok = xref:set_default(XRef, [{verbose, false}, {warnings, false}]),
+
+ %% Only add our application and those it's dependent on according
+ %% to the app file. Well, almost. erts beams are also required to
+ %% 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.
+ ok = lists:foreach(fun(A) -> add_application(XRef, A) end,
+ [?APP, erts | fetch(applications, App)]),
+
+ {ok, Undefs} = xref:analyze(XRef, undefined_function_calls),
+
+ xref:stop(XRef),
+
+ %% Only care about calls from our own application.
+ [] = lists:filter(fun({{M,_,_},_}) -> lists:member(M, Mods) end, Undefs).
+
+add_application(XRef, App) ->
+ add_application(XRef, App, code:lib_dir(App)).
+
+%% erts will not be in the lib directory before installation.
+add_application(XRef, erts, {error, _}) ->
+ Dir = filename:join([code:root_dir(), "erts", "preloaded", "ebin"]),
+ {ok, _} = xref:add_directory(XRef, Dir, []);
+add_application(XRef, App, Dir)
+ when is_list(Dir) ->
+ {ok, App} = xref:add_application(XRef, Dir, []).
+
+make_name(Suf) ->
+ list_to_atom(atom_to_list(?APP) ++ "_" ++ atom_to_list(Suf)).
+
+%% ===========================================================================
+%% # relup/1
+%%
+%% Ensure that we can generate release upgrade files using our appup file.
+%% ===========================================================================
+
+relup(Config) ->
+ [{Vsn, Up, Down}] = diameter_util:consult(?APP, appup),
+ true = is_vsn(Vsn),
+
+ App = fetch(app, Config),
+ Rel = [{erts, erlang:system_info(version)}
+ | [{A, appvsn(A)} || A <- fetch(applications, App)]],
+
+ Dir = fetch(priv_dir, Config),
+
+ Name = write_rel(Dir, Rel, Vsn),
+ UpFrom = acc_rel(Dir, Rel, Up),
+ DownTo = acc_rel(Dir, Rel, Down),
+
+ {[Name], [Name], UpFrom, DownTo} %% no intersections
+ = {[Name] -- UpFrom,
+ [Name] -- DownTo,
+ UpFrom -- DownTo,
+ DownTo -- UpFrom},
+
+ {ok, _, _, []} = systools:make_relup(Name, UpFrom, DownTo, [{path, [Dir]},
+ {outdir, Dir},
+ silent]).
+
+acc_rel(Dir, Rel, List) ->
+ lists:foldl(fun(T,A) -> acc_rel(Dir, Rel, T, A) end,
+ [],
+ List).
+
+acc_rel(Dir, Rel, {Vsn, _}, Acc) ->
+ [write_rel(Dir, Rel, Vsn) | Acc].
+
+%% Write a rel file and return its name.
+write_rel(Dir, [Erts | Apps], Vsn) ->
+ true = is_vsn(Vsn),
+ Name = "diameter_test_" ++ Vsn,
+ ok = write_file(filename:join([Dir, Name ++ ".rel"]),
+ {release,
+ {"diameter " ++ Vsn ++ " test release", Vsn},
+ Erts,
+ Apps}),
+ Name.
+
+%% ===========================================================================
+%% ===========================================================================
+
+fetch(Key, List) ->
+ {Key, {Key, Val}} = {Key, lists:keyfind(Key, 1, List)}, %% useful badmatch
+ Val.
+
+write_file(Path, T) ->
+ file:write_file(Path, io_lib:format("~p.", [T])).
+
+%% Is a version string of the expected form? Return the argument
+%% itself for 'false' for a useful badmatch.
+is_vsn(V) ->
+ is_list(V)
+ andalso length(V) == string:span(V, "0123456789.")
+ andalso V == string:join(string:tokens(V, [$.]), ".") %% no ".."
+ orelse {error, V}.
diff --git a/lib/diameter/test/diameter_codec_SUITE.erl b/lib/diameter/test/diameter_codec_SUITE.erl
new file mode 100644
index 0000000000..30c60be8e9
--- /dev/null
+++ b/lib/diameter/test/diameter_codec_SUITE.erl
@@ -0,0 +1,76 @@
+%%
+%% %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%
+%%
+
+%%
+%% Test encode/decode of dictionary-related modules. Each test case
+%% runs multiple tests in parallel since many of the tests are just
+%% the same code with different in-data: implementing each test as a
+%% single testcase would make for much duplication with ct's current
+%% requirement of one function per testcase.
+%%
+
+-module(diameter_codec_SUITE).
+
+-export([suite/0,
+ all/0,
+ init_per_testcase/2,
+ end_per_testcase/2]).
+
+%% testcases
+-export([base/1,
+ gen/1,
+ lib/1]).
+
+-include("diameter_ct.hrl").
+
+-define(L, atom_to_list).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [base, gen, lib].
+
+init_per_testcase(gen, Config) ->
+ [{application, ?APP, App}] = diameter_util:consult(?APP, app),
+ {modules, Ms} = lists:keyfind(modules, 1, App),
+ [_|_] = Gs = lists:filter(fun(M) ->
+ lists:prefix("diameter_gen_", ?L(M))
+ end,
+ Ms),
+ [{dicts, Gs} | Config];
+
+init_per_testcase(_Name, Config) ->
+ Config.
+
+end_per_testcase(_, _) ->
+ ok.
+
+%% ===========================================================================
+
+base(_Config) ->
+ diameter_codec_test:base().
+
+gen([{dicts, Ms} | _]) ->
+ lists:foreach(fun diameter_codec_test:gen/1, Ms).
+
+lib(_Config) ->
+ diameter_codec_test:lib().
diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl
new file mode 100644
index 0000000000..aab7ab35cc
--- /dev/null
+++ b/lib/diameter/test/diameter_codec_test.erl
@@ -0,0 +1,500 @@
+%%
+%% %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_test).
+
+-compile(export_all).
+
+%%
+%% Test encode/decode of dictionary-related modules.
+%%
+
+-include_lib("diameter/include/diameter.hrl").
+
+-define(BASE, diameter_gen_base_rfc3588).
+-define(BOOL, [true, false]).
+
+%% ===========================================================================
+%% Interface.
+
+base() ->
+ [] = run([{?MODULE, [base, T]} || T <- [zero, decode]]).
+
+gen(Mod) ->
+ Fs = [{Mod, F, []} || F <- [name, id, vendor_id, vendor_name]],
+ [] = run(Fs ++ [{?MODULE, [gen, Mod, T]} || T <- [messages,
+ command_codes,
+ avp_types,
+ grouped,
+ enums,
+ import_avps,
+ import_groups,
+ import_enums]]).
+
+lib() ->
+ Vs = {_,_} = values('Address'),
+ [] = run([[fun lib/2, N, Vs] || N <- [1,2]]).
+
+%% ===========================================================================
+%% Internal functions.
+
+lib(N, {_,_} = T) ->
+ B = 1 == N rem 2,
+ [] = run([[fun lib/2, A, B] || A <- element(N,T)]);
+
+lib(IP, B) ->
+ LA = tuple_to_list(IP),
+ {SA,Fun} = ip(LA),
+ [] = run([[fun lib/4, IP, B, Fun, A] || A <- [IP, LA, SA]]).
+
+lib(IP, B, Fun, A) ->
+ try Fun(A) of
+ IP when B ->
+ ok
+ catch
+ error:_ when not B ->
+ ok
+ end.
+
+ip([_,_,_,_] = A) ->
+ [$.|S] = lists:append(["." ++ integer_to_list(N) || N <- A]),
+ {S, fun diameter_lib:ip4address/1};
+ip([_,_,_,_,_,_,_,_] = A) ->
+ [$:|S] = lists:flatten([":" ++ io_lib:format("~.16B", [N]) || N <- A]),
+ {S, fun diameter_lib:ip6address/1}.
+
+%% ------------------------------------------------------------------------
+%% base/1
+%%
+%% Test of diameter_types.
+%% ------------------------------------------------------------------------
+
+base(T) ->
+ [] = run([{?MODULE, [base, T, F]} || F <- types()]).
+
+%% Ensure that 'zero' values encode only zeros.
+base(zero = T, F) ->
+ B = diameter_types:F(encode, T),
+ B = z(B);
+
+%% Ensure that we can decode what we encode and vice-versa, and that
+%% we can't decode invalid values.
+base(decode, F) ->
+ {Eq, Vs, Ns} = b(values(F)),
+ [] = run([{?MODULE, [base_decode, F, Eq, V]} || V <- Vs]),
+ [] = run([{?MODULE, [base_invalid, F, Eq, V]} || V <- Ns]).
+
+base_decode(F, Eq, Value) ->
+ d(fun(X,V) -> diameter_types:F(X,V) end, Eq, Value).
+
+base_invalid(F, Eq, Value) ->
+ try
+ base_decode(F, Eq, Value),
+ exit(nok)
+ catch
+ error: _ ->
+ ok
+ end.
+
+b({_,_,_} = T) ->
+ T;
+b({B,Vs})
+ when is_atom(B) ->
+ {B,Vs,[]};
+b({Vs,Ns}) ->
+ {true, Vs, Ns};
+b(Vs) ->
+ {true, Vs, []}.
+
+types() ->
+ [F || {F,2} <- diameter_types:module_info(exports)].
+
+%% ------------------------------------------------------------------------
+%% gen/2
+%%
+%% Test of generated encode/decode module.
+%% ------------------------------------------------------------------------
+
+gen(M, T) ->
+ [] = run(lists:map(fun(X) -> {?MODULE, [gen, M, T, X]} end,
+ fetch(T, M:dict()))).
+
+fetch(T, Spec) ->
+ case orddict:find(T, Spec) of
+ {ok, L} ->
+ L;
+ error ->
+ []
+ end.
+
+gen(M, messages, {Name, Code, Flags, _, _}) ->
+ Rname = M:msg2rec(Name),
+ Name = M:rec2msg(Rname),
+ {Code, F, _} = M:msg_header(Name),
+ 0 = F band 2#00001111,
+ Name = case M:msg_name(Code, lists:member('REQ', Flags)) of
+ N when Name /= 'answer-message' ->
+ N;
+ '' when Name == 'answer-message', M == ?BASE ->
+ Name
+ end,
+ [] = arity(M, Name, Rname);
+
+gen(M, command_codes = T, {Code, {Req, Abbr}, Ans}) ->
+ Rname = M:msg2rec(Req),
+ Rname = M:msg2rec(Abbr),
+ gen(M, T, {Code, Req, Ans});
+
+gen(M, command_codes = T, {Code, Req, {Ans, Abbr}}) ->
+ Rname = M:msg2rec(Ans),
+ Rname = M:msg2rec(Abbr),
+ gen(M, T, {Code, Req, Ans});
+
+gen(M, command_codes, {Code, Req, Ans}) ->
+ Msgs = orddict:fetch(messages, M:dict()),
+ {_, Code, _, _, _} = lists:keyfind(Req, 1, Msgs),
+ {_, Code, _, _, _} = lists:keyfind(Ans, 1, Msgs);
+
+gen(M, avp_types, {Name, Code, Type, _Flags, _Encr}) ->
+ {Code, Flags, VendorId} = M:avp_header(Name),
+ 0 = Flags band 2#00011111,
+ V = undefined /= VendorId,
+ V = 0 /= Flags band 2#10000000,
+ {Name, Type} = M:avp_name(Code, VendorId),
+ B = M:empty_value(Name),
+ B = z(B),
+ [] = avp_decode(M, Type, Name);
+
+gen(M, grouped, {Name, _, _, _}) ->
+ Rname = M:name2rec(Name),
+ [] = arity(M, Name, Rname);
+
+gen(M, enums, {Name, ED}) ->
+ [] = run([{?MODULE, [enum, M, Name, T]} || T <- ED]);
+
+gen(M, Tag, {_Mod, L}) ->
+ T = retag(Tag),
+ [] = run([{?MODULE, [gen, M, T, I]} || I <- L]).
+
+%% avp_decode/3
+
+avp_decode(Mod, Type, Name) ->
+ {Eq, Vs, _} = b(values(Type, Name, Mod)),
+ [] = run([{?MODULE, [avp_decode, Mod, Name, Type, Eq, V]}
+ || V <- v(Vs)]).
+
+avp_decode(Mod, Name, Type, Eq, Value) ->
+ d(fun(X,V) -> avp(Mod, X, V, Name, Type) end, Eq, Value).
+
+avp(Mod, decode = X, V, Name, 'Grouped') ->
+ {Rec, _} = Mod:avp(X, V, Name),
+ Rec;
+avp(Mod, X, V, Name, _) ->
+ Mod:avp(X, V, Name).
+
+%% v/1
+
+%% List of values ...
+v(Vs)
+ when is_list(Vs) ->
+ Vs;
+
+%% .. or enumeration for grouped avps. This could be quite large
+%% (millions of values) but since the avps are also tested
+%% individually don't bother trying everything. Instead, choose a
+%% reasonable number of values at random.
+v(E) ->
+ v(2000, E(0), E).
+
+v(Max, Ord, E)
+ when Ord =< Max ->
+ diameter_enum:to_list(E);
+v(Max, Ord, E) ->
+ {M,S,U} = now(),
+ random:seed(M,S,U),
+ v(Max, Ord, E, []).
+
+v(0, _, _, Acc) ->
+ Acc;
+v(N, Ord, E, Acc) ->
+ v(N-1, Ord, E, [E(random:uniform(Ord)) | Acc]).
+
+%% arity/3
+
+arity(M, Name, Rname) ->
+ Rec = M:'#new-'(Rname),
+ [] = run([{?MODULE, [arity, M, Name, F, Rec]}
+ || F <- M:'#info-'(Rname, fields)]).
+
+arity(M, Name, AvpName, Rec) ->
+ Def = M:'#get-'(AvpName, Rec),
+ Def = case M:avp_arity(Name, AvpName) of
+ 1 ->
+ undefined;
+ A when 0 /= A ->
+ []
+ end.
+
+%% enum/3
+
+enum(M, Name, {E,_}) ->
+ B = <<E:32/integer>>,
+ B = M:avp(encode, E, Name),
+ E = M:avp(decode, B, Name).
+
+retag(import_avps) -> avp_types;
+retag(import_groups) -> grouped;
+retag(import_enums) -> enums;
+
+retag(avp_types) -> import_avps;
+retag(enums) -> import_enums.
+
+%% ===========================================================================
+
+d(F, Eq, V) ->
+ B = F(encode, V),
+ D = F(decode, B),
+ V = if Eq -> %% test for value equality ...
+ D;
+ true -> %% ... or that encode/decode is idempotent
+ D = F(decode, F(encode, D)),
+ V
+ end.
+
+z(B) ->
+ << <<0>> || <<_>> <= B >>.
+
+%% values/1
+%%
+%% Return a list of base type values. Can also be wrapped in a tuple
+%% with 'false' to indicate that encode followed by decode may not be
+%% the identity map. (Although that this composition is idempotent is
+%% tested.)
+
+values('OctetString' = T) ->
+ {["", atom_to_list(T)], [-1, 256]};
+
+values('Integer32') ->
+ Mx = (1 bsl 31) - 1,
+ Mn = -1*Mx,
+ {[Mn, 0, random(Mn,Mx), Mx], [Mn - 1, Mx + 1]};
+
+values('Integer64') ->
+ Mx = (1 bsl 63) - 1,
+ Mn = -1*Mx,
+ {[Mn, 0, random(Mn,Mx), Mx], [Mn - 1, Mx + 1]};
+
+values('Unsigned32') ->
+ M = (1 bsl 32) - 1,
+ {[0, random(M), M], [-1, M + 1]};
+
+values('Unsigned64') ->
+ M = (1 bsl 64) - 1,
+ {[0, random(M), M], [-1, M + 1]};
+
+values('Float32') ->
+ E = (1 bsl 8) - 2,
+ F = (1 bsl 23) - 1,
+ <<Mx:32/float>> = <<0:1/integer, E:8/integer, F:23/integer>>,
+ <<Mn:32/float>> = <<1:1/integer, E:8/integer, F:23/integer>>,
+ {[0.0, infinity, '-infinity', Mx, Mn], [0]};
+
+values('Float64') ->
+ E = (1 bsl 11) - 2,
+ F = (1 bsl 52) - 1,
+ <<Mx:64/float>> = <<0:1/integer, E:11/integer, F:52/integer>>,
+ <<Mn:64/float>> = <<1:1/integer, E:11/integer, F:52/integer>>,
+ {[0.0, infinity, '-infinity', Mx, Mn], [0]};
+
+values('Address') ->
+ {[{255,0,random(16#FF),1}, {65535,0,0,random(16#FFFF),0,0,0,1}],
+ [{256,0,0,1}, {65536,0,0,0,0,0,0,1}]};
+
+values('DiameterIdentity') ->
+ {["x", "diameter.com"], [""]};
+
+values('DiameterURI') ->
+ {false, ["aaa" ++ S ++ "://diameter.se" ++ P ++ Tr ++ Pr
+ || S <- ["", "s"],
+ P <- ["", ":1234"],
+ Tr <- ["" | [";transport=" ++ X
+ || X <- ["tcp", "sctp", "udp"]]],
+ Pr <- ["" | [";protocol=" ++ X
+ || X <- ["diameter","radius","tacacs+"]]]]};
+
+values(T)
+ when T == 'IPFilterRule';
+ T == 'QoSFilterRule' ->
+ ["deny in 0 from 127.0.0.1 to 10.0.0.1"];
+
+%% RFC 3629 defines the UTF-8 encoding of U+0000 through U+10FFFF with the
+%% exception of U+D800 through U+DFFF.
+values('UTF8String') ->
+ {[[],
+ lists:seq(0,16#1FF),
+ [0,16#D7FF,16#E000,16#10FFFF],
+ [random(16#D7FF), random(16#E000,16#10FFFF)]],
+ [[-1],
+ [16#D800],
+ [16#DFFF],
+ [16#110000]]};
+
+values('Time') ->
+ {[{{1968,1,20},{3,14,8}}, %% 19000101T000000 + 1 bsl 31
+ {date(), time()},
+ {{2036,2,7},{6,28,15}},
+ {{2036,2,7},{6,28,16}}, %% 19000101T000000 + 2 bsl 31
+ {{2104,2,26},{9,42,23}}],
+ [{{1968,1,20},{3,14,7}},
+ {{2104,2,26},{9,42,24}}]}. %% 19000101T000000 + 3 bsl 31
+
+%% values/3
+%%
+%% Return list or enumerations of values for a given AVP. Can be
+%% wrapped as for values/1.
+
+values('Enumerated', Name, Mod) ->
+ {_Name, Vals} = lists:keyfind(Name, 1, types(enums, Mod)),
+ lists:map(fun({N,_}) -> N end, Vals);
+
+values('Grouped', Name, Mod) ->
+ Rname = Mod:name2rec(Name),
+ Rec = Mod:'#new-'(Rname),
+ Avps = Mod:'#info-'(Rname, fields),
+ Enum = diameter_enum:combine(lists:map(fun({_,Vs,_}) -> to_enum(Vs) end,
+ [values(F, Mod) || F <- Avps])),
+ {false, diameter_enum:append(group(Mod, Name, Rec, Avps, Enum))};
+
+values(_, 'Framed-IP-Address', _) ->
+ [{127,0,0,1}];
+
+values(Type, _, _) ->
+ values(Type).
+
+to_enum(Vs)
+ when is_list(Vs) ->
+ diameter_enum:new(Vs);
+to_enum(E) ->
+ E.
+
+%% values/2
+
+values('AVP', _) ->
+ {true, [#diameter_avp{code = 0, data = <<0>>}], []};
+
+values(Name, Mod) ->
+ Avps = types(avp_types, Mod),
+ {Name, _Code, Type, _Flags, _Encr} = lists:keyfind(Name, 1, Avps),
+ b(values(Type, Name, Mod)).
+
+%% group/5
+%%
+%% Pack four variants of group values: tagged list containing all
+%% values, the corresponding record, a minimal tagged list and the
+%% coresponding record.
+
+group(Mod, Name, Rec, Avps, Enum) ->
+ lists:map(fun(B) -> group(Mod, Name, Rec, Avps, Enum, B) end,
+ [{A,R} || A <- ?BOOL, R <- ?BOOL]).
+
+group(Mod, Name, Rec, Avps, Enum, B) ->
+ diameter_enum:map(fun(Vs) -> g(Mod, Name, Rec, Avps, Vs, B) end, Enum).
+
+g(Mod, Name, Rec, Avps, Values, {All, AsRec}) ->
+ {Tagged, []}
+ = lists:foldl(fun(N, {A, [V|Vs]}) ->
+ {pack(All, Mod:avp_arity(Name, N), N, V, A), Vs}
+ end,
+ {[], Values},
+ Avps),
+ g(AsRec, Mod, Tagged, Rec).
+
+g(true, Mod, Vals, Rec) ->
+ Mod:'#set-'(Vals, Rec);
+g(false, _, Vals, _) ->
+ Vals.
+
+pack(true, Arity, Avp, Value, Acc) ->
+ [all(Arity, Avp, Value) | Acc];
+pack(false, Arity, Avp, Value, Acc) ->
+ min(Arity, Avp, Value, Acc).
+
+all(Mod, Name, Avp, V) ->
+ all(Mod:avp_arity(Name, Avp), Avp, V).
+
+all(1, Avp, V) ->
+ {Avp, V};
+all({0,'*'}, Avp, V) ->
+ a(1, Avp, V);
+all({N,'*'}, Avp, V) ->
+ a(N, Avp, V);
+all({_,N}, Avp, V) ->
+ a(N, Avp, V).
+
+a(N, Avp, V)
+ when N /= 0 ->
+ {Avp, lists:duplicate(N,V)}.
+
+min(Mod, Name, Avp, V, Acc) ->
+ min(Mod:avp_arity(Name, Avp), Avp, V, Acc).
+
+min(1, Avp, V, Acc) ->
+ [{Avp, V} | Acc];
+min({0,_}, _, _, Acc) ->
+ Acc;
+min({N,_}, Avp, V, Acc) ->
+ [{Avp, lists:duplicate(N,V)} | Acc].
+
+%% types/2
+
+types(T, Mod) ->
+ types(T, retag(T), Mod).
+
+types(T, IT, Mod) ->
+ Dict = Mod:dict(),
+ fetch(T, Dict) ++ lists:flatmap(fun({_,As}) -> As end, fetch(IT, Dict)).
+
+%% random/[12]
+
+random(M) ->
+ random(0,M).
+
+random(Mn,Mx) ->
+ seed(get({?MODULE, seed})),
+ Mn + random:uniform(Mx - Mn + 1) - 1.
+
+seed(undefined) ->
+ put({?MODULE, seed}, true),
+ random:seed(now());
+
+seed(true) ->
+ ok.
+
+%% run/1
+%%
+%% Unravel nested badmatches resulting from [] matches on calls to
+%% run/1 to make for more readable failures.
+
+run(L) ->
+ lists:flatmap(fun flatten/1, diameter_util:run(L)).
+
+flatten({_, {{badmatch, [{_, {{badmatch, _}, _}} | _] = L}, _}}) ->
+ L;
+flatten(T) ->
+ [T].
diff --git a/lib/diameter/test/diameter_ct.erl b/lib/diameter/test/diameter_ct.erl
new file mode 100644
index 0000000000..f8ee3dc1d7
--- /dev/null
+++ b/lib/diameter/test/diameter_ct.erl
@@ -0,0 +1,55 @@
+%%
+%% %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_ct).
+
+%%
+%% Module used to run suites from Makefile.
+%%
+
+-export([run/1]).
+
+%% ct:run_test/1 is currently documented as returning a list of test
+%% results ... but no. Instead it returns 'ok' regardless of whether
+%% or not the suite in question has failed testcases.
+
+run([Suite]) ->
+ Start = info(),
+ ok = ct:run_test([{suite, Suite},
+ {logdir, "./log"},
+ {auto_compile, false}]),
+ info(Start , info()).
+
+info() ->
+ [{time, now()},
+ {process_count, erlang:system_info(process_count)}
+ | erlang:memory()].
+
+info(L0, L1) ->
+ [T, C | M]
+ = lists:zipwith(fun({T,N0}, {T,N1}) -> {T, N1, diff(T, N0, N1)} end,
+ L0,
+ L1),
+ Diff = [T, C, {memory, M}],
+ ct:pal("INFO: ~p~n", [Diff]).
+
+diff(time, T0, T1) ->
+ timer:now_diff(T1, T0);
+diff(_, N0, N1) ->
+ N1 - N0.
diff --git a/lib/diameter/test/diameter_ct.hrl b/lib/diameter/test/diameter_ct.hrl
new file mode 100644
index 0000000000..b6bd2ca9da
--- /dev/null
+++ b/lib/diameter/test/diameter_ct.hrl
@@ -0,0 +1,21 @@
+%%
+%% %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%
+%%
+
+-define(APP, diameter).
+-define(ERROR(T), erlang:error({?MODULE, ?LINE, T})).
diff --git a/lib/diameter/test/diameter_dict_SUITE.erl b/lib/diameter/test/diameter_dict_SUITE.erl
new file mode 100644
index 0000000000..87bb9727fe
--- /dev/null
+++ b/lib/diameter/test/diameter_dict_SUITE.erl
@@ -0,0 +1,151 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the dict-like diameter_dict.
+%%
+
+-module(diameter_dict_SUITE).
+
+-export([suite/0,
+ all/0,
+ groups/0,
+ init_per_group/2,
+ end_per_group/2]).
+
+%% testcases
+-export([append/1,
+ fetch/1,
+ fetch_keys/1,
+ filter/1,
+ find/1,
+ fold/1,
+ is_key/1,
+ map/1,
+ merge/1,
+ update/1,
+ update_counter/1]).
+
+-include("diameter_ct.hrl").
+
+-define(dict, diameter_dict).
+-define(util, diameter_util).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [append,
+ fetch,
+ fetch_keys,
+ filter,
+ find,
+ fold,
+ is_key,
+ map,
+ merge,
+ update,
+ update_counter].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+%% ===========================================================================
+
+-define(KV100, [{N,[N]} || N <- lists:seq(1,100)]).
+
+append(_) ->
+ D = ?dict:append(k, v, ?dict:new()),
+ [{k,[v,v]}] = ?dict:to_list(?dict:append(k, v, D)).
+
+fetch(_) ->
+ D = ?dict:from_list(?KV100),
+ [50] = ?dict:fetch(50, D),
+ Ref = make_ref(),
+ Ref = try ?dict:fetch(Ref, D) catch _:_ -> Ref end.
+
+fetch_keys(_) ->
+ L = ?KV100,
+ D = ?dict:from_list(L),
+ L = [{N,[N]} || N <- lists:sort(?dict:fetch_keys(D))].
+
+filter(_) ->
+ L = ?KV100,
+ F = fun(K,[_]) -> 0 == K rem 2 end,
+ D = ?dict:filter(F, ?dict:from_list(L)),
+ true = [T || {K,V} = T <- L, F(K,V)] == lists:sort(?dict:to_list(D)).
+
+find(_) ->
+ D = ?dict:from_list(?KV100),
+ {ok, [50]} = ?dict:find(50, D),
+ error = ?dict:find(make_ref(), D).
+
+fold(_) ->
+ L = ?KV100,
+ S = lists:sum([N || {N,_} <- L]),
+ S = ?dict:fold(fun(K,[_],A) -> K + A end, 0, ?dict:from_list(L)).
+
+is_key(_) ->
+ L = ?KV100,
+ D = ?dict:from_list(L),
+ true = lists:all(fun({N,_}) -> ?dict:is_key(N,D) end, L),
+ false = ?dict:is_key(make_ref(), D).
+
+map(_) ->
+ L = ?KV100,
+ F = fun(_,V) -> [N] = V, N*2 end,
+ D = ?dict:map(F, ?dict:from_list(L)),
+ M = [{K, F(K,V)} || {K,V} <- L],
+ M = lists:sort(?dict:to_list(D)).
+
+merge(_) ->
+ L = ?KV100,
+ F = fun(_,V1,V2) -> V1 ++ V2 end,
+ D = ?dict:merge(F, ?dict:from_list(L), ?dict:from_list(L)),
+ M = [{K, F(K,V,V)} || {K,V} <- L],
+ M = lists:sort(?dict:to_list(D)).
+
+update(_) ->
+ L = ?KV100,
+ F = fun([V]) -> 2*V end,
+ D = ?dict:update(50, F, ?dict:from_list(L)),
+ 100 = ?dict:fetch(50, D),
+ Ref = make_ref(),
+ Ref = try ?dict:update(Ref, F, D) catch _:_ -> Ref end,
+ [Ref] = ?dict:fetch(Ref, ?dict:update(Ref,
+ fun(_,_) -> ?ERROR(i_think_not) end,
+ [Ref],
+ D)).
+
+update_counter(_) ->
+ L = [{N,2*N} || {N,_} <- ?KV100],
+ D = ?dict:update_counter(50, 20, ?dict:from_list(L)),
+ 120 = ?dict:fetch(50,D),
+ 2 = ?dict:fetch(1,D).
diff --git a/lib/diameter/test/diameter_enum.erl b/lib/diameter/test/diameter_enum.erl
new file mode 100644
index 0000000000..dfb6d04e3c
--- /dev/null
+++ b/lib/diameter/test/diameter_enum.erl
@@ -0,0 +1,406 @@
+%%
+%% %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_enum).
+
+%%
+%% This module constructs finite enumerations.
+%%
+%% An enumeration is represented as a function on integers, 0 mapping
+%% to the number of values enumerated and successive integers mapping
+%% to enumerated values. The function will fail on anything but 0 and
+%% positive integers less then or equal to the value of the function
+%% at 0.
+%%
+%% The purpose of this is to provide a way of stepping through a large
+%% number of values without explicitly constructing the list of all
+%% possible values. For example, consider the following function that
+%% given a list of lists constructs the list of all possible lists
+%% constructed by choosing one element from each sublist.
+%%
+%% combine([H]) ->
+%% [[X] || X <- H];
+%% combine([H|T]) ->
+%% Ys = combine(T),
+%% [[X|Y] || X <- H, Y <- Ys].
+%%
+%% Eg. [[1,2],[3,4,5]] -> [[1,3],[1,4],[1,5],[2,3],[2,4],[2,5]]
+%%
+%% If L is a list of three 1000 element lists then combine(L) would
+%% construct a list of length 10^9 which will likely exhaust available
+%% memory. (Which is how this module came into being. A tail-recursive
+%% implementation doesn't fare much better.) By contrast,
+%%
+%% F = enum:combine([enum:new(L) || L <- Lists])
+%%
+%% only maps existing lists. It may still be undesirable to step
+%% through a very large number of values but it's possible, and easy
+%% to step through a selection of values as an alternative.
+%%
+
+%% Functions that return enumerations.
+-export([new/1,
+ combine/1,
+ reverse/1,
+ map/2,
+ append/1,
+ duplicate/2,
+ nthtail/2,
+ seq/2,
+ seq/3,
+ zip/1,
+ zip/2,
+ slice/3,
+ split/2]).
+
+%% Functions that operate on existing enumerations.
+-export([foreach/2,
+ foldl/3,
+ foldr/3,
+ all/2,
+ any/2,
+ member/2,
+ last/1,
+ nth/2,
+ to_list/1]).
+
+%% ------------------------------------------------------------------------
+%% new/1
+%%
+%% Turn a list/tuple of values into an enumeration that steps through
+%% each element. Turn anything else into an enumeration of that single
+%% value.
+%% ------------------------------------------------------------------------
+
+new(L)
+ when is_list(L) ->
+ new(list_to_tuple(L));
+
+new(T)
+ when is_tuple(T) ->
+ enum(size(T), fun(N) -> element(N,T) end);
+
+new(T) ->
+ fun(0) -> 1; (1) -> T end.
+
+enum(Ord, F) ->
+ fun(0) -> Ord; (N) when 0 < N, N =< Ord -> F(N) end.
+
+%% ------------------------------------------------------------------------
+%% combine/1
+%%
+%% Map a list/tuple of enumerations to the enumeration of all
+%% lists/tuples constructed by choosing one value from each
+%% enumeration in the list/tuple.
+%% ------------------------------------------------------------------------
+
+combine(T)
+ when is_tuple(T) ->
+ F = combine(tuple_to_list(T)),
+ enum(F(0), fun(N) -> list_to_tuple(F(N)) end);
+
+combine([]) ->
+ fun(0) -> 0 end;
+
+%% Given positive integers n_1,...,n_k, construct a bijection from
+%% {0,...,\prod_{i=1}^k} n_i - 1} to {0,...,n_1} x ... x {0,...,n_k}
+%% that maps N to (N_1,...,N_k) where:
+%%
+%% N_1 = (N div 1) rem n_1
+%% ...
+%% N_k = (N div n_1*...*n_{k-1}) rem n_k
+%%
+%% That is:
+%%
+%% N_i = (N div \prod_{j=1}^{i-1} n_j) rem n_i
+%%
+%% This corresponds to looping through N_1, incrementing N_2 as N_1
+%% loops, and so on up through N_k. The inverse map is as follows.
+%%
+%% (N_1,...,N_k) -> N = N_1 + N_2*n_1 + ... + N_k*n_{k-1}*...*n_1
+%%
+%% = \sum_{i=1}^k N_i*\prod_{j=i}^{i-1} n_j
+%%
+%% [Proof: Induction on k. For k=1 we have the identity map. If
+%% g_k : (N_1,...,N_k) |-> N above is bijective then consider
+%% the bijection
+%%
+%% G : (t,n) |--> t + n*K, K = n_k*...*n_1
+%%
+%% from {0,...,K-1} x {0,...,n_{k+1}-1} onto {0,...,n_{k+1}*K - 1}
+%% with inverse F : n |--> (n rem K, n div K). Since
+%%
+%% g_{k+1}(N_1,...,N_{k+1}) = g_k(N_1,...,N_K) + N_{k+1}*K
+%% = G(g_k(N_1,...,N_K), N_{k+1})
+%%
+%% and G, g_k and ((N-1,...,N_k),N_{k+1}) -> (N_1,...,N_{k+1})
+%% are all bijections, so is g_{k+1}.]
+
+combine([_|_] = L) ->
+ [Ord | Divs] = lists:foldl(fun(F,[D|_] = A) -> [F(0)*D | A] end, [1], L),
+ RL = lists:reverse(L),
+ enum(Ord, fun(N) -> combine(N, Ord, Divs, RL) end).
+
+%% Since we use 0 to return the number of elements enumerated, use
+%% bijections from {1,...,N} rather than {0,...,N-1}.
+
+combine(N, Ord, Divs, L)
+ when 0 < N, N =< Ord ->
+ {Vs, []} = lists:foldl(fun(F, {A, [D|Ds]}) ->
+ {[F(1 + (((N-1) div D) rem F(0))) | A], Ds}
+ end,
+ {[], Divs},
+ L),
+ Vs.
+
+%% ------------------------------------------------------------------------
+%% reverse/1
+%%
+%% Construct the enumeration that reverses the order in which values
+%% are traversed.
+%% ------------------------------------------------------------------------
+
+reverse(E) ->
+ Ord = E(0),
+ enum(Ord, fun(N) -> E(Ord + 1 - N) end).
+
+%% ------------------------------------------------------------------------
+%% map/2
+%%
+%% Construct an enumeration that maps enumerated values.
+%% ------------------------------------------------------------------------
+
+map(Fun, E) ->
+ enum(E(0), fun(N) -> Fun(E(N)) end).
+
+%% ------------------------------------------------------------------------
+%% append/2
+%%
+%% Construct an enumeration that successively steps through each of a
+%% list of enumerations.
+%% ------------------------------------------------------------------------
+
+append(Es) ->
+ [Ord | Os] = lists:foldl(fun(E, [N|_] = A) -> [N+E(0)|A] end, [0], Es),
+ Rev = lists:reverse(Es),
+ enum(Ord, fun(N) -> append(N, Os, Rev) end).
+
+append(N, [Ord | _], [E | _])
+ when N > Ord ->
+ E(N - Ord);
+append(N, [_|Os], [_|Es]) ->
+ append(N, Os, Es).
+
+%% ------------------------------------------------------------------------
+%% duplicate/2
+%%
+%% Construct an enumeration that traverses an enumeration multiple
+%% times. Equivalent to append(lists:duplicate(N, E)).
+%% ------------------------------------------------------------------------
+
+duplicate(N, E) ->
+ Ord = E(0),
+ enum(N*Ord, fun(M) -> E(1 + ((M-1) rem Ord)) end).
+
+%% ------------------------------------------------------------------------
+%% nthtail/2
+%%
+%% Construct an enumeration that omits values at the head of an
+%% existing enumeration.
+%% ------------------------------------------------------------------------
+
+nthtail(N, E)
+ when 0 =< N ->
+ nthtail(E(0) - N, N, E).
+
+nthtail(Ord, N, E)
+ when 0 =< Ord ->
+ enum(Ord, fun(M) -> E(M+N) end).
+
+%% ------------------------------------------------------------------------
+%% seq/[23]
+%%
+%% Construct an enumeration that steps through a sequence of integers.
+%% ------------------------------------------------------------------------
+
+seq(From, To) ->
+ seq(From, To, 1).
+
+seq(From, To, Incr)
+ when From =< To ->
+ enum((To - From + Incr) div Incr, fun(N) -> From + (N-1)*Incr end).
+
+%% ------------------------------------------------------------------------
+%% zip/[12]
+%%
+%% Construct an enumeration whose nth value is the list of nth values
+%% of a list of enumerations.
+%% ------------------------------------------------------------------------
+
+zip(Es) ->
+ zip(fun(T) -> T end, Es).
+
+zip(_, []) ->
+ [];
+zip(Fun, Es) ->
+ enum(lists:min([E(0) || E <- Es]), fun(N) -> Fun([E(N) || E <- Es]) end).
+
+%% ------------------------------------------------------------------------
+%% slice/3
+%%
+%% Construct an enumeration of a given length from a given starting point.
+%% ------------------------------------------------------------------------
+
+slice(N, Len, E)
+ when is_integer(N), N > 0, is_integer(Len), Len >= 0 ->
+ slice(N, Len, E(0) - (N - 1), E).
+
+slice(_, _, Tail, _)
+ when Tail < 1 ->
+ fun(0) -> 0 end;
+
+slice(N, Len, Tail, E) ->
+ enum(lists:min([Len, Tail]), fun(M) -> E(N-1+M) end).
+
+%% ------------------------------------------------------------------------
+%% split/2
+%%
+%% Split an enumeration into a list of enumerations of the specified
+%% length. The last enumeration of the list may have order less than
+%% this length.
+%% ------------------------------------------------------------------------
+
+split(Len, E)
+ when is_integer(Len), Len > 0 ->
+ split(1, E(0), Len, E, []).
+
+split(N, Ord, _, _, Acc)
+ when N > Ord ->
+ lists:reverse(Acc);
+
+split(N, Ord, Len, E, Acc) ->
+ split(N+Len, Ord, Len, E, [slice(N, Len, E) | Acc]).
+
+%% ------------------------------------------------------------------------
+%% foreach/2
+%%
+%% Apply a fun to each value of an enumeration.
+%% ------------------------------------------------------------------------
+
+foreach(Fun, E) ->
+ foldl(fun(N,ok) -> Fun(N), ok end, ok, E).
+
+%% ------------------------------------------------------------------------
+%% foldl/3
+%% foldr/3
+%%
+%% Fold through values in an enumeration.
+%% ------------------------------------------------------------------------
+
+foldl(Fun, Acc, E) ->
+ foldl(E(0), 1, Fun, Acc, E).
+
+foldl(M, N, _, Acc, _)
+ when N == M+1 ->
+ Acc;
+foldl(M, N, Fun, Acc, E) ->
+ foldl(M, N+1, Fun, Fun(E(N), Acc), E).
+
+foldr(Fun, Acc, E) ->
+ foldl(Fun, Acc, reverse(E)).
+
+%% ------------------------------------------------------------------------
+%% all/2
+%%
+%% Do all values of an enumeration satisfy a predicate?
+%% ------------------------------------------------------------------------
+
+all(Pred, E) ->
+ all(E(0), 1, Pred, E).
+
+all(M, N, _, _)
+ when N == M+1 ->
+ true;
+all(M, N, Pred, E) ->
+ Pred(E(N)) andalso all(M, N+1, Pred, E).
+
+%% Note that andalso/orelse are tail-recusive as of R13A.
+
+%% ------------------------------------------------------------------------
+%% any/2
+%%
+%% Does any value of an enumeration satisfy a predicate?
+%% ------------------------------------------------------------------------
+
+any(Pred, E) ->
+ any(E(0), 1, Pred, E).
+
+any(M, N, _, _)
+ when N == M+1 ->
+ false;
+any(M, N, Pred, E) ->
+ Pred(E(N)) orelse any(M, N+1, Pred, E).
+
+%% ------------------------------------------------------------------------
+%% member/2
+%%
+%% Does a value match any in an enumeration?
+%% ------------------------------------------------------------------------
+
+member(X, E) ->
+ member(E(0), 1, X, E).
+
+member(M, N, _, _)
+ when N == M+1 ->
+ false;
+member(M, N, X, E) ->
+ match(E(N), X) orelse member(M, N+1, X, E).
+
+match(X, X) ->
+ true;
+match(_, _) ->
+ false.
+
+%% ------------------------------------------------------------------------
+%% last/1
+%%
+%% Return the last value of an enumeration.
+%% ------------------------------------------------------------------------
+
+last(E) ->
+ E(E(0)).
+
+%% ------------------------------------------------------------------------
+%% nth/2
+%%
+%% Return a selected value of an enumeration.
+%% ------------------------------------------------------------------------
+
+nth(N, E) ->
+ E(N).
+
+%% ------------------------------------------------------------------------
+%% to_list/1
+%%
+%% Turn an enumeration into a list. Not good if the very many values
+%% are enumerated.
+%% ------------------------------------------------------------------------
+
+to_list(E) ->
+ foldr(fun(X,A) -> [X|A] end, [], E).
diff --git a/lib/diameter/test/diameter_reg_SUITE.erl b/lib/diameter/test/diameter_reg_SUITE.erl
new file mode 100644
index 0000000000..ade824c9dd
--- /dev/null
+++ b/lib/diameter/test/diameter_reg_SUITE.erl
@@ -0,0 +1,119 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the server implemented by diameter_reg.erl.
+%%
+
+-module(diameter_reg_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([add/1,
+ add_new/1,
+ del/1,
+ repl/1,
+ terms/1,
+ pids/1]).
+
+-define(reg, diameter_reg).
+-define(util, diameter_util).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [add,
+ add_new,
+ del,
+ repl,
+ terms,
+ pids].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+
+add(_) ->
+ Ref = make_ref(),
+ true = ?reg:add(Ref),
+ true = ?reg:add(Ref),
+ [{Ref, Pid}] = ?reg:match(Ref),
+ Pid = self().
+
+add_new(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new(Ref),
+ false = ?reg:add_new(Ref).
+
+del(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new(Ref),
+ true = ?reg:add_new({Ref}),
+ true = ?reg:del({Ref}),
+ [{Ref, Pid}] = ?reg:match(Ref),
+ Pid = self().
+
+repl(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new({Ref}),
+ true = ?reg:repl({Ref}, Ref),
+ false = ?reg:add_new(Ref),
+ false = ?reg:repl({Ref}, Ref),
+ [{Ref, Pid}] = ?reg:match(Ref),
+ Pid = self().
+
+terms(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new(Ref),
+ [[Pid]] = [L || {T,L} <- ?reg:terms(), T == Ref],
+ Pid = self().
+
+pids(_) ->
+ Ref = make_ref(),
+ true = ?reg:add_new(Ref),
+ %% Don't match [[Ref]] since this will only necessarily be the
+ %% case when the test is run in its own process.
+ [_|_] = [L || {P,L} <- ?reg:pids(), P == self()].
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
new file mode 100644
index 0000000000..d3d1fe690a
--- /dev/null
+++ b/lib/diameter/test/diameter_relay_SUITE.erl
@@ -0,0 +1,415 @@
+%%
+%% %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 seven Diameter nodes connected as follows.
+%%
+%% --- SERVER1.REALM2
+%% /
+%% ---- RELAY.REALM2 ---- SERVER2.REALM2
+%% / |
+%% CLIENT.REALM1 |
+%% \ |
+%% ---- RELAY.REALM3 ---- SERVER1.REALM3
+%% \
+%% --- SERVER2.REALM3
+%%
+
+-module(diameter_relay_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,
+ send4/1,
+ send_loop/1,
+ send_timeout_1/1,
+ send_timeout_2/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.REALM1").
+-define(RELAY1, "RELAY.REALM2").
+-define(SERVER1, "SERVER1.REALM2").
+-define(SERVER2, "SERVER2.REALM2").
+-define(RELAY2, "RELAY.REALM3").
+-define(SERVER3, "SERVER1.REALM3").
+-define(SERVER4, "SERVER2.REALM3").
+
+-define(DICT_COMMON, ?DIAMETER_DICT_COMMON).
+-define(DICT_RELAY, ?DIAMETER_DICT_RELAY).
+
+-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}]}]).
+
+%% 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).
+
+-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() ->
+ [{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 = 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
+%% established.
+tc() ->
+ [send1,
+ send2,
+ send3,
+ send4,
+ send_loop,
+ 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)}.
+
+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].
+
+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)).
+
+%% ===========================================================================
+
+%% Send an STR intended for a specific server and expect success.
+send1(_Config) ->
+ call(?SERVER1).
+send2(_Config) ->
+ call(?SERVER2).
+send3(_Config) ->
+ call(?SERVER3).
+send4(_Config) ->
+ call(?SERVER4).
+
+%% Send an ASR that loops between the relays and expect the loop to
+%% be detected.
+send_loop(_Config) ->
+ Req = ['ASR', {'Destination-Realm', realm(?SERVER1)},
+ {'Destination-Host', ?SERVER1},
+ {'Auth-Application-Id', ?APP_ID}],
+ #'diameter_base_answer-message'{'Result-Code' = ?LOOP_DETECTED}
+ = call(Req, [{filter, realm}]).
+
+%% Send a RAR that is incorrectly routed and then discarded and expect
+%% different results depending on whether or not we or the relay
+%% timeout first.
+send_timeout_1(_Config) ->
+ #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER}
+ = send_timeout(7000).
+send_timeout_2(_Config) ->
+ {error, timeout} = send_timeout(3000).
+
+send_timeout(Tmo) ->
+ Req = ['RAR', {'Destination-Realm', realm(?SERVER1)},
+ {'Destination-Host', ?SERVER1},
+ {'Auth-Application-Id', ?APP_ID},
+ {'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),
+
+ 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).
+
+disconnect({LRef, _PortNr}, Client, 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},
+ {'Destination-Host', [Server]},
+ {'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 | _], _, Svc, _State)
+ when Svc == ?RELAY1;
+ Svc == ?RELAY2;
+ Svc == ?CLIENT->
+ {ok, Peer}.
+
+%% prepare_request/3
+
+prepare_request(Pkt, Svc, _Peer)
+ when Svc == ?RELAY1;
+ Svc == ?RELAY2 ->
+ {send, Pkt};
+
+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, false, _Peer) ->
+ discard.
+
+%% handle_answer/4
+
+%% A relay must return Pkt.
+handle_answer(Pkt, _Req, Svc, _Peer)
+ when Svc == ?RELAY1;
+ Svc == ?RELAY2 ->
+ Pkt;
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
+ #diameter_packet{msg = Rec, errors = []} = Pkt,
+ Rec.
+
+%% handle_error/4
+
+handle_error(Reason, _Req, _Svc, _Peer) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+handle_request(Pkt, OH, {_Ref, #diameter_caps{origin_host = {OH,_}} = Caps})
+ when OH /= ?CLIENT ->
+ request(Pkt, Caps).
+
+%% RELAY1 routes any ASR or RAR to RELAY2 ...
+request(#diameter_packet{header = #diameter_header{cmd_code = C}},
+ #diameter_caps{origin_host = {?RELAY1, _}})
+ when C == 274; %% ASR
+ C == 258 -> %% RAR
+ {relay, [{filter, {realm, realm(?RELAY2)}}]};
+
+%% ... which in turn routes it back. Expect diameter to either answer
+%% either with DIAMETER_LOOP_DETECTED/DIAMETER_UNABLE_TO_COMPLY.
+request(#diameter_packet{header = #diameter_header{cmd_code = 274}},
+ #diameter_caps{origin_host = {?RELAY2, _}}) ->
+ {relay, [{filter, {host, ?RELAY1}}]};
+request(#diameter_packet{header = #diameter_header{cmd_code = 258}},
+ #diameter_caps{origin_host = {?RELAY2, _}}) ->
+ discard;
+
+%% Other request to a relay: send on to one of the servers in the
+%% same realm.
+request(_Pkt, #diameter_caps{origin_host = {OH, _}})
+ when OH == ?RELAY1;
+ OH == ?RELAY2 ->
+ {relay, [{filter, {all, [host, realm]}}]};
+
+%% Request received by a server: answer.
+request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId,
+ 'Origin-Host' = Host,
+ 'Origin-Realm' = Realm,
+ 'Route-Record' = Route}},
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}) ->
+ %% The request should have the Origin-Host/Realm of the original
+ %% sender.
+ R = realm(?CLIENT),
+ {?CLIENT, R} = {Host, Realm},
+ %% A relay appends the identity of the peer that a request was
+ %% received from to the Route-Record avp.
+ [?CLIENT] = Route,
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR}}.
diff --git a/lib/diameter/test/diameter_stats_SUITE.erl b/lib/diameter/test/diameter_stats_SUITE.erl
new file mode 100644
index 0000000000..e50a0050a6
--- /dev/null
+++ b/lib/diameter/test/diameter_stats_SUITE.erl
@@ -0,0 +1,92 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the server implemented by diameter_stats.erl.
+%%
+
+-module(diameter_stats_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([an/1,
+ twa/1]).
+
+-define(stat, diameter_stats).
+-define(util, diameter_util).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [an,
+ twa].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+
+an(_) ->
+ Ref = {'_', make_ref()},
+ true = ?stat:reg(Ref),
+ true = ?stat:reg(Ref), %% duplicate
+ ok = ?stat:incr(x),
+ ok = ?stat:incr(x, Ref),
+ ok = ?stat:incr(y, 2),
+ ok = ?stat:incr(y, Ref),
+ %% Flushing a pid flushes even stats on the registered reference.
+ [{x,2},{y,3}] = lists:sort(?stat:flush()),
+ [] = ?stat:flush(Ref),
+ [] = ?stat:flush().
+
+twa(_) ->
+ Ref = make_ref(),
+ ok = ?stat:incr(x, 8),
+ ok = ?stat:incr(x, Ref, 7),
+ %% Flushing a reference doesn't affect registered pids.
+ [{x,7}] = ?stat:flush(Ref),
+ [] = ?stat:flush(Ref),
+ [{x,8}] = ?stat:flush(),
+ [] = ?stat:flush().
diff --git a/lib/diameter/test/diameter_sync_SUITE.erl b/lib/diameter/test/diameter_sync_SUITE.erl
new file mode 100644
index 0000000000..84f77b6066
--- /dev/null
+++ b/lib/diameter/test/diameter_sync_SUITE.erl
@@ -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%
+%%
+
+%%
+%% Tests of the server implemented by diameter_sync.erl.
+%%
+
+-module(diameter_sync_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([call/1,
+ cast/1,
+ timeout/1,
+ flush/1]).
+
+-define(sync, diameter_sync).
+-define(util, diameter_util).
+
+-define(TIMEOUT, infinity).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [call,
+ cast,
+ timeout,
+ flush].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+
+call(_) ->
+ Ref = make_ref(),
+ Q = {q, Ref},
+ F = fun() -> Ref end,
+ Ref = ?sync:call(Q, F, infinity, ?TIMEOUT),
+ Ref = ?sync:call(Q, F, 0, infinity),
+ Ref = call(Q, F),
+ Ref = call(Q, {fun(_) -> Ref end, x}),
+ timeout = call(Q, fun() -> exit(unexpected) end),
+ {_,_,_} = call(Q, {erlang, now, []}),
+ {_,_,_} = call(Q, [fun erlang:now/0]).
+
+cast(_) ->
+ Ref = make_ref(),
+ Q = {q, Ref},
+ false = ?sync:carp(Q),
+ [] = ?sync:pids(Q),
+ %% Queue a request that blocks until we send it Ref and another
+ %% that exits with Ref.
+ ok = cast(Q, fun() -> receive Ref -> ok end end),
+ ok = cast(Q, fun() -> exit(Ref) end),
+ [_,Pid] = ?sync:pids(Q),
+ %% Ensure some expected truths ...
+ 2 = ?sync:pending(Q),
+ true = 2 =< ?sync:pending(),
+ true = lists:member(Q, ?sync:queues()),
+ %% ... and that the max number of requests is respected.
+ rejected = ?sync:call(Q, {erlang, now, []}, 1, ?TIMEOUT),
+ rejected = ?sync:cast(Q, {erlang, now, []}, 1, ?TIMEOUT),
+ %% Monitor on the identifiable request and see that exits when we
+ %% let the blocking request finish.
+ MRef = erlang:monitor(process, Pid),
+ {value, P} = ?sync:carp(Q),
+ P ! Ref,
+ Ref = receive
+ {'DOWN', MRef, process, _, Reason} ->
+ Reason
+ after ?TIMEOUT ->
+ false
+ end.
+
+timeout(_) ->
+ Q = make_ref(),
+ ok = ?sync:cast(Q, {timer, sleep, [2000]}, infinity, 2000),
+ timeout = ?sync:call(Q, fun() -> ok end, infinity, 1000).
+
+flush(_) ->
+ Q = make_ref(),
+ F = {timer, sleep, [2000]},
+ ok = cast(Q, F),
+ ok = cast(Q, F),
+ 1 = ?sync:flush(Q).
+
+%% ===========================================================================
+
+call(Q, Req) ->
+ sync(call, Q, Req).
+
+cast(Q, Req) ->
+ sync(cast, Q, Req).
+
+sync(F, Q, Req) ->
+ ?sync:F(Q, Req, infinity, infinity).
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
new file mode 100644
index 0000000000..8c85323222
--- /dev/null
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -0,0 +1,779 @@
+%%
+%% %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 two Diameter nodes, one client, one server.
+%%
+
+-module(diameter_traffic_SUITE).
+
+-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,
+ send_ok/1,
+ send_arbitrary/1,
+ send_unknown/1,
+ send_unknown_mandatory/1,
+ send_noreply/1,
+ send_unsupported/1,
+ send_unsupported_app/1,
+ send_error_bit/1,
+ send_unsupported_version/1,
+ send_long/1,
+ send_nopeer/1,
+ send_noapp/1,
+ send_discard/1,
+ send_any_1/1,
+ send_any_2/1,
+ send_all_1/1,
+ send_all_2/1,
+ send_timeout/1,
+ send_error/1,
+ send_detach/1,
+ send_encode_error/1,
+ send_destination_1/1,
+ send_destination_2/1,
+ send_destination_3/1,
+ send_destination_4/1,
+ send_destination_5/1,
+ send_destination_6/1,
+ send_bad_option_1/1,
+ send_bad_option_2/1,
+ send_bad_filter_1/1,
+ send_bad_filter_2/1,
+ send_bad_filter_3/1,
+ send_bad_filter_4/1,
+ send_multiple_filters_1/1,
+ send_multiple_filters_2/1,
+ send_multiple_filters_3/1,
+ send_anything/1,
+ remove_transports/1,
+ stop_services/1]).
+
+%% diameter callbacks
+-export([peer_up/3,
+ peer_down/3,
+ pick_peer/5, pick_peer/6,
+ prepare_request/4, prepare_request/5,
+ prepare_retransmit/4,
+ handle_answer/5, handle_answer/6,
+ handle_error/5,
+ 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").
+-define(SERVER, "SERVER").
+-define(REALM, "erlang.org").
+-define(HOST(Host, Realm), Host ++ [$.|Realm]).
+
+-define(APP_ALIAS, base).
+-define(EXTRA, an_extra_argument).
+-define(ENCODINGS, [list, record]).
+
+-define(DICT, ?DIAMETER_DICT_COMMON).
+-define(APP_ID, ?DIAMETER_APP_ID_COMMON).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Name),
+ [{'Origin-Host', Name ++ "." ++ ?REALM},
+ {'Origin-Realm', ?REALM},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Acct-Application-Id', [?DIAMETER_APP_ID_COMMON]},
+ {application, [{alias, ?APP_ALIAS},
+ {dictionary, ?DIAMETER_DICT_COMMON},
+ {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,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_COMMAND_UNSUPPORTED').
+-define(TOO_BUSY,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_TOO_BUSY').
+-define(APPLICATION_UNSUPPORTED,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_APPLICATION_UNSUPPORTED').
+-define(INVALID_HDR_BITS,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_HDR_BITS').
+-define(AVP_UNSUPPORTED,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_AVP_UNSUPPORTED').
+-define(UNSUPPORTED_VERSION,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNSUPPORTED_VERSION').
+-define(REALM_NOT_SERVED,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_REALM_NOT_SERVED').
+-define(UNABLE_TO_DELIVER,
+ ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNABLE_TO_DELIVER').
+
+-define(EVENT_RECORD,
+ ?'DIAMETER_BASE_ACCOUNTING-RECORD-TYPE_EVENT_RECORD').
+-define(AUTHORIZE_ONLY,
+ ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY').
+-define(AUTHORIZE_AUTHENTICATE,
+ ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_AUTHENTICATE').
+
+-define(LOGOUT,
+ ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT').
+-define(BAD_ANSWER,
+ ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_BAD_ANSWER').
+
+-define(A, list_to_atom).
+-define(L, atom_to_list).
+-define(P(N), ?A("p_" ++ ?L(N))).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 10}}].
+
+all() ->
+ [result_codes | [{group, N} || {N, _, _} <- groups()]]
+ ++ [remove_transports, stop_services].
+
+groups() ->
+ Ts = tc(),
+ [{E, [], Ts} || E <- ?ENCODINGS]
+ ++ [{?P(E), [parallel], Ts} || E <- ?ENCODINGS].
+
+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().
+
+init_per_group(Name, Config) ->
+ E = case ?L(Name) of
+ "p_" ++ Rest ->
+ ?A(Rest);
+ _ ->
+ Name
+ end,
+ [{encode, E} | Config].
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_testcase(Name, Config) ->
+ [{testcase, Name} | Config].
+
+end_per_testcase(_, _) ->
+ ok.
+
+%% Testcases to run when services are started and connections
+%% established.
+tc() ->
+ [send_ok,
+ send_arbitrary,
+ send_unknown,
+ send_unknown_mandatory,
+ send_noreply,
+ send_unsupported,
+ send_unsupported_app,
+ send_error_bit,
+ send_unsupported_version,
+ send_long,
+ send_nopeer,
+ send_noapp,
+ send_discard,
+ send_any_1,
+ send_any_2,
+ send_all_1,
+ send_all_2,
+ send_timeout,
+ send_error,
+ send_detach,
+ send_encode_error,
+ send_destination_1,
+ send_destination_2,
+ send_destination_3,
+ send_destination_4,
+ send_destination_5,
+ send_destination_6,
+ send_bad_option_1,
+ send_bad_option_2,
+ send_bad_filter_1,
+ send_bad_filter_2,
+ send_bad_filter_3,
+ send_bad_filter_4,
+ send_multiple_filters_1,
+ send_multiple_filters_2,
+ 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.
+
+%% ===========================================================================
+
+%% Ensure that result codes have the expected values.
+result_codes(_Config) ->
+ {2001, 3001, 3002, 3003, 3004, 3007, 3008, 5001, 5011}
+ = {?SUCCESS,
+ ?COMMAND_UNSUPPORTED,
+ ?UNABLE_TO_DELIVER,
+ ?REALM_NOT_SERVED,
+ ?TOO_BUSY,
+ ?APPLICATION_UNSUPPORTED,
+ ?INVALID_HDR_BITS,
+ ?AVP_UNSUPPORTED,
+ ?UNSUPPORTED_VERSION}.
+
+%% Send an ACR and expect success.
+send_ok(Config) ->
+ Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
+ {'Accounting-Record-Number', 1}],
+ #diameter_base_ACA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req).
+
+%% Send an ASR with an arbitrary AVP and expect success and the same
+%% AVP in the reply.
+send_arbitrary(Config) ->
+ Req = ['ASR', {'AVP', [#diameter_avp{name = 'Class', value = "XXX"}]}],
+ #diameter_base_ASA{'Result-Code' = ?SUCCESS,
+ 'AVP' = Avps}
+ = call(Config, Req),
+ [#diameter_avp{name = 'Class',
+ value = "XXX"}]
+ = Avps.
+
+%% Send an unknown AVP (to some client) and check that it comes back.
+send_unknown(Config) ->
+ Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
+ is_mandatory = false,
+ data = <<17>>}]}],
+ #diameter_base_ASA{'Result-Code' = ?SUCCESS,
+ 'AVP' = Avps}
+ = call(Config, Req),
+ [#diameter_avp{code = 999,
+ is_mandatory = false,
+ data = <<17>>}]
+ = Avps.
+
+%% Ditto but set the M flag.
+send_unknown_mandatory(Config) ->
+ Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
+ is_mandatory = true,
+ data = <<17>>}]}],
+ #diameter_base_ASA{'Result-Code' = ?AVP_UNSUPPORTED,
+ 'Failed-AVP' = Failed}
+ = call(Config, Req),
+ [#'diameter_base_Failed-AVP'{'AVP' = Avps}] = Failed,
+ [#diameter_avp{code = 999,
+ is_mandatory = true,
+ data = <<17>>}]
+ = Avps.
+
+%% Send an STR that the server ignores.
+send_noreply(Config) ->
+ Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
+ {error, timeout} = call(Config, Req).
+
+%% Send an unsupported command and expect 3001.
+send_unsupported(Config) ->
+ Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
+ #'diameter_base_answer-message'{'Result-Code' = ?COMMAND_UNSUPPORTED}
+ = call(Config, Req).
+
+%% Send an unsupported command and expect 3007.
+send_unsupported_app(Config) ->
+ Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
+ #'diameter_base_answer-message'{'Result-Code' = ?APPLICATION_UNSUPPORTED}
+ = call(Config, Req).
+
+%% Send a request with the E bit set and expect 3008.
+send_error_bit(Config) ->
+ Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
+ #'diameter_base_answer-message'{'Result-Code' = ?INVALID_HDR_BITS}
+ = call(Config, Req).
+
+%% Send a bad version and check that we get 5011.
+send_unsupported_version(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ #diameter_base_STA{'Result-Code' = ?UNSUPPORTED_VERSION}
+ = call(Config, Req).
+
+%% Send something long that will be fragmented by TCP.
+send_long(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'User-Name', [lists:duplicate(1 bsl 20, $X)]}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req).
+
+%% Send something for which pick_peer finds no suitable peer.
+send_nopeer(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, no_connection} = call(Config, Req, [{extra, [?EXTRA]}]).
+
+%% Send something on an unconfigured application.
+send_noapp(_Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, no_connection} = diameter:call(?CLIENT, unknown_alias, Req).
+
+%% Send something that's discarded by prepare_request.
+send_discard(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, unprepared} = call(Config, Req).
+
+%% Send with a disjunctive filter.
+send_any_1(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, no_connection} = call(Config, Req, [{filter, {any, []}}]).
+send_any_2(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}],
+ #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER}
+ = call(Config, Req, [{filter, {any, [host, realm]}}]).
+
+%% Send with a conjunctive filter.
+send_all_1(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM),
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req, [{filter, {all, [{host, any},
+ {realm, Realm}]}}]).
+send_all_2(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}],
+ {error, no_connection}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+
+%% Timeout before the server manages an answer.
+send_timeout(Config) ->
+ Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}],
+ {error, timeout} = call(Config, Req, [{timeout, 1000}]).
+
+%% Explicitly answer with an answer-message and ensure that we
+%% received the Session-Id.
+send_error(Config) ->
+ Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}],
+ #'diameter_base_answer-message'{'Result-Code' = ?TOO_BUSY,
+ 'Session-Id' = SId}
+ = call(Config, Req),
+ undefined /= SId.
+
+%% Send a request with the detached option and receive it as a message
+%% from handle_answer instead.
+send_detach(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ Ref = make_ref(),
+ ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]),
+ #diameter_packet{msg = Rec, errors = []}
+ = receive {Ref, T} -> T after 2000 -> false end,
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = Rec.
+
+%% Send a request which can't be encoded and expect {error, encode}.
+send_encode_error(Config) ->
+ {error, encode} = call(Config, ['STR']). %% No Termination-Cause
+
+%% Send with filtering and expect success.
+send_destination_1(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, ?REALM)]}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+send_destination_2(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+
+%% Send with filtering on and expect failure when specifying an
+%% unknown host or realm.
+send_destination_3(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Realm', "unknown.org"}],
+ {error, no_connection}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+send_destination_4(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}],
+ {error, no_connection}
+ = call(Config, Req, [{filter, {all, [host, realm]}}]).
+
+%% Send without filtering and expect an error answer when specifying
+%% an unknown host or realm.
+send_destination_5(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Realm', "unknown.org"}],
+ #'diameter_base_answer-message'{'Result-Code' = ?REALM_NOT_SERVED}
+ = call(Config, Req).
+send_destination_6(Config) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT},
+ {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}],
+ #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER}
+ = call(Config, Req).
+
+%% Specify an invalid option and expect failure.
+send_bad_option_1(Config) ->
+ send_bad_option(Config, x).
+send_bad_option_2(Config) ->
+ send_bad_option(Config, {extra, false}).
+
+send_bad_option(Config, Opt) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ try call(Config, Req, [Opt]) of
+ T -> erlang:error({?MODULE, ?LINE, T})
+ catch
+ error: _ -> ok
+ end.
+
+%% Specify an invalid filter and expect no matching peers.
+send_bad_filter_1(Config) ->
+ send_bad_filter(Config, {all, none}).
+send_bad_filter_2(Config) ->
+ send_bad_filter(Config, {host, x}).
+send_bad_filter_3(Config) ->
+ send_bad_filter(Config, {eval, fun() -> true end}).
+send_bad_filter_4(Config) ->
+ send_bad_filter(Config, {eval, {?MODULE, not_exported, []}}).
+
+send_bad_filter(Config, F) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ {error, no_connection} = call(Config, Req, [{filter, F}]).
+
+%% Specify multiple filter options and expect them be conjunctive.
+send_multiple_filters_1(Config) ->
+ Fun = fun(#diameter_caps{}) -> true end,
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = send_multiple_filters(Config, [host, {eval, Fun}]).
+send_multiple_filters_2(Config) ->
+ E = {erlang, is_tuple, []},
+ {error, no_connection}
+ = send_multiple_filters(Config, [realm, {neg, {eval, E}}]).
+send_multiple_filters_3(Config) ->
+ E1 = [fun(#diameter_caps{}, ok) -> true end, ok],
+ E2 = {erlang, is_tuple, []},
+ E3 = {erlang, is_record, [diameter_caps]},
+ E4 = [{erlang, is_record, []}, diameter_caps],
+ #diameter_base_STA{'Result-Code' = ?SUCCESS}
+ = send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]).
+
+send_multiple_filters(Config, Fs) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ call(Config, Req, [{filter, F} || F <- Fs]).
+
+%% Ensure that we can pass a request in any form to diameter:call/4,
+%% only the return value from the prepare_request callback being
+%% significant.
+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) ->
+ call(Config, Req, []).
+
+call(Config, Req, Opts) ->
+ Name = proplists:get_value(testcase, Config),
+ Enc = proplists:get_value(encode, Config),
+ diameter:call(?CLIENT,
+ ?APP_ALIAS,
+ msg(Req, Enc),
+ [{extra, [Name]} | Opts]).
+
+msg([_|_] = L, list) ->
+ L;
+msg([H|T], record) ->
+ ?DICT:'#new-'(?DICT:msg2rec(H), T);
+msg(T, _) ->
+ T.
+
+%% Set only values that aren't already.
+set([H|T], Vs) ->
+ [H | Vs ++ T];
+set(Rec, Vs) ->
+ lists:foldl(fun({F,_} = FV, A) -> set(?DICT:'#get-'(F, A), FV, A) end,
+ Rec,
+ Vs).
+
+set(E, FV, Rec)
+ when E == undefined;
+ E == [] ->
+ ?DICT:'#set-'(FV, Rec);
+set(_, _, Rec) ->
+ Rec.
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+ State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+ State.
+
+%% pick_peer/5/6
+
+pick_peer([Peer], _, ?CLIENT, _State, Name)
+ when Name /= send_detach ->
+ {ok, Peer}.
+
+pick_peer([_Peer], _, ?CLIENT, _State, send_nopeer, ?EXTRA) ->
+ false;
+
+pick_peer([Peer], _, ?CLIENT, _State, send_detach, {_,_}) ->
+ {ok, Peer}.
+
+%% prepare_request/4/5
+
+prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, send_discard) ->
+ {discard, unprepared};
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name) ->
+ {send, prepare(Pkt, Caps, Name)}.
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, _) ->
+ {send, prepare(Pkt, Caps)}.
+
+prepare(Pkt, Caps, send_unsupported) ->
+ Req = prepare(Pkt, Caps),
+ #diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>}
+ = E
+ = diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req}),
+ E#diameter_packet{bin = <<H/binary, 42:24/integer, T/binary>>};
+
+prepare(Pkt, Caps, send_unsupported_app) ->
+ Req = prepare(Pkt, Caps),
+ #diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>}
+ = E
+ = diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req}),
+ E#diameter_packet{bin = <<H/binary, 42:32/integer, T/binary>>};
+
+prepare(Pkt, Caps, send_error_bit) ->
+ #diameter_packet{header = Hdr} = Pkt,
+ Pkt#diameter_packet{header = Hdr#diameter_header{is_error = true},
+ msg = prepare(Pkt, Caps)};
+
+prepare(Pkt, Caps, send_unsupported_version) ->
+ #diameter_packet{header = Hdr} = Pkt,
+ Pkt#diameter_packet{header = Hdr#diameter_header{version = 42},
+ msg = prepare(Pkt, Caps)};
+
+prepare(Pkt, Caps, send_anything) ->
+ Req = ['STR', {'Termination-Cause', ?LOGOUT}],
+ prepare(Pkt#diameter_packet{msg = Req}, Caps);
+
+prepare(Pkt, Caps, _Name) ->
+ prepare(Pkt, Caps).
+
+prepare(#diameter_packet{msg = Req}, Caps)
+ when is_record(Req, diameter_base_ACR);
+ 'ACR' == hd(Req) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, DR}}
+ = Caps,
+
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Destination-Realm', DR}]);
+
+prepare(#diameter_packet{msg = Req}, Caps)
+ when is_record(Req, diameter_base_ASR);
+ 'ASR' == hd(Req) ->
+ #diameter_caps{origin_host = {OH, DH},
+ origin_realm = {OR, DR}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Destination-Host', DH},
+ {'Destination-Realm', DR},
+ {'Auth-Application-Id', ?APP_ID}]);
+
+prepare(#diameter_packet{msg = Req}, Caps)
+ when is_record(Req, diameter_base_STR);
+ 'STR' == hd(Req) ->
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, DR}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Destination-Realm', DR},
+ {'Auth-Application-Id', ?APP_ID}]);
+
+prepare(#diameter_packet{msg = Req}, Caps)
+ when is_record(Req, diameter_base_RAR);
+ 'RAR' == hd(Req) ->
+ #diameter_caps{origin_host = {OH, DH},
+ origin_realm = {OR, DR}}
+ = Caps,
+ set(Req, [{'Session-Id', diameter:session_id(OH)},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Destination-Host', DH},
+ {'Destination-Realm', DR},
+ {'Auth-Application-Id', ?APP_ID}]).
+
+%% prepare_retransmit/4
+
+prepare_retransmit(_Pkt, false, _Peer, _Name) ->
+ discard.
+
+%% handle_answer/5/6
+
+handle_answer(Pkt, Req, ?CLIENT, Peer, Name) ->
+ answer(Pkt, Req, Peer, Name).
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer, send_detach, {Pid, Ref}) ->
+ Pid ! {Ref, Pkt}.
+
+answer(#diameter_packet{msg = Rec, errors = []}, _Req, _Peer, _) ->
+ Rec.
+
+%% handle_error/5
+
+handle_error(Reason, _Req, ?CLIENT, _Peer, _Name) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+%% Note that diameter will set Result-Code and Failed-AVPs if
+%% #diameter_packet.errors is non-null.
+
+handle_request(Pkt, ?SERVER, {_Ref, Caps}) ->
+ request(Pkt, Caps).
+
+request(#diameter_packet{msg
+ = #diameter_base_ACR{'Session-Id' = SId,
+ 'Accounting-Record-Type' = RT,
+ 'Accounting-Record-Number' = RN}},
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}) ->
+ {reply, ['ACA', {'Result-Code', ?SUCCESS},
+ {'Session-Id', SId},
+ {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Accounting-Record-Type', RT},
+ {'Accounting-Record-Number', RN}]};
+
+request(#diameter_packet{msg = #diameter_base_ASR{'Session-Id' = SId,
+ 'AVP' = Avps}},
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}) ->
+ {reply, #diameter_base_ASA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR,
+ 'AVP' = Avps}};
+
+request(#diameter_packet{msg = #diameter_base_STR{'Termination-Cause' = T}},
+ _Caps)
+ when T /= ?LOGOUT ->
+ discard;
+
+request(#diameter_packet{msg = #diameter_base_STR{'Destination-Realm'= R}},
+ #diameter_caps{origin_realm = {OR, _}})
+ when R /= undefined, R /= OR ->
+ {protocol_error, ?REALM_NOT_SERVED};
+
+request(#diameter_packet{msg = #diameter_base_STR{'Destination-Host'= [H]}},
+ #diameter_caps{origin_host = {OH, _}})
+ when H /= OH ->
+ {protocol_error, ?UNABLE_TO_DELIVER};
+
+request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}},
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}) ->
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR}};
+
+request(#diameter_packet{msg = #diameter_base_RAR{}}, _Caps) ->
+ receive after 2000 -> ok end,
+ {protocol_error, ?TOO_BUSY}.
diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl
new file mode 100644
index 0000000000..d545859fe8
--- /dev/null
+++ b/lib/diameter/test/diameter_transport_SUITE.erl
@@ -0,0 +1,458 @@
+%%
+%% %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 diameter_tcp/sctp as implementations of the diameter
+%% transport interface.
+%%
+
+-module(diameter_transport_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([tcp_accept/1,
+ tcp_connect/1,
+ sctp_accept/1,
+ sctp_connect/1]).
+
+-export([accept/1,
+ connect/1,
+ init/2]).
+
+-include_lib("kernel/include/inet_sctp.hrl").
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+-define(util, diameter_util).
+
+%% Corresponding to diameter_* transport modules.
+-define(TRANSPORTS, [tcp, sctp]).
+
+%% Receive a message.
+-define(RECV(Pat, Ret), receive Pat -> Ret end).
+-define(RECV(Pat), ?RECV(Pat, now())).
+
+%% Or not.
+-define(WAIT(Ms), receive after Ms -> now() end).
+
+%% Sockets are opened on the loopback address.
+-define(ADDR, {127,0,0,1}).
+
+%% diameter_tcp doesn't use anything but host_ip_address, and that
+%% only is a local address isn't configured as at transport start.
+-define(SVC(Addrs), #diameter_service{capabilities
+ = #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}).
+
+%% Message over the transport interface.
+-define(TMSG(T), {diameter, T}).
+
+%% Options for gen_tcp/gen_sctp.
+-define(TCP_OPTS, [binary, {active, true}, {packet, 0}]).
+-define(SCTP_OPTS, [binary, {active, true}, {sctp_initmsg, ?SCTP_INIT}]).
+
+%% Request a specific number of streams just because we can.
+-define(SCTP_INIT, #sctp_initmsg{num_ostreams = 5,
+ max_instreams = 5}).
+
+%% Messages from gen_sctp.
+-define(SCTP(Sock, Data), {sctp, Sock, _, _, Data}).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {minutes, 2}}].
+
+all() ->
+ [{group, all} | tc()].
+
+groups() ->
+ [{all, [parallel], tc()}].
+
+tc() ->
+ [tcp_accept,
+ tcp_connect,
+ sctp_accept,
+ sctp_connect].
+
+init_per_group(_, Config) ->
+ Config.
+
+end_per_group(_, _) ->
+ ok.
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ [{sctp, have_sctp()} | Config].
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+%% tcp_accept/1
+%% sctp_accept/1
+%%
+%% diameter transport accepting, test code connecting.
+
+tcp_accept(_) ->
+ accept(tcp).
+
+sctp_accept(Config) ->
+ if_sctp(fun accept/1, Config).
+
+%% Start multiple accepting transport processes that are connected to
+%% with an equal number of connecting processes using gen_tcp/sctp
+%% directly.
+
+-define(PEER_COUNT, 8).
+
+accept(Prot) ->
+ T = {Prot, make_ref()},
+ [] = ?util:run(?util:scramble(acc(2*?PEER_COUNT, T, []))).
+
+acc(0, _, Acc) ->
+ Acc;
+acc(N, T, Acc) ->
+ acc(N-1, T, [{?MODULE, [init,
+ element(1 + N rem 2, {accept, gen_connect}),
+ T]}
+ | Acc]).
+
+%% ===========================================================================
+%% tcp_connect/1
+%% sctp_connect/1
+%%
+%% Test code accepting, diameter transport connecting.
+
+tcp_connect(_) ->
+ connect(tcp).
+
+sctp_connect(Config) ->
+ if_sctp(fun connect/1, Config).
+
+connect(Prot) ->
+ T = {Prot, make_ref()},
+ [] = ?util:run([{?MODULE, [init, X, T]} || X <- [gen_accept, connect]]).
+
+%% ===========================================================================
+%% ===========================================================================
+
+%% have_sctp/0
+
+have_sctp() ->
+ try gen_sctp:open() of
+ {ok, Sock} ->
+ gen_sctp:close(Sock),
+ true
+ catch
+ error: badarg ->
+ false
+ end.
+
+%% if_sctp/2
+
+if_sctp(F, Config) ->
+ case proplists:get_value(sctp, Config) of
+ true ->
+ F(sctp);
+ false ->
+ {skip, no_sctp}
+ end.
+
+%% init/2
+
+init(accept, {Prot, Ref}) ->
+ %% Start an accepting transport and receive notification of a
+ %% connection.
+ TPid = start_accept(Prot, Ref),
+
+ %% Receive a message and send it back.
+ <<_:8, Len:24, _/binary>> = Bin = bin(Prot, ?RECV(?TMSG({recv, P}), P)),
+
+ Len = size(Bin),
+ TPid ! ?TMSG({send, Bin}),
+
+ %% Expect the transport process to die as a result of the peer
+ %% closing the connection.
+ MRef = erlang:monitor(process, TPid),
+ ?RECV({'DOWN', MRef, process, _, _});
+
+init(gen_connect, {Prot, Ref}) ->
+ %% Lookup the peer's listening socket.
+ {ok, PortNr} = inet:port(lsock(Prot, Ref)),
+
+ %% Connect, send a message and receive it back.
+ {ok, Sock} = gen_connect(Prot, PortNr, Ref),
+ Bin = make_msg(),
+ ok = gen_send(Prot, Sock, Bin),
+ Bin = gen_recv(Prot, Sock);
+
+init(gen_accept, {Prot, Ref}) ->
+ %% Open a listening socket and publish the port number.
+ {ok, LSock} = gen_listen(Prot),
+ {ok, PortNr} = inet:port(LSock),
+ true = diameter_reg:add_new(?TEST_LISTENER(Ref, PortNr)),
+
+ %% Accept a connection, receive a message and send it back.
+ {ok, Sock} = gen_accept(Prot, LSock),
+ Bin = gen_recv(Prot, Sock),
+ ok = gen_send(Prot, Sock, Bin);
+
+init(connect, {Prot, Ref}) ->
+ %% Lookup the peer's listening socket.
+ [{?TEST_LISTENER(_, PortNr), _}] = match(?TEST_LISTENER(Ref, '_')),
+
+ %% Start a connecting transport and receive notification of
+ %% the connection.
+ TPid = start_connect(Prot, PortNr, Ref),
+
+ %% Send a message and receive it back.
+ Bin = make_msg(),
+ TPid ! ?TMSG({send, Bin}),
+ Bin = bin(Prot, ?RECV(?TMSG({recv, P}), P)),
+
+ %% Expect the transport process to die as a result of the peer
+ %% closing the connection.
+ 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
+ [] ->
+ ?WAIT(50),
+ match(Pat);
+ L ->
+ L
+ end.
+
+bin(sctp, #diameter_packet{bin = Bin}) ->
+ Bin;
+bin(tcp, Bin) ->
+ Bin.
+
+%% make_msg/0
+%%
+%% A valid Diameter message in as far as diameter_tcp examines it,
+%% the module examining the length in the Diameter header to locate
+%% message boundaries.
+
+make_msg() ->
+ N = 1024,
+ Bin = rand_bytes(4*N),
+ Len = 4*(N+1),
+ <<1:8, Len:24, Bin/binary>>.
+
+%% crypto:rand_bytes/1 isn't available on all platforms (since openssl
+%% isn't) so roll our own.
+rand_bytes(N) ->
+ random:seed(now()),
+ rand_bytes(N, <<>>).
+
+rand_bytes(0, Bin) ->
+ Bin;
+rand_bytes(N, Bin) ->
+ Oct = random:uniform(256) - 1,
+ rand_bytes(N-1, <<Oct, Bin/binary>>).
+
+%% ===========================================================================
+
+%% start_connect/3
+
+start_connect(Prot, PortNr, Ref) ->
+ {ok, TPid, [?ADDR]} = start_connect(Prot,
+ {connect, Ref},
+ ?SVC([]),
+ [{raddr, ?ADDR},
+ {rport, PortNr},
+ {ip, ?ADDR},
+ {port, 0}]),
+ ?RECV(?TMSG({TPid, connected, _})),
+ TPid.
+
+start_connect(sctp, T, Svc, Opts) ->
+ diameter_sctp:start(T, Svc, [{sctp_initmsg, ?SCTP_INIT} | Opts]);
+start_connect(tcp, T, Svc, Opts) ->
+ diameter_tcp:start(T, Svc, Opts).
+
+%% start_accept/2
+%%
+%% Start transports sequentially by having each wait for a message
+%% from a job in a queue before commencing. Only one transport with
+%% a pending accept is started at a time since diameter_sctp currently
+%% assumes (and diameter currently implements) this.
+
+start_accept(Prot, Ref) ->
+ Pid = sync(accept, Ref),
+
+ %% Configure the same port number for transports on the same
+ %% reference.
+ PortNr = portnr(Prot, Ref),
+ {Mod, Opts} = tmod(Prot),
+
+ try
+ {ok, TPid, [?ADDR]} = Mod:start({accept, Ref},
+ ?SVC([?ADDR]),
+ [{port, PortNr} | Opts]),
+ ?RECV(?TMSG({TPid, connected})),
+ TPid
+ after
+ Pid ! Ref
+ end.
+
+sync(What, Ref) ->
+ ok = diameter_sync:cast({?MODULE, What, Ref},
+ [fun lock/2, Ref, self()],
+ infinity,
+ infinity),
+ receive {start, Ref, Pid} -> Pid end.
+
+lock(Ref, Pid) ->
+ Pid ! {start, Ref, self()},
+ erlang:monitor(process, Pid),
+ Ref = receive T -> T end.
+
+tmod(sctp) ->
+ {diameter_sctp, [{sctp_initmsg, ?SCTP_INIT}]};
+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
+
+gen_connect(Prot, PortNr, Ref) ->
+ Pid = sync(connect, Ref),
+
+ %% Stagger connect attempts to avoid the situation that no
+ %% transport process is accepting yet.
+ receive after 250 -> ok end,
+
+ try
+ gen_connect(Prot, PortNr)
+ after
+ Pid ! Ref
+ end.
+
+gen_connect(sctp = P, PortNr) ->
+ {ok, Sock} = Ok = gen_sctp:open([{ip, ?ADDR}, {port, 0} | ?SCTP_OPTS]),
+ ok = gen_sctp:connect_init(Sock, ?ADDR, PortNr, []),
+ Ok = gen_accept(P, Sock);
+gen_connect(tcp, PortNr) ->
+ gen_tcp:connect(?ADDR, PortNr, ?TCP_OPTS).
+
+%% gen_listen/1
+
+gen_listen(sctp) ->
+ {ok, Sock} = gen_sctp:open([{ip, ?ADDR}, {port, 0} | ?SCTP_OPTS]),
+ {gen_sctp:listen(Sock, true), Sock};
+gen_listen(tcp) ->
+ gen_tcp:listen(0, [{ip, ?ADDR} | ?TCP_OPTS]).
+
+%% gen_accept/2
+
+gen_accept(sctp, Sock) ->
+ Assoc = ?RECV(?SCTP(Sock, {_, #sctp_assoc_change{state = comm_up,
+ outbound_streams = O,
+ inbound_streams = I,
+ assoc_id = A}}),
+ {O, I, A}),
+ putr(assoc, Assoc),
+ {ok, Sock};
+gen_accept(tcp, LSock) ->
+ gen_tcp:accept(LSock).
+
+%% gen_send/3
+
+gen_send(sctp, Sock, Bin) ->
+ {OS, _IS, Id} = getr(assoc),
+ {_, _, Us} = now(),
+ gen_sctp:send(Sock, Id, Us rem OS, Bin);
+gen_send(tcp, Sock, Bin) ->
+ gen_tcp:send(Sock, Bin).
+
+%% gen_recv/2
+
+gen_recv(sctp, Sock) ->
+ {_OS, _IS, Id} = getr(assoc),
+ ?RECV(?SCTP(Sock, {[#sctp_sndrcvinfo{assoc_id = Id}], Bin}), Bin);
+gen_recv(tcp, Sock) ->
+ tcp_recv(Sock, <<>>).
+
+tcp_recv(_, <<_:8, Len:24, _/binary>> = Bin)
+ when Len =< size(Bin) ->
+ Bin;
+tcp_recv(Sock, B) ->
+ receive {tcp, Sock, Bin} -> tcp_recv(Sock, <<B/binary, Bin/binary>>) end.
+
+%% putr/2
+
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+%% getr/1
+
+getr(Key) ->
+ get({?MODULE, Key}).
diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl
new file mode 100644
index 0000000000..99f4fa1977
--- /dev/null
+++ b/lib/diameter/test/diameter_util.erl
@@ -0,0 +1,177 @@
+%%
+%% %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_util).
+
+%%
+%% Utility functions.
+%%
+
+-export([consult/2,
+ run/1,
+ fold/3,
+ foldl/3,
+ scramble/1,
+ ps/0]).
+
+-define(L, atom_to_list).
+
+%% consult/2
+%%
+%% Extract info from the app/appup file (presumably) of the named
+%% application.
+
+consult(Name, Suf)
+ when is_atom(Name), is_atom(Suf) ->
+ case code:lib_dir(Name, ebin) of
+ {error = E, Reason} ->
+ {E, {Name, Reason}};
+ Dir ->
+ consult(filename:join([Dir, ?L(Name) ++ "." ++ ?L(Suf)]))
+ end.
+
+consult(Path) ->
+ case file:consult(Path) of
+ {ok, Terms} ->
+ Terms;
+ {error, Reason} ->
+ {error, {Path, Reason}}
+ end.
+%% 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
+%% failed to return. The fun takes a boolean (did the function return
+%% or not), the function that was evaluated, the return value or exit
+%% reason and the prevailing accumulator.
+
+run(L) ->
+ fold(fun cons/4, [], L).
+
+cons(true, _, _, Acc) ->
+ Acc;
+cons(false, F, RC, Acc) ->
+ [{F, RC} | Acc].
+
+%% fold/3
+%%
+%% Parallel fold. Results are folded in the order received.
+
+fold(Fun, Acc0, L)
+ when is_function(Fun, 4) ->
+ Ref = make_ref(),
+ %% Spawn a middleman to collect down messages from processes
+ %% spawned for each function so as not to assume that all DOWN
+ %% messages are ours.
+ MRef = run1([fun fold/4, Ref, Fun, Acc0, L], Ref),
+ {Ref, RC} = down(MRef),
+ RC.
+
+fold(Ref, Fun, Acc0, L) ->
+ recv(run(Ref, L), Ref, Fun, Acc0).
+
+run(Ref, L) ->
+ [{run1(F, Ref), F} || F <- L].
+
+run1(F, Ref) ->
+ {_, MRef} = spawn_monitor(fun() -> exit({Ref, eval(F)}) end),
+ MRef.
+
+recv([], _, _, Acc) ->
+ Acc;
+recv(L, Ref, Fun, Acc) ->
+ {MRef, R} = down(),
+ {MRef, F} = lists:keyfind(MRef, 1, L),
+ recv(lists:keydelete(MRef, 1, L),
+ Ref,
+ Fun,
+ acc(R, Ref, F, Fun, Acc)).
+
+acc({Ref, RC}, Ref, F, Fun, Acc) ->
+ Fun(true, F, RC, Acc);
+acc(Reason, _, F, Fun, Acc) ->
+ Fun(false, F, Reason, Acc).
+
+down(MRef) ->
+ receive {'DOWN', MRef, process, _, Reason} -> Reason end.
+
+down() ->
+ receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end.
+
+%% foldl/3
+%%
+%% Parallel fold. Results are folded in order of the function list.
+
+foldl(Fun, Acc0, L)
+ when is_function(Fun, 4) ->
+ Ref = make_ref(),
+ recvl(run(Ref, L), Ref, Fun, Acc0).
+
+recvl([], _, _, Acc) ->
+ Acc;
+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.
+
+scramble(L) ->
+ foldl(fun(true, _, S, false) -> S end,
+ false,
+ [[fun s/1, L]]).
+
+s(L) ->
+ random:seed(now()),
+ s([], L).
+
+s(Acc, []) ->
+ Acc;
+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]})
+ when is_atom(F) ->
+ apply(M,F,A);
+
+eval({M,F,A}) ->
+ apply(M,F,A);
+
+eval([F|A])
+ when is_function(F) ->
+ apply(F,A);
+
+eval(L)
+ when is_list(L) ->
+ run(L);
+
+eval(F)
+ when is_function(F,0) ->
+ F().
diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl
new file mode 100644
index 0000000000..dec307529a
--- /dev/null
+++ b/lib/diameter/test/diameter_watchdog_SUITE.erl
@@ -0,0 +1,540 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of the RFC3539 watchdog state machine as implemented by
+%% module diameter_watchdog.
+%%
+
+-module(diameter_watchdog_SUITE).
+
+-export([suite/0,
+ all/0,
+ init_per_suite/1,
+ end_per_suite/1]).
+
+%% testcases
+-export([reopen/1, reopen/4]).
+
+-export([start/3, %% diameter_transport callback
+ id/1, %% jitter callback
+ run/1]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_ct.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(BASE, diameter_gen_base_rfc3588).
+-define(APPL_ID, diameter_gen_base_rfc3588:id()).
+-define(SUCCESS, 2001). %% DIAMETER_SUCCESS
+
+%% Addresses for the local and remote diameter nodes. The values don't
+%% matter since we're faking transport.
+-define(LOCALHOST, {127,0,0,1}).
+-define(REMOTEHOST, {10,0,0,1}).
+
+-define(CAPS, #diameter_caps{origin_host = "node.innan.com",
+ origin_realm = "innan.com",
+ host_ip_address = [?LOCALHOST],
+ vendor_id = 1022,
+ product_name = "remote",
+ auth_application_id = [?APPL_ID]}).
+
+-define(APPL, #diameter_app{alias = ?MODULE,
+ dictionary = ?BASE,
+ module = [?MODULE],
+ init_state = now(),
+ id = ?APPL_ID,
+ mutable = false}).
+
+%% Service record maintained by our faked service process.
+-define(SERVICE, #diameter_service{pid = self(),
+ capabilities = ?CAPS,
+ applications = [?APPL]}).
+
+%% Watchdog timer as a callback.
+-define(WD(T), {?MODULE, id, [T]}).
+
+%% Watchdog timers used by the testcases. Note that the short timeout
+%% with random jitter is excluded since the reopen/1 isn't smart
+%% enough to deal with it: see ONE_WD below.
+-define(WD_TIMERS, [?WD(6000)
+ | [F_(T_) || T_ <- [10000, 20000, 30000],
+ F_ <- [fun(T__) -> T__ end,
+ fun(T__) -> ?WD(T__) end]]]).
+
+%% Transport types.
+-define(TRANSPORTS, [connect, accept]).
+
+%% Message over the transport interface.
+-define(TMSG(T), {diameter, T}).
+
+%% Receive a message within a specified time.
+-define(RECV(T, Timeout),
+ receive T -> now()
+ after Timeout -> ?ERROR({timeout, Timeout})
+ end).
+
+%% Receive a message in a given number of watchdogs, plus or minus
+%% half. Note that the call to now_diff assumes left to right
+%% evaluation order.
+-define(RECV(T, N, WdL, WdH),
+ [?ERROR({received, _Elapsed_, _LowerBound_, N, WdL})
+ || _UpperBound_ <- [(N)*(WdH) + (WdH) div 2],
+ _Elapsed_ <- [now_diff(now(), ?RECV(T, _UpperBound_))],
+ _LowerBound_ <- [(N)*(WdL) - (WdL) div 2],
+ _Elapsed_ =< _LowerBound_*1000]).
+
+%% A timeout that ensures one watchdog. The ensure only one watchdog
+%% requires (Wd + 2000) + 1000 < 2*(Wd - 2000) ==> 7000 < Wd for the
+%% case with random jitter.
+-define(ONE_WD(Wd), jitter(Wd,2000) + 1000).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {minutes, 6}}].%% enough for 11 watchdogs @ 30 sec plus jitter
+
+all() ->
+ [reopen].
+
+init_per_suite(Config) ->
+ ok = diameter:start(),
+ Config.
+
+end_per_suite(_Config) ->
+ ok = diameter:stop().
+
+%% ===========================================================================
+%% # reopen/1
+%% ===========================================================================
+
+%% Test the watchdog state machine for the required failover, failback
+%% and reopen behaviour. Do this by having the testcase replace
+%% diameter_service and start watchdogs, and having this module
+%% implement a transport process that plays the role of the peer
+%% Diameter node.
+
+reopen(_) ->
+ [] = ?util:run([{?MODULE, [run, [reopen, Wd, T, N, M]]}
+ || Wd <- ?WD_TIMERS,
+ T <- ?TRANSPORTS,
+ N <- [0,1,2],
+ M <- ['DWR', 'DWA', other]]).
+
+reopen(Wd, Type, N, What) ->
+ Ref = make_ref(),
+
+ %% The maker of transport processes.
+ TPid = start({N, Wd, What, Ref}),
+
+ %% Act like diameter_service and start the watchdog process, which
+ %% in turn starts a peer_fsm process, which in turn starts a
+ %% transport process by way of start/3. Messages received by the
+ %% testcase are those sent by diameter_watchdog to the service
+ %% process (= process starting the watchdog).
+ WPid1 = watchdog(Type, Ref, TPid, Wd),
+
+ %% Low/high watchdog timeouts.
+ WdL = jitter(Wd, -2000),
+ WdH = jitter(Wd, 2000),
+
+ %% Connection should come up immediately as a consequence of
+ %% starting the watchdog process. In the accepting case this
+ %% results in a new watchdog on a transport waiting for a new
+ %% connection.
+ ?RECV({connection_up, WPid1, _}, 1000),
+
+ WPid2 = case Type of
+ connect ->
+ WPid1;
+ accept ->
+ watchdog(Type, Ref, TPid, Wd)
+ end,
+
+ %% OKAY Timer expires & Failover()
+ %% Pending SetWatchdog() SUSPECT
+ %%
+ %% Since our transport is replying to N DWR's before becoming
+ %% silent, we should go down after N+2 watchdog_timer expirations:
+ %% that is, after the first unanswered DWR. Knowing the min/max
+ %% watchdog timeout values gives the time interval in which the
+ %% down message is expected.
+ ?RECV({connection_down, WPid1}, N+2, WdL, WdH),
+
+ %% SUSPECT Receive DWA Pending = FALSE
+ %% Failback()
+ %% SetWatchdog() OKAY
+ %%
+ %% SUSPECT Receive non-DWA Failback()
+ %% SetWatchdog() OKAY
+ %%
+ %% The transport receives a message before the expiry of another
+ %% watchdog to induce failback.
+ ?RECV({connection_up, WPid1}, WdH),
+
+ %% OKAY Timer expires & SendWatchdog()
+ %% !Pending SetWatchdog()
+ %% Pending = TRUE OKAY
+ %%
+ %% OKAY Timer expires & Failover()
+ %% Pending SetWatchdog() SUSPECT
+ %%
+ %% The transport is still not responding to watchdogs so the
+ %% connection should go back down after either one or two watchdog
+ %% expiries, depending on whether or not DWA restored the connection.
+ F = choose(What == 'DWA', 2, 1),
+ ?RECV({connection_down, WPid1}, F, WdL, WdH),
+
+ %% SUSPECT Timer expires CloseConnection()
+ %% SetWatchdog() DOWN
+ %%
+ %% DOWN Timer expires AttemptOpen()
+ %% SetWatchdog() DOWN
+ %%
+ %% Our transport tells us when the fake connection is
+ %% reestablished, which should happen after another couple of
+ %% watchdog expiries, the first bringing the watchdog to state
+ %% DOWN, the second triggering an attempt to reopen the
+ %% connection.
+ ?RECV({reopen, Ref}, 2, WdL, WdH),
+
+ %% DOWN Connection up NumDWA = 0
+ %% SendWatchdog()
+ %% SetWatchdog()
+ %% Pending = TRUE REOPEN
+ %%
+ %% REOPEN Receive DWA & Pending = FALSE
+ %% NumDWA < 2 NumDWA++ REOPEN
+ %%
+ %% REOPEN Receive DWA & Pending = FALSE
+ %% NumDWA == 2 NumDWA++
+ %% Failback() OKAY
+ %%
+ %% Now the watchdog should require three received DWA's before
+ %% taking the connection back up. The first DWR is sent directly
+ %% after capabilities exchange so it should take no more than two
+ %% watchdog expiries.
+ ?RECV({connection_up, WPid2, _}, 2, WdL, WdH).
+
+%% ===========================================================================
+
+%% Start the fake transport process. From diameter's point of view
+%% it's started when diameter calls start/3. We start it before this
+%% happens since we use the same fake transport each time diameter
+%% calls start/3. The process lives and dies with the test case.
+start(Config) ->
+ Pid = self(),
+ spawn(fun() -> loop(init(Pid, Config)) end).
+
+%% Transport start from diameter. This may be called multiple times
+%% depending on the testcase.
+start({Type, _Ref}, #diameter_service{}, Pid) ->
+ Ref = make_ref(),
+ MRef = erlang:monitor(process, Pid),
+ Pid ! {start, self(), Type, Ref},
+ {Ref, TPid} = receive
+ {Ref, _} = T ->
+ T;
+ {'DOWN', MRef, process, _, _} = T ->
+ T
+ end,
+ erlang:demonitor(MRef, [flush]),
+ {ok, TPid}.
+
+%% id/1
+
+id(T) ->
+ T.
+
+%% ===========================================================================
+
+choose(true, X, _) -> X;
+choose(false, _, X) -> X.
+
+%% run/1
+%%
+%% A more useful badmatch in case of failure.
+
+run([F|A]) ->
+ ok = try
+ apply(?MODULE, F, A),
+ ok
+ catch
+ E:R ->
+ {A, E, R, erlang:get_stacktrace()}
+ end.
+
+%% now_diff/2
+
+now_diff(T1, T2) ->
+ timer:now_diff(T2, T1).
+
+%% jitter/2
+
+jitter(?WD(T), _) ->
+ T;
+jitter(T,D) ->
+ T+D.
+
+%% watchdog/4
+%%
+%% Fake the call from diameter_service. The watchdog process will send
+%% messages to the calling "service" process so our tests are that the
+%% watchdog responds as expected.
+
+watchdog(Type, Ref, TPid, Wd) ->
+ Opts = [{transport_module, ?MODULE},
+ {transport_config, TPid},
+ {watchdog_timer, Wd}],
+ monitor(diameter_watchdog:start({Type, Ref},
+ {false, Opts, false, ?SERVICE})).
+
+monitor(Pid) ->
+ erlang:monitor(process, Pid),
+ Pid.
+
+%% ===========================================================================
+
+%% Transport process implmentation. Fakes reception of messages by
+%% sending fakes to the parent (peer fsm) process that called start/3.
+
+-record(transport,
+ {type, %% connect | accept | manager
+ parent, %% pid() of peer_fsm/ervice process
+ open = false, %% done with capabilities exchange?
+ config}).%% testcase-specific config
+
+%% init/2
+
+%% Testcase starting the manager.
+init(SvcPid, {_,_,_,_} = Config) ->
+ putr(peer, [{'Origin-Host', hostname() ++ ".utan.com"},
+ {'Origin-Realm', "utan.com"}]),
+ #transport{type = manager,
+ parent = monitor(SvcPid),
+ config = Config};
+
+%% Manager starting a transport.
+init(_, {Type, ParentPid, SvcPid, TwinPid, Peer, {N,_,_,_} = Config}) ->
+ putr(peer, Peer),
+ putr(service, SvcPid),
+ putr(count, init(Type, ParentPid, TwinPid, N)),%% number of DWR's to answer
+ #transport{type = Type,
+ parent = monitor(ParentPid),
+ config = Config}.
+
+init(Type, ParentPid, undefined, N) ->
+ connected(ParentPid, Type),
+ N;
+init(_, _, TPid, _) ->
+ monitor(TPid),
+ 3.
+
+%% Generate a unique hostname for the faked peer.
+hostname() ->
+ lists:flatten(io_lib:format("~p-~p-~p", tuple_to_list(now()))).
+
+%% loop/1
+
+loop(S) ->
+ loop(msg(receive T -> T end, S)).
+
+msg(T,S) ->
+ case transition(T,S) of
+ ok ->
+ S;
+ #transport{} = NS ->
+ NS;
+ {stop, Reason} ->
+ x(Reason)
+ end.
+
+x(Reason) ->
+ exit(Reason).
+
+%% transition/2
+
+%% Manager is being asked for a new transport process.
+transition({start, Pid, Type, Ref}, #transport{type = manager,
+ parent = SvcPid,
+ config = Config}) ->
+ TPid = start({Type, Pid, SvcPid, getr(transport), getr(peer), Config}),
+ Pid ! {Ref, TPid},
+ putr(transport, TPid),
+ ok;
+
+%% Peer fsm or testcase process has died.
+transition({'DOWN', _, process, Pid, _} = T, #transport{parent = Pid}) ->
+ {stop, T};
+
+%% Twin transport process has gone down. In the connect case, the
+%% transport isn't started until this happens in the first place so
+%% connect immediately. In the accept case, fake the peer reconnecting
+%% only after another watchdog expiry.
+transition({'DOWN', _, process, _, _}, #transport{type = Type,
+ config = {_, Wd, _, _}}) ->
+ Tmo = case Type of
+ connect ->
+ 0;
+ accept ->
+ ?ONE_WD(Wd)
+ end,
+ erlang:send_after(Tmo, self(), reconnect),
+ ok;
+
+transition(reconnect, #transport{type = Type,
+ parent = Pid,
+ config = {_,_,_,Ref}}) ->
+ getr(service) ! {reopen, Ref},
+ connected(Pid, Type),
+ ok;
+
+%% Peer fsm process is sending CER: fake the peer's CEA.
+transition(?TMSG({send, Bin}), #transport{type = connect,
+ open = false,
+ parent = Pid}
+ = S) ->
+ {Code, Flags, _} = ?BASE:msg_header('CER'),
+ <<_:32, Flags:8, Code:24, _:96, _/binary>> = Bin,
+ Hdr = make_header(Bin),
+ recv(Pid, {Hdr, make_cea()}),
+ S#transport{open = true};
+
+%% Peer fsm process is sending CEA.
+transition(?TMSG({send, Bin}), #transport{type = accept,
+ open = false}
+ = S) ->
+ {Code, Flags, _} = ?BASE:msg_header('CEA'),
+ <<_:32, Flags:8, Code:24, _:96, _/binary>> = Bin,
+ S#transport{open = true};
+
+%% Watchdog is sending DWR or DWA.
+transition(?TMSG({send, Bin}), #transport{open = true} = S) ->
+ {Code, _, _} = ?BASE:msg_header('DWR'),
+ {Code, _, _} = ?BASE:msg_header('DWA'),
+ <<_:32, R:1, 0:7, Code:24, _:96, _/binary>> = Bin,
+ Hdr = make_header(Bin),
+ dwa(1 == R, S, Hdr),
+ ok;
+
+%% We're telling ourselves to fake a received message.
+transition({recv, Msg}, #transport{parent = Pid}) ->
+ recv(Pid, Msg),
+ ok;
+
+%% We're telling ourselves to receive a message to induce failback.
+transition(failback = T, #transport{parent = Pid}) ->
+ recv(Pid, eraser(T)),
+ ok.
+
+make_header(Bin) ->
+ #diameter_header{end_to_end_id = E,
+ hop_by_hop_id = H}
+ = diameter_codec:decode_header(Bin),
+ #diameter_header{end_to_end_id = E,
+ hop_by_hop_id = H}.
+
+recv(Pid, Msg) ->
+ Pid ! ?TMSG({recv, encode(Msg)}).
+
+%% Replace the end-to-end/hop-by-hop identifiers with those from an
+%% incoming request to which we're constructing a reply.
+encode({Hdr, [_|_] = Msg}) ->
+ #diameter_header{hop_by_hop_id = HBH,
+ end_to_end_id = E2E}
+ = Hdr,
+ #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg),
+ <<H:12/binary, _:64, T/binary>> = Bin,
+ <<H/binary, HBH:32, E2E:32, T/binary>>;
+
+encode([_|_] = Msg) ->
+ #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg),
+ Bin.
+
+connected(Pid, connect) ->
+ Pid ! ?TMSG({self(), connected, make_ref()});
+connected(Pid, accept) ->
+ Pid ! ?TMSG({self(), connected}),
+ recv(Pid, make_cer()).
+
+make_cer() ->
+ ['CER' | getr(peer)] ++ [{'Host-IP-Address', [?REMOTEHOST]},
+ {'Vendor-Id', 1028},
+ {'Product-Name', "Utan"},
+ {'Auth-Application-Id', [?APPL_ID]}].
+
+make_cea() ->
+ ['CER' | Rest] = make_cer(),
+ ['CEA', {'Result-Code', ?SUCCESS} | Rest].
+
+make_dwr() ->
+ ['DWR' | getr(peer)].
+
+make_dwa() ->
+ ['DWR' | Rest] = make_dwr(),
+ ['DWA', {'Result-Code', ?SUCCESS} | Rest].
+
+dwa(false, _, _) -> %% outgoing was DWA ...
+ ok;
+dwa(true, S, Hdr) -> %% ... or DWR
+ dwa(getr(count), Hdr, S);
+
+%% React to the DWR only after another watchdog expiry. We shouldn't
+%% get another DWR while the answer is pending.
+dwa(0, Hdr, #transport{config = {_, Wd, What, _}}) ->
+ erlang:send_after(?ONE_WD(Wd), self(), failback),
+ putr(failback, make_msg(What, Hdr)),
+ eraser(count);
+
+dwa(undefined, _, _) ->
+ undefined = getr(failback), %% ensure this is after failback
+ ok;
+
+%% Reply with DWA.
+dwa(N, Hdr, #transport{parent = Pid}) ->
+ putr(count, N-1),
+ recv(Pid, {Hdr, make_dwa()}).
+
+%% Answer to received DWR.
+make_msg('DWA', Hdr) ->
+ {Hdr, make_dwa()};
+
+%% DWR from peer.
+make_msg('DWR', _) ->
+ make_dwr();
+
+%% An unexpected answer is discarded after passing through the
+%% watchdog state machine.
+make_msg(other, _) ->
+ ['RAA', {'Session-Id', diameter:session_id("abc")},
+ {'Result-Code', 2001}
+ | getr(peer)].
+
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+getr(Key) ->
+ get({?MODULE, Key}).
+
+eraser(Key) ->
+ erase({?MODULE, Key}).
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
new file mode 100644
index 0000000000..c6f709dc36
--- /dev/null
+++ b/lib/diameter/test/modules.mk
@@ -0,0 +1,40 @@
+#-*-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%
+
+TEST_SPEC_FILE = diameter.spec
+COVER_SPEC_FILE = diameter.cover
+
+MODULES = \
+ diameter_ct \
+ diameter_util \
+ diameter_enum \
+ diameter_codec_SUITE \
+ diameter_codec_test \
+ diameter_app_SUITE \
+ diameter_dict_SUITE \
+ diameter_reg_SUITE \
+ diameter_sync_SUITE \
+ diameter_stats_SUITE \
+ diameter_watchdog_SUITE \
+ diameter_transport_SUITE \
+ diameter_traffic_SUITE \
+ diameter_relay_SUITE
+
+INTERNAL_HRL_FILES = \
+ diameter_ct.hrl