diff options
Diffstat (limited to 'lib/diameter/src')
57 files changed, 16368 insertions, 0 deletions
diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile new file mode 100644 index 0000000000..6935eb053e --- /dev/null +++ b/lib/diameter/src/Makefile @@ -0,0 +1,43 @@ +# +# %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 +include $(ERL_TOP)/make/$(TARGET)/otp.mk +else +include $(DIAMETER_TOP)/make/target.mk +include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk +endif + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- + +include subdirs.mk + +SPECIAL_TARGETS = + +# ---------------------------------------------------- +# Default Subdir Targets +# ---------------------------------------------------- +ifneq ($(ERL_TOP),) +include $(ERL_TOP)/make/otp_subdir.mk +else +include $(DIAMETER_TOP)/make/subdir.mk +endif +#include ../make/subdir.mk diff --git a/lib/diameter/src/app/.gitignore b/lib/diameter/src/app/.gitignore new file mode 100644 index 0000000000..1310a0da6b --- /dev/null +++ b/lib/diameter/src/app/.gitignore @@ -0,0 +1,5 @@ + +/diameter_gen_*.erl +/diameter_gen_*.hrl +/depend.mk + diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile new file mode 100644 index 0000000000..8985ca4911 --- /dev/null +++ b/lib/diameter/src/app/Makefile @@ -0,0 +1,199 @@ +# +# %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 + +SPEC_ERL_FILES = \ + $(SPEC_FILES:%.dia=%.erl) + +SPEC_HRL_FILES = \ + $(SPEC_FILES:%.dia=%.hrl) + +APP_MODULES = \ + $(MODULES) \ + $(SPEC_FILES:%.dia=%) + +TARGET_FILES = \ + $(APP_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) $(SPEC_ERL_FILES) $(SPEC_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 "SPEC_FILES = $(FILES)" + @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 +# ---------------------------------------------------- + +# Generate the app file and then modules into in. This shouldn't know +# about ../{compiler,transport} but good enough for now. +$(APP_TARGET): $(APP_SRC) \ + ../../vsn.mk \ + modules.mk \ + ../compiler/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 ../compiler $(APP_TARGET) APP_TARGET=$(APP_TARGET) + $(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) + +# erl/hrl from application spec +diameter_gen_%.erl diameter_gen_%.hrl: diameter_gen_%.dia + ../../bin/diameterc -i $(EBIN) -o $(@D) $< + + +# ---------------------------------------------------- +# 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)/include + $(INSTALL_DIR) $(RELSYSDIR)/examples + $(INSTALL_SCRIPT) $(ESCRIPT_FILES) $(RELSYSDIR)/bin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(MODULES:%=%.erl) $(SPEC_ERL_FILES) $(RELSYSDIR)/src/app + $(INSTALL_DATA) $(SPEC_FILES) $(RELSYSDIR)/src/app + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src/app + $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(SPEC_HRL_FILES) $(RELSYSDIR)/include + $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples + +release_docs_spec: + +# ---------------------------------------------------- +# Dependencies +# ---------------------------------------------------- + +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) modules.mk Makefile + (for f in $(MODULES); do \ + sed -f $< $$f.erl | sed "s@/@/$$f@"; \ + done) \ + > $@ + +-include depend.mk + +.PRECIOUS: $(SPEC_ERL_FILES) $(SPEC_HRL_FILES) +.PHONY: app clean debug depend info opt compiler release_spec release_docs_spec diff --git a/lib/diameter/src/app/depend.sed b/lib/diameter/src/app/depend.sed new file mode 100644 index 0000000000..9df0133960 --- /dev/null +++ b/lib/diameter/src/app/depend.sed @@ -0,0 +1,31 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010-2011. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# Extract 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 new file mode 100644 index 0000000000..119997953e --- /dev/null +++ b/lib/diameter/src/app/diameter.app.src @@ -0,0 +1,28 @@ +%% +%% %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%,%COMPILER_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 new file mode 100644 index 0000000000..2b96153575 --- /dev/null +++ b/lib/diameter/src/app/diameter.appup.src @@ -0,0 +1,27 @@ +%% 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%", + [ + ], + [ + ] +}. + diff --git a/lib/diameter/src/app/diameter.erl b/lib/diameter/src/app/diameter.erl new file mode 100644 index 0000000000..5f2ab82475 --- /dev/null +++ b/lib/diameter/src/app/diameter.erl @@ -0,0 +1,212 @@ +%% +%% %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/1, + 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]). + +%% Backwards compatibility. +-export([add_connector/2, + add_listener/2, + remove_connector/2, + remove_listener/2]). + +-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/[12] +%%% -------------------------------------------------------------------------- + +-spec service_info(service_name(), atom() | [atom()]) + -> any(). + +service_info(SvcName, Option) -> + diameter_service:info(SvcName, Option). + +service_info(SvcName) -> + service_info(SvcName, all). + +%%% -------------------------------------------------------------------------- +%%% 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). + +add_listener(SvcName, Opts) -> + add_transport(SvcName, {listen, Opts}). + +add_connector(SvcName, Opts) -> + add_transport(SvcName, {connect, Opts}). + +%%% -------------------------------------------------------------------------- +%%% remove_transport/2 +%%% -------------------------------------------------------------------------- + +-spec remove_transport(service_name(), transport_pred()) + -> ok | {error, term()}. + +remove_transport(SvcName, Pred) -> + diameter_config:remove_transport(SvcName, Pred). + +remove_listener(SvcName, Pred) -> + remove_transport(SvcName, {listen, Pred}). + +remove_connector(SvcName, Pred) -> + remove_transport(SvcName, {connect, 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 new file mode 100644 index 0000000000..c161064303 --- /dev/null +++ b/lib/diameter/src/app/diameter.mk.in @@ -0,0 +1,47 @@ +#-*-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 new file mode 100644 index 0000000000..600f7ff04d --- /dev/null +++ b/lib/diameter/src/app/diameter_app.erl @@ -0,0 +1,36 @@ +%% +%% %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 new file mode 100644 index 0000000000..fcf9a8fc1e --- /dev/null +++ b/lib/diameter/src/app/diameter_callback.erl @@ -0,0 +1,91 @@ +%% +%% %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) -> + Pkt. + +%%% ---------------------------------------------------------- +%%% # prepare_retransmit/3 +%%% ---------------------------------------------------------- + +prepare_retransmit(Pkt, _SvcName, _Peer) -> + Pkt. + +%%% ---------------------------------------------------------- +%%% # handle_request/3 +%%% ---------------------------------------------------------- + +handle_request(_Pkt, _SvcName, _Peer) -> + discard. + +%%% ---------------------------------------------------------- +%%% # handle_answer/4 +%%% ---------------------------------------------------------- + +handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) -> + {ok, 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 new file mode 100644 index 0000000000..aa5318e79d --- /dev/null +++ b/lib/diameter/src/app/diameter_capx.erl @@ -0,0 +1,388 @@ +%% +%% %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). + +%% =========================================================================== + +-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'()], #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]; + +%% Not documented but accept it as long as it's what we support. +cap('Inband-Security-Id', [0] = Vs) -> %% NO_INBAND_SECURITY + Vs; + +cap(K, Vs) when K /= 'Inband-Security-Id', 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. + +bCER(#diameter_caps{origin_host = Host, + origin_realm = Realm, + host_ip_address = Addrs, + vendor_id = Vid, + product_name = Name, + origin_state_id = OSI, + supported_vendor_id = SVid, + auth_application_id = AuId, + acct_application_id = AcId, + vendor_specific_application_id = VSA, + firmware_revision = Rev}) -> + #diameter_base_CER{'Origin-Host' = Host, + 'Origin-Realm' = Realm, + 'Host-IP-Address' = Addrs, + 'Vendor-Id' = Vid, + 'Product-Name' = Name, + 'Origin-State-Id' = OSI, + 'Supported-Vendor-Id' = SVid, + 'Auth-Application-Id' = AuId, + 'Acct-Application-Id' = AcId, + 'Vendor-Specific-Application-Id' = VSA, + 'Firmware-Revision' = Rev}. + +%% 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. + +%% TODO: Make it an option to send only common applications in CEA to +%% allow backwards compatibility, and also because there are likely +%% servers that expect this. Or maybe a callback. + +%% 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. + +rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> + #diameter_base_CER{'Inband-Security-Id' = RIS} + = CER, + #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, + RIS, + lists:member(?NO_INBAND_SECURITY, RIS), + CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS, + 'Inband-Security-Id' = []})}. + +%% TODO: 5.3 of RFC3588 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(true, _, _, CEA) -> + CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; +build_CEA(false, [_|_], false, CEA) -> + CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; +build_CEA(false, [_|_], true, CEA) -> + CEA#diameter_base_CEA{'Inband-Security-Id' = [?NO_INBAND_SECURITY]}; +build_CEA(false, [], false, CEA) -> + CEA. + +%% cea_from_cer/1 + +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:'#info-'(diameter_base_CEA, {index, Field}) of + N -> + setelement(N, CEA, ?BASE:'#get-'(Field, CER)) + catch + error: _ -> + CEA + end. + +%% rCEA/2 + +rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) + when is_record(CEA, diameter_base_CEA) -> + #diameter_base_CEA{'Result-Code' = RC} + = CEA, + + RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), + + RCaps = capx_to_caps(CEA), + SApps = common_applications(LCaps, RCaps, Svc), + + [] == SApps andalso ?THROW({no_common_apps, LCaps, RCaps}), + + {SApps, 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 new file mode 100644 index 0000000000..f6cbde5446 --- /dev/null +++ b/lib/diameter/src/app/diameter_codec.erl @@ -0,0 +1,569 @@ +%% +%% %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) bsl N). + +bit(true) -> 1; +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 bor choose(P, 2#01000000, 0); +p(Flags, _) -> + Flags. + +%% The header below is that of the incoming request being answered, +%% not of the answer (which hasn't been encoded yet). + +h(Mod, 'answer-message' = MsgName, Header) -> + ?BASE = Mod, + #diameter_header{is_request = true, + cmd_code = Code} + = Header, + {_, Flags, ApplId} = ?BASE:msg_header(MsgName), + {Code, Flags, ApplId}; + +h(Mod, MsgName, #diameter_header{is_request = true, + cmd_code = Code}) -> + {Code, _, _} = Mod:msg_header(MsgName); %% ensure Code + +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{errors = lists:reverse(Avps)}; +%% 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 new file mode 100644 index 0000000000..42c70890b3 --- /dev/null +++ b/lib/diameter/src/app/diameter_config.erl @@ -0,0 +1,681 @@ +%% +%% %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) -> + warning_msg("received unexpected request from ~p:~n~w", [From, Req]), + Reply = {error, {bad_request, Req}}, + {reply, Reply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast/2 +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + warning_msg("received unexpected message:~n~w", [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) -> + warning_msg("received unknown info:~n~w", [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). + +%% warning_msg/2 + +warning_msg(F, A) -> + ?diameter_warning("~p: " ++ F, [?MODULE | A]). diff --git a/lib/diameter/src/app/diameter_dbg.erl b/lib/diameter/src/app/diameter_dbg.erl new file mode 100644 index 0000000000..b18f34e13d --- /dev/null +++ b/lib/diameter/src/app/diameter_dbg.erl @@ -0,0 +1,565 @@ +%% +%% %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/4 +%%% +%%% Called to have something to trace on for happenings of interest. +%%% ---------------------------------------------------------- + +log(_Slogan, _Mod, _Line, _Details) -> + ok. + +%%% ---------------------------------------------------------- +%%% # help() +%%% ---------------------------------------------------------- + +help() -> + ?INFO:usage(usage()). + +usage() -> + 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(diameter_service = T) -> + Fs = [name, started] ++ fields(T) ++ [peerT, + connT, + share_peers, + use_shared_peers, + shared_peers, + local_peers, + monitor], + ?INFO:format(T, + fun(R) -> + [I,N,S|Vs] = ?VALUES(R), + {Fs, [N,I] ++ ?VALUES(S) ++ Vs} + end, + fun ?INFO:split/2); + +table(Table) + when is_atom(Table) -> + case fields(Table) of + undefined = No -> + No; + Fields -> + ?INFO:format(Table, Fields, fun ?INFO:split/2) + end. + +%%% ---------------------------------------------------------- +%%% # 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() -> + format_all(fun ?INFO:split/3). + +format_all(SplitFun) -> + ?INFO:format(field(?LOCAL), SplitFun, fun collect/1). + +field(Tables) -> + lists:map(fun(T) -> {T, fields(T)} end, lists:sort(Tables)). + +%%% ---------------------------------------------------------- +%%% # 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, dbg(T)). + +tp(T) -> + dbg(tp, dbg(T)). + +%% dbg/1 + +dbg(x) -> + [{M, x, []} || M <- [diameter_tcp, + diameter_etcp, + diameter_sctp, + diameter_peer_fsm, + diameter_watchdog]]; + +dbg(log) -> + {?MODULE, log, 4}; + +dbg({log = F, Mods}) + when is_list(Mods) -> + {?MODULE, F, [{['_','$1','_','_'], + [?ORCOND([{'==', '$1', M} || M <- Mods])], + []}]}; + +dbg({log = F, Mod}) -> + dbg({F, [Mod]}); + +dbg(send) -> + {diameter_peer, send, 2}; + +dbg(recv) -> + {diameter_peer, recv, 2}; + +dbg(sendrecv) -> + [{diameter_peer, send, 2}, + {diameter_peer, recv, 2}]; + +dbg(decode) -> + [{diameter_codec,decode,2}]; + +dbg(encode) -> + [{diameter_codec,encode,2,[]}, + {diameter_codec,encode,3,[]}, + {diameter_codec,encode,4}]; + +dbg(transition = T) -> + [{?MODULE, log, [{[T,M,'_','_'],[],[]}]} + || M <- [diameter_watchdog, diameter_peer_fsm]]; + +dbg(T) -> + T. + +%% dbg/2 + +dbg(TF, L) + when is_list(L) -> + {ok, lists:foldl(fun(T,A) -> {ok, X} = dbg(TF, T), [X|A] end, [], L)}; + +dbg(F, M) + when is_atom(M) -> + dbg(F, {M}); + +dbg(F, T) + when is_tuple(T) -> + [_|_] = A = tuple_to_list(T), + {ok,_} = apply(dbg, F, case is_list(lists:last(A)) of + false -> + A ++ [[{'_',[],[{exception_trace}]}]]; + true -> + A + end). + +%% =========================================================================== +%% =========================================================================== + +%% 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, {Cs,As}) -> + mk_peer(Name, connector, Cs) ++ mk_peer(Name, acceptor, As). + +mk_peer(Name, T, Ts) -> + [[Name | mk_peer(T,Vs)] || Vs <- Ts]. + +mk_peer(Type, Vs) -> + [Ref, State, Opts, WPid, TPid, SApps, Caps] + = get_values(Vs, [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; + +%% Collect states from watchdog/transport pids. +s(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); +?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 new file mode 100644 index 0000000000..3b9ba00a3f --- /dev/null +++ b/lib/diameter/src/app/diameter_dict.erl @@ -0,0 +1,153 @@ +%% +%% %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 new file mode 100644 index 0000000000..5e120d6f44 --- /dev/null +++ b/lib/diameter/src/app/diameter_exprecs.erl @@ -0,0 +1,301 @@ +%% +%% %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_gen_base_accounting.dia b/lib/diameter/src/app/diameter_gen_base_accounting.dia new file mode 100644 index 0000000000..64e95dddb5 --- /dev/null +++ b/lib/diameter/src/app/diameter_gen_base_accounting.dia @@ -0,0 +1,68 @@ +;; +;; %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% +;; + +@id 3 +@prefix diameter_base_accounting +@vendor 0 IETF + +@inherits diameter_gen_base_rfc3588 + +@messages + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Reporting-Host ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] diff --git a/lib/diameter/src/app/diameter_gen_base_rfc3588.dia b/lib/diameter/src/app/diameter_gen_base_rfc3588.dia new file mode 100644 index 0000000000..4a12e21acd --- /dev/null +++ b/lib/diameter/src/app/diameter_gen_base_rfc3588.dia @@ -0,0 +1,413 @@ +;; +;; %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% +;; + +@id 0 +@prefix diameter_base +@vendor 0 IETF + +@avp_types + + Acct-Interim-Interval 85 Unsigned32 M + Accounting-Realtime-Required 483 Enumerated M + Acct-Multi-Session-Id 50 UTF8String M + Accounting-Record-Number 485 Unsigned32 M + Accounting-Record-Type 480 Enumerated M + Acct-Session-Id 44 OctetString M + Accounting-Sub-Session-Id 287 Unsigned64 M + Acct-Application-Id 259 Unsigned32 M + Auth-Application-Id 258 Unsigned32 M + Auth-Request-Type 274 Enumerated M + Authorization-Lifetime 291 Unsigned32 M + Auth-Grace-Period 276 Unsigned32 M + Auth-Session-State 277 Enumerated M + Re-Auth-Request-Type 285 Enumerated M + Class 25 OctetString M + Destination-Host 293 DiamIdent M + Destination-Realm 283 DiamIdent M + Disconnect-Cause 273 Enumerated M + E2E-Sequence 300 Grouped M + Error-Message 281 UTF8String - + Error-Reporting-Host 294 DiamIdent - + Event-Timestamp 55 Time M + Experimental-Result 297 Grouped M + Experimental-Result-Code 298 Unsigned32 M + Failed-AVP 279 Grouped M + Firmware-Revision 267 Unsigned32 - + Host-IP-Address 257 Address M + Inband-Security-Id 299 Unsigned32 M + Multi-Round-Time-Out 272 Unsigned32 M + Origin-Host 264 DiamIdent M + Origin-Realm 296 DiamIdent M + Origin-State-Id 278 Unsigned32 M + Product-Name 269 UTF8String - + Proxy-Host 280 DiamIdent M + Proxy-Info 284 Grouped M + Proxy-State 33 OctetString M + Redirect-Host 292 DiamURI M + Redirect-Host-Usage 261 Enumerated M + Redirect-Max-Cache-Time 262 Unsigned32 M + Result-Code 268 Unsigned32 M + Route-Record 282 DiamIdent M + Session-Id 263 UTF8String M + Session-Timeout 27 Unsigned32 M + Session-Binding 270 Unsigned32 M + Session-Server-Failover 271 Enumerated M + Supported-Vendor-Id 265 Unsigned32 M + Termination-Cause 295 Enumerated M + User-Name 1 UTF8String M + Vendor-Id 266 Unsigned32 M + Vendor-Specific-Application-Id 260 Grouped M + +@messages + + CER ::= < Diameter Header: 257, REQ > + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + CEA ::= < Diameter Header: 257 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + [ Error-Message ] + * [ Failed-AVP ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + DPR ::= < Diameter Header: 282, REQ > + { Origin-Host } + { Origin-Realm } + { Disconnect-Cause } + + DPA ::= < Diameter Header: 282 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + * [ Failed-AVP ] + + DWR ::= < Diameter Header: 280, REQ > + { Origin-Host } + { Origin-Realm } + [ Origin-State-Id ] + + DWA ::= < Diameter Header: 280 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + * [ Failed-AVP ] + [ Origin-State-Id ] + + answer-message ::= < Diameter Header: code, ERR [PXY] > + 0*1< Session-Id > + { Origin-Host } + { Origin-Realm } + { Result-Code } + [ Origin-State-Id ] + [ Error-Reporting-Host ] + [ Proxy-Info ] + * [ AVP ] + + RAR ::= < Diameter Header: 258, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + { Re-Auth-Request-Type } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + RAA ::= < Diameter Header: 258, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + STR ::= < Diameter Header: 275, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Auth-Application-Id } + { Termination-Cause } + [ User-Name ] + [ Destination-Host ] + * [ Class ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + STA ::= < Diameter Header: 275, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + * [ Class ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + [ Origin-State-Id ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ASR ::= < Diameter Header: 274, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ASA ::= < Diameter Header: 274, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + * [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Reporting-Host ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] + +@enum Disconnect-Cause + + REBOOTING 0 + BUSY 1 + DO_NOT_WANT_TO_TALK_TO_YOU 2 + +@enum Redirect-Host-Usage + + DONT_CACHE 0 + ALL_SESSION 1 + ALL_REALM 2 + REALM_AND_APPLICATION 3 + ALL_APPLICATION 4 + ALL_HOST 5 + ALL_USER 6 + +@enum Auth-Request-Type + + AUTHENTICATE_ONLY 1 + AUTHORIZE_ONLY 2 + AUTHORIZE_AUTHENTICATE 3 + +@enum Auth-Session-State + + STATE_MAINTAINED 0 + NO_STATE_MAINTAINED 1 + +@enum Re-Auth-Request-Type + + AUTHORIZE_ONLY 0 + AUTHORIZE_AUTHENTICATE 1 + +@enum Termination-Cause + + DIAMETER_LOGOUT 1 + DIAMETER_SERVICE_NOT_PROVIDED 2 + DIAMETER_BAD_ANSWER 3 + DIAMETER_ADMINISTRATIVE 4 + DIAMETER_LINK_BROKEN 5 + DIAMETER_AUTH_EXPIRED 6 + DIAMETER_USER_MOVED 7 + DIAMETER_SESSION_TIMEOUT 8 + +@enum Session-Server-Failover + + REFUSE_SERVICE 0 + TRY_AGAIN 1 + ALLOW_SERVICE 2 + TRY_AGAIN_ALLOW_SERVICE 3 + +@enum Accounting-Record-Type + + EVENT_RECORD 1 + START_RECORD 2 + INTERIM_RECORD 3 + STOP_RECORD 4 + +@enum Accounting-Realtime-Required + + DELIVER_AND_GRANT 1 + GRANT_AND_STORE 2 + GRANT_AND_LOSE 3 + +@result_code Result-Code + +;; 7.1.1. Informational + DIAMETER_MULTI_ROUND_AUTH 1001 + +;; 7.1.2. Success + DIAMETER_SUCCESS 2001 + DIAMETER_LIMITED_SUCCESS 2002 + +;; 7.1.3. Protocol Errors + DIAMETER_COMMAND_UNSUPPORTED 3001 + DIAMETER_UNABLE_TO_DELIVER 3002 + DIAMETER_REALM_NOT_SERVED 3003 + DIAMETER_TOO_BUSY 3004 + DIAMETER_LOOP_DETECTED 3005 + DIAMETER_REDIRECT_INDICATION 3006 + DIAMETER_APPLICATION_UNSUPPORTED 3007 + DIAMETER_INVALID_HDR_BITS 3008 + DIAMETER_INVALID_AVP_BITS 3009 + DIAMETER_UNKNOWN_PEER 3010 + +;; 7.1.4. Transient Failures + DIAMETER_AUTHENTICATION_REJECTED 4001 + DIAMETER_OUT_OF_SPACE 4002 + ELECTION_LOST 4003 + +;; 7.1.5. Permanent Failures + DIAMETER_AVP_UNSUPPORTED 5001 + DIAMETER_UNKNOWN_SESSION_ID 5002 + DIAMETER_AUTHORIZATION_REJECTED 5003 + DIAMETER_INVALID_AVP_VALUE 5004 + DIAMETER_MISSING_AVP 5005 + DIAMETER_RESOURCES_EXCEEDED 5006 + DIAMETER_CONTRADICTING_AVPS 5007 + DIAMETER_AVP_NOT_ALLOWED 5008 + DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009 + DIAMETER_NO_COMMON_APPLICATION 5010 + DIAMETER_UNSUPPORTED_VERSION 5011 + DIAMETER_UNABLE_TO_COMPLY 5012 + DIAMETER_INVALID_BIT_IN_HEADER 5013 + DIAMETER_INVALID_AVP_LENGTH 5014 + DIAMETER_INVALID_MESSAGE_LENGTH 5015 + DIAMETER_INVALID_AVP_BIT_COMBO 5016 + DIAMETER_NO_COMMON_SECURITY 5017 + +@grouped + + Proxy-Info ::= < AVP Header: 284 > + { Proxy-Host } + { Proxy-State } + * [ AVP ] + + Failed-AVP ::= < AVP Header: 279 > + 1* {AVP} + + Experimental-Result ::= < AVP Header: 297 > + { Vendor-Id } + { Experimental-Result-Code } + + Vendor-Specific-Application-Id ::= < AVP Header: 260 > + 1* { Vendor-Id } + [ Auth-Application-Id ] + [ Acct-Application-Id ] + +;; The E2E-Sequence AVP is defined in RFC 3588 as Grouped, but +;; there is no definition of the group - only an informal text stating +;; that there should be a nonce (an OctetString) and a counter +;; (integer) +;; + E2E-Sequence ::= <AVP Header: 300 > + 2* { AVP } diff --git a/lib/diameter/src/app/diameter_gen_relay.dia b/lib/diameter/src/app/diameter_gen_relay.dia new file mode 100644 index 0000000000..d86446e368 --- /dev/null +++ b/lib/diameter/src/app/diameter_gen_relay.dia @@ -0,0 +1,24 @@ +;; +;; %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% +;; + +@id 0xFFFFFFFF +@prefix diameter_relay +@vendor 0 IETF + +@inherits diameter_gen_base_rfc3588 diff --git a/lib/diameter/src/app/diameter_info.erl b/lib/diameter/src/app/diameter_info.erl new file mode 100644 index 0000000000..39d32d07cd --- /dev/null +++ b/lib/diameter/src/app/diameter_info.erl @@ -0,0 +1,869 @@ +%% +%% %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 new file mode 100644 index 0000000000..9de3914830 --- /dev/null +++ b/lib/diameter/src/app/diameter_internal.hrl @@ -0,0 +1,95 @@ +%% +%% %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()). + +%% Info report for anything unexpected. +-define(REPORT(Reason, Func, Args), + diameter_lib:report(Reason, {?MODULE, Func, Args})). + +%% Something to trace on. +-define(LOG(Slogan, Details), + diameter_dbg: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}). + +%%%---------------------------------------------------------------------- +%%% Error/warning/info message macro(s) +%%%---------------------------------------------------------------------- + +-define(diameter_info(F, A), + (catch error_logger:info_msg("[ ~w : ~w : ~p ] ~n" ++ F ++ "~n", + [?APPLICATION, ?MODULE, self()|A]))). + +-define(diameter_warning(F, A), + (catch error_logger:warning_msg("[ ~w : ~w : ~p ] ~n" ++ F ++ "~n", + [?APPLICATION, ?MODULE, self()|A]))). + +-define(diameter_error(F, A), + (catch error_logger:error_msg("[ ~w : ~w : ~p ] ~n" ++ F ++ "~n", + [?APPLICATION, ?MODULE, self()|A]))). diff --git a/lib/diameter/src/app/diameter_lib.erl b/lib/diameter/src/app/diameter_lib.erl new file mode 100644 index 0000000000..b5c0e1bf6a --- /dev/null +++ b/lib/diameter/src/app/diameter_lib.erl @@ -0,0 +1,266 @@ +%% +%% %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]). + +-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, {M,F,A}) -> + error_logger:info_report(" Reason: ~p~n" + " Pid: ~p~n" + " Node: ~p~n" + " Module: ~p~n" + " Function: ~p~n" + "Arguments: ~p~n", + [Reason, self(), node(), M, F, A]). + +%%% --------------------------------------------------------------------------- +%%% # 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([{reason, Reason}, {who, self()}, {where, node()}, {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, T) -> + element(2, lists:foldl(fun(X, {M,_} = A) -> {M+1, ft(X, A)} end, + {N, T0}, + lists:nthtail(N-1, tuple_to_list(T)))). + +ft(undefined, T) -> + T; +ft(X, {N, T}) -> + setelement(N, T, X). diff --git a/lib/diameter/src/app/diameter_misc_sup.erl b/lib/diameter/src/app/diameter_misc_sup.erl new file mode 100644 index 0000000000..4e40476f14 --- /dev/null +++ b/lib/diameter/src/app/diameter_misc_sup.erl @@ -0,0 +1,58 @@ +%% +%% %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 new file mode 100644 index 0000000000..6b8971b8ea --- /dev/null +++ b/lib/diameter/src/app/diameter_peer.erl @@ -0,0 +1,230 @@ +%% +%% %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) -> + warning_msg("received unexpected request from ~p:~n~w", [From, Req]), + {reply, nok, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + warning_msg("received unexpected message:~n~w", [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) -> + warning_msg("received unexpected info:~n~w", [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). + +%% warning_msg/2 + +warning_msg(F, A) -> + ?diameter_warning("~p: " ++ F, [?MODULE | A]). diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/app/diameter_peer_fsm.erl new file mode 100644 index 0000000000..0252fb3809 --- /dev/null +++ b/lib/diameter/src/app/diameter_peer_fsm.erl @@ -0,0 +1,746 @@ +%% +%% %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(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, close = C, Reason} -> + ?LOG(C, {Reason, T}), + x(Reason, State); + throw: {?MODULE, abort, Reason} -> + {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} + = S) -> + diameter_peer:close(TPid), + close(T,S); + +%% 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} = S) + when PS /= 'Open'; + Name == 'CER'; + Name == 'CEA' -> + close({Name, PS}, S); + +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, CEA} + = recv_CER(CER, S), + + try + [] == SupportedApps + andalso ?THROW({no_common_application, 5010}), + register_everywhere({?MODULE, connection, OH, DH}) + orelse ?THROW({election_lost, 4003}), + {CEA, [fun open/4, Pkt, SupportedApps, RCaps]} + 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 = Svc} + = 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, #diameter_caps{origin_host = DH} = RCaps} = recv_CEA(CEA, S), + + %% 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. + + #diameter_service{capabilities = #diameter_caps{origin_host = OH}} + = Svc, + + register_everywhere({?MODULE, connection, OH, DH}) + orelse + close({'CEA', DH}, S), + + open(DPkt, SApps, RCaps, S). + +%% recv_CEA/2 + +recv_CEA(CEA, #state{service = Svc} = S) -> + case diameter_capx:recv_CEA(CEA, Svc) of + {ok, {[], _}} -> + close({'CEA', no_common_application}, S); + {ok, T} -> + T; + {error, Reason} -> + close({'CEA', Reason}, S) + end. + +%% open/4 + +open(Pkt, SupportedApps, RCaps, #state{parent = Pid, + service = Svc} + = S) -> + #diameter_service{capabilities = #diameter_caps{origin_host = OH} + = LCaps} + = Svc, + #diameter_caps{origin_host = DH} + = RCaps, + Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, + S#state{state = 'Open'}. + +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 new file mode 100644 index 0000000000..995eaf74d0 --- /dev/null +++ b/lib/diameter/src/app/diameter_peer_fsm_sup.erl @@ -0,0 +1,63 @@ +%% +%% %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 new file mode 100644 index 0000000000..8e5f34c2c3 --- /dev/null +++ b/lib/diameter/src/app/diameter_reg.erl @@ -0,0 +1,331 @@ +%% +%% %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) -> + {reply, nok, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State)-> + warning_msg("received unexpected message:~n~w", [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) -> + warning_msg("received unknown info:~n~w", [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). + +%% warning_msg/2 + +warning_msg(F, A) -> + ?diameter_warning("~p: " ++ F, [?MODULE | A]). diff --git a/lib/diameter/src/app/diameter_service.erl b/lib/diameter/src/app/diameter_service.erl new file mode 100644 index 0000000000..82a8d7a994 --- /dev/null +++ b/lib/diameter/src/app/diameter_service.erl @@ -0,0 +1,2931 @@ +%% +%% %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) -> + ?REPORT(unknown_request, ?FUNC, [Req, From]), + {reply, nok, S}. + +%%% --------------------------------------------------------------------------- +%%% # handle_cast(Req, State) +%%% --------------------------------------------------------------------------- + +handle_cast(Req, S) -> + ?REPORT(unknown_request, ?FUNC, [Req]), + {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, _) -> + ?REPORT(unknown_request, ?FUNC, [Req]), + 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). + +%% =========================================================================== +%% =========================================================================== + +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. There are two +%% cases: a diameter_packet as argument when we're calling call/4 +%% ourselves in order to relay a request or a bare message in case the +%% call came by way of diameter:call/4. + +make_packet(Bin) + when is_binary(Bin) -> + #diameter_packet{header = diameter_codec:decode_header(Bin), + bin = Bin}; + +make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt) -> + Pkt; + +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 alternative 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, {_, OH, OR}, TPid, _, _, Pkt) -> + ?LOG({error, application}, Pkt), + reply(answer_message({OH, OR, 3007}, collect_avps(Pkt)), ?BASE, TPid, Pkt). + +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({_, OH, OR}, {TPid, _}, _, #diameter_packet{errors = [Bs | _], + bin = Bin, + avps = Avps} + = Pkt) + when is_bitstring(Bs) -> + ?LOG({error, invalid_avp_bits}, Bin), + reply(answer_message({OH, OR, 3009}, Avps), ?BASE, 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({_, OH, OR}, + {TPid, _}, + #diameter_app{id = Id}, + #diameter_packet{header = #diameter_header{is_proxiable = P}, + msg = M, + avps = Avps, + bin = Bin} + = Pkt) + when ?APP_ID_RELAY /= Id, undefined == M; + ?APP_ID_RELAY == Id, not P -> + ?LOG({error, command_unsupported}, Bin), + reply(answer_message({OH, OR, 3001}, Avps), ?BASE, 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({_, OH, OR}, + {TPid, _}, + _, + #diameter_packet{header = #diameter_header{is_error = true}, + avps = Avps, + bin = Bin} + = Pkt) -> + ?LOG({error, error_bit}, Bin), + reply(answer_message({OH, OR, 3008}, Avps), ?BASE, 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, _, _}, + {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], + %% Filter sender as ineligible receiver. + reply(call(SvcName, App, Msg, [{filter, {neg, {host, OH}}} | Opts]), + TPid, + Pkt). +%% The incoming request is relayed with the addition of a +%% Route-Record. Note the requirement on the return from call/4. +%% This places a requirement on the values returned by the +%% handle_answer and handle_error callbacks of the application module +%% in question. +%% +%% 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. + +%% reply/3 +%% +%% Relay a reply to a relayed request. + +%% Answer from the peer: reset the hop by hop identifier and send. +reply(#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 + +%% Not. Ignoring the error feels harsh but there is no appropriate +%% Result-Code for a protocol error (which this isn't really anyway) +%% and the RFC doesn't provide any guidance how to act. A weakness +%% here is that we don't deal well with a decode error: the request +%% will simply timeout on the peer's end. Better would be to just send +%% the answer (with modified hop by hop identifier) on regardless, at +%% least in the relay case in which there's no examination of the +%% answer. In the proxy case it's not clear that the callback won't +%% examine the answer. Just be quiet here since a decode error causes +%% the request process to crash (or not depending on the error and +%% config and/or handle_answer callback). +reply(_, _, _) -> + ok. + +%% 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. + +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}); + +%% Simplify the handling of error cases by accepting a list consisting +%% of an answer record followed by failed AVPs to be packed into a +%% Failed-AVP field, either directly or into an AVP field. Only if +%% the message is a tuple-list or record however, not a list +%% with a list of #diameter_header{} and #diameter_avp{}. +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 + +make_reply_packet(Bin, _) + when is_binary(Bin) -> + #diameter_packet{bin = Bin}; + +make_reply_packet([#diameter_header{} | _] = Msg, _) -> + #diameter_packet{msg = Msg}; + +make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) -> + #diameter_header{end_to_end_id = EId, + hop_by_hop_id = Hid, + is_proxiable = P} + = ReqHdr, + + Hdr = #diameter_header{version = ?DIAMETER_VERSION, + end_to_end_id = EId, + hop_by_hop_id = Hid, + is_proxiable = P, + 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{} = Avp} = find_avp(Code, Vid, Avps), + Avp + catch + error: _ -> + [] + end; + +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 +%%% --------------------------------------------------------------------------- + +%% 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))]. + +%% TODO: +%% +%% Should add some way of specifying destination directly so that the +%% only requirement is that the prepare_request callback returns +%% something specific. (eg. {host, DH}; that is, let the caller specify.) +%% +%% Also, there is no longer any need to call get_destination at all in +%% the default case. + +str(T) + when T == undefined; + T == [] -> + undefined; +str([X]) + when is_list(X) -> + X; +str(T) -> + T. + +%% get_avp_value/3 +%% +%% Support outgoing messages in 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; + +get_avp_value(Dict, Name, Rec) + when is_tuple(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. + +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, TC, {Ts, Fs}) -> + {[TC|Ts], Fs}; +pacc(true, false, TC, {Ts, Fs}) -> + {Ts, [TC|Fs]}; +pacc(false, _, _, Acc) -> + Acc. + +%% caps_filter/3 + +caps_filter(C, RH, {neg, F}) -> + not caps_filter(C, RH, F); + +caps_filter(C, RH, {all, L}) -> + lists:all(fun(F) -> caps_filter(C, RH, F) end, L); + +caps_filter(C, RH, {any, L}) -> + lists:any(fun(F) -> caps_filter(C, RH, F) end, L); + +caps_filter(#diameter_caps{origin_host = {_,H}}, [_,DH], host) -> + eq(undefined, DH, H); + +caps_filter(#diameter_caps{origin_realm = {_,R}}, [DR,_], realm) -> + eq(undefined, DR, R); + +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); + +caps_filter(C, T) -> + try + {eval, F} = T, + diameter_lib:eval([F,C]) + catch + _:_ -> false + end. + +eq(X, A, B) -> + X == A orelse A == B. + +%% 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 new file mode 100644 index 0000000000..153fff902f --- /dev/null +++ b/lib/diameter/src/app/diameter_service_sup.erl @@ -0,0 +1,64 @@ +%% +%% %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 new file mode 100644 index 0000000000..bb91e97f39 --- /dev/null +++ b/lib/diameter/src/app/diameter_session.erl @@ -0,0 +1,172 @@ +%% +%% %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 new file mode 100644 index 0000000000..b52d4cdcfb --- /dev/null +++ b/lib/diameter/src/app/diameter_stats.erl @@ -0,0 +1,347 @@ +%% +%% %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) -> + warning_msg("received unexpected request from ~p:~n~w", [From, Req]), + {reply, nok, State}. + +%% ---------------------------------------------------------- +%% handle_cast(Request, State) +%% ---------------------------------------------------------- + +handle_cast({incr, Rec}, State) -> + update_counter(Rec), + {noreply, State}; + +handle_cast(Msg, State) -> + warning_msg("received unexpected message:~n~w", [Msg]), + {noreply, State}. + +%% ---------------------------------------------------------- +%% handle_info(Request, State) +%% ---------------------------------------------------------- + +handle_info({'DOWN', _MRef, process, Pid, _}, State) -> + down(Pid), + {noreply, State}; + +handle_info(Info, State) -> + warning_msg("received unknown info:~n~w", [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). + +%% warning_msg/2 + +warning_msg(F, A) -> + ?diameter_warning("~p: " ++ F, [?MODULE | A]). diff --git a/lib/diameter/src/app/diameter_sup.erl b/lib/diameter/src/app/diameter_sup.erl new file mode 100644 index 0000000000..e5afd23dcd --- /dev/null +++ b/lib/diameter/src/app/diameter_sup.erl @@ -0,0 +1,101 @@ +%% +%% %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 new file mode 100644 index 0000000000..f7777ae809 --- /dev/null +++ b/lib/diameter/src/app/diameter_sync.erl @@ -0,0 +1,555 @@ +%% +%% %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, State), State}. + +%% call/2 + +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, _State) -> %% ignore + warning_msg("received unexpected request:~n~w", [Req]), + nok. + +%%% ---------------------------------------------------------- +%%% handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + warning_msg("received unexpected message:~n~w", [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) -> + warning_msg("received unknown info:~n~w", [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. + +%% warning_msg/2 + +warning_msg(F, A) -> + ?diameter_warning("~p: " ++ F, [?MODULE | A]). diff --git a/lib/diameter/src/app/diameter_types.erl b/lib/diameter/src/app/diameter_types.erl new file mode 100644 index 0000000000..6b1b1b8d39 --- /dev/null +++ b/lib/diameter/src/app/diameter_types.erl @@ -0,0 +1,537 @@ +%% +%% %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 new file mode 100644 index 0000000000..02bf8a74dd --- /dev/null +++ b/lib/diameter/src/app/diameter_types.hrl @@ -0,0 +1,139 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% 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 new file mode 100644 index 0000000000..b7c1491f4b --- /dev/null +++ b/lib/diameter/src/app/diameter_watchdog.erl @@ -0,0 +1,571 @@ +%% +%% %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 new file mode 100644 index 0000000000..fc837fe4ef --- /dev/null +++ b/lib/diameter/src/app/diameter_watchdog_sup.erl @@ -0,0 +1,60 @@ +%% +%% %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 new file mode 100644 index 0000000000..a7a78b1a9d --- /dev/null +++ b/lib/diameter/src/app/modules.mk @@ -0,0 +1,68 @@ +#-*-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% + +SPEC_FILES = \ + diameter_gen_base_rfc3588.dia \ + diameter_gen_base_accounting.dia \ + diameter_gen_relay.dia + +MODULES = \ + diameter \ + diameter_app \ + diameter_callback \ + diameter_capx \ + diameter_config \ + diameter_dbg \ + diameter_codec \ + diameter_dict \ + diameter_exprecs \ + diameter_info \ + 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 + +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 diff --git a/lib/diameter/src/compiler/.gitignore b/lib/diameter/src/compiler/.gitignore new file mode 100644 index 0000000000..d9f072e262 --- /dev/null +++ b/lib/diameter/src/compiler/.gitignore @@ -0,0 +1,3 @@ + +/depend.mk + diff --git a/lib/diameter/src/compiler/Makefile b/lib/diameter/src/compiler/Makefile new file mode 100644 index 0000000000..8512eb515a --- /dev/null +++ b/lib/diameter/src/compiler/Makefile @@ -0,0 +1,141 @@ +# +# %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 + +ERL_FILES = \ + $(MODULES:%=%.erl) + +TARGET_FILES = \ + $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ifeq ($(TYPE),debug) +ERL_COMPILE_FLAGS += -Ddebug +endif + +include ../app/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) + rm -f errs core *~ + rm -f depend.mk + +docs: + +info: + @echo "" + @echo "ERL_FILES = $(ERL_FILES)" + @echo "HRL_FILES = $(HRL_FILES)" + @echo "" + @echo "TARGET_FILES = $(TARGET_FILES)" + @echo "" + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +# Invoked from ../app to add modules to the app file. +$(APP_TARGET): force + M=`echo $(MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ + echo "/%COMPILER_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ + | ed -s $@ + +# ---------------------------------------------------- +# 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)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/src/compiler + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src/compiler + +release_docs_spec: + +force: + +# ---------------------------------------------------- +# Dependencies +# ---------------------------------------------------- + +depend: depend.mk + +# Generate dependencies makefile. +depend.mk: ../app/depend.sed $(ERL_FILES) modules.mk Makefile + for f in $(MODULES); do \ + sed -f $< $$f.erl | sed "s@/@/$$f@"; \ + done \ + > $@ + +-include depend.mk + +.PHONY: clean debug depend docs force info opt release_docs_spec release_spec diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl new file mode 100644 index 0000000000..213ba0d22c --- /dev/null +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -0,0 +1,788 @@ +%% +%% %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_codegen). + +%% +%% This module generates .erl and .hrl files for encode/decode +%% modules from the orddict parsed from a .dia (aka spec) file by +%% dis_spec_util. The generated code is very simple (one-liners), the +%% generated functions being called by code included from dis_gen.hrl +%% in order to encode/decode messages and AVPs. The orddict itself is +%% returned by dict/0 in the generated module and dis_spec_util calls +%% this function when importing spec files. (That is, beam has to be +%% compiled from an imported spec file before it can be imported.) +%% + +-export([from_spec/4]). + +%% Internal exports (for test). +-export([file/1, + file/2, + file/3]). + +-include_lib("diameter/src/app/diameter_internal.hrl"). +-include("diameter_forms.hrl"). + +%% Generated functions that could have no generated clauses will have +%% a trailing ?UNEXPECTED clause that should never execute. +-define(UNEXPECTED(N), {?clause, [?VAR('_') || _ <- lists:seq(1,N)], + [], + [?APPLY(erlang, + error, + [?TERM({unexpected, getr(module)})])]}). + + +from_spec(File, Spec, Opts, Mode) -> + Outdir = proplists:get_value(outdir, Opts, "."), + putr(verbose, lists:member(verbose, Opts)), + putr(debug, lists:member(debug, Opts)), + codegen(File, Spec, Outdir, Mode). + +%% Optional reports when running verbosely. +report(What, Data) -> + report(getr(verbose), What, Data), + Data. + +report(true, Tag, Data) -> + io:format(">>~n>> ~p ~p~n", [Tag, Data]); +report(false, _, _) -> + ok. + +putr(Key, Value) -> + put({?MODULE, Key}, Value). + +getr(Key) -> + get({?MODULE, Key}). + +%% =========================================================================== +%% =========================================================================== + +%% Generate from parsed spec in a file. + +file(F) -> + file(F, spec). + +file(F, Mode) -> + file(F, ".", Mode). + +file(F, Outdir, Mode) -> + {ok, [Spec]} = file:consult(F), + from_spec(F, Spec, Outdir, Mode). + +%% =========================================================================== +%% =========================================================================== + +choose(true, X, _) -> X; +choose(false, _, X) -> X. + +get_value(Key, Plist) -> + proplists:get_value(Key, Plist, []). + +write(Path, [C|_] = Spec) + when is_integer(C) -> + w(Path, Spec, "~s"); +write(Path, Spec) -> + w(Path, Spec, "~p."). + +w(Path, Spec, Fmt) -> + {ok, Fd} = file:open(Path, [write]), + io:fwrite(Fd, Fmt ++ "~n", [Spec]), + file:close(Fd). + +codegen(File, Spec, Outdir, Mode) -> + Mod = mod(File, orddict:find(name, Spec)), + Path = filename:join(Outdir, Mod), %% minus extension + gen(Mode, Spec, Mod, Path), + ok. + +mod(File, error) -> + filename:rootname(filename:basename(File)); +mod(_, {ok, Mod}) -> + atom_to_list(Mod). + +gen(spec, Spec, _Mod, Path) -> + write(Path ++ ".spec", Spec); + +gen(hrl, Spec, Mod, Path) -> + gen_hrl(Path ++ ".hrl", Mod, Spec); + +gen(erl = Mode, Spec, Mod, Path) + when is_list(Mod) -> + gen(Mode, Spec, list_to_atom(Mod), Path); + +gen(erl, Spec, Mod, Path) -> + putr(module, Mod), %% used by ?UNEXPECTED. + + Forms = [{?attribute, module, Mod}, + {?attribute, compile, [{parse_transform, diameter_exprecs}]}, + {?attribute, compile, [nowarn_unused_function]}, + {?attribute, export, [{name, 0}, + {id, 0}, + {vendor_id, 0}, + {vendor_name, 0}, + {decode_avps, 2}, %% in diameter_gen.hrl + {encode_avps, 2}, %% + {msg_name, 2}, + {msg_header, 1}, + {rec2msg, 1}, + {msg2rec, 1}, + {name2rec, 1}, + {avp_name, 2}, + {avp_arity, 2}, + {avp_header, 1}, + {avp, 3}, + {grouped_avp, 3}, + {enumerated_avp, 3}, + {empty_value, 1}, + {dict, 0}]}, + %% diameter.hrl is included for #diameter_avp + {?attribute, include_lib, "diameter/include/diameter.hrl"}, + {?attribute, include_lib, "diameter/include/diameter_gen.hrl"}, + f_name(Mod), + f_id(Spec), + f_vendor_id(Spec), + f_vendor_name(Spec), + f_msg_name(Spec), + f_msg_header(Spec), + f_rec2msg(Spec), + f_msg2rec(Spec), + f_name2rec(Spec), + f_avp_name(Spec), + f_avp_arity(Spec), + f_avp_header(Spec), + f_avp(Spec), + f_enumerated_avp(Spec), + f_empty_value(Spec), + f_dict(Spec), + {eof, ?LINE}], + + gen_erl(Path, insert_hrl_forms(Spec, Forms)). + +gen_erl(Path, Forms) -> + getr(debug) andalso write(Path ++ ".forms", Forms), + write(Path ++ ".erl", + header() ++ erl_prettypr:format(erl_syntax:form_list(Forms))). + +insert_hrl_forms(Spec, Forms) -> + {H,T} = lists:splitwith(fun is_header/1, Forms), + H ++ make_hrl_forms(Spec) ++ T. + +is_header({attribute, _, export, _}) -> + false; +is_header(_) -> + true. + +make_hrl_forms(Spec) -> + {_Prefix, MsgRecs, GrpRecs, ImportedGrpRecs} + = make_record_forms(Spec), + + RecordForms = MsgRecs ++ GrpRecs ++ lists:flatmap(fun({_,Fs}) -> Fs end, + ImportedGrpRecs), + + RecNames = lists:map(fun({attribute,_,record,{N,_}}) -> N end, + RecordForms), + + %% export_records is used by the diameter_exprecs parse transform. + [{?attribute, export_records, RecNames} | RecordForms]. + +make_record_forms(Spec) -> + Prefix = prefix(Spec), + + MsgRecs = a_record(Prefix, fun msg_proj/1, get_value(messages, Spec)), + GrpRecs = a_record(Prefix, fun grp_proj/1, get_value(grouped, Spec)), + + ImportedGrpRecs = [{M, a_record(Prefix, fun grp_proj/1, Gs)} + || {M,Gs} <- get_value(import_groups, Spec)], + + {Prefix, MsgRecs, GrpRecs, ImportedGrpRecs}. + +msg_proj({Name, _, _, _, Avps}) -> + {Name, Avps}. + +grp_proj({Name, _, _, Avps}) -> + {Name, Avps}. + +%% a_record/3 + +a_record(Prefix, ProjF, L) -> + lists:map(fun(T) -> a_record(ProjF(T), Prefix) end, L). + +a_record({Nm, Avps}, Prefix) -> + Name = list_to_atom(Prefix ++ atom_to_list(Nm)), + Fields = lists:map(fun field/1, Avps), + {?attribute, record, {Name, Fields}}. + +field(Avp) -> + {Name, Arity} = avp_info(Avp), + if 1 == Arity -> + {?record_field, ?ATOM(Name)}; + true -> + {?record_field, ?ATOM(Name), ?NIL} + end. + +%%% ------------------------------------------------------------------------ +%%% # name/0 +%%% ------------------------------------------------------------------------ + +f_name(Name) -> + {?function, name, 0, + [{?clause, [], [], [?ATOM(Name)]}]}. + +%%% ------------------------------------------------------------------------ +%%% # id/0 +%%% ------------------------------------------------------------------------ + +f_id(Spec) -> + Id = orddict:fetch(id, Spec), + {?function, id, 0, + [{?clause, [], [], [?INTEGER(Id)]}]}. + +%%% ------------------------------------------------------------------------ +%%% # vendor_id/0 +%%% ------------------------------------------------------------------------ + +f_vendor_id(Spec) -> + {Id, _} = orddict:fetch(vendor, Spec), + {?function, vendor_id, 0, + [{?clause, [], [], [?INTEGER(Id)]}]}. + +%%% ------------------------------------------------------------------------ +%%% # vendor_name/0 +%%% ------------------------------------------------------------------------ + +f_vendor_name(Spec) -> + {_, Name} = orddict:fetch(vendor, Spec), + {?function, vendor_name, 0, + [{?clause, [], [], [?ATOM(Name)]}]}. + +%%% ------------------------------------------------------------------------ +%%% # msg_name/1 +%%% ------------------------------------------------------------------------ + +f_msg_name(Spec) -> + {?function, msg_name, 2, msg_name(Spec)}. + +%% Return the empty name for any unknown command to which +%% DIAMETER_COMMAND_UNSUPPORTED should be replied. + +msg_name(Spec) -> + lists:flatmap(fun c_msg_name/1, + proplists:get_value(command_codes, Spec, [])) + ++ [{?clause, [?VAR('_'), ?VAR('_')], [], [?ATOM('')]}]. + +c_msg_name({Code, Req, Ans}) -> + [{?clause, [?INTEGER(Code), ?ATOM(true)], + [], + [?ATOM(mname(Req))]}, + {?clause, [?INTEGER(Code), ?ATOM(false)], + [], + [?ATOM(mname(Ans))]}]. + +mname({N, _Abbr}) -> + N; +mname(N) -> + N. + +%%% ------------------------------------------------------------------------ +%%% # msg2rec/1 +%%% ------------------------------------------------------------------------ + +f_msg2rec(Spec) -> + {?function, msg2rec, 1, msg2rec(Spec)}. + +msg2rec(Spec) -> + Pre = prefix(Spec), + Dict = dict:from_list(lists:flatmap(fun msgs/1, + get_value(command_codes, Spec))), + lists:flatmap(fun(T) -> msg2rec(T, Dict, Pre) end, + get_value(messages, Spec)) + ++ [?UNEXPECTED(1)]. + +msgs({_Code, Req, Ans}) -> + [{mname(Req), Req}, {mname(Ans), Ans}]. + +msg2rec({N,_,_,_,_}, Dict, Pre) -> + c_msg2rec(fetch_names(N, Dict), Pre). + +fetch_names(Name, Dict) -> + case dict:find(Name, Dict) of + {ok, N} -> + N; + error -> + Name + end. + +c_msg2rec({N,A}, Pre) -> + [c_name2rec(N, N, Pre), c_name2rec(A, N, Pre)]; +c_msg2rec(N, Pre) -> + [c_name2rec(N, N, Pre)]. + +%%% ------------------------------------------------------------------------ +%%% # rec2msg/1 +%%% ------------------------------------------------------------------------ + +f_rec2msg(Spec) -> + {?function, rec2msg, 1, rec2msg(Spec)}. + +rec2msg(Spec) -> + Pre = prefix(Spec), + lists:map(fun(T) -> c_rec2msg(T, Pre) end, get_value(messages, Spec)) + ++ [?UNEXPECTED(1)]. + +c_rec2msg({N,_,_,_,_}, Pre) -> + {?clause, [?ATOM(rec_name(N, Pre))], [], [?ATOM(N)]}. + +%%% ------------------------------------------------------------------------ +%%% # name2rec/1 +%%% ------------------------------------------------------------------------ + +f_name2rec(Spec) -> + {?function, name2rec, 1, name2rec(Spec)}. + +name2rec(Spec) -> + Pre = prefix(Spec), + Groups = get_value(grouped, Spec) + ++ lists:flatmap(fun avps/1, get_value(import_groups, Spec)), + lists:map(fun({N,_,_,_}) -> c_name2rec(N, N, Pre) end, Groups) + ++ [{?clause, [?VAR('T')], [], [?CALL(msg2rec, [?VAR('T')])]}]. + +c_name2rec(Name, Rname, Pre) -> + {?clause, [?ATOM(Name)], [], [?ATOM(rec_name(Rname, Pre))]}. + +avps({_Mod, Avps}) -> + Avps. + +%%% ------------------------------------------------------------------------ +%%% # avp_name/1 +%%% ------------------------------------------------------------------------ + +f_avp_name(Spec) -> + {?function, avp_name, 2, avp_name(Spec)}. + +%% 3588, 4.1: +%% +%% AVP Code +%% The AVP Code, combined with the Vendor-Id field, identifies the +%% attribute uniquely. AVP numbers 1 through 255 are reserved for +%% backward compatibility with RADIUS, without setting the Vendor-Id +%% field. AVP numbers 256 and above are used for Diameter, which are +%% allocated by IANA (see Section 11.1). + +avp_name(Spec) -> + Avps = get_value(avp_types, Spec) + ++ lists:flatmap(fun avps/1, get_value(import_avps, Spec)), + {Vid, _} = orddict:fetch(vendor, Spec), + Vs = lists:flatmap(fun({V,Ns}) -> [{N,V} || N <- Ns] end, + get_value(avp_vendor_id, Spec)), + + lists:map(fun(T) -> c_avp_name(T, Vid, Vs) end, Avps) + ++ [{?clause, [?VAR('_'), ?VAR('_')], [], [?ATOM('AVP')]}]. + +c_avp_name({Name, Code, Type, Flags, _Encr}, Vid, Vs) -> + c_avp_name({Name, Type}, + Code, + lists:member('V', Flags), + Vid, + proplists:get_value(Name, Vs)). + +c_avp_name(T, Code, false, _, undefined = U) -> + {?clause, [?INTEGER(Code), ?ATOM(U)], + [], + [?TERM(T)]}; + +c_avp_name(T, Code, true, Vid, V) + when is_integer(Vid) -> + {?clause, [?INTEGER(Code), ?INTEGER(choose(V == undefined, Vid, V))], + [], + [?TERM(T)]}. + +%%% ------------------------------------------------------------------------ +%%% # avp_arity/2 +%%% ------------------------------------------------------------------------ + +f_avp_arity(Spec) -> + {?function, avp_arity, 2, avp_arity(Spec)}. + +avp_arity(Spec) -> + Msgs = get_value(messages, Spec), + Groups = get_value(grouped, Spec) + ++ lists:flatmap(fun avps/1, get_value(import_groups, Spec)), + c_avp_arity(Msgs ++ Groups) + ++ [{?clause, [?VAR('_'), ?VAR('_')], [], [?INTEGER(0)]}]. + +c_avp_arity(L) + when is_list(L) -> + lists:flatmap(fun c_avp_arity/1, L); + +c_avp_arity({N,_,_,_,As}) -> + c_avp_arity(N,As); +c_avp_arity({N,_,_,As}) -> + c_avp_arity(N,As). + +c_avp_arity(Name, Avps) -> + lists:map(fun(A) -> c_arity(Name, A) end, Avps). + +c_arity(Name, Avp) -> + {AvpName, Arity} = avp_info(Avp), + {?clause, [?ATOM(Name), ?ATOM(AvpName)], [], [?TERM(Arity)]}. + +%%% ------------------------------------------------------------------------ +%%% # avp/3 +%%% ------------------------------------------------------------------------ + +f_avp(Spec) -> + {?function, avp, 3, avp(Spec) ++ [?UNEXPECTED(3)]}. + +avp(Spec) -> + Native = get_value(avp_types, Spec), + Custom = get_value(custom_types, Spec), + Imported = get_value(import_avps, Spec), + avp([{N,T} || {N,_,T,_,_} <- Native], Imported, Custom). + +avp(Native, Imported, Custom) -> + Dict = orddict:from_list(Native), + + report(native, Dict), + report(imported, Imported), + report(custom, Custom), + + CustomNames = lists:flatmap(fun({_,Ns}) -> Ns end, Custom), + + lists:map(fun c_base_avp/1, + lists:filter(fun({N,_}) -> + false == lists:member(N, CustomNames) + end, + Native)) + ++ lists:flatmap(fun c_imported_avp/1, Imported) + ++ lists:flatmap(fun(C) -> c_custom_avp(C, Dict) end, Custom). + +c_base_avp({AvpName, T}) -> + {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], + [], + [base_avp(AvpName, T)]}. + +base_avp(AvpName, 'Enumerated') -> + ?CALL(enumerated_avp, [?VAR('T'), ?ATOM(AvpName), ?VAR('Data')]); + +base_avp(AvpName, 'Grouped') -> + ?CALL(grouped_avp, [?VAR('T'), ?ATOM(AvpName), ?VAR('Data')]); + +base_avp(_, Type) -> + ?APPLY(diameter_types, Type, [?VAR('T'), ?VAR('Data')]). + +c_imported_avp({Mod, Avps}) -> + lists:map(fun(A) -> imported_avp(Mod, A) end, Avps). + +imported_avp(_Mod, {AvpName, _, 'Grouped' = T, _, _}) -> + c_base_avp({AvpName, T}); + +imported_avp(Mod, {AvpName, _, _, _, _}) -> + {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], + [], + [?APPLY(Mod, avp, [?VAR('T'), + ?VAR('Data'), + ?ATOM(AvpName)])]}. + +c_custom_avp({Mod, Avps}, Dict) -> + lists:map(fun(N) -> custom_avp(Mod, N, orddict:fetch(N, Dict)) end, Avps). + +custom_avp(Mod, AvpName, Type) -> + {?clause, [?VAR('T'), ?VAR('Data'), ?ATOM(AvpName)], + [], + [?APPLY(Mod, AvpName, [?VAR('T'), ?ATOM(Type), ?VAR('Data')])]}. + +%%% ------------------------------------------------------------------------ +%%% # enumerated_avp/3 +%%% ------------------------------------------------------------------------ + +f_enumerated_avp(Spec) -> + {?function, enumerated_avp, 3, enumerated_avp(Spec) ++ [?UNEXPECTED(3)]}. + +enumerated_avp(Spec) -> + lists:flatmap(fun c_enumerated_avp/1, get_value(enums, Spec)). + +c_enumerated_avp({AvpName, Values}) -> + lists:flatmap(fun(V) -> c_enumerated_avp(AvpName, V) end, Values). + +c_enumerated_avp(AvpName, {I,_}) -> + [{?clause, [?ATOM(decode), ?ATOM(AvpName), ?TERM(<<I:32/integer>>)], + [], + [?TERM(I)]}, + {?clause, [?ATOM(encode), ?ATOM(AvpName), ?INTEGER(I)], + [], + [?TERM(<<I:32/integer>>)]}]. + +%%% ------------------------------------------------------------------------ +%%% msg_header/1 +%%% ------------------------------------------------------------------------ + +f_msg_header(Spec) -> + {?function, msg_header, 1, msg_header(Spec) ++ [?UNEXPECTED(1)]}. + +msg_header(Spec) -> + ApplId = orddict:fetch(id, Spec), + + lists:map(fun({M,C,F,_,_}) -> c_msg_header(M, C, F, ApplId) end, + get_value(messages, Spec)). + +%% Note that any application id in the message header spec is ignored. + +c_msg_header(Name, Code, Flags, ApplId) -> + {?clause, [?ATOM(Name)], + [], + [?TERM({Code, encode_msg_flags(Flags), ApplId})]}. + +encode_msg_flags(Flags) -> + lists:foldl(fun emf/2, 0, Flags). + +emf('REQ', N) -> N bor 2#10000000; +emf('PXY', N) -> N bor 2#01000000; +emf('ERR', N) -> N bor 2#00100000. + +%%% ------------------------------------------------------------------------ +%%% # avp_header/1 +%%% ------------------------------------------------------------------------ + +f_avp_header(Spec) -> + {?function, avp_header, 1, avp_header(Spec) ++ [?UNEXPECTED(1)]}. + +avp_header(Spec) -> + Native = get_value(avp_types, Spec), + Imported = get_value(import_avps, Spec), + {Vid, _} = orddict:fetch(vendor, Spec), + Vs = lists:flatmap(fun({V,Ns}) -> [{N,V} || N <- Ns] end, + get_value(avp_vendor_id, Spec)), + + lists:flatmap(fun(A) -> c_avp_header({Vid, Vs}, A) end, + Native ++ Imported). + +c_avp_header({Vid, Vs}, {Name, Code, _Type, Flags, _Encr}) -> + [{?clause, [?ATOM(Name)], + [], + [?TERM({Code, encode_avp_flags(Flags), vid(Name, Flags, Vs, Vid)})]}]; + +c_avp_header({_, Vs}, {Mod, Avps}) -> + lists:map(fun(A) -> c_avp_header(Vs, Mod, A) end, Avps). + +c_avp_header(Vs, Mod, {Name, _, _, Flags, _}) -> + Apply = ?APPLY(Mod, avp_header, [?ATOM(Name)]), + {?clause, [?ATOM(Name)], + [], + [case proplists:get_value(Name, Vs) of + undefined -> + Apply; + Vid -> + true = lists:member('V', Flags), %% sanity check + ?CALL(setelement, [?INTEGER(3), Apply, ?INTEGER(Vid)]) + end]}. + +encode_avp_flags(Fs) -> + lists:foldl(fun eaf/2, 0, Fs). + +eaf('V', F) -> 2#10000000 bor F; +eaf('M', F) -> 2#01000000 bor F; +eaf('P', F) -> 2#00100000 bor F. + +vid(Name, Flags, Vs, Vid) -> + v(lists:member('V', Flags), Name, Vs, Vid). + +v(true, Name, Vs, Vid) -> + proplists:get_value(Name, Vs, Vid); +v(false, _, _, _) -> + undefined. + +%%% ------------------------------------------------------------------------ +%%% # empty_value/0 +%%% ------------------------------------------------------------------------ + +f_empty_value(Spec) -> + {?function, empty_value, 1, empty_value(Spec)}. + +empty_value(Spec) -> + Groups = get_value(grouped, Spec) + ++ lists:flatmap(fun avps/1, get_value(import_groups, Spec)), + Enums = get_value(enums, Spec) + ++ lists:flatmap(fun avps/1, get_value(import_enums, Spec)), + lists:map(fun c_empty_value/1, Groups ++ Enums) + ++ [{?clause, [?VAR('Name')], [], [?CALL(empty, [?VAR('Name')])]}]. + +c_empty_value({Name, _, _, _}) -> + {?clause, [?ATOM(Name)], + [], + [?CALL(empty_group, [?ATOM(Name)])]}; + +c_empty_value({Name, _}) -> + {?clause, [?ATOM(Name)], + [], + [?TERM(<<0:32/integer>>)]}. + +%%% ------------------------------------------------------------------------ +%%% # dict/0 +%%% ------------------------------------------------------------------------ + +f_dict(Spec) -> + {?function, dict, 0, + [{?clause, [], [], [?TERM(Spec)]}]}. + +%%% ------------------------------------------------------------------------ +%%% # gen_hrl/3 +%%% ------------------------------------------------------------------------ + +gen_hrl(Path, Mod, Spec) -> + {ok, Fd} = file:open(Path, [write]), + + {Prefix, MsgRecs, GrpRecs, ImportedGrpRecs} + = make_record_forms(Spec), + + file:write(Fd, hrl_header(Mod)), + + forms("Message records", Fd, MsgRecs), + forms("Grouped AVP records", Fd, GrpRecs), + + lists:foreach(fun({M,Fs}) -> + forms("Grouped AVP records from " ++ atom_to_list(M), + Fd, + Fs) + end, + ImportedGrpRecs), + + PREFIX = to_upper(Prefix), + + write("ENUM Macros", + Fd, + m_enums(PREFIX, false, get_value(enums, Spec))), + write("RESULT CODE Macros", + Fd, + m_enums(PREFIX, false, get_value(result_codes, Spec))), + + lists:foreach(fun({M,Es}) -> + write("ENUM Macros from " ++ atom_to_list(M), + Fd, + m_enums(PREFIX, true, Es)) + end, + get_value(import_enums, Spec)), + + file:close(Fd). + +forms(_, _, []) -> + ok; +forms(Banner, Fd, Forms) -> + write(Banner, Fd, prettypr(Forms)). + +write(_, _, []) -> + ok; +write(Banner, Fd, Str) -> + banner(Fd, Banner), + io:fwrite(Fd, "~s~n", [Str]). + +prettypr(Forms) -> + erl_prettypr:format(erl_syntax:form_list(Forms)). + +banner(Fd, Heading) -> + file:write(Fd, banner(Heading)). + +banner(Heading) -> + ("\n\n" + "%%% -------------------------------------------------------\n" + "%%% " ++ Heading ++ ":\n" + "%%% -------------------------------------------------------\n\n"). + +z(S) -> + string:join(string:tokens(S, "\s\t"), "\s"). + +m_enums(Prefix, Wrap, Enums) -> + lists:map(fun(T) -> m_enum(Prefix, Wrap, T) end, Enums). + +m_enum(Prefix, B, {Name, Values}) -> + P = Prefix ++ to_upper(Name) ++ "_", + lists:map(fun({I,A}) -> + N = ["'", P, to_upper(z(atom_to_list(A))), "'"], + wrap(B, + N, + ["-define(", N, ", ", integer_to_list(I), ").\n"]) + end, + Values). + +wrap(true, Name, Def) -> + ["-ifndef(", Name, ").\n", Def, "-endif.\n"]; +wrap(false, _, Def) -> + Def. + +to_upper(A) when is_atom(A) -> + to_upper(atom_to_list(A)); +to_upper(S) -> + lists:map(fun tu/1, S). + +tu(C) when C >= $a, C =< $z -> + C + $A - $a; +tu(C) -> + C. + +header() -> + ("%% -------------------------------------------------------------------\n" + "%% This is a generated file.\n" + "%% -------------------------------------------------------------------\n" + "\n" + "%%\n" + "%% Copyright (c) Ericsson AB. All rights reserved.\n" + "%%\n" + "%% The information in this document is the property of Ericsson.\n" + "%%\n" + "%% Except as specifically authorized in writing by Ericsson, the\n" + "%% receiver of this document shall keep the information contained\n" + "%% herein confidential and shall protect the same in whole or in\n" + "%% part from disclosure and dissemination to third parties.\n" + "%%\n" + "%% Disclosure and disseminations to the receivers employees shall\n" + "%% only be made on a strict need to know basis.\n" + "%%\n\n"). + +hrl_header(Name) -> + header() ++ "-hrl_name('" ++ Name ++ ".hrl').\n". + +%% avp_info/1 + +avp_info(Entry) -> %% {Name, Arity} + case Entry of + {'<',A,'>'} -> {A, 1}; + {A} -> {A, 1}; + [A] -> {A, {0,1}}; + {Q,T} -> + {A,_} = avp_info(T), + {A, arity(Q)} + end. + +%% Normalize arity to 1 or {N,X} where N is an integer. A record field +%% for an AVP is list-valued iff the normalized arity is not 1. +arity('*' = Inf) -> {0, Inf}; +arity({'*', N}) -> {0, N}; +arity({1,1}) -> 1; +arity(T) -> T. + +prefix(Spec) -> + case orddict:find(prefix, Spec) of + {ok, P} -> + atom_to_list(P) ++ "_"; + error -> + "" + end. + +rec_name(Name, Prefix) -> + list_to_atom(Prefix ++ atom_to_list(Name)). diff --git a/lib/diameter/src/compiler/diameter_forms.hrl b/lib/diameter/src/compiler/diameter_forms.hrl new file mode 100644 index 0000000000..4125e2331c --- /dev/null +++ b/lib/diameter/src/compiler/diameter_forms.hrl @@ -0,0 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. 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% +%% + +%% +%% Macros used when building abstract code. +%% + +%% 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(INTEGER(N), {integer, ?LINE, N}). +-define(VAR(V), {var, ?LINE, V}). +-define(NIL, {nil, ?LINE}). + +-define(CALL(F,A), {?call, ?ATOM(F), A}). +-define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). +-define(FIELDS(Fs), [{?record_field, ?ATOM(F), V} || {F,V} <- Fs]). + +%% Literal term. +-define(TERM(T), erl_parse:abstract(T, ?LINE)). diff --git a/lib/diameter/src/compiler/diameter_make.erl b/lib/diameter/src/compiler/diameter_make.erl new file mode 100644 index 0000000000..4431b88c4d --- /dev/null +++ b/lib/diameter/src/compiler/diameter_make.erl @@ -0,0 +1,120 @@ +%% +%% %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% +%% + +%% +%% Driver for the encoder generator utility. +%% + +-module(diameter_make). + +-export([spec/0, + hrl/0, + erl/0]). + +-spec spec() -> no_return(). +-spec hrl() -> no_return(). +-spec erl() -> no_return(). + +spec() -> + make(spec). + +hrl() -> + make(hrl). + +erl() -> + make(erl). + +%% make/1 + +make(Mode) -> + Args = init:get_plain_arguments(), + Opts = try options(Args) catch throw: help -> help(Mode) end, + Files = proplists:get_value(files, Opts, []), + lists:foreach(fun(F) -> from_file(F, Mode, Opts) end, Files), + halt(0). + +%% from_file/3 + +from_file(F, Mode, Opts) -> + try to_spec(F, Mode, Opts) of + Spec -> + from_spec(F, Spec, Mode, Opts) + catch + error: Reason -> + io:format("==> ~p parse failure:~n~p~n", + [F, {Reason, erlang:get_stacktrace()}]), + halt(1) + end. + +%% to_spec/2 + +%% Try to read the input as an already parsed file or else parse it. +to_spec(F, spec, Opts) -> + diameter_spec_util:parse(F, Opts); +to_spec(F, _, _) -> + {ok, [Spec]} = file:consult(F), + Spec. + +%% from_spec/4 + +from_spec(File, Spec, Mode, Opts) -> + try + diameter_codegen:from_spec(File, Spec, Opts, Mode) + catch + error: Reason -> + io:format("==> ~p codegen failure:~n~p~n~p~n", + [Mode, File, {Reason, erlang:get_stacktrace()}]), + halt(1) + end. + +%% options/1 + +options(["-v" | Rest]) -> + [verbose | options(Rest)]; + +options(["-o", Outdir | Rest]) -> + [{outdir, Outdir} | options(Rest)]; + +options(["-i", Incdir | Rest]) -> + [{include, Incdir} | options(Rest)]; + +options(["-h" | _]) -> + throw(help); + +options(["--" | Fs]) -> + [{files, Fs}]; + +options(["-" ++ _ = Opt | _]) -> + io:fwrite("==> unknown option: ~s~n", [Opt]), + throw(help); + +options(Fs) -> %% trailing arguments + options(["--" | Fs]). + +%% help/1 + +help(M) -> + io:fwrite("Usage: ~p ~p [Options] [--] File ...~n" + "Options:~n" + " -v verbose output~n" + " -h shows this help message~n" + " -o OutDir where to put the output files~n" + " -i IncludeDir where to search for beams to import~n", + [?MODULE, M]), + halt(1). diff --git a/lib/diameter/src/compiler/diameter_spec_scan.erl b/lib/diameter/src/compiler/diameter_spec_scan.erl new file mode 100644 index 0000000000..bc0448882a --- /dev/null +++ b/lib/diameter/src/compiler/diameter_spec_scan.erl @@ -0,0 +1,157 @@ +%% +%% %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_spec_scan). + +%% +%% Functions used by the spec file parser in diameter_spec_util. +%% + +-export([split/1, + split/2, + parse/1]). + +%%% ----------------------------------------------------------- +%%% # parse/1 +%%% +%%% Output: list of Token +%%% +%%% Token = '{' | '}' | '<' | '>' | '[' | ']' +%%% | '*' | '::=' | ':' | ',' | '-' +%%% | {name, string()} +%%% | {tag, atom()} +%%% | {number, integer() >= 0} +%%% +%%% Tokenize a string. Fails if the string does not parse. +%%% ----------------------------------------------------------- + +parse(S) -> + parse(S, []). + +%% parse/2 + +parse(S, Acc) -> + acc(split(S), Acc). + +acc({T, Rest}, Acc) -> + parse(Rest, [T | Acc]); +acc("", Acc) -> + lists:reverse(Acc). + +%%% ----------------------------------------------------------- +%%% # split/2 +%%% +%%% Output: {list() of Token, Rest} +%%% +%%% Extract a specified number of tokens from a string. Returns a list +%%% of length less than the specified number if there are less than +%%% this number of tokens to be parsed. +%%% ----------------------------------------------------------- + +split(Str, N) + when N >= 0 -> + split(N, Str, []). + +split(0, Str, Acc) -> + {lists:reverse(Acc), Str}; + +split(N, Str, Acc) -> + case split(Str) of + {T, Rest} -> + split(N-1, Rest, [T|Acc]); + "" = Rest -> + {lists:reverse(Acc), Rest} + end. + +%%% ----------------------------------------------------------- +%%% # split/1 +%%% +%%% Output: {Token, Rest} | "" +%%% +%%% Extract the next token from a string. +%%% ----------------------------------------------------------- + +split("" = Rest) -> + Rest; + +split("::=" ++ T) -> + {'::=', T}; + +split([H|T]) + when H == ${; H == $}; + H == $<; H == $>; + H == $[; H == $]; + H == $*; H == $:; H == $,; H == $- -> + {list_to_atom([H]), T}; + +split([H|T]) when $A =< H, H =< $Z; + $0 =< H, H =< $9 -> + {P, Rest} = splitwith(fun is_name_ch/1, [H], T), + Tok = try + {number, read_int(P)} + catch + error:_ -> + {name, P} + end, + {Tok, Rest}; + +split([H|T]) when $a =< H, H =< $z -> + {P, Rest} = splitwith(fun is_name_ch/1, [H], T), + {{tag, list_to_atom(P)}, Rest}; + +split([H|T]) when H == $\t; + H == $\s; + H == $\n -> + split(T). + +%% read_int/1 + +read_int([$0,X|S]) + when X == $X; + X == $x -> + {ok, [N], []} = io_lib:fread("~16u", S), + N; + +read_int(S) -> + list_to_integer(S). + +%% splitwith/3 + +splitwith(Fun, Acc, S) -> + split([] /= S andalso Fun(hd(S)), Fun, Acc, S). + +split(true, Fun, Acc, [H|T]) -> + splitwith(Fun, [H|Acc], T); +split(false, _, Acc, S) -> + {lists:reverse(Acc), S}. + +is_name_ch(C) -> + is_alphanum(C) orelse C == $- orelse C == $_. + +is_alphanum(C) -> + is_lower(C) orelse is_upper(C) orelse is_digit(C). + +is_lower(C) -> + $a =< C andalso C =< $z. + +is_upper(C) -> + $A =< C andalso C =< $Z. + +is_digit(C) -> + $0 =< C andalso C =< $9. diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl new file mode 100644 index 0000000000..322d53a199 --- /dev/null +++ b/lib/diameter/src/compiler/diameter_spec_util.erl @@ -0,0 +1,1052 @@ +%% +%% %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 turns a .dia (aka spec) file into the orddict that +%% diameter_codegen.erl in turn morphs into .erl and .hrl files for +%% encode and decode of Diameter messages and AVPs. +%% + +-module(diameter_spec_util). + +-export([parse/2]). + +-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). +-define(ATOM, list_to_atom). + +%% parse/1 +%% +%% Output: orddict() + +parse(Path, Options) -> + put({?MODULE, verbose}, lists:member(verbose, Options)), + {ok, B} = file:read_file(Path), + Chunks = chunk(B), + Spec = make_spec(Chunks), + true = enums_defined(Spec), %% sanity checks + true = groups_defined(Spec), %% + true = customs_defined(Spec), %% + Full = import_enums(import_groups(import_avps(insert_codes(Spec), + Options))), + true = v_flags_set(Spec), + Full. + +%% Optional reports when running verbosely. +report(What, Data) -> + report(get({?MODULE, verbose}), What, Data). + +report(true, Tag, Data) -> + io:format("##~n## ~p ~p~n", [Tag, Data]); +report(false, _, _) -> + ok. + +%% chunk/1 + +chunk(B) -> + chunkify(normalize(binary_to_list(B))). + +%% normalize/1 +%% +%% Replace CR NL by NL, multiple NL by one, tab by space, and strip +%% comments and leading/trailing space from each line. Precludes +%% semicolons being used for any other purpose than comments. + +normalize(Str) -> + nh(Str, []). + +nh([], Acc) -> + lists:reverse(Acc); + +%% Trim leading whitespace. +nh(Str, Acc) -> + nb(trim(Str), Acc). + +%% tab -> space +nb([$\t|Rest], Acc) -> + nb(Rest, [$\s|Acc]); + +%% CR NL -> NL +nb([$\r,$\n|Rest], Acc) -> + nt(Rest, Acc); + +%% Gobble multiple newlines before starting over again. +nb([$\n|Rest], Acc) -> + nt(Rest, Acc); + +%% Comment. +nb([$;|Rest], Acc) -> + nb(lists:dropwhile(fun(C) -> C /= $\n end, Rest), Acc); + +%% Just an ordinary character. Boring ... +nb([C|Rest], Acc) -> + nb(Rest, [C|Acc]); + +nb([] = Str, Acc) -> + nt(Str, Acc). + +%% Discard a subsequent newline. +nt(T, [$\n|_] = Acc) -> + nh(T, trim(Acc)); + +%% Trim whitespace from the end of the line before continuing. +nt(T, Acc) -> + nh(T, [$\n|trim(Acc)]). + +trim(S) -> + lists:dropwhile(fun(C) -> lists:member(C, "\s\t") end, S). + +%% chunkify/1 +%% +%% Split the spec file into pieces delimited by lines starting with +%% @Tag. Returns a list of {Tag, Args, Chunk} where Chunk is the +%% string extending to the next delimiter. Note that leading +%% whitespace has already been stripped. + +chunkify(Str) -> + %% Drop characters to the start of the first chunk. + {_, Rest} = split_chunk([$\n|Str]), + chunkify(Rest, []). + +chunkify([], Acc) -> + lists:reverse(Acc); + +chunkify(Rest, Acc) -> + {H,T} = split_chunk(Rest), + chunkify(T, [split_tag(H) | Acc]). + +split_chunk(Str) -> + split_chunk(Str, []). + +split_chunk([] = Rest, Acc) -> + {lists:reverse(Acc), Rest}; +split_chunk([$@|Rest], [$\n|_] = Acc) -> + {lists:reverse(Acc), Rest}; +split_chunk([C|Rest], Acc) -> + split_chunk(Rest, [C|Acc]). + +%% Expect a tag and its arguments on a single line. +split_tag(Str) -> + {L, Rest} = get_until($\n, Str), + [{tag, Tag} | Toks] = diameter_spec_scan:parse(L), + {Tag, Toks, trim(Rest)}. + +get_until(EndT, L) -> + {H, [EndT | T]} = lists:splitwith(fun(C) -> C =/= EndT end, L), + {H,T}. + +%% ------------------------------------------------------------------------ +%% make_spec/1 +%% +%% Turn chunks into spec. + +make_spec(Chunks) -> + lists:foldl(fun(T,A) -> report(chunk, T), chunk(T,A) end, + orddict:new(), + Chunks). + +chunk({T, [X], []}, Dict) + when T == name; + T == prefix -> + store(T, atomize(X), Dict); + +chunk({id = T, [{number, I}], []}, Dict) -> + store(T, I, Dict); + +chunk({vendor = T, [{number, I}, N], []}, Dict) -> + store(T, {I, atomize(N)}, Dict); + +%% inherits -> [{Mod, [AvpName, ...]}, ...] +chunk({inherits = T, [_,_|_] = Args, []}, Acc) -> + Mods = [atomize(A) || A <- Args], + append_list(T, [{M,[]} || M <- Mods], Acc); +chunk({inherits = T, [Mod], Body}, Acc) -> + append(T, {atomize(Mod), parse_avp_names(Body)}, Acc); + +%% avp_types -> [{AvpName, Code, Type, Flags, Encr}, ...] +chunk({avp_types = T, [], Body}, Acc) -> + store(T, parse_avp_types(Body), Acc); + +%% custom_types -> [{Mod, [AvpName, ...]}, ...] +chunk({custom_types = T, [Mod], Body}, Dict) -> + [_|_] = Avps = parse_avp_names(Body), + append(T, {atomize(Mod), Avps}, Dict); + +%% messages -> [{MsgName, Code, Type, Appl, Avps}, ...] +chunk({messages = T, [], Body}, Acc) -> + store(T, parse_messages(Body), Acc); + +%% grouped -> [{AvpName, Code, Vendor, Avps}, ...] +chunk({grouped = T, [], Body}, Acc) -> + store(T, parse_groups(Body), Acc); + +%% avp_vendor_id -> [{Id, [AvpName, ...]}, ...] +chunk({avp_vendor_id = T, [{number, I}], Body}, Dict) -> + [_|_] = Names = parse_avp_names(Body), + append(T, {I, Names}, Dict); + +%% enums -> [{AvpName, [{Value, Name}, ...]}, ...] +chunk({enum, [N], Str}, Dict) -> + append(enums, {atomize(N), parse_enums(Str)}, Dict); + +%% result_codes -> [{ResultName, [{Value, Name}, ...]}, ...] +chunk({result_code, [N], Str}, Dict) -> + append(result_codes, {atomize(N), parse_enums(Str)}, Dict); + +%% commands -> [{Name, Abbrev}, ...] +chunk({commands = T, [], Body}, Dict) -> + store(T, parse_commands(Body), Dict); + +chunk(T, _) -> + ?ERROR({unknown_tag, T}). + +store(Key, Value, Dict) -> + error == orddict:find(Key, Dict) orelse ?ERROR({duplicate, Key}), + orddict:store(Key, Value, Dict). +append(Key, Value, Dict) -> + orddict:append(Key, Value, Dict). +append_list(Key, Values, Dict) -> + orddict:append_list(Key, Values, Dict). + +atomize({tag, T}) -> + T; +atomize({name, T}) -> + ?ATOM(T). + +get_value(Keys, Spec) + when is_list(Keys) -> + [get_value(K, Spec) || K <- Keys]; +get_value(Key, Spec) -> + proplists:get_value(Key, Spec, []). + +%% ------------------------------------------------------------------------ +%% enums_defined/1 +%% groups_defined/1 +%% customs_defined/1 +%% +%% Ensure that every local enum/grouped/custom is defined as an avp +%% with an appropriate type. + +enums_defined(Spec) -> + is_defined(Spec, 'Enumerated', enums). + +groups_defined(Spec) -> + is_defined(Spec, 'Grouped', grouped). + +is_defined(Spec, Type, Key) -> + Avps = get_value(avp_types, Spec), + lists:all(fun(T) -> true = is_local(name(Key, T), Type, Avps) end, + get_value(Key, Spec)). + +name(enums, {N,_}) -> N; +name(grouped, {N,_,_,_}) -> N. + +is_local(Name, Type, Avps) -> + case lists:keyfind(Name, 1, Avps) of + {Name, _, Type, _, _} -> + true; + {Name, _, T, _, _} -> + ?ERROR({avp_has_wrong_type, Name, Type, T}); + false -> + ?ERROR({avp_not_defined, Name, Type}) + end. + +customs_defined(Spec) -> + Avps = get_value(avp_types, Spec), + lists:all(fun(A) -> true = is_local(A, Avps) end, + lists:flatmap(fun last/1, get_value(custom_types, Spec))). + +is_local(Name, Avps) -> + case lists:keyfind(Name, 1, Avps) of + {Name, _, T, _, _} when T == 'Grouped'; + T == 'Enumerated' -> + ?ERROR({avp_has_invalid_custom_type, Name, T}); + {Name, _, _, _, _} -> + true; + false -> + ?ERROR({avp_not_defined, Name}) + end. + +last({_,Xs}) -> Xs. + +%% ------------------------------------------------------------------------ +%% v_flags_set/1 + +v_flags_set(Spec) -> + Avps = get_value(avp_types, Spec) + ++ lists:flatmap(fun last/1, get_value(import_avps, Spec)), + Vs = lists:flatmap(fun last/1, get_value(avp_vendor_id, Spec)), + + lists:all(fun(N) -> vset(N, Avps) end, Vs). + +vset(Name, Avps) -> + A = lists:keyfind(Name, 1, Avps), + false == A andalso ?ERROR({avp_not_defined, Name}), + {Name, _Code, _Type, Flags, _Encr} = A, + lists:member('V', Flags) orelse ?ERROR({v_flag_not_set, A}). + +%% ------------------------------------------------------------------------ +%% insert_codes/1 + +insert_codes(Spec) -> + [Msgs, Cmds] = get_value([messages, commands], Spec), + + %% Code -> [{Name, Flags}, ...] + Dict = lists:foldl(fun({N,C,Fs,_,_}, D) -> dict:append(C,{N,Fs},D) end, + dict:new(), + Msgs), + + %% list() of {Code, {ReqName, ReqAbbr}, {AnsName, AnsAbbr}} + %% If the name and abbreviation are the same then the 2-tuples + %% are replaced by the common atom()-valued name. + Codes = dict:fold(fun(C,Ns,A) -> [make_code(C, Ns, Cmds) | A] end, + [], + dict:erase(-1, Dict)), %% answer-message + + orddict:store(command_codes, Codes, Spec). + +make_code(Code, [_,_] = Ns, Cmds) -> + {Req, Ans} = make_names(Ns, lists:map(fun({_,Fs}) -> + lists:member('REQ', Fs) + end, + Ns)), + {Code, abbrev(Req, Cmds), abbrev(Ans, Cmds)}; + +make_code(Code, Cs, _) -> + ?ERROR({missing_request_or_answer, Code, Cs}). + +%% 3.3. Diameter Command Naming Conventions +%% +%% Diameter command names typically includes one or more English words +%% followed by the verb Request or Answer. Each English word is +%% delimited by a hyphen. A three-letter acronym for both the request +%% and answer is also normally provided. + +make_names([{Rname,_},{Aname,_}], [true, false]) -> + {Rname, Aname}; +make_names([{Aname,_},{Rname,_}], [false, true]) -> + {Rname, Aname}; +make_names([_,_] = Names, _) -> + ?ERROR({inconsistent_command_flags, Names}). + +abbrev(Name, Cmds) -> + case abbr(Name, get_value(Name, Cmds)) of + Name -> + Name; + Abbr -> + {Name, Abbr} + end. + +%% No explicit abbreviation: construct. +abbr(Name, []) -> + ?ATOM(abbr(string:tokens(atom_to_list(Name), "-"))); + +%% Abbreviation was specified. +abbr(_Name, Abbr) -> + Abbr. + +%% No hyphens: already abbreviated. +abbr([Abbr]) -> + Abbr; + +%% XX-Request/Answer ==> XXR/XXA +abbr([[_,_] = P, T]) + when T == "Request"; + T == "Answer" -> + P ++ [hd(T)]; + +%% XXX-...-YYY-Request/Answer ==> X...YR/X...YA +abbr([_,_|_] = L) -> + lists:map(fun erlang:hd/1, L). + +%% ------------------------------------------------------------------------ +%% import_avps/2 + +import_avps(Spec, Options) -> + Msgs = get_value(messages, Spec), + Groups = get_value(grouped, Spec), + + %% Messages and groups require AVP's referenced by them. + NeededAvps + = ordsets:from_list(lists:flatmap(fun({_,_,_,_,As}) -> + [avp_name(A) || A <- As] + end, + Msgs) + ++ lists:flatmap(fun({_,_,_,As}) -> + [avp_name(A) || A <- As] + end, + Groups)), + MissingAvps = missing_avps(NeededAvps, Spec), + + report(needed, NeededAvps), + report(missing, MissingAvps), + + Import = inherit(get_value(inherits, Spec), Options), + + report(imported, Import), + + ImportedAvps = lists:map(fun({N,_,_,_,_}) -> N end, + lists:flatmap(fun last/1, Import)), + + Unknown = MissingAvps -- ImportedAvps, + + [] == Unknown orelse ?ERROR({undefined_avps, Unknown}), + + orddict:store(import_avps, Import, orddict:erase(inherits, Spec)). + +%% missing_avps/2 +%% +%% Given a list of AVP names and parsed spec, return the list of +%% AVP's that aren't defined in this spec. + +missing_avps(NeededNames, Spec) -> + Avps = get_value(avp_types, Spec), + Groups = lists:map(fun({N,_,_,As}) -> + {N, [avp_name(A) || A <- As]} + end, + get_value(grouped, Spec)), + Names = ordsets:from_list(['AVP' | lists:map(fun({N,_,_,_,_}) -> N end, + Avps)]), + missing_avps(NeededNames, [], {Names, Groups}). + +avp_name({'<',A,'>'}) -> A; +avp_name({A}) -> A; +avp_name([A]) -> A; +avp_name({_, A}) -> avp_name(A). + +missing_avps(NeededNames, MissingNames, {Names, _} = T) -> + missing(ordsets:filter(fun(N) -> lists:member(N, NeededNames) end, Names), + ordsets:union(NeededNames, MissingNames), + T). + +%% Nothing found locally. +missing([], MissingNames, _) -> + MissingNames; + +%% Or not. Keep looking for for the AVP's needed by the found AVP's of +%% type Grouped. +missing(FoundNames, MissingNames, {_, Groups} = T) -> + NeededNames = lists:flatmap(fun({N,As}) -> + choose(lists:member(N, FoundNames), As, []) + end, + Groups), + missing_avps(ordsets:from_list(NeededNames), + ordsets:subtract(MissingNames, FoundNames), + T). + +%% inherit/2 + +inherit(Inherits, Options) -> + Dirs = [D || {include, D} <- Options] ++ ["."], + lists:foldl(fun(T,A) -> find_avps(T, A, Dirs) end, [], Inherits). + +find_avps({Mod, AvpNames}, Acc, Path) -> + report(inherit_from, Mod), + Avps = avps_from_beam(find_beam(Mod, Path), Mod), %% could be empty + [{Mod, lists:sort(find_avps(AvpNames, Avps))} | Acc]. + +find_avps([], Avps) -> + Avps; +find_avps(Names, Avps) -> + lists:filter(fun({N,_,_,_,_}) -> lists:member(N, Names) end, Avps). + +%% find_beam/2 + +find_beam(Mod, Dirs) + when is_atom(Mod) -> + find_beam(atom_to_list(Mod), Dirs); +find_beam(Mod, Dirs) -> + Beam = Mod ++ code:objfile_extension(), + case try_path(Dirs, Beam) of + {value, Path} -> + Path; + false -> + ?ERROR({beam_not_on_path, Beam, Dirs}) + end. + +try_path([D|Ds], Fname) -> + Path = filename:join(D, Fname), + case file:read_file_info(Path) of + {ok, _} -> + {value, Path}; + _ -> + try_path(Ds, Fname) + end; +try_path([], _) -> + false. + +%% avps_from_beam/2 + +avps_from_beam(Path, Mod) -> + report(beam, Path), + ok = load_module(code:is_loaded(Mod), Mod, Path), + orddict:fetch(avp_types, Mod:dict()). + +load_module(false, Mod, Path) -> + R = filename:rootname(Path, code:objfile_extension()), + {module, Mod} = code:load_abs(R), + ok; +load_module({file, _}, _, _) -> + ok. + +choose(true, X, _) -> X; +choose(false, _, X) -> X. + +%% ------------------------------------------------------------------------ +%% import_groups/1 +%% import_enums/1 + +import_groups(Spec) -> + orddict:store(import_groups, import(grouped, Spec), Spec). + +import_enums(Spec) -> + orddict:store(import_enums, import(enums, Spec), Spec). + +import(Key, Spec) -> + lists:flatmap(fun(T) -> import_key(Key, T) end, + get_value(import_avps, Spec)). + +import_key(Key, {Mod, Avps}) -> + Imports = lists:flatmap(fun(T) -> + choose(lists:keymember(element(1,T), + 1, + Avps), + [T], + []) + end, + get_value(Key, Mod:dict())), + if Imports == [] -> + []; + true -> + [{Mod, Imports}] + end. + +%% ------------------------------------------------------------------------ +%% parse_enums/1 +%% +%% Enums are specified either as the integer value followed by the +%% name or vice-versa. In the former case the name of the enum is +%% taken to be the string up to the end of line, which may contain +%% whitespace. In the latter case the integer may be parenthesized, +%% specified in hex and followed by an inline comment. This is +%% historical and will likely be changed to require a precise input +%% format. +%% +%% Output: list() of {integer(), atom()} + +parse_enums(Str) -> + lists:flatmap(fun(L) -> parse_enum(trim(L)) end, string:tokens(Str, "\n")). + +parse_enum([]) -> + []; + +parse_enum(Str) -> + REs = [{"^(0[xX][0-9A-Fa-f]+|[0-9]+)\s+(.*?)\s*$", 1, 2}, + {"^(.+?)\s+(0[xX][0-9A-Fa-f]+|[0-9]+)(\s+.*)?$", 2, 1}, + {"^(.+?)\s+\\((0[xX][0-9A-Fa-f]+|[0-9]+)\\)(\s+.*)?$", 2, 1}], + parse_enum(Str, REs). + +parse_enum(Str, REs) -> + try lists:foreach(fun(R) -> enum(Str, R) end, REs) of + ok -> + ?ERROR({bad_enum, Str}) + catch + throw: {enum, T} -> + [T] + end. + +enum(Str, {Re, I, N}) -> + case re:run(Str, Re, [{capture, all_but_first, list}]) of + {match, Vs} -> + T = list_to_tuple(Vs), + throw({enum, {to_int(element(I,T)), ?ATOM(element(N,T))}}); + nomatch -> + ok + end. + +to_int([$0,X|Hex]) + when X == $x; + X == $X -> + {ok, [I], _} = io_lib:fread("~#", "16#" ++ Hex), + I; +to_int(I) -> + list_to_integer(I). + +%% ------------------------------------------------------------------------ +%% parse_messages/1 +%% +%% Parse according to the ABNF for message specifications in 3.2 of +%% RFC 3588 (shown below). We require all message and AVP names to +%% start with a digit or uppercase character, except for the base +%% answer-message, which is treated as a special case. Allowing names +%% that start with a digit is more than the RFC specifies but the name +%% doesn't affect what's sent over the wire. (Certains 3GPP standards +%% use names starting with a digit. eg 3GPP-Charging-Id in TS32.299.) + +%% +%% Sadly, not even the RFC follows this grammar. In particular, except +%% in the example in 3.2, it wraps each command-name in angle brackets +%% ('<' '>') which makes parsing a sequence of specifications require +%% lookahead: after 'optional' avps have been parsed, it's not clear +%% whether a '<' is a 'fixed' or whether it's the start of a +%% subsequent message until we see whether or not '::=' follows the +%% closing '>'. Require the grammar as specified. +%% +%% Output: list of {Name, Code, Flags, ApplId, Avps} +%% +%% Name = atom() +%% Code = integer() +%% Flags = integer() +%% ApplId = [] | [integer()] +%% Avps = see parse_avps/1 + +parse_messages(Str) -> + p_cmd(trim(Str), []). + +%% command-def = command-name "::=" diameter-message +%% +%% command-name = diameter-name +%% +%% diameter-name = ALPHA *(ALPHA / DIGIT / "-") +%% +%% diameter-message = header [ *fixed] [ *required] [ *optional] +%% [ *fixed] +%% +%% header = "<" Diameter-Header:" command-id +%% [r-bit] [p-bit] [e-bit] [application-id]">" +%% +%% The header spec (and example that follows it) is slightly mangled +%% and, given the examples in the RFC should as follows: +%% +%% header = "<" "Diameter Header:" command-id +%% [r-bit] [p-bit] [e-bit] [application-id]">" +%% +%% This is what's required/parsed below, modulo whitespace. This is +%% also what's specified in the current draft standard at +%% http://ftp.ietf.org/drafts/wg/dime. +%% +%% Note that the grammar specifies the order fixed, required, +%% optional. In practise there seems to be little difference between +%% the latter two since qualifiers can be used to change the +%% semantics. For example 1*[XXX] and *1{YYY} specify 1 or more of the +%% optional avp XXX and 0 or 1 of the required avp YYY, making the +%% iotional avp required and the required avp optional. The current +%% draft addresses this somewhat by requiring that min for a qualifier +%% on an optional avp must be 0 if present. It doesn't say anything +%% about required avps however, so specifying a min of 0 would still +%% be possible. The draft also does away with the trailing *fixed. +%% +%% What will be parsed here will treat required and optional +%% interchangeably. That is. only require that required/optional +%% follow and preceed fixed, not that optional avps must follow +%% required ones. We already have several specs for which this parsing +%% is necessary and there seems to be no harm in accepting it. + +p_cmd("", Acc) -> + lists:reverse(Acc); + +p_cmd(Str, Acc) -> + {Next, Rest} = split_def(Str), + report(command, Next), + p_cmd(Rest, [p_cmd(Next) | Acc]). + +p_cmd("answer-message" ++ Str) -> + p_header([{name, 'answer-message'} | diameter_spec_scan:parse(Str)]); + +p_cmd(Str) -> + p_header(diameter_spec_scan:parse(Str)). + +%% p_header/1 + +p_header(['<', {name, _} = N, '>' | Toks]) -> + p_header([N | Toks]); + +p_header([{name, 'answer-message' = N}, '::=', + '<', {name, "Diameter"}, {name, "Header"}, ':', {tag, code}, + ',', {name, "ERR"}, '[', {name, "PXY"}, ']', '>' + | Toks]) -> + {N, -1, ['ERR', 'PXY'], [], parse_avps(Toks)}; + +p_header([{name, Name}, '::=', + '<', {name, "Diameter"}, {name, "Header"}, ':', {number, Code} + | Toks]) -> + {Flags, Rest} = p_flags(Toks), + {ApplId, [C|_] = R} = p_appl(Rest), + '>' == C orelse ?ERROR({invalid_flag, {Name, Code, Flags, ApplId}, R}), + {?ATOM(Name), Code, Flags, ApplId, parse_avps(tl(R))}; + +p_header(Toks) -> + ?ERROR({invalid_header, Toks}). + +%% application-id = 1*DIGIT +%% +%% command-id = 1*DIGIT +%% ; The Command Code assigned to the command +%% +%% r-bit = ", REQ" +%% ; If present, the 'R' bit in the Command +%% ; Flags is set, indicating that the message +%% ; is a request, as opposed to an answer. +%% +%% p-bit = ", PXY" +%% ; If present, the 'P' bit in the Command +%% ; Flags is set, indicating that the message +%% ; is proxiable. +%% +%% 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. + +p_flags(Toks) -> + lists:foldl(fun p_flags/2, {[], Toks}, ["REQ", "PXY", "ERR"]). + +p_flags(N, {Acc, [',', {name, N} | Toks]}) -> + {[?ATOM(N) | Acc], Toks}; + +p_flags(_, T) -> + T. + +%% The RFC doesn't specify ',' before application-id but this seems a +%% bit inconsistent. Accept a comma if it exists. +p_appl([',', {number, I} | Toks]) -> + {[I], Toks}; +p_appl([{number, I} | Toks]) -> + {[I], Toks}; +p_appl(Toks) -> + {[], Toks}. + +%% parse_avps/1 +%% +%% Output: list() of Avp | {Qual, Avp} +%% +%% Qual = '*' | {Min, '*'} | {'*', Max} | {Min, Max} +%% Avp = {'<', Name, '>'} | {Name} | [Name] +%% +%% Min, Max = integer() >= 0 + +parse_avps(Toks) -> + p_avps(Toks, ['<', '|', '<'], []). +%% The list corresponds to the delimiters expected at the front, middle +%% and back of the avp specification, '|' representing '{' and '['. + +%% fixed = [qual] "<" avp-spec ">" +%% ; Defines the fixed position of an AVP +%% +%% required = [qual] "{" avp-spec "}" +%% ; The AVP MUST be present and can appear +%% ; anywhere in the message. +%% +%% optional = [qual] "[" avp-name "]" +%% ; The avp-name in the 'optional' rule cannot +%% ; evaluate to any AVP Name which is included +%% ; in a fixed or required rule. The AVP can +%% ; appear anywhere in the message. +%% +%% qual = [min] "*" [max] +%% ; See ABNF conventions, RFC 2234 Section 6.6. +%% ; The absence of any qualifiers depends on whether +%% ; it precedes a fixed, required, or optional +%% ; rule. If a fixed or required rule has no +%% ; qualifier, then exactly one such AVP MUST +%% ; be present. If an optional rule has no +%% ; qualifier, then 0 or 1 such AVP may be +%% ; present. +%% ; +%% ; NOTE: "[" and "]" have a different meaning +%% ; than in ABNF (see the optional rule, above). +%% ; These braces cannot be used to express +%% ; optional fixed rules (such as an optional +%% ; ICV at the end). To do this, the convention +%% ; is '0*1fixed'. +%% +%% min = 1*DIGIT +%% ; The minimum number of times the element may +%% ; be present. The default value is zero. +%% +%% max = 1*DIGIT +%% ; The maximum number of times the element may +%% ; be present. The default value is infinity. A +%% ; value of zero implies the AVP MUST NOT be +%% ; present. +%% +%% avp-spec = diameter-name +%% ; The avp-spec has to be an AVP Name, defined +%% ; in the base or extended Diameter +%% ; specifications. +%% +%% avp-name = avp-spec / "AVP" +%% ; The string "AVP" stands for *any* arbitrary +%% ; AVP Name, which does not conflict with the +%% ; required or fixed position AVPs defined in +%% ; the command code definition. +%% + +p_avps([], _, Acc) -> + lists:reverse(Acc); + +p_avps(Toks, Delim, Acc) -> + {Qual, Rest} = p_qual(Toks), + {Avp, R, D} = p_avp(Rest, Delim), + T = if Qual == false -> + Avp; + true -> + {Qual, Avp} + end, + p_avps(R, D, [T | Acc]). + +p_qual([{number, Min}, '*', {number, Max} | Toks]) -> + {{Min, Max}, Toks}; +p_qual([{number, Min}, '*' = Max | Toks]) -> + {{Min, Max}, Toks}; +p_qual(['*' = Min, {number, Max} | Toks]) -> + {{Min, Max}, Toks}; +p_qual(['*' = Q | Toks]) -> + {Q, Toks}; +p_qual(Toks) -> + {false, Toks}. + +p_avp([B, {name, Name}, E | Toks], [_|_] = Delim) -> + {avp(B, ?ATOM(Name), E), + Toks, + delim(choose(B == '<', B, '|'), Delim)}; +p_avp(Toks, Delim) -> + ?ERROR({invalid_avp, Toks, Delim}). + +avp('<' = B, Name, '>' = E) -> + {B, Name, E}; +avp('{', Name, '}') -> + {Name}; +avp('[', Name, ']') -> + [Name]; +avp(B, Name, E) -> + ?ERROR({invalid_avp, B, Name, E}). + +delim(B, D) -> + if B == hd(D) -> D; true -> tl(D) end. + +%% split_def/1 +%% +%% Strip one command definition off head of a string. + +split_def(Str) -> + sdh(Str, []). + +%% Look for the "::=" starting off the definition. +sdh("", _) -> + ?ERROR({missing, '::='}); +sdh("::=" ++ Rest, Acc) -> + sdb(Rest, [$=,$:,$:|Acc]); +sdh([C|Rest], Acc) -> + sdh(Rest, [C|Acc]). + +%% Look for the "::=" starting off the following definition. +sdb("::=" ++ _ = Rest, Acc) -> + sdt(trim(Acc), Rest); +sdb("" = Rest, Acc) -> + sd(Acc, Rest); +sdb([C|Rest], Acc) -> + sdb(Rest, [C|Acc]). + +%% Put name characters of the subsequent specification back into Rest. +sdt([C|Acc], Rest) + when C /= $\n, C /= $\s -> + sdt(Acc, [C|Rest]); + +sdt(Acc, Rest) -> + sd(Acc, Rest). + +sd(Acc, Rest) -> + {trim(lists:reverse(Acc)), Rest}. +%% Note that Rest is already trimmed of leading space. + +%% ------------------------------------------------------------------------ +%% parse_groups/1 +%% +%% Parse according to the ABNF for message specifications in 4.4 of +%% RFC 3588 (shown below). Again, allow names starting with a digit +%% and also require "AVP Header" without "-" since this is what +%% the RFC uses in all examples. +%% +%% Output: list of {Name, Code, Vendor, Avps} +%% +%% Name = atom() +%% Code = integer() +%% Vendor = [] | [integer()] +%% Avps = see parse_avps/1 + +parse_groups(Str) -> + p_group(trim(Str), []). + +%% grouped-avp-def = name "::=" avp +%% +%% name-fmt = ALPHA *(ALPHA / DIGIT / "-") +%% +%% name = name-fmt +%% ; The name has to be the name of an AVP, +%% ; defined in the base or extended Diameter +%% ; specifications. +%% +%% avp = header [ *fixed] [ *required] [ *optional] +%% [ *fixed] +%% +%% header = "<" "AVP-Header:" avpcode [vendor] ">" +%% +%% avpcode = 1*DIGIT +%% ; The AVP Code assigned to the Grouped AVP +%% +%% vendor = 1*DIGIT +%% ; The Vendor-ID assigned to the Grouped AVP. +%% ; If absent, the default value of zero is +%% ; used. + +p_group("", Acc) -> + lists:reverse(Acc); + +p_group(Str, Acc) -> + {Next, Rest} = split_def(Str), + report(group, Next), + p_group(Rest, [p_group(diameter_spec_scan:parse(Next)) | Acc]). + +p_group([{name, Name}, '::=', '<', {name, "AVP"}, {name, "Header"}, + ':', {number, Code} + | Toks]) -> + {Id, [C|_] = R} = p_vendor(Toks), + C == '>' orelse ?ERROR({invalid_group_header, R}), + {?ATOM(Name), Code, Id, parse_avps(tl(R))}; + +p_group(Toks) -> + ?ERROR({invalid_group, Toks}). + +p_vendor([{number, I} | Toks]) -> + {[I], Toks}; +p_vendor(Toks) -> + {[], Toks}. + +%% ------------------------------------------------------------------------ +%% parse_avp_names/1 + +parse_avp_names(Str) -> + [p_name(N) || N <- diameter_spec_scan:parse(Str)]. + +p_name({name, N}) -> + ?ATOM(N); +p_name(T) -> + ?ERROR({invalid_avp_name, T}). + +%% ------------------------------------------------------------------------ +%% parse_avp_types/1 +%% +%% Output: list() of {Name, Code, Type, Flags, Encr} + +parse_avp_types(Str) -> + p_avp_types(Str, []). + +p_avp_types(Str, Acc) -> + p_type(diameter_spec_scan:split(Str, 3), Acc). + +p_type({[],[]}, Acc) -> + lists:reverse(Acc); + +p_type({[{name, Name}, {number, Code}, {name, Type}], Str}, Acc) -> + {Flags, Encr, Rest} = try + p_avp_flags(trim(Str), []) + catch + throw: {?MODULE, Reason} -> + ?ERROR({invalid_avp_type, Reason}) + end, + p_avp_types(Rest, [{?ATOM(Name), Code, ?ATOM(type(Type)), Flags, Encr} + | Acc]); + +p_type(T, _) -> + ?ERROR({invalid_avp_type, T}). + +p_avp_flags([C|Str], Acc) + when C == $M; + C == $P; + C == $V -> + p_avp_flags(Str, [?ATOM([C]) | Acc]); +%% Could support lowercase here if there's a use for distinguishing +%% between Must and Should in the future in deciding whether or not +%% to set a flag. + +p_avp_flags([$-|Str], Acc) -> + %% Require encr on same line as flags if specified. + {H,T} = lists:splitwith(fun(C) -> C /= $\n end, Str), + + {[{name, [$X|X]} | Toks], Rest} = diameter_spec_scan:split([$X|H], 2), + + "" == X orelse throw({?MODULE, {invalid_avp_flag, Str}}), + + Encr = case Toks of + [] -> + "-"; + [{_, E}] -> + (E == "Y" orelse E == "N") + orelse throw({?MODULE, {invalid_encr, E}}), + E + end, + + Flags = ordsets:from_list(lists:reverse(Acc)), + + {Flags, ?ATOM(Encr), Rest ++ T}; + +p_avp_flags(Str, Acc) -> + p_avp_flags([$-|Str], Acc). + +type("DiamIdent") -> "DiameterIdentity"; %% RFC 3588 +type("DiamURI") -> "DiameterURI"; %% RFC 3588 +type("IPFltrRule") -> "IPFilterRule"; %% RFC 4005 +type("QoSFltrRule") -> "QoSFilterRule"; %% RFC 4005 +type(N) + when N == "OctetString"; + N == "Integer32"; + N == "Integer64"; + N == "Unsigned32"; + N == "Unsigned64"; + N == "Float32"; + N == "Float64"; + N == "Grouped"; + N == "Enumerated"; + N == "Address"; + N == "Time"; + N == "UTF8String"; + N == "DiameterIdentity"; + N == "DiameterURI"; + N == "IPFilterRule"; + N == "QoSFilterRule" -> + N; +type(N) -> + ?ERROR({invalid_avp_type, N}). + +%% ------------------------------------------------------------------------ +%% parse_commands/1 + +parse_commands(Str) -> + p_abbr(diameter_spec_scan:parse(Str), []). + + p_abbr([{name, Name}, {name, Abbrev} | Toks], Acc) + when length(Abbrev) < length(Name) -> + p_abbr(Toks, [{?ATOM(Name), ?ATOM(Abbrev)} | Acc]); + +p_abbr([], Acc) -> + lists:reverse(Acc); + +p_abbr(T, _) -> + ?ERROR({invalid_command, T}). diff --git a/lib/diameter/src/compiler/modules.mk b/lib/diameter/src/compiler/modules.mk new file mode 100644 index 0000000000..17a311dacf --- /dev/null +++ b/lib/diameter/src/compiler/modules.mk @@ -0,0 +1,27 @@ +#-*-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% + +MODULES = \ + diameter_codegen \ + diameter_spec_scan \ + diameter_spec_util + +HRL_FILES = \ + diameter_forms.hrl + diff --git a/lib/diameter/src/subdirs.mk b/lib/diameter/src/subdirs.mk new file mode 100644 index 0000000000..3026224e00 --- /dev/null +++ b/lib/diameter/src/subdirs.mk @@ -0,0 +1,21 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode + +# %CopyrightBegin% +# +# Copyright Ericsson AB 2010. 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% + +SUB_DIRS = compiler app transport +SUB_DIRECTORIES = $(SUB_DIRS)
\ No newline at end of file diff --git a/lib/diameter/src/transport/.gitignore b/lib/diameter/src/transport/.gitignore new file mode 100644 index 0000000000..d9f072e262 --- /dev/null +++ b/lib/diameter/src/transport/.gitignore @@ -0,0 +1,3 @@ + +/depend.mk + diff --git a/lib/diameter/src/transport/Makefile b/lib/diameter/src/transport/Makefile new file mode 100644 index 0000000000..5dc1772796 --- /dev/null +++ b/lib/diameter/src/transport/Makefile @@ -0,0 +1,141 @@ +# +# %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 + +ERL_FILES = \ + $(MODULES:%=%.erl) + +TARGET_FILES = \ + $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ifeq ($(TYPE),debug) +ERL_COMPILE_FLAGS += -Ddebug +endif + +include ../app/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) + rm -f errs core *~ + rm -f depend.mk + +docs: + +info: + @echo "" + @echo "ERL_FILES = $(ERL_FILES)" + @echo "HRL_FILES = $(HRL_FILES)" + @echo "" + @echo "TARGET_FILES = $(TARGET_FILES)" + @echo "" + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +# Invoked from ../app to add modules to the app file. +$(APP_TARGET): force + M=`echo $(MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ + echo "/%TRANSPORT_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ + | ed -s $@ + +# ---------------------------------------------------- +# 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)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DIR) $(RELSYSDIR)/src/transport + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src/transport + +release_docs_spec: + +force: + +# ---------------------------------------------------- +# Dependencies +# ---------------------------------------------------- + +depend: depend.mk + +# Generate dependencies makefile. +depend.mk: ../app/depend.sed $(ERL_FILES) modules.mk Makefile + for f in $(MODULES); do \ + sed -f $< $$f.erl | sed "s@/@/$$f@"; \ + done \ + > $@ + +-include depend.mk + +.PHONY: clean debug depend docs force info opt release_docs_spec release_spec diff --git a/lib/diameter/src/transport/diameter_etcp.erl b/lib/diameter/src/transport/diameter_etcp.erl new file mode 100644 index 0000000000..d925d62545 --- /dev/null +++ b/lib/diameter/src/transport/diameter_etcp.erl @@ -0,0 +1,311 @@ +%% +%% %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 transport_module that uses Erlang message +%% passing for transport. +%% + +-module(diameter_etcp). + +-behaviour(gen_server). + +%% transport_module interface. +-export([start/3]). + +%% gen_tcp-ish interface used by diameter_tcp. +-export([listen/2, + accept/1, + connect/3, + send/2, + close/1, + setopts/2, + port/1]). + +%% child start +-export([start_link/1]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3, + terminate/2]). + +%% Server states. + +-record(listener, + {acceptors = [] :: [pid()]}). + +-record(connection, + {parent :: pid(), + peer :: {connect, reference()} %% {connect, MRef} + | accept + | pid()}). + +%% start/3 + +%% 'module' option makes diameter_tcp call here instead of gen_tcp/inet. +start(T, Svc, Opts) + when is_list(Opts) -> + diameter_etcp_sup:start(), + diameter_tcp:start(T, Svc, [{module, ?MODULE} | Opts]). + +%% listen/2 +%% +%% Spawn a process that represents the listening socket. The local +%% port number can be any term, not just an integer. The listener +%% process registers its host/port with diameter_reg and this is the +%% handle with which connect/3 finds the appropriate listening +%% process. + +listen(LPort, Opts) -> + Parent = self(), + diameter_etcp_sup:start_child({listen, Parent, LPort, Opts}). + +%% accept/1 +%% +%% Output: pid() + +accept(LPid) -> + start(fun(Ref, Parent) -> acceptor(LPid, Ref, Parent) end). + +%% connect/3 +%% +%% Output: pid() + +%% RAddr here can either be a 4/8-tuple address or {Node, Addr}. +connect(RAddr, RPort, _Opts) -> + start(fun(Ref, Parent) -> connector(RAddr, RPort, Ref, Parent) end). + +%% send/2 + +send(Pid, Bin) -> + Pid ! {send, Bin}, + ok. + +%% close/1 + +close(Pid) -> + Pid ! close, + monitor(Pid), + receive {'DOWN', _, process, Pid, _} -> ok end. + +%% setopts/2 + +setopts(_, _) -> + ok. + +%% port/1 + +port(_) -> + 3868. %% We have no local port: fake it. + +%% start_link/1 + +start_link(T) -> + gen_server:start_link(?MODULE, T, []). + +%% --------------------------------------------------------------------------- +%% # init/1 +%% --------------------------------------------------------------------------- + +%% Maintain a list of acceptor pids as the process state. Each accept +%% adds a pid to the list, each connect removes one. +init({listen, Parent, LPort, Opts}) -> + monitor(Parent), + {ip, LAddr} = lists:keyfind(ip, 1, Opts), + true = diameter_reg:add_new({?MODULE, listener, LAddr, LPort}), + {ok, #listener{}}; + +init({connect, Fun, Ref, Parent}) -> + {ok, #connection{parent = Parent, + peer = Fun(Ref, Parent)}}. + +%% --------------------------------------------------------------------------- +%% # handle_call/3 +%% --------------------------------------------------------------------------- + +handle_call(_, _, State) -> + {reply, nok, State}. + +%% --------------------------------------------------------------------------- +%% # handle_cast/2 +%% --------------------------------------------------------------------------- + +handle_cast(_, State) -> + {noreply, State}. + +%% --------------------------------------------------------------------------- +%% # handle_info/2 +%% --------------------------------------------------------------------------- + +handle_info(T, #listener{acceptors = L} = S) -> + {noreply, S#listener{acceptors = l(T,L)}}; + +handle_info(T, State) -> + {noreply, transition(T, State)}. + +%% --------------------------------------------------------------------------- +%% # code_change/3 +%% --------------------------------------------------------------------------- + +code_change(_, State, _) -> + {ok, State}. + +%% --------------------------------------------------------------------------- +%% # terminate/2 +%% --------------------------------------------------------------------------- + +terminate(_, _) -> + ok. + +%% --------------------------------------------------------------------------- + +monitor(Pid) -> + erlang:monitor(process, Pid). + +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +eraser(Key) -> + erase({?MODULE, Key}). + +%% l/2 + +l({'DOWN', _, process, _, _} = T, _) -> + x(T); + +%% New accepting process. +l({accept, APid}, As) -> + As ++ [APid]; + +%% Peer wants to connect but we have no acceptor ... +l({connect, Peer}, [] = As) -> + Peer ! {refused, self()}, + As; + +%% ... or we do. +l({connect, Peer}, [APid | Rest]) -> + Peer ! {accepted, APid}, + Rest. + +x(T) -> + exit({shutdown, T}). + +%% start/1 + +start(Fun) -> + Ref = make_ref(), + {ok, Pid} + = T + = diameter_etcp_sup:start_child({connect, Fun, Ref, self()}), + MRef = monitor(Pid), + receive + {ok, Ref} -> + T; + {'DOWN', MRef, process, _, Reason} -> + {error, Reason} + end. + +%% acceptor/3 + +acceptor(LPid, Ref, Parent) -> + LPid ! {accept, self()}, %% announce that we're accepting + putr(ref, {ok, Ref}), + monitor(Parent), + monitor(LPid), + accept. + +%% connector/4 + +connector(RAddr, RPort, Ref, Parent) -> + c(match(RAddr, RPort), Ref, Parent). + +c([], _, _) -> + x(refused); + +c([{_,LPid}], Ref, Parent) -> + LPid ! {connect, self()}, + putr(ref, {ok, Ref}), + monitor(Parent), + {connect, monitor(LPid)}. + +match({Node, RAddr}, RPort) -> + rpc:call(Node, diameter_reg, match, [{?MODULE, listener, RAddr, RPort}]); + +match(RAddr, RPort) -> + match({node(), RAddr}, RPort). + +%% transition/2 + +%% Unexpected parent or peer death. +transition({'DOWN', _, process, _, _} = T, S) -> + element(2,S) ! {tcp_error, self(), T}, + x(T); + +%% Connector is receiving acceptor pid from listener. +transition({accepted, Peer}, #connection{parent = Parent, + peer = {connect, MRef}}) -> + monitor(Peer), + erlang:demonitor(MRef, [flush]), + Peer ! {connect, self()}, + Parent ! {ok, _} = eraser(ref), + #connection{parent = Parent, + peer = Peer}; + +%% Connector is receiving connection refusal from listener. +transition({refused, _} = T, #connection{peer = {connect, _}}) -> + x(T); + +%% Acceptor is receiving peer connect. +transition({connect, Peer}, #connection{parent = Parent, + peer = accept}) -> + monitor(Peer), + Parent ! {ok, _} = eraser(ref), + #connection{parent = Parent, + peer = Peer}; + +%% Incoming message. +transition({recv, Bin}, #connection{parent = Parent} = S) -> + Parent ! {tcp, self(), Bin}, + S; + +%% Outgoing message. +transition({send, Bin}, #connection{peer = Peer} = S) -> + Peer ! {recv, Bin}, + S; + +%% diameter_etcp:close/1 call when a peer is connected ... +transition(close = T, #connection{peer = Peer}) + when is_pid(Peer) -> + Peer ! {close, self()}, + x(T); + +%% ... or not. +transition(close = T, #connection{}) -> + x(T); + +%% Peer is closing the connection. +transition({close, Peer} = T, #connection{parent = Parent, + peer = Peer}) + when is_pid(Peer) -> + Parent ! {tcp_closed, self()}, + x(T). diff --git a/lib/diameter/src/transport/diameter_etcp_sup.erl b/lib/diameter/src/transport/diameter_etcp_sup.erl new file mode 100644 index 0000000000..bd089cf041 --- /dev/null +++ b/lib/diameter/src/transport/diameter_etcp_sup.erl @@ -0,0 +1,64 @@ +%% +%% %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_etcp_sup). + +-behaviour(supervisor). + +%% interface +-export([start/0, + start_child/1]). + +%% internal exports +-export([start_link/1, + init/1]). + +%% start/0 +%% +%% Start the etcp top supervisor. + +start() -> + diameter_transport_sup:start_child(?MODULE, ?MODULE). + +%% start_child/1 +%% +%% Start a worker under the etcp supervisor. + +start_child(T) -> + supervisor:start_child(?MODULE, [T]). + +%% start_link/1 +%% +%% Callback from diameter_transport_sup as a result of start/0. +%% Starts a child supervisor under the transport supervisor. + +start_link(?MODULE) -> + SupName = {local, ?MODULE}, + supervisor:start_link(SupName, ?MODULE, []). + +init([]) -> + Mod = diameter_etcp, + 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/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl new file mode 100644 index 0000000000..92aa8488a0 --- /dev/null +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -0,0 +1,624 @@ +%% +%% %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_sctp). + +-behaviour(gen_server). + +%% interface +-export([start/3]). + +%% child start from supervisor +-export([start_link/1]). + +%% child start from here +-export([init/1]). + +%% gen_server callbacks +-export([handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3, + terminate/2]). + +-include_lib("kernel/include/inet_sctp.hrl"). +-include_lib("diameter/include/diameter.hrl"). + +-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). + +%% The default port for a listener. +-define(DEFAULT_PORT, 3868). %% RFC 3588, ch 2.1 + +%% How long a listener with no associations lives before offing +%% itself. +-define(LISTENER_TIMEOUT, 30000). + +%% How long to wait for a transport process to attach after +%% association establishment. +-define(ACCEPT_TIMEOUT, 5000). + +-type uint() :: non_neg_integer(). + +%% Accepting/connecting transport process state. +-record(transport, + {parent :: pid(), + mode :: {accept, pid()} + | {connect, {list(inet:ip_address()), uint(), list()}} + %% {RAs, RP, Errors} + | connect, + socket :: gen_sctp:sctp_socket(), + assoc_id :: gen_sctp:assoc_id(), %% association identifier + peer :: {[inet:ip_address()], uint()}, %% {RAs, RP} + streams :: {uint(), uint()}, %% {InStream, OutStream} counts + os = 0 :: uint()}). %% next output stream + +%% Listener process state. +-record(listener, + {ref :: reference(), + socket :: gen_sctp:sctp_socket(), + count = 0 :: uint(), + tmap = ets:new(?MODULE, []) :: ets:tid(), + %% {MRef, Pid|AssocId}, {AssocId, Pid} + pending = {0, ets:new(?MODULE, [ordered_set])}, + tref :: reference()}). +%% Field tmap is used to map an incoming message or event to the +%% relevent transport process. Field pending implements a queue of +%% transport processes to which an association has been assigned (at +%% comm_up and written into tmap) but for which diameter hasn't yet +%% spawned a transport process: a short-lived state of affairs as a +%% new transport is spawned as a consequence of a peer being taken up, +%% transport processes being spawned by the listener on demand. In +%% case diameter starts a transport before comm_up on a new +%% association, pending is set to an improper list with the spawned +%% transport as head and the queue as tail. + +%% --------------------------------------------------------------------------- +%% # start/3 +%% --------------------------------------------------------------------------- + +start(T, #diameter_service{capabilities = Caps}, Opts) + when is_list(Opts) -> + diameter_sctp_sup:start(), %% start supervisors on demand + Addrs = Caps#diameter_caps.host_ip_address, + s(T, Addrs, lists:map(fun ip/1, Opts)). + +ip({ifaddr, A}) -> + {ip, A}; +ip(T) -> + T. + +%% A listener spawns transports either as a consequence of this call +%% when there is not yet an association to associate with it, or at +%% comm_up on a new association in which case the call retrieves a +%% transport from the pending queue. +s({accept, Ref} = A, Addrs, Opts) -> + {LPid, LAs} = listener(Ref, {Opts, Addrs}), + try gen_server:call(LPid, {A, self()}, infinity) of + {ok, TPid} -> {ok, TPid, LAs} + catch + exit: Reason -> {error, Reason} + end; +%% This implementation is due to there being no accept call in +%% gen_sctp in order to be able to accept a new association only +%% *after* an accepting transport has been spawned. + +s({connect = C, _}, Addrs, Opts) -> + diameter_sctp_sup:start_child({C, self(), Opts, Addrs}). + +%% start_link/1 + +start_link(T) -> + proc_lib:start_link(?MODULE, + init, + [T], + infinity, + diameter_lib:spawn_opts(server, [])). + +%% --------------------------------------------------------------------------- +%% # init/1 +%% --------------------------------------------------------------------------- + +init(T) -> + gen_server:enter_loop(?MODULE, [], i(T)). + +%% i/1 + +%% A process owning a listening socket. +i({listen, Ref, {Opts, Addrs}}) -> + {LAs, Sock} = AS = open(Addrs, Opts, ?DEFAULT_PORT), + proc_lib:init_ack({ok, self(), LAs}), + ok = gen_sctp:listen(Sock, true), + true = diameter_reg:add_new({?MODULE, listener, {Ref, AS}}), + start_timer(#listener{ref = Ref, + socket = Sock}); + +%% A connecting transport. +i({connect, Pid, Opts, Addrs}) -> + {[As, Ps], Rest} = proplists:split(Opts, [raddr, rport]), + RAs = [diameter_lib:ipaddr(A) || {raddr, A} <- As], + [RP] = [P || {rport, P} <- Ps] ++ [P || P <- [?DEFAULT_PORT], [] == Ps], + {LAs, Sock} = open(Addrs, Rest, 0), + proc_lib:init_ack({ok, self(), LAs}), + erlang:monitor(process, Pid), + #transport{parent = Pid, + mode = {connect, connect(Sock, RAs, RP, [])}, + socket = Sock}; + +%% An accepting transport spawned by diameter. +i({accept, Pid, LPid, Sock}) -> + proc_lib:init_ack({ok, self()}), + erlang:monitor(process, Pid), + erlang:monitor(process, LPid), + #transport{parent = Pid, + mode = {accept, LPid}, + socket = Sock}; + +%% An accepting transport spawned at association establishment. +i({accept, Ref, LPid, Sock, Id}) -> + proc_lib:init_ack({ok, self()}), + MRef = erlang:monitor(process, LPid), + %% Wait for a signal that the transport has been started before + %% processing other messages. + receive + {Ref, Pid} -> %% transport started + #transport{parent = Pid, + mode = {accept, LPid}, + socket = Sock}; + {'DOWN', MRef, process, _, _} = T -> %% listener down + close(Sock, Id), + x(T) + after ?ACCEPT_TIMEOUT -> + close(Sock, Id), + x(timeout) + end. + +%% close/2 + +close(Sock, Id) -> + gen_sctp:eof(Sock, #sctp_assoc_change{assoc_id = Id}). +%% Having to pass a record here is hokey. + +%% listener/2 + +listener(LRef, T) -> + l(diameter_reg:match({?MODULE, listener, {LRef, '_'}}), LRef, T). + +%% Existing process with the listening socket ... +l([{{?MODULE, listener, {_, AS}}, LPid}], _, _) -> + {LAs, _Sock} = AS, + {LPid, LAs}; + +%% ... or not: start one. +l([], LRef, T) -> + {ok, LPid, LAs} = diameter_sctp_sup:start_child({listen, LRef, T}), + {LPid, LAs}. + +%% open/3 + +open(Addrs, Opts, PortNr) -> + {LAs, Os} = addrs(Addrs, Opts), + {LAs, case gen_sctp:open(gen_opts(portnr(Os, PortNr))) of + {ok, Sock} -> + Sock; + {error, Reason} -> + x({open, Reason}) + end}. + +addrs(Addrs, Opts) -> + case proplists:split(Opts, [ip]) of + {[[]], _} -> + {Addrs, Opts ++ [{ip, A} || A <- Addrs]}; + {[As], Os} -> + LAs = [diameter_lib:ipaddr(A) || {ip, A} <- As], + {LAs, Os ++ [{ip, A} || A <- LAs]} + end. + +portnr(Opts, PortNr) -> + case proplists:get_value(port, Opts) of + undefined -> + [{port, PortNr} | Opts]; + _ -> + Opts + end. + +%% x/1 + +x(Reason) -> + exit({shutdown, Reason}). + +%% gen_opts/1 + +gen_opts(Opts) -> + {L,_} = proplists:split(Opts, [binary, list, mode, active, sctp_events]), + [[],[],[],[],[]] == L orelse ?ERROR({reserved_options, Opts}), + [binary, {active, once} | Opts]. + +%% --------------------------------------------------------------------------- +%% # handle_call/3 +%% --------------------------------------------------------------------------- + +handle_call({{accept, Ref}, Pid}, _, #listener{ref = Ref, + count = N} + = S) -> + {TPid, NewS} = accept(Pid, S), + {reply, {ok, TPid}, NewS#listener{count = N+1}}; + +handle_call(_, _, State) -> + {reply, nok, State}. + +%% --------------------------------------------------------------------------- +%% # handle_cast/2 +%% --------------------------------------------------------------------------- + +handle_cast(_, State) -> + {noreply, State}. + +%% --------------------------------------------------------------------------- +%% # handle_info/2 +%% --------------------------------------------------------------------------- + +handle_info(T, #transport{} = S) -> + {noreply, #transport{} = t(T,S)}; + +handle_info(T, #listener{} = S) -> + {noreply, #listener{} = l(T,S)}. + +%% --------------------------------------------------------------------------- +%% # code_change/3 +%% --------------------------------------------------------------------------- + +code_change(_, State, _) -> + {ok, State}. + +%% --------------------------------------------------------------------------- +%% # terminate/2 +%% --------------------------------------------------------------------------- + +terminate(_, #transport{assoc_id = undefined}) -> + ok; + +terminate(_, #transport{socket = Sock, + mode = {accept, _}, + assoc_id = Id}) -> + close(Sock, Id); + +terminate(_, #transport{socket = Sock}) -> + gen_sctp:close(Sock); + +terminate(_, #listener{socket = Sock}) -> + gen_sctp:close(Sock). + +%% --------------------------------------------------------------------------- + +%% start_timer/1 + +start_timer(#listener{count = 0} = S) -> + S#listener{tref = erlang:start_timer(?LISTENER_TIMEOUT, self(), close)}; +start_timer(S) -> + S. + +%% l/2 +%% +%% Transition listener state. + +%% Incoming message from SCTP. +l({sctp, Sock, _RA, _RP, Data} = Msg, #listener{socket = Sock} = S) -> + setopts(Sock), + case find(Data, S) of + {TPid, NewS} -> + TPid ! Msg, + NewS; + false -> + S + end; + +%% Transport is asking message to be sent. See send/3 for why the send +%% isn't directly from the transport. +l({send, AssocId, StreamId, Bin}, #listener{socket = Sock} = S) -> + send(Sock, AssocId, StreamId, Bin), + S; + +%% Accepting transport has died. One that's awaiting an association ... +l({'DOWN', MRef, process, TPid, _}, #listener{pending = [TPid | Q], + tmap = T, + count = N} + = S) -> + ets:delete(T, MRef), + ets:delete(T, TPid), + start_timer(S#listener{count = N-1, + pending = Q}); + +%% ... ditto and a new transport has already been started ... +l({'DOWN', _, process, _, _} = T, #listener{pending = [TPid | Q]} + = S) -> + #listener{pending = NQ} + = NewS + = l(T, S#listener{pending = Q}), + NewS#listener{pending = [TPid | NQ]}; + +%% ... or not. +l({'DOWN', MRef, process, TPid, _}, #listener{socket = Sock, + tmap = T, + count = N, + pending = {P,Q}} + = S) -> + [{MRef, Id}] = ets:lookup(T, MRef), %% Id = TPid | AssocId + ets:delete(T, MRef), + ets:delete(T, Id), + Id == TPid orelse close(Sock, Id), + case ets:lookup(Q, TPid) of + [{TPid, _}] -> %% transport in the pending queue ... + ets:delete(Q, TPid), + S#listener{pending = {P-1, Q}}; + [] -> %% ... or not + start_timer(S#listener{count = N-1}) + end; + +%% Timeout after the last accepting process has died. +l({timeout, TRef, close = T}, #listener{tref = TRef, + count = 0}) -> + x(T); +l({timeout, _, close}, #listener{} = S) -> + S. + +%% t/2 +%% +%% Transition transport state. + +t(T,S) -> + case transition(T,S) of + ok -> + S; + #transport{} = NS -> + NS; + stop -> + x(T) + end. + +%% transition/2 + +%% Incoming message. +transition({sctp, Sock, _RA, _RP, Data}, #transport{socket = Sock, + mode = {accept, _}} + = S) -> + recv(Data, S); + +transition({sctp, Sock, _RA, _RP, Data}, #transport{socket = Sock} = S) -> + setopts(Sock), + recv(Data, S); + +%% Outgoing message. +transition({diameter, {send, Msg}}, S) -> + send(Msg, S); + +%% Request to close the transport connection. +transition({diameter, {close, Pid}}, #transport{parent = Pid}) -> + stop; + +%% Listener process has died. +transition({'DOWN', _, process, Pid, _}, #transport{mode = {accept, Pid}}) -> + stop; + +%% Parent process has died. +transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> + stop. + +%% Crash on anything unexpected. + +%% accept/2 +%% +%% Start a new transport process or use one that's already been +%% started as a consequence of association establishment. + +%% No pending associations: spawn a new transport. +accept(Pid, #listener{socket = Sock, + tmap = T, + pending = {0,_} = Q} + = S) -> + Arg = {accept, Pid, self(), Sock}, + {ok, TPid} = diameter_sctp_sup:start_child(Arg), + MRef = erlang:monitor(process, TPid), + ets:insert(T, [{MRef, TPid}, {TPid, MRef}]), + {TPid, S#listener{pending = [TPid | Q]}}; +%% Placing the transport in the pending field makes it available to +%% the next association. The stack starts a new accepting transport +%% only after this one brings the connection up (or dies). + +%% Accepting transport has died. This can happen if a new transport is +%% started before the DOWN has arrived. +accept(Pid, #listener{pending = [TPid | {0,_} = Q]} = S) -> + false = is_process_alive(TPid), %% assert + accept(Pid, S#listener{pending = Q}); + +%% Pending associations: attach to the first in the queue. +accept(Pid, #listener{ref = Ref, pending = {N,Q}} = S) -> + TPid = ets:first(Q), + TPid ! {Ref, Pid}, + ets:delete(Q, TPid), + {TPid, S#listener{pending = {N-1, Q}}}. + +%% send/2 + +%% Outbound Diameter message on a specified stream ... +send(#diameter_packet{bin = Bin, transport_data = {stream, SId}}, S) -> + send(SId, Bin, S), + S; + +%% ... or not: rotate through all steams. +send(Bin, #transport{streams = {_, OS}, + os = N} + = S) + when is_binary(Bin) -> + send(N, Bin, S), + S#transport{os = (N + 1) rem OS}. + +%% send/3 + +%% Messages have to be sent from the controlling process, which is +%% probably a bug. Sending from here causes an inet_reply, Sock, +%% Status} message to be sent to the controlling process while +%% gen_sctp:send/4 here hangs. +send(StreamId, Bin, #transport{assoc_id = AId, + mode = {accept, LPid}}) -> + LPid ! {send, AId, StreamId, Bin}; + +send(StreamId, Bin, #transport{socket = Sock, + assoc_id = AId}) -> + send(Sock, AId, StreamId, Bin). + +%% send/4 + +send(Sock, AssocId, Stream, Bin) -> + case gen_sctp:send(Sock, AssocId, Stream, Bin) of + ok -> + ok; + {error, Reason} -> + x({send, Reason}) + end. + +%% recv/2 + +%% Association established ... +recv({[], #sctp_assoc_change{state = comm_up, + outbound_streams = OS, + inbound_streams = IS, + assoc_id = Id}}, + #transport{assoc_id = undefined} + = S) -> + up(S#transport{assoc_id = Id, + streams = {IS, OS}}); + +%% ... or not: try the next address. +recv({[], #sctp_assoc_change{} = E}, + #transport{assoc_id = undefined, + socket = Sock, + mode = {connect = C, {[RA|RAs], RP, Es}}} + = S) -> + S#transport{mode = {C, connect(Sock, RAs, RP, [{RA,E} | Es])}}; + +%% Lost association after establishment. +recv({[], #sctp_assoc_change{}}, _) -> + stop; + +%% Inbound Diameter message. +recv({[#sctp_sndrcvinfo{stream = Id}], Bin}, #transport{parent = Pid}) + when is_binary(Bin) -> + diameter_peer:recv(Pid, #diameter_packet{transport_data = {stream, Id}, + bin = Bin}), + ok; + +recv({[], #sctp_shutdown_event{assoc_id = Id}}, + #transport{assoc_id = Id}) -> + stop. + +%% up/1 + +up(#transport{parent = Pid, + mode = {connect = C, {[RA | _], RP, _}}} + = S) -> + diameter_peer:up(Pid, {RA,RP}), + S#transport{mode = C}; + +up(#transport{parent = Pid, + mode = {accept, _}} + = S) -> + diameter_peer:up(Pid), + S. + +%% find/2 + +find({[#sctp_sndrcvinfo{assoc_id = Id}], _} + = Data, + #listener{tmap = T} + = S) -> + f(ets:lookup(T, Id), Data, S); + +find({_, Rec} = Data, #listener{tmap = T} = S) -> + f(ets:lookup(T, assoc_id(Rec)), Data, S). + +%% New association and a transport waiting for one: use it. +f([], + {_, #sctp_assoc_change{state = comm_up, + assoc_id = Id}}, + #listener{tmap = T, + pending = [TPid | {_,_} = Q]} + = S) -> + [{TPid, MRef}] = ets:lookup(T, TPid), + ets:insert(T, [{MRef, Id}, {Id, TPid}]), + ets:delete(T, TPid), + {TPid, S#listener{pending = Q}}; + +%% New association and no transport start yet: spawn one and place it +%% in the queue. +f([], + {_, #sctp_assoc_change{state = comm_up, + assoc_id = Id}}, + #listener{ref = Ref, + socket = Sock, + tmap = T, + pending = {N,Q}} + = S) -> + Arg = {accept, Ref, self(), Sock, Id}, + {ok, TPid} = diameter_sctp_sup:start_child(Arg), + MRef = erlang:monitor(process, TPid), + ets:insert(T, [{MRef, Id}, {Id, TPid}]), + ets:insert(Q, {TPid, now()}), + {TPid, S#listener{pending = {N+1, Q}}}; + +%% Known association ... +f([{_, TPid}], _, S) -> + {TPid, S}; + +%% ... or not: discard. +f([], _, _) -> + false. + +%% assoc_id/1 + +assoc_id(#sctp_shutdown_event{assoc_id = Id}) -> %% undocumented + Id; +assoc_id(#sctp_assoc_change{assoc_id = Id}) -> + Id; +assoc_id(#sctp_sndrcvinfo{assoc_id = Id}) -> + Id; +assoc_id(#sctp_paddr_change{assoc_id = Id}) -> + Id; +assoc_id(#sctp_adaptation_event{assoc_id = Id}) -> + Id. + +%% connect/4 + +connect(_, [], _, Reasons) -> + x({connect, lists:reverse(Reasons)}); + +connect(Sock, [Addr | AT] = As, Port, Reasons) -> + case gen_sctp:connect_init(Sock, Addr, Port, []) of + ok -> + {As, Port, Reasons}; + {error, _} = E -> + connect(Sock, AT, Port, [{Addr, E} | Reasons]) + end. + +%% setopts/1 + +setopts(Sock) -> + case inet:setopts(Sock, [{active, once}]) of + ok -> ok; + X -> x({setopts, Sock, X}) %% possibly on peer disconnect + end. diff --git a/lib/diameter/src/transport/diameter_sctp_sup.erl b/lib/diameter/src/transport/diameter_sctp_sup.erl new file mode 100644 index 0000000000..3bdae02d68 --- /dev/null +++ b/lib/diameter/src/transport/diameter_sctp_sup.erl @@ -0,0 +1,74 @@ +%% +%% %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_sctp_sup). + +-behaviour(supervisor). + +%% interface +-export([start/0, + start_child/1]). + +%% internal exports +-export([start_link/1, + init/1]). + +%% Start multiple supervisors only because a child can't start another +%% child before supervisor:start_child/2 has returned. +-define(TRANSPORT_SUP, diameter_sctp_transport_sup). +-define(LISTENER_SUP, diameter_sctp_listener_sup). + +%% start/0 +%% +%% Start the TCP-specific supervisors. + +start() -> + diameter_transport_sup:start_child(?TRANSPORT_SUP, ?MODULE), + diameter_transport_sup:start_child(?LISTENER_SUP, ?MODULE). + +%% start_child/1 +%% +%% Start a worker under one of the child supervisors. + +start_child(T) -> + SupRef = case element(1,T) of + connect -> ?TRANSPORT_SUP; + accept -> ?TRANSPORT_SUP; + listen -> ?LISTENER_SUP + end, + supervisor:start_child(SupRef, [T]). + +%% start_link/1 +%% +%% Callback from diameter_transport_sup as a result of start/0. +%% Starts a child supervisor under the transport supervisor. + +start_link(Name) -> + supervisor:start_link({local, Name}, ?MODULE, []). + +init([]) -> + Mod = diameter_sctp, + 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/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl new file mode 100644 index 0000000000..653c114471 --- /dev/null +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -0,0 +1,531 @@ +%% +%% %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_tcp). + +-behaviour(gen_server). + +%% interface +-export([start/3]). + +%% child start from supervisor +-export([start_link/1]). + +%% child start from here +-export([init/1]). + +%% gen_server callbacks +-export([handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3, + terminate/2]). + +-include_lib("diameter/include/diameter.hrl"). + +-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). + +-define(DEFAULT_PORT, 3868). %% RFC 3588, ch 2.1 +-define(LISTENER_TIMEOUT, 30000). +-define(FRAGMENT_TIMEOUT, 1000). + +%% The same gen_server implementation supports three different kinds +%% of processes: an actual transport process, one that will club it to +%% death should the parent die before a connection is established, and +%% a process owning the listening port. + +%% Listener process state. +-record(listener, {socket :: inet:socket(), + count = 1 :: non_neg_integer(), + tref :: reference()}). + +%% Monitor process state. +-record(monitor, + {parent :: pid(), + transport = self() :: pid()}). + +-type tref() :: reference(). %% timer reference +-type length() :: 0..16#FFFFFF. %% message length from Diameter header +-type size() :: non_neg_integer(). %% accumulated binary size +-type frag() :: {length(), size(), binary(), list(binary())} + | binary(). + +%% Accepting/connecting transport process state. +-record(transport, + {socket :: inet:socket(), %% accept or connect socket + parent :: pid(), %% of process that started us + module :: module(), %% gen_tcp-like module + frag = <<>> :: binary() | {tref(), frag()}}). %% message fragment + +%% The usual transport using gen_tcp can be replaced by anything +%% sufficiently gen_tcp-like by passing a 'module' option as the first +%% (for simplicity) transport option. The transport_module diameter_etcp +%% uses this to set itself as the module to call, its start/3 just +%% calling start/3 here with the option set. + +%% --------------------------------------------------------------------------- +%% # start/3 +%% --------------------------------------------------------------------------- + +start({T, Ref}, #diameter_service{capabilities = Caps}, Opts) -> + diameter_tcp_sup:start(), %% start tcp supervisors on demand + {Mod, Rest} = split(Opts), + Addrs = Caps#diameter_caps.host_ip_address, + Arg = {T, Ref, Mod, self(), Rest, Addrs}, + diameter_tcp_sup:start_child(Arg). + +split([{module, M} | Opts]) -> + {M, Opts}; +split(Opts) -> + {gen_tcp, Opts}. + +%% start_link/1 + +start_link(T) -> + proc_lib:start_link(?MODULE, + init, + [T], + infinity, + diameter_lib:spawn_opts(server, [])). + +%% --------------------------------------------------------------------------- +%% # init/1 +%% --------------------------------------------------------------------------- + +init(T) -> + gen_server:enter_loop(?MODULE, [], i(T)). + +%% i/1 + +%% A transport process. +i({T, Ref, Mod, Pid, Opts, Addrs}) + when T == accept; + T == connect -> + erlang:monitor(process, Pid), + %% Since accept/connect might block indefinitely, spawn a process + %% that does nothing but kill us with the parent until call + %% returns. + {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}), + Sock = i(T, Ref, Mod, Pid, Opts, Addrs), + MPid ! {stop, self()}, %% tell the monitor to die + setopts(Mod, Sock), + #transport{parent = Pid, + module = Mod, + socket = Sock}; + +%% A monitor process to kill the transport if the parent dies. +i(#monitor{parent = Pid, transport = TPid} = S) -> + proc_lib:init_ack({ok, self()}), + erlang:monitor(process, Pid), + erlang:monitor(process, TPid), + S; +%% In principle a link between the transport and killer processes +%% could do the same thing: have the accepting/connecting process be +%% killed when the killer process dies as a consequence of parent +%% death. However, a link can be unlinked and this is exactly what +%% gen_tcp seems to so. Links should be left to supervisors. + +i({listen, LRef, APid, {Mod, Opts, Addrs}}) -> + {[LA, LP], Rest} = proplists:split(Opts, [ip, port]), + LAddr = get_addr(LA, Addrs), + LPort = get_port(LP), + {ok, LSock} = Mod:listen(LPort, gen_opts(LAddr, Rest)), + proc_lib:init_ack({ok, self(), {LAddr, LSock}}), + erlang:monitor(process, APid), + true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), + start_timer(#listener{socket = LSock}). + +%% i/6 + +i(accept, Ref, Mod, Pid, Opts, Addrs) -> + {LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}), + proc_lib:init_ack({ok, self(), [LAddr]}), + Sock = ok(accept(Mod, LSock)), + diameter_peer:up(Pid), + Sock; + +i(connect, _, Mod, Pid, Opts, Addrs) -> + {[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]), + LAddr = get_addr(LA, Addrs), + RAddr = get_addr(RA, []), + RPort = get_port(RP), + proc_lib:init_ack({ok, self(), [LAddr]}), + Sock = ok(connect(Mod, RAddr, RPort, gen_opts(LAddr, Rest))), + diameter_peer:up(Pid, {RAddr, RPort}), + Sock. + +ok({ok, T}) -> + T; +ok(No) -> + x(No). + +x(Reason) -> + exit({shutdown, Reason}). + +%% listener/2 + +listener(LRef, T) -> + l(diameter_reg:match({?MODULE, listener, {LRef, '_'}}), LRef, T). + +%% Existing process with the listening socket ... +l([{{?MODULE, listener, {_, AS}}, LPid}], _, _) -> + LPid ! {accept, self()}, + AS; + +%% ... or not: start one. +l([], LRef, T) -> + {ok, _, AS} = diameter_tcp_sup:start_child({listen, LRef, self(), T}), + AS. + +%% get_addr/2 + +get_addr(As, Def) -> + diameter_lib:ipaddr(addr(As, Def)). + +%% Take the first address from the service if several are unspecified. +addr([], [Addr | _]) -> + Addr; +addr([{_, Addr}], _) -> + Addr; +addr(As, Addrs) -> + ?ERROR({invalid_addrs, As, Addrs}). + +%% get_port/1 + +get_port([{_, Port}]) -> + Port; +get_port([]) -> + ?DEFAULT_PORT; +get_port(Ps) -> + ?ERROR({invalid_ports, Ps}). + +%% gen_opts/2 + +gen_opts(LAddr, Opts) -> + {L,_} = proplists:split(Opts, [binary, packet, active]), + [[],[],[]] == L orelse ?ERROR({reserved_options, Opts}), + [binary, + {packet, 0}, + {active, once}, + {ip, LAddr} + | Opts]. + +%% --------------------------------------------------------------------------- +%% # handle_call/3 +%% --------------------------------------------------------------------------- + +handle_call(_, _, State) -> + {reply, nok, State}. + +%% --------------------------------------------------------------------------- +%% # handle_cast/2 +%% --------------------------------------------------------------------------- + +handle_cast(_, State) -> + {noreply, State}. + +%% --------------------------------------------------------------------------- +%% # handle_info/2 +%% --------------------------------------------------------------------------- + +handle_info(T, #transport{} = S) -> + {noreply, #transport{} = t(T,S)}; + +handle_info(T, #listener{} = S) -> + {noreply, #listener{} = l(T,S)}; + +handle_info(T, #monitor{} = S) -> + m(T,S), + x(T). + +%% --------------------------------------------------------------------------- +%% # code_change/3 +%% --------------------------------------------------------------------------- + +code_change(_, State, _) -> + {ok, State}. + +%% --------------------------------------------------------------------------- +%% # terminate/2 +%% --------------------------------------------------------------------------- + +terminate(_, _) -> + ok. + +%% --------------------------------------------------------------------------- + +%% start_timer/1 + +start_timer(#listener{count = 0} = S) -> + S#listener{tref = erlang:start_timer(?LISTENER_TIMEOUT, self(), close)}; +start_timer(S) -> + S. + +%% m/2 +%% +%% Transition monitor state. + +%% Transport is telling us to die. +m({stop, TPid}, #monitor{transport = TPid}) -> + ok; + +%% Transport has died. +m({'DOWN', _, process, TPid, _}, #monitor{transport = TPid}) -> + ok; + +%% Transport parent has died. +m({'DOWN', _, process, Pid, _}, #monitor{parent = Pid, + transport = TPid}) -> + exit(TPid, {shutdown, parent}). + +%% l/2 +%% +%% Transition listener state. + +%% Another accept transport is attaching. +l({accept, TPid}, #listener{count = N} = S) -> + erlang:monitor(process, TPid), + S#listener{count = N+1}; + +%% Accepting process has died. +l({'DOWN', _, process, _, _}, #listener{count = N} = S) -> + start_timer(S#listener{count = N-1}); + +%% Timeout after the last accepting process has died. +l({timeout, TRef, close = T}, #listener{tref = TRef, + count = 0}) -> + x(T); +l({timeout, _, close}, #listener{} = S) -> + S. + +%% t/2 +%% +%% Transition transport state. + +t(T,S) -> + case transition(T,S) of + ok -> + S; + #transport{} = NS -> + NS; + {stop, Reason} -> + x(Reason); + stop -> + x(T) + end. + +%% transition/2 + +%% Incoming message. +transition({tcp, Sock, Data}, #transport{socket = Sock, + module = M} + = S) -> + setopts(M, Sock), + recv(Data, S); + +transition({tcp_closed, Sock}, #transport{socket = Sock}) -> + stop; + +transition({tcp_error, Sock, _Reason} = T, #transport{socket = Sock} = S) -> + ?ERROR({T,S}); + +%% Outgoing message. +transition({diameter, {send, Bin}}, #transport{socket = Sock, + module = M}) -> + case send(M, Sock, Bin) of + ok -> + ok; + {error, Reason} -> + {stop, {send, Reason}} + end; + +%% Request to close the transport connection. +transition({diameter, {close, Pid}}, #transport{parent = Pid, + socket = Sock, + module = M}) -> + M:close(Sock), + stop; + +%% Timeout for reception of outstanding packets. +transition({timeout, TRef, flush}, S) -> + flush(TRef, S); + +%% Request for the local port number. +transition({resolve_port, RPid}, #transport{socket = Sock, + module = M}) + when is_pid(RPid) -> + RPid ! lport(M, Sock), + ok; + +%% Parent process has died. +transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> + stop. + +%% Crash on anything unexpected. + +%% recv/2 +%% +%% Reassemble fragmented messages and extract multple message sent +%% using Nagle. + +recv(Bin, #transport{parent = Pid, frag = Head} = S) -> + S#transport{frag = recv(Pid, Head, Bin)}. + +%% recv/3 + +%% No previous fragment. +recv(Pid, <<>>, Bin) -> + rcv(Pid, Bin); + +recv(Pid, {TRef, Head}, Bin) -> + erlang:cancel_timer(TRef), + rcv(Pid, Head, Bin). + +%% rcv/3 + +%% Not even the first four bytes of the header. +rcv(Pid, Head, Bin) + when is_binary(Head) -> + rcv(Pid, <<Head/binary, Bin/binary>>); + +%% Or enough to know how many bytes to extract. +rcv(Pid, {Len, N, Head, Acc}, Bin) -> + rcv(Pid, Len, N + size(Bin), Head, [Bin | Acc]). + +%% rcv/5 + +%% Extract a message for which we have all bytes. +rcv(Pid, Len, N, Head, Acc) + when Len =< N -> + rcv(Pid, rcv1(Pid, Len, bin(Head, Acc))); + +%% Wait for more packets. +rcv(_, Len, N, Head, Acc) -> + {start_timer(), {Len, N, Head, Acc}}. + +%% rcv/2 + +%% Nothing left. +rcv(_, <<>> = Bin) -> + Bin; + +%% Well, this isn't good. Chances are things will go south from here +%% but if we're lucky then the bytes we have extend to an intended +%% message boundary and we can recover by simply discarding them, +%% which is the result of receiving them. +rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin) + when Len < 20 -> + diameter_peer:recv(Pid, Bin), + <<>>; + +%% Enough bytes to extract a message. +rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin) + when Len =< size(Bin) -> + rcv(Pid, rcv1(Pid, Len, Bin)); + +%% Or not: wait for more packets. +rcv(_, <<_:1/binary, Len:24, _/binary>> = Head) -> + {start_timer(), {Len, size(Head), Head, []}}; + +%% Not even 4 bytes yet. +rcv(_, Head) -> + {start_timer(), Head}. + +%% rcv1/3 + +rcv1(Pid, Len, Bin) -> + <<Msg:Len/binary, Rest/binary>> = Bin, + diameter_peer:recv(Pid, Msg), + Rest. + +%% bin/[12] + +bin(Head, Acc) -> + list_to_binary([Head | lists:reverse(Acc)]). + +bin({_, _, Head, Acc}) -> + bin(Head, Acc); +bin(Bin) + when is_binary(Bin) -> + Bin. + +%% start_timer/0 + +%% An erroneously large message length may leave us with a fragment +%% that lingers if the peer doesn't have anything more to send. Start +%% a timer to force reception if an incoming message doesn't arrive +%% first. This won't stop a peer from sending a large bogus value and +%% following it up however but such a state of affairs can only go on +%% for so long since an unanswered DWR will eventually be the result. +%% +%% An erroneously small message length causes problems as well but +%% since all messages with length problems are discarded this should +%% also eventually lead to watchdog failover. + +start_timer() -> + erlang:start_timer(?FRAGMENT_TIMEOUT, self(), flush). + +flush(TRef, #transport{parent = Pid, frag = {TRef, Head}} = S) -> + diameter_peer:recv(Pid, bin(Head)), + S#transport{frag = <<>>}; +flush(_, S) -> + S. + +%% accept/2 + +accept(gen_tcp, LSock) -> + gen_tcp:accept(LSock); +accept(Mod, LSock) -> + Mod:accept(LSock). + +%% connect/4 + +connect(gen_tcp, Host, Port, Opts) -> + gen_tcp:connect(Host, Port, Opts); +connect(Mod, Host, Port, Opts) -> + Mod:connect(Host, Port, Opts). + +%% send/3 + +send(gen_tcp, Sock, Bin) -> + gen_tcp:send(Sock, Bin); +send(M, Sock, Bin) -> + M:send(Sock, Bin). + +%% setopts/3 + +setopts(gen_tcp, Sock, Opts) -> + inet:setopts(Sock, Opts); +setopts(M, Sock, Opts) -> + M:setopts(Sock, Opts). + +%% setopts/2 + +setopts(M, Sock) -> + case setopts(M, Sock, [{active, once}]) of + ok -> ok; + X -> x({setopts, M, Sock, X}) %% possibly on peer disconnect + end. + +%% lport/2 + +lport(gen_tcp, Sock) -> + inet:port(Sock); +lport(M, Sock) -> + M:port(Sock). diff --git a/lib/diameter/src/transport/diameter_tcp_sup.erl b/lib/diameter/src/transport/diameter_tcp_sup.erl new file mode 100644 index 0000000000..1016fa2d9b --- /dev/null +++ b/lib/diameter/src/transport/diameter_tcp_sup.erl @@ -0,0 +1,78 @@ +%% +%% %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_tcp_sup). + +-behaviour(supervisor). + +%% interface +-export([start/0, + start_child/1]). + +%% internal exports +-export([start_link/1, + init/1]). + +%% Start multiple supervisors only because a child can't start another +%% child before supervisor:start_child/2 has returned, although two is +%% really sufficient (listeners and monitors can be under the same). +-define(TRANSPORT_SUP, diameter_tcp_transport_sup). +-define(LISTENER_SUP, diameter_tcp_listener_sup). +-define(MONITOR_SUP, diameter_tcp_monitor_sup). + +%% start/0 +%% +%% Start the TCP-specific supervisors. + +start() -> + diameter_transport_sup:start_child(?TRANSPORT_SUP, ?MODULE), + diameter_transport_sup:start_child(?LISTENER_SUP, ?MODULE), + diameter_transport_sup:start_child(?MONITOR_SUP, ?MODULE). + +%% start_child/1 +%% +%% Start a worker under one of the child supervisors. + +start_child(T) -> + SupRef = case element(1,T) of + accept -> ?TRANSPORT_SUP; + connect -> ?TRANSPORT_SUP; + listen -> ?LISTENER_SUP; + monitor -> ?MONITOR_SUP + end, + supervisor:start_child(SupRef, [T]). + +%% start_link/1 +%% +%% Callback from diameter_transport_sup as a result of start/0. +%% Starts a child supervisor under the transport supervisor. + +start_link(Name) -> + supervisor:start_link({local, Name}, ?MODULE, []). + +init([]) -> + Mod = diameter_tcp, + 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/transport/diameter_transport_sup.erl b/lib/diameter/src/transport/diameter_transport_sup.erl new file mode 100644 index 0000000000..6457ab78b0 --- /dev/null +++ b/lib/diameter/src/transport/diameter_transport_sup.erl @@ -0,0 +1,68 @@ +%% +%% %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% +%% + +%% +%% Top supervisor for transport processes. +%% + +-module(diameter_transport_sup). + +-behaviour(supervisor). + +-export([start_link/0, %% supervisor start + start_child/2]). + +%% supervisor callback +-export([init/1]). + +%% --------------------------------------------------------------------------- + +%% start_link/0 +%% +%% Start the transport top supervisor. This is started as a child at +%% at application start, from diameter_sup.erl. Protocol-specific +%% supervisors are started as children of this supervisor dynamically +%% by calling start_child/2. (Eg. diameter_tcp_sup:start/0, which +%% is called from diameter_tcp:start/3 to start supervisors the +%% first time a TCP transport process is started.) + +start_link() -> + SupName = {local, ?MODULE}, + supervisor:start_link(SupName, ?MODULE, []). + +%% start_child/2 +%% +%% Start a protocol-specific supervisor under the top supervisor. + +start_child(Name, Module) -> + Spec = {Name, + {Module, start_link, [Name]}, + permanent, + 1000, + supervisor, + [Module]}, + supervisor:start_child(?MODULE, Spec). + +%% --------------------------------------------------------------------------- + +%% Top supervisor callback. +init([]) -> + Flags = {one_for_one, 0, 1}, + Workers = [], %% Each protocol starts its supervisor on demand. + {ok, {Flags, Workers}}. diff --git a/lib/diameter/src/transport/modules.mk b/lib/diameter/src/transport/modules.mk new file mode 100644 index 0000000000..a0dc3cf2c0 --- /dev/null +++ b/lib/diameter/src/transport/modules.mk @@ -0,0 +1,29 @@ +#-*-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% + +MODULES = \ + diameter_etcp \ + diameter_etcp_sup \ + diameter_tcp \ + diameter_tcp_sup \ + diameter_sctp \ + diameter_sctp_sup \ + diameter_transport_sup + +HRL_FILES = |