diff options
Diffstat (limited to 'lib/diameter/src/app')
34 files changed, 0 insertions, 11483 deletions
diff --git a/lib/diameter/src/app/.gitignore b/lib/diameter/src/app/.gitignore deleted file mode 100644 index d388e61877..0000000000 --- a/lib/diameter/src/app/.gitignore +++ /dev/null @@ -1,6 +0,0 @@ - -/diameter_gen_*.erl -/diameter_gen_*.hrl -/depend.mk -/diameter.mk - diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile deleted file mode 100644 index b2efc42a69..0000000000 --- a/lib/diameter/src/app/Makefile +++ /dev/null @@ -1,215 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- - -include ../../vsn.mk - -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -DICT_FILES = $(DICTIONARIES:%=../dict/%.dia) -DICT_MODULES = $(DICTIONARIES:%=diameter_gen_%) -DICT_ERL_FILES = $(DICT_MODULES:%=%.erl) -DICT_HRL_FILES = $(DICT_MODULES:%=%.hrl) - -MODULES = \ - $(RUNTIME_MODULES) \ - $(HELP_MODULES) - -APP_MODULES = \ - $(RUNTIME_MODULES) \ - $(DICT_MODULES) - -TARGET_MODULES = \ - $(APP_MODULES) \ - $(HELP_MODULES) - -TARGET_FILES = \ - $(TARGET_MODULES:%=$(EBIN)/%.$(EMULATOR)) \ - $(APP_TARGET) \ - $(APPUP_TARGET) - -ESCRIPT_FILES = \ - ../../bin/diameterc - -APP_FILE = diameter.app -APP_SRC = $(APP_FILE).src -APP_TARGET = $(EBIN)/$(APP_FILE) - -APPUP_FILE = diameter.appup -APPUP_SRC = $(APPUP_FILE).src -APPUP_TARGET = $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @$(MAKE) TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) $(DICT_ERL_FILES) $(DICT_HRL_FILES) - rm -f $(APP_TARGET) $(APPUP_TARGET) - rm -f errs core *~ diameter_gen_*.forms diameter_gen_*.spec - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "DICTIONARIES = $(DICTIONARIES)" - @echo "MODULES = $(MODULES)" - @echo "" - @echo "EXTERNAL_HRL_FILES = $(EXTERNAL_HRL_FILES)" - @echo "INTERNAL_HRL_FILES = $(INTERNAL_HRL_FILES)" - @echo "" - @echo "EXAMPLE_FILES = $(EXAMPLE_FILES)" - @echo "" - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# erl/hrl from application spec -diameter_gen_%.erl diameter_gen_%.hrl: ../dict/%.dia - ../../bin/diameterc -i $(EBIN) $< - -# Generate the app file and then modules into in. This shouldn't know -# about ../transport but good enough for now. -$(APP_TARGET): $(APP_SRC) \ - ../../vsn.mk \ - modules.mk \ - ../transport/modules.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - M=`echo $(APP_MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ - echo "/%APP_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ - | ed -s $@ - $(MAKE) -C ../transport $(APP_TARGET) APP_TARGET=$(APP_TARGET) - -$(APPUP_TARGET): $(APPUP_SRC) ../../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -compiler: - $(MAKE) -C ../$@ - -app: $(APP_TARGET) $(APPUP_TARGET) -dict: $(DICT_ERL_FILES) - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/bin - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src/app - $(INSTALL_DIR) $(RELSYSDIR)/src/dict - $(INSTALL_DIR) $(RELSYSDIR)/include - $(INSTALL_DIR) $(RELSYSDIR)/examples - $(INSTALL_SCRIPT) $(ESCRIPT_FILES) $(RELSYSDIR)/bin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(MODULES:%=%.erl) $(DICT_ERL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(DICT_FILES) $(RELSYSDIR)/src/dict - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) $(RELSYSDIR)/include - $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples - -release_docs_spec: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): $(EBIN)/diameter_exprecs.$(EMULATOR) - -diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ - $(EBIN)/diameter_gen_base_rfc3588.beam - -$(DICT_ERL_FILES) $(DICT_HRL_FILES): compiler - -$(DICT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)): \ - $(DIAMETER_TOP)/include/diameter.hrl \ - $(DIAMETER_TOP)/include/diameter_gen.hrl - -depend: depend.mk - -# Generate dependencies makefile. It's assumed that the compile target -# has already been made since it's currently not smart enough to not -# force a rebuild of those beams dependent on generated hrls, and this -# is a no-no at make release. -depend.mk: depend.sed $(MODULES:%=%.erl) Makefile - (for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done) \ - > $@ - --include depend.mk - -.PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) -.PHONY: app clean debug depend info opt compiler dict -.PHONY: release_spec release_docs_spec diff --git a/lib/diameter/src/app/depend.sed b/lib/diameter/src/app/depend.sed deleted file mode 100644 index 9df0133960..0000000000 --- a/lib/diameter/src/app/depend.sed +++ /dev/null @@ -1,31 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% -# - -# -# Extract include dependencies from .erl files. The output is massaged -# further in Makefile. -# - -/^-include/!d -/"diameter/!d - -s@^-include_lib("[^/]*@$(DIAMETER_TOP)@ -s@^-include("@@ -s@".*@@ -s@^@$(EBIN)/.$(EMULATOR): @ diff --git a/lib/diameter/src/app/diameter.app.src b/lib/diameter/src/app/diameter.app.src deleted file mode 100644 index a806b5c78a..0000000000 --- a/lib/diameter/src/app/diameter.app.src +++ /dev/null @@ -1,28 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -{application, diameter, - [{description, "Diameter protocol"}, - {vsn, "%VSN%"}, - {modules, [%APP_MODULES%,%TRANSPORT_MODULES%]}, - {registered, []}, - {applications, [stdlib, kernel]}, - {env, []}, - {mod, {diameter_app, []}} - ]}. diff --git a/lib/diameter/src/app/diameter.appup.src b/lib/diameter/src/app/diameter.appup.src deleted file mode 100644 index 6d8ceadb92..0000000000 --- a/lib/diameter/src/app/diameter.appup.src +++ /dev/null @@ -1,47 +0,0 @@ -%% This is an -*- erlang -*- file. -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -{"%VSN%", - [ - {"0.9", - [ - {load_module, diameter, soft_purge, soft_purge, []}, - {load_module, diameter_capx, soft_purge, soft_purge, []}, - {load_module, diameter_codec, soft_purge, soft_purge, [diameter_lib]}, - {load_module, diameter_lib, soft_purge, soft_purge, []}, - {load_module, diameter_types, soft_purge, soft_purge, []}, - {load_module, diameter_gen_base_accounting, soft_purge, soft_purge, []}, - {load_module, diameter_gen_base_rfc3588, soft_purge, soft_purge, []}, - {load_module, diameter_gen_relay, soft_purge, soft_purge, []}, - {update, diameter_service, soft, soft_purge, soft_purge, [diameter_lib]}, - {update, diameter_config, soft, soft_purge, soft_purge, []}, - {update, diameter_peer, soft, soft_purge, soft_purge, []}, - {update, diameter_peer_fsm, soft, soft_purge, soft_purge, [diameter_lib]}, - {update, diameter_reg, soft, soft_purge, soft_purge, []}, - {update, diameter_sctp, soft, soft_purge, soft_purge, []}, - {update, diameter_stats, soft, soft_purge, soft_purge, []}, - {update, diameter_sync, soft, soft_purge, soft_purge, []}, - {update, diameter_watchdog, soft, soft_purge, soft_purge, [diameter_lib]} - ] - } - ], - [ - ] -}. diff --git a/lib/diameter/src/app/diameter.erl b/lib/diameter/src/app/diameter.erl deleted file mode 100644 index 2f721421d8..0000000000 --- a/lib/diameter/src/app/diameter.erl +++ /dev/null @@ -1,190 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter). - -%% Configuration. --export([start_service/2, - stop_service/1, - add_transport/2, - remove_transport/2, - subscribe/1, - unsubscribe/1]). - -%% Traffic. --export([session_id/1, - origin_state_id/0, - call/3, - call/4]). - -%% Information. --export([services/0, - service_info/2]). - -%% Start/stop the application. In a "real" application this should -%% typically be a consequence of specifying diameter in a release file -%% rather than by calling start/stop explicitly. --export([start/0, - stop/0]). - --include("diameter_internal.hrl"). --include("diameter_types.hrl"). - -%%% -------------------------------------------------------------------------- -%%% start/0 -%%% -------------------------------------------------------------------------- - --spec start() - -> ok - | {error, term()}. - -start() -> - application:start(?APPLICATION). - -%%% -------------------------------------------------------------------------- -%%% stop/0 -%%% -------------------------------------------------------------------------- - --spec stop() - -> ok - | {error, term()}. - -stop() -> - application:stop(?APPLICATION). - -%%% -------------------------------------------------------------------------- -%%% start_service/2 -%%% -------------------------------------------------------------------------- - --spec start_service(service_name(), [service_opt()]) - -> ok - | {error, term()}. - -start_service(SvcName, Opts) - when is_list(Opts) -> - diameter_config:start_service(SvcName, Opts). - -%%% -------------------------------------------------------------------------- -%%% stop_service/1 -%%% -------------------------------------------------------------------------- - --spec stop_service(service_name()) - -> ok - | {error, term()}. - -stop_service(SvcName) -> - diameter_config:stop_service(SvcName). - -%%% -------------------------------------------------------------------------- -%%% services/0 -%%% -------------------------------------------------------------------------- - --spec services() - -> [service_name()]. - -services() -> - [Name || {Name, _} <- diameter_service:services()]. - -%%% -------------------------------------------------------------------------- -%%% service_info/2 -%%% -------------------------------------------------------------------------- - --spec service_info(service_name(), atom() | [atom()]) - -> any(). - -service_info(SvcName, Option) -> - diameter_service:info(SvcName, Option). - -%%% -------------------------------------------------------------------------- -%%% add_transport/3 -%%% -------------------------------------------------------------------------- - --spec add_transport(service_name(), {listen|connect, [transport_opt()]}) - -> {ok, transport_ref()} - | {error, term()}. - -add_transport(SvcName, {T, Opts} = Cfg) - when is_list(Opts), (T == connect orelse T == listen) -> - diameter_config:add_transport(SvcName, Cfg). - -%%% -------------------------------------------------------------------------- -%%% remove_transport/2 -%%% -------------------------------------------------------------------------- - --spec remove_transport(service_name(), transport_pred()) - -> ok | {error, term()}. - -remove_transport(SvcName, Pred) -> - diameter_config:remove_transport(SvcName, Pred). - -%%% -------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% -%%% Description: Subscribe to #diameter_event{} messages for the specified -%%% service. -%%% -------------------------------------------------------------------------- - --spec subscribe(service_name()) - -> true. - -subscribe(SvcName) -> - diameter_service:subscribe(SvcName). - -%%% -------------------------------------------------------------------------- -%%% # unsubscribe(SvcName) -%%% -------------------------------------------------------------------------- - --spec unsubscribe(service_name()) - -> true. - -unsubscribe(SvcName) -> - diameter_service:unsubscribe(SvcName). - -%%% ---------------------------------------------------------- -%%% # session_id/1 -%%% ---------------------------------------------------------- - --spec session_id('DiameterIdentity'()) - -> 'OctetString'(). - -session_id(Ident) -> - diameter_session:session_id(Ident). - -%%% ---------------------------------------------------------- -%%% # origin_state_id/0 -%%% ---------------------------------------------------------- - --spec origin_state_id() - -> 'Unsigned32'(). - -origin_state_id() -> - diameter_session:origin_state_id(). - -%%% -------------------------------------------------------------------------- -%%% # call/[34] -%%% -------------------------------------------------------------------------- - --spec call(service_name(), app_alias(), any(), [call_opt()]) - -> any(). - -call(SvcName, App, Message, Options) -> - diameter_service:call(SvcName, {alias, App}, Message, Options). - -call(SvcName, App, Message) -> - call(SvcName, App, Message, []). diff --git a/lib/diameter/src/app/diameter.mk.in b/lib/diameter/src/app/diameter.mk.in deleted file mode 100644 index c161064303..0000000000 --- a/lib/diameter/src/app/diameter.mk.in +++ /dev/null @@ -1,47 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% - -DIAMETER_TOP = @DIAMETER_TOP@ - -# ifneq ($(PREFIX),) -# ifeq ($(TESTROOT),) -# TESTROOT = $(PREFIX) -# endif -# endif - -ifeq ($(USE_DIAMETER_TEST_CODE), true) -ERL_COMPILE_FLAGS += -DDIAMETER_TEST_CODE=mona_lisa_spelar_doom -endif - -ifeq ($(USE_DIAMETER_HIPE), true) -ERL_COMPILE_FLAGS += +native -endif - -ifeq ($(WARN_UNUSED_WARS), true) -ERL_COMPILE_FLAGS += +warn_unused_vars -endif - -DIAMETER_APP_VSN_COMPILE_FLAGS = \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' - -DIAMETER_ERL_COMPILE_FLAGS += \ - -pa $(DIAMETER_TOP)/ebin \ - $(DIAMETER_APP_VSN_COMPILE_FLAGS) - diff --git a/lib/diameter/src/app/diameter_app.erl b/lib/diameter/src/app/diameter_app.erl deleted file mode 100644 index 600f7ff04d..0000000000 --- a/lib/diameter/src/app/diameter_app.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_app). - --behaviour(application). - -%% application callbacks --export([start/2, - stop/1]). - -%% start/2 - -start(_Type, _Args) -> - diameter_sup:start_link(). - -%% stop/1 - -stop(_) -> - ok. diff --git a/lib/diameter/src/app/diameter_callback.erl b/lib/diameter/src/app/diameter_callback.erl deleted file mode 100644 index 6d5c8cdca1..0000000000 --- a/lib/diameter/src/app/diameter_callback.erl +++ /dev/null @@ -1,91 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% A minimal application callback module. -%% - --module(diameter_callback). - --export([peer_up/3, - peer_down/3, - pick_peer/4, - prepare_request/3, - prepare_retransmit/3, - handle_request/3, - handle_answer/4, - handle_error/4]). - --include_lib("diameter/include/diameter.hrl"). - -%%% ---------------------------------------------------------- -%%% # peer_up/3 -%%% ---------------------------------------------------------- - -peer_up(_Svc, _Peer, State) -> - State. - -%%% ---------------------------------------------------------- -%%% # peer_down/3 -%%% ---------------------------------------------------------- - -peer_down(_SvcName, _Peer, State) -> - State. - -%%% ---------------------------------------------------------- -%%% # pick_peer/4 -%%% ---------------------------------------------------------- - -pick_peer([Peer|_], _, _SvcName, _State) -> - {ok, Peer}. - -%%% ---------------------------------------------------------- -%%% # prepare_request/3 -%%% ---------------------------------------------------------- - -prepare_request(Pkt, _SvcName, _Peer) -> - {send, Pkt}. - -%%% ---------------------------------------------------------- -%%% # prepare_retransmit/3 -%%% ---------------------------------------------------------- - -prepare_retransmit(Pkt, _SvcName, _Peer) -> - {send, Pkt}. - -%%% ---------------------------------------------------------- -%%% # handle_request/3 -%%% ---------------------------------------------------------- - -handle_request(_Pkt, _SvcName, _Peer) -> - {protocol_error, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED - -%%% ---------------------------------------------------------- -%%% # handle_answer/4 -%%% ---------------------------------------------------------- - -handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) -> - Ans. - -%%% --------------------------------------------------------------------------- -%%% # handle_error/4 -%%% --------------------------------------------------------------------------- - -handle_error(Reason, _Req, _SvcName, _Peer) -> - {error, Reason}. diff --git a/lib/diameter/src/app/diameter_capx.erl b/lib/diameter/src/app/diameter_capx.erl deleted file mode 100644 index 138e76411e..0000000000 --- a/lib/diameter/src/app/diameter_capx.erl +++ /dev/null @@ -1,405 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module builds CER and CEA records for use during capabilities -%% exchange. All of a CER/CEA is built from AVP values configured on -%% the service in question but values for Supported-Vendor-Id, -%% Vendor-Specific-Application-Id, Auth-Application-Id and -%% Acct-Application-id are also obtained using an older method that -%% remains only for backwards compatibility. With this method, each -%% dictionary module was required to export a cer/0 that returned a -%% diameter_base_CER record (or corresponding list, although the list -%% is also a later addition). Each returned CER contributes its member -%% values for the aforementioned four AVPs to the resulting CER, with -%% remaining AVP's either unspecified or identical to those configured -%% on the service. Auth-Application-Id and Acct-Application-id were -%% originally treated a little differently, each callback being -%% required to return either no value of the same value as the other -%% callbacks, but this coupled the callback modules unnecessarily. (A -%% union is backwards compatible to boot.) -%% -%% Values obtained from the service and callbacks are all included -%% when building a CER. Older code with only callback can continue to -%% use them, newer code should probably stick to service configuration -%% (since this is more explicit) or mix at their own peril. -%% -%% The cer/0 callback is now undocumented (despite never being fully -%% documented to begin with) and should be considered deprecated even -%% by those poor souls still using it. -%% - --module(diameter_capx). - --export([build_CER/1, - recv_CER/2, - recv_CEA/2, - make_caps/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). --include("diameter_gen_base_rfc3588.hrl"). - --define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). --define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION'). --define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). - --define(NO_INBAND_SECURITY, 0). --define(TLS, 1). - -%% =========================================================================== - --type tried(T) :: {ok, T} | {error, {term(), list()}}. - --spec build_CER(#diameter_caps{}) - -> tried(#diameter_base_CER{}). - -build_CER(Caps) -> - try_it([fun bCER/1, Caps]). - --spec recv_CER(#diameter_base_CER{}, #diameter_service{}) - -> tried({['Unsigned32'()], #diameter_caps{}, #diameter_base_CEA{}}). - -recv_CER(CER, Svc) -> - try_it([fun rCER/2, CER, Svc]). - --spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) - -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). - -recv_CEA(CEA, Svc) -> - try_it([fun rCEA/2, CEA, Svc]). - -make_caps(Caps, Opts) -> - try_it([fun mk_caps/2, Caps, Opts]). - -%% =========================================================================== -%% =========================================================================== - -try_it([Fun | Args]) -> - try apply(Fun, Args) of - T -> {ok, T} - catch - throw: ?FAILURE(Reason) -> {error, {Reason, Args}} - end. - -%% mk_caps/2 - -mk_caps(Caps0, Opts) -> - {Caps, _} = lists:foldl(fun set_cap/2, - {Caps0, #diameter_caps{_ = false}}, - Opts), - Caps. - --define(SC(K,F), - set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) -> - {Caps#diameter_caps{F = cap(K, Val)}, C#diameter_caps{F = true}}). - -?SC('Origin-Host', origin_host); -?SC('Origin-Realm', origin_realm); -?SC('Host-IP-Address', host_ip_address); -?SC('Vendor-Id', vendor_id); -?SC('Product-Name', product_name); -?SC('Origin-State-Id', origin_state_id); -?SC('Supported-Vendor-Id', supported_vendor_id); -?SC('Auth-Application-Id', auth_application_id); -?SC('Inband-Security-Id', inband_security_id); -?SC('Acct-Application-Id', acct_application_id); -?SC('Vendor-Specific-Application-Id', vendor_specific_application_id); -?SC('Firmware-Revision', firmware_revision); - -set_cap({Key, _}, _) -> - ?THROW({duplicate, Key}). - -cap(K, V) - when K == 'Origin-Host'; - K == 'Origin-Realm'; - K == 'Vendor-Id'; - K == 'Product-Name' -> - V; - -cap('Host-IP-Address', Vs) - when is_list(Vs) -> - lists:map(fun ipaddr/1, Vs); - -cap('Firmware-Revision', V) -> - [V]; - -cap(_, Vs) - when is_list(Vs) -> - Vs; - -cap(K, V) -> - ?THROW({invalid, K, V}). - -ipaddr(A) -> - try - diameter_lib:ipaddr(A) - catch - error: {invalid_address, _} = T -> - ?THROW(T) - end. - -%% bCER/1 -%% -%% Build a CER record to send to a remote peer. - -%% Use the fact that diameter_caps has the same field names as CER. -bCER(#diameter_caps{} = Rec) -> - #diameter_base_CER{} - = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). - -%% rCER/2 -%% -%% Build a CEA record to send to a remote peer in response to an -%% incoming CER. RFC 3588 gives no guidance on what should be sent -%% here: should we advertise applications that the peer hasn't sent in -%% its CER (aside from the relay application) or not? If we send -%% applications that the peer hasn't advertised then the peer may have -%% to be aware of the possibility. If we don't then we just look like -%% a server that supports a subset (possibly) of what the client -%% advertised, so this feels like the path of least incompatibility. -%% However, the current draft standard (draft-ietf-dime-rfc3588bis-26, -%% expires 24 July 2011) says this in section 5.3, Capabilities -%% Exchange: -%% -%% The receiver of the Capabilities-Exchange-Request (CER) MUST -%% determine common applications by computing the intersection of its -%% own set of supported Application Id against all of the application -%% identifier AVPs (Auth-Application-Id, Acct-Application-Id and Vendor- -%% Specific-Application-Id) present in the CER. The value of the -%% Vendor-Id AVP in the Vendor-Specific-Application-Id MUST NOT be used -%% during computation. The sender of the Capabilities-Exchange-Answer -%% (CEA) SHOULD include all of its supported applications as a hint to -%% the receiver regarding all of its application capabilities. -%% -%% Both RFC and the draft also say this: -%% -%% The receiver only issues commands to its peers that have advertised -%% support for the Diameter application that defines the command. A -%% Diameter node MUST cache the supported applications in order to -%% ensure that unrecognized commands and/or AVPs are not unnecessarily -%% sent to a peer. -%% -%% That is, each side sends all of its capabilities and is responsible for -%% not sending commands that the peer doesn't support. - -%% 6.10. Inband-Security-Id AVP -%% -%% NO_INBAND_SECURITY 0 -%% This peer does not support TLS. This is the default value, if the -%% AVP is omitted. -%% -%% TLS 1 -%% This node supports TLS security, as defined by [TLS]. - -rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> - #diameter_base_CEA{} - = CEA - = cea_from_cer(bCER(LCaps)), - - RCaps = capx_to_caps(CER), - SApps = common_applications(LCaps, RCaps, Svc), - - {SApps, - RCaps, - build_CEA(SApps, - LCaps, - RCaps, - CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. - -%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION -%% in the CEA and SHOULD disconnect the transport. However, we have -%% no way to guarantee the send before disconnecting. - -build_CEA([], _, _, CEA) -> - CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; - -build_CEA(_, LCaps, RCaps, CEA) -> - case common_security(LCaps, RCaps) of - [] -> - CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; - [_] = IS -> - CEA#diameter_base_CEA{'Inband-Security-Id' = IS} - end. - -%% common_security/2 - -common_security(#diameter_caps{inband_security_id = LS}, - #diameter_caps{inband_security_id = RS}) -> - cs(LS, RS). - -%% Unspecified is equivalent to NO_INBAND_SECURITY. -cs([], RS) -> - cs([?NO_INBAND_SECURITY], RS); -cs(LS, []) -> - cs(LS, [?NO_INBAND_SECURITY]); - -%% Agree on TLS if both parties support it. When sending CEA, this is -%% to ensure the peer is clear that we will be expecting a TLS -%% handshake since there is no ssl:maybe_accept that would allow the -%% peer to choose between TLS or not upon reception of our CEA. When -%% receiving CEA it deals with a server that isn't explicit about its choice. -%% TODO: Make the choice configurable. -cs(LS, RS) -> - Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS), - ordsets:from_list(RS))), - case lists:member(?TLS, Is) of - true -> - [?TLS]; - false when [] == Is -> - Is; - false -> - [hd(Is)] %% probably NO_INBAND_SECURITY - end. -%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and -%% TLS but don't enforce this. In theory this allows some other -%% security mechanism we don't have to know about, although in -%% practice something there may be a need for more synchronization -%% than notification by way of an event subscription offers. - -%% cea_from_cer/1 - -%% CER is a subset of CEA, the latter adding Result-Code and a few -%% more AVP's. -cea_from_cer(#diameter_base_CER{} = CER) -> - lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, - #diameter_base_CEA{}, - record_info(fields, diameter_base_CER)). - -to_cea(CER, Field, CEA) -> - try ?BASE:'#get-'(Field, CER) of - V -> ?BASE:'#set-'({Field, V}, CEA) - catch - error: _ -> CEA - end. - -%% rCEA/2 - -rCEA(#diameter_base_CEA{'Result-Code' = RC} - = CEA, - #diameter_service{capabilities = LCaps} - = Svc) -> - RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), - - RCaps = capx_to_caps(CEA), - SApps = common_applications(LCaps, RCaps, Svc), - - [] == SApps andalso ?THROW(no_common_applications), - - IS = common_security(LCaps, RCaps), - - [] == IS andalso ?THROW(no_common_security), - - {SApps, IS, RCaps}; - -rCEA(CEA, _Svc) -> - ?THROW({invalid, CEA}). - -%% capx_to_caps/1 - -capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Host-IP-Address' = IP, - 'Vendor-Id' = VId, - 'Product-Name' = PN, - 'Origin-State-Id' = OSI, - 'Supported-Vendor-Id' = SV, - 'Auth-Application-Id' = Auth, - 'Inband-Security-Id' = IS, - 'Acct-Application-Id' = Acct, - 'Vendor-Specific-Application-Id' = VSA, - 'Firmware-Revision' = FR, - 'AVP' = X}) -> - #diameter_caps{origin_host = OH, - origin_realm = OR, - vendor_id = VId, - product_name = PN, - origin_state_id = OSI, - host_ip_address = IP, - supported_vendor_id = SV, - auth_application_id = Auth, - inband_security_id = IS, - acct_application_id = Acct, - vendor_specific_application_id = VSA, - firmware_revision = FR, - avp = X}; - -capx_to_caps(#diameter_base_CER{} = CER) -> - capx_to_caps(cea_from_cer(CER)). - -%% --------------------------------------------------------------------------- -%% --------------------------------------------------------------------------- - -%% common_applications/3 -%% -%% Identify the (local) applications to be supported on the connection -%% in question. - -common_applications(LCaps, RCaps, #diameter_service{applications = Apps}) -> - LA = app_union(LCaps), - RA = app_union(RCaps), - - lists:foldl(fun(I,A) -> ca(I, Apps, RA, A) end, [], LA). - -ca(Id, Apps, RA, Acc) -> - Relay = lists:member(?APP_ID_RELAY, RA), - #diameter_app{alias = Alias} = find_app(Id, Apps), - tcons(Relay %% peer is a relay - orelse ?APP_ID_RELAY == Id %% we're a relay - orelse lists:member(Id, RA), %% app is supported by the peer - Id, - Alias, - Acc). -%% 5.3 of the RFC states that a peer advertising itself as a relay must -%% be interpreted as having common applications. - -%% Extract the list of all application identifiers from Auth-Application-Id, -%% Acct-Application-Id and Vendor-Specific-Application-Id. -app_union(#diameter_caps{auth_application_id = U, - acct_application_id = C, - vendor_specific_application_id = V}) -> - set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)). - -vsa_apps(#'diameter_base_Vendor-Specific-Application-Id' - {'Auth-Application-Id' = U, - 'Acct-Application-Id' = C}) -> - U ++ C; -vsa_apps(L) -> - Rec = ?BASE:'#new-'('diameter_base_Vendor-Specific-Application-Id', L), - vsa_apps(Rec). - -%% It's a configuration error for a locally advertised application not -%% to be represented in Apps. Don't just match on lists:keyfind/3 in -%% order to generate a more helpful error. -find_app(Id, Apps) -> - case lists:keyfind(Id, #diameter_app.id, Apps) of - #diameter_app{} = A -> - A; - false -> - ?THROW({app_not_configured, Id}) - end. - -set_list(L) -> - sets:to_list(sets:from_list(L)). - -tcons(true, K, V, Acc) -> - [{K,V} | Acc]; -tcons(false, _, _, Acc) -> - Acc. diff --git a/lib/diameter/src/app/diameter_codec.erl b/lib/diameter/src/app/diameter_codec.erl deleted file mode 100644 index d88f42fb7c..0000000000 --- a/lib/diameter/src/app/diameter_codec.erl +++ /dev/null @@ -1,561 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_codec). - --export([encode/2, - decode/2, - decode/3, - collect_avps/1, - decode_header/1, - sequence_numbers/1, - hop_by_hop_id/2, - msg_name/1, - msg_id/1]). - -%% Towards generated encoders (from diameter_gen.hrl). --export([pack_avp/1, - pack_avp/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(MASK(N,I), ((I) band (1 bsl (N)))). - -%% 0 1 2 3 -%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Version | Message Length | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | command flags | Command-Code | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Application-ID | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Hop-by-Hop Identifier | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | End-to-End Identifier | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | AVPs ... -%% +-+-+-+-+-+-+-+-+-+-+-+-+- - -%%% --------------------------------------------------------------------------- -%%% # encode/[2-4] -%%% --------------------------------------------------------------------------- - -encode(Mod, #diameter_packet{} = Pkt) -> - try - e(Mod, Pkt) - catch - error: Reason -> - %% Be verbose rather than letting the emulator truncate the - %% error report. - X = {Reason, ?STACK}, - diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}), - exit(X) - end; - -encode(Mod, Msg) -> - Seq = diameter_session:sequence(), - Hdr = #diameter_header{version = ?DIAMETER_VERSION, - end_to_end_id = Seq, - hop_by_hop_id = Seq}, - encode(Mod, #diameter_packet{header = Hdr, - msg = Msg}). - -e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> - Avps = encode_avps(As), - Length = size(Avps) + 20, - - #diameter_header{version = Vsn, - cmd_code = Code, - application_id = Aid, - hop_by_hop_id = Hid, - end_to_end_id = Eid} - = Hdr, - - Flags = make_flags(0, Hdr), - - Pkt#diameter_packet{bin = <<Vsn:8, Length:24, - Flags:8, Code:24, - Aid:32, - Hid:32, - Eid:32, - Avps/binary>>}; - -e(Mod0, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> - #diameter_header{version = Vsn, - hop_by_hop_id = Hid, - end_to_end_id = Eid} - = Hdr, - - {Mod, MsgName} = rec2msg(Mod0, Msg), - {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), - Flags = make_flags(Flags0, Hdr), - - Avps = encode_avps(Mod, MsgName, values(Msg)), - Length = size(Avps) + 20, - - Pkt#diameter_packet{header = Hdr#diameter_header - {length = Length, - cmd_code = Code, - application_id = Aid, - is_request = 0 /= ?MASK(7, Flags), - is_proxiable = 0 /= ?MASK(6, Flags), - is_error = 0 /= ?MASK(5, Flags), - is_retransmitted = 0 /= ?MASK(4, Flags)}, - bin = <<Vsn:8, Length:24, - Flags:8, Code:24, - Aid:32, - Hid:32, - Eid:32, - Avps/binary>>}. - -%% make_flags/2 - -make_flags(Flags0, #diameter_header{is_request = R, - is_proxiable = P, - is_error = E, - is_retransmitted = T}) -> - {Flags, 3} = lists:foldl(fun(B,{F,N}) -> {mf(B,F,N), N-1} end, - {Flags0, 7}, - [R,P,E,T]), - Flags. - -mf(undefined, F, _) -> - F; -mf(B, F, N) -> %% reset the affected bit - (F bxor (F band (1 bsl N))) bor bit(B, N). - -bit(true, N) -> 1 bsl N; -bit(false, _) -> 0. - -%% values/1 - -values([H|T]) - when is_atom(H) -> - T; -values(Avps) -> - Avps. - -%% encode_avps/3 - -%% Specifying values as a #diameter_avp list bypasses arity and other -%% checks: the values are expected to be already encoded and the AVP's -%% presented are simply sent. This is needed for relay agents, since -%% these have to be able to resend whatever comes. - -%% Message as a list of #diameter_avp{} ... -encode_avps(_, _, [#diameter_avp{} | _] = Avps) -> - encode_avps(reorder(Avps, [], Avps)); - -%% ... or as a tuple list or record. -encode_avps(Mod, MsgName, Values) -> - Mod:encode_avps(MsgName, Values). - -%% reorder/1 - -reorder([#diameter_avp{index = 0} | _] = Avps, Acc, _) -> - Avps ++ Acc; - -reorder([#diameter_avp{index = N} = A | Avps], Acc, _) - when is_integer(N) -> - lists:reverse(Avps, [A | Acc]); - -reorder([H | T], Acc, Avps) -> - reorder(T, [H | Acc], Avps); - -reorder([], Acc, _) -> - Acc. - -%% encode_avps/1 - -encode_avps(Avps) -> - list_to_binary(lists:map(fun pack_avp/1, Avps)). - -%% msg_header/3 - -msg_header(Mod, MsgName, Header) -> - {Code, Flags, ApplId} = h(Mod, MsgName, Header), - {Code, p(Flags, Header), ApplId}. - -%% 6.2 of 3588 requires the same 'P' bit on an answer as on the -%% request. - -p(Flags, #diameter_header{is_request = true, - is_proxiable = P}) -> - Flags band (2#10110000 bor choose(P, 2#01000000, 0)); -p(Flags, _) -> - Flags. - -h(Mod, 'answer-message' = MsgName, Header) -> - ?BASE = Mod, - #diameter_header{cmd_code = Code} = Header, - {_, Flags, ApplId} = ?BASE:msg_header(MsgName), - {Code, Flags, ApplId}; - -h(Mod, MsgName, _) -> - Mod:msg_header(MsgName). - -%% rec2msg/2 - -rec2msg(_, ['answer-message' = M | _]) -> - {?BASE, M}; - -rec2msg(Mod, [MsgName|_]) - when is_atom(MsgName) -> - {Mod, MsgName}; - -rec2msg(Mod, Rec) -> - R = element(1, Rec), - A = 'answer-message', - case ?BASE:msg2rec(A) of - R -> - {?BASE, A}; - _ -> - {Mod, Mod:rec2msg(R)} - end. - -%%% --------------------------------------------------------------------------- -%%% # decode/2 -%%% --------------------------------------------------------------------------- - -%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. - -decode(Mod, Pkt) -> - decode(Mod:id(), Mod, Pkt). - -%% If we're a relay application then just extract the avp's without -%% any decoding of their data since we don't know the application in -%% question. -decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> - case collect_avps(Pkt) of - {Bs, As} -> - Pkt#diameter_packet{avps = As, - errors = [Bs]}; - As -> - Pkt#diameter_packet{avps = As} - end; - -%% Otherwise decode using the dictionary. -decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) - when is_atom(Mod) -> - #diameter_header{cmd_code = CmdCode, - is_request = IsRequest, - is_error = IsError} - = Hdr, - - {M, MsgName} = if IsError andalso not IsRequest -> - {?BASE, 'answer-message'}; - true -> - {Mod, Mod:msg_name(CmdCode, IsRequest)} - end, - - decode_avps(MsgName, M, Pkt, collect_avps(Pkt)); - -decode(Id, Mod, Bin) - when is_bitstring(Bin) -> - decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). - -decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ... - ?LOG(invalid, Pkt#diameter_packet.bin), - #diameter_packet{errors = Failed} - = P - = decode_avps(MsgName, Mod, Pkt, Avps), - P#diameter_packet{errors = [Bs | Failed]}; - -decode_avps('', Mod, Pkt, Avps) -> %% unknown message ... - ?LOG(unknown, {Mod, Pkt#diameter_packet.header}), - Pkt#diameter_packet{avps = lists:reverse(Avps), - errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED -%% msg = undefined identifies this case. - -decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not - {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps), - ?LOGC([] /= Failed, failed, {Mod, Failed}), - Pkt#diameter_packet{msg = Rec, - errors = Failed, - avps = As}. - -%%% --------------------------------------------------------------------------- -%%% # decode_header/1 -%%% --------------------------------------------------------------------------- - -decode_header(<<Version:8, - MsgLength:24, - CmdFlags:1/binary, - CmdCode:24, - ApplicationId:32, - HopByHopId:32, - EndToEndId:32, - _/bitstring>>) -> - <<R:1, P:1, E:1, T:1, _:4>> - = CmdFlags, - %% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored - %% by the receiver. - - %% The RFC is quite unclear about the order of the bits in this - %% case. It writes - %% - %% 0 1 2 3 4 5 6 7 - %% +-+-+-+-+-+-+-+-+ - %% |R P E T r r r r| - %% +-+-+-+-+-+-+-+-+ - %% - %% in defining these but the scale refers to the (big endian) - %% transmission order, first to last, not the bit order. That is, - %% R is the high order bit. It's odd that a standard reserves - %% low-order bit rather than high-order ones. - - #diameter_header{version = Version, - length = MsgLength, - cmd_code = CmdCode, - application_id = ApplicationId, - hop_by_hop_id = HopByHopId, - end_to_end_id = EndToEndId, - is_request = 1 == R, - is_proxiable = 1 == P, - is_error = 1 == E, - is_retransmitted = 1 == T}; - -decode_header(_) -> - false. - -%%% --------------------------------------------------------------------------- -%%% # sequence_numbers/1 -%%% --------------------------------------------------------------------------- - -%% The End-To-End identifier must be unique for at least 4 minutes. We -%% maintain a 24-bit wraparound counter, and add an 8-bit persistent -%% wraparound counter. The 8-bit counter is incremented each time the -%% system is restarted. - -sequence_numbers(#diameter_packet{bin = Bin}) - when is_binary(Bin) -> - sequence_numbers(Bin); - -sequence_numbers(#diameter_packet{header = #diameter_header{} = H}) -> - sequence_numbers(H); - -sequence_numbers(#diameter_header{hop_by_hop_id = H, - end_to_end_id = E}) -> - {H,E}; - -sequence_numbers(<<_:12/binary, H:32, E:32, _/binary>>) -> - {H,E}. - -%%% --------------------------------------------------------------------------- -%%% # hop_by_hop_id/2 -%%% --------------------------------------------------------------------------- - -hop_by_hop_id(Id, <<H:12/binary, _:32, T/binary>>) -> - <<H/binary, Id:32, T/binary>>. - -%%% --------------------------------------------------------------------------- -%%% # msg_name/1 -%%% --------------------------------------------------------------------------- - -msg_name(#diameter_header{application_id = ?APP_ID_COMMON, - cmd_code = C, - is_request = R}) -> - ?BASE:msg_name(C,R); - -msg_name(Hdr) -> - msg_id(Hdr). - -%% Note that messages in different applications could have the same -%% name. - -%%% --------------------------------------------------------------------------- -%%% # msg_id/1 -%%% --------------------------------------------------------------------------- - -msg_id(#diameter_packet{msg = [#diameter_header{} = Hdr | _]}) -> - msg_id(Hdr); - -msg_id(#diameter_packet{header = #diameter_header{} = Hdr}) -> - msg_id(Hdr); - -msg_id(#diameter_header{application_id = A, - cmd_code = C, - is_request = R}) -> - {A, C, if R -> 1; true -> 0 end}; - -msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> - {ApplId, CmdCode, Rbit}. - -%%% --------------------------------------------------------------------------- -%%% # collect_avps/1 -%%% --------------------------------------------------------------------------- - -%% Note that the returned list of AVP's is reversed relative to their -%% order in the binary. Note also that grouped avp's aren't unraveled, -%% only those at the top level. - -collect_avps(#diameter_packet{bin = Bin}) -> - <<_:20/binary, Avps/bitstring>> = Bin, - collect_avps(Avps); - -collect_avps(Bin) -> - collect_avps(Bin, 0, []). - -collect_avps(<<>>, _, Acc) -> - Acc; -collect_avps(Bin, N, Acc) -> - try split_avp(Bin) of - {Rest, AVP} -> - collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc]) - catch - ?FAILURE(_) -> - {Bin, Acc} - end. - -%% 0 1 2 3 -%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | AVP Code | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% |V M P r r r r r| AVP Length | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Vendor-ID (opt) | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Data ... -%% +-+-+-+-+-+-+-+-+ - -%% split_avp/1 - -split_avp(Bin) -> - 8 =< size(Bin) orelse ?THROW(truncated_header), - - <<Code:32, Flags:1/binary, Length:24, Rest/bitstring>> - = Bin, - - DataSize = Length - 8, % size(Code+Flags+Length) = 8 octets - PadSize = (4 - (DataSize rem 4)) rem 4, - - DataSize + PadSize =< size(Rest) - orelse ?THROW(truncated_data), - - <<Data:DataSize/binary, _:PadSize/binary, R/bitstring>> - = Rest, - <<Vbit:1, Mbit:1, Pbit:1, _Reserved:5>> - = Flags, - - 0 == Vbit orelse 4 =< size(Data) - orelse ?THROW(truncated_vendor_id), - - {Vid, D} = vid(Vbit, Data), - {R, #diameter_avp{code = Code, - vendor_id = Vid, - is_mandatory = 1 == Mbit, - need_encryption = 1 == Pbit, - data = D}}. - -%% The RFC is a little misleading when stating that OctetString is -%% padded to a 32-bit boundary while other types align naturally. All -%% other types are already multiples of 32 bits so there's no need to -%% distinguish between types here. Any invalid lengths will result in -%% decode error in diameter_types. - -vid(1, <<Vid:32, Data/bitstring>>) -> - {Vid, Data}; -vid(0, Data) -> - {undefined, Data}. - -%%% --------------------------------------------------------------------------- -%%% # pack_avp/1 -%%% --------------------------------------------------------------------------- - -%% The normal case here is data as an #diameter_avp{} list or an -%% iolist, which are the cases that generated codec modules use. The -%% other case is as a convenience in the relay case in which the -%% dictionary doesn't know about specific AVP's. - -%% Grouped AVP whose components need packing ... -pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) -> - pack_avp(A#diameter_avp{data = encode_avps(Avps)}); - -%% ... data as a type/value tuple, possibly with header data, ... -pack_avp(#diameter_avp{data = {Type, Value}} = A) - when is_atom(Type) -> - pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)}); -pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) -> - pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value))); -pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}}) - when is_binary(Bin) -> - pack_avp(T, Bin); -pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> - {Code, _Flags, Vid} = Hdr = Dict:avp_header(Name), - {Name, Type} = Dict:avp_name(Code, Vid), - pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); - -%% ... or as an iolist. -pack_avp(#diameter_avp{code = Code, - vendor_id = V, - is_mandatory = M, - need_encryption = P, - data = Data}) -> - Flags = lists:foldl(fun flag_avp/2, 0, [{V /= undefined, 2#10000000}, - {M, 2#01000000}, - {P, 2#00100000}]), - pack_avp({Code, Flags, V}, iolist_to_binary(Data)). - -flag_avp({true, B}, F) -> - F bor B; -flag_avp({false, _}, F) -> - F. - -%%% --------------------------------------------------------------------------- -%%% # pack_avp/2 -%%% --------------------------------------------------------------------------- - -pack_avp({Code, Flags, VendorId}, Bin) - when is_binary(Bin) -> - Sz = size(Bin), - pack_avp(Code, Flags, VendorId, Sz, pad(Sz rem 4, Bin)). - -pad(0, Bin) -> - Bin; -pad(N, Bin) -> - P = 8*(4-N), - <<Bin/binary, 0:P>>. -%% Note that padding is not included in the length field as mandated by -%% the RFC. - -%% pack_avp/5 -%% -%% Prepend the vendor id as required. - -pack_avp(Code, Flags, Vid, Sz, Bin) - when 0 == Flags band 2#10000000 -> - undefined = Vid, %% sanity check - pack_avp(Code, Flags, Sz, Bin); - -pack_avp(Code, Flags, Vid, Sz, Bin) -> - pack_avp(Code, Flags, Sz+4, <<Vid:32, Bin/binary>>). - -%% pack_avp/4 - -pack_avp(Code, Flags, Sz, Bin) -> - Length = Sz + 8, - <<Code:32, Flags:8, Length:24, Bin/binary>>. - -%% =========================================================================== - -choose(true, X, _) -> X; -choose(false, _, X) -> X. diff --git a/lib/diameter/src/app/diameter_config.erl b/lib/diameter/src/app/diameter_config.erl deleted file mode 100644 index a6b48fe65b..0000000000 --- a/lib/diameter/src/app/diameter_config.erl +++ /dev/null @@ -1,676 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module writes service/transport configuration to the table -%% diameter_config, so that the config will survive service process -%% death, and then turns it into calls towards diameter_service. It -%% also restarts services upon their death. -%% -%% The table diameter_config is only written here while -%% diameter_service reads. This is all somewhat after the fact. Once -%% upon a time the config was only stored in the service process, -%% causing much grief if these processes died (which they did with -%% some regularity) and one was forced to reconfigure. This module was -%% then inserted into the service start in order to keep a more -%% permanent record of the config. That said, service processes are -%% now much more robust than they once were and crashing is a thing of -%% the past. -%% - --module(diameter_config). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([start_service/2, - stop_service/1, - add_transport/2, - remove_transport/2, - have_transport/2, - lookup/1]). - -%% child server start --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% diameter_sync requests. --export([sync/1]). - -%% debug --export([state/0, - uptime/0]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - -%% Server state. --record(state, {id = now()}). - -%% Registered name of the server. --define(SERVER, ?MODULE). - -%% Table config is written to. --define(TABLE, ?MODULE). - -%% Workaround for dialyzer's lack of understanding of match specs. --type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - -%% Configuration records in ?TABLE. - --record(service, - {name, - rec :: match(#diameter_service{}), - options :: match(list())}). - --record(transport, - {service, %% name - ref = make_ref() :: match(reference()), - type :: match(connect | listen), - options :: match(list())}). - -%% Monitor entry in ?TABLE. --record(monitor, {mref = make_ref() :: reference(), - service}). %% name - -%% Time to lay low before restarting a dead service. --define(RESTART_SLEEP, 2000). - -%% A minimal diameter_caps for checking for valid capabilities values. --define(EXAMPLE_CAPS, - #diameter_caps{origin_host = "TheHost", - origin_realm = "TheRealm", - host_ip_address = [{127,0,0,1}], - vendor_id = 42, - product_name = "TheProduct"}). - --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -%%% The return values below assume the server diameter_config is started. -%%% The functions will exit if it isn't. - -%% -------------------------------------------------------------------------- -%% # start_service(SvcName, Opts) -%% -%% Output: ok | {error, Reason} -%% -------------------------------------------------------------------------- - -start_service(SvcName, Opts) - when is_list(Opts) -> - start_rc(sync(SvcName, {start_service, SvcName, Opts})). - -start_rc({ok = T, _Pid}) -> - T; -start_rc({error, _} = No) -> - No; -start_rc(timeout) -> - {error, application_not_started}. - -%% -------------------------------------------------------------------------- -%% # stop_service(SvcName) -%% -%% Output: ok -%% -------------------------------------------------------------------------- - -stop_service(SvcName) -> - sync(SvcName, {stop_service, SvcName}). - -%% -------------------------------------------------------------------------- -%% # add_transport(SvcName, {Type, Opts}) -%% -%% Input: Type = connect | listen -%% -%% Output: {ok, Ref} | {error, Reason} -%% -------------------------------------------------------------------------- - -add_transport(SvcName, {T, Opts}) - when is_list(Opts), (T == connect orelse T == listen) -> - sync(SvcName, {add, SvcName, T, Opts}). - -%% -------------------------------------------------------------------------- -%% # remove_transport(SvcName, Pred) -%% -%% Input: Pred = arity 3 fun on transport ref, connect|listen and Opts, -%% returning true if the transport is to be removed, false if -%% not -%% | arity 2 fun on Ref and Opts only -%% | arity 1 fun on Opts only -%% | Opts matching all transports that have all of the specified -%% options -%% | Ref matching only the transport with this reference. -%% | {M,F,A} applied to Ref, connect|listen and Opts -%% | boolean() -%% -%% Output: ok | {error, Reason} -%% -------------------------------------------------------------------------- - -remove_transport(SvcName, Pred) -> - try - sync(SvcName, {remove, SvcName, pred(Pred)}) - catch - ?FAILURE(Reason) -> - {error, Reason} - end. - -pred(Pred) - when is_function(Pred, 3) -> - Pred; -pred(Pred) - when is_function(Pred, 2) -> - fun(R,_,O) -> Pred(R,O) end; -pred(Pred) - when is_function(Pred, 1) -> - fun(_,_,O) -> Pred(O) end; -pred(Opts) - when is_list(Opts) -> - fun(_,_,O) -> [] == Opts -- O end; -pred(Ref) - when is_reference(Ref) -> - fun(R,_,_) -> R == Ref end; -pred({M,F,A}) - when is_atom(M), is_atom(F), is_list(A) -> - fun(R,T,O) -> apply(M,F,[R,T,O|A]) end; -pred({Type, Pred}) -> %% backwards compatibility - P = pred(Pred), - fun(R,T,O) -> T == Type andalso P(R,T,O) end; -pred(B) - when is_boolean(B) -> - fun(_,_,_) -> B end; -pred(_) -> - ?THROW(pred). - -%% -------------------------------------------------------------------------- -%% # have_transport/2 -%% -%% Output: true | false -%% -------------------------------------------------------------------------- - -have_transport(SvcName, Ref) -> - member([{#transport{service = '$1', - ref = '$2', - _ = '_'}, - [{'andalso', {'=:=', '$1', {const, SvcName}}, - {'=:=', '$2', {const, Ref}}}], - [true]}]). - -%% -------------------------------------------------------------------------- -%% # lookup/1 -%% -------------------------------------------------------------------------- - -lookup(SvcName) -> - select([{#service{name = '$1', rec = '$2', options = '$3'}, - [{'=:=', '$1', {const, SvcName}}], - [{{'$1', '$2', '$3'}}]}, - {#transport{service = '$1', - ref = '$2', - type = '$3', - options = '$4'}, - [{'=:=', '$1', {const, SvcName}}], - [{{'$2', '$3', '$4'}}]}]). - -%% --------------------------------------------------------- -%% EXPORTED INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init/1 -%%% ---------------------------------------------------------- - -init([]) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call/2 -%%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - Reply = {error, {bad_request, Req}}, - {reply, Reply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast/2 -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info/2 -%%% ---------------------------------------------------------- - -%% A service process has died. This is most likely a consequence of -%% stop_service, in which case the restart will find no config for the -%% service and do nothing. The entry keyed on the monitor ref is only -%% removed as a result of the 'DOWN' notification however. -handle_info({'DOWN', MRef, process, _, Reason}, State) -> - [#monitor{service = SvcName} = T] = select([{#monitor{mref = MRef, - _ = '_'}, - [], - ['$_']}]), - queue_restart(Reason, SvcName), - delete_object(T), - {noreply, State}; - -handle_info({monitor, SvcName, Pid}, State) -> - monitor(Pid, SvcName), - {noreply, State}; - -handle_info({restart, SvcName}, State) -> - restart(SvcName), - {noreply, State}; - -handle_info(restart, State) -> - restart(), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%%-------------------------------------------------------------------- -%% # terminate/2 -%%-------------------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%%% ---------------------------------------------------------- -%%% # code_change/3 -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -insert(T) -> - ets:insert(?TABLE, T). - -%% ?TABLE is a bag: check only for a service entry. -have_service(SvcName) -> - member([{#service{name = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - [true]}]). - -member(MatchSpec) -> - '$end_of_table' =/= ets:select(?TABLE, MatchSpec, 1). - -delete_object(T) -> - ets:delete_object(?TABLE, T). - -delete(Key) -> - ets:delete(?TABLE, Key). - -select(MatchSpec) -> - ets:select(?TABLE, MatchSpec). - -select_delete(MatchSpec) -> - ets:select_delete(?TABLE, MatchSpec). - -%% sync/2 -%% -%% Interface functions used to be implemented as calls to ?SERVER but -%% now serialize things per service instead since stopping a service -%% can take time if the server doesn't answer DPR. A caller who wants -%% to stop multiple services can then improve performance by spawning -%% processes to stop them concurrently. - -sync(SvcName, T) -> - diameter_sync:call({?MODULE, SvcName}, - {?MODULE, sync, [T]}, - infinity, - infinity). - -%% sync/1 - -sync({restart, SvcName}) -> - have_service(SvcName) andalso start(SvcName); - -sync({start_service, SvcName, Opts}) -> - try - start(have_service(SvcName), SvcName, Opts) - catch - ?FAILURE(Reason) -> {error, Reason} - end; - -sync({stop_service, SvcName}) -> - stop(SvcName); - -sync({add, SvcName, Type, Opts}) -> - try - add(SvcName, Type, Opts) - catch - ?FAILURE(Reason) -> {error, Reason} - end; - -sync({remove, SvcName, Pred}) -> - remove(select([{#transport{service = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - ['$_']}]), - SvcName, - Pred). - -%% start/3 - -start(true, _, _) -> - {error, already_started}; -start(false, SvcName, Opts) -> - insert(make_config(SvcName, Opts)), - start(SvcName). - -%% start/1 - -start(SvcName) -> - RC = diameter_service:start(SvcName), - startmon(SvcName, RC), - RC. - -startmon(SvcName, {ok, Pid}) -> - ?SERVER ! {monitor, SvcName, Pid}; -startmon(_, {error, _}) -> - ok. - -monitor(Pid, SvcName) -> - MRef = erlang:monitor(process, Pid), - insert(#monitor{mref = MRef, service = SvcName}). - -%% queue_restart/2 - -%% Service has gone down on monitor death. Note that all service-related -%% config is deleted. -queue_restart({shutdown, {monitor, _}}, SvcName) -> - delete(SvcName); - -%% Application shutdown: ignore. -queue_restart(shutdown, _) -> - ok; - -%% Or not. -queue_restart(_, SvcName) -> - erlang:send_after(?RESTART_SLEEP, self(), {restart, SvcName}). - -%% restart/1 - -restart(SvcName) -> - sync(SvcName, {restart, SvcName}). - -%% restart/0 -%% -%% Start anything configured as required. Bang 'restart' to the server -%% to kick things into gear manually. (Not that it should be required -%% but it's been useful for test.) - -restart() -> - MatchSpec = [{#service{name = '$1', _ = '_'}, - [], - ['$1']}], - lists:foreach(fun restart/1, select(MatchSpec)). - -%% stop/1 - -stop(SvcName) -> - %% If the call to the service returns error for any reason other - %% than the process not being alive then deleting the config from - %% under it will surely bring it down. - diameter_service:stop(SvcName), - %% Delete only the service entry, not everything keyed on the name, - select_delete([{#service{name = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - [true]}]), - ok. -%% Note that a transport has to be removed for its statistics to be -%% deleted. - -%% add/3 - -add(SvcName, Type, Opts) -> - %% Ensure usable capabilities. diameter_service:merge_service/2 - %% depends on this. - lists:foreach(fun(Os) -> - is_list(Os) orelse ?THROW({capabilities, Os}), - ok = encode_CER(Os) - end, - [Os || {capabilities, Os} <- Opts, is_list(Os)]), - - Ref = make_ref(), - T = {Ref, Type, Opts}, - %% The call to the service returns error if the service isn't - %% started yet, which is harmless. The transport will be started - %% when the service is in that case. - case start_transport(SvcName, T) of - ok -> - insert(#transport{service = SvcName, - ref = Ref, - type = Type, - options = Opts}), - {ok, Ref}; - {error, _} = No -> - No - end. - -start_transport(SvcName, T) -> - case diameter_service:start_transport(SvcName, T) of - {ok, _Pid} -> - ok; - {error, no_service} -> - ok; - {error, _} = No -> - No - end. - -%% remove/3 - -remove(L, SvcName, Pred) -> - rm(SvcName, lists:filter(fun(#transport{ref = R, type = T, options = O}) -> - Pred(R,T,O) - end, - L)). - -rm(_, []) -> - ok; -rm(SvcName, L) -> - Refs = lists:map(fun(#transport{ref = R}) -> R end, L), - case stop_transport(SvcName, Refs) of - ok -> - lists:foreach(fun delete_object/1, L); - {error, _} = No -> - No - end. - -stop_transport(SvcName, Refs) -> - case diameter_service:stop_transport(SvcName, Refs) of - ok -> - ok; - {error, no_service} -> - ok; - {error, _} = No -> - No - end. - -%% make_config/2 - -make_config(SvcName, Opts) -> - Apps = init_apps(Opts), - [] == Apps andalso ?THROW(no_apps), - - %% Use the fact that diameter_caps has the same field names as CER. - Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER) -- ['AVP'], - - COpts = [T || {K,_} = T <- Opts, lists:member(K, Fields)], - Caps = make_caps(#diameter_caps{}, COpts), - - ok = encode_CER(COpts), - - Os = split(Opts, [{[fun erlang:is_boolean/1], false, share_peers}, - {[fun erlang:is_boolean/1], false, use_shared_peers}, - {[fun erlang:is_pid/1, false], false, monitor}]), - %% share_peers and use_shared_peers are currently undocumented. - - #service{name = SvcName, - rec = #diameter_service{applications = Apps, - capabilities = Caps}, - options = Os}. - -make_caps(Caps, Opts) -> - case diameter_capx:make_caps(Caps, Opts) of - {ok, T} -> - T; - {error, {Reason, _}} -> - ?THROW(Reason) - end. - -%% Validate types by encoding a CER. -encode_CER(Opts) -> - {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts)), - - Hdr = #diameter_header{version = ?DIAMETER_VERSION, - end_to_end_id = 0, - hop_by_hop_id = 0}, - - try - diameter_codec:encode(?BASE, #diameter_packet{header = Hdr, - msg = CER}), - ok - catch - exit: Reason -> - ?THROW(Reason) - end. - -init_apps(Opts) -> - lists:foldl(fun app_acc/2, [], lists:reverse(Opts)). - -app_acc({application, Opts}, Acc) -> - is_list(Opts) orelse ?THROW({application, Opts}), - - [Dict, Mod] = get_opt([dictionary, module], Opts), - Alias = get_opt(alias, Opts, Dict), - ModS = get_opt(state, Opts, Alias), - M = get_opt(call_mutates_state, Opts, false), - A = get_opt(answer_errors, Opts, report), - [#diameter_app{alias = Alias, - dictionary = Dict, - id = cb(Dict, id), - module = init_mod(Mod), - init_state = ModS, - mutable = init_mutable(M), - answer_errors = init_answers(A)} - | Acc]; -app_acc(_, Acc) -> - Acc. - -init_mod(M) - when is_atom(M) -> - [M]; -init_mod([M|_] = L) - when is_atom(M) -> - L; -init_mod(M) -> - ?THROW({module, M}). - -init_mutable(M) - when M == true; - M == false -> - M; -init_mutable(M) -> - ?THROW({call_mutates_state, M}). - -init_answers(A) - when callback == A; - report == A; - discard == A -> - A; -init_answers(A) -> - ?THROW({answer_errors, A}). - -%% Get a single value at the specified key. -get_opt(Keys, List) - when is_list(Keys) -> - [get_opt(K, List) || K <- Keys]; -get_opt(Key, List) -> - case [V || {K,V} <- List, K == Key] of - [V] -> V; - _ -> ?THROW({arity, Key}) - end. - -%% Get an optional value at the specified key. -get_opt(Key, List, Def) -> - case [V || {K,V} <- List, K == Key] of - [] -> Def; - [V] -> V; - _ -> ?THROW({arity, Key}) - end. - -split(Opts, Defs) -> - [{K, value(D, Opts)} || {_,_,K} = D <- Defs]. - -value({Preds, Def, Key}, Opts) -> - V = get_opt(Key, Opts, Def), - lists:any(fun(P) -> pred(P,V) end, Preds) - orelse ?THROW({value, Key}), - V. - -pred(F, V) - when is_function(F) -> - F(V); -pred(T, V) -> - T == V. - -cb(M,F) -> - try M:F() of - V -> V - catch - E: Reason -> - ?THROW({callback, E, Reason, ?STACK}) - end. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_dbg.erl b/lib/diameter/src/app/diameter_dbg.erl deleted file mode 100644 index 5b0ac3a3b6..0000000000 --- a/lib/diameter/src/app/diameter_dbg.erl +++ /dev/null @@ -1,516 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_dbg). - --export([table/1, - tables/0, - fields/1, - help/0, - modules/0, - versions/0, - version_info/0, - compiled/0, - procs/0, - latest/0, - nl/0, - log/4]). - --export([diameter_config/0, - diameter_peer/0, - diameter_reg/0, - diameter_request/0, - diameter_sequence/0, - diameter_service/0, - diameter_stats/0]). - --export([pp/1, - subscriptions/0, - children/0]). - -%% Trace help. --export([tracer/0, tracer/1, - p/0, p/1, - stop/0, - tpl/1, - tp/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - - --define(INFO, diameter_info). --define(SEP(), ?INFO:sep()). - --define(LOCAL, [diameter_config, - diameter_peer, - diameter_reg, - diameter_request, - diameter_sequence, - diameter_service, - diameter_stats]). - --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -log(_Slogan, _Mod, _Line, _Details) -> - ok. - -%%% ---------------------------------------------------------- -%%% # help() -%%% ---------------------------------------------------------- - -help() -> - not_yet_implemented. - -%%% ---------------------------------------------------------- -%%% # table(TableName) -%%% -%%% Input: TableName = diameter table containing record entries. -%%% -%%% Output: Count | undefined -%%% ---------------------------------------------------------- - -table(T) - when (T == diameter_peer) orelse (T == diameter_reg) -> - ?INFO:format(collect(T), fields(T), fun ?INFO:split/2); - -table(Table) - when is_atom(Table) -> - case fields(Table) of - undefined = No -> - No; - Fields -> - ?INFO:format(Table, Fields, fun split/2) - end. - -split([started, name | Fs], [S, N | Vs]) -> - {name, [started | Fs], N, [S | Vs]}; -split([[F|FT]|Fs], [Rec|Vs]) -> - [_, V | VT] = tuple_to_list(Rec), - {F, FT ++ Fs, V, VT ++ Vs}; -split([F|Fs], [V|Vs]) -> - {F, Fs, V, Vs}. - -%%% ---------------------------------------------------------- -%%% # TableName() -%%% ---------------------------------------------------------- - --define(TABLE(Name), Name() -> table(Name)). - -?TABLE(diameter_config). -?TABLE(diameter_peer). -?TABLE(diameter_reg). -?TABLE(diameter_request). -?TABLE(diameter_sequence). -?TABLE(diameter_service). -?TABLE(diameter_stats). - -%%% ---------------------------------------------------------- -%%% # tables() -%%% -%%% Output: Number of records output. -%%% -%%% Description: Pretty-print records in diameter tables from all nodes. -%%% ---------------------------------------------------------- - -tables() -> - ?INFO:format(field(?LOCAL), fun split/3, fun collect/1). - -field(Tables) -> - lists:map(fun(T) -> {T, fields(T)} end, lists:sort(Tables)). - -split(_, Fs, Vs) -> - split(Fs, Vs). - -%%% ---------------------------------------------------------- -%%% # modules() -%%% ---------------------------------------------------------- - -modules() -> - Path = filename:join([appdir(), atom_to_list(?APPLICATION) ++ ".app"]), - {ok, [{application, ?APPLICATION, Attrs}]} = file:consult(Path), - {modules, Mods} = lists:keyfind(modules, 1, Attrs), - Mods. - -appdir() -> - [_|_] = code:lib_dir(?APPLICATION, ebin). - -%%% ---------------------------------------------------------- -%%% # versions() -%%% ---------------------------------------------------------- - -versions() -> - ?INFO:versions(modules()). - -%%% ---------------------------------------------------------- -%%% # versions() -%%% ---------------------------------------------------------- - -version_info() -> - ?INFO:version_info(modules()). - -%%% ---------------------------------------------------------- -%%% # compiled() -%%% ---------------------------------------------------------- - -compiled() -> - ?INFO:compiled(modules()). - -%%% ---------------------------------------------------------- -%%% procs() -%%% ---------------------------------------------------------- - -procs() -> - ?INFO:procs(?APPLICATION). - -%%% ---------------------------------------------------------- -%%% # latest() -%%% ---------------------------------------------------------- - -latest() -> - ?INFO:latest(modules()). - -%%% ---------------------------------------------------------- -%%% # nl() -%%% ---------------------------------------------------------- - -nl() -> - lists:foreach(fun(M) -> abcast = c:nl(M) end, modules()). - -%%% ---------------------------------------------------------- -%%% # pp(Bin) -%%% -%%% Description: Pretty-print a message binary. -%%% ---------------------------------------------------------- - -%% Network byte order = big endian. - -pp(<<Version:8, MsgLength:24, - Rbit:1, Pbit:1, Ebit:1, Tbit:1, Reserved:4, CmdCode:24, - ApplId:32, - HbHid:32, - E2Eid:32, - AVPs/binary>>) -> - ?SEP(), - ppp(["Version", - "Message length", - "[Actual length]", - "R(equest)", - "P(roxiable)", - "E(rror)", - "T(Potential retrans)", - "Reserved bits", - "Command code", - "Application id", - "Hop by hop id", - "End to end id"], - [Version, MsgLength, size(AVPs) + 20, - Rbit, Pbit, Ebit, Tbit, Reserved, - CmdCode, - ApplId, - HbHid, - E2Eid]), - N = avp_loop({AVPs, MsgLength - 20}, 0), - ?SEP(), - N; - -pp(<<_Version:8, MsgLength:24, _/binary>> = Bin) -> - {bad_message_length, MsgLength, size(Bin)}; - -pp(Bin) - when is_binary(Bin) -> - {truncated_binary, size(Bin)}; - -pp(_) -> - not_binary. - -%% avp_loop/2 - -avp_loop({Bin, Size}, N) -> - avp_loop(avp(Bin, Size), N+1); -avp_loop(ok, N) -> - N; -avp_loop([_E, _Rest] = L, N) -> - io:format("! ~s: ~p~n", L), - N; -avp_loop([E, Rest, Fmt | Values], N) - when is_binary(Rest) -> - io:format("! ~s (" ++ Fmt ++ "): ~p~n", [E|Values] ++ [Rest]), - N. - -%% avp/2 - -avp(<<>>, 0) -> - ok; -avp(<<Code:32, Flags:1/binary, Length:24, Rest/binary>>, - Size) -> - avp(Code, Flags, Length, Rest, Size); -avp(Bin, _) -> - ["truncated AVP header", Bin]. - -%% avp/5 - -avp(Code, Flags, Length, Rest, Size) -> - <<V:1, M:1, P:1, Res:5>> - = Flags, - b(), - ppp(["AVP Code", - "V(endor)", - "M(andatory)", - "P(Security)", - "R(eserved)", - "Length"], - [Code, V, M, P, Res, Length]), - avp(V, Rest, Length - 8, Size - 8). - -%% avp/4 - -avp(1, <<V:32, Data/binary>>, Length, Size) -> - ppp({"Vendor-ID", V}), - data(Data, Length - 4, Size - 4); -avp(1, Bin, _, _) -> - ["truncated Vendor-ID", Bin]; -avp(0, Data, Length, Size) -> - data(Data, Length, Size). - -data(Bin, Length, Size) - when size(Bin) >= Length -> - <<AVP:Length/binary, Rest/binary>> = Bin, - ppp({"Data", AVP}), - unpad(Rest, Size - Length, Length rem 4); - -data(Bin, _, _) -> - ["truncated AVP data", Bin]. - -%% Remove padding bytes up to the next word boundary. -unpad(Bin, Size, 0) -> - {Bin, Size}; -unpad(Bin, Size, N) -> - un(Bin, Size, 4 - N). - -un(Bin, Size, N) - when size(Bin) >= N -> - ppp({"Padding bytes", N}), - <<Pad:N/binary, Rest/binary>> = Bin, - Bits = N*8, - case Pad of - <<0:Bits>> -> - {Rest, Size - N}; - _ -> - ["non-zero padding", Bin, "~p", N] - end; - -un(Bin, _, _) -> - ["truncated padding", Bin]. - -b() -> - io:format("#~n"). - -ppp(Fields, Values) -> - lists:foreach(fun ppp/1, lists:zip(Fields, Values)). - -ppp({Field, Value}) -> - io:format(": ~-22s : ~p~n", [Field, Value]). - -%%% ---------------------------------------------------------- -%%% # subscriptions() -%%% -%%% Output: list of {SvcName, Pid} -%%% ---------------------------------------------------------- - -subscriptions() -> - diameter_service:subscriptions(). - -%%% ---------------------------------------------------------- -%%% # children() -%%% ---------------------------------------------------------- - -children() -> - diameter_sup:tree(). - -%%% ---------------------------------------------------------- - -%% tracer/[12] - -tracer(Port) - when is_integer(Port) -> - dbg:tracer(port, dbg:trace_port(ip, Port)); - -tracer(Path) - when is_list(Path) -> - dbg:tracer(port, dbg:trace_port(file, Path)). - -tracer() -> - dbg:tracer(process, {fun p/2, ok}). - -p(T,_) -> - io:format("+ ~p~n", [T]). - -%% p/[01] - -p() -> - p([c,timestamp]). - -p(T) -> - dbg:p(all,T). - -%% stop/0 - -stop() -> - dbg:ctp(), - dbg:stop_clear(). - -%% tpl/1 -%% tp/1 - -tpl(T) -> - dbg(tpl, T). - -tp(T) -> - dbg(tp, T). - -%% dbg/2 - -dbg(F, L) - when is_list(L) -> - [dbg(F, X) || X <- L]; - -dbg(F, M) - when is_atom(M) -> - apply(dbg, F, [M, x]); - -dbg(F, T) - when is_tuple(T) -> - apply(dbg, F, tuple_to_list(T)). - -%% =========================================================================== -%% =========================================================================== - -%% collect/1 - -collect(diameter_peer) -> - lists:flatmap(fun peers/1, diameter:services()); - -collect(diameter_reg) -> - diameter_reg:terms(); - -collect(Name) -> - c(ets:info(Name), Name). - -c(undefined, _) -> - []; -c(_, Name) -> - ets:tab2list(Name). - -%% peers/1 - -peers(Name) -> - peers(Name, diameter:service_info(Name, transport)). - -peers(_, undefined) -> - []; -peers(Name, Ts) -> - lists:flatmap(fun(T) -> mk_peers(Name, T) end, Ts). - -mk_peers(Name, [_, {type, connect} | _] = Ts) -> - [[Name | mk_peer(Ts)]]; -mk_peers(Name, [R, {type, listen}, O, {accept = A, As}]) -> - [[Name | mk_peer([R, {type, A}, O | Ts])] || Ts <- As]. -%% This is a bit lame: service_info works to build this list and out -%% of something like what we want here and then we take it apart. - -mk_peer(Vs) -> - [Type, Ref, State, Opts, WPid, TPid, SApps, Caps] - = get_values(Vs, [type,ref,state,options,watchdog,peer,apps,caps]), - [Ref, State, [{type, Type} | Opts], s(WPid), s(TPid), SApps, Caps]. - -get_values(Vs, Ks) -> - [proplists:get_value(K, Vs) || K <- Ks]. - -s(undefined = T) -> - T; -s({Pid, _Started, _State}) -> - state(Pid); -s({Pid, _Started}) -> - state(Pid). - -%% Collect states from watchdog/transport pids. -state(Pid) -> - MRef = erlang:monitor(process, Pid), - Pid ! {state, self()}, - receive - {'DOWN', MRef, process, _, _} -> - Pid; - {Pid, _} = T -> - erlang:demonitor(MRef, [flush]), - T - end. - -%% fields/1 - --define(FIELDS(Table), fields(Table) -> record_info(fields, Table)). - -fields(diameter_config) -> - []; - -fields(T) - when T == diameter_request; - T == diameter_sequence -> - fun kv/1; - -fields(diameter_stats) -> - fun({Ctr, N}) when not is_pid(Ctr) -> - {[counter, value], [Ctr, N]}; - (_) -> - [] - end; - -fields(diameter_service) -> - [started, - name, - record_info(fields, diameter_service), - peerT, - connT, - share_peers, - use_shared_peers, - shared_peers, - local_peers, - monitor]; - -?FIELDS(diameter_event); -?FIELDS(diameter_uri); -?FIELDS(diameter_avp); -?FIELDS(diameter_header); -?FIELDS(diameter_packet); -?FIELDS(diameter_app); -?FIELDS(diameter_caps); - -fields(diameter_peer) -> - [service, ref, state, options, watchdog, peer, applications, capabilities]; - -fields(diameter_reg) -> - [property, pids]; - -fields(_) -> - undefined. - -kv({_,_}) -> - [key, value]; -kv(_) -> - []. diff --git a/lib/diameter/src/app/diameter_dict.erl b/lib/diameter/src/app/diameter_dict.erl deleted file mode 100644 index 3b9ba00a3f..0000000000 --- a/lib/diameter/src/app/diameter_dict.erl +++ /dev/null @@ -1,153 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module provide OTP's dict interface built on top of ets. -%% -%% Note that while the interface is the same as dict the semantics -%% aren't quite. A Dict here is just a table identifier (although -%% this fact can't be used if you want dict/ets-based implementations -%% to be interchangeable) so changes made to the Dict modify the -%% underlying table. For merge/3, the first argument table is modified. -%% -%% The underlying ets table implementing a dict is deleted when the -%% process from which new() was invoked exits and the dict is only -%% writable from this process. -%% -%% The reason for this is to be able to swap dict/ets-based -%% implementations: the former is easier to debug, the latter is -%% faster for larger tables. It's also just a nice interface even -%% when there's no need for swapability. -%% - --module(diameter_dict). - --export([append/3, - append_list/3, - erase/2, - fetch/2, - fetch_keys/1, - filter/2, - find/2, - fold/3, - from_list/1, - is_key/2, - map/2, - merge/3, - new/0, - store/3, - to_list/1, - update/3, - update/4, - update_counter/3]). - -%%% ---------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% ---------------------------------------------------------- - -append(Key, Value, Dict) -> - append_list(Key, [Value], Dict). - -append_list(Key, ValueList, Dict) - when is_list(ValueList) -> - update(Key, fun(V) -> V ++ ValueList end, ValueList, Dict). - -erase(Key, Dict) -> - ets:delete(Dict, Key), - Dict. - -fetch(Key, Dict) -> - {ok, V} = find(Key, Dict), - V. - -fetch_keys(Dict) -> - ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). - -filter(Pred, Dict) -> - lists:foreach(fun({K,V}) -> filter(Pred(K,V), K, Dict) end, to_list(Dict)), - Dict. - -find(Key, Dict) -> - case ets:lookup(Dict, Key) of - [{Key, V}] -> - {ok, V}; - [] -> - error - end. - -fold(Fun, Acc0, Dict) -> - ets:foldl(fun({K,V}, Acc) -> Fun(K, V, Acc) end, Acc0, Dict). - -from_list(List) -> - lists:foldl(fun store/2, new(), List). - -is_key(Key, Dict) -> - ets:member(Dict, Key). - -map(Fun, Dict) -> - lists:foreach(fun({K,V}) -> store(K, Fun(K,V), Dict) end, to_list(Dict)), - Dict. - -merge(Fun, Dict1, Dict2) -> - fold(fun(K2,V2,_) -> - update(K2, fun(V1) -> Fun(K2, V1, V2) end, V2, Dict1) - end, - Dict1, - Dict2). - -new() -> - ets:new(?MODULE, [set]). - -store(Key, Value, Dict) -> - store({Key, Value}, Dict). - -to_list(Dict) -> - ets:tab2list(Dict). - -update(Key, Fun, Dict) -> - store(Key, Fun(fetch(Key, Dict)), Dict). - -update(Key, Fun, Initial, Dict) -> - store(Key, map(Key, Fun, Dict, Initial), Dict). - -update_counter(Key, Increment, Dict) - when is_integer(Increment) -> - update(Key, fun(V) -> V + Increment end, Increment, Dict). - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -store({_,_} = T, Dict) -> - ets:insert(Dict, T), - Dict. - -filter(true, _, _) -> - ok; -filter(false, K, Dict) -> - erase(K, Dict). - -map(Key, Fun, Dict, Error) -> - case find(Key, Dict) of - {ok, V} -> - Fun(V); - error -> - Error - end. - diff --git a/lib/diameter/src/app/diameter_exprecs.erl b/lib/diameter/src/app/diameter_exprecs.erl deleted file mode 100644 index 5e120d6f44..0000000000 --- a/lib/diameter/src/app/diameter_exprecs.erl +++ /dev/null @@ -1,301 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Parse transform for generating record access functions -%% -%% This parse transform can be used to reduce compile-time -%% dependencies in large systems. -%% -%% In the old days, before records, Erlang programmers often wrote -%% access functions for tuple data. This was tedious and error-prone. -%% The record syntax made this easier, but since records were implemented -%% fully in the pre-processor, a nasty compile-time dependency was -%% introduced. -%% -%% This module automates the generation of access functions for -%% records. While this method cannot fully replace the utility of -%% pattern matching, it does allow a fair bit of functionality on -%% records without the need for compile-time dependencies. -%% -%% Whenever record definitions need to be exported from a module, -%% inserting a compiler attribute, -%% -%% export_records([RecName, ...]) -%% -%% causes this transform to lay out access functions for the exported -%% records: -%% -%% -module(foo) -%% -compile({parse_transform, diameter_exprecs}). -%% -%% -record(r, {a, b, c}). -%% -export_records([a]). -%% -%% -export(['#info-'/1, '#info-'/2, -%% '#new-'/1, '#new-'/2, -%% '#get-'/2, '#set-'/2, -%% '#new-a'/0, '#new-a'/1, -%% '#get-a'/2, '#set-a'/2, -%% '#info-a'/1]). -%% -%% '#info-'(RecName) -> -%% '#info-'(RecName, fields). -%% -%% '#info-'(r, Info) -> -%% '#info-r'(Info). -%% -%% '#new-'(r) -> #r{}. -%% '#new-'(r, Vals) -> '#new-r'(Vals) -%% -%% '#new-r'() -> #r{}. -%% '#new-r'(Vals) -> '#set-r'(Vals, #r{}). -%% -%% '#get-'(Attrs, #r{} = Rec) -> -%% '#get-r'(Attrs, Rec). -%% -%% '#get-r'(Attrs, Rec) when is_list(Attrs) -> -%% ['#get-r'(A, Rec) || A <- Attrs]; -%% '#get-r'(a, Rec) -> Rec#r.a; -%% '#get-r'(b, Rec) -> Rec#r.b; -%% '#get-r'(c, Rec) -> Rec#r.c. -%% -%% '#set-'(Vals, #r{} = Rec) -> -%% '#set-r'(Vals, Rec). -%% -%% '#set-r'(Vals, Rec) when is_list(Vals) -> -%% lists:foldl(fun '#set-r'/2, Rec, Vals); -%% '#set-r'({a,V}, Rec) -> Rec#r{a = V}; -%% '#set-r'({b,V}, Rec) -> Rec#r{b = V}; -%% '#set-r'({c,V}, Rec) -> Rec#r{c = V}. -%% -%% '#info-r'(fields) -> record_info(fields, r); -%% '#info-r'(size) -> record_info(size, r); -%% '#info-r'({index, a}) -> 1; -%% '#info-r'({index, b}) -> 2; -%% '#info-r'({index, c}) -> 3; -%% - --module(diameter_exprecs). - --export([parse_transform/2]). - -%% Form tag with line number. --define(F(T), T, ?LINE). -%% Yes, that's right. The replacement is to the first unmatched ')'. - --define(attribute, ?F(attribute)). --define(clause, ?F(clause)). --define(function, ?F(function)). --define(call, ?F(call)). --define('fun', ?F('fun')). --define(generate, ?F(generate)). --define(lc, ?F(lc)). --define(match, ?F(match)). --define(remote, ?F(remote)). --define(record, ?F(record)). --define(record_field, ?F(record_field)). --define(record_index, ?F(record_index)). --define(tuple, ?F(tuple)). - --define(ATOM(T), {atom, ?LINE, T}). --define(VAR(V), {var, ?LINE, V}). - --define(CALL(F,A), {?call, ?ATOM(F), A}). --define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). - -%% parse_transform/2 - -parse_transform(Forms, _Options) -> - Rs = [R || {attribute, _, record, R} <- Forms], - case lists:append([E || {attribute, _, export_records, E} <- Forms]) of - [] -> - Forms; - Es -> - {H,T} = lists:splitwith(fun is_head/1, Forms), - H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T - end. - -is_head(T) -> - not lists:member(element(1,T), [function, eof]). - -%% a_export/1 - -a_export(Exports) -> - {?attribute, export, [{fname(info), 1}, - {fname(info), 2}, - {fname(new), 1}, - {fname(new), 2}, - {fname(get), 2}, - {fname(set), 2} - | lists:flatmap(fun export/1, Exports)]}. - -export(Rname) -> - New = fname(new, Rname), - [{New, 0}, - {New, 1}, - {fname(get, Rname), 2}, - {fname(set, Rname), 2}, - {fname(info, Rname), 1}]. - -%% f_accessors/2 - -f_accessors(Es, Rs) -> - ['#info-/1'(), - '#info-/2'(Es), - '#new-/1'(Es), - '#new-/2'(Es), - '#get-/2'(Es), - '#set-/2'(Es) - | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)]. - -accessors(Rname, Fields) -> - ['#new-X/0'(Rname), - '#new-X/1'(Rname), - '#get-X/2'(Rname, Fields), - '#set-X/2'(Rname, Fields), - '#info-X/1'(Rname, Fields)]. - -fields(Rname, Recs) -> - {Rname, Fields} = lists:keyfind(Rname, 1, Recs), - lists:map(fun({record_field, _, {atom, _, N}}) -> N; - ({record_field, _, {atom, _, N}, _}) -> N - end, - Fields). - -fname_prefix(Op) -> - "#" ++ atom_to_list(Op) ++ "-". - -fname(Op) -> - list_to_atom(fname_prefix(Op)). - -fname(Op, Rname) -> - Prefix = fname_prefix(Op), - list_to_atom(Prefix ++ atom_to_list(Rname)). - -%% Generated functions. - -'#info-/1'() -> - Fname = fname(info), - {?function, Fname, 1, - [{?clause, [?VAR('RecName')], - [], - [?CALL(Fname, [?VAR('RecName'), ?ATOM(fields)])]}]}. - -'#info-/2'(Exports) -> - {?function, fname(info), 2, - lists:map(fun 'info-'/1, Exports)}. - -'info-'(R) -> - {?clause, [?ATOM(R), ?VAR('Info')], - [], - [?CALL(fname(info, R), [?VAR('Info')])]}. - -'#new-/1'(Exports) -> - {?function, fname(new), 1, - lists:map(fun 'new-'/1, Exports)}. - -'new-'(R) -> - {?clause, [?ATOM(R)], - [], - [{?record, R, []}]}. - -'#new-/2'(Exports) -> - {?function, fname(new), 2, - lists:map(fun 'new--'/1, Exports)}. - -'new--'(R) -> - {?clause, [?ATOM(R), ?VAR('Vals')], - [], - [?CALL(fname(new, R), [?VAR('Vals')])]}. - -'#get-/2'(Exports) -> - {?function, fname(get), 2, - lists:map(fun 'get-'/1, Exports)}. - -'get-'(R) -> - {?clause, [?VAR('Attrs'), - {?match, {?record, R, []}, ?VAR('Rec')}], - [], - [?CALL(fname(get, R), [?VAR('Attrs'), ?VAR('Rec')])]}. - -'#set-/2'(Exports) -> - {?function, fname(set), 2, - lists:map(fun 'set-'/1, Exports)}. - -'set-'(R) -> - {?clause, [?VAR('Vals'), {?match, {?record, R, []}, ?VAR('Rec')}], - [], - [?CALL(fname(set, R), [?VAR('Vals'), ?VAR('Rec')])]}. - -'#new-X/0'(Rname) -> - {?function, fname(new, Rname), 0, - [{?clause, [], - [], - [{?record, Rname, []}]}]}. - -'#new-X/1'(Rname) -> - {?function, fname(new, Rname), 1, - [{?clause, [?VAR('Vals')], - [], - [?CALL(fname(set, Rname), [?VAR('Vals'), {?record, Rname, []}])]}]}. - -'#set-X/2'(Rname, Fields) -> - {?function, fname(set, Rname), 2, - [{?clause, [?VAR('Vals'), ?VAR('Rec')], - [[?CALL(is_list, [?VAR('Vals')])]], - [?APPLY(lists, foldl, [{?'fun', {function, fname(set, Rname), 2}}, - ?VAR('Rec'), - ?VAR('Vals')])]} - | lists:map(fun(A) -> 'set-X'(Rname, A) end, Fields)]}. - -'set-X'(Rname, Attr) -> - {?clause, [{?tuple, [?ATOM(Attr), ?VAR('V')]}, ?VAR('Rec')], - [], - [{?record, ?VAR('Rec'), Rname, - [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}. - -'#get-X/2'(Rname, Fields) -> - FName = fname(get, Rname), - {?function, FName, 2, - [{?clause, [?VAR('Attrs'), ?VAR('Rec')], - [[?CALL(is_list, [?VAR('Attrs')])]], - [{?lc, ?CALL(FName, [?VAR('A'), ?VAR('Rec')]), - [{?generate, ?VAR('A'), ?VAR('Attrs')}]}]} - | lists:map(fun(A) -> 'get-X'(Rname, A) end, Fields)]}. - -'get-X'(Rname, Attr) -> - {?clause, [?ATOM(Attr), ?VAR('Rec')], - [], - [{?record_field, ?VAR('Rec'), Rname, ?ATOM(Attr)}]}. - -'#info-X/1'(Rname, Fields) -> - {?function, fname(info, Rname), 1, - [{?clause, [?ATOM(fields)], - [], - [?CALL(record_info, [?ATOM(fields), ?ATOM(Rname)])]}, - {?clause, [?ATOM(size)], - [], - [?CALL(record_info, [?ATOM(size), ?ATOM(Rname)])]} - | lists:map(fun(A) -> 'info-X'(Rname, A) end, Fields)]}. - -'info-X'(Rname, Attr) -> - {?clause, [{?tuple, [?ATOM(index), ?ATOM(Attr)]}], - [], - [{?record_index, Rname, ?ATOM(Attr)}]}. diff --git a/lib/diameter/src/app/diameter_info.erl b/lib/diameter/src/app/diameter_info.erl deleted file mode 100644 index 39d32d07cd..0000000000 --- a/lib/diameter/src/app/diameter_info.erl +++ /dev/null @@ -1,869 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_info). - --export([usage/1, - format/1, - format/2, - format/3, - format/4, - table/2, - tables/1, - tables/2, - split/2, - split/3, - tab2list/1, - modules/1, - versions/1, - version_info/1, - attrs/2, - compiled/1, - procs/1, - latest/1, - list/1]). - -%% Support for rolling your own. --export([sep/0, - sep/1, - widest/1, - p/1, - p/3]). - --compile({no_auto_import,[max/2]}). - --export([collect/2]). - --define(LONG_TIMEOUT, 30000). --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -%%% ---------------------------------------------------------- -%%% # usage(String) -%%% ---------------------------------------------------------- - -usage(Usage) -> - sep($+), - io:format("+ ~p~n", [?MODULE]), - io:format("~n~s~n~n", [compact(Usage)]), - sep($+). - -%%% -%%% The function format/3, for pretty-printing tables, comes in -%%% several flavours. -%%% - -%%% ---------------------------------------------------------- -%%% # format(TableName, Fields, SplitFun) -%%% -%%% Input: TableName = atom() name of table. -%%% -%%% Fields = List of field names for the records maintained -%%% in the specified table. Can be empty, in which -%%% case entries are listed unadorned of field names -%%% and SplitFun is unused. -%%% | Integer, equivalent to a list with this many '' atoms. -%%% | Arity 1 fun mapping a table entry to a Fields list -%%% or a tuple {Fields, Values} of lists of the same -%%% length. -%%% -%%% If Fields is a list then its length must be the same -%%% as or one less than the size of the tuples contained -%%% in the table. (The values printed then being those -%%% in the tuple or record in question.) -%%% -%%% SplitFun = Arity 3 fun applied as -%%% -%%% SplitFun(TableName, Fields, Values) -%%% -%%% in order to obtain a tuple -%%% -%%% {Field, RestFields, Value, RestValues} -%%% -%%% for which Field/Value will be formatted on -%%% STDOUT. (This is to allow a value to be -%%% transformed before being output by returning a -%%% new value and/or replacing the remainder of -%%% the list.) The returned lists must have the -%%% same length and Field here is an atom, '' causing -%%% a value to be listed unadorned of the field name. -%%% -%%% Field can also be list of field names, in -%%% which case Value must be a record of the -%%% corresponding type. -%%% -%%% | Arity 2 fun applied as SplitFun(Fields, Values). -%%% -%%% Output: Count | undefined -%%% -%%% Count = Number of entries output. -%%% -%%% Description: Pretty-print records in a named table. -%%% ---------------------------------------------------------- - -format(Table, Fields, SFun) - when is_atom(Table), is_function(SFun, 2) -> - ft(ets:info(Table), Table, SFun, Fields); - -format(Table, Fields, SFun) - when is_atom(Table), is_function(SFun, 3) -> - format(Table, Fields, fun(Fs,Vs) -> SFun(Table, Fs, Vs) end); - -%%% ---------------------------------------------------------- -%%% # format(Recs, Fields, SplitFun) -%%% -%%% Input: Recs = list of records/tuples -%%% Fields = As for format(Table, Fields, SplitFun), a table -%%% entry there being a member of Recs. -%%% SplitFun = Arity 3 fun applied as above but with the TableName -%%% replaced by the first element of the records in -%%% question. -%%% | Arity 2 fun as for format/3. -%%% -%%% Output: length(Recs) -%%% -%%% Description: Pretty print records/tuples. -%%% ---------------------------------------------------------- - -format(Recs, Fields, SFun) - when is_list(Recs), is_function(SFun, 3) -> - lists:foldl(fun(R,A) -> f(recsplit(SFun, R), 0, Fields, R, A) end, - 0, - Recs); - -format(Recs, Fields, SFun) - when is_list(Recs), is_function(SFun, 2) -> - lists:foldl(fun(R,A) -> f(SFun, 0, Fields, R, A) end, - 0, - Recs); - -%%% ---------------------------------------------------------- -%%% # format(Tables, SplitFun, CollectFun) -%%% -%%% Input: Tables = list of {TableName, Fields}. -%%% SplitFun = As for format(Table, Fields, SplitFun). -%%% CollectFun = arity 1 fun mapping a table name to a list -%%% of elements. A non-list can be returned to indicate -%%% that the table in question doesn't exist. -%%% -%%% Output: Number of entries output. -%%% -%%% Description: Pretty-print records in a named tables as collected -%%% from known nodes. Each table listing is preceeded by -%%% a banner. -%%% ---------------------------------------------------------- - -format(Tables, SFun, CFun) - when is_list(Tables), is_function(CFun, 1) -> - format_remote(Tables, - SFun, - rpc:multicall(nodes(known), - ?MODULE, - collect, - [CFun, lists:map(fun({T,_}) -> T end, Tables)], - ?LONG_TIMEOUT)); - -%%% ---------------------------------------------------------- -%%% # format(LocalTables, RemoteTables, SplitFun, CollectFun) -%%% # format(LocalTables, RemoteTables, SplitFun) -%%% -%%% Input: LocalTables = list of {TableName, Fields}. -%%% | list of {TableName, Recs, Fields} -%%% RemoteTable = list of {TableName, Fields}. -%%% SplitFun, CollectFun = As for format(Table, CollectFun, SplitFun). -%%% -%%% Output: Number of entries output. -%%% -%%% Description: Pretty-print records in a named tables as collected -%%% from local and remote nodes. Each table listing is -%%% preceeded by a banner. -%%% ---------------------------------------------------------- - -format(Local, Remote, SFun) -> - format(Local, Remote, SFun, fun tab2list/1). - -format(Local, Remote, SFun, CFun) - when is_list(Local), is_list(Remote), is_function(CFun, 1) -> - format_local(Local, SFun) + format(Remote, SFun, CFun). - -%%% ---------------------------------------------------------- -%%% # format(Tables, SplitFun) -%%% ---------------------------------------------------------- - -format(Tables, SFun) - when is_list(Tables), (is_function(SFun, 2) or is_function(SFun, 3)) -> - format(Tables, SFun, fun tab2list/1); - -format(Tables, CFun) - when is_list(Tables), is_function(CFun, 1) -> - format(Tables, fun split/2, CFun). - -%%% ---------------------------------------------------------- -%%% # format(Table|Tables) -%%% ---------------------------------------------------------- - -format(Table) - when is_atom(Table) -> - format(Table, [], fun split/2); - -format(Tables) - when is_list(Tables) -> - format(Tables, fun split/2, fun tab2list/1). - -%%% ---------------------------------------------------------- -%%% # split(TableName, Fields, Values) -%%% -%%% Description: format/3 SplitFun that does nothing special. -%%% ---------------------------------------------------------- - -split([F|FT], [V|VT]) -> - {F, FT, V, VT}. - -split(_, Fs, Vs) -> - split(Fs, Vs). - -%%% ---------------------------------------------------------- -%%% # tab2list(TableName) -%%% -%%% Description: format/4 CollectFun that extracts records from an -%%% existing ets table. -%%% ---------------------------------------------------------- - -tab2list(Table) -> - case ets:info(Table) of - undefined = No -> - No; - _ -> - ets:tab2list(Table) - end. - -list(Table) -> - l(tab2list(Table)). - -l(undefined = No) -> - No; -l(List) - when is_list(List) -> - io:format("~p~n", [List]), - length(List). - -%%% ---------------------------------------------------------- -%%% # table(TableName, Fields) -%%% ---------------------------------------------------------- - -table(Table, Fields) -> - format(Table, Fields, fun split/2). - -%%% ---------------------------------------------------------- -%%% # tables(LocalTables, RemoteTables) -%%% ---------------------------------------------------------- - -tables(Local, Remote) -> - format(Local, Remote, fun split/2). - -%%% ---------------------------------------------------------- -%%% # tables(Tables) -%%% ---------------------------------------------------------- - -tables(Tables) -> - format(Tables, fun split/2). - -%%% ---------------------------------------------------------- -%%% # modules(Prefix|Prefixes) -%%% -%%% Input: Prefix = atom() -%%% -%%% Description: Return the list of all loaded modules with the -%%% specified prefix. -%%% ---------------------------------------------------------- - -modules(Prefix) - when is_atom(Prefix) -> - lists:sort(mods(Prefix)); - -modules(Prefixes) - when is_list(Prefixes) -> - lists:sort(lists:flatmap(fun modules/1, Prefixes)). - -mods(Prefix) -> - P = atom_to_list(Prefix), - lists:filter(fun(M) -> - lists:prefix(P, atom_to_list(M)) - end, - erlang:loaded()). - -%%% ---------------------------------------------------------- -%%% # versions(Modules|Prefix) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List the versions of the specified modules. -%%% ---------------------------------------------------------- - -versions(Modules) -> - {SysInfo, OsInfo, ModInfo} = version_info(Modules), - sep(), - print_sys_info(SysInfo), - sep(), - print_os_info(OsInfo), - sep(), - print_mod_info(ModInfo), - sep(). - -%%% ---------------------------------------------------------- -%%% # attrs(Modules|Prefix, Attr|FormatFun) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List an attribute from module_info. -%%% ---------------------------------------------------------- - -attrs(Modules, Attr) - when is_atom(Attr) -> - attrs(Modules, fun(W,M) -> attr(W, M, Attr, fun attr/1) end); - -attrs(Modules, Fun) - when is_list(Modules) -> - sep(), - W = 2 + widest(Modules), - N = lists:foldl(fun(M,A) -> Fun(W,M), A+1 end, 0, Modules), - sep(), - N; - -attrs(Prefix, Fun) -> - attrs(modules(Prefix), Fun). - -%% attr/1 - -attr(T) when is_atom(T) -> - atom_to_list(T); -attr(N) when is_integer(N) -> - integer_to_list(N); -attr(V) -> - case is_list(V) andalso lists:all(fun is_char/1, V) of - true -> %% string - V; - false -> - io_lib:format("~p", [V]) - end. - -is_char(C) -> - 0 =< C andalso C < 256. - -%% attr/4 - -attr(Width, Mod, Attr, VFun) -> - io:format(": ~*s~s~n", [-Width, Mod, attr(Mod, Attr, VFun)]). - -attr(Mod, Attr, VFun) -> - Key = key(Attr), - try - VFun(val(Attr, keyfetch(Attr, Mod:module_info(Key)))) - catch - _:_ -> - "-" - end. - -attr(Mod, Attr) -> - attr(Mod, Attr, fun attr/1). - -key(time) -> compile; -key(_) -> attributes. - -val(time, {_,_,_,_,_,_} = T) -> - lists:flatten(io_lib:format("~p-~2..0B-~2..0B ~2..0B:~2..0B:~2..0B", - tuple_to_list(T))); -val(_, [V]) -> - V. - -%%% ---------------------------------------------------------- -%%% # compiled(Modules|Prefix) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List the compile times of the specified modules. -%%% ---------------------------------------------------------- - -compiled(Modules) - when is_list(Modules) -> - attrs(Modules, fun compiled/2); - -compiled(Prefix) -> - compiled(modules(Prefix)). - -compiled(Width, Mod) -> - io:format(": ~*s~19s ~s~n", [-Width, - Mod, - attr(Mod, time), - opt(attr(Mod, date))]). - -opt("-") -> - ""; -opt(D) -> - "(" ++ D ++ ")". - -%%% ---------------------------------------------------------- -%%% # procs(Pred|Prefix|Prefixes|Pid|Pids) -%%% -%%% Input: Pred = arity 2 fun returning true|false when applied to a -%%% pid and its process info. -%%% -%%% Output: Number of processes listed. -%%% -%%% Description: List process info for all local processes that test -%%% true with the specified predicate. With the prefix -%%% form, those processes that are either currently -%%% executing in, started executing in, or have a -%%% registered name with a specified prefix are listed. -%%% With the pid forms, only those process that are local -%%% are listed and those that are dead list only the pid -%%% itself. -%%% ---------------------------------------------------------- - -procs(Pred) - when is_function(Pred, 2) -> - procs(Pred, erlang:processes()); - -procs([]) -> - 0; - -procs(Prefix) - when is_atom(Prefix) -> - procs(fun(_,I) -> info(fun pre1/2, I, atom_to_list(Prefix)) end); - -procs(Prefixes) - when is_atom(hd(Prefixes)) -> - procs(fun(_,I) -> info(fun pre/2, I, Prefixes) end); - -procs(Pid) - when is_pid(Pid) -> - procs(fun true2/2, [Pid]); - -procs(Pids) - when is_list(Pids) -> - procs(fun true2/2, Pids). - -true2(_,_) -> - true. - -%% procs/2 - -procs(Pred, Pids) -> - Procs = lists:foldl(fun(P,A) -> - procs_acc(Pred, P, catch process_info(P), A) - end, - [], - Pids), - sep(0 < length(Procs)), - lists:foldl(fun(T,N) -> p(T), sep(), N+1 end, 0, Procs). - -procs_acc(_, Pid, undefined, Acc) -> %% dead - [[{pid, Pid}] | Acc]; -procs_acc(Pred, Pid, Info, Acc) - when is_list(Info) -> - p_acc(Pred(Pid, Info), Pid, Info, Acc); -procs_acc(_, _, _, Acc) -> - Acc. - -p_acc(true, Pid, Info, Acc) -> - [[{pid, Pid} | Info] | Acc]; -p_acc(false, _, _, Acc) -> - Acc. - -%% info/3 - -info(Pred, Info, T) -> - lists:any(fun(I) -> i(Pred, I, T) end, Info). - -i(Pred, {K, {M,_,_}}, T) - when K == current_function; - K == initial_call -> - Pred(M,T); -i(Pred, {registered_name, N}, T) -> - Pred(N,T); -i(_,_,_) -> - false. - -pre1(A, Pre) -> - lists:prefix(Pre, atom_to_list(A)). - -pre(A, Prefixes) -> - lists:any(fun(P) -> pre1(A, atom_to_list(P)) end, Prefixes). - -%%% ---------------------------------------------------------- -%%% # latest(Modules|Prefix) -%%% -%%% Output: {Mod, {Y,M,D,HH,MM,SS}, Version} -%%% -%%% Description: Return the compile time of the most recently compiled -%%% module from the specified non-empty list. The modules -%%% are assumed to exist. -%%% ---------------------------------------------------------- - -latest(Prefix) - when is_atom(Prefix) -> - latest(modules(Prefix)); - -latest([_|_] = Modules) -> - {Mod, T} - = hd(lists:sort(fun latest/2, lists:map(fun compile_time/1, Modules))), - {Mod, T, app_vsn(Mod)}. - -app_vsn(Mod) -> - keyfetch(app_vsn, Mod:module_info(attributes)). - -compile_time(Mod) -> - T = keyfetch(time, Mod:module_info(compile)), - {Mod, T}. - -latest({_,T1},{_,T2}) -> - T1 > T2. - -%%% ---------------------------------------------------------- -%%% version_info(Modules|Prefix) -%%% -%%% Output: {SysInfo, OSInfo, [ModInfo]} -%%% -%%% SysInfo = {Arch, Vers} -%%% OSInfo = {Vers, {Fam, Name}} -%%% ModInfo = {Vsn, AppVsn, Time, CompilerVsn} -%%% ---------------------------------------------------------- - -version_info(Prefix) - when is_atom(Prefix) -> - version_info(modules(Prefix)); - -version_info(Mods) - when is_list(Mods) -> - {sys_info(), os_info(), [{M, mod_version_info(M)} || M <- Mods]}. - -mod_version_info(Mod) -> - try - Info = Mod:module_info(), - [[Vsn], AppVsn] = get_values(attributes, [vsn, app_vsn], Info), - [Ver, Time] = get_values(compile, [version, time], Info), - [Vsn, AppVsn, Ver, Time] - catch - _:_ -> - [] - end. - -get_values(Attr, Keys, Info) -> - As = proplists:get_value(Attr, Info), - [proplists:get_value(K, As, "?") || K <- Keys]. - -sys_info() -> - [A,V] = [chomp(erlang:system_info(K)) || K <- [system_architecture, - system_version]], - {A,V}. - -os_info() -> - {os:version(), case os:type() of - {_Fam, _Name} = T -> - T; - Fam -> - {Fam, ""} - end}. - -chomp(S) -> - string:strip(S, right, $\n). - -print_sys_info({Arch, Ver}) -> - io:format("System info:~n" - " architecture : ~s~n" - " version : ~s~n", - [Arch, Ver]). - -print_os_info({Vsn, {Fam, Name}}) -> - io:format("OS info:~n" - " family : ~s ~s~n" - " version : ~s~n", - [str(Fam), bkt(str(Name)), vsn(Vsn)]). - -print_mod_info(Mods) -> - io:format("Module info:~n", []), - lists:foreach(fun print_mod/1, Mods). - -print_mod({Mod, []}) -> - io:format(" ~w:~n", [Mod]); -print_mod({Mod, [Vsn, AppVsn, Ver, {Year, Month, Day, Hour, Min, Sec}]}) -> - Time = io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", - [Year, Month, Day, Hour, Min, Sec]), - io:format(" ~w:~n" - " vsn : ~s~n" - " app_vsn : ~s~n" - " compiled : ~s~n" - " compiler : ~s~n", - [Mod, str(Vsn), str(AppVsn), Time, Ver]). - -str(A) - when is_atom(A) -> - atom_to_list(A); -str(S) - when is_list(S) -> - S; -str(T) -> - io_lib:format("~p", [T]). - -bkt("" = S) -> - S; -bkt(S) -> - [$[, S, $]]. - -vsn(T) when is_tuple(T) -> - case [[$., integer_to_list(N)] || N <- tuple_to_list(T)] of - [[$.,S] | Rest] -> - [S | Rest]; - [] = S -> - S - end; -vsn(T) -> - str(T). - -%%% ---------------------------------------------------------- -%%% ---------------------------------------------------------- - -%% p/1 - -p(Info) -> - W = 2 + widest([K || {K,_} <- Info]), - lists:foreach(fun({K,V}) -> p(W,K,V) end, Info). - -p(Width, Key, Value) -> - io:format(": ~*s: ~p~n", [-Width, Key, Value]). - -%% sep/[01] - -sep() -> - sep($#). - -sep(true) -> - sep(); -sep(false) -> - ok; - -sep(Ch) -> - io:format("~c~65c~n", [Ch, $-]). - -%% widest/1 - -widest(List) -> - lists:foldl(fun widest/2, 0, List). - -widest(T, Max) - when is_atom(T) -> - widest(atom_to_list(T), Max); - -widest(T, Max) - when is_integer(T) -> - widest(integer_to_list(T), Max); - -widest(T, Max) - when is_list(T) -> %% string - max(length(T), Max). - -pt(T) -> - io:format(": ~p~n", [T]). - -recsplit(SFun, Rec) -> - fun(Fs,Vs) -> SFun(element(1, Rec), Fs, Vs) end. - -max(A, B) -> - if A > B -> A; true -> B end. - -keyfetch(Key, List) -> - {Key,V} = lists:keyfind(Key, 1, List), - V. - -%% ft/4 - -ft(undefined = No, _, _, _) -> - No; - -ft(_, Table, SFun, Fields) -> - ets:foldl(fun(R,A) -> - f(SFun, 0, Fields, R, A) - end, - 0, - Table). - -%% f/5 - -f(SFun, Width, Fields, Rec, Count) -> - ff(SFun, Width, fields(Fields, Rec), Rec, Count). - -ff(SFun, Width, Fields, Rec, Count) -> - sep(0 == Count), - f(SFun, Width, Fields, Rec), - sep(), - Count+1. - -fields(N, _) - when is_integer(N), N >= 0 -> - lists:duplicate(N, ''); %% list values unadorned -fields(Fields, R) - when is_function(Fields, 1) -> - fields(Fields(R), R); -fields({Fields, Values} = T, _) - when length(Fields) == length(Values) -> - T; -fields(Fields, _) - when is_list(Fields) -> - Fields. %% list field/value pairs, or tuples if [] - -%% f/4 - -%% Empty fields list: just print the entry. -f(_, _, [], Rec) - when is_tuple(Rec) -> - pt(Rec); - -%% Otherwise list field names/values. -f(SFun, Width, {Fields, Values}, _) -> - f(SFun, Width, Fields, Values); - -f(SFun, Width, Fields, Rec) - when is_tuple(Rec) -> - f(SFun, Width, Fields, values(Fields, Rec)); - -f(_, _, [], []) -> - ok; - -f(SFun, Width, [HF | _] = Fields, Values) -> - {F, FT, V, VT} = SFun(Fields, Values), - if is_list(F) -> %% V is a record - break($>, HF), - f(SFun, Width, F, values(F,V)), - break($<, HF), - f(SFun, Width, FT, VT); - F == '' -> %% no field name: just list value - pt(V), - f(SFun, Width, FT, VT); - true -> %% list field/value. - W = max(Width, 1 + widest(Fields)), - p(W, F, V), - f(SFun, W, FT, VT) - end. - -values(Fields, Rec) - when length(Fields) == size(Rec) - 1 -> - ?VALUES(Rec); -values(Fields, T) - when length(Fields) == size(T) -> - tuple_to_list(T). - -%% format_local/2 - -format_local(Tables, SFun) -> - lists:foldl(fun(T,A) -> fl(SFun, T, A) end, 0, Tables). - -fl(SFun, {Table, Recs, Fields}, Count) -> - sep(), - io:format("# ~p~n", [Table]), - N = fmt(Recs, Fields, SFun), - sep(0 == N), - Count + N; - -fl(SFun, {Table, Fields}, Count) -> - fl(SFun, {Table, Table, Fields}, Count). - -%% fmt/3 - -fmt(T, Fields, SFun) -> - case format(T, Fields, SFun) of - undefined -> - 0; - N -> - N - end. - -%% break/2 - -break(C, T) -> - io:format("~c ~p~n", [C, T]). - -%% collect/2 -%% -%% Output: {[{TableName, Recs}, ...], node()} - -collect(CFun, TableNames) -> - {lists:foldl(fun(N,A) -> c(CFun, N, A) end, [], TableNames), node()}. - -c(CFun, TableName, Acc) -> - case CFun(TableName) of - Recs when is_list(Recs) -> - [{TableName, Recs} | Acc]; - _ -> - Acc - end. - -%% format_remote/3 - -format_remote(Tables, SFun, {Replies, BadNodes}) -> - N = lists:foldl(fun(T,A) -> fr(Tables, SFun, T, A) end, - 0, - Replies), - sep(0 == N andalso [] /= BadNodes), - lists:foreach(fun(Node) -> io:format("# no reply from ~p~n", [Node]) end, - BadNodes), - sep([] /= BadNodes), - N. - -fr(Tables, SFun, {List, Node}, Count) - when is_list(List) -> %% guard against {badrpc, Reason} - lists:foldl(fun({T,Recs}, C) -> fr(Tables, SFun, Node, T, Recs,C) end, - Count, - List); -fr(_, _, _, Count) -> - Count. - -fr(Tables, SFun, Node, Table, Recs, Count) -> - Fields = keyfetch(Table, Tables), - sep(), - io:format("# ~p@~p~n", [Table, Node]), - N = format(Recs, Fields, tblsplit(SFun, Table)), - sep(0 == N), - Count + N. - -tblsplit(SFun, Table) - when is_function(SFun, 3) -> - fun(Fs,Vs) -> SFun(Table, Fs, Vs) end; -tblsplit(SFun, _) - when is_function(SFun, 2) -> - SFun. - -%% compact/1 -%% -%% Strip whitespace from both ends of a string. - -compact(Str) -> - compact(Str, true). - -compact([Ch|Rest], B) - when Ch == $\n; - Ch == $ ; - Ch == $\t; - Ch == $\v; - Ch == $\r -> - compact(Rest, B); - -compact(Str, false) -> - Str; - -compact(Str, true) -> - lists:reverse(compact(lists:reverse(Str), false)). diff --git a/lib/diameter/src/app/diameter_internal.hrl b/lib/diameter/src/app/diameter_internal.hrl deleted file mode 100644 index 63b35550a8..0000000000 --- a/lib/diameter/src/app/diameter_internal.hrl +++ /dev/null @@ -1,80 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% Our Erlang application. --define(APPLICATION, diameter). - -%% The one and only. --define(DIAMETER_VERSION, 1). - -%% Exception for use within a module with decent protection against -%% catching something we haven't thrown. Not foolproof but close -%% enough. ?MODULE is rudmentary protection against catching across -%% module boundaries, a root of much evil: always catch ?FAILURE(X), -%% never X. --define(FAILURE(Reason), {{?MODULE}, {Reason}}). --define(THROW(Reason), throw(?FAILURE(Reason))). - -%% A corresponding error when failure is the best option. --define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). - -%% Failure reports always get a stack trace. --define(STACK, erlang:get_stacktrace()). - -%% Warning report for unexpected messages in various processes. --define(UNEXPECTED(F,A), - diameter_lib:warning_report(unexpected, {?MODULE, F, A})). --define(UNEXPECTED(A), ?UNEXPECTED(?FUNC, A)). - -%% Something to trace on. --define(LOG(Slogan, Details), - diameter_lib:log(Slogan, ?MODULE, ?LINE, Details)). --define(LOGC(Bool, Slogan, Details), ((Bool) andalso ?LOG(Slogan, Details))). - -%% Compensate for no builtin ?FUNC for use in log reports. --define(FUNC, element(2, element(2, process_info(self(), current_function)))). - -%% Disjunctive match spec condition. 'false' is to ensure that there's at -%% least one condition. --define(ORCOND(List), list_to_tuple(['orelse', false | List])). - -%% 3588, 2.4: --define(APP_ID_COMMON, 0). --define(APP_ID_RELAY, 16#FFFFFFFF). - --define(BASE, diameter_gen_base_rfc3588). - -%%% --------------------------------------------------------- - -%%% RFC 3588, ch 2.6 Peer table --record(diameter_peer, - {host_id, - statusT, - is_dynamic, - expiration, - tls_enabled}). - -%%% RFC 3588, ch 2.7 Realm-based routing table --record(diameter_realm, - {name, - app_id, - local_action, % LOCAL | RELAY | PROXY | REDIRECT - server_id, - is_dynamic, - expiration}). diff --git a/lib/diameter/src/app/diameter_lib.erl b/lib/diameter/src/app/diameter_lib.erl deleted file mode 100644 index 362d593b24..0000000000 --- a/lib/diameter/src/app/diameter_lib.erl +++ /dev/null @@ -1,272 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_lib). - --export([report/2, info_report/2, - error_report/2, - warning_report/2, - now_diff/1, - time/1, - eval/1, - ip4address/1, - ip6address/1, - ipaddr/1, - spawn_opts/2, - wait/1, - fold_tuple/3, - log/4]). - --include("diameter_internal.hrl"). - -%% --------------------------------------------------------------------------- -%% # info_report(Reason, MFA) -%% -%% Input: Reason = Arbitrary term indicating the reason for the report. -%% MFA = {Module, Function, Args} to report. -%% -%% Output: true -%% --------------------------------------------------------------------------- - -report(Reason, MFA) -> - info_report(Reason, MFA). - -info_report(Reason, MFA) -> - report(fun error_logger:info_report/1, Reason, MFA), - true. - -%%% --------------------------------------------------------------------------- -%%% # error_report(Reason, MFA) -%%% # warning_report(Reason, MFA) -%%% -%%% Output: false -%%% --------------------------------------------------------------------------- - -error_report(Reason, MFA) -> - report(fun error_logger:error_report/1, Reason, MFA). - -warning_report(Reason, MFA) -> - report(fun error_logger:warning_report/1, Reason, MFA). - -report(Fun, Reason, MFA) -> - Fun([{why, Reason}, {who, self()}, {what, MFA}]), - false. - -%%% --------------------------------------------------------------------------- -%%% # now_diff(Time) -%%% -%%% Description: Return timer:now_diff(now(), Time) as an {H, M, S, MicroS} -%%% tuple instead of as integer microseconds. -%%% --------------------------------------------------------------------------- - -now_diff({_,_,_} = Time) -> - time(timer:now_diff(erlang:now(), Time)). - -%%% --------------------------------------------------------------------------- -%%% # time(Time) -%%% -%%% Input: Time = {MegaSec, Sec, MicroSec} -%%% | MicroSec -%%% -%%% Output: {H, M, S, MicroS} -%%% --------------------------------------------------------------------------- - -time({_,_,_} = Time) -> %% time of day - %% 24 hours = 24*60*60*1000000 = 86400000000 microsec - time(timer:now_diff(Time, {0,0,0}) rem 86400000000); - -time(Micro) -> %% elapsed time - Seconds = Micro div 1000000, - H = Seconds div 3600, - M = (Seconds rem 3600) div 60, - S = Seconds rem 60, - {H, M, S, Micro rem 1000000}. - -%%% --------------------------------------------------------------------------- -%%% # eval(Func) -%%% --------------------------------------------------------------------------- - -eval({M,F,A}) -> - apply(M,F,A); - -eval([{M,F,A} | X]) -> - apply(M, F, X ++ A); - -eval([[F|A] | X]) -> - eval([F | X ++ A]); - -eval([F|A]) -> - apply(F,A); - -eval({F}) -> - eval(F); - -eval(F) -> - F(). - -%%% --------------------------------------------------------------------------- -%%% # ip4address(Addr) -%%% -%%% Input: string() (eg. "10.0.0.1") -%%% | list of integer() -%%% | tuple of integer() -%%% -%%% Output: {_,_,_,_} of integer -%%% -%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - -ip4address([_,_,_,_] = Addr) -> %% Length 4 string can't be an address. - ipaddr(list_to_tuple(Addr)); - -%% Be brutal. -ip4address(Addr) -> - try - {_,_,_,_} = ipaddr(Addr) - catch - error: _ -> - erlang:error({invalid_address, Addr, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # ip6address(Addr) -%%% -%%% Input: string() (eg. "1080::8:800:200C:417A") -%%% | list of integer() -%%% | tuple of integer() -%%% -%%% Output: {_,_,_,_,_,_,_,_} of integer -%%% -%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - -ip6address([_,_,_,_,_,_,_,_] = Addr) -> %% Length 8 string can't be an address. - ipaddr(list_to_tuple(Addr)); - -%% Be brutal. -ip6address(Addr) -> - try - {_,_,_,_,_,_,_,_} = ipaddr(Addr) - catch - error: _ -> - erlang:error({invalid_address, Addr, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # ipaddr(Addr) -%%% -%%% Input: string() | tuple of integer() -%%% -%%% Output: {_,_,_,_} | {_,_,_,_,_,_,_,_} -%%% -%%% Exceptions: error: {invalid_address, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - --spec ipaddr(string() | tuple()) - -> inet:ip_address(). - -%% Don't convert lists of integers since a length 8 list like -%% [$1,$0,$.,$0,$.,$0,$.,$1] is ambiguous: is it "10.0.0.1" or -%% "49:48:46:48:46:48:46:49"? -%% -%% RFC 2373 defines the format parsed for v6 addresses. - -%% Be brutal. -ipaddr(Addr) -> - try - ip(Addr) - catch - error: _ -> - erlang:error({invalid_address, ?STACK}) - end. - -%% Already a tuple: ensure non-negative integers of the right size. -ip(T) - when size(T) == 4; - size(T) == 8 -> - Bs = 2*size(T), - [] = lists:filter(fun(N) when 0 =< N -> 0 < N bsr Bs end, - tuple_to_list(T)), - T; - -%% Or not: convert from '.'/':'-separated decimal/hex. -ip(Addr) -> - {ok, A} = inet_parse:address(Addr), %% documented in inet(3) - A. - -%%% --------------------------------------------------------------------------- -%%% # spawn_opts(Type, Opts) -%%% --------------------------------------------------------------------------- - -%% TODO: config variables. - -spawn_opts(server, Opts) -> - opts(75000, Opts); -spawn_opts(worker, Opts) -> - opts(5000, Opts). - -opts(HeapSize, Opts) -> - [{min_heap_size, HeapSize} | lists:keydelete(min_heap_size, 1, Opts)]. - -%%% --------------------------------------------------------------------------- -%%% # wait(MRefs) -%%% --------------------------------------------------------------------------- - -wait(L) -> - w([erlang:monitor(process, P) || P <- L]). - -w([]) -> - ok; -w(L) -> - receive - {'DOWN', MRef, process, _, _} -> - w(lists:delete(MRef, L)) - end. - -%%% --------------------------------------------------------------------------- -%%% # fold_tuple(N, T0, T) -%%% --------------------------------------------------------------------------- - -%% Replace fields in T0 by those of T starting at index N, unless the -%% new value is 'undefined'. -%% -%% eg. fold_tuple(2, Hdr, #diameter_header{end_to_end_id = 42}) - -fold_tuple(_, T, undefined) -> - T; - -fold_tuple(N, T0, T1) -> - {_, T} = lists:foldl(fun(V, {I,_} = IT) -> {I+1, ft(V, IT)} end, - {N, T0}, - lists:nthtail(N-1, tuple_to_list(T1))), - T. - -ft(undefined, {_, T}) -> - T; -ft(Value, {Idx, T}) -> - setelement(Idx, T, Value). - -%%% ---------------------------------------------------------- -%%% # log(Slogan, Mod, Line, Details) -%%% -%%% Called to have something to trace on for happenings of interest. -%%% ---------------------------------------------------------- - -log(_, _, _, _) -> - ok. diff --git a/lib/diameter/src/app/diameter_misc_sup.erl b/lib/diameter/src/app/diameter_misc_sup.erl deleted file mode 100644 index 4e40476f14..0000000000 --- a/lib/diameter/src/app/diameter_misc_sup.erl +++ /dev/null @@ -1,58 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The supervisor of the static server processes. -%% - --module(diameter_misc_sup). - --behaviour(supervisor). - --export([start_link/0]). %% supervisor start - -%% supervisor callback --export([init/1]). - --define(CHILDREN, [diameter_sync, %% serialization - diameter_stats, %% statistics counter management - diameter_reg, %% service/property publishing - diameter_peer, %% remote peer manager - diameter_config]). %% configuration/restart - -%% start_link/0 - -start_link() -> - SupName = {local, ?MODULE}, - supervisor:start_link(SupName, ?MODULE, []). - -%% init/1 - -init([]) -> - Flags = {one_for_one, 1, 5}, - Workers = lists:map(fun spec/1, ?CHILDREN), - {ok, {Flags, Workers}}. - -spec(Mod) -> - {Mod, - {Mod, start_link, []}, - permanent, - 1000, - worker, - [Mod]}. diff --git a/lib/diameter/src/app/diameter_peer.erl b/lib/diameter/src/app/diameter_peer.erl deleted file mode 100644 index 3e78c4caef..0000000000 --- a/lib/diameter/src/app/diameter_peer.erl +++ /dev/null @@ -1,225 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_peer). - --behaviour(gen_server). - -%% Interface towards transport modules ... --export([recv/2, - up/1, - up/2]). - -%% ... and the stack. --export([start/3, - send/2, - close/1, - abort/1, - notify/2]). - -%% Server start. --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% debug --export([state/0, - uptime/0]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - -%% Registered name of the server. --define(SERVER, ?MODULE). - -%% Server state. --record(state, {id = now()}). - -%%% --------------------------------------------------------------------------- -%%% # notify/2 -%%% --------------------------------------------------------------------------- - -notify(SvcName, T) -> - rpc:abcast(nodes(), ?SERVER, {notify, SvcName, T}). - -%%% --------------------------------------------------------------------------- -%%% # start/3 -%%% --------------------------------------------------------------------------- - -start(T, Opts, #diameter_service{} = Svc) -> - {Mod, Cfg} = split_transport(Opts), - apply(Mod, start, [T, Svc, Cfg]). - -%%% --------------------------------------------------------------------------- -%%% # up/[12] -%%% --------------------------------------------------------------------------- - -up(Pid) -> %% accepting transport - ifc_send(Pid, {self(), connected}). - -up(Pid, Remote) -> %% connecting transport - ifc_send(Pid, {self(), connected, Remote}). - -%%% --------------------------------------------------------------------------- -%%% # recv/2 -%%% --------------------------------------------------------------------------- - -recv(Pid, Pkt) -> - ifc_send(Pid, {recv, Pkt}). - -%%% --------------------------------------------------------------------------- -%%% # send/2 -%%% --------------------------------------------------------------------------- - -send(Pid, #diameter_packet{transport_data = undefined, - bin = Bin}) -> - send(Pid, Bin); - -send(Pid, Pkt) -> - ifc_send(Pid, {send, Pkt}). - -%%% --------------------------------------------------------------------------- -%%% # close/1 -%%% --------------------------------------------------------------------------- - -close(Pid) -> - ifc_send(Pid, {close, self()}). - -%%% --------------------------------------------------------------------------- -%%% # abort/1 -%%% --------------------------------------------------------------------------- - -abort(Pid) -> - exit(Pid, shutdown). - -%% --------------------------------------------------------------------------- -%% --------------------------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init(Role) -%%% ---------------------------------------------------------- - -init([]) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info(Request, State) -%%% ---------------------------------------------------------- - -%% Remote service is distributing a message. -handle_info({notify, SvcName, T}, S) -> - bang(diameter_service:whois(SvcName), T), - {noreply, S}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% terminate(Reason, State) -%% ---------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%% ---------------------------------------------------------- -%% code_change(OldVsn, State, Extra) -%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -%% ifc_send/2 -%% -%% Send something over the transport interface. - -ifc_send(Pid, T) -> - Pid ! {diameter, T}. - -%% bang/2 - -bang(undefined = No, _) -> - No; -bang(Pid, T) -> - Pid ! T. - -%% split_transport/1 -%% -%% Split options into transport module, transport config and -%% remaining options. - -split_transport(Opts) -> - {[M,C], _} = proplists:split(Opts, [transport_module, - transport_config]), - {value(M, diameter_tcp), value(C, [])}. - -value([{_,V}], _) -> - V; -value([], V) -> - V. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/app/diameter_peer_fsm.erl deleted file mode 100644 index 282fa2742f..0000000000 --- a/lib/diameter/src/app/diameter_peer_fsm.erl +++ /dev/null @@ -1,777 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module implements (as a process) the RFC 3588 Peer State -%% Machine modulo the necessity of adapting the peer election to the -%% fact that we don't know the identity of a peer until we've -%% received a CER/CEA from it. -%% - --module(diameter_peer_fsm). --behaviour(gen_server). - -%% Interface towards diameter_watchdog. --export([start/3]). - -%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% diameter_peer_fsm_sup callback --export([start_link/1]). - -%% internal callbacks --export([match/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). --include("diameter_gen_base_rfc3588.hrl"). - --define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). --define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). - --define(NO_INBAND_SECURITY, 0). --define(TLS, 1). - --define(LOOP_TIMEOUT, 2000). - -%% RFC 3588: -%% -%% Timeout An application-defined timer has expired while waiting -%% for some event. -%% --define(EVENT_TIMEOUT, 10000). - -%% How long to wait for a DPA in response to DPR before simply -%% aborting. Used to distinguish between shutdown and not but there's -%% not really any need. Stopping a service will require a timeout if -%% the peer doesn't answer DPR so the value should be short-ish. --define(DPA_TIMEOUT, 1000). - --record(state, - {state = 'Wait-Conn-Ack' %% state of RFC 3588 Peer State Machine - :: 'Wait-Conn-Ack' | recv_CER | 'Wait-CEA' | 'Open', - mode :: accept | connect | {connect, reference()}, - parent :: pid(), - transport :: pid(), - service :: #diameter_service{}, - dpr = false :: false | {'Unsigned32'(), 'Unsigned32'()}}). - %% | hop by hop and end to end identifiers - -%% There are non-3588 states possible as a consequence of 5.6.1 of the -%% standard and the corresponding problem for incoming CEA's: we don't -%% know who we're talking to until either a CER or CEA has been -%% received. The CEA problem in particular makes it impossible to -%% follow the state machine exactly as documented in 3588: there can -%% be no election until the CEA arrives and we have an Origin-Host to -%% elect. - -%% -%% Once upon a time start/2 started a process akin to that started by -%% start/3 below, which in turn started a watchdog/transport process -%% with the result that the watchdog could send DWR/DWA regardless of -%% whether or not the corresponding Peer State Machine was in its open -%% state; that is, before capabilities exchange had taken place. This -%% is not what RFC's 3588 and 3539 say (albeit not very clearly). -%% Watchdog messages are only exchanged on *open* connections, so the -%% 3539 state machine is more naturally placed on top of the 3588 Peer -%% State Machine rather than closer to the transport. This is what we -%% now do below: connect/accept call diameter_watchdog and return the -%% pid of the watchdog process, and the watchdog in turn calls start/3 -%% below to start the process implementing the Peer State Machine. The -%% former is a "peer" in diameter_service while the latter is a -%% "conn". In a sense, diameter_service sees the watchdog as -%% implementing the Peer State Machine and the process implemented -%% here as being the transport, not being aware of the watchdog at -%% all. -%% - -%%% --------------------------------------------------------------------------- -%%% # start({connect|accept, Ref}, Opts, Service) -%%% -%%% Output: Pid -%%% --------------------------------------------------------------------------- - -%% diameter_config requires a non-empty list of applications on the -%% service but diameter_service then constrains the list to any -%% specified on the transport in question. Check here that the list is -%% still non-empty. - -start({_, Ref} = Type, Opts, #diameter_service{applications = Apps} = Svc) -> - [] /= Apps orelse ?ERROR({no_apps, Type, Opts}), - T = {self(), Type, Opts, Svc}, - {ok, Pid} = diameter_peer_fsm_sup:start_child(T), - diameter_stats:reg(Pid, Ref), - Pid. - -start_link(T) -> - {ok, _} = proc_lib:start_link(?MODULE, - init, - [T], - infinity, - diameter_lib:spawn_opts(server, [])). - -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- - -%% init/1 - -init(T) -> - proc_lib:init_ack({ok, self()}), - gen_server:enter_loop(?MODULE, [], i(T)). - -i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> - putr(dwa, dwa(Caps)), - {ok, TPid, Svc} = start_transport(T, Opts, Svc0), - erlang:monitor(process, TPid), - erlang:monitor(process, WPid), - #state{parent = WPid, - transport = TPid, - mode = M, - service = Svc}. -%% The transport returns its local ip addresses so that different -%% transports on the same service can use different local addresses. -%% The local addresses are put into Host-IP-Address avps here when -%% sending capabilities exchange messages. -%% -%% Invalid transport config may cause us to crash but note that the -%% watchdog start (start/2) succeeds regardless so as not to crash the -%% service. - -start_transport(T, Opts, Svc) -> - case diameter_peer:start(T, Opts, Svc) of - {ok, TPid} -> - {ok, TPid, Svc}; - {ok, TPid, [_|_] = Addrs} -> - #diameter_service{capabilities = Caps0} = Svc, - Caps = Caps0#diameter_caps{host_ip_address = Addrs}, - {ok, TPid, Svc#diameter_service{capabilities = Caps}}; - No -> - exit({shutdown, No}) - end. - -%% handle_call/3 - -handle_call(_, _, State) -> - {reply, nok, State}. - -%% handle_cast/2 - -handle_cast(_, State) -> - {noreply, State}. - -%% handle_info/1 - -handle_info(T, #state{} = State) -> - try transition(T, State) of - ok -> - {noreply, State}; - #state{state = X} = S -> - ?LOGC(X =/= State#state.state, transition, X), - {noreply, S}; - {stop, Reason} -> - ?LOG(stop, Reason), - x(Reason, State); - stop -> - ?LOG(stop, T), - x(T, State) - catch - throw: {?MODULE, Tag, Reason} -> - ?LOG(Tag, {Reason, T}), - {stop, {shutdown, Reason}, State} - end. - -x(Reason, #state{} = S) -> - close_wd(Reason, S), - {stop, {shutdown, Reason}, S}. - -%% terminate/2 - -terminate(_, _) -> - ok. - -%% code_change/3 - -code_change(_, State, _) -> - {ok, State}. - -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- - -putr(Key, Val) -> - put({?MODULE, Key}, Val). - -getr(Key) -> - get({?MODULE, Key}). - -%% transition/2 - -%% Connection to peer. -transition({diameter, {TPid, connected, Remote}}, - #state{state = PS, - mode = M} - = S) -> - 'Wait-Conn-Ack' = PS, %% assert - connect = M, %% - send_CER(S#state{mode = {M, Remote}, - transport = TPid}); - -%% Connection from peer. -transition({diameter, {TPid, connected}}, - #state{state = PS, - mode = M, - parent = Pid} - = S) -> - 'Wait-Conn-Ack' = PS, %% assert - accept = M, %% - Pid ! {accepted, self()}, - start_timer(S#state{state = recv_CER, - transport = TPid}); - -%% Incoming message from the transport. -transition({diameter, {recv, Pkt}}, S) -> - recv(Pkt, S); - -%% Timeout when still in the same state ... -transition({timeout, PS}, #state{state = PS}) -> - stop; - -%% ... or not. -transition({timeout, _}, _) -> - ok; - -%% Outgoing message. -transition({send, Msg}, #state{transport = TPid}) -> - send(TPid, Msg), - ok; - -%% Request for graceful shutdown. -transition({shutdown, Pid}, #state{parent = Pid, dpr = false} = S) -> - dpr(?GOAWAY, S); -transition({shutdown, Pid}, #state{parent = Pid}) -> - ok; - -%% Application shutdown. -transition(shutdown, #state{dpr = false} = S) -> - dpr(?REBOOT, S); -transition(shutdown, _) -> %% DPR already send: ensure expected timeout - dpa_timer(), - ok; - -%% Request to close the transport connection. -transition({close = T, Pid}, #state{parent = Pid, - transport = TPid}) -> - diameter_peer:close(TPid), - {stop, T}; - -%% DPA reception has timed out. -transition(dpa_timeout, _) -> - stop; - -%% Someone wants to know a resolved port: forward to the transport process. -transition({resolve_port, _Pid} = T, #state{transport = TPid}) -> - TPid ! T, - ok; - -%% Parent or transport has died. -transition({'DOWN', _, process, P, _}, - #state{parent = Pid, - transport = TPid}) - when P == Pid; - P == TPid -> - stop; - -%% State query. -transition({state, Pid}, #state{state = S, transport = TPid}) -> - Pid ! {self(), [S, TPid]}, - ok. - -%% Crash on anything unexpected. - -%% send_CER/1 - -send_CER(#state{mode = {connect, Remote}, - service = #diameter_service{capabilities = Caps}, - transport = TPid} - = S) -> - req_send_CER(Caps#diameter_caps.origin_host, Remote) - orelse - close(connected, S), - CER = build_CER(S), - ?LOG(send, 'CER'), - send(TPid, encode(CER)), - start_timer(S#state{state = 'Wait-CEA'}). - -%% Register ourselves as connecting to the remote endpoint in -%% question. This isn't strictly necessary since a peer implementing -%% the 3588 Peer State Machine should reject duplicate connection's -%% from the same peer but there's little point in us setting up a -%% duplicate connection in the first place. This could also include -%% the transport protocol being used but since we're blind to -%% transport just avoid duplicate connections to the same host/port. -req_send_CER(OriginHost, Remote) -> - register_everywhere({?MODULE, connection, OriginHost, {remote, Remote}}). - -%% start_timer/1 - -start_timer(#state{state = PS} = S) -> - erlang:send_after(?EVENT_TIMEOUT, self(), {timeout, PS}), - S. - -%% build_CER/1 - -build_CER(#state{service = #diameter_service{capabilities = Caps}}) -> - {ok, CER} = diameter_capx:build_CER(Caps), - CER. - -%% encode/1 - -encode(Rec) -> - #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Rec), - Bin. - -%% recv/2 - -%% RFC 3588 has result code 5015 for an invalid length but if a -%% transport is detecting message boundaries using the length header -%% then a length error will likely lead to further errors. - -recv(#diameter_packet{header = #diameter_header{length = Len} - = Hdr, - bin = Bin}, - S) - when Len < 20; - (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) -> - discard(invalid_message_length, recv, [size(Bin), - bit_size(Bin) rem 8, - Hdr, - S]); - -recv(#diameter_packet{header = #diameter_header{} = Hdr} - = Pkt, - #state{parent = Pid} - = S) -> - Name = diameter_codec:msg_name(Hdr), - Pid ! {recv, self(), Name, Pkt}, - diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received - rcv(Name, Pkt, S); - -recv(#diameter_packet{header = undefined, - bin = Bin} - = Pkt, - S) -> - recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S); - -recv(Bin, S) - when is_binary(Bin) -> - recv(#diameter_packet{bin = Bin}, S); - -recv(#diameter_packet{header = false} = Pkt, S) -> - discard(truncated_header, recv, [Pkt, S]). - -msg_id({_,_,_} = T, _) -> - T; -msg_id(_, Hdr) -> - diameter_codec:msg_id(Hdr). - -%% Treat invalid length as a transport error and die. Especially in -%% the TCP case, in which there's no telling where the next message -%% begins in the incoming byte stream, keeping a crippled connection -%% alive may just make things worse. - -discard(Reason, F, A) -> - diameter_stats:incr(Reason), - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - throw({?MODULE, abort, Reason}). - -%% rcv/3 - -%% Incoming CEA. -rcv('CEA', Pkt, #state{state = 'Wait-CEA'} = S) -> - handle_CEA(Pkt, S); - -%% Incoming CER -rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> - handle_request(N, Pkt, S); - -%% Anything but CER/CEA in a non-Open state is an error, as is -%% CER/CEA in anything but recv_CER/Wait-CEA. -rcv(Name, _, #state{state = PS}) - when PS /= 'Open'; - Name == 'CER'; - Name == 'CEA' -> - {stop, {Name, PS}}; - -rcv(N, Pkt, S) - when N == 'DWR'; - N == 'DPR' -> - handle_request(N, Pkt, S); - -%% DPA even though we haven't sent DPR: ignore. -rcv('DPA', _Pkt, #state{dpr = false}) -> - ok; - -%% DPA in response to DPR. We could check the sequence numbers but -%% don't bother, just close. -rcv('DPA' = N, _Pkt, #state{transport = TPid}) -> - diameter_peer:close(TPid), - {stop, N}; - -rcv(_, _, _) -> - ok. - -%% send/2 - -%% Msg here could be a #diameter_packet or a binary depending on who's -%% sending. In particular, the watchdog will send DWR as a binary -%% while messages coming from clients will be in a #diameter_packet. -send(Pid, Msg) -> - diameter_stats:incr({diameter_codec:msg_id(Msg), send}), - diameter_peer:send(Pid, Msg). - -%% handle_request/3 - -handle_request(Type, #diameter_packet{} = Pkt, S) -> - ?LOG(recv, Type), - send_answer(Type, diameter_codec:decode(?BASE, Pkt), S). - -%% send_answer/3 - -send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> - #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, - transport_data = TD} - = ReqPkt, - - {Answer, PostF} = build_answer(Type, V, ReqPkt, S), - - Pkt = #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, - msg = Answer, - transport_data = TD}, - - send(TPid, diameter_codec:encode(?BASE, Pkt)), - eval(PostF, S). - -eval([F|A], S) -> - apply(F, A ++ [S]); -eval(ok, S) -> - S. - -%% build_answer/4 - -build_answer('CER', - ?DIAMETER_VERSION, - #diameter_packet{msg = CER, - header = #diameter_header{is_error = false}, - errors = []} - = Pkt, - #state{service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH}} - = Svc, - - {SupportedApps, - #diameter_caps{origin_host = DH} = RCaps, - #diameter_base_CEA{'Result-Code' = RC} - = CEA} - = recv_CER(CER, S), - - try - 2001 == RC %% DIAMETER_SUCCESS - orelse ?THROW({sent_CEA, RC}), - register_everywhere({?MODULE, connection, OH, DH}) - orelse ?THROW({election_lost, 4003}), - #diameter_base_CEA{'Inband-Security-Id' = [IS]} - = CEA, - {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]} - catch - ?FAILURE({Reason, RC}) -> - {answer('CER', S) ++ [{'Result-Code', RC}], - [fun close/2, {'CER', Reason, DH}]} - end; - -%% The error checks below are similar to those in diameter_service for -%% other messages. Should factor out the commonality. - -build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) -> - FailedAvp = failed_avp([A || {_,A} <- Es]), - Ans = answer(answer(Type, S), V, H, Es), - {set(Ans, FailedAvp), if 'CER' == Type -> - [fun close/2, {Type, V, Pkt}]; - true -> - ok - end}. - -failed_avp([] = No) -> - No; -failed_avp(Avps) -> - [{'Failed-AVP', [[{'AVP', Avps}]]}]. - -set(Ans, []) -> - Ans; -set(['answer-message' | _] = Ans, FailedAvp) -> - Ans ++ [{'AVP', [FailedAvp]}]; -set([_|_] = Ans, FailedAvp) -> - Ans ++ FailedAvp. - -answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) -> - ['answer-message', OH, OR, {'Result-Code', 3008}]; - -answer([_, OH, OR | _], _, _, [Bs|_]) - when is_bitstring(Bs) -> - ['answer-message', OH, OR, {'Result-Code', 3009}]; - -answer(Ans, ?DIAMETER_VERSION, _, Es) -> - Ans ++ [{'Result-Code', rc(Es)}]; - -answer(Ans, _, _, _) -> - Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION - -rc([]) -> - 2001; %% DIAMETER_SUCCESS -rc([{RC,_}|_]) -> - RC; -rc([RC|_]) -> - RC. - -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. - -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. - -%% ELECTION_LOST 4003 -%% The peer has determined that it has lost the election process and -%% has therefore disconnected the transport connection. - -%% DIAMETER_NO_COMMON_APPLICATION 5010 -%% This error is returned when a CER message is received, and there -%% are no common applications supported between the peers. - -%% DIAMETER_UNSUPPORTED_VERSION 5011 -%% This error is returned when a request was received, whose version -%% number is unsupported. - -%% answer/2 - -answer('DWR', _) -> - getr(dwa); - -answer(Name, #state{service = #diameter_service{capabilities = Caps}}) -> - a(Name, Caps). - -a('CER', #diameter_caps{vendor_id = Vid, - origin_host = Host, - origin_realm = Realm, - host_ip_address = Addrs, - product_name = Name}) -> - ['CEA', {'Origin-Host', Host}, - {'Origin-Realm', Realm}, - {'Host-IP-Address', Addrs}, - {'Vendor-Id', Vid}, - {'Product-Name', Name}]; - -a('DPR', #diameter_caps{origin_host = Host, - origin_realm = Realm}) -> - ['DPA', {'Origin-Host', Host}, - {'Origin-Realm', Realm}]. - -%% recv_CER/2 - -recv_CER(CER, #state{service = Svc}) -> - {ok, T} = diameter_capx:recv_CER(CER, Svc), - T. - -%% handle_CEA/1 - -handle_CEA(#diameter_packet{header = #diameter_header{version = V}, - bin = Bin} - = Pkt, - #state{service = #diameter_service{capabilities = LCaps}} - = S) - when is_binary(Bin) -> - ?LOG(recv, 'CEA'), - - ?DIAMETER_VERSION == V orelse close({version, V}, S), - - #diameter_packet{msg = CEA, errors = Errors} - = DPkt - = diameter_codec:decode(?BASE, Pkt), - - [] == Errors orelse close({errors, Errors}, S), - - {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps} - = recv_CEA(CEA, S), - - #diameter_caps{origin_host = OH} - = LCaps, - - %% Ensure that we don't already have a connection to the peer in - %% question. This isn't the peer election of 3588 except in the - %% sense that, since we don't know who we're talking to until we - %% receive a CER/CEA, the first that arrives wins the right to a - %% connection with the peer. - - register_everywhere({?MODULE, connection, OH, DH}) - orelse close({'CEA', DH}, S), - - open(DPkt, SApps, RCaps, {connect, IS}, S). - -%% recv_CEA/2 - -recv_CEA(CEA, #state{service = Svc} = S) -> - case diameter_capx:recv_CEA(CEA, Svc) of - {ok, {_,_}} -> %% return from old code - close({'CEA', update}, S); - {ok, {[], _, _}} -> - close({'CEA', no_common_application}, S); - {ok, {_, [], _}} -> - close({'CEA', no_common_security}, S); - {ok, {_,_,_} = T} -> - T; - {error, Reason} -> - close({'CEA', Reason}, S) - end. - -%% open/5 - -open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid, - service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH, - inband_security_id = LS} - = LCaps} - = Svc, - #diameter_caps{origin_host = DH} - = RCaps, - - tls_ack(lists:member(?TLS, LS), Type, IS, S), - Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, - - S#state{state = 'Open'}. - -%% We've advertised TLS support: tell the transport the result -%% and expect a reply when the handshake is complete. -tls_ack(true, Type, IS, #state{transport = TPid} = S) -> - Ref = make_ref(), - MRef = erlang:monitor(process, TPid), - TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, - receive - {diameter, {tls, Ref}} -> - erlang:demonitor(MRef, [flush]); - {'DOWN', MRef, process, _, _} = T -> - close({tls_ack, T}, S) - end; - -%% Or not. Don't send anything to the transport so that transports -%% not supporting TLS work as before without modification. -tls_ack(false, _, _, _) -> - ok. - -capz(#diameter_caps{} = L, #diameter_caps{} = R) -> - #diameter_caps{} - = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), - tl(tuple_to_list(R)))]). - -%% close/2 - -%% Tell the watchdog that our death isn't due to transport failure. -close(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid), - throw({?MODULE, close, Reason}). - -%% close_wd/2 - -%% Ensure the watchdog dies if DPR has been sent ... -close_wd(_, #state{dpr = false}) -> - ok; -close_wd(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid); - -%% ... or otherwise -close_wd(Reason, Pid) -> - Pid ! {close, self(), Reason}. - -%% dwa/1 - -dwa(#diameter_caps{origin_host = OH, - origin_realm = OR, - origin_state_id = OSI}) -> - ['DWA', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Origin-State-Id', OSI}]. - -%% dpr/2 - -dpr(Cause, #state{transport = TPid, - service = #diameter_service{capabilities = Caps}} - = S) -> - #diameter_caps{origin_host = OH, - origin_realm = OR} - = Caps, - - Bin = encode(['DPR', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Disconnect-Cause', Cause}]), - send(TPid, Bin), - dpa_timer(), - ?LOG(send, 'DPR'), - S#state{dpr = diameter_codec:sequence_numbers(Bin)}. - -dpa_timer() -> - erlang:send_after(?DPA_TIMEOUT, self(), dpa_timeout). - -%% register_everywhere/1 -%% -%% Register a term and ensure it's not registered elsewhere. Note that -%% two process that simultaneously register the same term may well -%% both fail to do so this isn't foolproof. - -register_everywhere(T) -> - diameter_reg:add_new(T) - andalso unregistered(T). - -unregistered(T) -> - {ResL, _} = rpc:multicall(?MODULE, match, [{node(), T}]), - lists:all(fun(L) -> [] == L end, ResL). - -match({Node, _}) - when Node == node() -> - []; -match({_, T}) -> - try - diameter_reg:match(T) - catch - _:_ -> [] - end. diff --git a/lib/diameter/src/app/diameter_peer_fsm_sup.erl b/lib/diameter/src/app/diameter_peer_fsm_sup.erl deleted file mode 100644 index 995eaf74d0..0000000000 --- a/lib/diameter/src/app/diameter_peer_fsm_sup.erl +++ /dev/null @@ -1,63 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The supervisor of peer_fsm processes. -%% - --module(diameter_peer_fsm_sup). - --behaviour(supervisor). - --define(NAME, ?MODULE). %% supervisor name - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- - --export([start_link/0, %% supervisor start - start_child/1]). %% peer fsm start - --export([init/1]). - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% Start a peer_fsm process. - -start_child(T) -> - supervisor:start_child(?NAME, [T]). - -%% init/1 - -init([]) -> - Mod = diameter_peer_fsm, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/diameter_reg.erl b/lib/diameter/src/app/diameter_reg.erl deleted file mode 100644 index 882b9da238..0000000000 --- a/lib/diameter/src/app/diameter_reg.erl +++ /dev/null @@ -1,327 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The module implements a simple term -> pid registry. -%% - --module(diameter_reg). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([add/1, - add_new/1, - del/1, - repl/2, - match/1]). - --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% test --export([pids/0, - terms/0]). - -%% debug --export([state/0, - uptime/0]). - --include("diameter_internal.hrl"). - --define(SERVER, ?MODULE). --define(TABLE, ?MODULE). - -%% Table entry used to keep from starting more than one monitor on the -%% same process. This isn't a problem but there's no point in starting -%% multiple monitors if we can avoid it. Note that we can't have a 2-tuple -%% keyed on Pid since a registered term can be anything. Want the entry -%% keyed on Pid so that lookup is fast. --define(MONITOR(Pid, MRef), {Pid, monitor, MRef}). - -%% Table entry containing the Term -> Pid mapping. --define(MAPPING(Term, Pid), {Term, Pid}). - --record(state, {id = now()}). - -%%% ---------------------------------------------------------- -%%% # add(T) -%%% -%%% Input: Term = term() -%%% -%%% Output: true -%%% -%%% Description: Associate the specified term with self(). The list of pids -%%% having this or other assocations can be retrieved using -%%% match/1. -%%% -%%% An association is removed when the calling process dies -%%% or as a result of calling del/1. Adding the same term -%%% more than once is equivalent to adding it exactly once. -%%% -%%% Note that since match/1 takes a pattern as argument, -%%% specifying a term that contains match variables is -%%% probably not a good idea -%%% ---------------------------------------------------------- - --spec add(any()) - -> true. - -add(T) -> - call({add, fun ets:insert/2, T, self()}). - -%%% ---------------------------------------------------------- -%%% # add_new(T) -%%% -%%% Input: T = term() -%%% -%%% Output: true | false -%%% -%%% Description: Like add/1 but only one process is allowed to have the -%%% the association, false being returned if an association -%%% already exists. -%%% ---------------------------------------------------------- - --spec add_new(any()) - -> boolean(). - -add_new(T) -> - call({add, fun insert_new/2, T, self()}). - -%%% ---------------------------------------------------------- -%%% # repl(T, NewT) -%%% -%%% Input: T, NewT = term() -%%% -%%% Output: true | false -%%% -%%% Description: Like add/1 but only replace an existing association on T, -%%% false being returned if it doesn't exist. -%%% ---------------------------------------------------------- - --spec repl(any(), any()) - -> boolean(). - -repl(T, U) -> - call({repl, T, U, self()}). - -%%% ---------------------------------------------------------- -%%% # del(Term) -%%% -%%% Input: Term = term() -%%% -%%% Output: true -%%% -%%% Description: Remove any existing association of Term with self(). -%%% ---------------------------------------------------------- - --spec del(any()) - -> true. - -del(T) -> - call({del, T, self()}). - -%%% ---------------------------------------------------------- -%%% # match(Pat) -%%% -%%% Input: Pat = pattern in the sense of ets:match_object/2. -%%% -%%% Output: list of {Term, Pid} -%%% -%%% Description: Return the list of associations whose Term, as specified -%%% to add/1 or add_new/1, matches the specified pattern. -%%% -%%% Note that there's no guarantee that the returned processes -%%% are still alive. (Although one that isn't will soon have -%%% its associations removed.) -%%% ---------------------------------------------------------- - --spec match(tuple()) - -> [{term(), pid()}]. - -match(Pat) -> - ets:match_object(?TABLE, ?MAPPING(Pat, '_')). - -%% --------------------------------------------------------- -%% EXPORTED INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, ?MODULE, [], Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%% pids/0 -%% -%% Output: list of {Pid, [Term, ...]} - -pids() -> - to_list(fun swap/1). - -to_list(Fun) -> - ets:foldl(fun(T,A) -> acc(Fun, T, A) end, orddict:new(), ?TABLE). - -acc(Fun, ?MAPPING(Term, Pid), Dict) -> - append(Fun({Term, Pid}), Dict); -acc(_, _, Dict) -> - Dict. - -append({K,V}, Dict) -> - orddict:append(K, V, Dict). - -id(T) -> T. - -%% terms/0 -%% -%% Output: list of {Term, [Pid, ...]} - -terms() -> - to_list(fun id/1). - -swap({X,Y}) -> {Y,X}. - -%%% ---------------------------------------------------------- -%%% # init(Role) -%%% -%%% Output: {ok, State} -%%% ---------------------------------------------------------- - -init(_) -> - ets:new(?TABLE, [bag, named_table]), - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -handle_call({add, Fun, Key, Pid}, _, State) -> - B = Fun(?TABLE, {Key, Pid}), - monitor(B andalso no_monitor(Pid), Pid), - {reply, B, State}; - -handle_call({del, Key, Pid}, _, State) -> - {reply, ets:delete_object(?TABLE, ?MAPPING(Key, Pid)), State}; - -handle_call({repl, T, U, Pid}, _, State) -> - MatchSpec = [{?MAPPING('$1', Pid), - [{'=:=', '$1', {const, T}}], - ['$_']}], - {reply, repl(ets:select(?TABLE, MatchSpec), U, Pid), State}; - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State)-> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info(Request, State) -%%% ---------------------------------------------------------- - -handle_info({'DOWN', MRef, process, Pid, _}, State) -> - ets:delete_object(?TABLE, ?MONITOR(Pid, MRef)), - ets:match_delete(?TABLE, ?MAPPING('_', Pid)), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # terminate(Reason, State) -%%% ---------------------------------------------------------- - -terminate(_Reason, _State)-> - ok. - -%%% ---------------------------------------------------------- -%%% # code_change(OldVsn, State, Extra) -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -monitor(true, Pid) -> - ets:insert(?TABLE, ?MONITOR(Pid, erlang:monitor(process, Pid))); -monitor(false, _) -> - ok. - -%% Do we need a monitor for the specified Pid? -no_monitor(Pid) -> - [] == ets:match_object(?TABLE, ?MONITOR(Pid, '_')). - -%% insert_new/2 - -insert_new(?TABLE, {Key, _} = T) -> - flush(ets:lookup(?TABLE, Key)), - ets:insert_new(?TABLE, T). - -%% Remove any processes that are dead but for which we may not have -%% received 'DOWN' yet. This is to ensure that add_new can be used -%% to register a unique name each time a process restarts. -flush(List) -> - lists:foreach(fun({_,P} = T) -> - del(erlang:is_process_alive(P), T) - end, - List). - -del(Alive, T) -> - Alive orelse ets:delete_object(?TABLE, T). - -%% repl/3 - -repl([?MAPPING(_, Pid) = M], Key, Pid) -> - ets:delete_object(?TABLE, M), - true = ets:insert(?TABLE, ?MAPPING(Key, Pid)); -repl([], _, _) -> - false. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_service.erl b/lib/diameter/src/app/diameter_service.erl deleted file mode 100644 index 421e36ccf5..0000000000 --- a/lib/diameter/src/app/diameter_service.erl +++ /dev/null @@ -1,2903 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Implements the process that represents a service. -%% - --module(diameter_service). --behaviour(gen_server). - --export([start/1, - stop/1, - start_transport/2, - stop_transport/2, - info/2, - call/4]). - -%% towards diameter_watchdog --export([receive_message/3]). - -%% service supervisor --export([start_link/1]). - --export([subscribe/1, - unsubscribe/1, - subscriptions/1, - subscriptions/0, - services/0, - services/1, - whois/1, - flush_stats/1]). - -%% test/debug --export([call_module/3, - state/1, - uptime/1]). - -%%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% Other callbacks. --export([send/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). - --define(STATE_UP, up). --define(STATE_DOWN, down). - --define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1 --define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests --define(RESTART_TC, 1000). %% if restart was this recent - -%% Used to be able to swap this with anything else dict-like but now -%% rely on the fact that a service's #state{} record does not change -%% in storing in it ?STATE table and not always going through the -%% service process. In particular, rely on the fact that operations on -%% a ?Dict don't change the handle to it. --define(Dict, diameter_dict). - -%% Table containing outgoing requests for which a reply has yet to be -%% received. --define(REQUEST_TABLE, diameter_request). - -%% Maintains state in a table. In contrast to previously, a service's -%% stat is not constant and is accessed outside of the service -%% process. --define(STATE_TABLE, ?MODULE). - -%% Workaround for dialyzer's lack of understanding of match specs. --type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - -%% State of service gen_server. --record(state, - {id = now(), - service_name, %% as passed to start_service/2, key in ?STATE_TABLE - service :: #diameter_service{}, - peerT = ets_new(peers) :: ets:tid(), %% #peer{} at start_fsm - connT = ets_new(conns) :: ets:tid(), %% #conn{} at connection_up - share_peers = false :: boolean(), %% broadcast peers to remote nodes? - use_shared_peers = false :: boolean(), %% use broadcasted peers? - shared_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] - local_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] - monitor = false :: false | pid()}). %% process to die with -%% shared_peers reflects the peers broadcast from remote nodes. Note -%% that the state term itself doesn't change, which is relevant for -%% the stateless application callbacks since the state is retrieved -%% from ?STATE_TABLE from outside the service process. The pid in the -%% service record is used to determine whether or not we need to call -%% the process for a pick_peer callback. - -%% Record representing a watchdog process. --record(peer, - {pid :: match(pid()), - type :: match(connect | accept), - ref :: match(reference()), %% key into diameter_config - options :: match([transport_opt()]), %% as passed to start_transport - op_state = ?STATE_DOWN :: match(?STATE_DOWN | ?STATE_UP), - started = now(), %% at process start - conn = false :: match(boolean() | pid())}). - %% true at accept, pid() at connection_up (connT key) - -%% Record representing a peer_fsm process. --record(conn, - {pid :: pid(), - apps :: [{0..16#FFFFFFFF, app_alias()}], %% {Id, Alias} - caps :: #diameter_caps{}, - started = now(), %% at process start - peer :: pid()}). %% key into peerT - -%% Record stored in diameter_request for each outgoing request. --record(request, - {from, %% arg 2 of handle_call/3 - handler :: match(pid()), %% request process - transport :: match(pid()), %% peer process - caps :: match(#diameter_caps{}), - app :: match(app_alias()), %% #diameter_app.alias - dictionary :: match(module()), %% #diameter_app.dictionary - module :: match(nonempty_improper_list(module(), list())), - %% #diameter_app.module - filter :: match(peer_filter()), - packet :: match(#diameter_packet{})}). - -%% Record call/4 options are parsed into. --record(options, - {filter = none :: peer_filter(), - extra = [] :: list(), - timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, - detach = false :: boolean()}). - -%% Since RFC 3588 requires that a Diameter agent not modify End-to-End -%% Identifiers, the possibility of explicitly setting an End-to-End -%% Identifier would be needed to be able to implement an agent in -%% which one side of the communication is not implemented on top of -%% diameter. For example, Diameter being sent or received encapsulated -%% in some other protocol, or even another Diameter stack in a -%% non-Erlang environment. (Not that this is likely to be a normal -%% case.) -%% -%% The implemented solution is not an option but to respect any header -%% values set in a diameter_header record returned from a -%% prepare_request callback. A call to diameter:call/4 can communicate -%% values to the callback using the 'extra' option if so desired. - -%%% --------------------------------------------------------------------------- -%%% # start(SvcName) -%%% --------------------------------------------------------------------------- - -start(SvcName) -> - diameter_service_sup:start_child(SvcName). - -start_link(SvcName) -> - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(?MODULE, [SvcName], Options). -%% Put the arbitrary term SvcName in a list in case we ever want to -%% send more than this and need to distinguish old from new. - -%%% --------------------------------------------------------------------------- -%%% # stop(SvcName) -%%% --------------------------------------------------------------------------- - -stop(SvcName) -> - case whois(SvcName) of - undefined -> - {error, not_started}; - Pid -> - stop(call_service(Pid, stop), Pid) - end. - -stop(ok, Pid) -> - MRef = erlang:monitor(process, Pid), - receive {'DOWN', MRef, process, _, _} -> ok end; -stop(No, _) -> - No. - -%%% --------------------------------------------------------------------------- -%%% # start_transport(SvcName, {Ref, Type, Opts}) -%%% --------------------------------------------------------------------------- - -start_transport(SvcName, {_,_,_} = T) -> - call_service_by_name(SvcName, {start, T}). - -%%% --------------------------------------------------------------------------- -%%% # stop_transport(SvcName, Refs) -%%% --------------------------------------------------------------------------- - -stop_transport(_, []) -> - ok; -stop_transport(SvcName, [_|_] = Refs) -> - call_service_by_name(SvcName, {stop, Refs}). - -%%% --------------------------------------------------------------------------- -%%% # info(SvcName, Item) -%%% --------------------------------------------------------------------------- - -info(SvcName, Item) -> - info_rc(call_service_by_name(SvcName, {info, Item})). - -info_rc({error, _}) -> - undefined; -info_rc(Info) -> - Info. - -%%% --------------------------------------------------------------------------- -%%% # receive_message(TPid, Pkt, MessageData) -%%% --------------------------------------------------------------------------- - -%% Handle an incoming message in the watchdog process. This used to -%% come through the service process but this avoids that becoming a -%% bottleneck. - -receive_message(TPid, Pkt, T) - when is_pid(TPid) -> - #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, - recv(R, (not R) andalso lookup_request(Pkt, TPid), TPid, Pkt, T). - -%% Incoming request ... -recv(true, false, TPid, Pkt, T) -> - try - spawn(fun() -> recv_request(TPid, Pkt, T) end) - catch - error: system_limit = E -> %% discard - ?LOG({error, E}, now()) - end; - -%% ... answer to known request ... -recv(false, #request{from = {_, Ref}, handler = Pid} = Req, _, Pkt, _) -> - Pid ! {answer, Ref, Req, Pkt}; -%% Note that failover could have happened prior to this message being -%% received and triggering failback. That is, both a failover message -%% and answer may be on their way to the handler process. In the worst -%% case the request process gets notification of the failover and -%% sends to the alternate peer before an answer arrives, so it's -%% always the case that we can receive more than one answer after -%% failover. The first answer received by the request process wins, -%% any others are discarded. - -%% ... or not. -recv(false, false, _, _, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # call(SvcName, App, Msg, Options) -%%% --------------------------------------------------------------------------- - -call(SvcName, App, Msg, Options) - when is_list(Options) -> - Rec = make_options(Options), - Ref = make_ref(), - Caller = {self(), Ref}, - Fun = fun() -> exit({Ref, call(SvcName, App, Msg, Rec, Caller)}) end, - try spawn_monitor(Fun) of - {_, MRef} -> - recv(MRef, Ref, Rec#options.detach, false) - catch - error: system_limit = E -> - {error, E} - end. - -%% Don't rely on gen_server:call/3 for the timeout handling since it -%% makes no guarantees about not leaving a reply message in the -%% mailbox if we catch its exit at timeout. It currently *can* do so, -%% which is also undocumented. - -recv(MRef, _, true, true) -> - erlang:demonitor(MRef, [flush]), - ok; - -recv(MRef, Ref, Detach, Sent) -> - receive - Ref -> %% send has been attempted - recv(MRef, Ref, Detach, true); - {'DOWN', MRef, process, _, Reason} -> - call_rc(Reason, Ref, Sent) - end. - -%% call/5 has returned ... -call_rc({Ref, Ans}, Ref, _) -> - Ans; - -%% ... or not. In this case failure/encode are documented. -call_rc(_, _, Sent) -> - {error, choose(Sent, failure, encode)}. - -%% call/5 -%% -%% In the process spawned for the outgoing request. - -call(SvcName, App, Msg, Opts, Caller) -> - c(ets:lookup(?STATE_TABLE, SvcName), App, Msg, Opts, Caller). - -c([#state{service_name = SvcName} = S], App, Msg, Opts, Caller) -> - case find_transport(App, Msg, Opts, S) of - {_,_,_} = T -> - send_request(T, Msg, Opts, Caller, SvcName); - false -> - {error, no_connection}; - {error, _} = No -> - No - end; - -c([], _, _, _, _) -> - {error, no_service}. - -%% make_options/1 - -make_options(Options) -> - lists:foldl(fun mo/2, #options{}, Options). - -mo({timeout, T}, Rec) - when is_integer(T), 0 =< T -> - Rec#options{timeout = T}; - -mo({filter, F}, #options{filter = none} = Rec) -> - Rec#options{filter = F}; -mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> - Rec#options{filter = {all, [F | Fs]}}; -mo({filter, F}, #options{filter = F0} = Rec) -> - Rec#options{filter = {all, [F0, F]}}; - -mo({extra, L}, #options{extra = X} = Rec) - when is_list(L) -> - Rec#options{extra = X ++ L}; - -mo(detach, Rec) -> - Rec#options{detach = true}; - -mo(T, _) -> - ?ERROR({invalid_option, T}). - -%%% --------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% # unsubscribe(SvcName) -%%% --------------------------------------------------------------------------- - -subscribe(SvcName) -> - diameter_reg:add({?MODULE, subscriber, SvcName}). - -unsubscribe(SvcName) -> - diameter_reg:del({?MODULE, subscriber, SvcName}). - -subscriptions(Pat) -> - pmap(diameter_reg:match({?MODULE, subscriber, Pat})). - -subscriptions() -> - subscriptions('_'). - -pmap(Props) -> - lists:map(fun({{?MODULE, _, Name}, Pid}) -> {Name, Pid} end, Props). - -%%% --------------------------------------------------------------------------- -%%% # services(Pattern) -%%% --------------------------------------------------------------------------- - -services(Pat) -> - pmap(diameter_reg:match({?MODULE, service, Pat})). - -services() -> - services('_'). - -whois(SvcName) -> - case diameter_reg:match({?MODULE, service, SvcName}) of - [{_, Pid}] -> - Pid; - [] -> - undefined - end. - -%%% --------------------------------------------------------------------------- -%%% # flush_stats/1 -%%% -%%% Output: list of {{SvcName, Alias, Counter}, Value} -%%% --------------------------------------------------------------------------- - -flush_stats(TPid) -> - diameter_stats:flush(TPid). - -%% =========================================================================== -%% =========================================================================== - -state(Svc) -> - call_service(Svc, state). - -uptime(Svc) -> - call_service(Svc, uptime). - -%% call_module/3 - -call_module(Service, AppMod, Request) -> - call_service(Service, {call_module, AppMod, Request}). - -%%% --------------------------------------------------------------------------- -%%% # init([SvcName]) -%%% --------------------------------------------------------------------------- - -init([SvcName]) -> - process_flag(trap_exit, true), %% ensure terminate(shutdown, _) - i(SvcName, diameter_reg:add_new({?MODULE, service, SvcName})). - -i(SvcName, true) -> - {ok, i(SvcName)}; -i(_, false) -> - {stop, {shutdown, already_started}}. - -%%% --------------------------------------------------------------------------- -%%% # handle_call(Req, From, State) -%%% --------------------------------------------------------------------------- - -handle_call(state, _, S) -> - {reply, S, S}; - -handle_call(uptime, _, #state{id = T} = S) -> - {reply, diameter_lib:now_diff(T), S}; - -%% Start a transport. -handle_call({start, {Ref, Type, Opts}}, _From, S) -> - {reply, start(Ref, {Type, Opts}, S), S}; - -%% Stop transports. -handle_call({stop, Refs}, _From, S) -> - shutdown(Refs, S), - {reply, ok, S}; - -%% pick_peer with mutable state -handle_call({pick_peer, Local, Remote, App}, _From, S) -> - #diameter_app{mutable = true} = App, %% assert - {reply, pick_peer(Local, Remote, self(), S#state.service_name, App), S}; - -handle_call({call_module, AppMod, Req}, From, S) -> - call_module(AppMod, Req, From, S); - -handle_call({info, Item}, _From, S) -> - {reply, service_info(Item, S), S}; - -handle_call(stop, _From, S) -> - shutdown(S), - {stop, normal, ok, S}; -%% The server currently isn't guaranteed to be dead when the caller -%% gets the reply. We deal with this in the call to the server, -%% stating a monitor that waits for DOWN before returning. - -handle_call(Req, From, S) -> - unexpected(handle_call, [Req, From], S), - {reply, nok, S}. - -%%% --------------------------------------------------------------------------- -%%% # handle_cast(Req, State) -%%% --------------------------------------------------------------------------- - -handle_cast(Req, S) -> - unexpected(handle_cast, [Req], S), - {noreply, S}. - -%%% --------------------------------------------------------------------------- -%%% # handle_info(Req, State) -%%% --------------------------------------------------------------------------- - -handle_info(T,S) -> - case transition(T,S) of - ok -> - {noreply, S}; - #state{} = NS -> - {noreply, NS}; - {stop, Reason} -> - {stop, {shutdown, Reason}, S} - end. - -%% transition/2 - -%% Peer process is telling us to start a new accept process. -transition({accepted, Pid, TPid}, S) -> - accepted(Pid, TPid, S), - ok; - -%% Peer process has a new open connection. -transition({connection_up, Pid, T}, S) -> - connection_up(Pid, T, S); - -%% Peer process has left state open. -transition({connection_down, Pid}, S) -> - connection_down(Pid, S); - -%% Peer process has returned to state open. -transition({connection_up, Pid}, S) -> - connection_up(Pid, S); - -%% Accepting transport has lost connectivity. -transition({close, Pid}, S) -> - close(Pid, S), - ok; - -%% Connecting transport is being restarted by watchdog. -transition({reconnect, Pid}, S) -> - reconnect(Pid, S), - ok; - -%% Monitor process has died. Just die with a reason that tells -%% diameter_config about the happening. If a cleaner shutdown is -%% required then someone should stop us. -transition({'DOWN', MRef, process, _, Reason}, #state{monitor = MRef}) -> - {stop, {monitor, Reason}}; - -%% Local peer process has died. -transition({'DOWN', _, process, Pid, Reason}, S) - when node(Pid) == node() -> - peer_down(Pid, Reason, S); - -%% Remote service wants to know about shared transports. -transition({service, Pid}, S) -> - share_peers(Pid, S), - ok; - -%% Remote service is communicating a shared peer. -transition({peer, TPid, Aliases, Caps}, S) -> - remote_peer_up(TPid, Aliases, Caps, S); - -%% Remote peer process has died. -transition({'DOWN', _, process, TPid, _}, S) -> - remote_peer_down(TPid, S); - -%% Restart after tc expiry. -transition({tc_timeout, T}, S) -> - tc_timeout(T, S), - ok; - -%% Request process is telling us it may have missed a failover message -%% after a transport went down and the service process looked up -%% outstanding requests. -transition({failover, TRef, Seqs}, S) -> - failover(TRef, Seqs, S), - ok; - -transition(Req, S) -> - unexpected(handle_info, [Req], S), - ok. - -%%% --------------------------------------------------------------------------- -%%% # terminate(Reason, State) -%%% --------------------------------------------------------------------------- - -terminate(Reason, #state{service_name = Name} = S) -> - ets:delete(?STATE_TABLE, Name), - shutdown == Reason %% application shutdown - andalso shutdown(S). - -%%% --------------------------------------------------------------------------- -%%% # code_change(FromVsn, State, Extra) -%%% --------------------------------------------------------------------------- - -code_change(FromVsn, - #state{service_name = SvcName, - service = #diameter_service{applications = Apps}} - = S, - Extra) -> - lists:foreach(fun(A) -> - code_change(FromVsn, SvcName, Extra, A) - end, - Apps), - {ok, S}. - -code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> - {ok, S} = cb(A, code_change, [FromVsn, - mod_state(Alias), - Extra, - SvcName]), - mod_state(Alias, S). - -%% =========================================================================== -%% =========================================================================== - -unexpected(F, A, #state{service_name = Name}) -> - ?UNEXPECTED(F, A ++ [Name]). - -cb([_|_] = M, F, A) -> - eval(M, F, A); -cb(Rec, F, A) -> - {_, M} = app(Rec), - eval(M, F, A). - -app(#request{app = A, module = M}) -> - {A,M}; -app(#diameter_app{alias = A, module = M}) -> - {A,M}. - -eval([M|X], F, A) -> - apply(M, F, A ++ X). - -%% Callback with state. - -state_cb(#diameter_app{mutable = false, init_state = S}, {ModX, F, A}) -> - eval(ModX, F, A ++ [S]); - -state_cb(#diameter_app{mutable = true, alias = Alias}, {_,_,_} = MFA) -> - state_cb(MFA, Alias); - -state_cb({ModX,F,A}, Alias) - when is_list(ModX) -> - eval(ModX, F, A ++ [mod_state(Alias)]). - -choose(true, X, _) -> X; -choose(false, _, X) -> X. - -ets_new(Tbl) -> - ets:new(Tbl, [{keypos, 2}]). - -insert(Tbl, Rec) -> - ets:insert(Tbl, Rec), - Rec. - -monitor(Pid) -> - erlang:monitor(process, Pid), - Pid. - -%% Using the process dictionary for the callback state was initially -%% just a way to make what was horrendous trace (big state record and -%% much else everywhere) somewhat more readable. There's not as much -%% need for it now but it's no worse (except possibly that we don't -%% see the table identifier being passed around) than an ets table so -%% keep it. - -mod_state(Alias) -> - get({?MODULE, mod_state, Alias}). - -mod_state(Alias, ModS) -> - put({?MODULE, mod_state, Alias}, ModS). - -%% have_transport/2 - -have_transport(SvcName, Ref) -> - [] /= diameter_config:have_transport(SvcName, Ref). - -%%% --------------------------------------------------------------------------- -%%% # shutdown/2 -%%% --------------------------------------------------------------------------- - -shutdown(Refs, #state{peerT = PeerT}) -> - ets:foldl(fun(P,ok) -> s(P, Refs), ok end, ok, PeerT). - -s(#peer{ref = Ref, pid = Pid}, Refs) -> - s(lists:member(Ref, Refs), Pid); - -s(true, Pid) -> - Pid ! {shutdown, self()}; %% 'DOWN' will cleanup as usual -s(false, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # shutdown/1 -%%% --------------------------------------------------------------------------- - -shutdown(#state{peerT = PeerT}) -> - %% A transport might not be alive to receive the shutdown request - %% but give those that are a chance to shutdown gracefully. - wait(fun st/2, PeerT), - %% Kill the watchdogs explicitly in case there was no transport. - wait(fun sw/2, PeerT). - -wait(Fun, T) -> - diameter_lib:wait(ets:foldl(Fun, [], T)). - -st(#peer{conn = B}, Acc) - when is_boolean(B) -> - Acc; -st(#peer{conn = Pid}, Acc) -> - Pid ! shutdown, - [Pid | Acc]. - -sw(#peer{pid = Pid}, Acc) -> - exit(Pid, shutdown), - [Pid | Acc]. - -%%% --------------------------------------------------------------------------- -%%% # call_service/2 -%%% --------------------------------------------------------------------------- - -call_service(Pid, Req) - when is_pid(Pid) -> - cs(Pid, Req); -call_service(SvcName, Req) -> - call_service_by_name(SvcName, Req). - -call_service_by_name(SvcName, Req) -> - cs(whois(SvcName), Req). - -cs(Pid, Req) - when is_pid(Pid) -> - try - gen_server:call(Pid, Req, infinity) - catch - E: Reason when E == exit -> - {error, {E, Reason}} - end; - -cs(undefined, _) -> - {error, no_service}. - -%%% --------------------------------------------------------------------------- -%%% # i/1 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Intialize the state of a service gen_server. - -i(SvcName) -> - %% Split the config into a server state and a list of transports. - {#state{} = S, CL} = lists:foldl(fun cfg_acc/2, - {false, []}, - diameter_config:lookup(SvcName)), - - %% Publish the state in order to be able to access it outside of - %% the service process. Originally table identifiers were only - %% known to the service process but we now want to provide the - %% option of application callbacks being 'stateless' in order to - %% avoid having to go through a common process. (Eg. An agent that - %% sends a request for every incoming request.) - true = ets:insert_new(?STATE_TABLE, S), - - %% Start fsms for each transport. - lists:foreach(fun(T) -> start_fsm(T,S) end, CL), - - init_shared(S), - S. - -cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts}, - {false, Acc}) -> - lists:foreach(fun init_mod/1, Apps), - S = #state{service_name = SvcName, - service = Rec#diameter_service{pid = self()}, - share_peers = get_value(share_peers, Opts), - use_shared_peers = get_value(use_shared_peers, Opts), - monitor = mref(get_value(monitor, Opts))}, - {S, Acc}; - -cfg_acc({_Ref, Type, _Opts} = T, {S, Acc}) - when Type == connect; - Type == listen -> - {S, [T | Acc]}. - -mref(false = No) -> - No; -mref(P) -> - erlang:monitor(process, P). - -init_shared(#state{use_shared_peers = true, - service_name = Svc}) -> - diameter_peer:notify(Svc, {service, self()}); -init_shared(#state{use_shared_peers = false}) -> - ok. - -init_mod(#diameter_app{alias = Alias, - init_state = S}) -> - mod_state(Alias, S). - -start_fsm({Ref, Type, Opts}, S) -> - start(Ref, {Type, Opts}, S). - -get_value(Key, Vs) -> - {_, V} = lists:keyfind(Key, 1, Vs), - V. - -%%% --------------------------------------------------------------------------- -%%% # start/3 -%%% --------------------------------------------------------------------------- - -%% If the initial start/3 at service/transport start succeeds then -%% subsequent calls to start/4 on the same service will also succeed -%% since they involve the same call to merge_service/2. We merge here -%% rather than earlier since the service may not yet be configured -%% when the transport is configured. - -start(Ref, {T, Opts}, S) - when T == connect; - T == listen -> - try - {ok, start(Ref, type(T), Opts, S)} - catch - ?FAILURE(Reason) -> - {error, Reason} - end. -%% TODO: don't actually raise any errors yet - -%% There used to be a difference here between the handling of -%% configured listening and connecting transports but now we simply -%% tell the transport_module to start an accepting or connecting -%% process respectively, the transport implementation initiating -%% listening on a port as required. -type(listen) -> accept; -type(accept) -> listen; -type(connect = T) -> T. - -%% start/4 - -start(Ref, Type, Opts, #state{peerT = PeerT, - connT = ConnT, - service_name = SvcName, - service = Svc}) - when Type == connect; - Type == accept -> - Pid = monitor(s(Type, Ref, {ConnT, - Opts, - SvcName, - merge_service(Opts, Svc)})), - insert(PeerT, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts}), - Pid. - -%% Note that the service record passed into the watchdog is the merged -%% record so that each watchdog (and peer_fsm) may get a different -%% record. This record is what is passed back into application -%% callbacks. - -s(Type, Ref, T) -> - diameter_watchdog:start({Type, Ref}, T). - -%% merge_service/2 - -merge_service(Opts, Svc) -> - lists:foldl(fun ms/2, Svc, Opts). - -%% Limit the applications known to the fsm to those in the 'apps' -%% option. That this might be empty is checked by the fsm. It's not -%% checked at config-time since there's no requirement that the -%% service be configured first. (Which could be considered a bit odd.) -ms({applications, As}, #diameter_service{applications = Apps} = S) - when is_list(As) -> - S#diameter_service{applications - = [A || A <- Apps, - lists:member(A#diameter_app.alias, As)]}; - -%% The fact that all capabilities can be configured on the transports -%% means that the service doesn't necessarily represent a single -%% locally implemented Diameter peer as identified by Origin-Host: a -%% transport can configure its own Origin-Host. This means that the -%% service little more than a placeholder for default capabilities -%% plus a list of applications that individual transports can choose -%% to support (or not). -ms({capabilities, Opts}, #diameter_service{capabilities = Caps0} = Svc) - when is_list(Opts) -> - %% make_caps has already succeeded in diameter_config so it will succeed - %% again here. - {ok, Caps} = diameter_capx:make_caps(Caps0, Opts), - Svc#diameter_service{capabilities = Caps}; - -ms(_, Svc) -> - Svc. - -%%% --------------------------------------------------------------------------- -%%% # accepted/3 -%%% --------------------------------------------------------------------------- - -accepted(Pid, _TPid, #state{peerT = PeerT} = S) -> - #peer{ref = Ref, type = accept = T, conn = false, options = Opts} - = P - = fetch(PeerT, Pid), - insert(PeerT, P#peer{conn = true}), %% mark replacement transport started - start(Ref, T, Opts, S). %% start new peer - -fetch(Tid, Key) -> - [T] = ets:lookup(Tid, Key), - T. - -%%% --------------------------------------------------------------------------- -%%% # connection_up/3 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has reached the open state. - -connection_up(Pid, {TPid, {Caps, SApps, Pkt}}, #state{peerT = PeerT, - connT = ConnT} - = S) -> - P = fetch(PeerT, Pid), - C = #conn{pid = TPid, - apps = SApps, - caps = Caps, - peer = Pid}, - - insert(ConnT, C), - connection_up([Pkt], P#peer{conn = TPid}, C, S). - -%%% --------------------------------------------------------------------------- -%%% # connection_up/2 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has transitioned back into the open state. Note that there -%% has been no new capabilties exchange in this case. - -connection_up(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{conn = TPid} = P = fetch(PeerT, Pid), - C = fetch(ConnT, TPid), - connection_up([], P, C, S). - -%% connection_up/4 - -connection_up(T, P, C, #state{peerT = PeerT, - local_peers = LDict, - service_name = SvcName, - service - = #diameter_service{applications = Apps}} - = S) -> - #peer{conn = TPid, op_state = ?STATE_DOWN} - = P, - #conn{apps = SApps, caps = Caps} - = C, - - insert(PeerT, P#peer{op_state = ?STATE_UP}), - - request_peer_up(TPid), - report_status(up, P, C, S, T), - S#state{local_peers = insert_local_peer(SApps, - {{TPid, Caps}, {SvcName, Apps}}, - LDict)}. - -insert_local_peer(SApps, T, LDict) -> - lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). - -ilp({Id, Alias}, {TC, SA}, LDict) -> - init_conn(Id, Alias, TC, SA), - ?Dict:append(Alias, TC, LDict). - -init_conn(Id, Alias, TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert - = find_app(Alias, Apps), - - peer_cb({ModX, peer_up, [SvcName, TC]}, Alias). - -find_app(Alias, Apps) -> - lists:keyfind(Alias, #diameter_app.alias, Apps). - -%% A failing peer callback brings down the service. In the case of -%% peer_up we could just kill the transport and emit an error but for -%% peer_down we have no way to cleanup any state change that peer_up -%% may have introduced. -peer_cb(MFA, Alias) -> - try state_cb(MFA, Alias) of - ModS -> - mod_state(Alias, ModS) - catch - E: Reason -> - ?ERROR({E, Reason, MFA, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # connection_down/2 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has transitioned out of the open state. - -connection_down(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{conn = TPid} - = P - = fetch(PeerT, Pid), - - C = fetch(ConnT, TPid), - insert(PeerT, P#peer{op_state = ?STATE_DOWN}), - connection_down(P,C,S). - -%% connection_down/3 - -connection_down(#peer{conn = TPid, - op_state = ?STATE_UP} - = P, - #conn{caps = Caps, - apps = SApps} - = C, - #state{service_name = SvcName, - service = #diameter_service{applications = Apps}, - local_peers = LDict} - = S) -> - report_status(down, P, C, S, []), - NewS = S#state{local_peers - = remove_local_peer(SApps, - {{TPid, Caps}, {SvcName, Apps}}, - LDict)}, - request_peer_down(TPid, NewS), - NewS. - -remove_local_peer(SApps, T, LDict) -> - lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). - -rlp({Id, Alias}, {TC, SA}, LDict) -> - L = ?Dict:fetch(Alias, LDict), - down_conn(Id, Alias, TC, SA), - ?Dict:store(Alias, lists:delete(TC, L), LDict). - -down_conn(Id, Alias, TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert - = find_app(Alias, Apps), - - peer_cb({ModX, peer_down, [SvcName, TC]}, Alias). - -%%% --------------------------------------------------------------------------- -%%% # peer_down/3 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has died. - -peer_down(Pid, _Reason, #state{peerT = PeerT} = S) -> - P = fetch(PeerT, Pid), - ets:delete_object(PeerT, P), - restart(P,S), - peer_down(P,S). - -%% peer_down/2 - -%% The peer has never come up ... -peer_down(#peer{conn = B}, S) - when is_boolean(B) -> - S; - -%% ... or it has. -peer_down(#peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts} - = P, - #state{service_name = SvcName, - connT = ConnT} - = S) -> - #conn{caps = Caps} - = C - = fetch(ConnT, TPid), - ets:delete_object(ConnT, C), - try - pd(P,C,S) - after - send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}}) - end. - -pd(#peer{op_state = ?STATE_DOWN}, _, S) -> - S; -pd(#peer{op_state = ?STATE_UP} = P, C, S) -> - connection_down(P,C,S). - -%% restart/2 - -restart(P,S) -> - q_restart(restart(P), S). - -%% restart/1 - -%% Always try to reconnect. -restart(#peer{ref = Ref, - type = connect = T, - options = Opts, - started = Time}) -> - {Time, {Ref, T, Opts}}; - -%% Transport connection hasn't yet been accepted ... -restart(#peer{ref = Ref, - type = accept = T, - options = Opts, - conn = false, - started = Time}) -> - {Time, {Ref, T, Opts}}; - -%% ... or it has: a replacement transport has already been spawned. -restart(#peer{type = accept}) -> - false. - -%% q_restart/2 - -%% Start the reconnect timer. -q_restart({Time, {_Ref, Type, Opts} = T}, S) -> - start_tc(tc(Time, default_tc(Type, Opts)), T, S); -q_restart(false, _) -> - ok. - -%% RFC 3588, 2.1: -%% -%% When no transport connection exists with a peer, an attempt to -%% connect SHOULD be periodically made. This behavior is handled via -%% the Tc timer, whose recommended value is 30 seconds. There are -%% certain exceptions to this rule, such as when a peer has terminated -%% the transport connection stating that it does not wish to -%% communicate. - -default_tc(connect, Opts) -> - proplists:get_value(reconnect_timer, Opts, ?DEFAULT_TC); -default_tc(accept, _) -> - 0. - -%% Bound tc below if the peer was restarted recently to avoid -%% continuous in case of faulty config or other problems. -tc(Time, Tc) -> - choose(Tc > ?RESTART_TC - orelse timer:now_diff(now(), Time) > 1000*?RESTART_TC, - Tc, - ?RESTART_TC). - -start_tc(0, T, S) -> - tc_timeout(T, S); -start_tc(Tc, T, _) -> - erlang:send_after(Tc, self(), {tc_timeout, T}). - -%% tc_timeout/2 - -tc_timeout({Ref, _Type, _Opts} = T, #state{service_name = SvcName} = S) -> - tc(have_transport(SvcName, Ref), T, S). - -tc(true, {Ref, Type, Opts}, #state{service_name = SvcName} - = S) -> - send_event(SvcName, {reconnect, Ref, Opts}), - start(Ref, Type, Opts, S); -tc(false = No, _, _) -> %% removed - No. - -%%% --------------------------------------------------------------------------- -%%% # close/2 -%%% --------------------------------------------------------------------------- - -%% The watchdog doesn't start a new fsm in the accept case, it -%% simply stays alive until someone tells it to die in order for -%% another watchdog to be able to detect that it should transition -%% from initial into reopen rather than okay. That someone is either -%% the accepting watchdog upon reception of a CER from the previously -%% connected peer, or us after reconnect_timer timeout. - -close(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{pid = Pid, - type = accept, - ref = Ref, - options = Opts} - = fetch(PeerT, Pid), - - c(Pid, have_transport(SvcName, Ref), Opts). - -%% Tell watchdog to (maybe) die later ... -c(Pid, true, Opts) -> - Tc = proplists:get_value(reconnect_timer, Opts, 2*?DEFAULT_TC), - erlang:send_after(Tc, Pid, close); - -%% ... or now. -c(Pid, false, _Opts) -> - Pid ! close. - -%% The RFC's only document the behaviour of Tc, our reconnect_timer, -%% for the establishment of connections but we also give -%% reconnect_timer semantics for a listener, being the time within -%% which a new connection attempt is expected of a connecting peer. -%% The value should be greater than the peer's Tc + jitter. - -%%% --------------------------------------------------------------------------- -%%% # reconnect/2 -%%% --------------------------------------------------------------------------- - -reconnect(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{ref = Ref, - type = connect, - options = Opts} - = fetch(PeerT, Pid), - send_event(SvcName, {reconnect, Ref, Opts}). - -%%% --------------------------------------------------------------------------- -%%% # call_module/4 -%%% --------------------------------------------------------------------------- - -%% Backwards compatibility and never documented/advertised. May be -%% removed. - -call_module(Mod, Req, From, #state{service - = #diameter_service{applications = Apps}, - service_name = Svc} - = S) -> - case cm([A || A <- Apps, Mod == hd(A#diameter_app.module)], - Req, - From, - Svc) - of - {reply = T, RC} -> - {T, RC, S}; - noreply = T -> - {T, S}; - Reason -> - {reply, {error, Reason}, S} - end. - -cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> - MFA = {ModX, handle_call, [Req, From, Svc]}, - - try state_cb(MFA, Alias) of - {noreply = T, ModS} -> - mod_state(Alias, ModS), - T; - {reply = T, RC, ModS} -> - mod_state(Alias, ModS), - {T, RC}; - T -> - diameter_lib:error_report({invalid, T}, MFA), - invalid - catch - E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA), - failure - end; - -cm([], _, _, _) -> - unknown; - -cm([_,_|_], _, _, _) -> - multiple. - -%%% --------------------------------------------------------------------------- -%%% # send_request/5 -%%% --------------------------------------------------------------------------- - -%% Send an outgoing request in its dedicated process. -%% -%% Note that both encode of the outgoing request and of the received -%% answer happens in this process. It's also this process that replies -%% to the caller. The service process only handles the state-retaining -%% callbacks. -%% -%% The mod field of the #diameter_app{} here includes any extra -%% arguments passed to diameter:call/2. - -send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> - #diameter_app{module = ModX} - = App, - - Pkt = make_packet(Msg), - - case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of - {send, P} -> - send_request(make_packet(P, Pkt), - TPid, - Caps, - App, - Opts, - Caller, - SvcName); - {discard, Reason} -> - {error, Reason}; - discard -> - {error, discarded}; - T -> - ?ERROR({invalid_return, prepare_request, App, T}) - end. - -%% make_packet/1 -%% -%% Turn an outgoing request as passed to call/4 into a diameter_packet -%% record in preparation for a prepare_request callback. - -make_packet(Bin) - when is_binary(Bin) -> - #diameter_packet{header = diameter_codec:decode_header(Bin), - bin = Bin}; - -make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) -> - Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]}; - -make_packet(#diameter_packet{header = Hdr} = Pkt) -> - Pkt#diameter_packet{header = make_header(Hdr)}; - -make_packet(Msg) -> - make_packet(#diameter_packet{msg = Msg}). - -%% make_header/1 - -make_header(undefined) -> - Seq = diameter_session:sequence(), - make_header(#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); - -make_header(#diameter_header{version = undefined} = Hdr) -> - make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); - -make_header(#diameter_header{end_to_end_id = undefined} = H) -> - Seq = diameter_session:sequence(), - make_header(H#diameter_header{end_to_end_id = Seq}); - -make_header(#diameter_header{hop_by_hop_id = undefined} = H) -> - Seq = diameter_session:sequence(), - make_header(H#diameter_header{hop_by_hop_id = Seq}); - -make_header(#diameter_header{} = Hdr) -> - Hdr; - -make_header(T) -> - ?ERROR({invalid_header, T}). - -%% make_packet/2 -%% -%% Reconstruct a diameter_packet from the return value of -%% prepare_request or prepare_retransmit callback. - -make_packet(Bin, _) - when is_binary(Bin) -> - make_packet(Bin); - -make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> - Pkt; - -%% Returning a diameter_packet with no header from a prepare_request -%% or prepare_retransmit callback retains the header passed into it. -%% This is primarily so that the end to end and hop by hop identifiers -%% are retained. -make_packet(#diameter_packet{header = Hdr} = Pkt, - #diameter_packet{header = Hdr0}) -> - Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; - -make_packet(Msg, Pkt) -> - Pkt#diameter_packet{msg = Msg}. - -%% fold_record/2 - -fold_record(undefined, R) -> - R; -fold_record(Rec, R) -> - diameter_lib:fold_tuple(2, Rec, R). - -%% send_request/7 - -send_request(Pkt, TPid, Caps, App, Opts, Caller, SvcName) -> - #diameter_app{alias = Alias, - dictionary = Dict, - module = ModX, - answer_errors = AE} - = App, - - EPkt = encode(Dict, Pkt), - - #options{filter = Filter, - timeout = Timeout} - = Opts, - - Req = #request{packet = Pkt, - from = Caller, - handler = self(), - transport = TPid, - caps = Caps, - app = Alias, - filter = Filter, - dictionary = Dict, - module = ModX}, - - try - TRef = send_request(TPid, EPkt, Req, Timeout), - ack(Caller), - handle_answer(SvcName, AE, recv_answer(Timeout, SvcName, {TRef, Req})) - after - erase_request(EPkt) - end. - -%% Tell caller a send has been attempted. -ack({Pid, Ref}) -> - Pid ! Ref. - -%% recv_answer/3 - -recv_answer(Timeout, - SvcName, - {TRef, #request{from = {_, Ref}, packet = RPkt} = Req} - = T) -> - - %% Matching on TRef below ensures we ignore messages that pertain - %% to a previous transport prior to failover. The answer message - %% includes the #request{} since it's not necessarily Req; that - %% is, from the last peer to which we've transmitted. - - receive - {answer = A, Ref, Rq, Pkt} -> %% Answer from peer - {A, Rq, Pkt}; - {timeout = Reason, TRef, _} -> %% No timely reply - {error, Req, Reason}; - {failover = Reason, TRef, false} -> %% No alternate peer - {error, Req, Reason}; - {failover, TRef, Transport} -> %% Resend to alternate peer - try_retransmit(Timeout, SvcName, Req, Transport); - {failover, TRef} -> %% May have missed failover notification - Seqs = diameter_codec:sequence_numbers(RPkt), - Pid = whois(SvcName), - is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}), - recv_answer(Timeout, SvcName, T) - end. -%% Note that failover starts a new timer and that expiry of an old -%% timer value is ignored. This means that an answer could be accepted -%% from a peer after timeout in the case of failover. - -try_retransmit(Timeout, SvcName, Req, Transport) -> - try retransmit(Transport, Req, SvcName, Timeout) of - T -> recv_answer(Timeout, SvcName, T) - catch - ?FAILURE(Reason) -> {error, Req, Reason} - end. - -%% handle_error/3 - -handle_error(Req, Reason, SvcName) -> - #request{module = ModX, - packet = Pkt, - transport = TPid, - caps = Caps} - = Req, - cb(ModX, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). - -msg(#diameter_packet{msg = undefined, bin = Bin}) -> - Bin; -msg(#diameter_packet{msg = Msg}) -> - Msg. - -%% encode/2 - -%% Note that prepare_request can return a diameter_packet containing -%% header or transport_data. Even allow the returned record to contain -%% an encoded binary. This isn't the usual case but could some in -%% handy, for test at least. (For example, to send garbage.) - -%% The normal case: encode the returned message. -encode(Dict, #diameter_packet{msg = Msg, bin = undefined} = Pkt) -> - D = pick_dictionary([Dict, ?BASE], Msg), - diameter_codec:encode(D, Pkt); - -%% Callback has returned an encoded binary: just send. -encode(_, #diameter_packet{} = Pkt) -> - Pkt. - -%% pick_dictionary/2 - -%% Pick the first dictionary that declares the application id in the -%% specified header. -pick_dictionary(Ds, [#diameter_header{application_id = Id} | _]) -> - pd(Ds, fun(D) -> Id = D:id() end); - -%% Pick the first dictionary that knows the specified message name. -pick_dictionary(Ds, [MsgName|_]) -> - pd(Ds, fun(D) -> D:msg2rec(MsgName) end); - -%% Pick the first dictionary that knows the name of the specified -%% message record. -pick_dictionary(Ds, Rec) -> - Name = element(1, Rec), - pd(Ds, fun(D) -> D:rec2msg(Name) end). - -pd([D|Ds], F) -> - try - F(D), - D - catch - error:_ -> - pd(Ds, F) - end; - -pd([], _) -> - ?ERROR(no_dictionary). - -%% send_request/4 - -send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout) - when node() == node(TPid) -> - %% Store the outgoing request before sending to avoid a race with - %% reply reception. - TRef = store_request(TPid, Bin, Req, Timeout), - send(TPid, Pkt), - TRef; - -%% Send using a remote transport: spawn a process on the remote node -%% to relay the answer. -send_request(TPid, #diameter_packet{} = Pkt, Req, Timeout) -> - TRef = erlang:start_timer(Timeout, self(), timeout), - T = {TPid, Pkt, Req, Timeout, TRef}, - spawn(node(TPid), ?MODULE, send, [T]), - TRef. - -%% send/1 - -send({TPid, Pkt, #request{handler = Pid} = Req, Timeout, TRef}) -> - Ref = send_request(TPid, Pkt, Req#request{handler = self()}, Timeout), - Pid ! reref(receive T -> T end, Ref, TRef). - -reref({T, Ref, R}, Ref, TRef) -> - {T, TRef, R}; -reref(T, _, _) -> - T. - -%% send/2 - -send(Pid, Pkt) -> - Pid ! {send, Pkt}. - -%% retransmit/4 - -retransmit({TPid, Caps, #diameter_app{alias = Alias} = App}, - #request{app = Alias, - packet = Pkt} - = Req, - SvcName, - Timeout) -> - have_request(Pkt, TPid) %% Don't failover to a peer we've - andalso ?THROW(timeout), %% already sent to. - - case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of - {send, P} -> - retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout); - {discard, Reason} -> - ?THROW(Reason); - discard -> - ?THROW(discarded); - T -> - ?ERROR({invalid_return, prepare_retransmit, App, T}) - end. - -%% retransmit/5 - -retransmit(Pkt, TPid, Caps, #request{dictionary = Dict} = Req, Timeout) -> - EPkt = encode(Dict, Pkt), - - NewReq = Req#request{transport = TPid, - packet = Pkt, - caps = Caps}, - - ?LOG(retransmission, NewReq), - TRef = send_request(TPid, EPkt, NewReq, Timeout), - {TRef, NewReq}. - -%% store_request/4 - -store_request(TPid, Bin, Req, Timeout) -> - Seqs = diameter_codec:sequence_numbers(Bin), - TRef = erlang:start_timer(Timeout, self(), timeout), - ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), - ets:member(?REQUEST_TABLE, TPid) - orelse (self() ! {failover, TRef}), %% possibly missed failover - TRef. - -%% lookup_request/2 - -lookup_request(Msg, TPid) - when is_pid(TPid) -> - lookup(Msg, TPid, '_'); - -lookup_request(Msg, TRef) - when is_reference(TRef) -> - lookup(Msg, '_', TRef). - -lookup(Msg, TPid, TRef) -> - Seqs = diameter_codec:sequence_numbers(Msg), - Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, TRef}, - [], - ['$_']}], - case ets:select(?REQUEST_TABLE, Spec) of - [{_, Req, _}] -> - Req; - [] -> - false - end. - -%% erase_request/1 - -erase_request(Pkt) -> - ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). - -%% match_requests/1 - -match_requests(TPid) -> - Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, - ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). - -%% have_request/2 - -have_request(Pkt, TPid) -> - Seqs = diameter_codec:sequence_numbers(Pkt), - Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, - '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). - -%% request_peer_up/1 - -request_peer_up(TPid) -> - ets:insert(?REQUEST_TABLE, {TPid}). - -%% request_peer_down/2 - -request_peer_down(TPid, S) -> - ets:delete(?REQUEST_TABLE, TPid), - lists:foreach(fun(T) -> failover(T,S) end, match_requests(TPid)). -%% Note that a request process can store its request after failover -%% notifications are sent here: store_request/4 sends the notification -%% in that case. Note also that we'll send as many notifications to a -%% given handler as there are peers its sent to. All but one of these -%% will be ignored. - -%%% --------------------------------------------------------------------------- -%%% recv_request/3 -%%% --------------------------------------------------------------------------- - -recv_request(TPid, Pkt, {ConnT, SvcName, Apps}) -> - try ets:lookup(ConnT, TPid) of - [C] -> - recv_request(C, TPid, Pkt, SvcName, Apps); - [] -> %% transport has gone down - ok - catch - error: badarg -> %% service has gone down (and taken table with it) - ok - end. - -%% recv_request/5 - -recv_request(#conn{apps = SApps, caps = Caps}, TPid, Pkt, SvcName, Apps) -> - #diameter_caps{origin_host = {OH,_}, - origin_realm = {OR,_}} - = Caps, - - #diameter_packet{header = #diameter_header{application_id = Id}} - = Pkt, - - recv_request(find_recv_app(Id, SApps), - {SvcName, OH, OR}, - TPid, - Apps, - Caps, - Pkt). - -%% find_recv_app/2 - -%% No one should be sending the relay identifier. -find_recv_app(?APP_ID_RELAY, _) -> - false; - -%% With any other id we either support it locally or as a relay. -find_recv_app(Id, SApps) -> - keyfind([Id, ?APP_ID_RELAY], 1, SApps). - -%% keyfind/3 - -keyfind([], _, _) -> - false; -keyfind([Key | Rest], Pos, L) -> - case lists:keyfind(Key, Pos, L) of - false -> - keyfind(Rest, Pos, L); - T -> - T - end. - -%% recv_request/6 - -recv_request({Id, Alias}, T, TPid, Apps, Caps, Pkt) -> - #diameter_app{dictionary = Dict} - = A - = find_app(Alias, Apps), - recv_request(T, {TPid, Caps}, A, diameter_codec:decode(Id, Dict, Pkt)); -%% Note that the decode is different depending on whether or not Id is -%% ?APP_ID_RELAY. - -%% DIAMETER_APPLICATION_UNSUPPORTED 3007 -%% A request was sent for an application that is not supported. - -recv_request(false, T, TPid, _, _, Pkt) -> - As = collect_avps(Pkt), - protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}). - -collect_avps(Pkt) -> - case diameter_codec:collect_avps(Pkt) of - {_Bs, As} -> - As; - As -> - As - end. - -%% recv_request/4 - -%% Wrong number of bits somewhere in the message: reply. -%% -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. -%% -recv_request(T, {TPid, _}, _, #diameter_packet{errors = [Bs | _]} = Pkt) - when is_bitstring(Bs) -> - protocol_error(3009, T, TPid, Pkt); - -%% Either we support this application but don't recognize the command -%% or we're a relay and the command isn't proxiable. -%% -%% DIAMETER_COMMAND_UNSUPPORTED 3001 -%% The Request contained a Command-Code that the receiver did not -%% recognize or support. This MUST be used when a Diameter node -%% receives an experimental command that it does not understand. -%% -recv_request(T, - {TPid, _}, - #diameter_app{id = Id}, - #diameter_packet{header = #diameter_header{is_proxiable = P}, - msg = M} - = Pkt) - when ?APP_ID_RELAY /= Id, undefined == M; - ?APP_ID_RELAY == Id, not P -> - protocol_error(3001, T, TPid, Pkt); - -%% Error bit was set on a request. -%% -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. -%% -recv_request(T, - {TPid, _}, - _, - #diameter_packet{header = #diameter_header{is_error = true}} - = Pkt) -> - protocol_error(3008, T, TPid, Pkt); - -%% A message in a locally supported application or a proxiable message -%% in the relay application. Don't distinguish between the two since -%% each application has its own callback config. That is, the user can -%% easily distinguish between the two cases. -recv_request(T, TC, App, Pkt) -> - request_cb(T, TC, App, examine(Pkt)). - -%% Note that there may still be errors but these aren't protocol -%% (3xxx) errors that lead to an answer-message. - -request_cb({SvcName, _OH, _OR} = T, TC, App, Pkt) -> - request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), App, T, TC, Pkt). - -%% examine/1 -%% -%% Look for errors in a decoded message. Length errors result in -%% decode failure in diameter_codec. - -examine(#diameter_packet{header = #diameter_header{version - = ?DIAMETER_VERSION}} - = Pkt) -> - Pkt; - -%% DIAMETER_UNSUPPORTED_VERSION 5011 -%% This error is returned when a request was received, whose version -%% number is unsupported. - -examine(#diameter_packet{errors = Es} = Pkt) -> - Pkt#diameter_packet{errors = [5011 | Es]}. -%% It's odd/unfortunate that this isn't a protocol error. - -%% request_cb/5 - -%% A reply may be an answer-message, constructed either here or by -%% the handle_request callback. The header from the incoming request -%% is passed into the encode so that it can retrieve the relevant -%% command code in this case. It will also then ignore Dict and use -%% the base encoder. -request_cb({reply, Ans}, - #diameter_app{dictionary = Dict}, - _, - {TPid, _}, - Pkt) -> - reply(Ans, Dict, TPid, Pkt); - -%% An 3xxx result code, for which the E-bit is set in the header. -request_cb({protocol_error, RC}, _, T, {TPid, _}, Pkt) - when 3000 =< RC, RC < 4000 -> - protocol_error(RC, T, TPid, Pkt); - -%% RFC 3588 says we must reply 3001 to anything unrecognized or -%% unsupported. 'noreply' is undocumented (and inappropriately named) -%% backwards compatibility for this, protocol_error the documented -%% alternative. -request_cb(noreply, _, T, {TPid, _}, Pkt) -> - protocol_error(3001, T, TPid, Pkt); - -%% Relay a request to another peer. This is equivalent to doing an -%% explicit call/4 with the message in question except that (1) a loop -%% will be detected by examining Route-Record AVP's, (3) a -%% Route-Record AVP will be added to the outgoing request and (3) the -%% End-to-End Identifier will default to that in the -%% #diameter_header{} without the need for an end_to_end_identifier -%% option. -%% -%% relay and proxy are similar in that they require the same handling -%% with respect to Route-Record and End-to-End identifier. The -%% difference is that a proxy advertises specific applications, while -%% a relay advertises the relay application. If a callback doesn't -%% want to distinguish between the cases in the callback return value -%% then 'resend' is a neutral alternative. -%% -request_cb({A, Opts}, - #diameter_app{id = Id} - = App, - T, - TC, - Pkt) - when A == relay, Id == ?APP_ID_RELAY; - A == proxy, Id /= ?APP_ID_RELAY; - A == resend -> - resend(Opts, App, T, TC, Pkt); - -request_cb(discard, _, _, _, _) -> - ok; - -request_cb({eval, RC, F}, App, T, TC, Pkt) -> - request_cb(RC, App, T, TC, Pkt), - diameter_lib:eval(F). - -%% protocol_error/4 - -protocol_error(RC, {_, OH, OR}, TPid, #diameter_packet{avps = Avps} = Pkt) -> - ?LOG({error, RC}, Pkt), - reply(answer_message({OH, OR, RC}, Avps), ?BASE, TPid, Pkt). - -%% resend/5 -%% -%% Resend a message as a relay or proxy agent. - -resend(Opts, - #diameter_app{} = App, - {_SvcName, OH, _OR} = T, - {_TPid, _Caps} = TC, - #diameter_packet{avps = Avps} = Pkt) -> - {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'), - resend(is_loop(Code, Vid, OH, Avps), Opts, App, T, TC, Pkt). - -%% DIAMETER_LOOP_DETECTED 3005 -%% An agent detected a loop while trying to get the message to the -%% intended recipient. The message MAY be sent to an alternate peer, -%% if one is available, but the peer reporting the error has -%% identified a configuration problem. - -resend(true, _, _, T, {TPid, _}, Pkt) -> %% Route-Record loop - protocol_error(3005, T, TPid, Pkt); - -%% 6.1.8. Relaying and Proxying Requests -%% -%% A relay or proxy agent MUST append a Route-Record AVP to all requests -%% forwarded. The AVP contains the identity of the peer the request was -%% received from. - -resend(false, - Opts, - App, - {SvcName, _, _} = T, - {TPid, #diameter_caps{origin_host = {_, OH}}}, - #diameter_packet{header = Hdr0, - avps = Avps} - = Pkt) -> - Route = #diameter_avp{data = {?BASE, 'Route-Record', OH}}, - Seq = diameter_session:sequence(), - Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, - Msg = [Hdr, Route | Avps], - resend(call(SvcName, App, Msg, Opts), T, TPid, Pkt). -%% The incoming request is relayed with the addition of a -%% Route-Record. Note the requirement on the return from call/4 below, -%% which places a requirement on the value returned by the -%% handle_answer callback of the application module in question. -%% -%% Note that there's nothing stopping the request from being relayed -%% back to the sender. A pick_peer callback may want to avoid this but -%% a smart peer might recognize the potential loop and choose another -%% route. A less smart one will probably just relay the request back -%% again and force us to detect the loop. A pick_peer that wants to -%% avoid this can specify filter to avoid the possibility. -%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. -%% -%% RFC 6.3 says that a relay agent does not modify Origin-Host but -%% says nothing about a proxy. Assume it should behave the same way. - -%% resend/4 -%% -%% Relay a reply to a relayed request. - -%% Answer from the peer: reset the hop by hop identifier and send. -resend(#diameter_packet{bin = B} - = Pkt, - _, - TPid, - #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, - transport_data = TD}) -> - send(TPid, Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), - transport_data = TD}); -%% TODO: counters - -%% Or not: DIAMETER_UNABLE_TO_DELIVER. -resend(_, T, TPid, Pkt) -> - protocol_error(3002, T, TPid, Pkt). - -%% is_loop/4 -%% -%% Is there a Route-Record AVP with our Origin-Host? - -is_loop(Code, - Vid, - Bin, - [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> - true; - -is_loop(_, _, _, []) -> - false; - -is_loop(Code, Vid, OH, [_ | Avps]) - when is_binary(OH) -> - is_loop(Code, Vid, OH, Avps); - -is_loop(Code, Vid, OH, Avps) -> - is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps). - -%% reply/4 -%% -%% Send a locally originating reply. - -%% No errors or a diameter_header/avp list. -reply(Msg, Dict, TPid, #diameter_packet{errors = Es, - transport_data = TD} - = ReqPkt) - when [] == Es; - is_record(hd(Msg), diameter_header) -> - Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)), - incr(send, Pkt, Dict, TPid), %% count result codes in sent answers - send(TPid, Pkt#diameter_packet{transport_data = TD}); - -%% Or not: set Result-Code and Failed-AVP AVP's. -reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) -> - reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), - Dict, - TPid, - Pkt#diameter_packet{errors = []}). - -%% make_reply_packet/2 - -%% Binaries and header/avp lists are sent as-is. -make_reply_packet(Bin, _) - when is_binary(Bin) -> - #diameter_packet{bin = Bin}; -make_reply_packet([#diameter_header{} | _] = Msg, _) -> - #diameter_packet{msg = Msg}; - -%% Otherwise a reply message clears the R and T flags and retains the -%% P flag. The E flag will be set at encode. -make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) -> - Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, - is_request = false, - is_error = undefined, - is_retransmitted = false}, - #diameter_packet{header = Hdr, - msg = Msg}. - -%% rc/1 - -rc({RC, _}) -> - RC; -rc(RC) -> - RC. - -%% rc/4 - -rc(Rec, RC, Failed, Dict) - when is_integer(RC) -> - set(Rec, [{'Result-Code', RC} | failed_avp(Rec, Failed, Dict)], Dict). - -%% Reply as name and tuple list ... -set([_|_] = Ans, Avps, _) -> - Ans ++ Avps; %% Values nearer tail take precedence. - -%% ... or record. -set(Rec, Avps, Dict) -> - Dict:'#set-'(Avps, Rec). - -%% failed_avp/3 - -failed_avp(_, [] = No, _) -> - No; - -failed_avp(Rec, Failed, Dict) -> - [fa(Rec, [{'AVP', Failed}], Dict)]. - -%% Reply as name and tuple list ... -fa([MsgName | Values], FailedAvp, Dict) -> - R = Dict:msg2rec(MsgName), - try - Dict:'#info-'(R, {index, 'Failed-AVP'}), - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = proplists:get_value('AVP', Values, []), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end; - -%% ... or record. -fa(Rec, FailedAvp, Dict) -> - try - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = Dict:'get-'('AVP', Rec), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end. - -%% 3. Diameter Header -%% -%% E(rror) - If set, the message contains a protocol error, -%% and the message will not conform to the ABNF -%% described for this command. Messages with the 'E' -%% bit set are commonly referred to as error -%% messages. This bit MUST NOT be set in request -%% messages. See Section 7.2. - -%% 3.2. Command Code ABNF specification -%% -%% e-bit = ", ERR" -%% ; If present, the 'E' bit in the Command -%% ; Flags is set, indicating that the answer -%% ; message contains a Result-Code AVP in -%% ; the "protocol error" class. - -%% 7.1.3. Protocol Errors -%% -%% Errors that fall within the Protocol Error category SHOULD be treated -%% on a per-hop basis, and Diameter proxies MAY attempt to correct the -%% error, if it is possible. Note that these and only these errors MUST -%% only be used in answer messages whose 'E' bit is set. - -%% Thus, only construct answers to protocol errors. Other errors -%% require an message-specific answer and must be handled by the -%% application. - -%% 6.2. Diameter Answer Processing -%% -%% When a request is locally processed, the following procedures MUST be -%% applied to create the associated answer, in addition to any -%% additional procedures that MAY be discussed in the Diameter -%% application defining the command: -%% -%% - The same Hop-by-Hop identifier in the request is used in the -%% answer. -%% -%% - The local host's identity is encoded in the Origin-Host AVP. -%% -%% - The Destination-Host and Destination-Realm AVPs MUST NOT be -%% present in the answer message. -%% -%% - The Result-Code AVP is added with its value indicating success or -%% failure. -%% -%% - If the Session-Id is present in the request, it MUST be included -%% in the answer. -%% -%% - Any Proxy-Info AVPs in the request MUST be added to the answer -%% message, in the same order they were present in the request. -%% -%% - The 'P' bit is set to the same value as the one in the request. -%% -%% - The same End-to-End identifier in the request is used in the -%% answer. -%% -%% Note that the error messages (see Section 7.3) are also subjected to -%% the above processing rules. - -%% 7.3. Error-Message AVP -%% -%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY -%% accompany a Result-Code AVP as a human readable error message. The -%% Error-Message AVP is not intended to be useful in real-time, and -%% SHOULD NOT be expected to be parsed by network entities. - -%% answer_message/2 - -answer_message({OH, OR, RC}, Avps) -> - {Code, _, Vid} = ?BASE:avp_header('Session-Id'), - ['answer-message', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Result-Code', RC} - | session_id(Code, Vid, Avps)]. - -session_id(Code, Vid, Avps) - when is_list(Avps) -> - try - {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), - [{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}] - catch - error: _ -> - [] - end. - -%% find_avp/3 - -find_avp(Code, Vid, Avps) - when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> - find(fun(A) -> is_avp(Code, Vid, A) end, Avps). - -%% The final argument here could be a list of AVP's, depending on the case, -%% but we're only searching at the top level. -is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> - true; -is_avp(_, _, _) -> - false. - -find(_, []) -> - false; -find(Pred, [H|T]) -> - case Pred(H) of - true -> - {value, H}; - false -> - find(Pred, T) - end. - -%% 7. Error Handling -%% -%% There are certain Result-Code AVP application errors that require -%% additional AVPs to be present in the answer. In these cases, the -%% Diameter node that sets the Result-Code AVP to indicate the error -%% MUST add the AVPs. Examples are: -%% -%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) -%% set, causes an answer to be sent with the Result-Code AVP set to -%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the -%% offending AVP. -%% -%% - An AVP that is received with an unrecognized value causes an -%% answer to be returned with the Result-Code AVP set to -%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the -%% AVP causing the error. -%% -%% - A command is received with an AVP that is omitted, yet is -%% mandatory according to the command's ABNF. The receiver issues an -%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and -%% creates an AVP with the AVP Code and other fields set as expected -%% in the missing AVP. The created AVP is then added to the Failed- -%% AVP AVP. -%% -%% The Result-Code AVP describes the error that the Diameter node -%% encountered in its processing. In case there are multiple errors, -%% the Diameter node MUST report only the first error it encountered -%% (detected possibly in some implementation dependent order). The -%% specific errors that can be described by this AVP are described in -%% the following section. - -%% 7.5. Failed-AVP AVP -%% -%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides -%% debugging information in cases where a request is rejected or not -%% fully processed due to erroneous information in a specific AVP. The -%% value of the Result-Code AVP will provide information on the reason -%% for the Failed-AVP AVP. -%% -%% The possible reasons for this AVP are the presence of an improperly -%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP -%% value, the omission of a required AVP, the presence of an explicitly -%% excluded AVP (see tables in Section 10), or the presence of two or -%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 -%% occurrences. -%% -%% A Diameter message MAY contain one Failed-AVP AVP, containing the -%% entire AVP that could not be processed successfully. If the failure -%% reason is omission of a required AVP, an AVP with the missing AVP -%% code, the missing vendor id, and a zero filled payload of the minimum -%% required length for the omitted AVP will be added. - -%%% --------------------------------------------------------------------------- -%%% # handle_answer/3 -%%% --------------------------------------------------------------------------- - -%% Process an answer message in call-specific process. - -handle_answer(SvcName, _, {error, Req, Reason}) -> - handle_error(Req, Reason, SvcName); - -handle_answer(SvcName, - AnswerErrors, - {answer, #request{dictionary = Dict} = Req, Pkt}) -> - a(examine(diameter_codec:decode(Dict, Pkt)), - SvcName, - AnswerErrors, - Req). - -%% We don't really need to do a full decode if we're a relay and will -%% just resend with a new hop by hop identifier, but might a proxy -%% want to examine the answer? - -a(#diameter_packet{errors = []} - = Pkt, - SvcName, - AE, - #request{transport = TPid, - dictionary = Dict, - caps = Caps, - packet = P} - = Req) -> - try - incr(in, Pkt, Dict, TPid) - of - _ -> - cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]) - catch - exit: {invalid_error_bit, _} = E -> - e(Pkt#diameter_packet{errors = [E]}, SvcName, AE, Req) - end; - -a(#diameter_packet{} = Pkt, SvcName, AE, Req) -> - e(Pkt, SvcName, AE, Req). - -e(Pkt, SvcName, callback, #request{transport = TPid, - caps = Caps, - packet = Pkt} - = Req) -> - cb(Req, handle_answer, [Pkt, msg(Pkt), SvcName, {TPid, Caps}]); -e(Pkt, SvcName, report, Req) -> - x(errors, handle_answer, [SvcName, Req, Pkt]); -e(Pkt, SvcName, discard, Req) -> - x({errors, handle_answer, [SvcName, Req, Pkt]}). - -%% Note that we don't check that the application id in the answer's -%% header is what we expect. (TODO: Does the rfc says anything about -%% this?) - -%% incr/4 -%% -%% Increment a stats counter for an incoming or outgoing message. - -%% TODO: fix -incr(_, #diameter_packet{msg = undefined}, _, _) -> - ok; - -incr(Dir, Pkt, Dict, TPid) - when is_pid(TPid) -> - #diameter_packet{header = #diameter_header{is_error = E} - = Hdr, - msg = Rec} - = Pkt, - - D = choose(E, ?BASE, Dict), - RC = int(get_avp_value(D, 'Result-Code', Rec)), - PE = is_protocol_error(RC), - - %% Check that the E bit is set only for 3xxx result codes. - (not (E orelse PE)) - orelse (E andalso PE) - orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), - - Ctr = rc_counter(D, Rec, RC), - is_tuple(Ctr) - andalso incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). - -%% incr/2 - -incr(TPid, Counter) -> - diameter_stats:incr(Counter, TPid, 1). - -%% RFC 3588, 7.6: -%% -%% All Diameter answer messages defined in vendor-specific -%% applications MUST include either one Result-Code AVP or one -%% Experimental-Result AVP. -%% -%% Maintain statistics assuming one or the other, not both, which is -%% surely the intent of the RFC. - -rc_counter(_, _, RC) - when is_integer(RC) -> - {'Result-Code', RC}; -rc_counter(D, Rec, _) -> - rcc(get_avp_value(D, 'Experimental-Result', Rec)). - -%% Outgoing answers may be in any of the forms messages can be sent -%% in. Incoming messages will be records. We're assuming here that the -%% arity of the result code AVP's is 0 or 1. - -rcc([{_,_,RC} = T]) - when is_integer(RC) -> - T; -rcc({_,_,RC} = T) - when is_integer(RC) -> - T; -rcc(_) -> - undefined. - -int([N]) - when is_integer(N) -> - N; -int(N) - when is_integer(N) -> - N; -int(_) -> - undefined. - -is_protocol_error(RC) -> - 3000 =< RC andalso RC < 4000. - --spec x(any(), atom(), list()) -> no_return(). - -%% Warn and exit request process on errors in an incoming answer. -x(Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - x(Reason). - -x(T) -> - exit(T). - -%%% --------------------------------------------------------------------------- -%%% # failover/[23] -%%% --------------------------------------------------------------------------- - -%% Failover as a consequence of request_peer_down/2. -failover({_, #request{handler = Pid} = Req, TRef}, S) -> - Pid ! {failover, TRef, rt(Req, S)}. - -%% Failover as a consequence of store_request/4. -failover(TRef, Seqs, S) - when is_reference(TRef) -> - case lookup_request(Seqs, TRef) of - #request{} = Req -> - failover({Seqs, Req, TRef}, S); - false -> - ok - end. - -%% prepare_request returned a binary ... -rt(#request{packet = #diameter_packet{msg = undefined}}, _) -> - false; %% TODO: Not what we should do. - -%% ... or not. -rt(#request{packet = #diameter_packet{msg = Msg}, dictionary = D} = Req, S) -> - find_transport(get_destination(Msg, D), Req, S). - -%%% --------------------------------------------------------------------------- -%%% # report_status/5 -%%% --------------------------------------------------------------------------- - -report_status(Status, - #peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts}, - #conn{apps = [_|_] = As, - caps = Caps}, - #state{service_name = SvcName} - = S, - Extra) -> - share_peer(Status, Caps, As, TPid, S), - Info = [Status, Ref, {TPid, Caps}, {type(Type), Opts} | Extra], - send_event(SvcName, list_to_tuple(Info)). - -%% send_event/2 - -send_event(SvcName, Info) -> - send_event(#diameter_event{service = SvcName, - info = Info}). - -send_event(#diameter_event{service = SvcName} = E) -> - lists:foreach(fun({_, Pid}) -> Pid ! E end, subscriptions(SvcName)). - -%%% --------------------------------------------------------------------------- -%%% # share_peer/5 -%%% --------------------------------------------------------------------------- - -share_peer(up, Caps, Aliases, TPid, #state{share_peers = true, - service_name = Svc}) -> - diameter_peer:notify(Svc, {peer, TPid, Aliases, Caps}); - -share_peer(_, _, _, _, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # share_peers/2 -%%% --------------------------------------------------------------------------- - -share_peers(Pid, #state{share_peers = true, - local_peers = PDict}) -> - ?Dict:fold(fun(A,Ps,ok) -> sp(Pid, A, Ps), ok end, ok, PDict); - -share_peers(_, #state{share_peers = false}) -> - ok. - -sp(Pid, Alias, Peers) -> - lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers). - -%%% --------------------------------------------------------------------------- -%%% # remote_peer_up/4 -%%% --------------------------------------------------------------------------- - -remote_peer_up(Pid, Aliases, Caps, #state{use_shared_peers = true, - service = Svc, - shared_peers = PDict} - = S) -> - #diameter_service{applications = Apps} = Svc, - Update = lists:filter(fun(A) -> - lists:keymember(A, #diameter_app.alias, Apps) - end, - Aliases), - S#state{shared_peers = rpu(Pid, Caps, PDict, Update)}; - -remote_peer_up(_, _, _, #state{use_shared_peers = false} = S) -> - S. - -rpu(_, _, PDict, []) -> - PDict; -rpu(Pid, Caps, PDict, Aliases) -> - erlang:monitor(process, Pid), - T = {Pid, Caps}, - lists:foldl(fun(A,D) -> ?Dict:append(A, T, D) end, - PDict, - Aliases). - -%%% --------------------------------------------------------------------------- -%%% # remote_peer_down/2 -%%% --------------------------------------------------------------------------- - -remote_peer_down(Pid, #state{use_shared_peers = true, - shared_peers = PDict} - = S) -> - S#state{shared_peers = lists:foldl(fun(A,D) -> rpd(Pid, A, D) end, - PDict, - ?Dict:fetch_keys(PDict))}. - -rpd(Pid, Alias, PDict) -> - ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict). - -%%% --------------------------------------------------------------------------- -%%% find_transport/[34] -%%% -%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Initial call, from an arbitrary process. -find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) -> - #diameter_service{applications = Apps} = Svc, - ft(find_send_app(Alias, Apps), Msg, Opts, S); - -%% Relay or proxy send. -find_transport(#diameter_app{} = App, Msg, Opts, S) -> - ft(App, Msg, Opts, S). - -ft(#diameter_app{module = Mod, dictionary = D} = App, Msg, Opts, S) -> - #options{filter = Filter, - extra = Xtra} - = Opts, - pick_peer(App#diameter_app{module = Mod ++ Xtra}, - get_destination(Msg, D), - Filter, - S); -ft(false = No, _, _, _) -> - No. - -%% This can't be used if we're a relay and sending a message -%% in an application not known locally. (TODO) -find_send_app(Alias, Apps) -> - case lists:keyfind(Alias, #diameter_app.alias, Apps) of - #diameter_app{id = ?APP_ID_RELAY} -> - false; - T -> - T - end. - -%% Retransmission, in the service process. -find_transport([_,_] = RH, - Req, - #state{service = #diameter_service{pid = Pid, - applications = Apps}} - = S) - when self() == Pid -> - #request{app = Alias, - filter = Filter, - module = ModX} - = Req, - #diameter_app{} - = App - = lists:keyfind(Alias, #diameter_app.alias, Apps), - - pick_peer(App#diameter_app{module = ModX}, - RH, - Filter, - S). - -%% get_destination/2 - -get_destination(Msg, Dict) -> - [str(get_avp_value(Dict, 'Destination-Realm', Msg)), - str(get_avp_value(Dict, 'Destination-Host', Msg))]. - -%% This is not entirely correct. The avp could have an arity 1, in -%% which case an empty list is a DiameterIdentity of length 0 rather -%% than the list of no values we treat it as by mapping to undefined. -%% This behaviour is documented. -str([]) -> - undefined; -str(T) -> - T. - -%% get_avp_value/3 -%% -%% Find an AVP in a message of one of three forms: -%% -%% - a message record (as generated from a .dia spec) or -%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. -%% - a list of a #diameter_header{} followed by #diameter_avp{} records, -%% -%% In the first two forms a dictionary module is used at encode to -%% identify the type of the AVP and its arity in the message in -%% question. The third form allows messages to be sent as is, without -%% a dictionary, which is needed in the case of relay agents, for one. - -get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> - try - {Code, _, VId} = Dict:avp_header(Name), - [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> - C /= Code orelse V /= VId - end, - Avps), - avp_decode(Dict, Name, A) - catch - error: _ -> - undefined - end; - -get_avp_value(_, Name, [_MsgName | Avps]) -> - case lists:keyfind(Name, 1, Avps) of - {_, V} -> - V; - _ -> - undefined - end; - -%% Message is typically a record but not necessarily: diameter:call/4 -%% can be passed an arbitrary term. -get_avp_value(Dict, Name, Rec) -> - try - Dict:'#get-'(Name, Rec) - catch - error:_ -> - undefined - end. - -avp_decode(Dict, Name, #diameter_avp{value = undefined, - data = Bin}) -> - Dict:avp(decode, Bin, Name); -avp_decode(_, _, #diameter_avp{value = V}) -> - V. - -%%% --------------------------------------------------------------------------- -%%% # pick_peer(App, [DestRealm, DestHost], Filter, #state{}) -%%% -%%% Output: {TransportPid, #diameter_caps{}, App} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Find transports to a given realm/host. - -pick_peer(#diameter_app{alias = Alias} - = App, - [_,_] = RH, - Filter, - #state{local_peers = L, - shared_peers = S, - service_name = SvcName, - service = #diameter_service{pid = Pid}}) -> - pick_peer(peers(Alias, RH, Filter, L), - peers(Alias, RH, Filter, S), - Pid, - SvcName, - App). - -%% pick_peer/5 - -pick_peer([], [], _, _, _) -> - false; - -%% App state is mutable but we're not in the service process: go there. -pick_peer(Local, Remote, Pid, _SvcName, #diameter_app{mutable = true} = App) - when self() /= Pid -> - call_service(Pid, {pick_peer, Local, Remote, App}); - -%% App state isn't mutable or it is and we're in the service process: -%% do the deed. -pick_peer(Local, - Remote, - _Pid, - SvcName, - #diameter_app{module = ModX, - alias = Alias, - init_state = S, - mutable = M} - = App) -> - MFA = {ModX, pick_peer, [Local, Remote, SvcName]}, - - try state_cb(App, MFA) of - {ok, {TPid, #diameter_caps{} = Caps}} when is_pid(TPid) -> - {TPid, Caps, App}; - {{TPid, #diameter_caps{} = Caps}, ModS} when is_pid(TPid), M -> - mod_state(Alias, ModS), - {TPid, Caps, App}; - {false = No, ModS} when M -> - mod_state(Alias, ModS), - No; - {ok, false = No} -> - No; - false = No -> - No; - {{TPid, #diameter_caps{} = Caps}, S} when is_pid(TPid) -> - {TPid, Caps, App}; %% Accept returned state in the immutable - {false = No, S} -> %% case as long it isn't changed. - No; - T -> - diameter_lib:error_report({invalid, T, App}, MFA) - catch - E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA) - end. - -%% peers/4 - -peers(Alias, RH, Filter, Peers) -> - case ?Dict:find(Alias, Peers) of - {ok, L} -> - ps(L, RH, Filter, {[],[]}); - error -> - [] - end. - -%% Place a peer whose Destination-Host/Realm matches those of the -%% request at the front of the result list. Could add some sort of -%% 'sort' option to allow more control. - -ps([], _, _, {Ys, Ns}) -> - lists:reverse(Ys, Ns); -ps([{_TPid, #diameter_caps{} = Caps} = TC | Rest], RH, Filter, Acc) -> - ps(Rest, RH, Filter, pacc(caps_filter(Caps, RH, Filter), - caps_filter(Caps, RH, {all, [host, realm]}), - TC, - Acc)). - -pacc(true, true, Peer, {Ts, Fs}) -> - {[Peer|Ts], Fs}; -pacc(true, false, Peer, {Ts, Fs}) -> - {Ts, [Peer|Fs]}; -pacc(_, _, _, Acc) -> - Acc. - -%% caps_filter/3 - -caps_filter(C, RH, {neg, F}) -> - not caps_filter(C, RH, F); - -caps_filter(C, RH, {all, L}) - when is_list(L) -> - lists:all(fun(F) -> caps_filter(C, RH, F) end, L); - -caps_filter(C, RH, {any, L}) - when is_list(L) -> - lists:any(fun(F) -> caps_filter(C, RH, F) end, L); - -caps_filter(#diameter_caps{origin_host = {_,OH}}, [_,DH], host) -> - eq(undefined, DH, OH); - -caps_filter(#diameter_caps{origin_realm = {_,OR}}, [DR,_], realm) -> - eq(undefined, DR, OR); - -caps_filter(C, _, Filter) -> - caps_filter(C, Filter). - -%% caps_filter/2 - -caps_filter(_, none) -> - true; - -caps_filter(#diameter_caps{origin_host = {_,OH}}, {host, H}) -> - eq(any, H, OH); - -caps_filter(#diameter_caps{origin_realm = {_,OR}}, {realm, R}) -> - eq(any, R, OR); - -%% Anything else is expected to be an eval filter. Filter failure is -%% documented as being equivalent to a non-matching filter. - -caps_filter(C, T) -> - try - {eval, F} = T, - diameter_lib:eval([F,C]) - catch - _:_ -> false - end. - -eq(Any, Id, PeerId) -> - Any == Id orelse try - iolist_to_binary(Id) == iolist_to_binary(PeerId) - catch - _:_ -> false - end. -%% OctetString() can be specified as an iolist() so test for string -%% rather then term equality. - -%% transports/1 - -transports(#state{peerT = PeerT}) -> - ets:select(PeerT, [{#peer{conn = '$1', _ = '_'}, - [{'is_pid', '$1'}], - ['$1']}]). - -%%% --------------------------------------------------------------------------- -%%% # service_info/2 -%%% --------------------------------------------------------------------------- - -%% The config passed to diameter:start_service/2. --define(CAP_INFO, ['Origin-Host', - 'Origin-Realm', - 'Vendor-Id', - 'Product-Name', - 'Origin-State-Id', - 'Host-IP-Address', - 'Supported-Vendor-Id', - 'Auth-Application-Id', - 'Inband-Security-Id', - 'Acct-Application-Id', - 'Vendor-Specific-Application-Id', - 'Firmware-Revision']). - --define(ALL_INFO, [capabilities, - applications, - transport, - pending, - statistics]). - -service_info(Items, S) - when is_list(Items) -> - [{complete(I), service_info(I,S)} || I <- Items]; -service_info(Item, S) - when is_atom(Item) -> - service_info(Item, S, true). - -service_info(Item, #state{service = Svc} = S, Complete) -> - case Item of - name -> - S#state.service_name; - 'Origin-Host' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_host; - 'Origin-Realm' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_realm; - 'Vendor-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.vendor_id; - 'Product-Name' -> - (Svc#diameter_service.capabilities) - #diameter_caps.product_name; - 'Origin-State-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_state_id; - 'Host-IP-Address' -> - (Svc#diameter_service.capabilities) - #diameter_caps.host_ip_address; - 'Supported-Vendor-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.supported_vendor_id; - 'Auth-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.auth_application_id; - 'Inband-Security-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.inband_security_id; - 'Acct-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.acct_application_id; - 'Vendor-Specific-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.vendor_specific_application_id; - 'Firmware-Revision' -> - (Svc#diameter_service.capabilities) - #diameter_caps.firmware_revision; - capabilities -> service_info(?CAP_INFO, S); - applications -> info_apps(S); - transport -> info_transport(S); - pending -> info_pending(S); - statistics -> info_stats(S); - keys -> ?ALL_INFO ++ ?CAP_INFO; %% mostly for test - all -> service_info(?ALL_INFO, S); - _ when Complete -> service_info(complete(Item), S, false); - _ -> undefined - end. - -complete(Pre) -> - P = atom_to_list(Pre), - case [I || I <- [name | ?ALL_INFO] ++ ?CAP_INFO, - lists:prefix(P, atom_to_list(I))] - of - [I] -> I; - _ -> Pre - end. - -info_stats(#state{peerT = PeerT}) -> - Peers = ets:select(PeerT, [{#peer{ref = '$1', conn = '$2', _ = '_'}, - [{'is_pid', '$2'}], - [['$1', '$2']]}]), - diameter_stats:read(lists:append(Peers)). -%% TODO: include peer identities in return value - -info_transport(#state{peerT = PeerT, connT = ConnT}) -> - dict:fold(fun it/3, - [], - ets:foldl(fun(T,A) -> it_acc(ConnT, A, T) end, - dict:new(), - PeerT)). - -it(Ref, [[{type, connect} | _] = L], Acc) -> - [[{ref, Ref} | L] | Acc]; -it(Ref, [[{type, accept}, {options, Opts} | _] | _] = L, Acc) -> - [[{ref, Ref}, - {type, listen}, - {options, Opts}, - {accept, [lists:nthtail(2,A) || A <- L]}] - | Acc]. -%% Each entry has the same Opts. (TODO) - -it_acc(ConnT, Acc, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts, - op_state = OS, - started = T, - conn = TPid}) -> - dict:append(Ref, - [{type, Type}, - {options, Opts}, - {watchdog, {Pid, T, OS}} - | info_conn(ConnT, TPid)], - Acc). - -info_conn(ConnT, TPid) -> - info_conn(ets:lookup(ConnT, TPid)). - -info_conn([#conn{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> - [{peer, {Pid, T}}, - {apps, SApps}, - {caps, info_caps(Caps)}]; -info_conn([] = No) -> - No. - -info_caps(#diameter_caps{} = C) -> - lists:zip(record_info(fields, diameter_caps), tl(tuple_to_list(C))). - -info_apps(#state{service = #diameter_service{applications = Apps}}) -> - lists:map(fun mk_app/1, Apps). - -mk_app(#diameter_app{alias = Alias, - dictionary = Dict, - module = ModX, - id = Id}) -> - [{alias, Alias}, - {dictionary, Dict}, - {module, ModX}, - {id, Id}]. - -info_pending(#state{} = S) -> - MatchSpec = [{{'$1', - #request{transport = '$2', - from = '$3', - app = '$4', - _ = '_'}, - '_'}, - [?ORCOND([{'==', T, '$2'} || T <- transports(S)])], - [{{'$1', [{{app, '$4'}}, - {{transport, '$2'}}, - {{from, '$3'}}]}}]}], - - ets:select(?REQUEST_TABLE, MatchSpec). diff --git a/lib/diameter/src/app/diameter_service_sup.erl b/lib/diameter/src/app/diameter_service_sup.erl deleted file mode 100644 index 153fff902f..0000000000 --- a/lib/diameter/src/app/diameter_service_sup.erl +++ /dev/null @@ -1,64 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The supervisor of service processes. -%% - --module(diameter_service_sup). - --behaviour(supervisor). - --export([start_link/0, %% supervisor start - start_child/1]). %% service start - -%% supervisor callback --export([init/1]). - --define(NAME, ?MODULE). %% supervisor name - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% A service and its related processes (transport, peer_fwm and -%% watchdog) are all temporary since they're all restarted in -%% application code. A Transport and peer_fsm is restarted by a -%% watchdog as required by the RFC 3539 state machine, a watchdog is -%% restarted by service, and services are restarted by diameter_config. - -start_child(ServiceName) -> - supervisor:start_child(?NAME, [ServiceName]). - -%% init/1 - -init([]) -> - Mod = diameter_service, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/diameter_session.erl b/lib/diameter/src/app/diameter_session.erl deleted file mode 100644 index bb91e97f39..0000000000 --- a/lib/diameter/src/app/diameter_session.erl +++ /dev/null @@ -1,172 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_session). - --export([sequence/0, - session_id/1, - origin_state_id/0]). - -%% towards diameter_sup --export([init/0]). - --include("diameter_types.hrl"). - --define(INT64, 16#FFFFFFFFFFFFFFFF). --define(INT32, 16#FFFFFFFF). - -%% --------------------------------------------------------------------------- -%% # sequence/0 -%% -%% Output: 32-bit -%% --------------------------------------------------------------------------- - -%% 3588, 3: -%% -%% Hop-by-Hop Identifier -%% The Hop-by-Hop Identifier is an unsigned 32-bit integer field (in -%% network byte order) and aids in matching requests and replies. -%% The sender MUST ensure that the Hop-by-Hop identifier in a request -%% is unique on a given connection at any given time, and MAY attempt -%% to ensure that the number is unique across reboots. The sender of -%% an Answer message MUST ensure that the Hop-by-Hop Identifier field -%% contains the same value that was found in the corresponding -%% request. The Hop-by-Hop identifier is normally a monotonically -%% increasing number, whose start value was randomly generated. An -%% answer message that is received with an unknown Hop-by-Hop -%% Identifier MUST be discarded. -%% -%% End-to-End Identifier -%% The End-to-End Identifier is an unsigned 32-bit integer field (in -%% network byte order) and is used to detect duplicate messages. -%% Upon reboot implementations MAY set the high order 12 bits to -%% contain the low order 12 bits of current time, and the low order -%% 20 bits to a random value. Senders of request messages MUST -%% insert a unique identifier on each message. The identifier MUST -%% remain locally unique for a period of at least 4 minutes, even -%% across reboots. The originator of an Answer message MUST ensure -%% that the End-to-End Identifier field contains the same value that -%% was found in the corresponding request. The End-to-End Identifier -%% MUST NOT be modified by Diameter agents of any kind. The -%% combination of the Origin-Host (see Section 6.3) and this field is -%% used to detect duplicates. Duplicate requests SHOULD cause the -%% same answer to be transmitted (modulo the hop-by-hop Identifier -%% field and any routing AVPs that may be present), and MUST NOT -%% affect any state that was set when the original request was -%% processed. Duplicate answer messages that are to be locally -%% consumed (see Section 6.2) SHOULD be silently discarded. - --spec sequence() - -> 'Unsigned32'(). - -sequence() -> - Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT32, _SetVal = 0}, - ets:update_counter(diameter_sequence, sequence, Instr). - -%% --------------------------------------------------------------------------- -%% # origin_state_id/0 -%% --------------------------------------------------------------------------- - -%% 3588, 8.16: -%% -%% The Origin-State-Id AVP (AVP Code 278), of type Unsigned32, is a -%% monotonically increasing value that is advanced whenever a Diameter -%% entity restarts with loss of previous state, for example upon reboot. -%% Origin-State-Id MAY be included in any Diameter message, including -%% CER. -%% -%% A Diameter entity issuing this AVP MUST create a higher value for -%% this AVP each time its state is reset. A Diameter entity MAY set -%% Origin-State-Id to the time of startup, or it MAY use an incrementing -%% counter retained in non-volatile memory across restarts. - --spec origin_state_id() - -> 'Unsigned32'(). - -origin_state_id() -> - ets:lookup_element(diameter_sequence, origin_state_id, 2). - -%% --------------------------------------------------------------------------- -%% # session_id/1 -%% --------------------------------------------------------------------------- - -%% 3588, 8.8: -%% -%% The Session-Id MUST begin with the sender's identity encoded in the -%% DiameterIdentity type (see Section 4.4). The remainder of the -%% Session-Id is delimited by a ";" character, and MAY be any sequence -%% that the client can guarantee to be eternally unique; however, the -%% following format is recommended, (square brackets [] indicate an -%% optional element): -%% -%% <DiameterIdentity>;<high 32 bits>;<low 32 bits>[;<optional value>] -%% -%% <high 32 bits> and <low 32 bits> are decimal representations of the -%% high and low 32 bits of a monotonically increasing 64-bit value. The -%% 64-bit value is rendered in two part to simplify formatting by 32-bit -%% processors. At startup, the high 32 bits of the 64-bit value MAY be -%% initialized to the time, and the low 32 bits MAY be initialized to -%% zero. This will for practical purposes eliminate the possibility of -%% overlapping Session-Ids after a reboot, assuming the reboot process -%% takes longer than a second. Alternatively, an implementation MAY -%% keep track of the increasing value in non-volatile memory. -%% -%% <optional value> is implementation specific but may include a modem's -%% device Id, a layer 2 address, timestamp, etc. - --spec session_id('DiameterIdentity'()) - -> 'OctetString'(). -%% Note that Session-Id has type UTF8String and that any OctetString -%% is a UTF8String. - -session_id(Host) -> - Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT64, _Set = 0}, - N = ets:update_counter(diameter_sequence, session_base, Instr), - Hi = N bsr 32, - Lo = N band ?INT32, - [Host, ";", integer_to_list(Hi), - ";", integer_to_list(Lo), - ";", atom_to_list(node())]. - -%% --------------------------------------------------------------------------- -%% # init/0 -%% --------------------------------------------------------------------------- - -init() -> - Now = now(), - random:seed(Now), - Time = time32(Now), - Seq = (?INT32 band (Time bsl 20)) bor (random:uniform(1 bsl 20) - 1), - ets:insert(diameter_sequence, [{origin_state_id, Time}, - {session_base, Time bsl 32}, - {sequence, Seq}]), - Time. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -%% The minimum value represented by a Time value. (See diameter_types.) -%% 32 bits extends to 2104. --define(TIME0, 62105714048). %% {{1968,1,20},{3,14,8}} - -time32(Now) -> - Time = calendar:now_to_universal_time(Now), - Diff = calendar:datetime_to_gregorian_seconds(Time) - ?TIME0, - Diff band ?INT32. diff --git a/lib/diameter/src/app/diameter_stats.erl b/lib/diameter/src/app/diameter_stats.erl deleted file mode 100644 index 71479afa95..0000000000 --- a/lib/diameter/src/app/diameter_stats.erl +++ /dev/null @@ -1,342 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Statistics collector. -%% - --module(diameter_stats). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([reg/1, reg/2, - incr/1, incr/2, incr/3, - read/1, - flush/0, flush/1]). - -%% supervisor callback --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% debug --export([state/0, - uptime/0]). - --include("diameter_internal.hrl"). - -%% ets table containing stats. reg(Pid, Ref) inserts a {Pid, Ref}, -%% incr(Counter, X, N) updates the counter keyed at {Counter, X}, and -%% Pid death causes counters keyed on {Counter, Pid} to be deleted and -%% added to those keyed on {Counter, Ref}. --define(TABLE, ?MODULE). - -%% Name of registered server. --define(SERVER, ?MODULE). - -%% Entries in the table. --define(REC(Key, Value), {Key, Value}). - -%% Server state. --record(state, {id = now()}). - --type counter() :: any(). --type contrib() :: any(). - -%%% --------------------------------------------------------------------------- -%%% # reg(Pid, Contrib) -%%% -%%% Description: Register a process as a contributor of statistics -%%% associated with a specified term. Statistics can be -%%% contributed by specifying either Pid or Contrib as -%%% the second argument to incr/3. Statistics contributed -%%% by Pid are folded into the corresponding entry for -%%% Contrib when the process dies. -%%% -%%% Contrib can be any term but should not be a pid -%%% passed as the first argument to reg/2. Subsequent -%%% registrations for the same Pid overwrite the association -%%% --------------------------------------------------------------------------- - --spec reg(pid(), contrib()) - -> true. - -reg(Pid, Contrib) - when is_pid(Pid) -> - call({reg, Pid, Contrib}). - --spec reg(contrib()) - -> true. - -reg(Ref) -> - reg(self(), Ref). - -%%% --------------------------------------------------------------------------- -%%% # incr(Counter, Contrib, N) -%%% -%%% Description: Increment a counter for the specified contributor. -%%% -%%% Contrib will typically be an argument passed to reg/2 -%%% but there's nothing that requires this. In particular, -%%% if Contrib is a pid that hasn't been registered then -%%% counters are unaffected by the death of the process. -%%% --------------------------------------------------------------------------- - --spec incr(counter(), contrib(), integer()) - -> integer(). - -incr(Ctr, Contrib, N) -> - update_counter({Ctr, Contrib}, N). - -incr(Ctr, N) - when is_integer(N) -> - incr(Ctr, self(), N); - -incr(Ctr, Contrib) -> - incr(Ctr, Contrib, 1). - -incr(Ctr) -> - incr(Ctr, self(), 1). - -%%% --------------------------------------------------------------------------- -%%% # read(Contribs) -%%% -%%% Description: Retrieve counters for the specified contributors. -%%% --------------------------------------------------------------------------- - --spec read([contrib()]) - -> [{contrib(), [{counter(), integer()}]}]. - -read(Contribs) -> - lists:foldl(fun(?REC({T,C}, N), D) -> orddict:append(C, {T,N}, D) end, - orddict:new(), - ets:select(?TABLE, [{?REC({'_', '$1'}, '_'), - [?ORCOND([{'=:=', '$1', {const, C}} - || C <- Contribs])], - ['$_']}])). - -%%% --------------------------------------------------------------------------- -%%% # flush(Contrib) -%%% -%%% Description: Retrieve and delete statistics for the specified -%%% contributor. -%%% -%%% If Contrib is a pid registered with reg/2 then statistics -%%% for both and its associated contributor are retrieved. -%%% --------------------------------------------------------------------------- - --spec flush(contrib()) - -> [{counter(), integer()}]. - -flush(Contrib) -> - try - call({flush, Contrib}) - catch - exit: _ -> - [] - end. - -flush() -> - flush(self()). - -%%% --------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init(_) -%%% -%%% Output: {ok, State} -%%% ---------------------------------------------------------- - -init([]) -> - ets:new(?TABLE, [named_table, ordered_set, public]), - {ok, #state{}}. - -%% ---------------------------------------------------------- -%% handle_call(Request, From, State) -%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call({reg, Pid, Contrib}, _From, State) -> - monitor(not ets:member(?TABLE, Pid), Pid), - {reply, insert(?REC(Pid, Contrib)), State}; - -handle_call({flush, Contrib}, _From, State) -> - {reply, fetch(Contrib), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%% ---------------------------------------------------------- -%% handle_cast(Request, State) -%% ---------------------------------------------------------- - -handle_cast({incr, Rec}, State) -> - update_counter(Rec), - {noreply, State}; - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% handle_info(Request, State) -%% ---------------------------------------------------------- - -handle_info({'DOWN', _MRef, process, Pid, _}, State) -> - down(Pid), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% terminate(Reason, State) -%% ---------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%% ---------------------------------------------------------- -%% code_change(OldVsn, State, Extra) -%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -%% monitor/2 - -monitor(true, Pid) -> - erlang:monitor(process, Pid); -monitor(false = No, _) -> - No. - -%% down/1 - -down(Pid) -> - L = ets:match_object(?TABLE, ?REC({'_', Pid}, '_')), - [?REC(_, Ref) = T] = lookup(Pid), - fold(Ref, L), - delete_object(T), - delete(L). - -%% Fold Pid-based entries into Ref-based ones. -fold(Ref, L) -> - lists:foreach(fun(?REC({K, _}, V)) -> update_counter({{K, Ref}, V}) end, - L). - -delete(Objs) -> - lists:foreach(fun delete_object/1, Objs). - -%% fetch/1 - -fetch(X) -> - MatchSpec = [{?REC({'_', '$1'}, '_'), - [?ORCOND([{'==', '$1', {const, T}} || T <- [X | ref(X)]])], - ['$_']}], - L = ets:select(?TABLE, MatchSpec), - delete(L), - D = lists:foldl(fun sum/2, dict:new(), L), - dict:to_list(D). - -sum({{Ctr, _}, N}, Dict) -> - dict:update(Ctr, fun(V) -> V+N end, N, Dict). - -ref(Pid) - when is_pid(Pid) -> - ets:select(?TABLE, [{?REC(Pid, '$1'), [], ['$1']}]); -ref(_) -> - []. - -%% update_counter/2 -%% -%% From an arbitrary request process. Cast to the server process to -%% insert a new element if the counter doesn't exists so that two -%% processes don't do so simultaneously. - -update_counter(Key, N) -> - try - ets:update_counter(?TABLE, Key, N) - catch - error: badarg -> - cast({incr, ?REC(Key, N)}) - end. - -%% update_counter/1 -%% -%% From the server process. - -update_counter(?REC(Key, N) = T) -> - try - ets:update_counter(?TABLE, Key, N) - catch - error: badarg -> - insert(T) - end. - -insert(T) -> - ets:insert(?TABLE, T). - -lookup(Key) -> - ets:lookup(?TABLE, Key). - -delete_object(T) -> - ets:delete_object(?TABLE, T). - -%% cast/1 - -cast(Msg) -> - gen_server:cast(?SERVER, Msg). - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_sup.erl b/lib/diameter/src/app/diameter_sup.erl deleted file mode 100644 index e5afd23dcd..0000000000 --- a/lib/diameter/src/app/diameter_sup.erl +++ /dev/null @@ -1,101 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% The top supervisor for the diameter application. -%% - --module(diameter_sup). - --behaviour(supervisor). - -%% interface --export([start_link/0, %% supervisor start - tree/0]). %% supervision tree - -%% supervisor callback --export([init/1]). - --define(CHILDREN, [diameter_misc_sup, - diameter_watchdog_sup, - diameter_peer_fsm_sup, - diameter_transport_sup, - diameter_service_sup]). - --define(TABLES, [{diameter_sequence, [set]}, - {diameter_service, [set, {keypos, 3}]}, - {diameter_request, [bag]}, - {diameter_config, [bag, {keypos, 2}]}]). - -%% start_link/0 - -start_link() -> - SupName = {local, ?MODULE}, - supervisor:start_link(SupName, ?MODULE, []). - -%% init/1 - -init([]) -> - ets_new(?TABLES), - diameter_session:init(), - Flags = {one_for_one, 1, 5}, - ChildSpecs = lists:map(fun spec/1, ?CHILDREN), - {ok, {Flags, ChildSpecs}}. - -%% spec/1 - -spec(Mod) -> - {Mod, - {Mod, start_link, []}, - permanent, - 1000, - supervisor, - [Mod]}. - -%% ets_new/1 - -ets_new(List) - when is_list(List) -> - lists:foreach(fun ets_new/1, List); - -ets_new({Table, Opts}) -> - ets:new(Table, [named_table, public | Opts]). - -%% tree/0 - -tree() -> - [{?MODULE, whereis(?MODULE), tree(?MODULE)}]. - -tree(Sup) -> - lists:map(fun t/1, supervisor:which_children(Sup)). - -t({Name, Pid, supervisor, _}) -> - t(Name, Pid, tree(Pid)); -t({Name, Pid, worker, _}) -> - t(Name, Pid). - -t(undefined, Pid, Children) -> - {Pid, Children}; -t(Name, Pid, Children) -> - {Name, Pid, Children}. - -t(undefined, Pid) -> - Pid; -t(Name, Pid) -> - {Name, Pid}. diff --git a/lib/diameter/src/app/diameter_sync.erl b/lib/diameter/src/app/diameter_sync.erl deleted file mode 100644 index ce2db4b3a2..0000000000 --- a/lib/diameter/src/app/diameter_sync.erl +++ /dev/null @@ -1,550 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module implements a server that serializes requests in named -%% queues. A request is an MFA or fun and a name can be any term. A -%% request is applied in a dedicated process that terminates when -%% the request function returns. -%% - --module(diameter_sync). --behaviour(gen_server). - --export([call/4, call/5, - cast/4, cast/5, - carp/1, carp/2]). - -%% supervisor callback --export([start_link/0]). - -%% gen_server interface --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% test/debug --export([state/0, - uptime/0, - flush/1, - pending/0, - pending/1, - queues/0, - pids/1]). - --include("diameter_internal.hrl"). - -%% Locally registered server name. --define(SERVER, ?MODULE). - -%% Message to the server to queue a request ... --define(REQUEST(CallOrCast, Name, Req, Max, Timeout), - {request, CallOrCast, Name, Req, Max, Timeout}). - -%% ... and to retrieve the pid of the prevailing request process. --define(CARP(Name), - {carp, Name}). - -%% Forever ... --define(TIMEOUT, 30000). - -%% Server state. --record(state, - {time = now(), - pending = 0 :: non_neg_integer(), %% outstanding requests - monitor = new() :: ets:tid(), %% MonitorRef -> {Name, From} - queue = new() :: ets:tid()}). %% Name -> queue of {Pid, Ref} - -%% ---------------------------------------------------------- -%% # call(Node, Name, Req, Max, Timeout) -%% # call(Name, Req, Max, Timeout) -%% -%% Input: Name = term() identifying the queue in which the request is -%% to be evaluated. -%% Req = {M,F,A} -%% | {Fun, Arg} -%% | [Fun | Args] -%% | Fun -%% Max = Upper bound for the number of outstanding requests -%% in the named queue for Req to be queued. -%% If more than this number are in the queue then -%% 'rejected' is returned to the caller. Can be any -%% term but integer() | infinity is sufficient. -%% Timeout = 32 bit integer() number of milliseconds after which -%% request is cancelled (if not already started), causing -%% 'timeout' to be returned to the caller. -%% | infinity -%% -%% Output: Req() | rejected | timeout -%% -%% Description: Serialize a request in a named queue. Note that if -%% 'timeout' is returned and the request itself does not -%% return this atom then request has not been evaluated. -%% ---------------------------------------------------------- - -call(Name, Req, Max, Timeout) -> - call(node(), Name, Req, Max, Timeout). - -call(Node, Name, Req, Max, Timeout) -> - gen_call({?SERVER, Node}, ?REQUEST(call, Name, Req, Max, Timeout)). - -%%% ---------------------------------------------------------- -%%% # cast(Node, Name, Req, Max, Timeout) -%%% # cast(Name, Req, Max, Timeout) -%%% -%%% Output: ok | rejected | timeout -%%% -%%% Description: Serialize a request without returning the result to the -%%% caller. Returns after the task is queued. -%%% ---------------------------------------------------------- - -cast(Name, Req, Max, Timeout) -> - cast(node(), Name, Req, Max, Timeout). - -cast(Node, Name, Req, Max, Timeout) -> - gen_call({?SERVER, Node}, ?REQUEST(cast, Name, Req, Max, Timeout)). - -%% 'timeout' is only return if the server process that processes -%% requests isn't alive. Ditto for call/carp. - -%%% ---------------------------------------------------------- -%%% # carp(Node, Name) -%%% # carp(Name) -%%% -%%% Output: {value, Pid} | false | timeout -%%% -%%% Description: Return the pid of the process processing the task -%%% at the head of the named queue. Note that the value -%%% returned by subsequent calls changes as tasks are -%%% completed, each task executing in a dedicated -%%% process. The exit value of this process will be -%%% {value, Req()} if the task returns. -%%% ---------------------------------------------------------- - -%% The intention of this is to let a process enqueue a task that waits -%% for a message before completing, the target pid being retrieved -%% with carp/[12]. - -carp(Name) -> - carp(node(), Name). - -carp(Node, Name) -> - gen_call({?SERVER, Node}, ?CARP(Name)). - -%%% --------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -state() -> - call(state). - -uptime() -> - call(uptime). - -flush(Name) -> - call({flush, Name}). - -pending() -> - call(pending). - -pending(Name) -> - call({pending, Name}). - -queues() -> - call(queues). - -pids(Name) -> - call({pids, Name}). - -%%% ---------------------------------------------------------- -%%% # start_link() -%%% ---------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -%%% ---------------------------------------------------------- -%%% # init(_) -%%% ---------------------------------------------------------- - -init(_) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -%% Enqueue a new request. -handle_call(?REQUEST(Type, Name, Req, Max, Timeout), - From, - #state{queue = QD} = State) -> - T = find(Name, QD), - nq(queued(T) =< Max, T, {Type, From}, Name, Req, Timeout, State); - -handle_call(Request, From, State) -> - {reply, call(Request, From, State), State}. - -%% call/3 - -call(?CARP(Name), _, #state{queue = QD}) -> - pcar(find(Name, QD)); - -call(state, _, State) -> - State; - -call(uptime, _, #state{time = T}) -> - diameter_lib:now_diff(T); - -call({flush, Name}, _, #state{queue = QD}) -> - cancel(find(Name, QD)); - -call(pending, _, #state{pending = N}) -> - N; - -call({pending, Name}, _, #state{queue = QD}) -> - queued(find(Name, QD)); - -call(queues, _, #state{queue = QD}) -> - fetch_keys(QD); - -call({pids, Name}, _, #state{queue = QD}) -> - plist(find(Name, QD)); - -call(Req, From, _State) -> %% ignore - ?UNEXPECTED(handle_call, [Req, From]), - nok. - -%%% ---------------------------------------------------------- -%%% handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% handle_info(Request, State) -%%% ---------------------------------------------------------- - -handle_info(Request, State) -> - {noreply, info(Request, State)}. - -%% info/2 - -%% A request has completed execution or timed out. -info({'DOWN', MRef, process, Pid, Info}, - #state{pending = N, - monitor = MD, - queue = QD} - = State) -> - {Name, From} = fetch(MRef, MD), - reply(From, rc(Info)), - State#state{pending = N-1, - monitor = erase(MRef, MD), - queue = dq(fetch(Name, QD), Pid, Info, Name, QD)}; - -info(Info, State) -> - ?UNEXPECTED(handle_info, [Info]), - State. - -reply({call, From}, T) -> - gen_server:reply(From, T); -reply(cast, _) -> - ok. - -rc({value, T}) -> - T; -rc(_) -> - timeout. - -%%% ---------------------------------------------------------- -%%% code_change(OldVsn, State, Extra) -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%% ---------------------------------------------------------- -%%% terminate(Reason, State) -%%% ---------------------------------------------------------- - -terminate(_Reason, _State)-> - ok. - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -%% queued/1 - -queued({ok, {N,_}}) -> - N; -queued(error) -> - 0. - -%% nq/7 - -%% Maximum number of pending requests exceeded ... -nq(false, _, _, _Name, _Req, _Timeout, State) -> - {reply, rejected, State}; - -%% ... or not. -nq(true, T, From, Name, Req, Timeout, #state{pending = N, - monitor = MD, - queue = QD} - = State) -> - Ref = make_ref(), - Pid = init(Ref, Req, timeout(Timeout, T)), - MRef = erlang:monitor(process, Pid), - {noreply, State#state{pending = N+1, - monitor = store(MRef, {Name, from(From)}, MD), - queue = store(Name, nq(T, {Pid, Ref}), QD)}}. - -from({call, _} = T) -> - T; -from({cast = T, From}) -> - gen_server:reply(From, ok), - T. - -%% nq/2 - -%% Other requests in the queue: append. -nq({ok, {N,Q}}, T) -> - {N+1, queue:in(T,Q)}; - -%% Queue is empty: start execution. -nq(error, T) -> - go(T), - {1, queue:from_list([T])}. - -%% Don't timeout if the request is evaluated immediately so as to -%% avoid a race between getting a 'go' and a 'timeout'. Queueing a -%% request in an empty queue always results in execution. -timeout(_, error) -> - infinity; -timeout(Timeout, _) -> - Timeout. - -%% dq/5 -%% -%% A request process has terminated. - -dq({N,Q}, Pid, _Info, Name, QD) -> - {{value, T}, TQ} = queue:out(Q), - dq(N-1, Pid, T, TQ, Name, QD). - -%% dq/6 - -%% Request was at the head of the queue: start another. -dq(N, Pid, {Pid, _}, TQ, Name, QD) -> - dq(N, TQ, Name, QD); - -%% Or not: remove the offender from the queue. -dq(N, Pid, T, TQ, Name, QD) -> - store(Name, {N, req(Pid, queue:from_list([T]), TQ)}, QD). - -%% dq/4 - -%% Queue is empty: erase. -dq(0, TQ, Name, QD) -> - true = queue:is_empty(TQ), %% assert - erase(Name, QD); - -%% Start the next request. -dq(N, TQ, Name, QD) -> - go(queue:head(TQ)), - store(Name, {N, TQ}, QD). - -%% req/3 -%% -%% Find and remove the queue element for the specified pid. - -req(Pid, HQ, Q) -> - {{value, T}, TQ} = queue:out(Q), - req(Pid, T, HQ, TQ). - -req(Pid, {Pid, _}, HQ, TQ) -> - queue:join(HQ, TQ); -req(Pid, T, HQ, TQ) -> - req(Pid, queue:in(T,HQ), TQ). - -%% go/1 - -go({Pid, Ref}) -> - Pid ! {Ref, ok}. - -%% init/4 -%% -%% Start the dedicated process for handling a request. The exit value -%% is as promised by carp/1. - -init(Ref, Req, Timeout) -> - spawn(fun() -> exit(i(Ref, Req, Timeout)) end). - -i(Ref, Req, Timeout) -> - Timer = send_timeout(Ref, Timeout), - MRef = erlang:monitor(process, ?SERVER), - receive - {Ref, ok} -> %% Do the deed. - %% Ensure we don't leave messages in the mailbox since the - %% request itself might receive. Alternatively, could have - %% done the eval in a new process but then we'd have to - %% relay messages arriving at this one. - cancel_timer(Timer), - erlang:demonitor(MRef, [flush]), - %% Ref is to ensure that we don't extract any message that - %% a client may have sent after retrieving self() with - %% carp/1, there being no guarantee that the message - %% banged by go/1 is received before the pid becomes - %% accessible. - {value, eval(Req)}; - {Ref, timeout = T} -> - T; - {'DOWN', MRef, process, _Pid, _Info} = D -> %% server death - D - end. - -send_timeout(_Ref, infinity = No) -> - No; -send_timeout(Ref, Ms) -> - Msg = {Ref, timeout}, - TRef = erlang:send_after(Ms, self(), Msg), - {TRef, Msg}. - -cancel_timer(infinity = No) -> - No; -cancel_timer({TRef, Msg}) -> - flush(Msg, erlang:cancel_timer(TRef)). - -flush(Msg, false) -> %% Message has already been sent ... - %% 'error' should never happen but crash if it does so as not to - %% hang the process. - ok = receive Msg -> ok after ?TIMEOUT -> error end; -flush(_, _) -> %% ... or not. - ok. - -eval({M,F,A}) -> - apply(M,F,A); -eval([Fun | Args]) -> - apply(Fun, Args); -eval({Fun, A}) -> - Fun(A); -eval(Fun) -> - Fun(). - -%% pcar/1 - -pcar({ok, {_,Q}}) -> - {Pid, _Ref} = queue:head(Q), - {value, Pid}; -pcar(error) -> - false. - -%% plist/1 - -plist({ok, {_,Q}}) -> - lists:map(fun({Pid, _Ref}) -> Pid end, queue:to_list(Q)); -plist(error) -> - []. - -%% cancel/1 -%% -%% Cancel all but the active request from the named queue. Return the -%% number of requests cancelled. - -%% Just send timeout messages to each request to make them die. Note -%% that these are guaranteed to arrive before a go message after the -%% current request completes since both messages are sent from the -%% server process. -cancel({ok, {N,Q}}) -> - {_,TQ} = queue:split(1,Q), - foreach(fun({Pid, Ref}) -> Pid ! {Ref, timeout} end, N-1, TQ), - N-1; -cancel(error) -> - 0. - -%% foreach/3 - -foreach(_, 0, _) -> - ok; -foreach(Fun, N, Q) -> - Fun(queue:head(Q)), - foreach(Fun, N-1, queue:tail(Q)). - -%% call/1 - -%% gen_server:call/3 will exit if the target process dies. -call(Request) -> - try - gen_server:call(?SERVER, Request, ?TIMEOUT) - catch - exit: Reason -> - {error, Reason} - end. - -%% dict-like table manipulation. - -erase(Key, Dict) -> - ets:delete(Dict, Key), - Dict. - -fetch(Key, Dict) -> - {ok, V} = find(Key, Dict), - V. - -fetch_keys(Dict) -> - ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). - -find(Key, Dict) -> - case ets:lookup(Dict, Key) of - [{Key, V}] -> - {ok, V}; - [] -> - error - end. - -new() -> - ets:new(?MODULE, [set]). - -store(Key, Value, Dict) -> - store({Key, Value}, Dict). - -store({_,_} = T, Dict) -> - ets:insert(Dict, T), - Dict. - -%% gen_call/1 - -gen_call(Server, Req) -> - gen_call(Server, Req, infinity). - -gen_call(Server, Req, Timeout) -> - try - gen_server:call(Server, Req, Timeout) - catch - exit: _ -> - timeout - end. diff --git a/lib/diameter/src/app/diameter_types.erl b/lib/diameter/src/app/diameter_types.erl deleted file mode 100644 index 6b1b1b8d39..0000000000 --- a/lib/diameter/src/app/diameter_types.erl +++ /dev/null @@ -1,537 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(diameter_types). - -%% -%% Encode/decode of RFC 3588 Data Formats, Basic (section 4.2) and -%% Derived (section 4.3). -%% - -%% Basic types. --export(['OctetString'/2, - 'Integer32'/2, - 'Integer64'/2, - 'Unsigned32'/2, - 'Unsigned64'/2, - 'Float32'/2, - 'Float64'/2]). - -%% Derived types. --export(['Address'/2, - 'Time'/2, - 'UTF8String'/2, - 'DiameterIdentity'/2, - 'DiameterURI'/2, - 'IPFilterRule'/2, - 'QoSFilterRule'/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(UINT(N,X), ((0 =< X) andalso (X < 1 bsl N))). --define(SINT(N,X), ((-1*(1 bsl (N-1)) < X) andalso (X < 1 bsl (N-1)))). - -%% The Grouped and Enumerated types are dealt with directly in -%% generated decode modules by way of diameter_gen.hrl and -%% diameter_codec.erl. Padding and the setting of Length and other -%% fields are also dealt with there. - -%% 3588: -%% -%% DIAMETER_INVALID_AVP_LENGTH 5014 -%% The request contained an AVP with an invalid length. A Diameter -%% message indicating this error MUST include the offending AVPs -%% within a Failed-AVP AVP. -%% --define(INVALID_LENGTH(Bin), erlang:error({'DIAMETER', 5014, Bin})). - -%% ------------------------------------------------------------------------- -%% 3588, 4.2. Basic AVP Data Formats -%% -%% The Data field is zero or more octets and contains information -%% specific to the Attribute. The format and length of the Data field -%% is determined by the AVP Code and AVP Length fields. The format of -%% the Data field MUST be one of the following base data types or a data -%% type derived from the base data types. In the event that a new Basic -%% AVP Data Format is needed, a new version of this RFC must be created. -%% -------------------- - -'OctetString'(decode, Bin) - when is_binary(Bin) -> - binary_to_list(Bin); - -'OctetString'(encode = M, zero) -> - 'OctetString'(M, []); - -'OctetString'(encode, Str) -> - iolist_to_binary(Str). - -%% -------------------- - -'Integer32'(decode, <<X:32/signed>>) -> - X; - -'Integer32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Integer32'(encode = M, zero) -> - 'Integer32'(M, 0); - -'Integer32'(encode, I) - when ?SINT(32,I) -> - <<I:32/signed>>. - -%% -------------------- - -'Integer64'(decode, <<X:64/signed>>) -> - X; - -'Integer64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Integer64'(encode = M, zero) -> - 'Integer64'(M, 0); - -'Integer64'(encode, I) - when ?SINT(64,I) -> - <<I:64/signed>>. - -%% -------------------- - -'Unsigned32'(decode, <<X:32>>) -> - X; - -'Unsigned32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Unsigned32'(encode = M, zero) -> - 'Unsigned32'(M, 0); - -'Unsigned32'(encode, I) - when ?UINT(32,I) -> - <<I:32>>. - -%% -------------------- - -'Unsigned64'(decode, <<X:64>>) -> - X; - -'Unsigned64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Unsigned64'(encode = M, zero) -> - 'Unsigned64'(M, 0); - -'Unsigned64'(encode, I) - when ?UINT(64,I) -> - <<I:64>>. - -%% -------------------- - -%% Decent summaries of the IEEE floating point formats can be -%% found at http://en.wikipedia.org/wiki/IEEE_754-1985 and -%% http://www.psc.edu/general/software/packages/ieee/ieee.php. -%% -%% That the bit syntax uses these formats isn't well documented but -%% this does indeed appear to be the case. However, the bit syntax -%% only encodes numeric values, not the standard's (signed) infinity -%% or NaN. It also encodes any large value as 'infinity', never 'NaN'. -%% Treat these equivalently on decode for this reason. -%% -%% An alternative would be to decode infinity/NaN to the largest -%% possible float but could likely lead to misleading results if -%% arithmetic is performed on the decoded value. Better to be explicit -%% that precision has been lost. - -'Float32'(decode, <<S:1, 255:8, _:23>>) -> - choose(S, infinity, '-infinity'); - -'Float32'(decode, <<X:32/float>>) -> - X; - -'Float32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Float32'(encode = M, zero) -> - 'Float32'(M, 0.0); - -'Float32'(encode, infinity) -> - <<0:1, 255:8, 0:23>>; - -'Float32'(encode, '-infinity') -> - <<1:1, 255:8, 0:23>>; - -'Float32'(encode, X) - when is_float(X) -> - <<X:32/float>>. -%% Note that this could also encode infinity/-infinity for large -%% (signed) numeric values. Note also that precision is lost just in -%% using the floating point syntax. For example: -%% -%% 1> B = <<3.14159:32/float>>. -%% <<64,73,15,208>> -%% 2> <<F:32/float>> = B. -%% <<64,73,15,208>> -%% 3> F. -%% 3.141590118408203 -%% -%% (The 64 bit type does better.) - -%% -------------------- - -%% The 64 bit format is entirely analogous to the 32 bit format. - -'Float64'(decode, <<S:1, 2047:11, _:52>>) -> - choose(S, infinity, '-infinity'); - -'Float64'(decode, <<X:64/float>>) -> - X; - -'Float64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Float64'(encode, infinity) -> - <<0:1, 2047:11, 0:52>>; - -'Float64'(encode, '-infinity') -> - <<1:1, 2047:11, 0:52>>; - -'Float64'(encode = M, zero) -> - 'Float64'(M, 0.0); - -'Float64'(encode, X) - when is_float(X) -> - <<X:64/float>>. - -%% ------------------------------------------------------------------------- -%% 3588, 4.3. Derived AVP Data Formats -%% -%% In addition to using the Basic AVP Data Formats, applications may -%% define data formats derived from the Basic AVP Data Formats. An -%% application that defines new AVP Derived Data Formats MUST include -%% them in a section entitled "AVP Derived Data Formats", using the same -%% format as the definitions below. Each new definition must be either -%% defined or listed with a reference to the RFC that defines the -%% format. -%% -------------------- - -'Address'(encode, zero) -> - <<0:48>>; - -'Address'(decode, <<1:16, B/binary>>) - when size(B) == 4 -> - list_to_tuple(binary_to_list(B)); - -'Address'(decode, <<2:16, B/binary>>) - when size(B) == 16 -> - list_to_tuple(v6dec(B, [])); - -'Address'(decode, <<A:16, _/binary>> = B) - when 1 == A; - 2 == A -> - ?INVALID_LENGTH(B); - -'Address'(encode, T) -> - ipenc(diameter_lib:ipaddr(T)). - -ipenc(T) - when is_tuple(T), size(T) == 4 -> - B = list_to_binary(tuple_to_list(T)), - <<1:16, B/binary>>; - -ipenc(T) - when is_tuple(T), size(T) == 8 -> - B = v6enc(lists:reverse(tuple_to_list(T)), <<>>), - <<2:16, B/binary>>. - -v6dec(<<N:16, B/binary>>, Acc) -> - v6dec(B, [N | Acc]); - -v6dec(<<>>, Acc) -> - lists:reverse(Acc). - -v6enc([N | Rest], B) - when ?UINT(16,N) -> - v6enc(Rest, <<N:16, B/binary>>); - -v6enc([], B) -> - B. - -%% -------------------- - -%% A DiameterIdentity is a FQDN as definined in RFC 1035, which is at -%% least one character. - -'DiameterIdentity'(encode = M, zero) -> - 'OctetString'(M, [0]); - -'DiameterIdentity'(encode = M, X) -> - <<_,_/binary>> = 'OctetString'(M, X); - -'DiameterIdentity'(decode = M, <<_,_/binary>> = X) -> - 'OctetString'(M, X). - -%% -------------------- - -'DiameterURI'(decode, Bin) - when is_binary(Bin) -> - scan_uri(Bin); - -%% The minimal DiameterURI is "aaa://x", 7 characters. -'DiameterURI'(encode = M, zero) -> - 'OctetString'(M, lists:duplicate(0,7)); - -'DiameterURI'(encode, #diameter_uri{type = Type, - fqdn = D, - port = P, - transport = T, - protocol = Prot} - = U) -> - S = lists:append([atom_to_list(Type), "://", D, - ":", integer_to_list(P), - ";transport=", atom_to_list(T), - ";protocol=", atom_to_list(Prot)]), - U = scan_uri(S), %% assert - list_to_binary(S); - -'DiameterURI'(encode, Str) -> - Bin = iolist_to_binary(Str), - #diameter_uri{} = scan_uri(Bin), %% type check - Bin. - -%% -------------------- - -%% This minimal rule is "deny in 0 from 0.0.0.0 to 0.0.0.0", 33 characters. -'IPFilterRule'(encode = M, zero) -> - 'OctetString'(M, lists:duplicate(0,33)); - -%% TODO: parse grammar. -'IPFilterRule'(M, X) -> - 'OctetString'(M, X). - -%% -------------------- - -%% This minimal rule is the same as for an IPFilterRule. -'QoSFilterRule'(encode = M, zero = X) -> - 'IPFilterRule'(M, X); - -%% TODO: parse grammar. -'QoSFilterRule'(M, X) -> - 'OctetString'(M, X). - -%% -------------------- - -'UTF8String'(decode, Bin) -> - udec(Bin, []); - -'UTF8String'(encode = M, zero) -> - 'UTF8String'(M, []); - -'UTF8String'(encode, S) -> - uenc(S, []). - -udec(<<>>, Acc) -> - lists:reverse(Acc); - -udec(<<C/utf8, Rest/binary>>, Acc) -> - udec(Rest, [C | Acc]). - -uenc(E, Acc) - when E == []; - E == <<>> -> - list_to_binary(lists:reverse(Acc)); - -uenc(<<C/utf8, Rest/binary>>, Acc) -> - uenc(Rest, [<<C/utf8>> | Acc]); - -uenc([[] | Rest], Acc) -> - uenc(Rest, Acc); - -uenc([[H|T] | Rest], Acc) -> - uenc([H, T | Rest], Acc); - -uenc([C | Rest], Acc) -> - uenc(Rest, [<<C/utf8>> | Acc]). - -%% -------------------- - -%% RFC 3588, 4.3: -%% -%% Time -%% The Time format is derived from the OctetString AVP Base Format. -%% The string MUST contain four octets, in the same format as the -%% first four bytes are in the NTP timestamp format. The NTP -%% Timestamp format is defined in chapter 3 of [SNTP]. -%% -%% This represents the number of seconds since 0h on 1 January 1900 -%% with respect to the Coordinated Universal Time (UTC). -%% -%% On 6h 28m 16s UTC, 7 February 2036 the time value will overflow. -%% SNTP [SNTP] describes a procedure to extend the time to 2104. -%% This procedure MUST be supported by all DIAMETER nodes. - -%% RFC 2030, 3: -%% -%% As the NTP timestamp format has been in use for the last 17 years, -%% it remains a possibility that it will be in use 40 years from now -%% when the seconds field overflows. As it is probably inappropriate -%% to archive NTP timestamps before bit 0 was set in 1968, a -%% convenient way to extend the useful life of NTP timestamps is the -%% following convention: If bit 0 is set, the UTC time is in the -%% range 1968-2036 and UTC time is reckoned from 0h 0m 0s UTC on 1 -%% January 1900. If bit 0 is not set, the time is in the range 2036- -%% 2104 and UTC time is reckoned from 6h 28m 16s UTC on 7 February -%% 2036. Note that when calculating the correspondence, 2000 is not a -%% leap year. Note also that leap seconds are not counted in the -%% reckoning. -%% -%% The statement regarding year 2000 is wrong: errata id 518 at -%% http://www.rfc-editor.org/errata_search.php?rfc=2030 notes this. - --define(TIME_1900, 59958230400). %% {{1900,1,1},{0,0,0}} --define(TIME_2036, 64253197696). %% {{2036,2,7},{6,28,16}} -%% TIME_2036 = TIME_1900 + (1 bsl 32) - -%% Time maps [0, 1 bsl 31) onto [TIME_1900 + 1 bsl 31, TIME_2036 + 1 bsl 31) -%% by taking integers with the high-order bit set relative to TIME_1900 -%% and those without relative to TIME_2036. This corresponds to the -%% following dates. --define(TIME_MIN, {{1968,1,20},{3,14,8}}). %% TIME_1900 + 1 bsl 31 --define(TIME_MAX, {{2104,2,26},{9,42,24}}). %% TIME_2036 + 1 bsl 31 - -'Time'(decode, <<Time:32>>) -> - Offset = msb(1 == Time bsr 31), - calendar:gregorian_seconds_to_datetime(Time + Offset); - -'Time'(decode, B) -> - ?INVALID_LENGTH(B); - -'Time'(encode, {{_Y,_M,_D},{_HH,_MM,_SS}} = Datetime) - when ?TIME_MIN =< Datetime, Datetime < ?TIME_MAX -> - S = calendar:datetime_to_gregorian_seconds(Datetime), - T = S - msb(S < ?TIME_2036), - 0 = T bsr 32, %% sanity check - <<T:32>>; - -'Time'(encode, zero) -> - <<0:32>>. - -%% =========================================================================== -%% =========================================================================== - -choose(0, X, _) -> X; -choose(1, _, X) -> X. - -msb(true) -> ?TIME_1900; -msb(false) -> ?TIME_2036. - -%% RFC 3588, 4.3: -%% -%% The DiameterURI MUST follow the Uniform Resource Identifiers (URI) -%% syntax [URI] rules specified below: -%% -%% "aaa://" FQDN [ port ] [ transport ] [ protocol ] -%% -%% ; No transport security -%% -%% "aaas://" FQDN [ port ] [ transport ] [ protocol ] -%% -%% ; Transport security used -%% -%% FQDN = Fully Qualified Host Name -%% -%% port = ":" 1*DIGIT -%% -%% ; One of the ports used to listen for -%% ; incoming connections. -%% ; If absent, -%% ; the default Diameter port (3868) is -%% ; assumed. -%% -%% transport = ";transport=" transport-protocol -%% -%% ; One of the transports used to listen -%% ; for incoming connections. If absent, -%% ; the default SCTP [SCTP] protocol is -%% ; assumed. UDP MUST NOT be used when -%% ; the aaa-protocol field is set to -%% ; diameter. -%% -%% transport-protocol = ( "tcp" / "sctp" / "udp" ) -%% -%% protocol = ";protocol=" aaa-protocol -%% -%% ; If absent, the default AAA protocol -%% ; is diameter. -%% -%% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) - -scan_uri(Bin) - when is_binary(Bin) -> - scan_uri(binary_to_list(Bin)); -scan_uri("aaa://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaa}); -scan_uri("aaas://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaas}). - -scan_fqdn(S, U) -> - {[_|_] = F, Rest} = lists:splitwith(fun is_fqdn/1, S), - scan_opt_port(Rest, U#diameter_uri{fqdn = F}). - -scan_opt_port(":" ++ S, U) -> - {[_|_] = P, Rest} = lists:splitwith(fun is_digit/1, S), - scan_opt_transport(Rest, U#diameter_uri{port = list_to_integer(P)}); -scan_opt_port(S, U) -> - scan_opt_transport(S, U). - -scan_opt_transport(";transport=" ++ S, U) -> - {P, Rest} = transport(S), - scan_opt_protocol(Rest, U#diameter_uri{transport = P}); -scan_opt_transport(S, U) -> - scan_opt_protocol(S, U). - -scan_opt_protocol(";protocol=" ++ S, U) -> - {P, ""} = protocol(S), - U#diameter_uri{protocol = P}; -scan_opt_protocol("", U) -> - U. - -transport("tcp" ++ S) -> - {tcp, S}; -transport("sctp" ++ S) -> - {sctp, S}; -transport("udp" ++ S) -> - {udp, S}. - -protocol("diameter" ++ S) -> - {diameter, S}; -protocol("radius" ++ S) -> - {radius, S}; -protocol("tacacs+" ++ S) -> - {'tacacs+', S}. - -is_fqdn(C) -> - is_digit(C) orelse is_alpha(C) orelse C == $. orelse C == $-. - -is_alpha(C) -> - ($a =< C andalso C =< $z) orelse ($A =< C andalso C =< $Z). - -is_digit(C) -> - $0 =< C andalso C =< $9. diff --git a/lib/diameter/src/app/diameter_types.hrl b/lib/diameter/src/app/diameter_types.hrl deleted file mode 100644 index 02bf8a74dd..0000000000 --- a/lib/diameter/src/app/diameter_types.hrl +++ /dev/null @@ -1,139 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Types for function specifications, primarily in diameter.erl. This -%% has nothing specifically to do with diameter_types.erl. -%% - --type evaluable() - :: {module(), atom(), list()} - | fun() - | nonempty_improper_list(evaluable(), list()). %% [evaluable() | Args] - --type app_alias() - :: any(). - --type service_name() - :: any(). - -%% Diameter basic types - --type 'OctetString'() :: iolist(). --type 'Integer32'() :: -2147483647..2147483647. --type 'Integer64'() :: -9223372036854775807..9223372036854775807. --type 'Unsigned32'() :: 0..4294967295. --type 'Unsigned64'() :: 0..18446744073709551615. --type 'Float32'() :: '-infinity' | float() | infinity. --type 'Float64'() :: '-infinity' | float() | infinity. --type 'Grouped'() :: list() | tuple(). - -%% Diameter derived types - --type 'Address'() - :: inet:ip_address() - | string(). - --type 'Time'() :: {{integer(), 1..12, 1..31}, - {0..23, 0..59, 0..59}}. --type 'UTF8String'() :: iolist(). --type 'DiameterIdentity'() :: 'OctetString'(). --type 'DiameterURI'() :: 'OctetString'(). --type 'Enumerated'() :: 'Integer32'(). --type 'IPFilterRule'() :: 'OctetString'(). --type 'QoSFilterRule'() :: 'OctetString'(). - -%% Capabilities options/avps on start_service/2 and/or add_transport/2 - --type capability() - :: {'Origin-Host', 'DiameterIdentity'()} - | {'Origin-Realm', 'DiameterIdentity'()} - | {'Host-IP-Address', ['Address'()]} - | {'Vendor-Id', 'Unsigned32'()} - | {'Product-Name', 'UTF8String'()} - | {'Supported-Vendor-Id', ['Unsigned32'()]} - | {'Auth-Application-Id', ['Unsigned32'()]} - | {'Vendor-Specific-Application-Id', ['Grouped'()]} - | {'Firmware-Revision', 'Unsigned32'()}. - -%% Filters for call/4 - --type peer_filter() - :: none - | host - | realm - | {host, any|'DiameterIdentity'()} - | {realm, any|'DiameterIdentity'()} - | {eval, evaluable()} - | {neg, peer_filter()} - | {all, [peer_filter()]} - | {any, [peer_filter()]}. - -%% Options passed to start_service/2 - --type service_opt() - :: capability() - | {application, [application_opt()]}. - --type application_opt() - :: {alias, app_alias()} - | {dictionary, module()} - | {module, app_module()} - | {state, any()} - | {call_mutates_state, boolean()} - | {answer_errors, callback|report|discard}. - --type app_module() - :: module() - | nonempty_improper_list(module(), list()). %% list with module() head - -%% Identifier returned by add_transport/2 - --type transport_ref() - :: reference(). - -%% Options passed to add_transport/2 - --type transport_opt() - :: {transport_module, atom()} - | {transport_config, any()} - | {applications, [app_alias()]} - | {capabilities, [capability()]} - | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} - | {reconnect_timer, 'Unsigned32'()} - | {private, any()}. - -%% Predicate passed to remove_transport/2 - --type transport_pred() - :: fun((reference(), connect|listen, list()) -> boolean()) - | fun((reference(), list()) -> boolean()) - | fun((list()) -> boolean()) - | reference() - | list() - | {connect|listen, transport_pred()} - | {atom(), atom(), list()}. - -%% Options passed to call/4 - --type call_opt() - :: {extra, list()} - | {filter, peer_filter()} - | {timeout, 'Unsigned32'()} - | detach. diff --git a/lib/diameter/src/app/diameter_watchdog.erl b/lib/diameter/src/app/diameter_watchdog.erl deleted file mode 100644 index b7c1491f4b..0000000000 --- a/lib/diameter/src/app/diameter_watchdog.erl +++ /dev/null @@ -1,571 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% This module implements (as a process) the state machine documented -%% in Appendix A of RFC 3539. -%% - --module(diameter_watchdog). --behaviour(gen_server). - -%% towards diameter_service --export([start/2]). - -%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% diameter_watchdog_sup callback --export([start_link/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(DEFAULT_TW_INIT, 30000). %% RFC 3539 ch 3.4.1 - --record(watchdog, - {%% PCB - Peer Control Block; see RFC 3539, Appendix A - status = initial :: initial | okay | suspect | down | reopen, - pending = false :: boolean(), - tw :: 6000..16#FFFFFFFF | {module(), atom(), list()}, - %% {M,F,A} -> integer() >= 0 - num_dwa = 0 :: -1 | non_neg_integer(), - %% number of DWAs received during reopen - %% end PCB - parent = self() :: pid(), - transport :: pid(), - tref :: reference(), %% reference for current watchdog timer - message_data}). %% term passed into diameter_service with message - -%% start/2 - -start({_,_} = Type, T) -> - {ok, Pid} = diameter_watchdog_sup:start_child({Type, self(), T}), - Pid. - -start_link(T) -> - {ok, _} = proc_lib:start_link(?MODULE, - init, - [T], - infinity, - diameter_lib:spawn_opts(server, [])). - -%% =========================================================================== -%% =========================================================================== - -%% init/1 - -init(T) -> - proc_lib:init_ack({ok, self()}), - gen_server:enter_loop(?MODULE, [], i(T)). - -i({T, Pid, {ConnT, Opts, SvcName, #diameter_service{applications = Apps, - capabilities = Caps} - = Svc}}) -> - {M,S,U} = now(), - random:seed(M,S,U), - putr(restart, {T, Opts, Svc}), %% save seeing it in trace - putr(dwr, dwr(Caps)), %% - #watchdog{parent = monitor(Pid), - transport = monitor(diameter_peer_fsm:start(T, Opts, Svc)), - tw = proplists:get_value(watchdog_timer, - Opts, - ?DEFAULT_TW_INIT), - message_data = {ConnT, SvcName, Apps}}. - -%% handle_call/3 - -handle_call(_, _, State) -> - {reply, nok, State}. - -%% handle_cast/2 - -handle_cast(_, State) -> - {noreply, State}. - -%% handle_info/2 - -handle_info(T, State) -> - case transition(T, State) of - ok -> - {noreply, State}; - #watchdog{status = X} = S -> - ?LOGC(X =/= State#watchdog.status, transition, X), - {noreply, S}; - stop -> - ?LOG(stop, T), - {stop, {shutdown, T}, State} - end. - -%% terminate/2 - -terminate(_, _) -> - ok. - -%% code_change/3 - -code_change(_, State, _) -> - {ok, State}. - -%% =========================================================================== -%% =========================================================================== - -%% transition/2 -%% -%% The state transitions documented here are extracted from RFC 3539, -%% the commentary is ours. - -%% Service or watchdog is telling the watchdog of an accepting -%% transport to die after reconnect_timer expiry or reestablished -%% connection (in another transport process) respectively. -transition(close, #watchdog{status = down}) -> - {{accept, _}, _, _} = getr(restart), %% assert - stop; -transition(close, #watchdog{}) -> - ok; - -%% Service is asking for the peer to be taken down gracefully. -transition({shutdown, Pid}, #watchdog{parent = Pid, - transport = undefined, - status = S}) -> - down = S, %% sanity check - stop; -transition({shutdown = T, Pid}, #watchdog{parent = Pid, - transport = TPid}) -> - TPid ! {T, self()}, - ok; - -%% Parent process has died, -transition({'DOWN', _, process, Pid, _Reason}, - #watchdog{parent = Pid}) -> - stop; - -%% Transport has accepted a connection. -transition({accepted = T, TPid}, #watchdog{transport = TPid, - parent = Pid}) -> - Pid ! {T, self(), TPid}, - ok; - -%% Transport is telling us that its impending death isn't failure. -transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> - stop; - -%% STATE Event Actions New State -%% ===== ------ ------- ---------- -%% INITIAL Connection up SetWatchdog() OKAY - -%% By construction, the watchdog timer isn't set until we move into -%% state okay as the result of the Peer State Machine reaching the -%% Open state. -%% -%% If we're an acceptor then we may be resuming a connection that went -%% down in another acceptor process, in which case this is the -%% transition below, from down into reopen. That is, it's not until -%% we know the identity of the peer (ie. now) that we know that we're -%% in state down rather than initial. - -transition({open, TPid, Hosts, T} = Open, - #watchdog{transport = TPid, - status = initial, - parent = Pid} - = S) -> - case okay(getr(restart), Hosts) of - okay -> - open(Pid, {TPid, T}), - set_watchdog(S#watchdog{status = okay}); - reopen -> - transition(Open, S#watchdog{status = down}) - end; - -%% DOWN Connection up NumDWA = 0 -%% SendWatchdog() -%% SetWatchdog() -%% Pending = TRUE REOPEN - -transition({open = P, TPid, _Hosts, T}, - #watchdog{transport = TPid, - status = down} - = S) -> - %% Store the info we need to notify the parent to reopen the - %% connection after the requisite DWA's are received, at which - %% time we eraser(open). - putr(P, {TPid, T}), - set_watchdog(send_watchdog(S#watchdog{status = reopen, - num_dwa = 0})); - -%% OKAY Connection down CloseConnection() -%% Failover() -%% SetWatchdog() DOWN -%% SUSPECT Connection down CloseConnection() -%% SetWatchdog() DOWN -%% REOPEN Connection down CloseConnection() -%% SetWatchdog() DOWN - -transition({'DOWN', _, process, TPid, _}, - #watchdog{transport = TPid, - status = initial}) -> - stop; - -transition({'DOWN', _, process, Pid, _}, - #watchdog{transport = Pid} - = S) -> - failover(S), - close(S), - set_watchdog(S#watchdog{status = down, - pending = false, - transport = undefined}); -%% Any outstanding pending (or other messages from the transport) will -%% have arrived before 'DOWN' since the message comes from the same -%% process. Note that we could also get this message in the initial -%% state. - -%% Incoming message. -transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> - recv(Name, Pkt, S); - -%% Current watchdog has timed out. -transition({timeout, TRef, tw}, #watchdog{tref = TRef} = S) -> - set_watchdog(timeout(S)); - -%% Timer was canceled after message was already sent. -transition({timeout, _, tw}, #watchdog{}) -> - ok; - -%% State query. -transition({state, Pid}, #watchdog{status = S}) -> - Pid ! {self(), S}, - ok. - -%% =========================================================================== - -monitor(Pid) -> - erlang:monitor(process, Pid), - Pid. - -putr(Key, Val) -> - put({?MODULE, Key}, Val). - -getr(Key) -> - get({?MODULE, Key}). - -eraser(Key) -> - erase({?MODULE, Key}). - -%% encode/1 - -encode(Msg) -> - #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg), - Bin. - -%% okay/2 - -okay({{accept, Ref}, _, _}, Hosts) -> - T = {?MODULE, connection, Ref, Hosts}, - diameter_reg:add(T), - okay(diameter_reg:match(T)); -%% Register before matching so that at least one of two registering -%% processes will match the other. (Which can't happen as long as -%% diameter_peer_fsm guarantees at most one open connection to the same -%% peer.) - -okay({{connect, _}, _, _}, _) -> - okay. - -%% The peer hasn't been connected recently ... -okay([{_,P}]) -> - P = self(), %% assert - okay; - -%% ... or it has. -okay(C) -> - [_|_] = [P ! close || {_,P} <- C, self() /= P], - reopen. - -%% set_watchdog/1 - -set_watchdog(#watchdog{tw = TwInit, - tref = TRef} - = S) -> - cancel(TRef), - S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)}. - -cancel(undefined) -> - ok; -cancel(TRef) -> - erlang:cancel_timer(TRef). - -tw(T) - when is_integer(T), T >= 6000 -> - T - 2000 + (random:uniform(4001) - 1); %% RFC3539 jitter of +/- 2 sec. -tw({M,F,A}) -> - apply(M,F,A). - -%% open/2 - -open(Pid, {_,_} = T) -> - Pid ! {connection_up, self(), T}. - -%% failover/1 - -failover(#watchdog{status = okay, - parent = Pid}) -> - Pid ! {connection_down, self()}; - -failover(_) -> - ok. - -%% close/1 - -close(#watchdog{status = down}) -> - ok; - -close(#watchdog{parent = Pid}) -> - {{T, _}, _, _} = getr(restart), - T == accept andalso (Pid ! {close, self()}). - -%% send_watchdog/1 - -send_watchdog(#watchdog{pending = false, - transport = TPid} - = S) -> - TPid ! {send, encode(getr(dwr))}, - ?LOG(send, 'DWR'), - S#watchdog{pending = true}. - -%% recv/3 - -recv(Name, Pkt, S) -> - try rcv(Name, S) of - #watchdog{} = NS -> - rcv(Name, Pkt, S), - NS - catch - throw: {?MODULE, throwaway, #watchdog{} = NS} -> - NS - end. - -%% rcv/3 - -rcv(N, _, _) - when N == 'CER'; - N == 'CEA'; - N == 'DWR'; - N == 'DWA'; - N == 'DPR'; - N == 'DPA' -> - false; - -rcv(_, Pkt, #watchdog{transport = TPid, - message_data = T}) -> - diameter_service:receive_message(TPid, Pkt, T). - -throwaway(S) -> - throw({?MODULE, throwaway, S}). - -%% rcv/2 - -%% INITIAL Receive DWA Pending = FALSE -%% Throwaway() INITIAL -%% INITIAL Receive non-DWA Throwaway() INITIAL - -rcv('DWA', #watchdog{status = initial} = S) -> - throwaway(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = initial} = S) -> - throwaway(S); - -%% DOWN Receive DWA Pending = FALSE -%% Throwaway() DOWN -%% DOWN Receive non-DWA Throwaway() DOWN - -rcv('DWA', #watchdog{status = down} = S) -> - throwaway(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = down} = S) -> - throwaway(S); - -%% OKAY Receive DWA Pending = FALSE -%% SetWatchdog() OKAY -%% OKAY Receive non-DWA SetWatchdog() OKAY - -rcv('DWA', #watchdog{status = okay} = S) -> - set_watchdog(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = okay} = S) -> - set_watchdog(S); - -%% SUSPECT Receive DWA Pending = FALSE -%% Failback() -%% SetWatchdog() OKAY -%% SUSPECT Receive non-DWA Failback() -%% SetWatchdog() OKAY - -rcv('DWA', #watchdog{status = suspect} = S) -> - failback(S), - set_watchdog(S#watchdog{status = okay, - pending = false}); - -rcv(_, #watchdog{status = suspect} = S) -> - failback(S), - set_watchdog(S#watchdog{status = okay}); - -%% REOPEN Receive DWA & Pending = FALSE -%% NumDWA == 2 NumDWA++ -%% Failback() OKAY - -rcv('DWA', #watchdog{status = reopen, - num_dwa = 2 = N, - parent = Pid} - = S) -> - open(Pid, eraser(open)), - S#watchdog{status = okay, - num_dwa = N+1, - pending = false}; - -%% REOPEN Receive DWA & Pending = FALSE -%% NumDWA < 2 NumDWA++ REOPEN - -rcv('DWA', #watchdog{status = reopen, - num_dwa = N} - = S) -> - S#watchdog{num_dwa = N+1, - pending = false}; - -%% REOPEN Receive non-DWA Throwaway() REOPEN - -rcv(_, #watchdog{status = reopen} = S) -> - throwaway(S). - -%% failback/1 - -failback(#watchdog{parent = Pid}) -> - Pid ! {connection_up, self()}. - -%% timeout/1 -%% -%% The caller sets the watchdog on the return value. - -%% OKAY Timer expires & SendWatchdog() -%% !Pending SetWatchdog() -%% Pending = TRUE OKAY -%% REOPEN Timer expires & SendWatchdog() -%% !Pending SetWatchdog() -%% Pending = TRUE REOPEN - -timeout(#watchdog{status = T, - pending = false} - = S) - when T == okay; - T == reopen -> - send_watchdog(S); - -%% OKAY Timer expires & Failover() -%% Pending SetWatchdog() SUSPECT - -timeout(#watchdog{status = okay, - pending = true} - = S) -> - failover(S), - S#watchdog{status = suspect}; - -%% SUSPECT Timer expires CloseConnection() -%% SetWatchdog() DOWN -%% REOPEN Timer expires & CloseConnection() -%% Pending & SetWatchdog() -%% NumDWA < 0 DOWN - -timeout(#watchdog{status = T, - pending = P, - num_dwa = N, - transport = TPid} - = S) - when T == suspect; - T == reopen, P, N < 0 -> - exit(TPid, shutdown), - close(S), - S#watchdog{status = down}; - -%% REOPEN Timer expires & NumDWA = -1 -%% Pending & SetWatchdog() -%% NumDWA >= 0 REOPEN - -timeout(#watchdog{status = reopen, - pending = true, - num_dwa = N} - = S) - when 0 =< N -> - S#watchdog{num_dwa = -1}; - -%% DOWN Timer expires AttemptOpen() -%% SetWatchdog() DOWN -%% INITIAL Timer expires AttemptOpen() -%% SetWatchdog() INITIAL - -%% RFC 3539, 3.4.1: -%% -%% [5] While the connection is in the closed state, the AAA client MUST -%% NOT attempt to send further watchdog messages on the connection. -%% However, after the connection is closed, the AAA client continues -%% to periodically attempt to reopen the connection. -%% -%% The AAA client SHOULD wait for the transport layer to report -%% connection failure before attempting again, but MAY choose to -%% bound this wait time by the watchdog interval, Tw. - -%% Don't bound, restarting the peer process only when the previous -%% process has died. We only need to handle state down since we start -%% the first watchdog when transitioning out of initial. - -timeout(#watchdog{status = down} = S) -> - restart(S). - -%% restart/1 - -restart(#watchdog{transport = undefined} = S) -> - restart(getr(restart), S); -restart(S) -> - S. - -%% Only restart the transport in the connecting case. For an accepting -%% transport, we've registered the peer connection when leaving state -%% initial and this is used by a new accepting process to realize that -%% it's actually in state down rather then initial when receiving -%% notification of an open connection. - -restart({{connect, _} = T, Opts, Svc}, #watchdog{parent = Pid} = S) -> - Pid ! {reconnect, self()}, - S#watchdog{transport = monitor(diameter_peer_fsm:start(T, Opts, Svc))}; -restart({{accept, _}, _, _}, S) -> - S. -%% Don't currently use Opts/Svc in the accept case but having them in -%% the process dictionary is helpful if the process dies unexpectedly. - -%% dwr/1 - -dwr(#diameter_caps{origin_host = OH, - origin_realm = OR, - origin_state_id = OSI}) -> - ['DWR', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Origin-State-Id', OSI}]. diff --git a/lib/diameter/src/app/diameter_watchdog_sup.erl b/lib/diameter/src/app/diameter_watchdog_sup.erl deleted file mode 100644 index fc837fe4ef..0000000000 --- a/lib/diameter/src/app/diameter_watchdog_sup.erl +++ /dev/null @@ -1,60 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% Supervisor for all watchdog processes. -%% - --module(diameter_watchdog_sup). - --behaviour(supervisor). - -%% interface --export([start_link/0, %% supervisor start - start_child/1]). %% watchdog start - --export([init/1]). - --define(NAME, ?MODULE). %% supervisor name - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% Start a watchdog process. - -start_child(T) -> - supervisor:start_child(?NAME, [T]). - -%% init/1 - -init([]) -> - Mod = diameter_watchdog, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/modules.mk b/lib/diameter/src/app/modules.mk deleted file mode 100644 index ea4c58bfd7..0000000000 --- a/lib/diameter/src/app/modules.mk +++ /dev/null @@ -1,70 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %CopyrightBegin% -# -# Copyright Ericsson AB 2010-2011. All Rights Reserved. -# -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. -# -# %CopyrightEnd% - -DICTIONARIES = \ - base_rfc3588 \ - base_accounting \ - relay - -RUNTIME_MODULES = \ - diameter \ - diameter_app \ - diameter_capx \ - diameter_config \ - diameter_codec \ - diameter_dict \ - diameter_lib \ - diameter_misc_sup \ - diameter_peer \ - diameter_peer_fsm \ - diameter_peer_fsm_sup \ - diameter_reg \ - diameter_service \ - diameter_service_sup \ - diameter_session \ - diameter_stats \ - diameter_sup \ - diameter_sync \ - diameter_types \ - diameter_watchdog \ - diameter_watchdog_sup - -HELP_MODULES = \ - diameter_callback \ - diameter_exprecs \ - diameter_dbg \ - diameter_info - -INTERNAL_HRL_FILES = \ - diameter_internal.hrl \ - diameter_types.hrl - -EXTERNAL_HRL_FILES = \ - ../../include/diameter.hrl \ - ../../include/diameter_gen.hrl - -EXAMPLE_FILES = \ - ../../examples/GNUmakefile \ - ../../examples/peer.erl \ - ../../examples/client.erl \ - ../../examples/client_cb.erl \ - ../../examples/server.erl \ - ../../examples/server_cb.erl \ - ../../examples/relay.erl \ - ../../examples/relay_cb.erl |