aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/src/app
diff options
context:
space:
mode:
Diffstat (limited to 'lib/diameter/src/app')
-rw-r--r--lib/diameter/src/app/.gitignore6
-rw-r--r--lib/diameter/src/app/Makefile215
-rw-r--r--lib/diameter/src/app/depend.sed31
-rw-r--r--lib/diameter/src/app/diameter.app.src28
-rw-r--r--lib/diameter/src/app/diameter.appup.src47
-rw-r--r--lib/diameter/src/app/diameter.erl190
-rw-r--r--lib/diameter/src/app/diameter.mk.in47
-rw-r--r--lib/diameter/src/app/diameter_app.erl36
-rw-r--r--lib/diameter/src/app/diameter_callback.erl91
-rw-r--r--lib/diameter/src/app/diameter_capx.erl405
-rw-r--r--lib/diameter/src/app/diameter_codec.erl561
-rw-r--r--lib/diameter/src/app/diameter_config.erl676
-rw-r--r--lib/diameter/src/app/diameter_dbg.erl516
-rw-r--r--lib/diameter/src/app/diameter_dict.erl153
-rw-r--r--lib/diameter/src/app/diameter_exprecs.erl301
-rw-r--r--lib/diameter/src/app/diameter_info.erl869
-rw-r--r--lib/diameter/src/app/diameter_internal.hrl80
-rw-r--r--lib/diameter/src/app/diameter_lib.erl272
-rw-r--r--lib/diameter/src/app/diameter_misc_sup.erl58
-rw-r--r--lib/diameter/src/app/diameter_peer.erl225
-rw-r--r--lib/diameter/src/app/diameter_peer_fsm.erl777
-rw-r--r--lib/diameter/src/app/diameter_peer_fsm_sup.erl63
-rw-r--r--lib/diameter/src/app/diameter_reg.erl327
-rw-r--r--lib/diameter/src/app/diameter_service.erl2903
-rw-r--r--lib/diameter/src/app/diameter_service_sup.erl64
-rw-r--r--lib/diameter/src/app/diameter_session.erl172
-rw-r--r--lib/diameter/src/app/diameter_stats.erl342
-rw-r--r--lib/diameter/src/app/diameter_sup.erl101
-rw-r--r--lib/diameter/src/app/diameter_sync.erl550
-rw-r--r--lib/diameter/src/app/diameter_types.erl537
-rw-r--r--lib/diameter/src/app/diameter_types.hrl139
-rw-r--r--lib/diameter/src/app/diameter_watchdog.erl571
-rw-r--r--lib/diameter/src/app/diameter_watchdog_sup.erl60
-rw-r--r--lib/diameter/src/app/modules.mk70
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