diff options
Diffstat (limited to 'lib/diameter/test')
36 files changed, 4320 insertions, 4221 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 index 823e2f0311..dba1f126dc 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -16,40 +16,29 @@ # # %CopyrightEnd% -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk +ifeq ($(ERL_TOP),) +TOP = $(DIAMETER_TOP) else -include $(DIAMETER_TOP)/make/target.mk -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk +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) +VSN = $(DIAMETER_VSN) # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/diameter_test - -ifeq ($(findstring win32,$(TARGET)),win32) - -MAKEFILE_SRC = Makefile.win32.src - -else - -MAKEFILE_SRC = Makefile.src - -endif - -ifeq ($(TT_DIR),) -TT_DIR = /tmp -endif +RELSYSDIR = $(RELEASE_PATH)/diameter_test # ---------------------------------------------------- # Target Specs @@ -59,39 +48,16 @@ include modules.mk EBIN = . -HRL_FILES = diameter_test_lib.hrl - +HRL_FILES = $(INTERNAL_HRL_FILES) ERL_FILES = $(MODULES:%=%.erl) SOURCE = $(HRL_FILES) $(ERL_FILES) - TARGET_FILES = $(MODULES:%=%.$(EMULATOR)) -APP_CASES = app appup - -TRANSPORT_CASES = tcp - -ALL_CASES = \ - $(APP_CASES) \ - compiler conf sync session stats reg peer \ - $(TRANSPORT_CASES) - - -EMAKEFILE = Emakefile -ifneq ($(ERL_TOP),) -MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile) -else -MAKE_EMAKE = $(wildcard $(DIAMETER_TOP)/make/make_emakefile) -endif +SUITE_MODULES = $(filter diameter_%_SUITE, $(MODULES)) +SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) -ifeq ($(MAKE_EMAKE),) -BUILDTARGET = $(TARGET_FILES) RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) -else -BUILDTARGET = emakebuild -RELTEST_FILES = $(EMAKEFILE) $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) -endif - # ---------------------------------------------------- # FLAGS @@ -99,310 +65,120 @@ endif include ../src/app/diameter.mk -ifeq ($(USE_DIAMETER_TEST_CODE),true) -ERL_COMPILE_FLAGS += -DDIAMETER_TEST_CODE=mona_lisa_spelar_doom -endif - -ifeq ($(USE_DIAMETER_HIPE),true) -ERL_COMPILE_FLAGS += +native -DDIAMETER_hipe_special=true -endif - -ifneq ($(ERL_TOP),) -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -pa $(ERL_TOP)/lib/test_server/ebin \ - -I$(ERL_TOP)/lib/test_server/include -else -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -pa $(TEST_SERVER_DIR)/ebin \ - -I$(TEST_SERVER_DIR)/include -endif - -ERL_PATH = \ - -pa ../../$(APPLICATION)/ebin \ - -pa ../../et/ebin - -ifndef SUITE -SUITE = diameter_SUITE -endif - -ESTOP = -s init stop - -ifeq ($(DONT_STOP),true) -MAYBE_ESTOP = -else -MAYBE_ESTOP = $(ESTOP) -endif - -ETVIEW = -s et_viewer -ifeq ($(USE_ET_VIEWER),true) -MAYBE_ETVIEW = -else -MAYBE_ETVIEW = $(ETVIEW) -endif - -ifeq ($(MERL),) -MERL = $(ERL) -endif - -ARGS += -noshell - -ifeq ($(DISABLE_TC_TIMEOUT),true) -ARGS += -diameter_test_timeout -endif - - -DIAMETER_TEST_SERVER = diameter_test_server - +# 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 # ---------------------------------------------------- -tests debug opt: $(BUILDTARGET) - -targets: $(TARGET_FILES) - -.PHONY: emakebuild - -emakebuild: $(EMAKEFILE) +all: $(SUITES) -$(EMAKEFILE): - $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' | grep -v Warning > $(EMAKEFILE) - $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) | grep -v Warning >> $(EMAKEFILE) +tests debug opt: $(TARGET_FILES) clean: - rm -f $(EMAKEFILE) 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 "MAKE_EMAKE = $(MAKE_EMAKE)" - @echo "EMAKEFILE = $(EMAKEFILE)" - @echo "BUILDTARGET = $(BUILDTARGET)" - @echo "" + @echo "TARGET_FILES = $(TARGET_FILES)" + @echo @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)" @echo "ERL = $(ERL)" @echo "ERLC = $(ERLC)" - @echo "MERL = $(MERL)" - @echo "" - @echo "ARGS = $(ARGS)" - @echo "" + @echo @echo "HRL_FILES = $(HRL_FILES)" @echo "ERL_FILES = $(ERL_FILES)" @echo "TARGET_FILES = $(TARGET_FILES)" - @echo "" + @echo + @echo "SUITE_MODULES = $(SUITE_MODULES)" + @echo "SUITES = $(SUITES)" + @echo help: - @echo "" - @echo "This Makefile controls the test of the $(APPLICATION) application. " - @echo "" - @echo "There are two separate ways to perform the test of $(APPLICATION)." - @echo "" - @echo " a) Run the official OTP test-server (which we do not describe here)" - @echo "" - @echo " b) Run the test-server provided with this application. " - @echo " There are a number of targets to run the entire or parts" - @echo " of this applications ($(APPLICATION)) test-suite" - @echo "" + @echo @echo "Targets:" - @echo "" - @echo " help" - @echo " Print this info" - @echo "" + @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 the Makefile. " - @echo "" - @echo " tests | debug | opt " - @echo " Compile all test-code. " - @echo "" - @echo " clean " - @echo " Remove all targets. " - @echo "" - @echo " test" - @echo " Run the entire $(APPLICATION) test-suite. " - @echo "" - @echo " app" - @echo " Run the $(APPLICATION) application sub-test-suite. " - @echo "" - @echo " appup" - @echo " Run the $(APPLICATION) application upgrade (appup) sub-test-suite. " - @echo "" - @echo " compiler" - @echo " Run the $(APPLICATION) compiler sub-test-suite(s). " - @echo "" - @echo " conf" - @echo " Run the $(APPLICATION) config sub-test-suite. " - @echo " Checks various aspects of the $(APPLICATION) configuration. " - @echo "" - @echo " sync" - @echo " Run the $(APPLICATION) sync sub-test-suite. " - @echo "" - @echo " session" - @echo " Run the $(APPLICATION) session sub-test-suite. " - @echo "" - @echo " stats" - @echo " Run the $(APPLICATION) stats sub-test-suite. " - @echo "" - @echo " reg" - @echo " Run the $(APPLICATION) reg sub-test-suite. " - @echo "" - @echo " peer" - @echo " Run the $(APPLICATION) peer sub-test-suite" - @echo "" - @echo " ptab" - @echo " Run the $(APPLICATION) persistent-table sub-test-suite" - @echo "" - @echo " tcp" - @echo " Run the $(APPLICATION) tcp sub-test-suite" - @echo "" - @echo "" + @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 # ---------------------------------------------------- -all: make - @echo "make sure epmd is new" - @epmd -kill > /dev/null - @echo "Running all sub-suites separatelly" - @for i in $(ALL_CASES); do \ - echo "SUITE: $$i"; \ - clearmake -V $$i > $$i.log; \ - done - -aall: make - @echo "make sure epmd is new" - @epmd -kill > /dev/null - @echo "Running all app sub-suites separatelly" - @for i in $(APP_CASES); do \ - echo "SUITE: $$i"; \ - clearmake -V $$i > $$i.log; \ - done - echo "done" - -tall: make - @echo "make sure epmd is new" - @epmd -kill > /dev/null - @echo "Running all transport sub-suites separatelly" - @for i in $(TRANSPORT_CASES); do \ - echo "SUITE: $$i"; \ - clearmake -V $$i > $$i.log; \ - done - -make: targets - -test: make - $(MERL) $(ARGS) -sname diameter_test $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t $(SUITE) \ - $(MAYBE_ESTOP) - -utest: make - $(MERL) $(ARGS) -sname diameter_utest $(ERL_PATH) \ - $(MAYBE_ETVIEW) \ - -s $(DIAMETER_TEST_SERVER) t $(SUITE) \ - $(ESTOP) - -# ftest: make -# $(MERL) $(ARGS) -sname diameter_ftest $(ERL_PATH) \ -# -s diameter_filter \ -# -s $(DIAMETER_TEST_SERVER) t $(SUITE) \ -# $(ESTOP) -# - -########################## - -# tickets: make -# $(MERL) $(ARGS) -sname diameter_tickets $(ERL_PATH) \ -# -s $(DIAMETER_TEST_SERVER) tickets $(SUITE) \ -# $(ESTOP) -# - -app: make - $(MERL) $(ARGS) -sname diameter_app $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_app_test \ - $(ESTOP) +# 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). -appup: make - $(MERL) $(ARGS) -sname diameter_appup $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_appup_test \ - $(ESTOP) - -compiler: make - $(MERL) $(ARGS) -sname diameter_compiler $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_compiler_test \ - $(ESTOP) - -conf: make - $(MERL) $(ARGS) -sname diameter_config $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_config_test \ - $(ESTOP) - -sync: make - $(MERL) $(ARGS) -sname diameter_sync $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_sync_test \ - $(ESTOP) - -session: make - $(MERL) $(ARGS) -sname diameter_session $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_session_test \ - $(ESTOP) - -stats: make - $(MERL) $(ARGS) -sname diameter_stats $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_stats_test \ - $(ESTOP) - -reg: make - $(MERL) $(ARGS) -sname diameter_reg $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_reg_test \ - $(ESTOP) - -peer: make - $(MERL) $(ARGS) -sname diameter_peer $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_peer_test \ - $(ESTOP) - -ptab: make - $(MERL) $(ARGS) -sname diameter_persistent_table $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_persistent_table_test \ - $(ESTOP) - -tcp: make - $(MERL) $(ARGS) -sname diameter_tcp $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_tcp_test \ - $(ESTOP) - - -node: - $(MERL) -sname diameter $(ERL_PATH) +log: + mkdir $@ +.PHONY: $(SUITES) # ---------------------------------------------------- # Release Targets # ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif +include $(TOP)/make/otp_release_targets.mk release_spec: release_docs_spec: -release_tests_spec: tests +release_tests_spec: $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(RELTEST_FILES) $(RELSYSDIR) -# $(INSTALL_DATA) $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) \ -# $(HRL_FILES) $(ERL_FILES) \ -# $(RELSYSDIR) -# - chmod -f -R u+w $(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.spec b/lib/diameter/test/diameter.spec index a6e71762eb..fae7863bec 100644 --- a/lib/diameter/test/diameter.spec +++ b/lib/diameter/test/diameter.spec @@ -1,9 +1 @@ {suites, "../diameter_test", all}. -%%{skip, {diameter_compiler_test, all, "Not yet implemented"}}. -%%{skip, {diameter_config_test, all, "Not yet implemented"}}. -%%{skip, {diameter_peer_test, all, "Not yet implemented"}}. -%%{skip, {diameter_reg_test, all, "Not yet implemented"}}. -%%{skip, {diameter_session_test, all, "Not yet implemented"}}. -%%{skip, {diameter_stats_test, all, "Not yet implemented"}}. -%%{skip, {diameter_sync_test, all, "Not yet implemented"}}. -%%{skip, {diameter_tcp_test, all, "Not yet implemented"}}. diff --git a/lib/diameter/test/diameter_SUITE.erl b/lib/diameter/test/diameter_SUITE.erl deleted file mode 100644 index 443cf90e92..0000000000 --- a/lib/diameter/test/diameter_SUITE.erl +++ /dev/null @@ -1,108 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Test application config -%%---------------------------------------------------------------------- - --module(diameter_SUITE). - --export([ - suite/0, - all/0, - groups/0, - - init_per_testcase/2, - fin_per_testcase/2, - - init_per_suite/1, - end_per_suite/1, - - init_per_group/2, - end_per_group/2, - - init/0 - ]). - --export([t/0, t/1]). - - --include("diameter_test_lib.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - -init() -> - process_flag(trap_exit, true), - ?FLUSH(). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Top test case - -suite() -> - [{ct_hooks, [{ts_install_cth, [{nodenames,1}]}]}]. - -all() -> - [ - {group, app}, - {group, appup}, - {group, compiler}, - {group, config}, - {group, sync}, - {group, session}, - {group, stats}, - {group, reg}, - {group, peer}, - {group, tcp} - ]. - -groups() -> - [{app, [], [{diameter_app_test, all}]}, - {appup, [], [{diameter_appup_test, all}]}, - {compiler, [], [{diameter_compiler_test, all}]}, - {config, [], [{diameter_config_test, all}]}, - {sync, [], [{diameter_sync_test, all}]}, - {session, [], [{diameter_session_test, all}]}, - {stats, [], [{diameter_stats_test, all}]}, - {reg, [], [{diameter_reg_test, all}]}, - {peer, [], [{diameter_peer_test, all}]}, - {tcp, [], [{diameter_tcp_test, all}]}]. - - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. 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_app_test.erl b/lib/diameter/test/diameter_app_test.erl deleted file mode 100644 index 7173c39caf..0000000000 --- a/lib/diameter/test/diameter_app_test.erl +++ /dev/null @@ -1,393 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the application specifics of the Diameter application -%%---------------------------------------------------------------------- --module(diameter_app_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2, - - fields/1, - modules/1, - exportall/1, - app_depend/1, - undef_funcs/1 - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(undef_funcs = Case, Config) -> - NewConfig = [{tc_timeout, ?MINUTES(10)} | Config], - diameter_test_server:init_per_testcase(Case, NewConfig); -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - [ - fields, - modules, - exportall, - app_depend, - undef_funcs - ]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - io:format("~w:init_per_suite -> entry with" - "~n Config: ~p" - "~n", [?MODULE, Config]), - case is_app(diameter) of - {ok, AppFile} -> - io:format("AppFile: ~n~p~n", [AppFile]), - %% diameter:print_version_info(), - [{app_file, AppFile}|Config]; - {error, Reason} -> - ?FAIL(Reason) - end. - -is_app(App) -> - LibDir = code:lib_dir(App), - File = filename:join([LibDir, "ebin", atom_to_list(App) ++ ".app"]), - case file:consult(File) of - {ok, [{application, App, AppFile}]} -> - {ok, AppFile}; - Error -> - {error, {invalid_format, Error}} - end. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -fields(suite) -> - []; -fields(doc) -> - []; -fields(Config) when is_list(Config) -> - AppFile = ?KEY1SEARCH(app_file, Config), - Fields = [vsn, description, modules, registered, applications], - case check_fields(Fields, AppFile, []) of - [] -> - ok; - Missing -> - ?FAIL({missing_fields, Missing}) - end. - -check_fields([], _AppFile, Missing) -> - Missing; -check_fields([Field|Fields], AppFile, Missing) -> - check_fields(Fields, AppFile, check_field(Field, AppFile, Missing)). - -check_field(Name, AppFile, Missing) -> - io:format("checking field: ~p~n", [Name]), - case lists:keymember(Name, 1, AppFile) of - true -> - Missing; - false -> - [Name|Missing] - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -modules(suite) -> - []; -modules(doc) -> - []; -modules(Config) when is_list(Config) -> - AppFile = ?KEY1SEARCH(app_file, Config), - Mods = ?KEY1SEARCH(modules, AppFile), - EbinList = get_ebin_mods(diameter), - case missing_modules(Mods, EbinList, []) of - [] -> - ok; - Missing -> - throw({error, {missing_modules, Missing}}) - end, - Allowed = [diameter_codegen, - diameter_make, - diameter_spec_scan, - diameter_spec_util], - case extra_modules(Mods, EbinList, Allowed, []) of - [] -> - ok; - Extra -> - throw({error, {extra_modules, Extra}}) - end, - {ok, Mods}. - -get_ebin_mods(App) -> - LibDir = code:lib_dir(App), - EbinDir = filename:join([LibDir,"ebin"]), - {ok, Files0} = file:list_dir(EbinDir), - Files1 = [lists:reverse(File) || File <- Files0], - [list_to_atom(lists:reverse(Name)) || [$m,$a,$e,$b,$.|Name] <- Files1]. - - -missing_modules([], _Ebins, Missing) -> - Missing; -missing_modules([Mod|Mods], Ebins, Missing) -> - case lists:member(Mod, Ebins) of - true -> - missing_modules(Mods, Ebins, Missing); - false -> - io:format("missing module: ~p~n", [Mod]), - missing_modules(Mods, Ebins, [Mod|Missing]) - end. - - -extra_modules(_Mods, [], Allowed, Extra) -> - Extra--Allowed; -extra_modules(Mods, [Mod|Ebins], Allowed, Extra) -> - case lists:member(Mod, Mods) of - true -> - extra_modules(Mods, Ebins, Allowed, Extra); - false -> - io:format("supefluous module: ~p~n", [Mod]), - extra_modules(Mods, Ebins, Allowed, [Mod|Extra]) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -exportall(suite) -> - []; -exportall(doc) -> - []; -exportall(Config) when is_list(Config) -> - AppFile = ?KEY1SEARCH(app_file, Config), - Mods = ?KEY1SEARCH(modules, AppFile), - check_export_all(Mods). - - -check_export_all([]) -> - ok; -check_export_all([Mod|Mods]) -> - case (catch apply(Mod, module_info, [compile])) of - {'EXIT', {undef, _}} -> - check_export_all(Mods); - O -> - case lists:keysearch(options, 1, O) of - false -> - check_export_all(Mods); - {value, {options, List}} -> - case lists:member(export_all, List) of - true -> - throw({error, {export_all, Mod}}); - false -> - check_export_all(Mods) - end - end - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -app_depend(suite) -> - []; -app_depend(doc) -> - []; -app_depend(Config) when is_list(Config) -> - AppFile = ?KEY1SEARCH(app_file, Config), - Apps = ?KEY1SEARCH(applications, AppFile), - check_apps(Apps). - - -check_apps([]) -> - ok; -check_apps([App|Apps]) -> - case is_app(App) of - {ok, _} -> - check_apps(Apps); - Error -> - throw({error, {missing_app, {App, Error}}}) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -undef_funcs(suite) -> - []; -undef_funcs(doc) -> - []; -undef_funcs(Config) when is_list(Config) -> - ?SKIP(diameter_not_known_by_xref), - App = diameter, - AppFile = ?KEY1SEARCH(app_file, Config), - Mods = ?KEY1SEARCH(modules, AppFile), - Root = code:root_dir(), - LibDir = code:lib_dir(App), - EbinDir = filename:join([LibDir,"ebin"]), - XRefTestName = undef_funcs_make_name(App, xref_test_name), - try - begin - XRef = xref_start(XRefTestName), - xref_set_defaults(XRef, [{verbose,false},{warnings,false}]), - XRefName = undef_funcs_make_name(App, xref_name), - XRefName = xref_add_release(XRef, Root, XRefName), - xref_replace_application(XRef, App, EbinDir), - Undefs = xref_analyze(XRef), - xref_stop(XRef), - analyze_undefined_function_calls(Undefs, Mods, []) - end - catch - throw:{error, Reason} -> - ?FAIL(Reason) - end. - - -xref_start(XRefTestName) -> - case (catch xref:start(XRefTestName)) of - {ok, XRef} -> - XRef; - {error, Reason} -> - throw({error, {failed_starting_xref, Reason}}); - Error -> - throw({error, {failed_starting_xref, Error}}) - end. - -xref_set_defaults(XRef, Defs) -> - case (catch xref:set_default(XRef, Defs)) of - ok -> - ok; - Error -> - throw({error, {failed_setting_defaults, Defs, Error}}) - end. - -xref_add_release(XRef, Root, Name) -> - case (catch xref:add_release(XRef, Root, {name, Name})) of - {ok, XRefName} -> - XRefName; - {error, Reason} -> - throw({error, {failed_adding_release, Reason}}); - Error -> - throw({error, {failed_adding_release, Error}}) - end. - -xref_replace_application(XRef, App, EbinDir) -> - case (catch xref:replace_application(XRef, App, EbinDir)) of - {ok, App} -> - ok; - {error, XRefMod, Reason} -> - throw({error, {failed_replacing_app, XRefMod, Reason}}); - Error -> - throw({error, {failed_replacing_app, Error}}) - end. - -xref_analyze(XRef) -> - case (catch xref:analyze(XRef, undefined_function_calls)) of - {ok, Undefs} -> - Undefs; - {error, Reason} -> - throw({error, {failed_detecting_func_calls, Reason}}); - Error -> - throw({error, {failed_detecting_func_calls, Error}}) - end. - -xref_stop(XRef) -> - xref:stop(XRef). - -analyze_undefined_function_calls([], _, []) -> - ok; -analyze_undefined_function_calls([], _, AppUndefs) -> - exit({suite_failed, {undefined_function_calls, AppUndefs}}); -analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs], - AppModules, AppUndefs) -> - %% Check that this module is our's - case lists:member(Mod,AppModules) of - true -> - {Calling,Called} = AppUndef, - {Mod1,Func1,Ar1} = Calling, - {Mod2,Func2,Ar2} = Called, - io:format("undefined function call: " - "~n ~w:~w/~w calls ~w:~w/~w~n", - [Mod1,Func1,Ar1,Mod2,Func2,Ar2]), - analyze_undefined_function_calls(Undefs, AppModules, - [AppUndef|AppUndefs]); - false -> - io:format("dropping ~p~n", [Mod]), - analyze_undefined_function_calls(Undefs, AppModules, AppUndefs) - end. - -%% This function is used simply to avoid cut-and-paste errors later... -undef_funcs_make_name(App, PostFix) -> - list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -%% fail(Reason) -> -%% exit({suite_failed, Reason}). - -%% ?KEY1SEARCH(Key, L) -> -%% case lists:keysearch(Key, 1, L) of -%% undefined -> -%% fail({not_found, Key, L}); -%% {value, {Key, Value}} -> -%% Value -%% end. diff --git a/lib/diameter/test/diameter_appup_test.erl b/lib/diameter/test/diameter_appup_test.erl deleted file mode 100644 index 97a089e01a..0000000000 --- a/lib/diameter/test/diameter_appup_test.erl +++ /dev/null @@ -1,539 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the application specifics of the Diameter application -%%---------------------------------------------------------------------- --module(diameter_appup_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2, - - appup/1 - ]). - --export([t/0, t/1]). - --compile({no_auto_import,[error/1]}). - --include("diameter_test_lib.hrl"). - --define(APPLICATION, diameter). - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - [appup]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - AppFile = file_name(?APPLICATION, ".app"), - AppupFile = file_name(?APPLICATION, ".appup"), - [{app_file, AppFile}, {appup_file, AppupFile}|Config]. - - -file_name(App, Ext) -> - LibDir = code:lib_dir(App), - filename:join([LibDir, "ebin", atom_to_list(App) ++ Ext]). - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -appup(suite) -> - []; -appup(doc) -> - "perform a simple check of the appup file"; -appup(Config) when is_list(Config) -> - AppupFile = key1search(appup_file, Config), - AppFile = key1search(app_file, Config), - Modules = modules(AppFile), - check_appup(AppupFile, Modules). - -modules(File) -> - case file:consult(File) of - {ok, [{application,diameter,Info}]} -> - case lists:keysearch(modules,1,Info) of - {value, {modules, Modules}} -> - Modules; - false -> - fail({bad_appinfo, Info}) - end; - Error -> - fail({bad_appfile, Error}) - end. - - -check_appup(AppupFile, Modules) -> - case file:consult(AppupFile) of - {ok, [{V, UpFrom, DownTo}]} -> - check_appup(V, UpFrom, DownTo, Modules); - Else -> - fail({bad_appupfile, Else}) - end. - - -check_appup(V, UpFrom, DownTo, Modules) -> - check_version(V), - check_depends(up, UpFrom, Modules), - check_depends(down, DownTo, Modules), - check_module_subset(UpFrom), - check_module_subset(DownTo), - ok. - - -check_depends(_, [], _) -> - ok; -check_depends(UpDown, [Dep|Deps], Modules) -> - check_depend(UpDown, Dep, Modules), - check_depends(UpDown, Deps, Modules). - - -check_depend(up = UpDown, {add_application, ?APPLICATION} = Instr, Modules) -> - d("check_instructions(~w) -> entry with" - "~n Instruction: ~p" - "~n Modules: ~p", [UpDown, Instr, Modules]), - ok; -check_depend(down = UpDown, {remove_application, ?APPLICATION} = Instr, - Modules) -> - d("check_instructions(~w) -> entry with" - "~n Instruction: ~p" - "~n Modules: ~p", [UpDown, Instr, Modules]), - ok; -check_depend(UpDown, {V, Instructions}, Modules) -> - d("check_instructions(~w) -> entry with" - "~n V: ~p" - "~n Modules: ~p", [UpDown, V, Modules]), - check_version(V), - case check_instructions(UpDown, - Instructions, Instructions, [], [], Modules) of - {_Good, []} -> - ok; - {_, Bad} -> - fail({bad_instructions, Bad, UpDown}) - end. - - -check_instructions(_, [], _, Good, Bad, _) -> - {lists:reverse(Good), lists:reverse(Bad)}; -check_instructions(UpDown, [Instr|Instrs], AllInstr, Good, Bad, Modules) -> - d("check_instructions(~w) -> entry with" - "~n Instr: ~p", [UpDown,Instr]), - case (catch check_instruction(UpDown, Instr, AllInstr, Modules)) of - ok -> - check_instructions(UpDown, Instrs, AllInstr, - [Instr|Good], Bad, Modules); - {error, Reason} -> - d("check_instructions(~w) -> bad instruction: " - "~n Reason: ~p", [UpDown,Reason]), - check_instructions(UpDown, Instrs, AllInstr, Good, - [{Instr, Reason}|Bad], Modules) - end. - -%% A new module is added -check_instruction(up, {add_module, Module}, _, Modules) - when is_atom(Module) -> - d("check_instruction -> entry when up-add_module instruction with" - "~n Module: ~p", [Module]), - check_module(Module, Modules); - -%% An old module is re-added -check_instruction(down, {add_module, Module}, _, Modules) - when is_atom(Module) -> - d("check_instruction -> entry when down-add_module instruction with" - "~n Module: ~p", [Module]), - case (catch check_module(Module, Modules)) of - {error, {unknown_module, Module, Modules}} -> - ok; - ok -> - error({existing_readded_module, Module}) - end; - -%% Removing a module on upgrade: -%% - the module has been removed from the app-file. -%% - check that no module depends on this (removed) module -check_instruction(up, {remove, {Module, Pre, Post}}, _, Modules) - when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) -> - d("check_instruction -> entry when up-remove instruction with" - "~n Module: ~p" - "~n Pre: ~p" - "~n Post: ~p", [Module, Pre, Post]), - case (catch check_module(Module, Modules)) of - {error, {unknown_module, Module, Modules}} -> - check_purge(Pre), - check_purge(Post); - ok -> - error({existing_removed_module, Module}) - end; - -%% Removing a module on downgrade: the module exist -%% in the app-file. -check_instruction(down, {remove, {Module, Pre, Post}}, AllInstr, Modules) - when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) -> - d("check_instruction -> entry when down-remove instruction with" - "~n Module: ~p" - "~n Pre: ~p" - "~n Post: ~p", [Module, Pre, Post]), - case (catch check_module(Module, Modules)) of - ok -> - check_purge(Pre), - check_purge(Post), - check_no_remove_depends(Module, AllInstr); - {error, {unknown_module, Module, Modules}} -> - error({nonexisting_removed_module, Module}) - end; - -check_instruction(_, {load_module, Module, Pre, Post, Depend}, - AllInstr, Modules) - when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) andalso is_list(Depend) -> - d("check_instruction -> entry when load_module instruction with" - "~n Module: ~p" - "~n Pre: ~p" - "~n Post: ~p" - "~n Depend: ~p", [Module, Pre, Post, Depend]), - check_module(Module, Modules), - check_module_depend(Module, Depend, Modules), - check_module_depend(Module, Depend, updated_modules(AllInstr, [])), - check_purge(Pre), - check_purge(Post); - -check_instruction(_, {update, Module, Change, Pre, Post, Depend}, - AllInstr, Modules) - when is_atom(Module) andalso is_atom(Pre) andalso is_atom(Post) andalso is_list(Depend) -> - d("check_instruction -> entry when update instruction with" - "~n Module: ~p" - "~n Change: ~p" - "~n Pre: ~p" - "~n Post: ~p" - "~n Depend: ~p", [Module, Change, Pre, Post, Depend]), - check_module(Module, Modules), - check_module_depend(Module, Depend, Modules), - check_module_depend(Module, Depend, updated_modules(AllInstr, [])), - check_change(Change), - check_purge(Pre), - check_purge(Post); - -check_instruction(_, {update, Module, supervisor}, _, Modules) - when is_atom(Module) -> - check_module(Module, Modules); - -check_instruction(_, {apply, {Module, Function, Args}}, _, Modules) - when is_atom(Module) andalso is_atom(Function) andalso is_list(Args) -> - d("check_instruction -> entry when down-apply instruction with" - "~n Module: ~p" - "~n Function: ~p" - "~n Args: ~p", [Module, Function, Args]), - check_module(Module, Modules), - check_apply(Module, Function, Args); - -check_instruction(_, {restart_application, ?APPLICATION}, _AllInstr, _Modules) -> - ok; - -check_instruction(_, Instr, _AllInstr, _Modules) -> - d("check_instruction -> entry when unknown instruction with" - "~n Instr: ~p", [Instr]), - error({error, {unknown_instruction, Instr}}). - - -%% If Module X depends on Module Y, then module Y must have an update -%% instruction of some sort (otherwise the depend is faulty). -updated_modules([], Modules) -> - d("update_modules -> entry when done with" - "~n Modules: ~p", [Modules]), - Modules; -updated_modules([Instr|Instrs], Modules) -> - d("update_modules -> entry with" - "~n Instr: ~p" - "~n Modules: ~p", [Instr,Modules]), - Module = instruction_module(Instr), - d("update_modules -> Module: ~p", [Module]), - updated_modules(Instrs, [Module|Modules]). - -instruction_module({add_module, Module}) -> - Module; -instruction_module({remove, {Module, _, _}}) -> - Module; -instruction_module({load_module, Module, _, _, _}) -> - Module; -instruction_module({update, Module, _, _, _, _}) -> - Module; -instruction_module({apply, {Module, _, _}}) -> - Module; -instruction_module(Instr) -> - d("instruction_module -> entry when unknown instruction with" - "~n Instr: ~p", [Instr]), - error({error, {unknown_instruction, Instr}}). - - -%% Check that the modules handled in an instruction set for version X -%% is a subset of the instruction set for version X-1. -check_module_subset(Instructions) -> - do_check_module_subset(modules_of(Instructions)). - -do_check_module_subset([]) -> - ok; -do_check_module_subset([_]) -> - ok; -do_check_module_subset([{_V1, Mods1}|T]) -> - {V2, Mods2} = hd(T), - %% Check that the modules in V1 is a subset of V2 - case do_check_module_subset2(Mods1, Mods2) of - ok -> - do_check_module_subset(T); - {error, Modules} -> - fail({subset_missing_instructions, V2, Modules}) - end. - -do_check_module_subset2(Mods1, Mods2) -> - do_check_module_subset2(Mods1, Mods2, []). - -do_check_module_subset2([], _, []) -> - ok; -do_check_module_subset2([], _, Acc) -> - {error, lists:reverse(Acc)}; -do_check_module_subset2([Mod|Mods], Mods2, Acc) -> - case lists:member(Mod, Mods2) of - true -> - do_check_module_subset2(Mods, Mods2, Acc); - false -> - do_check_module_subset2(Mods, Mods2, [Mod|Acc]) - end. - - -modules_of(Instructions) -> - modules_of(Instructions, []). - -modules_of([], Acc) -> - lists:reverse(Acc); -modules_of([{V,Instructions}|T], Acc) -> - Mods = modules_of2(Instructions, []), - modules_of(T, [{V, Mods}|Acc]). - -modules_of2([], Acc) -> - lists:reverse(Acc); -modules_of2([Instr|Instructions], Acc) -> - case module_of(Instr) of - {value, Mod} -> - modules_of2(Instructions, [Mod|Acc]); - false -> - modules_of2(Instructions, Acc) - end. - -module_of({add_module, Module}) -> - {value, Module}; -module_of({remove, {Module, _Pre, _Post}}) -> - {value, Module}; -module_of({load_module, Module, _Pre, _Post, _Depend}) -> - {value, Module}; -module_of({update, Module, _Change, _Pre, _Post, _Depend}) -> - {value, Module}; -module_of(_) -> - false. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% The version is a string consting of numbers separated by dots: "." -%% Example: "3.3.3" -%% -check_version(V) when is_list(V) -> - case do_check_version(string:tokens(V, [$.])) of - ok -> - ok; - {error, BadVersionPart} -> - throw({error, {bad_version, V, BadVersionPart}}) - end; -check_version(V) -> - error({bad_version, V}). - -do_check_version([]) -> - ok; -do_check_version([H|T]) -> - case (catch list_to_integer(H)) of - I when is_integer(I) -> - do_check_version(T); - _ -> - {error, H} - end. - -check_module(M, Modules) when is_atom(M) -> - case lists:member(M,Modules) of - true -> - ok; - false -> - error({unknown_module, M, Modules}) - end; -check_module(M, _) -> - error({bad_module, M}). - - -check_module_depend(M, [], _) when is_atom(M) -> - d("check_module_depend -> entry with" - "~n M: ~p", [M]), - ok; -check_module_depend(M, Deps, Modules) when is_atom(M) andalso is_list(Deps) -> - d("check_module_depend -> entry with" - "~n M: ~p" - "~n Deps: ~p" - "~n Modules: ~p", [M, Deps, Modules]), - case [Dep || Dep <- Deps, lists:member(Dep, Modules) == false] of - [] -> - ok; - Unknown -> - error({unknown_depend_modules, Unknown}) - end; -check_module_depend(_M, D, _Modules) -> - d("check_module_depend -> entry when bad depend with" - "~n D: ~p", [D]), - error({bad_depend, D}). - - -check_no_remove_depends(_Module, []) -> - ok; -check_no_remove_depends(Module, [Instr|Instrs]) -> - check_no_remove_depend(Module, Instr), - check_no_remove_depends(Module, Instrs). - -check_no_remove_depend(Module, {load_module, Mod, _Pre, _Post, Depend}) -> - case lists:member(Module, Depend) of - true -> - error({removed_module_in_depend, load_module, Mod, Module}); - false -> - ok - end; -check_no_remove_depend(Module, {update, Mod, _Change, _Pre, _Post, Depend}) -> - case lists:member(Module, Depend) of - true -> - error({removed_module_in_depend, update, Mod, Module}); - false -> - ok - end; -check_no_remove_depend(_, _) -> - ok. - - -check_change(soft) -> - ok; -check_change({advanced, _Something}) -> - ok; -check_change(Change) -> - error({bad_change, Change}). - - -check_purge(soft_purge) -> - ok; -check_purge(brutal_purge) -> - ok; -check_purge(Purge) -> - error({bad_purge, Purge}). - - -check_apply(Module, Function, Args) -> - case (catch Module:module_info()) of - Info when is_list(Info) -> - check_exported(Function, Args, Info); - {'EXIT', {undef, _}} -> - error({not_existing_module, Module}) - end. - -check_exported(Function, Args, Info) -> - case lists:keysearch(exports, 1, Info) of - {value, {exports, FuncList}} -> - Arity = length(Args), - Arities = [A || {F, A} <- FuncList, F == Function], - case lists:member(Arity, Arities) of - true -> - ok; - false -> - error({not_exported_function, Function, Arity}) - end; - _ -> - error({bad_export, Info}) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -error(Reason) -> - throw({error, Reason}). - -fail(Reason) -> - exit({suite_failed, Reason}). - -key1search(Key, L) -> - case lists:keysearch(Key, 1, L) of - undefined -> - fail({not_found, Key, L}); - {value, {Key, Value}} -> - Value - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -d(F, A) -> - d(false, F, A). - -d(true, F, A) -> - io:format(F ++ "~n", A); -d(_, _, _) -> - ok. - - 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_compiler_test.erl b/lib/diameter/test/diameter_compiler_test.erl deleted file mode 100644 index ae4c9c668d..0000000000 --- a/lib/diameter/test/diameter_compiler_test.erl +++ /dev/null @@ -1,104 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the dia compiler of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_compiler_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2 - - %% foo/1 - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - []. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - Config. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case example -%% - -%% foo(suite) -> -%% []; -%% foo(doc) -> -%% []; -%% foo(Config) when is_list(Config) -> -%% ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - diff --git a/lib/diameter/test/diameter_config_test.erl b/lib/diameter/test/diameter_config_test.erl deleted file mode 100644 index c44fb654ab..0000000000 --- a/lib/diameter/test/diameter_config_test.erl +++ /dev/null @@ -1,105 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the config server of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_config_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2 - - %% foo/1 - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - []. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - Config. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case example -%% - -%% foo(suite) -> -%% []; -%% foo(doc) -> -%% []; -%% foo(Config) when is_list(Config) -> -%% ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - 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_etcp_test.beam b/lib/diameter/test/diameter_etcp_test.beam Binary files differdeleted file mode 100644 index efaaec69d5..0000000000 --- a/lib/diameter/test/diameter_etcp_test.beam +++ /dev/null diff --git a/lib/diameter/test/diameter_peer_test.erl b/lib/diameter/test/diameter_peer_test.erl deleted file mode 100644 index 27e75e26ef..0000000000 --- a/lib/diameter/test/diameter_peer_test.erl +++ /dev/null @@ -1,104 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the peer component of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_peer_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2 - - %% foo/1 - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - []. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - Config. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case example -%% - -%% foo(suite) -> -%% []; -%% foo(doc) -> -%% []; -%% foo(Config) when is_list(Config) -> -%% ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - 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_reg_test.erl b/lib/diameter/test/diameter_reg_test.erl deleted file mode 100644 index a2638d6712..0000000000 --- a/lib/diameter/test/diameter_reg_test.erl +++ /dev/null @@ -1,104 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011_2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the reg component of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_reg_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2 - - %% foo/1 - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - []. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - Config. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case example -%% - -%% foo(suite) -> -%% []; -%% foo(doc) -> -%% []; -%% foo(Config) when is_list(Config) -> -%% ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - 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_session_test.erl b/lib/diameter/test/diameter_session_test.erl deleted file mode 100644 index a32647d83d..0000000000 --- a/lib/diameter/test/diameter_session_test.erl +++ /dev/null @@ -1,104 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the session component of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_session_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2 - - %% foo/1 - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - []. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - Config. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case example -%% - -%% foo(suite) -> -%% []; -%% foo(doc) -> -%% []; -%% foo(Config) when is_list(Config) -> -%% ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - 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_stats_test.erl b/lib/diameter/test/diameter_stats_test.erl deleted file mode 100644 index 8b666edf50..0000000000 --- a/lib/diameter/test/diameter_stats_test.erl +++ /dev/null @@ -1,104 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the stats component of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_stats_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2 - - %% foo/1 - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - []. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - Config. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case example -%% - -%% foo(suite) -> -%% []; -%% foo(doc) -> -%% []; -%% foo(Config) when is_list(Config) -> -%% ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - 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_sync_test.erl b/lib/diameter/test/diameter_sync_test.erl deleted file mode 100644 index 618fa5021b..0000000000 --- a/lib/diameter/test/diameter_sync_test.erl +++ /dev/null @@ -1,104 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the sync component of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_sync_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2 - - %% foo/1 - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - []. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - Config. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case example -%% - -%% foo(suite) -> -%% []; -%% foo(doc) -> -%% []; -%% foo(Config) when is_list(Config) -> -%% ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - diff --git a/lib/diameter/test/diameter_tcp_test.erl b/lib/diameter/test/diameter_tcp_test.erl deleted file mode 100644 index b002a3d289..0000000000 --- a/lib/diameter/test/diameter_tcp_test.erl +++ /dev/null @@ -1,482 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the tcp transport component of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_tcp_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/0, - groups/0, - init_per_suite/1, end_per_suite/1, - suite_init/1, suite_fin/1, - init_per_group/2, end_per_group/2, - - start_and_stop_transport_plain/1, - start_and_listen/1, - simple_connect/1, - simple_send_and_recv/1 - - ]). - --export([t/0, t/1]). - -%% diameter_peer (internal) callback API --export([up/1, up/3, recv/2]). - --include("diameter_test_lib.hrl"). --include_lib("diameter/include/diameter.hrl"). -%% -include_lib("diameter/src/tcp/diameter_tcp.hrl"). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all() -> - [ - {group, start}, - {group, simple} - ]. - -groups() -> - [ - {start, [], [start_and_stop_transport_plain, start_and_listen]}, - {simple, [], [simple_connect, simple_send_and_recv]} - ]. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(X) -> init_per_suite(X). - -init_per_suite(suite) -> []; -init_per_suite(doc) -> []; -init_per_suite(Config) when is_list(Config) -> - Config. - - -suite_fin(X) -> end_per_suite(X). - -end_per_suite(suite) -> []; -end_per_suite(doc) -> []; -end_per_suite(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case(s) -%% - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Plain start and stop of TCP transport -%% - -start_and_stop_transport_plain(suite) -> - []; -start_and_stop_transport_plain(doc) -> - []; -start_and_stop_transport_plain(Config) when is_list(Config) -> - - ?SKIP(not_yet_implemented), - - %% This has been changed *a lot* since it was written... - - process_flag(trap_exit, true), - Transport = ensure_transport_started(), - TcpTransport = ensure_tcp_transport_started(), - ensure_tcp_transport_stopped(TcpTransport), - ensure_transport_stopped(Transport), - i("done"), - ok. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Start TCP transport and then create a listen socket -%% - -start_and_listen(suite) -> - []; -start_and_listen(doc) -> - []; -start_and_listen(Config) when is_list(Config) -> - - ?SKIP(not_yet_implemented), - - %% This has been changed *a lot* since it was written... - - process_flag(trap_exit, true), - Transport = ensure_transport_started(), - TcpTransport = ensure_tcp_transport_started(), - - case listen([{port, 0}]) of - {ok, Acceptor} when is_pid(Acceptor) -> - Ref = erlang:monitor(process, Acceptor), - [{Acceptor, Info}] = diameter_tcp:which_listeners(), - case lists:keysearch(socket, 1, Info) of - {value, {_, Listen}} -> - i("Listen socket: ~p" - "~n Opts: ~p" - "~n Stats: ~p" - "~n Name: ~p", - [Listen, - ok(inet:getopts(Listen, [keepalive, delay_send])), - ok(inet:getstat(Listen)), - ok(inet:sockname(Listen)) - ]), - ok; - _ -> - ?FAIL({bad_listener_info, Acceptor, Info}) - end, - Crash = simulate_crash, - exit(Acceptor, Crash), - receive - {'DOWN', Ref, process, Acceptor, Crash} -> - ?SLEEP(1000), - case diameter_tcp:which_listeners() of - [{NewAcceptor, _NewInfo}] -> - diameter_tcp_accept:stop(NewAcceptor), - ?SLEEP(1000), - case diameter_tcp:which_listeners() of - [] -> - ok; - UnexpectedListeners -> - ?FAIL({unexpected_listeners, empty, UnexpectedListeners}) - end; - UnexpectedListeners -> - ?FAIL({unexpected_listeners, non_empty, UnexpectedListeners}) - end - after 5000 -> - ?FAIL({failed_killing, Acceptor}) - end; - Error -> - ?FAIL({failed_creating_acceptor, Error}) - end, - ensure_tcp_transport_stopped(TcpTransport), - ensure_transport_stopped(Transport), - i("done"), - ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% TCP transport connecting -%% - -simple_connect(suite) -> - []; -simple_connect(doc) -> - []; -simple_connect(Config) when is_list(Config) -> - - ?SKIP(not_yet_implemented), - - %% This has been changed *a lot* since it was written... - - process_flag(trap_exit, true), - Transport = ensure_transport_started(), - TcpTransport = ensure_tcp_transport_started(), - {_Acceptor, Port} = ensure_tcp_listener(), - - {ok, Hostname} = inet:gethostname(), - - i("try connect"), - Opts = [{host, Hostname}, {port, Port}, {module, ?MODULE}], - Conn = case connect(Opts) of - {ok, C} -> - C; - Error -> - ?FAIL({failed_connecting, Error}) - end, - i("connected: ~p", [Conn]), - - %% Up for connect - receive - {diameter, {up, Host, Port}} -> - i("Received expected connect up (~p:~p)", [Host, Port]), - ok - after 5000 -> - ?FAIL(connect_up_confirmation_timeout) - end, - - %% Up for accept - receive - {diameter, {up, _ConnPid}} -> - i("Received expected accept up"), - ok - after 5000 -> - ?FAIL(acceptor_up_confirmation_timeout) - end, - - i("try disconnect"), - diameter_tcp:disconnect(Conn), - ensure_tcp_transport_stopped(TcpTransport), - ensure_transport_stopped(Transport), - i("done"), - ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Plain start and stop of TCP transport -%% - -simple_send_and_recv(suite) -> - []; -simple_send_and_recv(doc) -> - []; -simple_send_and_recv(Config) when is_list(Config) -> - - ?SKIP(not_yet_implemented), - - %% This has been changed *a lot* since it was written... - - process_flag(trap_exit, true), - %% -------------------------------------------------- - %% Start the TCP transport sub-system - %% - - Transport = ensure_transport_started(), - TcpTransport = ensure_tcp_transport_started(), - - {_Acceptor, Port} = ensure_tcp_listener(), - - {ok, Hostname} = inet:gethostname(), - - i("try connect"), - Opts = [{host, Hostname}, {port, Port}, {module, ?MODULE}], - Conn = case connect(Opts) of - {ok, C1} -> - C1; - Error -> - ?FAIL({failed_connecting, Error}) - end, - i("connected: ~p", [Conn]), - - %% Up for connect - receive - {diameter, {up, Host, Port}} -> - i("Received expected connect up (~p:~p)", [Host, Port]), - ok - after 5000 -> - ?FAIL(connect_up_confirmation_timeout) - end, - - %% Up for accept - APid = - receive - {diameter, {up, C2}} -> - i("Received expected accept up"), - C2 - after 5000 -> - ?FAIL(acceptor_up_confirmation_timeout) - end, - - %% -------------------------------------------------- - %% Start some stuff needed for the codec to run - %% - - i("start persistent table"), - {ok, _Pers} = diameter_persistent_table:start_link(), - - i("start session"), - {ok, _Session} = diameter_session:start_link(), - - i("try decode a (DWR) message"), - Base = diameter_gen_base_rfc3588, - DWR = ['DWR', - {'Origin-Host', Hostname}, - {'Origin-Realm', "whatever-realm"}, - {'Origin-State-Id', [10]}], - - #diameter_packet{msg = Msg} = diameter_codec:encode(Base, DWR), - - - %% -------------------------------------------------- - %% Now try to send the message - %% - %% This is not the codec-test suite, so we dont really care what we - %% send, as long as it encoded/decodes correctly in the transport - %% - - i("try send from connect side"), - ok = diameter_tcp:send_message(Conn, Msg), - - %% Wait for data on Accept side - APkt = - receive - {diameter, {recv, A}} -> - i("[accept] Received expected data message: ~p", [A]), - A - after 5000 -> - ?FAIL(acceptor_up_confirmation_timeout) - end, - - %% Send the same message back, just to have something to send... - i("try send (\"reply\") from accept side"), - ok = diameter_tcp:send_message(APid, APkt), - - %% Wait for data on Connect side - receive - {diameter, {recv, B}} -> - i("[connect] Received expected data message: ~p", [B]), - ok - after 5000 -> - ?FAIL(acceptor_up_confirmation_timeout) - end, - - i("we are done - now close shop"), - diameter_session:stop(), - diameter_persistent_table:stop(), - - ensure_tcp_transport_stopped(TcpTransport), - ensure_transport_stopped(Transport), - i("done"), - ok. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -ensure_transport_started() -> -%% i("start diameter transport (top) supervisor"), - case diameter_transport_sup:start_link() of - {ok, TransportSup} -> - TransportSup; - Error -> - ?FAIL({failed_starting_transport_sup, Error}) - end. - -ensure_transport_stopped(Pid) when is_pid(Pid) -> -%% i("stop diameter transport (top) supervisor"), - Stop = fun(P) -> exit(P, kill) end, - ensure_stopped(Pid, Stop, failed_stopping_transport_sup). - -ensure_tcp_transport_started() -> -%% i("start diameter TCP transport"), - case diameter_tcp:start_transport() of - {ok, TcpTransport} when is_pid(TcpTransport) -> - TcpTransport; - Error -> - ?FAIL({failed_starting_transport, Error}) - end. - -ensure_tcp_transport_stopped(Pid) when is_pid(Pid) -> -%% i("stop diameter TCP transport supervisor"), - Stop = fun(P) -> diameter_tcp:stop_transport(P) end, - ensure_stopped(Pid, Stop, failed_stopping_tcp_transport). - - -ensure_tcp_listener() -> -%% i("create diameter TCP transport listen socket"), - case listen([{port, 0}]) of - {ok, Acceptor} -> - [{Acceptor, Info}] = diameter_tcp:which_listeners(), - case lists:keysearch(socket, 1, Info) of - {value, {_, Listen}} -> - {ok, Port} = inet:port(Listen), - {Acceptor, Port}; - _ -> - ?FAIL({failed_retrieving_listen_socket, Info}) - end; - Error -> - ?FAIL({failed_creating_listen_socket, Error}) - end. - - -ensure_stopped(Pid, Stop, ReasonTag) when is_pid(Pid) -> -%% i("ensure_stopped -> create monitor to ~p", [Pid]), - Ref = erlang:monitor(process, Pid), -%% i("ensure_stopped -> try stop"), - Stop(Pid), -%% i("ensure_stopped -> await DOWN message"), - receive - {'DOWN', Ref, process, Pid, _} -> -%% i("ensure_stopped -> received DOWN message"), - ok - after 5000 -> -%% i("ensure_stopped -> timeout"), - ?FAIL({ReasonTag, Pid}) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -listen(Opts) -> - diameter_tcp:listen([{module, ?MODULE} | Opts]). - -connect(Opts) -> - diameter_tcp:connect([{module, ?MODULE} | Opts]). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -up(Pid, Host, Port) -> - Pid ! {diameter, {up, Host, Port}}, - ok. - -up(Pid) -> - Pid ! {diameter, {up, self()}}, - ok. - -recv(Pid, Pkt) -> - Pid ! {diameter, {recv, Pkt}}. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -i(F) -> - i(F, []). - -i(F, A) -> - io:format(F ++ "~n", A). - - -ok({ok, Whatever}) -> - Whatever; -ok(Crap) -> - Crap. - - diff --git a/lib/diameter/test/diameter_test_lib.erl b/lib/diameter/test/diameter_test_lib.erl deleted file mode 100644 index 3d46236526..0000000000 --- a/lib/diameter/test/diameter_test_lib.erl +++ /dev/null @@ -1,478 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Lightweight test server -%%---------------------------------------------------------------------- -%% - --module(diameter_test_lib). - --export([ - sleep/1, - - hours/1, - minutes/1, - seconds/1, - - key1search/2, - - non_pc_tc_maybe_skip/4, - os_based_skip/1, - - fail/3, - skip/3, - fatal_skip/3, - - log/4, - error/3, - - flush/0, - - proxy_start/1, proxy_start/2, - proxy_init/2, - - still_alive/1, - - prepare_test_case/5, - lookup_config/2, - - mk_nodes/2, start_nodes/3, - - display_system_info/1, display_system_info/2, display_system_info/3, - display_alloc_info/0, - alloc_info/0, - - report_event/3 - - ]). - --include("diameter_test_lib.hrl"). - --record('REASON', {mod, line, desc}). - - -%% ---------------------------------------------------------------- -%% Time related function -%% - -sleep(infinity) -> - receive - after infinity -> - ok - end; -sleep(MSecs) -> - receive - after trunc(MSecs) -> - ok - end, - ok. - - -hours(N) -> trunc(N * 1000 * 60 * 60). -minutes(N) -> trunc(N * 1000 * 60). -seconds(N) -> trunc(N * 1000). - - -%% ---------------------------------------------------------------- - -key1search(Key, L) -> - case lists:keysearch(Key, 1, L) of - undefined -> - fail({not_found, Key, L}, ?MODULE, ?LINE); - {value, {Key, Value}} -> - Value - end. - - -%% ---------------------------------------------------------------- -%% Conditional skip of testcases -%% - -non_pc_tc_maybe_skip(Config, Condition, File, Line) - when is_list(Config) andalso is_function(Condition) -> - %% Check if we shall skip the skip - case os:getenv("TS_OS_BASED_SKIP") of - "false" -> - ok; - _ -> - case lists:keysearch(ts, 1, Config) of - {value, {ts, megaco}} -> - %% Always run the testcase if we are using our own - %% test-server... - ok; - _ -> - case (catch Condition()) of - true -> - skip(non_pc_testcase, File, Line); - _ -> - ok - end - end - end. - - -os_based_skip(any) -> - true; -os_based_skip(Skippable) when is_list(Skippable) -> - {OsFam, OsName} = - case os:type() of - {_Fam, _Name} = FamAndName -> - FamAndName; - Fam -> - {Fam, undefined} - end, - case lists:member(OsFam, Skippable) of - true -> - true; - false -> - case lists:keysearch(OsFam, 1, Skippable) of - {value, {OsFam, OsName}} -> - true; - {value, {OsFam, OsNames}} when is_list(OsNames) -> - lists:member(OsName, OsNames); - _ -> - false - end - end; -os_based_skip(_) -> - false. - - -%%---------------------------------------------------------------------- - -error(Actual, Mod, Line) -> - global:send(megaco_global_logger, {failed, Mod, Line}), - log("<ERROR> Bad result: ~p~n", [Actual], Mod, Line), - Label = lists:concat([Mod, "(", Line, ") unexpected result"]), - report_event(60, Label, [{line, Mod, Line}, {error, Actual}]), - case global:whereis_name(megaco_test_case_sup) of - undefined -> - ignore; - Pid -> - Fail = #'REASON'{mod = Mod, line = Line, desc = Actual}, - Pid ! {fail, self(), Fail} - end, - Actual. - -log(Format, Args, Mod, Line) -> - case global:whereis_name(megaco_global_logger) of - undefined -> - io:format(user, "~p~p(~p): " ++ Format, - [self(), Mod, Line] ++ Args); - Pid -> - io:format(Pid, "~p~p(~p): " ++ Format, - [self(), Mod, Line] ++ Args) - end. - -skip(Actual, File, Line) -> - log("Skipping test case~n", [], File, Line), - String = lists:flatten(io_lib:format("Skipping test case ~p(~p): ~p~n", - [File, Line, Actual])), - exit({skipped, String}). - -fatal_skip(Actual, File, Line) -> - error(Actual, File, Line), - exit(shutdown). - - -fail(Actual, File, Line) -> - log("Test case failing~n", [], File, Line), - String = lists:flatten(io_lib:format("Test case failing ~p (~p): ~p~n", - [File, Line, Actual])), - exit({suite_failed, String}). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Flush the message queue and return its messages - -flush() -> - receive - Msg -> - [Msg | flush()] - after 1000 -> - [] - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% The proxy process - -proxy_start(ProxyId) -> - spawn_link(?MODULE, proxy_init, [ProxyId, self()]). - -proxy_start(Node, ProxyId) -> - spawn_link(Node, ?MODULE, proxy_init, [ProxyId, self()]). - -proxy_init(ProxyId, Controller) -> - process_flag(trap_exit, true), - ?LOG("[~p] proxy started by ~p~n",[ProxyId, Controller]), - proxy_loop(ProxyId, Controller). - -proxy_loop(OwnId, Controller) -> - receive - {'EXIT', Controller, Reason} -> - p("proxy_loop -> received exit from controller" - "~n Reason: ~p" - "~n", [Reason]), - exit(Reason); - {apply, Fun} -> - p("proxy_loop -> received apply request~n", []), - Res = Fun(), - p("proxy_loop -> apply result: " - "~n ~p" - "~n", [Res]), - Controller ! {res, OwnId, Res}, - proxy_loop(OwnId, Controller); - OtherMsg -> - p("proxy_loop -> received unknown message: " - "~n OtherMsg: ~p" - "~n", [OtherMsg]), - Controller ! {msg, OwnId, OtherMsg}, - proxy_loop(OwnId, Controller) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Check if process is alive and kicking -still_alive(Pid) -> - case catch erlang:is_process_alive(Pid) of % New BIF in Erlang/OTP R5 - true -> - true; - false -> - false; - {'EXIT', _} -> % Pre R5 backward compatibility - case process_info(Pid, message_queue_len) of - undefined -> false; - _ -> true - end - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -mk_nodes(0, Nodes) -> - Nodes; -mk_nodes(N, []) -> - mk_nodes(N - 1, [node()]); -mk_nodes(N, Nodes) when N > 0 -> - Head = hd(Nodes), - [Name, Host] = node_to_name_and_host(Head), - Nodes ++ [mk_node(I, Name, Host) || I <- lists:seq(1, N)]. - -mk_node(N, Name, Host) -> - list_to_atom(lists:concat([Name ++ integer_to_list(N) ++ "@" ++ Host])). - -%% Returns [Name, Host] -node_to_name_and_host(Node) -> - string:tokens(atom_to_list(Node), [$@]). - -start_nodes([Node | Nodes], File, Line) -> - case net_adm:ping(Node) of - pong -> - start_nodes(Nodes, File, Line); - pang -> - [Name, Host] = node_to_name_and_host(Node), - case slave:start_link(Host, Name) of - {ok, NewNode} when NewNode =:= Node -> - Path = code:get_path(), - {ok, Cwd} = file:get_cwd(), - true = rpc:call(Node, code, set_path, [Path]), - ok = rpc:call(Node, file, set_cwd, [Cwd]), - true = rpc:call(Node, code, set_path, [Path]), - {_, []} = rpc:multicall(global, sync, []), - start_nodes(Nodes, File, Line); - Other -> - fatal_skip({cannot_start_node, Node, Other}, File, Line) - end - end; -start_nodes([], _File, _Line) -> - ok. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -display_alloc_info() -> - io:format("Allocator memory information:~n", []), - AllocInfo = alloc_info(), - display_alloc_info(AllocInfo). - -display_alloc_info([]) -> - ok; -display_alloc_info([{Alloc, Mem}|AllocInfo]) -> - io:format(" ~15w: ~10w~n", [Alloc, Mem]), - display_alloc_info(AllocInfo). - -alloc_info() -> - case erlang:system_info(allocator) of - {_Allocator, _Version, Features, _Settings} -> - alloc_info(Features); - _ -> - [] - end. - -alloc_info(Allocators) -> - Allocs = [temp_alloc, sl_alloc, std_alloc, ll_alloc, eheap_alloc, - ets_alloc, binary_alloc, driver_alloc], - alloc_info(Allocators, Allocs, []). - -alloc_info([], _, Acc) -> - lists:reverse(Acc); -alloc_info([Allocator | Allocators], Allocs, Acc) -> - case lists:member(Allocator, Allocs) of - true -> - Instances0 = erlang:system_info({allocator, Allocator}), - Instances = - if - is_list(Instances0) -> - [Instance || Instance <- Instances0, - element(1, Instance) =:= instance]; - true -> - [] - end, - AllocatorMem = alloc_mem_info(Instances), - alloc_info(Allocators, Allocs, [{Allocator, AllocatorMem} | Acc]); - - false -> - alloc_info(Allocators, Allocs, Acc) - end. - -alloc_mem_info(Instances) -> - alloc_mem_info(Instances, []). - -alloc_mem_info([], Acc) -> - lists:sum([Mem || {instance, _, Mem} <- Acc]); -alloc_mem_info([{instance, N, Info}|Instances], Acc) -> - InstanceMemInfo = alloc_instance_mem_info(Info), - alloc_mem_info(Instances, [{instance, N, InstanceMemInfo} | Acc]). - -alloc_instance_mem_info(InstanceInfo) -> - MBCS = alloc_instance_mem_info(mbcs, InstanceInfo), - SBCS = alloc_instance_mem_info(sbcs, InstanceInfo), - MBCS + SBCS. - -alloc_instance_mem_info(Key, InstanceInfo) -> - case lists:keysearch(Key, 1, InstanceInfo) of - {value, {Key, Info}} -> - case lists:keysearch(blocks_size, 1, Info) of - {value, {blocks_size, Mem, _, _}} -> - Mem; - _ -> - 0 - end; - _ -> - 0 - end. - - -display_system_info(WhenStr) -> - display_system_info(WhenStr, undefined, undefined). - -display_system_info(WhenStr, undefined, undefined) -> - display_system_info(WhenStr, ""); -display_system_info(WhenStr, Mod, Func) -> - ModFuncStr = lists:flatten(io_lib:format(" ~w:~w", [Mod, Func])), - display_system_info(WhenStr, ModFuncStr). - -display_system_info(WhenStr, ModFuncStr) -> - Fun = fun(F) -> case (catch F()) of - {'EXIT', _} -> - undefined; - Res -> - Res - end - end, - ProcCount = Fun(fun() -> erlang:system_info(process_count) end), - ProcLimit = Fun(fun() -> erlang:system_info(process_limit) end), - ProcMemAlloc = Fun(fun() -> erlang:memory(processes) end), - ProcMemUsed = Fun(fun() -> erlang:memory(processes_used) end), - ProcMemBin = Fun(fun() -> erlang:memory(binary) end), - ProcMemTot = Fun(fun() -> erlang:memory(total) end), - %% error_logger:info_msg( - io:format("~n" - "~n*********************************************" - "~n" - "System info ~s~s => " - "~n Process count: ~w" - "~n Process limit: ~w" - "~n Process memory alloc: ~w" - "~n Process memory used: ~w" - "~n Memory for binaries: ~w" - "~n Memory total: ~w" - "~n" - "~n*********************************************" - "~n" - "~n", [WhenStr, ModFuncStr, - ProcCount, ProcLimit, ProcMemAlloc, ProcMemUsed, - ProcMemBin, ProcMemTot]), - ok. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -prepare_test_case(Actions, N, Config, File, Line) -> - OrigNodes = lookup_config(nodes, Config), - TestNodes = lookup_config(nodenames, Config), %% For testserver - This = node(), - SomeNodes = OrigNodes ++ (TestNodes -- OrigNodes), - AllNodes = [This | (SomeNodes -- [This])], - Nodes = pick_n_nodes(N, AllNodes, File, Line), - start_nodes(Nodes, File, Line), - do_prepare_test_case(Actions, Nodes, Config, File, Line). - -do_prepare_test_case([init | Actions], Nodes, Config, File, Line) -> - process_flag(trap_exit, true), - megaco_test_lib:flush(), - do_prepare_test_case(Actions, Nodes, Config, File, Line); -do_prepare_test_case([{stop_app, App} | Actions], Nodes, Config, File, Line) -> - _Res = rpc:multicall(Nodes, application, stop, [App]), - do_prepare_test_case(Actions, Nodes, Config, File, Line); -do_prepare_test_case([], Nodes, _Config, _File, _Line) -> - Nodes. - -pick_n_nodes(all, AllNodes, _File, _Line) -> - AllNodes; -pick_n_nodes(N, AllNodes, _File, _Line) - when is_integer(N) andalso (length(AllNodes) >= N) -> - AllNodes -- lists:nthtail(N, AllNodes); -pick_n_nodes(N, AllNodes, File, Line) -> - fatal_skip({too_few_nodes, N, AllNodes}, File, Line). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -lookup_config(Key, Config) -> - case lists:keysearch(Key, 1, Config) of - {value, {Key, Val}} -> - Val; - _ -> - [] - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -report_event(_Severity, _Label, _Content) -> - %% diameter:report_event(Severity, Label, Content). - hopefully_traced. - - -p(F,A) -> - io:format("~p" ++ F ++ "~n", [self()|A]). diff --git a/lib/diameter/test/diameter_test_lib.hrl b/lib/diameter/test/diameter_test_lib.hrl deleted file mode 100644 index 0b86f38de7..0000000000 --- a/lib/diameter/test/diameter_test_lib.hrl +++ /dev/null @@ -1,106 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Define common macros for testing -%%---------------------------------------------------------------------- -%% - --define(FLUSH(), diameter_test_lib:flush()). - --define(SLEEP(MSEC), diameter_test_lib:sleep(MSEC)). --define(M(), diameter_test_lib:millis()). --define(MDIFF(A,B), diameter_test_lib:millis_diff(A,B)). - --define(HOURS(T), diameter_test_lib:hours(T)). --define(MINUTES(T), diameter_test_lib:minutes(T)). --define(SECONDS(T), diameter_test_lib:seconds(T)). - --define(KEY1SEARCH(Key, L), diameter_test_lib:key1search(Key, L)). - - --define(APPLY(Proxy, Fun), - Proxy ! {apply, Fun}). - --define(LOG(Format, Args), - diameter_test_lib:log(Format, Args, ?MODULE, ?LINE)). - --define(ERROR(Reason), - diameter_test_lib:error(Reason, ?MODULE, ?LINE)). - --define(OS_BASED_SKIP(Skippable), - diameter_test_lib:os_based_skip(Skippable)). - --define(NON_PC_TC_MAYBE_SKIP(Config, Condition), - diameter_test_lib:non_pc_tc_maybe_skip(Config, Condition, ?MODULE, ?LINE)). - --define(FAIL(Reason), - diameter_test_lib:fail(Reason, ?MODULE, ?LINE)). - --define(SKIP(Reason), - diameter_test_lib:skip(Reason, ?MODULE, ?LINE)). - --define(VERIFYL(Expected, Expr), - fun(A,B) when list(A), list(B) -> - A1 = lists:sort(A), - B1 = lists:sort(B), - case A1 of - B1 -> ?LOG("Ok, ~p~n", [B]); - _ -> ?ERROR(B) - end, - B; - (A,A) -> - ?LOG("Ok, ~p~n", [A]), - A; - (A,B) -> - ?ERROR(B), - B - end(Expected, (catch Expr))). - --define(VERIFY(Expected, Expr), - fun() -> - AcTuAlReS = (catch (Expr)), - case AcTuAlReS of - Expected -> ?LOG("Ok, ~p~n", [AcTuAlReS]); - _ -> ?ERROR(AcTuAlReS) - end, - AcTuAlReS - end()). - --define(RECEIVE(Expected), - ?VERIFY(Expected, ?FLUSH())). - --define(MULTI_RECEIVE(Expected), - ?VERIFY(lists:sort(Expected), lists:sort(?FLUSH()))). - --define(ACQUIRE_NODES(N, Config), - diameter_test_lib:prepare_test_case([init, {stop_app, diameter}], - N, Config, ?FILE, ?LINE)). - - --define(REPORT_IMPORTANT(Label, Content), ?REPORT_EVENT(20, Label, Content)). --define(REPORT_VERBOSE(Label, Content), ?REPORT_EVENT(40, Label, Content)). --define(REPORT_DEBUG(Label, Content), ?REPORT_EVENT(60, Label, Content)). --define(REPORT_TRACE(Label, Content), ?REPORT_EVENT(80, Label, Content)). - --define(REPORT_EVENT(Severity, Label, Content), - diameter_test_lib:report_event(Severity, Label, - [{line, ?MODULE, ?LINE} | Content])). - diff --git a/lib/diameter/test/diameter_test_server.erl b/lib/diameter/test/diameter_test_server.erl deleted file mode 100644 index e2ff73fb8e..0000000000 --- a/lib/diameter/test/diameter_test_server.erl +++ /dev/null @@ -1,551 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Lightweight test server -%%---------------------------------------------------------------------- - --module(diameter_test_server). - --export([ - t/1, t/2, - - init_per_testcase/2, - fin_per_testcase/2 - ]). - --include("diameter_test_lib.hrl"). - - --define(GLOGGER, diameter_global_logger). - - -%% ---------------------------------------------------------------- -%% - -t([Case]) when is_atom(Case) -> - t(Case); -t(Case) -> - process_flag(trap_exit, true), - MEM = fun() -> case (catch erlang:memory()) of - {'EXIT', _} -> - []; - Res -> - Res - end - end, - Alloc1 = diameter_test_lib:alloc_info(), - Mem1 = MEM(), - Res = lists:flatten(t(Case, default_config())), - Alloc2 = diameter_test_lib:alloc_info(), - Mem2 = MEM(), - %% io:format("Res: ~p~n", [Res]), - display_result(Res, Alloc1, Mem1, Alloc2, Mem2), - Res. - - -groups(Mod) when is_atom(Mod) -> - try Mod:groups() of - Groups when is_list(Groups) -> - Groups; - BadGroups -> - exit({bad_groups, Mod, BadGroups}) - catch - _:_ -> - [] - end. - -init_suite(Mod, Config) -> - io:format("~w:init_suite -> entry with" - "~n Mod: ~p" - "~n Config: ~p" - "~n", [?MODULE, Mod, Config]), - Mod:init_per_suite(Config). - -end_suite(Mod, Config) -> - Mod:end_per_suite(Config). - -init_group(Mod, Group, Config) -> - Mod:init_per_group(Group, Config). - -end_group(Mod, Group, Config) -> - Mod:init_per_group(Group, Config). - -%% This is for sub-SUITEs -t({_Mod, {NewMod, all}, _Groups}, _Config) when is_atom(NewMod) -> - io:format("~w:t(all) -> entry with" - "~n NewMod: ~p" - "~n", [?MODULE, NewMod]), - t(NewMod); -t({Mod, {group, Name} = Group, Groups}, Config) - when is_atom(Mod) andalso is_atom(Name) andalso is_list(Groups) -> - io:format("~w:t(group) -> entry with" - "~n Mod: ~p" - "~n Name: ~p" - "~n Groups: ~p" - "~n Config: ~p" - "~n", [?MODULE, Mod, Name, Groups, Config]), - case lists:keysearch(Name, 1, Groups) of - {value, {Name, _Props, GroupsAndCases}} -> - try init_group(Mod, Name, Config) of - Config2 when is_list(Config2) -> - Res = [t({Mod, Case, Groups}, Config2) || - Case <- GroupsAndCases], - (catch end_group(Mod, Name, Config2)), - Res; - Error -> - io:format(" => group (~w) init failed: ~p~n", - [Name, Error]), - [{failed, {Mod, Group}, Error}] - catch - exit:{skipped, SkipReason} -> - io:format(" => skipping group: ~p~n", [SkipReason]), - [{skipped, {Mod, Group}, SkipReason, 0}]; - exit:{undef, _} -> - [t({Mod, Case, Groups}, Config) || - Case <- GroupsAndCases]; - T:E -> - [{failed, {Mod, Group}, {T,E}, 0}] - end; - false -> - exit({unknown_group, Mod, Name, Groups}) - end; -t({Mod, Fun, _}, Config) - when is_atom(Mod) andalso is_atom(Fun) -> - io:format("~w:t -> entry with" - "~n Mod: ~p" - "~n Fun: ~p" - "~n Config: ~p" - "~n", [?MODULE, Mod, Fun, Config]), - case catch apply(Mod, Fun, [suite]) of - [] -> - io:format("Eval: ~p:", [{Mod, Fun}]), - Res = eval(Mod, Fun, Config), - {R, _, _, _} = Res, - io:format(" ~p~n", [R]), - Res; - - Cases when is_list(Cases) -> - io:format("Expand: ~p ...~n", [{Mod, Fun}]), - Map = fun(Case) when is_atom(Case) -> {Mod, Case}; - (Case) -> Case - end, - t(lists:map(Map, Cases), Config); - - {'EXIT', {undef, _}} -> - io:format("Undefined: ~p~n", [{Mod, Fun}]), - [{nyi, {Mod, Fun}, ok, 0}]; - - Error -> - io:format("Ignoring: ~p: ~p~n", [{Mod, Fun}, Error]), - [{failed, {Mod, Fun}, Error, 0}] - end; -t(Mod, Config) when is_atom(Mod) -> - io:format("~w:t -> entry with" - "~n Mod: ~p" - "~n Config: ~p" - "~n", [?MODULE, Mod, Config]), - %% This is assumed to be a test suite, so we start by calling - %% the top test suite function(s) (all/0 and groups/0). - case (catch Mod:all()) of - Cases when is_list(Cases) -> - %% The list may contain atoms (actual test cases) and - %% group-tuples (a tuple naming a group of test cases). - %% A group is defined by the (optional) groups/0 function. - io:format("~w:t -> suite all ok" - "~n Cases: ~p" - "~n", [?MODULE, Cases]), - Groups = groups(Mod), - io:format("~w:t -> " - "~n Groups: ~p" - "~n", [?MODULE, Groups]), - try init_suite(Mod, Config) of - Config2 when is_list(Config2) -> - io:format("~w:t -> suite init ok" - "~n Config2: ~p" - "~n", [?MODULE, Config2]), - Res = [t({Mod, Case, Groups}, Config2) || Case <- Cases], - (catch end_suite(Mod, Config2)), - Res; - Error -> - io:format(" => suite init failed: ~p~n", [Error]), - [{failed, {Mod, init_per_suite}, Error}] - catch - exit:{skipped, SkipReason} -> - io:format(" => skipping suite: ~p~n", [SkipReason]), - [{skipped, {Mod, init_per_suite}, SkipReason, 0}]; - exit:{undef, _} -> - io:format("~w:t -> suite init failed. exit undef(1)~n", [?MODULE]), - [t({Mod, Case, Groups}, Config) || Case <- Cases]; - exit:undef -> - io:format("~w:t -> suite init failed. exit undef(2)~n", [?MODULE]), - [t({Mod, Case, Groups}, Config) || Case <- Cases]; - T:E -> - io:format("~w:t -> suite init failed. " - "~n T: ~p" - "~n E: ~p" - "~n", [?MODULE, T,E]), - [{failed, {Mod, init_per_suite}, {T,E}, 0}] - end; - {'EXIT', {undef, _}} -> - io:format("Undefined: ~p~n", [{Mod, all}]), - [{nyi, {Mod, all}, ok, 0}]; - - Crap -> - io:format("~w:t -> suite all failed: " - "~n Crap: ~p" - "~n", [?MODULE, Crap]), - Crap - end; -t(Bad, _Config) -> - io:format("~w:t -> entry with" - "~n Bad: ~p" - "~n", [?MODULE, Bad]), - [{badarg, Bad, ok, 0}]. - -eval(Mod, Fun, Config) -> - TestCase = {?MODULE, Mod, Fun}, - Label = lists:concat(["TEST CASE: ", Fun]), - ?REPORT_VERBOSE(Label ++ " started", [TestCase, Config]), - global:register_name(diameter_test_case_sup, self()), - Flag = process_flag(trap_exit, true), - put(diameter_test_server, true), - Config2 = Mod:init_per_testcase(Fun, Config), - Self = self(), - Pid = spawn_link(fun() -> do_eval(Self, Mod, Fun, Config2) end), - R = wait_for_evaluator(Pid, Mod, Fun, Config2, []), - Mod:fin_per_testcase(Fun, Config2), - erase(diameter_test_server), - global:unregister_name(diameter_test_case_sup), - process_flag(trap_exit, Flag), - R. - -wait_for_evaluator(Pid, Mod, Fun, Config, Errors) -> - wait_for_evaluator(Pid, Mod, Fun, Config, Errors, 0). -wait_for_evaluator(Pid, Mod, Fun, Config, Errors, AccTime) -> - TestCase = {?MODULE, Mod, Fun}, - Label = lists:concat(["TEST CASE: ", Fun]), - receive - {done, Pid, ok, Time} when Errors =:= [] -> - ?REPORT_VERBOSE(Label ++ " ok", - [{test_case, TestCase}, {config, Config}]), - {ok, {Mod, Fun}, Errors, Time}; - {done, Pid, ok, Time} -> - ?REPORT_VERBOSE(Label ++ " failed", - [{test_case, TestCase}, {config, Config}]), - {failed, {Mod, Fun}, Errors, Time}; - {done, Pid, {ok, _}, Time} when Errors =:= [] -> - ?REPORT_VERBOSE(Label ++ " ok", - [{test_case, TestCase}, {config, Config}]), - {ok, {Mod, Fun}, Errors, Time}; - {done, Pid, {ok, _}, Time} -> - ?REPORT_VERBOSE(Label ++ " failed", - [{test_case, TestCase}, {config, Config}]), - {failed, {Mod, Fun}, Errors, Time}; - {done, Pid, Fail, Time} -> - ?REPORT_IMPORTANT(Label ++ " failed", - [{test_case, TestCase}, - {config, Config}, - {return, Fail}, - {errors, Errors}]), - {failed, {Mod, Fun}, Fail, Time}; - {'EXIT', Pid, {skipped, Reason}, Time} -> - ?REPORT_IMPORTANT(Label ++ " skipped", - [{test_case, TestCase}, - {config, Config}, - {skipped, Reason}]), - {skipped, {Mod, Fun}, Errors, Time}; - {'EXIT', Pid, Reason, Time} -> - ?REPORT_IMPORTANT(Label ++ " crashed", - [{test_case, TestCase}, - {config, Config}, - {'EXIT', Reason}]), - {crashed, {Mod, Fun}, [{'EXIT', Reason} | Errors], Time}; - {fail, Pid, Reason, Time} -> - wait_for_evaluator(Pid, Mod, Fun, Config, - Errors ++ [Reason], AccTime + Time) - end. - -do_eval(ReplyTo, Mod, Fun, Config) -> - diameter_test_lib:display_system_info("before", Mod, Fun), - case timer:tc(Mod, Fun, [Config]) of - {Time, {'EXIT', {skipped, Reason}}} -> - display_tc_time(Time), - diameter_test_lib:display_system_info("after (skipped)", Mod, Fun), - ReplyTo ! {'EXIT', self(), {skipped, Reason}, Time}; - {Time, {'EXIT', Reason}} -> - display_tc_time(Time), - diameter_test_lib:display_system_info("after (crashed)", Mod, Fun), - ReplyTo ! {'EXIT', self(), Reason, Time}; - {Time, Other} -> - display_tc_time(Time), - diameter_test_lib:display_system_info("after", Mod, Fun), - ReplyTo ! {done, self(), Other, Time} - end, - unlink(ReplyTo), - exit(shutdown). - - -display_tc_time(Time) -> - io:format("~n" - "~n*********************************************" - "~n" - "~nTest case completion time: ~.3f sec (~w)" - "~n", [(Time / 1000000), Time]), - ok. - - -display_result(Res, Alloc1, Mem1, Alloc2, Mem2) -> - io:format("~nAllocator info: ~n", []), - display_alloc(Alloc1, Alloc2), - io:format("~nMemory info: ~n", []), - display_memory(Mem1, Mem2), - display_result(Res). - -display_alloc([], []) -> - io:format("-~n", []), - ok; -display_alloc(A1, A2) -> - do_display_alloc(A1, A2). - -do_display_alloc([], _) -> - ok; -do_display_alloc([{Alloc, Mem1}|AllocInfo1], AllocInfo2) -> - Mem2 = - case lists:keysearch(Alloc, 1, AllocInfo2) of - {value, {_, Val}} -> - Val; - false -> - undefined - end, - io:format("~15w: ~10w -> ~w~n", [Alloc, Mem1, Mem2]), - do_display_alloc(AllocInfo1, AllocInfo2). - -display_memory([], []) -> - io:format("-~n", []), - ok; -display_memory(Mem1, Mem2) -> - do_display_memory(Mem1, Mem2). - - -do_display_memory([], _) -> - ok; -do_display_memory([{Key, Mem1}|MemInfo1], MemInfo2) -> - Mem2 = - case lists:keysearch(Key, 1, MemInfo2) of - {value, {_, Val}} -> - Val; - false -> - undefined - end, - io:format("~15w: ~10w -> ~w~n", [Key, Mem1, Mem2]), - do_display_memory(MemInfo1, MemInfo2). - -display_result([]) -> - io:format("OK~n", []); -display_result(Res) when is_list(Res) -> - Ok = [{MF, Time} || {ok, MF, _, Time} <- Res], - Nyi = [MF || {nyi, MF, _, _Time} <- Res], - Skipped = [{MF, Reason} || {skipped, MF, Reason, _Time} <- Res], - Failed = [{MF, Reason} || {failed, MF, Reason, _Time} <- Res], - Crashed = [{MF, Reason} || {crashed, MF, Reason, _Time} <- Res], - display_summery(Ok, Nyi, Skipped, Failed, Crashed), - display_ok(Ok), - display_skipped(Skipped), - display_failed(Failed), - display_crashed(Crashed). - -display_summery(Ok, Nyi, Skipped, Failed, Crashed) -> - io:format("~nTest case summery:~n", []), - display_summery(Ok, "successfull"), - display_summery(Nyi, "not yet implemented"), - display_summery(Skipped, "skipped"), - display_summery(Failed, "failed"), - display_summery(Crashed, "crashed"), - io:format("~n", []). - -display_summery(Res, Info) -> - io:format(" ~w test cases ~s~n", [length(Res), Info]). - -display_ok([]) -> - ok; -display_ok(Ok) -> - io:format("Ok test cases:~n", []), - F = fun({{M, F}, Time}) -> - io:format(" ~w : ~w => ~.2f sec~n", [M, F, Time / 1000000]) - end, - lists:foreach(F, Ok), - io:format("~n", []). - -display_skipped([]) -> - ok; -display_skipped(Skipped) -> - io:format("Skipped test cases:~n", []), - F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end, - lists:foreach(F, Skipped), - io:format("~n", []). - - -display_failed([]) -> - ok; -display_failed(Failed) -> - io:format("Failed test cases:~n", []), - F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end, - lists:foreach(F, Failed), - io:format("~n", []). - -display_crashed([]) -> - ok; -display_crashed(Crashed) -> - io:format("Crashed test cases:~n", []), - F = fun({MF, Reason}) -> io:format(" ~p => ~p~n", [MF, Reason]) end, - lists:foreach(F, Crashed), - io:format("~n", []). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Test server callbacks -init_per_testcase(_Case, Config) -> - Pid = group_leader(), - Name = ?GLOGGER, - case global:whereis_name(Name) of - undefined -> - global:register_name(?GLOGGER, Pid); - Pid -> - io:format("~w:init_per_testcase -> " - "already registered to ~p~n", [?MODULE, Pid]), - ok; - OtherPid when is_pid(OtherPid) -> - io:format("~w:init_per_testcase -> " - "already registered to other ~p (~p)~n", - [?MODULE, OtherPid, Pid]), - exit({already_registered, {?GLOGGER, OtherPid, Pid}}) - end, - set_kill_timer(Config). - -fin_per_testcase(_Case, Config) -> - Name = ?GLOGGER, - case global:whereis_name(Name) of - undefined -> - io:format("~w:fin_per_testcase -> already un-registered~n", - [?MODULE]), - ok; - Pid when is_pid(Pid) -> - global:unregister_name(?GLOGGER), - ok - end, - reset_kill_timer(Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Set kill timer - -set_kill_timer(Config) -> - case init:get_argument(diameter_test_timeout) of - {ok, _} -> - Config; - _ -> - Time = - case lookup_config(tc_timeout, Config) of - [] -> - timer:minutes(5); - ConfigTime when is_integer(ConfigTime) -> - ConfigTime - end, - Dog = - case get(diameter_test_server) of - true -> - Self = self(), - spawn_link(fun() -> watchdog(Self, Time) end); - _ -> - test_server:timetrap(Time) - end, - [{kill_timer, Dog}|Config] - - - end. - -reset_kill_timer(Config) -> - DogKiller = - case get(diameter_test_server) of - true -> - fun(P) when is_pid(P) -> P ! stop; - (_) -> ok - end; - _ -> - fun(Ref) -> test_server:timetrap_cancel(Ref) end - end, - case lists:keysearch(kill_timer, 1, Config) of - {value, {kill_timer, Dog}} -> - DogKiller(Dog), - lists:keydelete(kill_timer, 1, Config); - _ -> - Config - end. - -watchdog(Pid, Time) -> - erlang:now(), - receive - stop -> - ok - after Time -> - case (catch process_info(Pid)) of - undefined -> - ok; - Info -> - ?LOG("<ERROR> Watchdog in test case timed out " - "for ~p after ~p min" - "~n~p" - "~n", - [Pid, Time div (1000*60), Info]), - exit(Pid, kill) - end - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -lookup_config(Key, Config) -> - diameter_test_lib:lookup_config(Key, Config). - -default_config() -> - [{nodes, default_nodes()}, {ts, diameter}]. - -default_nodes() -> - mk_nodes(2, []). - -mk_nodes(0, Nodes) -> - Nodes; -mk_nodes(N, []) -> - mk_nodes(N - 1, [node()]); -mk_nodes(N, Nodes) when N > 0 -> - Head = hd(Nodes), - [Name, Host] = node_to_name_and_host(Head), - Nodes ++ [mk_node(I, Name, Host) || I <- lists:seq(1, N)]. - -mk_node(N, Name, Host) -> - list_to_atom(lists:concat([Name ++ integer_to_list(N) ++ "@" ++ Host])). - -%% Returns [Name, Host] -node_to_name_and_host(Node) -> - string:tokens(atom_to_list(Node), [$@]). - - - - 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 index ddc720d0c1..c6f709dc36 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -17,31 +17,24 @@ # # %CopyrightEnd% -TEST_SPEC_FILE = diameter.spec - +TEST_SPEC_FILE = diameter.spec COVER_SPEC_FILE = diameter.cover -BEHAVIOUR_MODULES = - MODULES = \ - $(BEHAVIOUR_MODULES) \ - diameter_SUITE \ - diameter_app_test \ - diameter_appup_test \ - diameter_compiler_test \ - diameter_config_test \ - diameter_peer_test \ - diameter_reg_test \ - diameter_session_test \ - diameter_stats_test \ - diameter_sync_test \ - diameter_tcp_test \ - diameter_test_lib \ - diameter_test_server - + 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_test_lib.hrl - - - + diameter_ct.hrl diff --git a/lib/diameter/test/slask/diameter_persistent_table_test.erl b/lib/diameter/test/slask/diameter_persistent_table_test.erl deleted file mode 100644 index bb907a5777..0000000000 --- a/lib/diameter/test/slask/diameter_persistent_table_test.erl +++ /dev/null @@ -1,495 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%---------------------------------------------------------------------- -%% Purpose: Verify the persistent-table component of the Diameter application -%%---------------------------------------------------------------------- -%% --module(diameter_persistent_table_test). - --export([ - init_per_testcase/2, fin_per_testcase/2, - - all/1, - suite_init/1, suite_fin/1, - - simple_start_and_stop/1, - table_create_and_delete/1 - - ]). - --export([t/0, t/1]). - --include("diameter_test_lib.hrl"). - --record(command, {id, desc, cmd, verify}). - - -t() -> diameter_test_server:t(?MODULE). -t(Case) -> diameter_test_server:t({?MODULE, Case}). - - -%% Test server callbacks -init_per_testcase(Case, Config) -> - diameter_test_server:init_per_testcase(Case, Config). - -fin_per_testcase(Case, Config) -> - diameter_test_server:fin_per_testcase(Case, Config). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -all(suite) -> - Cases = - [ - simple_start_and_stop, - table_create_and_delete - ], - {req, [], {conf, suite_init, Cases, suite_fin}}. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -suite_init(suite) -> []; -suite_init(doc) -> []; -suite_init(Config) when is_list(Config) -> - Config. - - -suite_fin(suite) -> []; -suite_fin(doc) -> []; -suite_fin(Config) when is_list(Config) -> - Config. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% -%% Test case(s) -%% - -simple_start_and_stop(suite) -> - []; -simple_start_and_stop(doc) -> - []; -simple_start_and_stop(Config) when is_list(Config) -> - diameter:enable_trace(100, io), - case diameter_persistent_table:start_link() of - {ok, Pid} -> - unlink(Pid); - {error, Reason} -> - exit({failed_starting, Reason}) - end, - - ok = diameter_persistent_table:stop(), - ok. - - -table_create_and_delete(suite) -> - []; -table_create_and_delete(doc) -> - []; -table_create_and_delete(Config) when is_list(Config) -> - process_flag(trap_exit, true), - - %% Command range values - Initial = 100, - ClientCreation = 200, - Nice = 300, - Evil = 400, - End = 500, - - Verbosity = min, - %% Verbosity = max, - - Data01 = lists:sort([{a, 10}, {b, 20}, {c, 30}]), - Data02 = lists:sort([{x, 100}, {y, 200}, {z, 300}]), - - Commands = - [ - %% Initial commands - initial_command( Initial + 0, - "enable trace", - fun() -> diameter:enable_trace(Verbosity, io) end, - ok), - initial_command( Initial + 1, - "start persistent-table process", - fun() -> - case diameter_persistent_table:start_link() of - {ok, Pid} when is_pid(Pid) -> - ok; - Error -> - Error - end - end, - ok), - - client_create_command( ClientCreation + 1, - "1", - client01), - - client_create_command( ClientCreation + 2, - "2", - client02), - - nice_command( Nice + 1, - "client 1 create table 1", - fun() -> - create_table(client01, tab01, []), - diameter_persistent_table:which_tables() - end, - fun([tab01] = Tabs) -> - {ok, Tabs}; - (Unexpected) -> - {error, {bad_tables, Unexpected}} - end), - - nice_command( Nice + 2, - "client 1 create table 2", - fun() -> - create_table(client01, tab02, []), - diameter_persistent_table:which_tables() - end, - fun([tab01, tab02] = Tabs) -> - {ok, Tabs}; - ([tab02, tab01] = Tabs) -> - {ok, Tabs}; - (Unexpected) -> - {error, {bad_tables, Unexpected}} - end), - - nice_command( Nice + 3, - "client 2 create table 1", - fun() -> - create_table(client02, tab03, []), - diameter_persistent_table:which_tables(whereis(client02)) - end, - fun([tab03] = Tabs) -> - {ok, Tabs}; - (Unexpected) -> - {error, {bad_tables, Unexpected}} - end), - - nice_command( Nice + 4, - "client 1 delete table 1", - fun() -> - delete_table(client01, tab01), - diameter_persistent_table:which_tables(whereis(client01)) - end, - fun([tab02] = Tabs) -> - {ok, Tabs}; - (Unexpected) -> - {error, {bad_tables, Unexpected}} - end), - - nice_command( Nice + 5, - "client 1 fill in some data in tab02", - fun() -> - populate_table(client01, tab02, Data01), - lists:sort(ets:tab2list(tab02)) - end, - fun(Data) when Data =:= Data01 -> - {ok, Data}; - (Unexpected) -> - {error, {bad_data, Unexpected}} - end), - - nice_command( Nice + 6, - "client 2 fill in some data in tab03", - fun() -> - populate_table(client02, tab03, Data02), - lists:sort(ets:tab2list(tab03)) - end, - fun(Data) when Data =:= Data02 -> - {ok, Data}; - (Unexpected) -> - {error, {bad_data, Unexpected}} - end), - - nice_command( Nice + 7, - "simulate client 1 crash", - fun() -> - simulate_crash(client01) - end, - fun(ok) -> - {ok, crashed}; - (Unexpected) -> - {error, {bad_simulation_result, Unexpected}} - end), - - client_create_command( Nice + 8, - "1 restarted", - client01), - - nice_command( Nice + 9, - "client 1 create tab02 - verify data", - fun() -> - create_table(client01, tab02, []), - lists:sort(ets:tab2list(tab02)) - end, - fun(Data) when Data =:= Data01 -> - {ok, Data}; - (Unexpected) -> - {error, {bad_data, Unexpected}} - end), - - evil_command( Evil + 1, - "try (and fail) to delete the non-existing table tab04", - fun() -> - delete_table(client02, tab04) - end, - fun({error, {unknown_table, tab04}}) -> - {ok, tab04}; - (X) -> - {error, {bad_result, X}} - end), - - evil_command( Evil + 2, - "try (and fail) to delete a not owned table tab02", - fun() -> - delete_table(client02, tab02) - end, - fun({error, {not_owner, tab02}}) -> - {ok, tab02}; - (X) -> - {error, {bad_result, X}} - end), - - evil_command( Evil + 3, - "try (and fail) to create an already existing *and* owned table - tab03", - fun() -> - create_table(client02, tab03, []) - end, - fun({error, {already_owner, tab03}}) -> - {ok, tab03}; - (X) -> - {error, {bad_result, X}} - end), - - evil_command( Evil + 4, - "try (and fail) to create an already existing not owned table - tab02", - fun() -> - create_table(client02, tab02, []) - end, - fun({error, {not_owner, _Owner, tab02}}) -> - {ok, tab02}; - (X) -> - {error, {bad_result, X}} - end), - - end_command( End + 1, - "stop client01", - fun() -> stop_client(client01) end), - - end_command( End + 2, - "stop client02", - fun() -> stop_client(client02) end), - - end_command( End + 2, - "stop persistent-table", - fun() -> diameter_persistent_table:stop() end), - - evil_command( Evil + 5, - "try (and fail) to stop a not running persistent-table process", - fun() -> - diameter_persistent_table:stop() - end, - fun({'EXIT', {noproc, _}}) -> - {ok, not_running}; - (X) -> - {error, {bad_result, X}} - end) - - ], - - exec(Commands). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% -%% Command engine -%% - -exec([]) -> - ok; -exec([#command{id = No, - desc = Desc, - cmd = Cmd, - verify = Verify}|Commands]) -> - io:format("Executing command ~2w: ~s: ", [No, Desc]), - case (catch Verify((catch Cmd()))) of - {ok, OK} -> - io:format("ok => ~p~n", [OK]), - exec(Commands); - {error, Reason} -> - io:format("error => ~p~n", [Reason]), - {error, {bad_result, No, Reason}}; - Error -> - io:format("exit => ~p~n", [Error]), - {error, {unexpected_result, No, Error}} - end. - -initial_command(No, Desc0, Cmd, VerifyVal) when is_function(Cmd) -> - Desc = lists:flatten(io_lib:format("Initial - ~s", [Desc0])), - command(No, Desc, Cmd, VerifyVal). - -client_create_command(No, Desc0, Name) -> - Desc = lists:flatten(io_lib:format("Client create - ~s", [Desc0])), - Self = self(), - Cmd = fun() -> start_client(Self, Name) end, - command(No, Desc, Cmd, ok). - -nice_command(No, Desc0, Cmd, Verify) - when is_function(Cmd) andalso is_function(Verify) -> - Desc = lists:flatten(io_lib:format("Nice - ~s", [Desc0])), - command(No, Desc, Cmd, Verify). - -evil_command(No, Desc0, Cmd, Verify) - when is_function(Cmd) andalso is_function(Verify) -> - Desc = lists:flatten(io_lib:format("Evil - ~s", [Desc0])), - command(No, Desc, Cmd, Verify). - -end_command(No, Desc0, Cmd) when is_function(Cmd) -> - Desc = lists:flatten(io_lib:format("End - ~s", [Desc0])), - command(No, Desc, Cmd, ok). - -command(No, Desc, Cmd, Verify) - when (is_integer(No) andalso - is_list(Desc) andalso - is_function(Cmd) andalso - is_function(Verify)) -> - #command{id = No, - desc = Desc, - cmd = Cmd, - verify = Verify}; -command(No, Desc, Cmd, VerifyVal) - when (is_integer(No) andalso - is_list(Desc) andalso - is_function(Cmd)) -> - Verify = - fun(Val) -> - case Val of - VerifyVal -> - {ok, Val}; - _ -> - {error, Val} - end - end, - #command{id = No, - desc = Desc, - cmd = Cmd, - verify = Verify}. - - -start_client(Parent, Name) -> - ClientPid = spawn_link(fun() -> client_init(Parent, Name) end), - receive - {ClientPid, started} -> - ClientPid, - ok; - {'EXIT', ClientPid, Reason} -> - {error, {failed_starting_client, Reason}} - end. - -stop_client(Client) -> - Pid = whereis(Client), - Pid ! stop, - receive - {'EXIT', Pid, normal} -> - ok - end. - -create_table(Client, Tab, Opts) -> - Self = self(), - Pid = whereis(Client), - Pid ! {create_table, Tab, Opts, Self}, - receive - {Pid, created} -> - ok; - {Pid, {create_failed, Error}} -> - Error - end. - -delete_table(Client, Tab) -> - Self = self(), - Pid = whereis(Client), - Pid ! {delete_table, Tab, Self}, - receive - {Pid, deleted} -> - ok; - {Pid, {delete_failed, Error}} -> - Error - end. - -populate_table(Client, Tab, Data) -> - Self = self(), - Pid = whereis(Client), - Pid ! {populate_table, Tab, Data, Self}, - receive - {Pid, populated} -> - ok - end. - -simulate_crash(Client) -> - Pid = whereis(Client), - Pid ! simulate_crash, - receive - {'EXIT', Pid, simulated_crash} -> - ok - end. - -client_init(Parent, Name) -> - erlang:register(Name, self()), - process_flag(trap_exit, true), - Parent ! {self(), started}, - client_loop(). - -client_loop() -> - receive - stop -> - exit(normal); - - {create_table, T, Opts, From} when is_atom(T) andalso is_list(Opts) -> - case diameter_persistent_table:create(T, Opts) of - ok -> - From ! {self(), created}; - Error -> - From ! {self(), {create_failed, Error}} - end, - client_loop(); - - {delete_table, T, From} -> - case diameter_persistent_table:delete(T) of - ok -> - From ! {self(), deleted}; - Error -> - From ! {self(), {delete_failed, Error}} - end, - client_loop(); - - {populate_table, Tab, Data, From} -> - ets:insert(Tab, Data), - From ! {self(), populated}, - client_loop(); - - simulate_crash -> - exit(simulated_crash) - end. - |