diff options
| author | Anders Svensson <[email protected]> | 2011-09-27 11:41:52 +0200 |
|---|---|---|
| committer | Anders Svensson <[email protected]> | 2011-09-27 11:41:52 +0200 |
| commit | 1c9017d8970713a24a36929063bcc76a28ae54c5 (patch) | |
| tree | 5d5020f812501d53da6ef5091ec8a75eebb7918b /lib/diameter | |
| parent | 6d31ccf58efcffc53a949fbdd0a217d6c3ac7058 (diff) | |
| parent | 162c0d3ee30790ec5a75e20b0e2e8bc61ed92375 (diff) | |
| download | otp-1c9017d8970713a24a36929063bcc76a28ae54c5.tar.gz otp-1c9017d8970713a24a36929063bcc76a28ae54c5.tar.bz2 otp-1c9017d8970713a24a36929063bcc76a28ae54c5.zip | |
Merge branch 'anders/diameter/testsuites/OTP-9553' into dev
* anders/diameter/testsuites/OTP-9553: (23 commits)
Explicit {init,end}_per_group/2 to work around ct bug
Add relay suite
More traffic cases
Add traffic suite
Use groups for parallel testcase execution
Remove gen_sctp suite since it's not diameter-specific
Minor macro cleanup
Minor diameter_ct simplification
Improve xref testcase
Don't require GNU sed to fail testsuite targets
Generate dependencies makefile
Makefile/spec cleanup
Remove old test framework
Add transport and gen_sctp suites
Add watchdog suite
Add stats suite
Add sync suite
Add reg suite
Add dict suite, remove session suite
Move appup tests into app suite and use systools for both
...
Diffstat (limited to 'lib/diameter')
36 files changed, 4330 insertions, 4186 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 b3648c7bb1..64e200584f 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -16,41 +16,40 @@ # # %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 - # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- @@ -59,30 +58,17 @@ 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) - +SUITE_MODULES = $(filter diameter_%_SUITE, $(MODULES)) +SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) EMAKEFILE = Emakefile -ifneq ($(ERL_TOP),) -MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile) -else -MAKE_EMAKE = $(wildcard $(DIAMETER_TOP)/make/make_emakefile) -endif +MAKE_EMAKE = $(wildcard $(TOP)/make/make_emakefile) ifeq ($(MAKE_EMAKE),) BUILDTARGET = $(TARGET_FILES) @@ -92,7 +78,6 @@ BUILDTARGET = emakebuild RELTEST_FILES = $(EMAKEFILE) $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) endif - # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -107,291 +92,116 @@ 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 - +ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \ + -DDIAMETER_CT=true \ + -I $(DIAMETER_TOP)/src/app # ---------------------------------------------------- # Targets # ---------------------------------------------------- -tests debug opt: $(BUILDTARGET) +all test: $(SUITES) -targets: $(TARGET_FILES) +tests debug opt: $(BUILDTARGET) -.PHONY: emakebuild +beam targets: $(TARGET_FILES) emakebuild: $(EMAKEFILE) $(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) + $(MAKE_EMAKE) $(ERL_COMPILE_FLAGS) -o $(EBIN) '*_SUITE_make' $(MODULES) \ + | grep -v Warning \ + > $(EMAKEFILE) clean: rm -f $(EMAKEFILE) rm -f $(TARGET_FILES) + rm -f depend.mk + +realclean: clean rm -f errs core *~ +.PHONY: all emakebuild test tests debug opt beam targets clean realclean + docs: info: - @echo "MAKE_EMAKE = $(MAKE_EMAKE)" - @echo "EMAKEFILE = $(EMAKEFILE)" - @echo "BUILDTARGET = $(BUILDTARGET)" - @echo "" + @echo "MAKE_EMAKE = $(MAKE_EMAKE)" + @echo "EMAKEFILE = $(EMAKEFILE)" + @echo "BUILDTARGET = $(BUILDTARGET)" + @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 + @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 @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 " b) Run individual suites using targets in this makefile, target" + @echo " xxx running the testcases contained in $(APPLICATION)_xxx_SUITE." + @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 " beam" + @echo " Compile all test-code." + @echo + @echo " clean" + @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) - -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) +# 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 targets + $(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). -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: @@ -400,9 +210,20 @@ release_docs_spec: release_tests_spec: tests $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(RELTEST_FILES) $(RELSYSDIR) -# $(INSTALL_DATA) $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) \ -# $(HRL_FILES) $(ERL_FILES) \ -# $(RELSYSDIR) -# - chmod -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..d710fa155d --- /dev/null +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -0,0 +1,249 @@ +%% +%% %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 module list match the installed beams. +%% =========================================================================== + +modules(Config) -> + Mods = fetch(modules, fetch(app, Config)), + Installed = code_mods(), + {[], []} = {Mods -- Installed, 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..0c004b3edb --- /dev/null +++ b/lib/diameter/test/diameter_codec_SUITE.erl @@ -0,0 +1,77 @@ +%% +%% %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 +%% requirement of one function per testcase. (Instead of allowing a +%% testcase to be an MFA instead of function name, say.) +%% + +-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..0cda2df8ca --- /dev/null +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -0,0 +1,422 @@ +%% +%% %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 ---- SERVER2.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(), + + dbg:tracer(port, dbg:trace_port(file, "relay.dbg")), + dbg:p(all,c), + dbg:tpl(diameter_service, x), + dbg:tp(?MODULE, x), + + + [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. - |