aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/src/base
diff options
context:
space:
mode:
Diffstat (limited to 'lib/diameter/src/base')
-rw-r--r--lib/diameter/src/base/diameter.app.src28
-rw-r--r--lib/diameter/src/base/diameter.appup.src47
-rw-r--r--lib/diameter/src/base/diameter.erl190
-rw-r--r--lib/diameter/src/base/diameter_app.erl36
-rw-r--r--lib/diameter/src/base/diameter_callback.erl91
-rw-r--r--lib/diameter/src/base/diameter_capx.erl405
-rw-r--r--lib/diameter/src/base/diameter_codec.erl561
-rw-r--r--lib/diameter/src/base/diameter_config.erl676
-rw-r--r--lib/diameter/src/base/diameter_dbg.erl516
-rw-r--r--lib/diameter/src/base/diameter_dict.erl153
-rw-r--r--lib/diameter/src/base/diameter_info.erl869
-rw-r--r--lib/diameter/src/base/diameter_internal.hrl80
-rw-r--r--lib/diameter/src/base/diameter_lib.erl272
-rw-r--r--lib/diameter/src/base/diameter_misc_sup.erl58
-rw-r--r--lib/diameter/src/base/diameter_peer.erl225
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl777
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm_sup.erl63
-rw-r--r--lib/diameter/src/base/diameter_reg.erl327
-rw-r--r--lib/diameter/src/base/diameter_service.erl2903
-rw-r--r--lib/diameter/src/base/diameter_service_sup.erl64
-rw-r--r--lib/diameter/src/base/diameter_session.erl172
-rw-r--r--lib/diameter/src/base/diameter_stats.erl342
-rw-r--r--lib/diameter/src/base/diameter_sup.erl101
-rw-r--r--lib/diameter/src/base/diameter_sync.erl550
-rw-r--r--lib/diameter/src/base/diameter_types.erl537
-rw-r--r--lib/diameter/src/base/diameter_types.hrl139
-rw-r--r--lib/diameter/src/base/diameter_watchdog.erl571
-rw-r--r--lib/diameter/src/base/diameter_watchdog_sup.erl60
28 files changed, 10813 insertions, 0 deletions
diff --git a/lib/diameter/src/base/diameter.app.src b/lib/diameter/src/base/diameter.app.src
new file mode 100644
index 0000000000..c092fdb022
--- /dev/null
+++ b/lib/diameter/src/base/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, [%MODULES%]},
+ {registered, []},
+ {applications, [stdlib, kernel]},
+ {env, []},
+ {mod, {diameter_app, []}}
+ ]}.
diff --git a/lib/diameter/src/base/diameter.appup.src b/lib/diameter/src/base/diameter.appup.src
new file mode 100644
index 0000000000..6d8ceadb92
--- /dev/null
+++ b/lib/diameter/src/base/diameter.appup.src
@@ -0,0 +1,47 @@
+%% This is an -*- erlang -*- file.
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+{"%VSN%",
+ [
+ {"0.9",
+ [
+ {load_module, diameter, soft_purge, soft_purge, []},
+ {load_module, diameter_capx, soft_purge, soft_purge, []},
+ {load_module, diameter_codec, soft_purge, soft_purge, [diameter_lib]},
+ {load_module, diameter_lib, soft_purge, soft_purge, []},
+ {load_module, diameter_types, soft_purge, soft_purge, []},
+ {load_module, diameter_gen_base_accounting, soft_purge, soft_purge, []},
+ {load_module, diameter_gen_base_rfc3588, soft_purge, soft_purge, []},
+ {load_module, diameter_gen_relay, soft_purge, soft_purge, []},
+ {update, diameter_service, soft, soft_purge, soft_purge, [diameter_lib]},
+ {update, diameter_config, soft, soft_purge, soft_purge, []},
+ {update, diameter_peer, soft, soft_purge, soft_purge, []},
+ {update, diameter_peer_fsm, soft, soft_purge, soft_purge, [diameter_lib]},
+ {update, diameter_reg, soft, soft_purge, soft_purge, []},
+ {update, diameter_sctp, soft, soft_purge, soft_purge, []},
+ {update, diameter_stats, soft, soft_purge, soft_purge, []},
+ {update, diameter_sync, soft, soft_purge, soft_purge, []},
+ {update, diameter_watchdog, soft, soft_purge, soft_purge, [diameter_lib]}
+ ]
+ }
+ ],
+ [
+ ]
+}.
diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
new file mode 100644
index 0000000000..2f721421d8
--- /dev/null
+++ b/lib/diameter/src/base/diameter.erl
@@ -0,0 +1,190 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter).
+
+%% Configuration.
+-export([start_service/2,
+ stop_service/1,
+ add_transport/2,
+ remove_transport/2,
+ subscribe/1,
+ unsubscribe/1]).
+
+%% Traffic.
+-export([session_id/1,
+ origin_state_id/0,
+ call/3,
+ call/4]).
+
+%% Information.
+-export([services/0,
+ service_info/2]).
+
+%% Start/stop the application. In a "real" application this should
+%% typically be a consequence of specifying diameter in a release file
+%% rather than by calling start/stop explicitly.
+-export([start/0,
+ stop/0]).
+
+-include("diameter_internal.hrl").
+-include("diameter_types.hrl").
+
+%%% --------------------------------------------------------------------------
+%%% start/0
+%%% --------------------------------------------------------------------------
+
+-spec start()
+ -> ok
+ | {error, term()}.
+
+start() ->
+ application:start(?APPLICATION).
+
+%%% --------------------------------------------------------------------------
+%%% stop/0
+%%% --------------------------------------------------------------------------
+
+-spec stop()
+ -> ok
+ | {error, term()}.
+
+stop() ->
+ application:stop(?APPLICATION).
+
+%%% --------------------------------------------------------------------------
+%%% start_service/2
+%%% --------------------------------------------------------------------------
+
+-spec start_service(service_name(), [service_opt()])
+ -> ok
+ | {error, term()}.
+
+start_service(SvcName, Opts)
+ when is_list(Opts) ->
+ diameter_config:start_service(SvcName, Opts).
+
+%%% --------------------------------------------------------------------------
+%%% stop_service/1
+%%% --------------------------------------------------------------------------
+
+-spec stop_service(service_name())
+ -> ok
+ | {error, term()}.
+
+stop_service(SvcName) ->
+ diameter_config:stop_service(SvcName).
+
+%%% --------------------------------------------------------------------------
+%%% services/0
+%%% --------------------------------------------------------------------------
+
+-spec services()
+ -> [service_name()].
+
+services() ->
+ [Name || {Name, _} <- diameter_service:services()].
+
+%%% --------------------------------------------------------------------------
+%%% service_info/2
+%%% --------------------------------------------------------------------------
+
+-spec service_info(service_name(), atom() | [atom()])
+ -> any().
+
+service_info(SvcName, Option) ->
+ diameter_service:info(SvcName, Option).
+
+%%% --------------------------------------------------------------------------
+%%% add_transport/3
+%%% --------------------------------------------------------------------------
+
+-spec add_transport(service_name(), {listen|connect, [transport_opt()]})
+ -> {ok, transport_ref()}
+ | {error, term()}.
+
+add_transport(SvcName, {T, Opts} = Cfg)
+ when is_list(Opts), (T == connect orelse T == listen) ->
+ diameter_config:add_transport(SvcName, Cfg).
+
+%%% --------------------------------------------------------------------------
+%%% remove_transport/2
+%%% --------------------------------------------------------------------------
+
+-spec remove_transport(service_name(), transport_pred())
+ -> ok | {error, term()}.
+
+remove_transport(SvcName, Pred) ->
+ diameter_config:remove_transport(SvcName, Pred).
+
+%%% --------------------------------------------------------------------------
+%%% # subscribe(SvcName)
+%%%
+%%% Description: Subscribe to #diameter_event{} messages for the specified
+%%% service.
+%%% --------------------------------------------------------------------------
+
+-spec subscribe(service_name())
+ -> true.
+
+subscribe(SvcName) ->
+ diameter_service:subscribe(SvcName).
+
+%%% --------------------------------------------------------------------------
+%%% # unsubscribe(SvcName)
+%%% --------------------------------------------------------------------------
+
+-spec unsubscribe(service_name())
+ -> true.
+
+unsubscribe(SvcName) ->
+ diameter_service:unsubscribe(SvcName).
+
+%%% ----------------------------------------------------------
+%%% # session_id/1
+%%% ----------------------------------------------------------
+
+-spec session_id('DiameterIdentity'())
+ -> 'OctetString'().
+
+session_id(Ident) ->
+ diameter_session:session_id(Ident).
+
+%%% ----------------------------------------------------------
+%%% # origin_state_id/0
+%%% ----------------------------------------------------------
+
+-spec origin_state_id()
+ -> 'Unsigned32'().
+
+origin_state_id() ->
+ diameter_session:origin_state_id().
+
+%%% --------------------------------------------------------------------------
+%%% # call/[34]
+%%% --------------------------------------------------------------------------
+
+-spec call(service_name(), app_alias(), any(), [call_opt()])
+ -> any().
+
+call(SvcName, App, Message, Options) ->
+ diameter_service:call(SvcName, {alias, App}, Message, Options).
+
+call(SvcName, App, Message) ->
+ call(SvcName, App, Message, []).
diff --git a/lib/diameter/src/base/diameter_app.erl b/lib/diameter/src/base/diameter_app.erl
new file mode 100644
index 0000000000..600f7ff04d
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl
new file mode 100644
index 0000000000..6d5c8cdca1
--- /dev/null
+++ b/lib/diameter/src/base/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) ->
+ {send, Pkt}.
+
+%%% ----------------------------------------------------------
+%%% # prepare_retransmit/3
+%%% ----------------------------------------------------------
+
+prepare_retransmit(Pkt, _SvcName, _Peer) ->
+ {send, Pkt}.
+
+%%% ----------------------------------------------------------
+%%% # handle_request/3
+%%% ----------------------------------------------------------
+
+handle_request(_Pkt, _SvcName, _Peer) ->
+ {protocol_error, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED
+
+%%% ----------------------------------------------------------
+%%% # handle_answer/4
+%%% ----------------------------------------------------------
+
+handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) ->
+ Ans.
+
+%%% ---------------------------------------------------------------------------
+%%% # handle_error/4
+%%% ---------------------------------------------------------------------------
+
+handle_error(Reason, _Req, _SvcName, _Peer) ->
+ {error, Reason}.
diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl
new file mode 100644
index 0000000000..138e76411e
--- /dev/null
+++ b/lib/diameter/src/base/diameter_capx.erl
@@ -0,0 +1,405 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% This module builds CER and CEA records for use during capabilities
+%% exchange. All of a CER/CEA is built from AVP values configured on
+%% the service in question but values for Supported-Vendor-Id,
+%% Vendor-Specific-Application-Id, Auth-Application-Id and
+%% Acct-Application-id are also obtained using an older method that
+%% remains only for backwards compatibility. With this method, each
+%% dictionary module was required to export a cer/0 that returned a
+%% diameter_base_CER record (or corresponding list, although the list
+%% is also a later addition). Each returned CER contributes its member
+%% values for the aforementioned four AVPs to the resulting CER, with
+%% remaining AVP's either unspecified or identical to those configured
+%% on the service. Auth-Application-Id and Acct-Application-id were
+%% originally treated a little differently, each callback being
+%% required to return either no value of the same value as the other
+%% callbacks, but this coupled the callback modules unnecessarily. (A
+%% union is backwards compatible to boot.)
+%%
+%% Values obtained from the service and callbacks are all included
+%% when building a CER. Older code with only callback can continue to
+%% use them, newer code should probably stick to service configuration
+%% (since this is more explicit) or mix at their own peril.
+%%
+%% The cer/0 callback is now undocumented (despite never being fully
+%% documented to begin with) and should be considered deprecated even
+%% by those poor souls still using it.
+%%
+
+-module(diameter_capx).
+
+-export([build_CER/1,
+ recv_CER/2,
+ recv_CEA/2,
+ make_caps/2]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_internal.hrl").
+-include("diameter_types.hrl").
+-include("diameter_gen_base_rfc3588.hrl").
+
+-define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS').
+-define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION').
+-define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY').
+
+-define(NO_INBAND_SECURITY, 0).
+-define(TLS, 1).
+
+%% ===========================================================================
+
+-type tried(T) :: {ok, T} | {error, {term(), list()}}.
+
+-spec build_CER(#diameter_caps{})
+ -> tried(#diameter_base_CER{}).
+
+build_CER(Caps) ->
+ try_it([fun bCER/1, Caps]).
+
+-spec recv_CER(#diameter_base_CER{}, #diameter_service{})
+ -> tried({['Unsigned32'()], #diameter_caps{}, #diameter_base_CEA{}}).
+
+recv_CER(CER, Svc) ->
+ try_it([fun rCER/2, CER, Svc]).
+
+-spec recv_CEA(#diameter_base_CEA{}, #diameter_service{})
+ -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}).
+
+recv_CEA(CEA, Svc) ->
+ try_it([fun rCEA/2, CEA, Svc]).
+
+make_caps(Caps, Opts) ->
+ try_it([fun mk_caps/2, Caps, Opts]).
+
+%% ===========================================================================
+%% ===========================================================================
+
+try_it([Fun | Args]) ->
+ try apply(Fun, Args) of
+ T -> {ok, T}
+ catch
+ throw: ?FAILURE(Reason) -> {error, {Reason, Args}}
+ end.
+
+%% mk_caps/2
+
+mk_caps(Caps0, Opts) ->
+ {Caps, _} = lists:foldl(fun set_cap/2,
+ {Caps0, #diameter_caps{_ = false}},
+ Opts),
+ Caps.
+
+-define(SC(K,F),
+ set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) ->
+ {Caps#diameter_caps{F = cap(K, Val)}, C#diameter_caps{F = true}}).
+
+?SC('Origin-Host', origin_host);
+?SC('Origin-Realm', origin_realm);
+?SC('Host-IP-Address', host_ip_address);
+?SC('Vendor-Id', vendor_id);
+?SC('Product-Name', product_name);
+?SC('Origin-State-Id', origin_state_id);
+?SC('Supported-Vendor-Id', supported_vendor_id);
+?SC('Auth-Application-Id', auth_application_id);
+?SC('Inband-Security-Id', inband_security_id);
+?SC('Acct-Application-Id', acct_application_id);
+?SC('Vendor-Specific-Application-Id', vendor_specific_application_id);
+?SC('Firmware-Revision', firmware_revision);
+
+set_cap({Key, _}, _) ->
+ ?THROW({duplicate, Key}).
+
+cap(K, V)
+ when K == 'Origin-Host';
+ K == 'Origin-Realm';
+ K == 'Vendor-Id';
+ K == 'Product-Name' ->
+ V;
+
+cap('Host-IP-Address', Vs)
+ when is_list(Vs) ->
+ lists:map(fun ipaddr/1, Vs);
+
+cap('Firmware-Revision', V) ->
+ [V];
+
+cap(_, Vs)
+ when is_list(Vs) ->
+ Vs;
+
+cap(K, V) ->
+ ?THROW({invalid, K, V}).
+
+ipaddr(A) ->
+ try
+ diameter_lib:ipaddr(A)
+ catch
+ error: {invalid_address, _} = T ->
+ ?THROW(T)
+ end.
+
+%% bCER/1
+%%
+%% Build a CER record to send to a remote peer.
+
+%% Use the fact that diameter_caps has the same field names as CER.
+bCER(#diameter_caps{} = Rec) ->
+ #diameter_base_CER{}
+ = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]).
+
+%% rCER/2
+%%
+%% Build a CEA record to send to a remote peer in response to an
+%% incoming CER. RFC 3588 gives no guidance on what should be sent
+%% here: should we advertise applications that the peer hasn't sent in
+%% its CER (aside from the relay application) or not? If we send
+%% applications that the peer hasn't advertised then the peer may have
+%% to be aware of the possibility. If we don't then we just look like
+%% a server that supports a subset (possibly) of what the client
+%% advertised, so this feels like the path of least incompatibility.
+%% However, the current draft standard (draft-ietf-dime-rfc3588bis-26,
+%% expires 24 July 2011) says this in section 5.3, Capabilities
+%% Exchange:
+%%
+%% The receiver of the Capabilities-Exchange-Request (CER) MUST
+%% determine common applications by computing the intersection of its
+%% own set of supported Application Id against all of the application
+%% identifier AVPs (Auth-Application-Id, Acct-Application-Id and Vendor-
+%% Specific-Application-Id) present in the CER. The value of the
+%% Vendor-Id AVP in the Vendor-Specific-Application-Id MUST NOT be used
+%% during computation. The sender of the Capabilities-Exchange-Answer
+%% (CEA) SHOULD include all of its supported applications as a hint to
+%% the receiver regarding all of its application capabilities.
+%%
+%% Both RFC and the draft also say this:
+%%
+%% The receiver only issues commands to its peers that have advertised
+%% support for the Diameter application that defines the command. A
+%% Diameter node MUST cache the supported applications in order to
+%% ensure that unrecognized commands and/or AVPs are not unnecessarily
+%% sent to a peer.
+%%
+%% That is, each side sends all of its capabilities and is responsible for
+%% not sending commands that the peer doesn't support.
+
+%% 6.10. Inband-Security-Id AVP
+%%
+%% NO_INBAND_SECURITY 0
+%% This peer does not support TLS. This is the default value, if the
+%% AVP is omitted.
+%%
+%% TLS 1
+%% This node supports TLS security, as defined by [TLS].
+
+rCER(CER, #diameter_service{capabilities = LCaps} = Svc) ->
+ #diameter_base_CEA{}
+ = CEA
+ = cea_from_cer(bCER(LCaps)),
+
+ RCaps = capx_to_caps(CER),
+ SApps = common_applications(LCaps, RCaps, Svc),
+
+ {SApps,
+ RCaps,
+ build_CEA(SApps,
+ LCaps,
+ RCaps,
+ CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}.
+
+%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION
+%% in the CEA and SHOULD disconnect the transport. However, we have
+%% no way to guarantee the send before disconnecting.
+
+build_CEA([], _, _, CEA) ->
+ CEA#diameter_base_CEA{'Result-Code' = ?NOAPP};
+
+build_CEA(_, LCaps, RCaps, CEA) ->
+ case common_security(LCaps, RCaps) of
+ [] ->
+ CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY};
+ [_] = IS ->
+ CEA#diameter_base_CEA{'Inband-Security-Id' = IS}
+ end.
+
+%% common_security/2
+
+common_security(#diameter_caps{inband_security_id = LS},
+ #diameter_caps{inband_security_id = RS}) ->
+ cs(LS, RS).
+
+%% Unspecified is equivalent to NO_INBAND_SECURITY.
+cs([], RS) ->
+ cs([?NO_INBAND_SECURITY], RS);
+cs(LS, []) ->
+ cs(LS, [?NO_INBAND_SECURITY]);
+
+%% Agree on TLS if both parties support it. When sending CEA, this is
+%% to ensure the peer is clear that we will be expecting a TLS
+%% handshake since there is no ssl:maybe_accept that would allow the
+%% peer to choose between TLS or not upon reception of our CEA. When
+%% receiving CEA it deals with a server that isn't explicit about its choice.
+%% TODO: Make the choice configurable.
+cs(LS, RS) ->
+ Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS),
+ ordsets:from_list(RS))),
+ case lists:member(?TLS, Is) of
+ true ->
+ [?TLS];
+ false when [] == Is ->
+ Is;
+ false ->
+ [hd(Is)] %% probably NO_INBAND_SECURITY
+ end.
+%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and
+%% TLS but don't enforce this. In theory this allows some other
+%% security mechanism we don't have to know about, although in
+%% practice something there may be a need for more synchronization
+%% than notification by way of an event subscription offers.
+
+%% cea_from_cer/1
+
+%% CER is a subset of CEA, the latter adding Result-Code and a few
+%% more AVP's.
+cea_from_cer(#diameter_base_CER{} = CER) ->
+ lists:foldl(fun(F,A) -> to_cea(CER, F, A) end,
+ #diameter_base_CEA{},
+ record_info(fields, diameter_base_CER)).
+
+to_cea(CER, Field, CEA) ->
+ try ?BASE:'#get-'(Field, CER) of
+ V -> ?BASE:'#set-'({Field, V}, CEA)
+ catch
+ error: _ -> CEA
+ end.
+
+%% rCEA/2
+
+rCEA(#diameter_base_CEA{'Result-Code' = RC}
+ = CEA,
+ #diameter_service{capabilities = LCaps}
+ = Svc) ->
+ RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}),
+
+ RCaps = capx_to_caps(CEA),
+ SApps = common_applications(LCaps, RCaps, Svc),
+
+ [] == SApps andalso ?THROW(no_common_applications),
+
+ IS = common_security(LCaps, RCaps),
+
+ [] == IS andalso ?THROW(no_common_security),
+
+ {SApps, IS, RCaps};
+
+rCEA(CEA, _Svc) ->
+ ?THROW({invalid, CEA}).
+
+%% capx_to_caps/1
+
+capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH,
+ 'Origin-Realm' = OR,
+ 'Host-IP-Address' = IP,
+ 'Vendor-Id' = VId,
+ 'Product-Name' = PN,
+ 'Origin-State-Id' = OSI,
+ 'Supported-Vendor-Id' = SV,
+ 'Auth-Application-Id' = Auth,
+ 'Inband-Security-Id' = IS,
+ 'Acct-Application-Id' = Acct,
+ 'Vendor-Specific-Application-Id' = VSA,
+ 'Firmware-Revision' = FR,
+ 'AVP' = X}) ->
+ #diameter_caps{origin_host = OH,
+ origin_realm = OR,
+ vendor_id = VId,
+ product_name = PN,
+ origin_state_id = OSI,
+ host_ip_address = IP,
+ supported_vendor_id = SV,
+ auth_application_id = Auth,
+ inband_security_id = IS,
+ acct_application_id = Acct,
+ vendor_specific_application_id = VSA,
+ firmware_revision = FR,
+ avp = X};
+
+capx_to_caps(#diameter_base_CER{} = CER) ->
+ capx_to_caps(cea_from_cer(CER)).
+
+%% ---------------------------------------------------------------------------
+%% ---------------------------------------------------------------------------
+
+%% common_applications/3
+%%
+%% Identify the (local) applications to be supported on the connection
+%% in question.
+
+common_applications(LCaps, RCaps, #diameter_service{applications = Apps}) ->
+ LA = app_union(LCaps),
+ RA = app_union(RCaps),
+
+ lists:foldl(fun(I,A) -> ca(I, Apps, RA, A) end, [], LA).
+
+ca(Id, Apps, RA, Acc) ->
+ Relay = lists:member(?APP_ID_RELAY, RA),
+ #diameter_app{alias = Alias} = find_app(Id, Apps),
+ tcons(Relay %% peer is a relay
+ orelse ?APP_ID_RELAY == Id %% we're a relay
+ orelse lists:member(Id, RA), %% app is supported by the peer
+ Id,
+ Alias,
+ Acc).
+%% 5.3 of the RFC states that a peer advertising itself as a relay must
+%% be interpreted as having common applications.
+
+%% Extract the list of all application identifiers from Auth-Application-Id,
+%% Acct-Application-Id and Vendor-Specific-Application-Id.
+app_union(#diameter_caps{auth_application_id = U,
+ acct_application_id = C,
+ vendor_specific_application_id = V}) ->
+ set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)).
+
+vsa_apps(#'diameter_base_Vendor-Specific-Application-Id'
+ {'Auth-Application-Id' = U,
+ 'Acct-Application-Id' = C}) ->
+ U ++ C;
+vsa_apps(L) ->
+ Rec = ?BASE:'#new-'('diameter_base_Vendor-Specific-Application-Id', L),
+ vsa_apps(Rec).
+
+%% It's a configuration error for a locally advertised application not
+%% to be represented in Apps. Don't just match on lists:keyfind/3 in
+%% order to generate a more helpful error.
+find_app(Id, Apps) ->
+ case lists:keyfind(Id, #diameter_app.id, Apps) of
+ #diameter_app{} = A ->
+ A;
+ false ->
+ ?THROW({app_not_configured, Id})
+ end.
+
+set_list(L) ->
+ sets:to_list(sets:from_list(L)).
+
+tcons(true, K, V, Acc) ->
+ [{K,V} | Acc];
+tcons(false, _, _, Acc) ->
+ Acc.
diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl
new file mode 100644
index 0000000000..d88f42fb7c
--- /dev/null
+++ b/lib/diameter/src/base/diameter_codec.erl
@@ -0,0 +1,561 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_codec).
+
+-export([encode/2,
+ decode/2,
+ decode/3,
+ collect_avps/1,
+ decode_header/1,
+ sequence_numbers/1,
+ hop_by_hop_id/2,
+ msg_name/1,
+ msg_id/1]).
+
+%% Towards generated encoders (from diameter_gen.hrl).
+-export([pack_avp/1,
+ pack_avp/2]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_internal.hrl").
+
+-define(MASK(N,I), ((I) band (1 bsl (N)))).
+
+%% 0 1 2 3
+%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | Version | Message Length |
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | command flags | Command-Code |
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | Application-ID |
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | Hop-by-Hop Identifier |
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | End-to-End Identifier |
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | AVPs ...
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-
+
+%%% ---------------------------------------------------------------------------
+%%% # encode/[2-4]
+%%% ---------------------------------------------------------------------------
+
+encode(Mod, #diameter_packet{} = Pkt) ->
+ try
+ e(Mod, Pkt)
+ catch
+ error: Reason ->
+ %% Be verbose rather than letting the emulator truncate the
+ %% error report.
+ X = {Reason, ?STACK},
+ diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}),
+ exit(X)
+ end;
+
+encode(Mod, Msg) ->
+ Seq = diameter_session:sequence(),
+ Hdr = #diameter_header{version = ?DIAMETER_VERSION,
+ end_to_end_id = Seq,
+ hop_by_hop_id = Seq},
+ encode(Mod, #diameter_packet{header = Hdr,
+ msg = Msg}).
+
+e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) ->
+ Avps = encode_avps(As),
+ Length = size(Avps) + 20,
+
+ #diameter_header{version = Vsn,
+ cmd_code = Code,
+ application_id = Aid,
+ hop_by_hop_id = Hid,
+ end_to_end_id = Eid}
+ = Hdr,
+
+ Flags = make_flags(0, Hdr),
+
+ Pkt#diameter_packet{bin = <<Vsn:8, Length:24,
+ Flags:8, Code:24,
+ Aid:32,
+ Hid:32,
+ Eid:32,
+ Avps/binary>>};
+
+e(Mod0, #diameter_packet{header = Hdr, msg = Msg} = Pkt) ->
+ #diameter_header{version = Vsn,
+ hop_by_hop_id = Hid,
+ end_to_end_id = Eid}
+ = Hdr,
+
+ {Mod, MsgName} = rec2msg(Mod0, Msg),
+ {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr),
+ Flags = make_flags(Flags0, Hdr),
+
+ Avps = encode_avps(Mod, MsgName, values(Msg)),
+ Length = size(Avps) + 20,
+
+ Pkt#diameter_packet{header = Hdr#diameter_header
+ {length = Length,
+ cmd_code = Code,
+ application_id = Aid,
+ is_request = 0 /= ?MASK(7, Flags),
+ is_proxiable = 0 /= ?MASK(6, Flags),
+ is_error = 0 /= ?MASK(5, Flags),
+ is_retransmitted = 0 /= ?MASK(4, Flags)},
+ bin = <<Vsn:8, Length:24,
+ Flags:8, Code:24,
+ Aid:32,
+ Hid:32,
+ Eid:32,
+ Avps/binary>>}.
+
+%% make_flags/2
+
+make_flags(Flags0, #diameter_header{is_request = R,
+ is_proxiable = P,
+ is_error = E,
+ is_retransmitted = T}) ->
+ {Flags, 3} = lists:foldl(fun(B,{F,N}) -> {mf(B,F,N), N-1} end,
+ {Flags0, 7},
+ [R,P,E,T]),
+ Flags.
+
+mf(undefined, F, _) ->
+ F;
+mf(B, F, N) -> %% reset the affected bit
+ (F bxor (F band (1 bsl N))) bor bit(B, N).
+
+bit(true, N) -> 1 bsl N;
+bit(false, _) -> 0.
+
+%% values/1
+
+values([H|T])
+ when is_atom(H) ->
+ T;
+values(Avps) ->
+ Avps.
+
+%% encode_avps/3
+
+%% Specifying values as a #diameter_avp list bypasses arity and other
+%% checks: the values are expected to be already encoded and the AVP's
+%% presented are simply sent. This is needed for relay agents, since
+%% these have to be able to resend whatever comes.
+
+%% Message as a list of #diameter_avp{} ...
+encode_avps(_, _, [#diameter_avp{} | _] = Avps) ->
+ encode_avps(reorder(Avps, [], Avps));
+
+%% ... or as a tuple list or record.
+encode_avps(Mod, MsgName, Values) ->
+ Mod:encode_avps(MsgName, Values).
+
+%% reorder/1
+
+reorder([#diameter_avp{index = 0} | _] = Avps, Acc, _) ->
+ Avps ++ Acc;
+
+reorder([#diameter_avp{index = N} = A | Avps], Acc, _)
+ when is_integer(N) ->
+ lists:reverse(Avps, [A | Acc]);
+
+reorder([H | T], Acc, Avps) ->
+ reorder(T, [H | Acc], Avps);
+
+reorder([], Acc, _) ->
+ Acc.
+
+%% encode_avps/1
+
+encode_avps(Avps) ->
+ list_to_binary(lists:map(fun pack_avp/1, Avps)).
+
+%% msg_header/3
+
+msg_header(Mod, MsgName, Header) ->
+ {Code, Flags, ApplId} = h(Mod, MsgName, Header),
+ {Code, p(Flags, Header), ApplId}.
+
+%% 6.2 of 3588 requires the same 'P' bit on an answer as on the
+%% request.
+
+p(Flags, #diameter_header{is_request = true,
+ is_proxiable = P}) ->
+ Flags band (2#10110000 bor choose(P, 2#01000000, 0));
+p(Flags, _) ->
+ Flags.
+
+h(Mod, 'answer-message' = MsgName, Header) ->
+ ?BASE = Mod,
+ #diameter_header{cmd_code = Code} = Header,
+ {_, Flags, ApplId} = ?BASE:msg_header(MsgName),
+ {Code, Flags, ApplId};
+
+h(Mod, MsgName, _) ->
+ Mod:msg_header(MsgName).
+
+%% rec2msg/2
+
+rec2msg(_, ['answer-message' = M | _]) ->
+ {?BASE, M};
+
+rec2msg(Mod, [MsgName|_])
+ when is_atom(MsgName) ->
+ {Mod, MsgName};
+
+rec2msg(Mod, Rec) ->
+ R = element(1, Rec),
+ A = 'answer-message',
+ case ?BASE:msg2rec(A) of
+ R ->
+ {?BASE, A};
+ _ ->
+ {Mod, Mod:rec2msg(R)}
+ end.
+
+%%% ---------------------------------------------------------------------------
+%%% # decode/2
+%%% ---------------------------------------------------------------------------
+
+%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors.
+
+decode(Mod, Pkt) ->
+ decode(Mod:id(), Mod, Pkt).
+
+%% If we're a relay application then just extract the avp's without
+%% any decoding of their data since we don't know the application in
+%% question.
+decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) ->
+ case collect_avps(Pkt) of
+ {Bs, As} ->
+ Pkt#diameter_packet{avps = As,
+ errors = [Bs]};
+ As ->
+ Pkt#diameter_packet{avps = As}
+ end;
+
+%% Otherwise decode using the dictionary.
+decode(_, Mod, #diameter_packet{header = Hdr} = Pkt)
+ when is_atom(Mod) ->
+ #diameter_header{cmd_code = CmdCode,
+ is_request = IsRequest,
+ is_error = IsError}
+ = Hdr,
+
+ {M, MsgName} = if IsError andalso not IsRequest ->
+ {?BASE, 'answer-message'};
+ true ->
+ {Mod, Mod:msg_name(CmdCode, IsRequest)}
+ end,
+
+ decode_avps(MsgName, M, Pkt, collect_avps(Pkt));
+
+decode(Id, Mod, Bin)
+ when is_bitstring(Bin) ->
+ decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}).
+
+decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ...
+ ?LOG(invalid, Pkt#diameter_packet.bin),
+ #diameter_packet{errors = Failed}
+ = P
+ = decode_avps(MsgName, Mod, Pkt, Avps),
+ P#diameter_packet{errors = [Bs | Failed]};
+
+decode_avps('', Mod, Pkt, Avps) -> %% unknown message ...
+ ?LOG(unknown, {Mod, Pkt#diameter_packet.header}),
+ Pkt#diameter_packet{avps = lists:reverse(Avps),
+ errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED
+%% msg = undefined identifies this case.
+
+decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not
+ {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps),
+ ?LOGC([] /= Failed, failed, {Mod, Failed}),
+ Pkt#diameter_packet{msg = Rec,
+ errors = Failed,
+ avps = As}.
+
+%%% ---------------------------------------------------------------------------
+%%% # decode_header/1
+%%% ---------------------------------------------------------------------------
+
+decode_header(<<Version:8,
+ MsgLength:24,
+ CmdFlags:1/binary,
+ CmdCode:24,
+ ApplicationId:32,
+ HopByHopId:32,
+ EndToEndId:32,
+ _/bitstring>>) ->
+ <<R:1, P:1, E:1, T:1, _:4>>
+ = CmdFlags,
+ %% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored
+ %% by the receiver.
+
+ %% The RFC is quite unclear about the order of the bits in this
+ %% case. It writes
+ %%
+ %% 0 1 2 3 4 5 6 7
+ %% +-+-+-+-+-+-+-+-+
+ %% |R P E T r r r r|
+ %% +-+-+-+-+-+-+-+-+
+ %%
+ %% in defining these but the scale refers to the (big endian)
+ %% transmission order, first to last, not the bit order. That is,
+ %% R is the high order bit. It's odd that a standard reserves
+ %% low-order bit rather than high-order ones.
+
+ #diameter_header{version = Version,
+ length = MsgLength,
+ cmd_code = CmdCode,
+ application_id = ApplicationId,
+ hop_by_hop_id = HopByHopId,
+ end_to_end_id = EndToEndId,
+ is_request = 1 == R,
+ is_proxiable = 1 == P,
+ is_error = 1 == E,
+ is_retransmitted = 1 == T};
+
+decode_header(_) ->
+ false.
+
+%%% ---------------------------------------------------------------------------
+%%% # sequence_numbers/1
+%%% ---------------------------------------------------------------------------
+
+%% The End-To-End identifier must be unique for at least 4 minutes. We
+%% maintain a 24-bit wraparound counter, and add an 8-bit persistent
+%% wraparound counter. The 8-bit counter is incremented each time the
+%% system is restarted.
+
+sequence_numbers(#diameter_packet{bin = Bin})
+ when is_binary(Bin) ->
+ sequence_numbers(Bin);
+
+sequence_numbers(#diameter_packet{header = #diameter_header{} = H}) ->
+ sequence_numbers(H);
+
+sequence_numbers(#diameter_header{hop_by_hop_id = H,
+ end_to_end_id = E}) ->
+ {H,E};
+
+sequence_numbers(<<_:12/binary, H:32, E:32, _/binary>>) ->
+ {H,E}.
+
+%%% ---------------------------------------------------------------------------
+%%% # hop_by_hop_id/2
+%%% ---------------------------------------------------------------------------
+
+hop_by_hop_id(Id, <<H:12/binary, _:32, T/binary>>) ->
+ <<H/binary, Id:32, T/binary>>.
+
+%%% ---------------------------------------------------------------------------
+%%% # msg_name/1
+%%% ---------------------------------------------------------------------------
+
+msg_name(#diameter_header{application_id = ?APP_ID_COMMON,
+ cmd_code = C,
+ is_request = R}) ->
+ ?BASE:msg_name(C,R);
+
+msg_name(Hdr) ->
+ msg_id(Hdr).
+
+%% Note that messages in different applications could have the same
+%% name.
+
+%%% ---------------------------------------------------------------------------
+%%% # msg_id/1
+%%% ---------------------------------------------------------------------------
+
+msg_id(#diameter_packet{msg = [#diameter_header{} = Hdr | _]}) ->
+ msg_id(Hdr);
+
+msg_id(#diameter_packet{header = #diameter_header{} = Hdr}) ->
+ msg_id(Hdr);
+
+msg_id(#diameter_header{application_id = A,
+ cmd_code = C,
+ is_request = R}) ->
+ {A, C, if R -> 1; true -> 0 end};
+
+msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) ->
+ {ApplId, CmdCode, Rbit}.
+
+%%% ---------------------------------------------------------------------------
+%%% # collect_avps/1
+%%% ---------------------------------------------------------------------------
+
+%% Note that the returned list of AVP's is reversed relative to their
+%% order in the binary. Note also that grouped avp's aren't unraveled,
+%% only those at the top level.
+
+collect_avps(#diameter_packet{bin = Bin}) ->
+ <<_:20/binary, Avps/bitstring>> = Bin,
+ collect_avps(Avps);
+
+collect_avps(Bin) ->
+ collect_avps(Bin, 0, []).
+
+collect_avps(<<>>, _, Acc) ->
+ Acc;
+collect_avps(Bin, N, Acc) ->
+ try split_avp(Bin) of
+ {Rest, AVP} ->
+ collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc])
+ catch
+ ?FAILURE(_) ->
+ {Bin, Acc}
+ end.
+
+%% 0 1 2 3
+%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | AVP Code |
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% |V M P r r r r r| AVP Length |
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | Vendor-ID (opt) |
+%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+%% | Data ...
+%% +-+-+-+-+-+-+-+-+
+
+%% split_avp/1
+
+split_avp(Bin) ->
+ 8 =< size(Bin) orelse ?THROW(truncated_header),
+
+ <<Code:32, Flags:1/binary, Length:24, Rest/bitstring>>
+ = Bin,
+
+ DataSize = Length - 8, % size(Code+Flags+Length) = 8 octets
+ PadSize = (4 - (DataSize rem 4)) rem 4,
+
+ DataSize + PadSize =< size(Rest)
+ orelse ?THROW(truncated_data),
+
+ <<Data:DataSize/binary, _:PadSize/binary, R/bitstring>>
+ = Rest,
+ <<Vbit:1, Mbit:1, Pbit:1, _Reserved:5>>
+ = Flags,
+
+ 0 == Vbit orelse 4 =< size(Data)
+ orelse ?THROW(truncated_vendor_id),
+
+ {Vid, D} = vid(Vbit, Data),
+ {R, #diameter_avp{code = Code,
+ vendor_id = Vid,
+ is_mandatory = 1 == Mbit,
+ need_encryption = 1 == Pbit,
+ data = D}}.
+
+%% The RFC is a little misleading when stating that OctetString is
+%% padded to a 32-bit boundary while other types align naturally. All
+%% other types are already multiples of 32 bits so there's no need to
+%% distinguish between types here. Any invalid lengths will result in
+%% decode error in diameter_types.
+
+vid(1, <<Vid:32, Data/bitstring>>) ->
+ {Vid, Data};
+vid(0, Data) ->
+ {undefined, Data}.
+
+%%% ---------------------------------------------------------------------------
+%%% # pack_avp/1
+%%% ---------------------------------------------------------------------------
+
+%% The normal case here is data as an #diameter_avp{} list or an
+%% iolist, which are the cases that generated codec modules use. The
+%% other case is as a convenience in the relay case in which the
+%% dictionary doesn't know about specific AVP's.
+
+%% Grouped AVP whose components need packing ...
+pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) ->
+ pack_avp(A#diameter_avp{data = encode_avps(Avps)});
+
+%% ... data as a type/value tuple, possibly with header data, ...
+pack_avp(#diameter_avp{data = {Type, Value}} = A)
+ when is_atom(Type) ->
+ pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)});
+pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) ->
+ pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value)));
+pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}})
+ when is_binary(Bin) ->
+ pack_avp(T, Bin);
+pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) ->
+ {Code, _Flags, Vid} = Hdr = Dict:avp_header(Name),
+ {Name, Type} = Dict:avp_name(Code, Vid),
+ pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}});
+
+%% ... or as an iolist.
+pack_avp(#diameter_avp{code = Code,
+ vendor_id = V,
+ is_mandatory = M,
+ need_encryption = P,
+ data = Data}) ->
+ Flags = lists:foldl(fun flag_avp/2, 0, [{V /= undefined, 2#10000000},
+ {M, 2#01000000},
+ {P, 2#00100000}]),
+ pack_avp({Code, Flags, V}, iolist_to_binary(Data)).
+
+flag_avp({true, B}, F) ->
+ F bor B;
+flag_avp({false, _}, F) ->
+ F.
+
+%%% ---------------------------------------------------------------------------
+%%% # pack_avp/2
+%%% ---------------------------------------------------------------------------
+
+pack_avp({Code, Flags, VendorId}, Bin)
+ when is_binary(Bin) ->
+ Sz = size(Bin),
+ pack_avp(Code, Flags, VendorId, Sz, pad(Sz rem 4, Bin)).
+
+pad(0, Bin) ->
+ Bin;
+pad(N, Bin) ->
+ P = 8*(4-N),
+ <<Bin/binary, 0:P>>.
+%% Note that padding is not included in the length field as mandated by
+%% the RFC.
+
+%% pack_avp/5
+%%
+%% Prepend the vendor id as required.
+
+pack_avp(Code, Flags, Vid, Sz, Bin)
+ when 0 == Flags band 2#10000000 ->
+ undefined = Vid, %% sanity check
+ pack_avp(Code, Flags, Sz, Bin);
+
+pack_avp(Code, Flags, Vid, Sz, Bin) ->
+ pack_avp(Code, Flags, Sz+4, <<Vid:32, Bin/binary>>).
+
+%% pack_avp/4
+
+pack_avp(Code, Flags, Sz, Bin) ->
+ Length = Sz + 8,
+ <<Code:32, Flags:8, Length:24, Bin/binary>>.
+
+%% ===========================================================================
+
+choose(true, X, _) -> X;
+choose(false, _, X) -> X.
diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl
new file mode 100644
index 0000000000..a6b48fe65b
--- /dev/null
+++ b/lib/diameter/src/base/diameter_config.erl
@@ -0,0 +1,676 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% This module writes service/transport configuration to the table
+%% diameter_config, so that the config will survive service process
+%% death, and then turns it into calls towards diameter_service. It
+%% also restarts services upon their death.
+%%
+%% The table diameter_config is only written here while
+%% diameter_service reads. This is all somewhat after the fact. Once
+%% upon a time the config was only stored in the service process,
+%% causing much grief if these processes died (which they did with
+%% some regularity) and one was forced to reconfigure. This module was
+%% then inserted into the service start in order to keep a more
+%% permanent record of the config. That said, service processes are
+%% now much more robust than they once were and crashing is a thing of
+%% the past.
+%%
+
+-module(diameter_config).
+-compile({no_auto_import, [monitor/2]}).
+
+-behaviour(gen_server).
+
+-export([start_service/2,
+ stop_service/1,
+ add_transport/2,
+ remove_transport/2,
+ have_transport/2,
+ lookup/1]).
+
+%% child server start
+-export([start_link/0]).
+
+%% gen_server callbacks
+-export([init/1,
+ terminate/2,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ code_change/3]).
+
+%% diameter_sync requests.
+-export([sync/1]).
+
+%% debug
+-export([state/0,
+ uptime/0]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_internal.hrl").
+
+%% Server state.
+-record(state, {id = now()}).
+
+%% Registered name of the server.
+-define(SERVER, ?MODULE).
+
+%% Table config is written to.
+-define(TABLE, ?MODULE).
+
+%% Workaround for dialyzer's lack of understanding of match specs.
+-type match(T)
+ :: T | '_' | '$1' | '$2' | '$3' | '$4'.
+
+%% Configuration records in ?TABLE.
+
+-record(service,
+ {name,
+ rec :: match(#diameter_service{}),
+ options :: match(list())}).
+
+-record(transport,
+ {service, %% name
+ ref = make_ref() :: match(reference()),
+ type :: match(connect | listen),
+ options :: match(list())}).
+
+%% Monitor entry in ?TABLE.
+-record(monitor, {mref = make_ref() :: reference(),
+ service}). %% name
+
+%% Time to lay low before restarting a dead service.
+-define(RESTART_SLEEP, 2000).
+
+%% A minimal diameter_caps for checking for valid capabilities values.
+-define(EXAMPLE_CAPS,
+ #diameter_caps{origin_host = "TheHost",
+ origin_realm = "TheRealm",
+ host_ip_address = [{127,0,0,1}],
+ vendor_id = 42,
+ product_name = "TheProduct"}).
+
+-define(VALUES(Rec), tl(tuple_to_list(Rec))).
+
+%%% The return values below assume the server diameter_config is started.
+%%% The functions will exit if it isn't.
+
+%% --------------------------------------------------------------------------
+%% # start_service(SvcName, Opts)
+%%
+%% Output: ok | {error, Reason}
+%% --------------------------------------------------------------------------
+
+start_service(SvcName, Opts)
+ when is_list(Opts) ->
+ start_rc(sync(SvcName, {start_service, SvcName, Opts})).
+
+start_rc({ok = T, _Pid}) ->
+ T;
+start_rc({error, _} = No) ->
+ No;
+start_rc(timeout) ->
+ {error, application_not_started}.
+
+%% --------------------------------------------------------------------------
+%% # stop_service(SvcName)
+%%
+%% Output: ok
+%% --------------------------------------------------------------------------
+
+stop_service(SvcName) ->
+ sync(SvcName, {stop_service, SvcName}).
+
+%% --------------------------------------------------------------------------
+%% # add_transport(SvcName, {Type, Opts})
+%%
+%% Input: Type = connect | listen
+%%
+%% Output: {ok, Ref} | {error, Reason}
+%% --------------------------------------------------------------------------
+
+add_transport(SvcName, {T, Opts})
+ when is_list(Opts), (T == connect orelse T == listen) ->
+ sync(SvcName, {add, SvcName, T, Opts}).
+
+%% --------------------------------------------------------------------------
+%% # remove_transport(SvcName, Pred)
+%%
+%% Input: Pred = arity 3 fun on transport ref, connect|listen and Opts,
+%% returning true if the transport is to be removed, false if
+%% not
+%% | arity 2 fun on Ref and Opts only
+%% | arity 1 fun on Opts only
+%% | Opts matching all transports that have all of the specified
+%% options
+%% | Ref matching only the transport with this reference.
+%% | {M,F,A} applied to Ref, connect|listen and Opts
+%% | boolean()
+%%
+%% Output: ok | {error, Reason}
+%% --------------------------------------------------------------------------
+
+remove_transport(SvcName, Pred) ->
+ try
+ sync(SvcName, {remove, SvcName, pred(Pred)})
+ catch
+ ?FAILURE(Reason) ->
+ {error, Reason}
+ end.
+
+pred(Pred)
+ when is_function(Pred, 3) ->
+ Pred;
+pred(Pred)
+ when is_function(Pred, 2) ->
+ fun(R,_,O) -> Pred(R,O) end;
+pred(Pred)
+ when is_function(Pred, 1) ->
+ fun(_,_,O) -> Pred(O) end;
+pred(Opts)
+ when is_list(Opts) ->
+ fun(_,_,O) -> [] == Opts -- O end;
+pred(Ref)
+ when is_reference(Ref) ->
+ fun(R,_,_) -> R == Ref end;
+pred({M,F,A})
+ when is_atom(M), is_atom(F), is_list(A) ->
+ fun(R,T,O) -> apply(M,F,[R,T,O|A]) end;
+pred({Type, Pred}) -> %% backwards compatibility
+ P = pred(Pred),
+ fun(R,T,O) -> T == Type andalso P(R,T,O) end;
+pred(B)
+ when is_boolean(B) ->
+ fun(_,_,_) -> B end;
+pred(_) ->
+ ?THROW(pred).
+
+%% --------------------------------------------------------------------------
+%% # have_transport/2
+%%
+%% Output: true | false
+%% --------------------------------------------------------------------------
+
+have_transport(SvcName, Ref) ->
+ member([{#transport{service = '$1',
+ ref = '$2',
+ _ = '_'},
+ [{'andalso', {'=:=', '$1', {const, SvcName}},
+ {'=:=', '$2', {const, Ref}}}],
+ [true]}]).
+
+%% --------------------------------------------------------------------------
+%% # lookup/1
+%% --------------------------------------------------------------------------
+
+lookup(SvcName) ->
+ select([{#service{name = '$1', rec = '$2', options = '$3'},
+ [{'=:=', '$1', {const, SvcName}}],
+ [{{'$1', '$2', '$3'}}]},
+ {#transport{service = '$1',
+ ref = '$2',
+ type = '$3',
+ options = '$4'},
+ [{'=:=', '$1', {const, SvcName}}],
+ [{{'$2', '$3', '$4'}}]}]).
+
+%% ---------------------------------------------------------
+%% EXPORTED INTERNAL FUNCTIONS
+%% ---------------------------------------------------------
+
+start_link() ->
+ ServerName = {local, ?SERVER},
+ Module = ?MODULE,
+ Args = [],
+ Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}],
+ gen_server:start_link(ServerName, Module, Args, Options).
+
+state() ->
+ call(state).
+
+uptime() ->
+ call(uptime).
+
+%%% ----------------------------------------------------------
+%%% # init/1
+%%% ----------------------------------------------------------
+
+init([]) ->
+ {ok, #state{}}.
+
+%%% ----------------------------------------------------------
+%%% # handle_call/2
+%%% ----------------------------------------------------------
+
+handle_call(state, _, State) ->
+ {reply, State, State};
+
+handle_call(uptime, _, #state{id = Time} = State) ->
+ {reply, diameter_lib:now_diff(Time), State};
+
+handle_call(Req, From, State) ->
+ ?UNEXPECTED([Req, From]),
+ Reply = {error, {bad_request, Req}},
+ {reply, Reply, State}.
+
+%%% ----------------------------------------------------------
+%%% # handle_cast/2
+%%% ----------------------------------------------------------
+
+handle_cast(Msg, State) ->
+ ?UNEXPECTED([Msg]),
+ {noreply, State}.
+
+%%% ----------------------------------------------------------
+%%% # handle_info/2
+%%% ----------------------------------------------------------
+
+%% A service process has died. This is most likely a consequence of
+%% stop_service, in which case the restart will find no config for the
+%% service and do nothing. The entry keyed on the monitor ref is only
+%% removed as a result of the 'DOWN' notification however.
+handle_info({'DOWN', MRef, process, _, Reason}, State) ->
+ [#monitor{service = SvcName} = T] = select([{#monitor{mref = MRef,
+ _ = '_'},
+ [],
+ ['$_']}]),
+ queue_restart(Reason, SvcName),
+ delete_object(T),
+ {noreply, State};
+
+handle_info({monitor, SvcName, Pid}, State) ->
+ monitor(Pid, SvcName),
+ {noreply, State};
+
+handle_info({restart, SvcName}, State) ->
+ restart(SvcName),
+ {noreply, State};
+
+handle_info(restart, State) ->
+ restart(),
+ {noreply, State};
+
+handle_info(Info, State) ->
+ ?UNEXPECTED([Info]),
+ {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% # terminate/2
+%%--------------------------------------------------------------------
+
+terminate(_Reason, _State) ->
+ ok.
+
+%%% ----------------------------------------------------------
+%%% # code_change/3
+%%% ----------------------------------------------------------
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%% ---------------------------------------------------------
+%% INTERNAL FUNCTIONS
+%% ---------------------------------------------------------
+
+insert(T) ->
+ ets:insert(?TABLE, T).
+
+%% ?TABLE is a bag: check only for a service entry.
+have_service(SvcName) ->
+ member([{#service{name = '$1', _ = '_'},
+ [{'=:=', '$1', {const, SvcName}}],
+ [true]}]).
+
+member(MatchSpec) ->
+ '$end_of_table' =/= ets:select(?TABLE, MatchSpec, 1).
+
+delete_object(T) ->
+ ets:delete_object(?TABLE, T).
+
+delete(Key) ->
+ ets:delete(?TABLE, Key).
+
+select(MatchSpec) ->
+ ets:select(?TABLE, MatchSpec).
+
+select_delete(MatchSpec) ->
+ ets:select_delete(?TABLE, MatchSpec).
+
+%% sync/2
+%%
+%% Interface functions used to be implemented as calls to ?SERVER but
+%% now serialize things per service instead since stopping a service
+%% can take time if the server doesn't answer DPR. A caller who wants
+%% to stop multiple services can then improve performance by spawning
+%% processes to stop them concurrently.
+
+sync(SvcName, T) ->
+ diameter_sync:call({?MODULE, SvcName},
+ {?MODULE, sync, [T]},
+ infinity,
+ infinity).
+
+%% sync/1
+
+sync({restart, SvcName}) ->
+ have_service(SvcName) andalso start(SvcName);
+
+sync({start_service, SvcName, Opts}) ->
+ try
+ start(have_service(SvcName), SvcName, Opts)
+ catch
+ ?FAILURE(Reason) -> {error, Reason}
+ end;
+
+sync({stop_service, SvcName}) ->
+ stop(SvcName);
+
+sync({add, SvcName, Type, Opts}) ->
+ try
+ add(SvcName, Type, Opts)
+ catch
+ ?FAILURE(Reason) -> {error, Reason}
+ end;
+
+sync({remove, SvcName, Pred}) ->
+ remove(select([{#transport{service = '$1', _ = '_'},
+ [{'=:=', '$1', {const, SvcName}}],
+ ['$_']}]),
+ SvcName,
+ Pred).
+
+%% start/3
+
+start(true, _, _) ->
+ {error, already_started};
+start(false, SvcName, Opts) ->
+ insert(make_config(SvcName, Opts)),
+ start(SvcName).
+
+%% start/1
+
+start(SvcName) ->
+ RC = diameter_service:start(SvcName),
+ startmon(SvcName, RC),
+ RC.
+
+startmon(SvcName, {ok, Pid}) ->
+ ?SERVER ! {monitor, SvcName, Pid};
+startmon(_, {error, _}) ->
+ ok.
+
+monitor(Pid, SvcName) ->
+ MRef = erlang:monitor(process, Pid),
+ insert(#monitor{mref = MRef, service = SvcName}).
+
+%% queue_restart/2
+
+%% Service has gone down on monitor death. Note that all service-related
+%% config is deleted.
+queue_restart({shutdown, {monitor, _}}, SvcName) ->
+ delete(SvcName);
+
+%% Application shutdown: ignore.
+queue_restart(shutdown, _) ->
+ ok;
+
+%% Or not.
+queue_restart(_, SvcName) ->
+ erlang:send_after(?RESTART_SLEEP, self(), {restart, SvcName}).
+
+%% restart/1
+
+restart(SvcName) ->
+ sync(SvcName, {restart, SvcName}).
+
+%% restart/0
+%%
+%% Start anything configured as required. Bang 'restart' to the server
+%% to kick things into gear manually. (Not that it should be required
+%% but it's been useful for test.)
+
+restart() ->
+ MatchSpec = [{#service{name = '$1', _ = '_'},
+ [],
+ ['$1']}],
+ lists:foreach(fun restart/1, select(MatchSpec)).
+
+%% stop/1
+
+stop(SvcName) ->
+ %% If the call to the service returns error for any reason other
+ %% than the process not being alive then deleting the config from
+ %% under it will surely bring it down.
+ diameter_service:stop(SvcName),
+ %% Delete only the service entry, not everything keyed on the name,
+ select_delete([{#service{name = '$1', _ = '_'},
+ [{'=:=', '$1', {const, SvcName}}],
+ [true]}]),
+ ok.
+%% Note that a transport has to be removed for its statistics to be
+%% deleted.
+
+%% add/3
+
+add(SvcName, Type, Opts) ->
+ %% Ensure usable capabilities. diameter_service:merge_service/2
+ %% depends on this.
+ lists:foreach(fun(Os) ->
+ is_list(Os) orelse ?THROW({capabilities, Os}),
+ ok = encode_CER(Os)
+ end,
+ [Os || {capabilities, Os} <- Opts, is_list(Os)]),
+
+ Ref = make_ref(),
+ T = {Ref, Type, Opts},
+ %% The call to the service returns error if the service isn't
+ %% started yet, which is harmless. The transport will be started
+ %% when the service is in that case.
+ case start_transport(SvcName, T) of
+ ok ->
+ insert(#transport{service = SvcName,
+ ref = Ref,
+ type = Type,
+ options = Opts}),
+ {ok, Ref};
+ {error, _} = No ->
+ No
+ end.
+
+start_transport(SvcName, T) ->
+ case diameter_service:start_transport(SvcName, T) of
+ {ok, _Pid} ->
+ ok;
+ {error, no_service} ->
+ ok;
+ {error, _} = No ->
+ No
+ end.
+
+%% remove/3
+
+remove(L, SvcName, Pred) ->
+ rm(SvcName, lists:filter(fun(#transport{ref = R, type = T, options = O}) ->
+ Pred(R,T,O)
+ end,
+ L)).
+
+rm(_, []) ->
+ ok;
+rm(SvcName, L) ->
+ Refs = lists:map(fun(#transport{ref = R}) -> R end, L),
+ case stop_transport(SvcName, Refs) of
+ ok ->
+ lists:foreach(fun delete_object/1, L);
+ {error, _} = No ->
+ No
+ end.
+
+stop_transport(SvcName, Refs) ->
+ case diameter_service:stop_transport(SvcName, Refs) of
+ ok ->
+ ok;
+ {error, no_service} ->
+ ok;
+ {error, _} = No ->
+ No
+ end.
+
+%% make_config/2
+
+make_config(SvcName, Opts) ->
+ Apps = init_apps(Opts),
+ [] == Apps andalso ?THROW(no_apps),
+
+ %% Use the fact that diameter_caps has the same field names as CER.
+ Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER) -- ['AVP'],
+
+ COpts = [T || {K,_} = T <- Opts, lists:member(K, Fields)],
+ Caps = make_caps(#diameter_caps{}, COpts),
+
+ ok = encode_CER(COpts),
+
+ Os = split(Opts, [{[fun erlang:is_boolean/1], false, share_peers},
+ {[fun erlang:is_boolean/1], false, use_shared_peers},
+ {[fun erlang:is_pid/1, false], false, monitor}]),
+ %% share_peers and use_shared_peers are currently undocumented.
+
+ #service{name = SvcName,
+ rec = #diameter_service{applications = Apps,
+ capabilities = Caps},
+ options = Os}.
+
+make_caps(Caps, Opts) ->
+ case diameter_capx:make_caps(Caps, Opts) of
+ {ok, T} ->
+ T;
+ {error, {Reason, _}} ->
+ ?THROW(Reason)
+ end.
+
+%% Validate types by encoding a CER.
+encode_CER(Opts) ->
+ {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts)),
+
+ Hdr = #diameter_header{version = ?DIAMETER_VERSION,
+ end_to_end_id = 0,
+ hop_by_hop_id = 0},
+
+ try
+ diameter_codec:encode(?BASE, #diameter_packet{header = Hdr,
+ msg = CER}),
+ ok
+ catch
+ exit: Reason ->
+ ?THROW(Reason)
+ end.
+
+init_apps(Opts) ->
+ lists:foldl(fun app_acc/2, [], lists:reverse(Opts)).
+
+app_acc({application, Opts}, Acc) ->
+ is_list(Opts) orelse ?THROW({application, Opts}),
+
+ [Dict, Mod] = get_opt([dictionary, module], Opts),
+ Alias = get_opt(alias, Opts, Dict),
+ ModS = get_opt(state, Opts, Alias),
+ M = get_opt(call_mutates_state, Opts, false),
+ A = get_opt(answer_errors, Opts, report),
+ [#diameter_app{alias = Alias,
+ dictionary = Dict,
+ id = cb(Dict, id),
+ module = init_mod(Mod),
+ init_state = ModS,
+ mutable = init_mutable(M),
+ answer_errors = init_answers(A)}
+ | Acc];
+app_acc(_, Acc) ->
+ Acc.
+
+init_mod(M)
+ when is_atom(M) ->
+ [M];
+init_mod([M|_] = L)
+ when is_atom(M) ->
+ L;
+init_mod(M) ->
+ ?THROW({module, M}).
+
+init_mutable(M)
+ when M == true;
+ M == false ->
+ M;
+init_mutable(M) ->
+ ?THROW({call_mutates_state, M}).
+
+init_answers(A)
+ when callback == A;
+ report == A;
+ discard == A ->
+ A;
+init_answers(A) ->
+ ?THROW({answer_errors, A}).
+
+%% Get a single value at the specified key.
+get_opt(Keys, List)
+ when is_list(Keys) ->
+ [get_opt(K, List) || K <- Keys];
+get_opt(Key, List) ->
+ case [V || {K,V} <- List, K == Key] of
+ [V] -> V;
+ _ -> ?THROW({arity, Key})
+ end.
+
+%% Get an optional value at the specified key.
+get_opt(Key, List, Def) ->
+ case [V || {K,V} <- List, K == Key] of
+ [] -> Def;
+ [V] -> V;
+ _ -> ?THROW({arity, Key})
+ end.
+
+split(Opts, Defs) ->
+ [{K, value(D, Opts)} || {_,_,K} = D <- Defs].
+
+value({Preds, Def, Key}, Opts) ->
+ V = get_opt(Key, Opts, Def),
+ lists:any(fun(P) -> pred(P,V) end, Preds)
+ orelse ?THROW({value, Key}),
+ V.
+
+pred(F, V)
+ when is_function(F) ->
+ F(V);
+pred(T, V) ->
+ T == V.
+
+cb(M,F) ->
+ try M:F() of
+ V -> V
+ catch
+ E: Reason ->
+ ?THROW({callback, E, Reason, ?STACK})
+ end.
+
+%% call/1
+
+call(Request) ->
+ gen_server:call(?SERVER, Request, infinity).
diff --git a/lib/diameter/src/base/diameter_dbg.erl b/lib/diameter/src/base/diameter_dbg.erl
new file mode 100644
index 0000000000..5b0ac3a3b6
--- /dev/null
+++ b/lib/diameter/src/base/diameter_dbg.erl
@@ -0,0 +1,516 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_dbg).
+
+-export([table/1,
+ tables/0,
+ fields/1,
+ help/0,
+ modules/0,
+ versions/0,
+ version_info/0,
+ compiled/0,
+ procs/0,
+ latest/0,
+ nl/0,
+ log/4]).
+
+-export([diameter_config/0,
+ diameter_peer/0,
+ diameter_reg/0,
+ diameter_request/0,
+ diameter_sequence/0,
+ diameter_service/0,
+ diameter_stats/0]).
+
+-export([pp/1,
+ subscriptions/0,
+ children/0]).
+
+%% Trace help.
+-export([tracer/0, tracer/1,
+ p/0, p/1,
+ stop/0,
+ tpl/1,
+ tp/1]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_internal.hrl").
+
+
+-define(INFO, diameter_info).
+-define(SEP(), ?INFO:sep()).
+
+-define(LOCAL, [diameter_config,
+ diameter_peer,
+ diameter_reg,
+ diameter_request,
+ diameter_sequence,
+ diameter_service,
+ diameter_stats]).
+
+-define(VALUES(Rec), tl(tuple_to_list(Rec))).
+
+log(_Slogan, _Mod, _Line, _Details) ->
+ ok.
+
+%%% ----------------------------------------------------------
+%%% # help()
+%%% ----------------------------------------------------------
+
+help() ->
+ not_yet_implemented.
+
+%%% ----------------------------------------------------------
+%%% # table(TableName)
+%%%
+%%% Input: TableName = diameter table containing record entries.
+%%%
+%%% Output: Count | undefined
+%%% ----------------------------------------------------------
+
+table(T)
+ when (T == diameter_peer) orelse (T == diameter_reg) ->
+ ?INFO:format(collect(T), fields(T), fun ?INFO:split/2);
+
+table(Table)
+ when is_atom(Table) ->
+ case fields(Table) of
+ undefined = No ->
+ No;
+ Fields ->
+ ?INFO:format(Table, Fields, fun split/2)
+ end.
+
+split([started, name | Fs], [S, N | Vs]) ->
+ {name, [started | Fs], N, [S | Vs]};
+split([[F|FT]|Fs], [Rec|Vs]) ->
+ [_, V | VT] = tuple_to_list(Rec),
+ {F, FT ++ Fs, V, VT ++ Vs};
+split([F|Fs], [V|Vs]) ->
+ {F, Fs, V, Vs}.
+
+%%% ----------------------------------------------------------
+%%% # TableName()
+%%% ----------------------------------------------------------
+
+-define(TABLE(Name), Name() -> table(Name)).
+
+?TABLE(diameter_config).
+?TABLE(diameter_peer).
+?TABLE(diameter_reg).
+?TABLE(diameter_request).
+?TABLE(diameter_sequence).
+?TABLE(diameter_service).
+?TABLE(diameter_stats).
+
+%%% ----------------------------------------------------------
+%%% # tables()
+%%%
+%%% Output: Number of records output.
+%%%
+%%% Description: Pretty-print records in diameter tables from all nodes.
+%%% ----------------------------------------------------------
+
+tables() ->
+ ?INFO:format(field(?LOCAL), fun split/3, fun collect/1).
+
+field(Tables) ->
+ lists:map(fun(T) -> {T, fields(T)} end, lists:sort(Tables)).
+
+split(_, Fs, Vs) ->
+ split(Fs, Vs).
+
+%%% ----------------------------------------------------------
+%%% # modules()
+%%% ----------------------------------------------------------
+
+modules() ->
+ Path = filename:join([appdir(), atom_to_list(?APPLICATION) ++ ".app"]),
+ {ok, [{application, ?APPLICATION, Attrs}]} = file:consult(Path),
+ {modules, Mods} = lists:keyfind(modules, 1, Attrs),
+ Mods.
+
+appdir() ->
+ [_|_] = code:lib_dir(?APPLICATION, ebin).
+
+%%% ----------------------------------------------------------
+%%% # versions()
+%%% ----------------------------------------------------------
+
+versions() ->
+ ?INFO:versions(modules()).
+
+%%% ----------------------------------------------------------
+%%% # versions()
+%%% ----------------------------------------------------------
+
+version_info() ->
+ ?INFO:version_info(modules()).
+
+%%% ----------------------------------------------------------
+%%% # compiled()
+%%% ----------------------------------------------------------
+
+compiled() ->
+ ?INFO:compiled(modules()).
+
+%%% ----------------------------------------------------------
+%%% procs()
+%%% ----------------------------------------------------------
+
+procs() ->
+ ?INFO:procs(?APPLICATION).
+
+%%% ----------------------------------------------------------
+%%% # latest()
+%%% ----------------------------------------------------------
+
+latest() ->
+ ?INFO:latest(modules()).
+
+%%% ----------------------------------------------------------
+%%% # nl()
+%%% ----------------------------------------------------------
+
+nl() ->
+ lists:foreach(fun(M) -> abcast = c:nl(M) end, modules()).
+
+%%% ----------------------------------------------------------
+%%% # pp(Bin)
+%%%
+%%% Description: Pretty-print a message binary.
+%%% ----------------------------------------------------------
+
+%% Network byte order = big endian.
+
+pp(<<Version:8, MsgLength:24,
+ Rbit:1, Pbit:1, Ebit:1, Tbit:1, Reserved:4, CmdCode:24,
+ ApplId:32,
+ HbHid:32,
+ E2Eid:32,
+ AVPs/binary>>) ->
+ ?SEP(),
+ ppp(["Version",
+ "Message length",
+ "[Actual length]",
+ "R(equest)",
+ "P(roxiable)",
+ "E(rror)",
+ "T(Potential retrans)",
+ "Reserved bits",
+ "Command code",
+ "Application id",
+ "Hop by hop id",
+ "End to end id"],
+ [Version, MsgLength, size(AVPs) + 20,
+ Rbit, Pbit, Ebit, Tbit, Reserved,
+ CmdCode,
+ ApplId,
+ HbHid,
+ E2Eid]),
+ N = avp_loop({AVPs, MsgLength - 20}, 0),
+ ?SEP(),
+ N;
+
+pp(<<_Version:8, MsgLength:24, _/binary>> = Bin) ->
+ {bad_message_length, MsgLength, size(Bin)};
+
+pp(Bin)
+ when is_binary(Bin) ->
+ {truncated_binary, size(Bin)};
+
+pp(_) ->
+ not_binary.
+
+%% avp_loop/2
+
+avp_loop({Bin, Size}, N) ->
+ avp_loop(avp(Bin, Size), N+1);
+avp_loop(ok, N) ->
+ N;
+avp_loop([_E, _Rest] = L, N) ->
+ io:format("! ~s: ~p~n", L),
+ N;
+avp_loop([E, Rest, Fmt | Values], N)
+ when is_binary(Rest) ->
+ io:format("! ~s (" ++ Fmt ++ "): ~p~n", [E|Values] ++ [Rest]),
+ N.
+
+%% avp/2
+
+avp(<<>>, 0) ->
+ ok;
+avp(<<Code:32, Flags:1/binary, Length:24, Rest/binary>>,
+ Size) ->
+ avp(Code, Flags, Length, Rest, Size);
+avp(Bin, _) ->
+ ["truncated AVP header", Bin].
+
+%% avp/5
+
+avp(Code, Flags, Length, Rest, Size) ->
+ <<V:1, M:1, P:1, Res:5>>
+ = Flags,
+ b(),
+ ppp(["AVP Code",
+ "V(endor)",
+ "M(andatory)",
+ "P(Security)",
+ "R(eserved)",
+ "Length"],
+ [Code, V, M, P, Res, Length]),
+ avp(V, Rest, Length - 8, Size - 8).
+
+%% avp/4
+
+avp(1, <<V:32, Data/binary>>, Length, Size) ->
+ ppp({"Vendor-ID", V}),
+ data(Data, Length - 4, Size - 4);
+avp(1, Bin, _, _) ->
+ ["truncated Vendor-ID", Bin];
+avp(0, Data, Length, Size) ->
+ data(Data, Length, Size).
+
+data(Bin, Length, Size)
+ when size(Bin) >= Length ->
+ <<AVP:Length/binary, Rest/binary>> = Bin,
+ ppp({"Data", AVP}),
+ unpad(Rest, Size - Length, Length rem 4);
+
+data(Bin, _, _) ->
+ ["truncated AVP data", Bin].
+
+%% Remove padding bytes up to the next word boundary.
+unpad(Bin, Size, 0) ->
+ {Bin, Size};
+unpad(Bin, Size, N) ->
+ un(Bin, Size, 4 - N).
+
+un(Bin, Size, N)
+ when size(Bin) >= N ->
+ ppp({"Padding bytes", N}),
+ <<Pad:N/binary, Rest/binary>> = Bin,
+ Bits = N*8,
+ case Pad of
+ <<0:Bits>> ->
+ {Rest, Size - N};
+ _ ->
+ ["non-zero padding", Bin, "~p", N]
+ end;
+
+un(Bin, _, _) ->
+ ["truncated padding", Bin].
+
+b() ->
+ io:format("#~n").
+
+ppp(Fields, Values) ->
+ lists:foreach(fun ppp/1, lists:zip(Fields, Values)).
+
+ppp({Field, Value}) ->
+ io:format(": ~-22s : ~p~n", [Field, Value]).
+
+%%% ----------------------------------------------------------
+%%% # subscriptions()
+%%%
+%%% Output: list of {SvcName, Pid}
+%%% ----------------------------------------------------------
+
+subscriptions() ->
+ diameter_service:subscriptions().
+
+%%% ----------------------------------------------------------
+%%% # children()
+%%% ----------------------------------------------------------
+
+children() ->
+ diameter_sup:tree().
+
+%%% ----------------------------------------------------------
+
+%% tracer/[12]
+
+tracer(Port)
+ when is_integer(Port) ->
+ dbg:tracer(port, dbg:trace_port(ip, Port));
+
+tracer(Path)
+ when is_list(Path) ->
+ dbg:tracer(port, dbg:trace_port(file, Path)).
+
+tracer() ->
+ dbg:tracer(process, {fun p/2, ok}).
+
+p(T,_) ->
+ io:format("+ ~p~n", [T]).
+
+%% p/[01]
+
+p() ->
+ p([c,timestamp]).
+
+p(T) ->
+ dbg:p(all,T).
+
+%% stop/0
+
+stop() ->
+ dbg:ctp(),
+ dbg:stop_clear().
+
+%% tpl/1
+%% tp/1
+
+tpl(T) ->
+ dbg(tpl, T).
+
+tp(T) ->
+ dbg(tp, T).
+
+%% dbg/2
+
+dbg(F, L)
+ when is_list(L) ->
+ [dbg(F, X) || X <- L];
+
+dbg(F, M)
+ when is_atom(M) ->
+ apply(dbg, F, [M, x]);
+
+dbg(F, T)
+ when is_tuple(T) ->
+ apply(dbg, F, tuple_to_list(T)).
+
+%% ===========================================================================
+%% ===========================================================================
+
+%% collect/1
+
+collect(diameter_peer) ->
+ lists:flatmap(fun peers/1, diameter:services());
+
+collect(diameter_reg) ->
+ diameter_reg:terms();
+
+collect(Name) ->
+ c(ets:info(Name), Name).
+
+c(undefined, _) ->
+ [];
+c(_, Name) ->
+ ets:tab2list(Name).
+
+%% peers/1
+
+peers(Name) ->
+ peers(Name, diameter:service_info(Name, transport)).
+
+peers(_, undefined) ->
+ [];
+peers(Name, Ts) ->
+ lists:flatmap(fun(T) -> mk_peers(Name, T) end, Ts).
+
+mk_peers(Name, [_, {type, connect} | _] = Ts) ->
+ [[Name | mk_peer(Ts)]];
+mk_peers(Name, [R, {type, listen}, O, {accept = A, As}]) ->
+ [[Name | mk_peer([R, {type, A}, O | Ts])] || Ts <- As].
+%% This is a bit lame: service_info works to build this list and out
+%% of something like what we want here and then we take it apart.
+
+mk_peer(Vs) ->
+ [Type, Ref, State, Opts, WPid, TPid, SApps, Caps]
+ = get_values(Vs, [type,ref,state,options,watchdog,peer,apps,caps]),
+ [Ref, State, [{type, Type} | Opts], s(WPid), s(TPid), SApps, Caps].
+
+get_values(Vs, Ks) ->
+ [proplists:get_value(K, Vs) || K <- Ks].
+
+s(undefined = T) ->
+ T;
+s({Pid, _Started, _State}) ->
+ state(Pid);
+s({Pid, _Started}) ->
+ state(Pid).
+
+%% Collect states from watchdog/transport pids.
+state(Pid) ->
+ MRef = erlang:monitor(process, Pid),
+ Pid ! {state, self()},
+ receive
+ {'DOWN', MRef, process, _, _} ->
+ Pid;
+ {Pid, _} = T ->
+ erlang:demonitor(MRef, [flush]),
+ T
+ end.
+
+%% fields/1
+
+-define(FIELDS(Table), fields(Table) -> record_info(fields, Table)).
+
+fields(diameter_config) ->
+ [];
+
+fields(T)
+ when T == diameter_request;
+ T == diameter_sequence ->
+ fun kv/1;
+
+fields(diameter_stats) ->
+ fun({Ctr, N}) when not is_pid(Ctr) ->
+ {[counter, value], [Ctr, N]};
+ (_) ->
+ []
+ end;
+
+fields(diameter_service) ->
+ [started,
+ name,
+ record_info(fields, diameter_service),
+ peerT,
+ connT,
+ share_peers,
+ use_shared_peers,
+ shared_peers,
+ local_peers,
+ monitor];
+
+?FIELDS(diameter_event);
+?FIELDS(diameter_uri);
+?FIELDS(diameter_avp);
+?FIELDS(diameter_header);
+?FIELDS(diameter_packet);
+?FIELDS(diameter_app);
+?FIELDS(diameter_caps);
+
+fields(diameter_peer) ->
+ [service, ref, state, options, watchdog, peer, applications, capabilities];
+
+fields(diameter_reg) ->
+ [property, pids];
+
+fields(_) ->
+ undefined.
+
+kv({_,_}) ->
+ [key, value];
+kv(_) ->
+ [].
diff --git a/lib/diameter/src/base/diameter_dict.erl b/lib/diameter/src/base/diameter_dict.erl
new file mode 100644
index 0000000000..3b9ba00a3f
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_info.erl b/lib/diameter/src/base/diameter_info.erl
new file mode 100644
index 0000000000..39d32d07cd
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_internal.hrl b/lib/diameter/src/base/diameter_internal.hrl
new file mode 100644
index 0000000000..63b35550a8
--- /dev/null
+++ b/lib/diameter/src/base/diameter_internal.hrl
@@ -0,0 +1,80 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% Our Erlang application.
+-define(APPLICATION, diameter).
+
+%% The one and only.
+-define(DIAMETER_VERSION, 1).
+
+%% Exception for use within a module with decent protection against
+%% catching something we haven't thrown. Not foolproof but close
+%% enough. ?MODULE is rudmentary protection against catching across
+%% module boundaries, a root of much evil: always catch ?FAILURE(X),
+%% never X.
+-define(FAILURE(Reason), {{?MODULE}, {Reason}}).
+-define(THROW(Reason), throw(?FAILURE(Reason))).
+
+%% A corresponding error when failure is the best option.
+-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})).
+
+%% Failure reports always get a stack trace.
+-define(STACK, erlang:get_stacktrace()).
+
+%% Warning report for unexpected messages in various processes.
+-define(UNEXPECTED(F,A),
+ diameter_lib:warning_report(unexpected, {?MODULE, F, A})).
+-define(UNEXPECTED(A), ?UNEXPECTED(?FUNC, A)).
+
+%% Something to trace on.
+-define(LOG(Slogan, Details),
+ diameter_lib:log(Slogan, ?MODULE, ?LINE, Details)).
+-define(LOGC(Bool, Slogan, Details), ((Bool) andalso ?LOG(Slogan, Details))).
+
+%% Compensate for no builtin ?FUNC for use in log reports.
+-define(FUNC, element(2, element(2, process_info(self(), current_function)))).
+
+%% Disjunctive match spec condition. 'false' is to ensure that there's at
+%% least one condition.
+-define(ORCOND(List), list_to_tuple(['orelse', false | List])).
+
+%% 3588, 2.4:
+-define(APP_ID_COMMON, 0).
+-define(APP_ID_RELAY, 16#FFFFFFFF).
+
+-define(BASE, diameter_gen_base_rfc3588).
+
+%%% ---------------------------------------------------------
+
+%%% RFC 3588, ch 2.6 Peer table
+-record(diameter_peer,
+ {host_id,
+ statusT,
+ is_dynamic,
+ expiration,
+ tls_enabled}).
+
+%%% RFC 3588, ch 2.7 Realm-based routing table
+-record(diameter_realm,
+ {name,
+ app_id,
+ local_action, % LOCAL | RELAY | PROXY | REDIRECT
+ server_id,
+ is_dynamic,
+ expiration}).
diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl
new file mode 100644
index 0000000000..362d593b24
--- /dev/null
+++ b/lib/diameter/src/base/diameter_lib.erl
@@ -0,0 +1,272 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_lib).
+
+-export([report/2, info_report/2,
+ error_report/2,
+ warning_report/2,
+ now_diff/1,
+ time/1,
+ eval/1,
+ ip4address/1,
+ ip6address/1,
+ ipaddr/1,
+ spawn_opts/2,
+ wait/1,
+ fold_tuple/3,
+ log/4]).
+
+-include("diameter_internal.hrl").
+
+%% ---------------------------------------------------------------------------
+%% # info_report(Reason, MFA)
+%%
+%% Input: Reason = Arbitrary term indicating the reason for the report.
+%% MFA = {Module, Function, Args} to report.
+%%
+%% Output: true
+%% ---------------------------------------------------------------------------
+
+report(Reason, MFA) ->
+ info_report(Reason, MFA).
+
+info_report(Reason, MFA) ->
+ report(fun error_logger:info_report/1, Reason, MFA),
+ true.
+
+%%% ---------------------------------------------------------------------------
+%%% # error_report(Reason, MFA)
+%%% # warning_report(Reason, MFA)
+%%%
+%%% Output: false
+%%% ---------------------------------------------------------------------------
+
+error_report(Reason, MFA) ->
+ report(fun error_logger:error_report/1, Reason, MFA).
+
+warning_report(Reason, MFA) ->
+ report(fun error_logger:warning_report/1, Reason, MFA).
+
+report(Fun, Reason, MFA) ->
+ Fun([{why, Reason}, {who, self()}, {what, MFA}]),
+ false.
+
+%%% ---------------------------------------------------------------------------
+%%% # now_diff(Time)
+%%%
+%%% Description: Return timer:now_diff(now(), Time) as an {H, M, S, MicroS}
+%%% tuple instead of as integer microseconds.
+%%% ---------------------------------------------------------------------------
+
+now_diff({_,_,_} = Time) ->
+ time(timer:now_diff(erlang:now(), Time)).
+
+%%% ---------------------------------------------------------------------------
+%%% # time(Time)
+%%%
+%%% Input: Time = {MegaSec, Sec, MicroSec}
+%%% | MicroSec
+%%%
+%%% Output: {H, M, S, MicroS}
+%%% ---------------------------------------------------------------------------
+
+time({_,_,_} = Time) -> %% time of day
+ %% 24 hours = 24*60*60*1000000 = 86400000000 microsec
+ time(timer:now_diff(Time, {0,0,0}) rem 86400000000);
+
+time(Micro) -> %% elapsed time
+ Seconds = Micro div 1000000,
+ H = Seconds div 3600,
+ M = (Seconds rem 3600) div 60,
+ S = Seconds rem 60,
+ {H, M, S, Micro rem 1000000}.
+
+%%% ---------------------------------------------------------------------------
+%%% # eval(Func)
+%%% ---------------------------------------------------------------------------
+
+eval({M,F,A}) ->
+ apply(M,F,A);
+
+eval([{M,F,A} | X]) ->
+ apply(M, F, X ++ A);
+
+eval([[F|A] | X]) ->
+ eval([F | X ++ A]);
+
+eval([F|A]) ->
+ apply(F,A);
+
+eval({F}) ->
+ eval(F);
+
+eval(F) ->
+ F().
+
+%%% ---------------------------------------------------------------------------
+%%% # ip4address(Addr)
+%%%
+%%% Input: string() (eg. "10.0.0.1")
+%%% | list of integer()
+%%% | tuple of integer()
+%%%
+%%% Output: {_,_,_,_} of integer
+%%%
+%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()}
+%%% ---------------------------------------------------------------------------
+
+ip4address([_,_,_,_] = Addr) -> %% Length 4 string can't be an address.
+ ipaddr(list_to_tuple(Addr));
+
+%% Be brutal.
+ip4address(Addr) ->
+ try
+ {_,_,_,_} = ipaddr(Addr)
+ catch
+ error: _ ->
+ erlang:error({invalid_address, Addr, ?STACK})
+ end.
+
+%%% ---------------------------------------------------------------------------
+%%% # ip6address(Addr)
+%%%
+%%% Input: string() (eg. "1080::8:800:200C:417A")
+%%% | list of integer()
+%%% | tuple of integer()
+%%%
+%%% Output: {_,_,_,_,_,_,_,_} of integer
+%%%
+%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()}
+%%% ---------------------------------------------------------------------------
+
+ip6address([_,_,_,_,_,_,_,_] = Addr) -> %% Length 8 string can't be an address.
+ ipaddr(list_to_tuple(Addr));
+
+%% Be brutal.
+ip6address(Addr) ->
+ try
+ {_,_,_,_,_,_,_,_} = ipaddr(Addr)
+ catch
+ error: _ ->
+ erlang:error({invalid_address, Addr, ?STACK})
+ end.
+
+%%% ---------------------------------------------------------------------------
+%%% # ipaddr(Addr)
+%%%
+%%% Input: string() | tuple of integer()
+%%%
+%%% Output: {_,_,_,_} | {_,_,_,_,_,_,_,_}
+%%%
+%%% Exceptions: error: {invalid_address, erlang:get_stacktrace()}
+%%% ---------------------------------------------------------------------------
+
+-spec ipaddr(string() | tuple())
+ -> inet:ip_address().
+
+%% Don't convert lists of integers since a length 8 list like
+%% [$1,$0,$.,$0,$.,$0,$.,$1] is ambiguous: is it "10.0.0.1" or
+%% "49:48:46:48:46:48:46:49"?
+%%
+%% RFC 2373 defines the format parsed for v6 addresses.
+
+%% Be brutal.
+ipaddr(Addr) ->
+ try
+ ip(Addr)
+ catch
+ error: _ ->
+ erlang:error({invalid_address, ?STACK})
+ end.
+
+%% Already a tuple: ensure non-negative integers of the right size.
+ip(T)
+ when size(T) == 4;
+ size(T) == 8 ->
+ Bs = 2*size(T),
+ [] = lists:filter(fun(N) when 0 =< N -> 0 < N bsr Bs end,
+ tuple_to_list(T)),
+ T;
+
+%% Or not: convert from '.'/':'-separated decimal/hex.
+ip(Addr) ->
+ {ok, A} = inet_parse:address(Addr), %% documented in inet(3)
+ A.
+
+%%% ---------------------------------------------------------------------------
+%%% # spawn_opts(Type, Opts)
+%%% ---------------------------------------------------------------------------
+
+%% TODO: config variables.
+
+spawn_opts(server, Opts) ->
+ opts(75000, Opts);
+spawn_opts(worker, Opts) ->
+ opts(5000, Opts).
+
+opts(HeapSize, Opts) ->
+ [{min_heap_size, HeapSize} | lists:keydelete(min_heap_size, 1, Opts)].
+
+%%% ---------------------------------------------------------------------------
+%%% # wait(MRefs)
+%%% ---------------------------------------------------------------------------
+
+wait(L) ->
+ w([erlang:monitor(process, P) || P <- L]).
+
+w([]) ->
+ ok;
+w(L) ->
+ receive
+ {'DOWN', MRef, process, _, _} ->
+ w(lists:delete(MRef, L))
+ end.
+
+%%% ---------------------------------------------------------------------------
+%%% # fold_tuple(N, T0, T)
+%%% ---------------------------------------------------------------------------
+
+%% Replace fields in T0 by those of T starting at index N, unless the
+%% new value is 'undefined'.
+%%
+%% eg. fold_tuple(2, Hdr, #diameter_header{end_to_end_id = 42})
+
+fold_tuple(_, T, undefined) ->
+ T;
+
+fold_tuple(N, T0, T1) ->
+ {_, T} = lists:foldl(fun(V, {I,_} = IT) -> {I+1, ft(V, IT)} end,
+ {N, T0},
+ lists:nthtail(N-1, tuple_to_list(T1))),
+ T.
+
+ft(undefined, {_, T}) ->
+ T;
+ft(Value, {Idx, T}) ->
+ setelement(Idx, T, Value).
+
+%%% ----------------------------------------------------------
+%%% # log(Slogan, Mod, Line, Details)
+%%%
+%%% Called to have something to trace on for happenings of interest.
+%%% ----------------------------------------------------------
+
+log(_, _, _, _) ->
+ ok.
diff --git a/lib/diameter/src/base/diameter_misc_sup.erl b/lib/diameter/src/base/diameter_misc_sup.erl
new file mode 100644
index 0000000000..4e40476f14
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl
new file mode 100644
index 0000000000..3e78c4caef
--- /dev/null
+++ b/lib/diameter/src/base/diameter_peer.erl
@@ -0,0 +1,225 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_peer).
+
+-behaviour(gen_server).
+
+%% Interface towards transport modules ...
+-export([recv/2,
+ up/1,
+ up/2]).
+
+%% ... and the stack.
+-export([start/3,
+ send/2,
+ close/1,
+ abort/1,
+ notify/2]).
+
+%% Server start.
+-export([start_link/0]).
+
+%% gen_server callbacks
+-export([init/1,
+ terminate/2,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ code_change/3]).
+
+%% debug
+-export([state/0,
+ uptime/0]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_internal.hrl").
+
+%% Registered name of the server.
+-define(SERVER, ?MODULE).
+
+%% Server state.
+-record(state, {id = now()}).
+
+%%% ---------------------------------------------------------------------------
+%%% # notify/2
+%%% ---------------------------------------------------------------------------
+
+notify(SvcName, T) ->
+ rpc:abcast(nodes(), ?SERVER, {notify, SvcName, T}).
+
+%%% ---------------------------------------------------------------------------
+%%% # start/3
+%%% ---------------------------------------------------------------------------
+
+start(T, Opts, #diameter_service{} = Svc) ->
+ {Mod, Cfg} = split_transport(Opts),
+ apply(Mod, start, [T, Svc, Cfg]).
+
+%%% ---------------------------------------------------------------------------
+%%% # up/[12]
+%%% ---------------------------------------------------------------------------
+
+up(Pid) -> %% accepting transport
+ ifc_send(Pid, {self(), connected}).
+
+up(Pid, Remote) -> %% connecting transport
+ ifc_send(Pid, {self(), connected, Remote}).
+
+%%% ---------------------------------------------------------------------------
+%%% # recv/2
+%%% ---------------------------------------------------------------------------
+
+recv(Pid, Pkt) ->
+ ifc_send(Pid, {recv, Pkt}).
+
+%%% ---------------------------------------------------------------------------
+%%% # send/2
+%%% ---------------------------------------------------------------------------
+
+send(Pid, #diameter_packet{transport_data = undefined,
+ bin = Bin}) ->
+ send(Pid, Bin);
+
+send(Pid, Pkt) ->
+ ifc_send(Pid, {send, Pkt}).
+
+%%% ---------------------------------------------------------------------------
+%%% # close/1
+%%% ---------------------------------------------------------------------------
+
+close(Pid) ->
+ ifc_send(Pid, {close, self()}).
+
+%%% ---------------------------------------------------------------------------
+%%% # abort/1
+%%% ---------------------------------------------------------------------------
+
+abort(Pid) ->
+ exit(Pid, shutdown).
+
+%% ---------------------------------------------------------------------------
+%% ---------------------------------------------------------------------------
+
+start_link() ->
+ ServerName = {local, ?SERVER},
+ Module = ?MODULE,
+ Args = [],
+ Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}],
+ gen_server:start_link(ServerName, Module, Args, Options).
+
+state() ->
+ call(state).
+
+uptime() ->
+ call(uptime).
+
+%%% ----------------------------------------------------------
+%%% # init(Role)
+%%% ----------------------------------------------------------
+
+init([]) ->
+ {ok, #state{}}.
+
+%%% ----------------------------------------------------------
+%%% # handle_call(Request, From, State)
+%%% ----------------------------------------------------------
+
+handle_call(state, _, State) ->
+ {reply, State, State};
+
+handle_call(uptime, _, #state{id = Time} = State) ->
+ {reply, diameter_lib:now_diff(Time), State};
+
+handle_call(Req, From, State) ->
+ ?UNEXPECTED([Req, From]),
+ {reply, nok, State}.
+
+%%% ----------------------------------------------------------
+%%% # handle_cast(Request, State)
+%%% ----------------------------------------------------------
+
+handle_cast(Msg, State) ->
+ ?UNEXPECTED([Msg]),
+ {noreply, State}.
+
+%%% ----------------------------------------------------------
+%%% # handle_info(Request, State)
+%%% ----------------------------------------------------------
+
+%% Remote service is distributing a message.
+handle_info({notify, SvcName, T}, S) ->
+ bang(diameter_service:whois(SvcName), T),
+ {noreply, S};
+
+handle_info(Info, State) ->
+ ?UNEXPECTED([Info]),
+ {noreply, State}.
+
+%% ----------------------------------------------------------
+%% terminate(Reason, State)
+%% ----------------------------------------------------------
+
+terminate(_Reason, _State) ->
+ ok.
+
+%% ----------------------------------------------------------
+%% code_change(OldVsn, State, Extra)
+%% ----------------------------------------------------------
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%% ---------------------------------------------------------
+%% INTERNAL FUNCTIONS
+%% ---------------------------------------------------------
+
+%% ifc_send/2
+%%
+%% Send something over the transport interface.
+
+ifc_send(Pid, T) ->
+ Pid ! {diameter, T}.
+
+%% bang/2
+
+bang(undefined = No, _) ->
+ No;
+bang(Pid, T) ->
+ Pid ! T.
+
+%% split_transport/1
+%%
+%% Split options into transport module, transport config and
+%% remaining options.
+
+split_transport(Opts) ->
+ {[M,C], _} = proplists:split(Opts, [transport_module,
+ transport_config]),
+ {value(M, diameter_tcp), value(C, [])}.
+
+value([{_,V}], _) ->
+ V;
+value([], V) ->
+ V.
+
+%% call/1
+
+call(Request) ->
+ gen_server:call(?SERVER, Request, infinity).
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
new file mode 100644
index 0000000000..282fa2742f
--- /dev/null
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -0,0 +1,777 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% This module implements (as a process) the RFC 3588 Peer State
+%% Machine modulo the necessity of adapting the peer election to the
+%% fact that we don't know the identity of a peer until we've
+%% received a CER/CEA from it.
+%%
+
+-module(diameter_peer_fsm).
+-behaviour(gen_server).
+
+%% Interface towards diameter_watchdog.
+-export([start/3]).
+
+%% gen_server callbacks
+-export([init/1,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ terminate/2,
+ code_change/3]).
+
+%% diameter_peer_fsm_sup callback
+-export([start_link/1]).
+
+%% internal callbacks
+-export([match/1]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_internal.hrl").
+-include("diameter_types.hrl").
+-include("diameter_gen_base_rfc3588.hrl").
+
+-define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU').
+-define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING').
+
+-define(NO_INBAND_SECURITY, 0).
+-define(TLS, 1).
+
+-define(LOOP_TIMEOUT, 2000).
+
+%% RFC 3588:
+%%
+%% Timeout An application-defined timer has expired while waiting
+%% for some event.
+%%
+-define(EVENT_TIMEOUT, 10000).
+
+%% How long to wait for a DPA in response to DPR before simply
+%% aborting. Used to distinguish between shutdown and not but there's
+%% not really any need. Stopping a service will require a timeout if
+%% the peer doesn't answer DPR so the value should be short-ish.
+-define(DPA_TIMEOUT, 1000).
+
+-record(state,
+ {state = 'Wait-Conn-Ack' %% state of RFC 3588 Peer State Machine
+ :: 'Wait-Conn-Ack' | recv_CER | 'Wait-CEA' | 'Open',
+ mode :: accept | connect | {connect, reference()},
+ parent :: pid(),
+ transport :: pid(),
+ service :: #diameter_service{},
+ dpr = false :: false | {'Unsigned32'(), 'Unsigned32'()}}).
+ %% | hop by hop and end to end identifiers
+
+%% There are non-3588 states possible as a consequence of 5.6.1 of the
+%% standard and the corresponding problem for incoming CEA's: we don't
+%% know who we're talking to until either a CER or CEA has been
+%% received. The CEA problem in particular makes it impossible to
+%% follow the state machine exactly as documented in 3588: there can
+%% be no election until the CEA arrives and we have an Origin-Host to
+%% elect.
+
+%%
+%% Once upon a time start/2 started a process akin to that started by
+%% start/3 below, which in turn started a watchdog/transport process
+%% with the result that the watchdog could send DWR/DWA regardless of
+%% whether or not the corresponding Peer State Machine was in its open
+%% state; that is, before capabilities exchange had taken place. This
+%% is not what RFC's 3588 and 3539 say (albeit not very clearly).
+%% Watchdog messages are only exchanged on *open* connections, so the
+%% 3539 state machine is more naturally placed on top of the 3588 Peer
+%% State Machine rather than closer to the transport. This is what we
+%% now do below: connect/accept call diameter_watchdog and return the
+%% pid of the watchdog process, and the watchdog in turn calls start/3
+%% below to start the process implementing the Peer State Machine. The
+%% former is a "peer" in diameter_service while the latter is a
+%% "conn". In a sense, diameter_service sees the watchdog as
+%% implementing the Peer State Machine and the process implemented
+%% here as being the transport, not being aware of the watchdog at
+%% all.
+%%
+
+%%% ---------------------------------------------------------------------------
+%%% # start({connect|accept, Ref}, Opts, Service)
+%%%
+%%% Output: Pid
+%%% ---------------------------------------------------------------------------
+
+%% diameter_config requires a non-empty list of applications on the
+%% service but diameter_service then constrains the list to any
+%% specified on the transport in question. Check here that the list is
+%% still non-empty.
+
+start({_, Ref} = Type, Opts, #diameter_service{applications = Apps} = Svc) ->
+ [] /= Apps orelse ?ERROR({no_apps, Type, Opts}),
+ T = {self(), Type, Opts, Svc},
+ {ok, Pid} = diameter_peer_fsm_sup:start_child(T),
+ diameter_stats:reg(Pid, Ref),
+ Pid.
+
+start_link(T) ->
+ {ok, _} = proc_lib:start_link(?MODULE,
+ init,
+ [T],
+ infinity,
+ diameter_lib:spawn_opts(server, [])).
+
+%%% ---------------------------------------------------------------------------
+%%% ---------------------------------------------------------------------------
+
+%% init/1
+
+init(T) ->
+ proc_lib:init_ack({ok, self()}),
+ gen_server:enter_loop(?MODULE, [], i(T)).
+
+i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) ->
+ putr(dwa, dwa(Caps)),
+ {ok, TPid, Svc} = start_transport(T, Opts, Svc0),
+ erlang:monitor(process, TPid),
+ erlang:monitor(process, WPid),
+ #state{parent = WPid,
+ transport = TPid,
+ mode = M,
+ service = Svc}.
+%% The transport returns its local ip addresses so that different
+%% transports on the same service can use different local addresses.
+%% The local addresses are put into Host-IP-Address avps here when
+%% sending capabilities exchange messages.
+%%
+%% Invalid transport config may cause us to crash but note that the
+%% watchdog start (start/2) succeeds regardless so as not to crash the
+%% service.
+
+start_transport(T, Opts, Svc) ->
+ case diameter_peer:start(T, Opts, Svc) of
+ {ok, TPid} ->
+ {ok, TPid, Svc};
+ {ok, TPid, [_|_] = Addrs} ->
+ #diameter_service{capabilities = Caps0} = Svc,
+ Caps = Caps0#diameter_caps{host_ip_address = Addrs},
+ {ok, TPid, Svc#diameter_service{capabilities = Caps}};
+ No ->
+ exit({shutdown, No})
+ end.
+
+%% handle_call/3
+
+handle_call(_, _, State) ->
+ {reply, nok, State}.
+
+%% handle_cast/2
+
+handle_cast(_, State) ->
+ {noreply, State}.
+
+%% handle_info/1
+
+handle_info(T, #state{} = State) ->
+ try transition(T, State) of
+ ok ->
+ {noreply, State};
+ #state{state = X} = S ->
+ ?LOGC(X =/= State#state.state, transition, X),
+ {noreply, S};
+ {stop, Reason} ->
+ ?LOG(stop, Reason),
+ x(Reason, State);
+ stop ->
+ ?LOG(stop, T),
+ x(T, State)
+ catch
+ throw: {?MODULE, Tag, Reason} ->
+ ?LOG(Tag, {Reason, T}),
+ {stop, {shutdown, Reason}, State}
+ end.
+
+x(Reason, #state{} = S) ->
+ close_wd(Reason, S),
+ {stop, {shutdown, Reason}, S}.
+
+%% terminate/2
+
+terminate(_, _) ->
+ ok.
+
+%% code_change/3
+
+code_change(_, State, _) ->
+ {ok, State}.
+
+%%% ---------------------------------------------------------------------------
+%%% ---------------------------------------------------------------------------
+
+putr(Key, Val) ->
+ put({?MODULE, Key}, Val).
+
+getr(Key) ->
+ get({?MODULE, Key}).
+
+%% transition/2
+
+%% Connection to peer.
+transition({diameter, {TPid, connected, Remote}},
+ #state{state = PS,
+ mode = M}
+ = S) ->
+ 'Wait-Conn-Ack' = PS, %% assert
+ connect = M, %%
+ send_CER(S#state{mode = {M, Remote},
+ transport = TPid});
+
+%% Connection from peer.
+transition({diameter, {TPid, connected}},
+ #state{state = PS,
+ mode = M,
+ parent = Pid}
+ = S) ->
+ 'Wait-Conn-Ack' = PS, %% assert
+ accept = M, %%
+ Pid ! {accepted, self()},
+ start_timer(S#state{state = recv_CER,
+ transport = TPid});
+
+%% Incoming message from the transport.
+transition({diameter, {recv, Pkt}}, S) ->
+ recv(Pkt, S);
+
+%% Timeout when still in the same state ...
+transition({timeout, PS}, #state{state = PS}) ->
+ stop;
+
+%% ... or not.
+transition({timeout, _}, _) ->
+ ok;
+
+%% Outgoing message.
+transition({send, Msg}, #state{transport = TPid}) ->
+ send(TPid, Msg),
+ ok;
+
+%% Request for graceful shutdown.
+transition({shutdown, Pid}, #state{parent = Pid, dpr = false} = S) ->
+ dpr(?GOAWAY, S);
+transition({shutdown, Pid}, #state{parent = Pid}) ->
+ ok;
+
+%% Application shutdown.
+transition(shutdown, #state{dpr = false} = S) ->
+ dpr(?REBOOT, S);
+transition(shutdown, _) -> %% DPR already send: ensure expected timeout
+ dpa_timer(),
+ ok;
+
+%% Request to close the transport connection.
+transition({close = T, Pid}, #state{parent = Pid,
+ transport = TPid}) ->
+ diameter_peer:close(TPid),
+ {stop, T};
+
+%% DPA reception has timed out.
+transition(dpa_timeout, _) ->
+ stop;
+
+%% Someone wants to know a resolved port: forward to the transport process.
+transition({resolve_port, _Pid} = T, #state{transport = TPid}) ->
+ TPid ! T,
+ ok;
+
+%% Parent or transport has died.
+transition({'DOWN', _, process, P, _},
+ #state{parent = Pid,
+ transport = TPid})
+ when P == Pid;
+ P == TPid ->
+ stop;
+
+%% State query.
+transition({state, Pid}, #state{state = S, transport = TPid}) ->
+ Pid ! {self(), [S, TPid]},
+ ok.
+
+%% Crash on anything unexpected.
+
+%% send_CER/1
+
+send_CER(#state{mode = {connect, Remote},
+ service = #diameter_service{capabilities = Caps},
+ transport = TPid}
+ = S) ->
+ req_send_CER(Caps#diameter_caps.origin_host, Remote)
+ orelse
+ close(connected, S),
+ CER = build_CER(S),
+ ?LOG(send, 'CER'),
+ send(TPid, encode(CER)),
+ start_timer(S#state{state = 'Wait-CEA'}).
+
+%% Register ourselves as connecting to the remote endpoint in
+%% question. This isn't strictly necessary since a peer implementing
+%% the 3588 Peer State Machine should reject duplicate connection's
+%% from the same peer but there's little point in us setting up a
+%% duplicate connection in the first place. This could also include
+%% the transport protocol being used but since we're blind to
+%% transport just avoid duplicate connections to the same host/port.
+req_send_CER(OriginHost, Remote) ->
+ register_everywhere({?MODULE, connection, OriginHost, {remote, Remote}}).
+
+%% start_timer/1
+
+start_timer(#state{state = PS} = S) ->
+ erlang:send_after(?EVENT_TIMEOUT, self(), {timeout, PS}),
+ S.
+
+%% build_CER/1
+
+build_CER(#state{service = #diameter_service{capabilities = Caps}}) ->
+ {ok, CER} = diameter_capx:build_CER(Caps),
+ CER.
+
+%% encode/1
+
+encode(Rec) ->
+ #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Rec),
+ Bin.
+
+%% recv/2
+
+%% RFC 3588 has result code 5015 for an invalid length but if a
+%% transport is detecting message boundaries using the length header
+%% then a length error will likely lead to further errors.
+
+recv(#diameter_packet{header = #diameter_header{length = Len}
+ = Hdr,
+ bin = Bin},
+ S)
+ when Len < 20;
+ (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) ->
+ discard(invalid_message_length, recv, [size(Bin),
+ bit_size(Bin) rem 8,
+ Hdr,
+ S]);
+
+recv(#diameter_packet{header = #diameter_header{} = Hdr}
+ = Pkt,
+ #state{parent = Pid}
+ = S) ->
+ Name = diameter_codec:msg_name(Hdr),
+ Pid ! {recv, self(), Name, Pkt},
+ diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received
+ rcv(Name, Pkt, S);
+
+recv(#diameter_packet{header = undefined,
+ bin = Bin}
+ = Pkt,
+ S) ->
+ recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S);
+
+recv(Bin, S)
+ when is_binary(Bin) ->
+ recv(#diameter_packet{bin = Bin}, S);
+
+recv(#diameter_packet{header = false} = Pkt, S) ->
+ discard(truncated_header, recv, [Pkt, S]).
+
+msg_id({_,_,_} = T, _) ->
+ T;
+msg_id(_, Hdr) ->
+ diameter_codec:msg_id(Hdr).
+
+%% Treat invalid length as a transport error and die. Especially in
+%% the TCP case, in which there's no telling where the next message
+%% begins in the incoming byte stream, keeping a crippled connection
+%% alive may just make things worse.
+
+discard(Reason, F, A) ->
+ diameter_stats:incr(Reason),
+ diameter_lib:warning_report(Reason, {?MODULE, F, A}),
+ throw({?MODULE, abort, Reason}).
+
+%% rcv/3
+
+%% Incoming CEA.
+rcv('CEA', Pkt, #state{state = 'Wait-CEA'} = S) ->
+ handle_CEA(Pkt, S);
+
+%% Incoming CER
+rcv('CER' = N, Pkt, #state{state = recv_CER} = S) ->
+ handle_request(N, Pkt, S);
+
+%% Anything but CER/CEA in a non-Open state is an error, as is
+%% CER/CEA in anything but recv_CER/Wait-CEA.
+rcv(Name, _, #state{state = PS})
+ when PS /= 'Open';
+ Name == 'CER';
+ Name == 'CEA' ->
+ {stop, {Name, PS}};
+
+rcv(N, Pkt, S)
+ when N == 'DWR';
+ N == 'DPR' ->
+ handle_request(N, Pkt, S);
+
+%% DPA even though we haven't sent DPR: ignore.
+rcv('DPA', _Pkt, #state{dpr = false}) ->
+ ok;
+
+%% DPA in response to DPR. We could check the sequence numbers but
+%% don't bother, just close.
+rcv('DPA' = N, _Pkt, #state{transport = TPid}) ->
+ diameter_peer:close(TPid),
+ {stop, N};
+
+rcv(_, _, _) ->
+ ok.
+
+%% send/2
+
+%% Msg here could be a #diameter_packet or a binary depending on who's
+%% sending. In particular, the watchdog will send DWR as a binary
+%% while messages coming from clients will be in a #diameter_packet.
+send(Pid, Msg) ->
+ diameter_stats:incr({diameter_codec:msg_id(Msg), send}),
+ diameter_peer:send(Pid, Msg).
+
+%% handle_request/3
+
+handle_request(Type, #diameter_packet{} = Pkt, S) ->
+ ?LOG(recv, Type),
+ send_answer(Type, diameter_codec:decode(?BASE, Pkt), S).
+
+%% send_answer/3
+
+send_answer(Type, ReqPkt, #state{transport = TPid} = S) ->
+ #diameter_packet{header = #diameter_header{version = V,
+ end_to_end_id = Eid,
+ hop_by_hop_id = Hid,
+ is_proxiable = P},
+ transport_data = TD}
+ = ReqPkt,
+
+ {Answer, PostF} = build_answer(Type, V, ReqPkt, S),
+
+ Pkt = #diameter_packet{header = #diameter_header{version = V,
+ end_to_end_id = Eid,
+ hop_by_hop_id = Hid,
+ is_proxiable = P},
+ msg = Answer,
+ transport_data = TD},
+
+ send(TPid, diameter_codec:encode(?BASE, Pkt)),
+ eval(PostF, S).
+
+eval([F|A], S) ->
+ apply(F, A ++ [S]);
+eval(ok, S) ->
+ S.
+
+%% build_answer/4
+
+build_answer('CER',
+ ?DIAMETER_VERSION,
+ #diameter_packet{msg = CER,
+ header = #diameter_header{is_error = false},
+ errors = []}
+ = Pkt,
+ #state{service = Svc}
+ = S) ->
+ #diameter_service{capabilities = #diameter_caps{origin_host = OH}}
+ = Svc,
+
+ {SupportedApps,
+ #diameter_caps{origin_host = DH} = RCaps,
+ #diameter_base_CEA{'Result-Code' = RC}
+ = CEA}
+ = recv_CER(CER, S),
+
+ try
+ 2001 == RC %% DIAMETER_SUCCESS
+ orelse ?THROW({sent_CEA, RC}),
+ register_everywhere({?MODULE, connection, OH, DH})
+ orelse ?THROW({election_lost, 4003}),
+ #diameter_base_CEA{'Inband-Security-Id' = [IS]}
+ = CEA,
+ {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]}
+ catch
+ ?FAILURE({Reason, RC}) ->
+ {answer('CER', S) ++ [{'Result-Code', RC}],
+ [fun close/2, {'CER', Reason, DH}]}
+ end;
+
+%% The error checks below are similar to those in diameter_service for
+%% other messages. Should factor out the commonality.
+
+build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) ->
+ FailedAvp = failed_avp([A || {_,A} <- Es]),
+ Ans = answer(answer(Type, S), V, H, Es),
+ {set(Ans, FailedAvp), if 'CER' == Type ->
+ [fun close/2, {Type, V, Pkt}];
+ true ->
+ ok
+ end}.
+
+failed_avp([] = No) ->
+ No;
+failed_avp(Avps) ->
+ [{'Failed-AVP', [[{'AVP', Avps}]]}].
+
+set(Ans, []) ->
+ Ans;
+set(['answer-message' | _] = Ans, FailedAvp) ->
+ Ans ++ [{'AVP', [FailedAvp]}];
+set([_|_] = Ans, FailedAvp) ->
+ Ans ++ FailedAvp.
+
+answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) ->
+ ['answer-message', OH, OR, {'Result-Code', 3008}];
+
+answer([_, OH, OR | _], _, _, [Bs|_])
+ when is_bitstring(Bs) ->
+ ['answer-message', OH, OR, {'Result-Code', 3009}];
+
+answer(Ans, ?DIAMETER_VERSION, _, Es) ->
+ Ans ++ [{'Result-Code', rc(Es)}];
+
+answer(Ans, _, _, _) ->
+ Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION
+
+rc([]) ->
+ 2001; %% DIAMETER_SUCCESS
+rc([{RC,_}|_]) ->
+ RC;
+rc([RC|_]) ->
+ RC.
+
+%% DIAMETER_INVALID_HDR_BITS 3008
+%% A request was received whose bits in the Diameter header were
+%% either set to an invalid combination, or to a value that is
+%% inconsistent with the command code's definition.
+
+%% DIAMETER_INVALID_AVP_BITS 3009
+%% A request was received that included an AVP whose flag bits are
+%% set to an unrecognized value, or that is inconsistent with the
+%% AVP's definition.
+
+%% ELECTION_LOST 4003
+%% The peer has determined that it has lost the election process and
+%% has therefore disconnected the transport connection.
+
+%% DIAMETER_NO_COMMON_APPLICATION 5010
+%% This error is returned when a CER message is received, and there
+%% are no common applications supported between the peers.
+
+%% DIAMETER_UNSUPPORTED_VERSION 5011
+%% This error is returned when a request was received, whose version
+%% number is unsupported.
+
+%% answer/2
+
+answer('DWR', _) ->
+ getr(dwa);
+
+answer(Name, #state{service = #diameter_service{capabilities = Caps}}) ->
+ a(Name, Caps).
+
+a('CER', #diameter_caps{vendor_id = Vid,
+ origin_host = Host,
+ origin_realm = Realm,
+ host_ip_address = Addrs,
+ product_name = Name}) ->
+ ['CEA', {'Origin-Host', Host},
+ {'Origin-Realm', Realm},
+ {'Host-IP-Address', Addrs},
+ {'Vendor-Id', Vid},
+ {'Product-Name', Name}];
+
+a('DPR', #diameter_caps{origin_host = Host,
+ origin_realm = Realm}) ->
+ ['DPA', {'Origin-Host', Host},
+ {'Origin-Realm', Realm}].
+
+%% recv_CER/2
+
+recv_CER(CER, #state{service = Svc}) ->
+ {ok, T} = diameter_capx:recv_CER(CER, Svc),
+ T.
+
+%% handle_CEA/1
+
+handle_CEA(#diameter_packet{header = #diameter_header{version = V},
+ bin = Bin}
+ = Pkt,
+ #state{service = #diameter_service{capabilities = LCaps}}
+ = S)
+ when is_binary(Bin) ->
+ ?LOG(recv, 'CEA'),
+
+ ?DIAMETER_VERSION == V orelse close({version, V}, S),
+
+ #diameter_packet{msg = CEA, errors = Errors}
+ = DPkt
+ = diameter_codec:decode(?BASE, Pkt),
+
+ [] == Errors orelse close({errors, Errors}, S),
+
+ {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps}
+ = recv_CEA(CEA, S),
+
+ #diameter_caps{origin_host = OH}
+ = LCaps,
+
+ %% Ensure that we don't already have a connection to the peer in
+ %% question. This isn't the peer election of 3588 except in the
+ %% sense that, since we don't know who we're talking to until we
+ %% receive a CER/CEA, the first that arrives wins the right to a
+ %% connection with the peer.
+
+ register_everywhere({?MODULE, connection, OH, DH})
+ orelse close({'CEA', DH}, S),
+
+ open(DPkt, SApps, RCaps, {connect, IS}, S).
+
+%% recv_CEA/2
+
+recv_CEA(CEA, #state{service = Svc} = S) ->
+ case diameter_capx:recv_CEA(CEA, Svc) of
+ {ok, {_,_}} -> %% return from old code
+ close({'CEA', update}, S);
+ {ok, {[], _, _}} ->
+ close({'CEA', no_common_application}, S);
+ {ok, {_, [], _}} ->
+ close({'CEA', no_common_security}, S);
+ {ok, {_,_,_} = T} ->
+ T;
+ {error, Reason} ->
+ close({'CEA', Reason}, S)
+ end.
+
+%% open/5
+
+open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid,
+ service = Svc}
+ = S) ->
+ #diameter_service{capabilities = #diameter_caps{origin_host = OH,
+ inband_security_id = LS}
+ = LCaps}
+ = Svc,
+ #diameter_caps{origin_host = DH}
+ = RCaps,
+
+ tls_ack(lists:member(?TLS, LS), Type, IS, S),
+ Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}},
+
+ S#state{state = 'Open'}.
+
+%% We've advertised TLS support: tell the transport the result
+%% and expect a reply when the handshake is complete.
+tls_ack(true, Type, IS, #state{transport = TPid} = S) ->
+ Ref = make_ref(),
+ MRef = erlang:monitor(process, TPid),
+ TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}},
+ receive
+ {diameter, {tls, Ref}} ->
+ erlang:demonitor(MRef, [flush]);
+ {'DOWN', MRef, process, _, _} = T ->
+ close({tls_ack, T}, S)
+ end;
+
+%% Or not. Don't send anything to the transport so that transports
+%% not supporting TLS work as before without modification.
+tls_ack(false, _, _, _) ->
+ ok.
+
+capz(#diameter_caps{} = L, #diameter_caps{} = R) ->
+ #diameter_caps{}
+ = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)),
+ tl(tuple_to_list(R)))]).
+
+%% close/2
+
+%% Tell the watchdog that our death isn't due to transport failure.
+close(Reason, #state{parent = Pid}) ->
+ close_wd(Reason, Pid),
+ throw({?MODULE, close, Reason}).
+
+%% close_wd/2
+
+%% Ensure the watchdog dies if DPR has been sent ...
+close_wd(_, #state{dpr = false}) ->
+ ok;
+close_wd(Reason, #state{parent = Pid}) ->
+ close_wd(Reason, Pid);
+
+%% ... or otherwise
+close_wd(Reason, Pid) ->
+ Pid ! {close, self(), Reason}.
+
+%% dwa/1
+
+dwa(#diameter_caps{origin_host = OH,
+ origin_realm = OR,
+ origin_state_id = OSI}) ->
+ ['DWA', {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Origin-State-Id', OSI}].
+
+%% dpr/2
+
+dpr(Cause, #state{transport = TPid,
+ service = #diameter_service{capabilities = Caps}}
+ = S) ->
+ #diameter_caps{origin_host = OH,
+ origin_realm = OR}
+ = Caps,
+
+ Bin = encode(['DPR', {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Disconnect-Cause', Cause}]),
+ send(TPid, Bin),
+ dpa_timer(),
+ ?LOG(send, 'DPR'),
+ S#state{dpr = diameter_codec:sequence_numbers(Bin)}.
+
+dpa_timer() ->
+ erlang:send_after(?DPA_TIMEOUT, self(), dpa_timeout).
+
+%% register_everywhere/1
+%%
+%% Register a term and ensure it's not registered elsewhere. Note that
+%% two process that simultaneously register the same term may well
+%% both fail to do so this isn't foolproof.
+
+register_everywhere(T) ->
+ diameter_reg:add_new(T)
+ andalso unregistered(T).
+
+unregistered(T) ->
+ {ResL, _} = rpc:multicall(?MODULE, match, [{node(), T}]),
+ lists:all(fun(L) -> [] == L end, ResL).
+
+match({Node, _})
+ when Node == node() ->
+ [];
+match({_, T}) ->
+ try
+ diameter_reg:match(T)
+ catch
+ _:_ -> []
+ end.
diff --git a/lib/diameter/src/base/diameter_peer_fsm_sup.erl b/lib/diameter/src/base/diameter_peer_fsm_sup.erl
new file mode 100644
index 0000000000..995eaf74d0
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl
new file mode 100644
index 0000000000..882b9da238
--- /dev/null
+++ b/lib/diameter/src/base/diameter_reg.erl
@@ -0,0 +1,327 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% The module implements a simple term -> pid registry.
+%%
+
+-module(diameter_reg).
+-compile({no_auto_import, [monitor/2]}).
+
+-behaviour(gen_server).
+
+-export([add/1,
+ add_new/1,
+ del/1,
+ repl/2,
+ match/1]).
+
+-export([start_link/0]).
+
+%% gen_server callbacks
+-export([init/1,
+ terminate/2,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ code_change/3]).
+
+%% test
+-export([pids/0,
+ terms/0]).
+
+%% debug
+-export([state/0,
+ uptime/0]).
+
+-include("diameter_internal.hrl").
+
+-define(SERVER, ?MODULE).
+-define(TABLE, ?MODULE).
+
+%% Table entry used to keep from starting more than one monitor on the
+%% same process. This isn't a problem but there's no point in starting
+%% multiple monitors if we can avoid it. Note that we can't have a 2-tuple
+%% keyed on Pid since a registered term can be anything. Want the entry
+%% keyed on Pid so that lookup is fast.
+-define(MONITOR(Pid, MRef), {Pid, monitor, MRef}).
+
+%% Table entry containing the Term -> Pid mapping.
+-define(MAPPING(Term, Pid), {Term, Pid}).
+
+-record(state, {id = now()}).
+
+%%% ----------------------------------------------------------
+%%% # add(T)
+%%%
+%%% Input: Term = term()
+%%%
+%%% Output: true
+%%%
+%%% Description: Associate the specified term with self(). The list of pids
+%%% having this or other assocations can be retrieved using
+%%% match/1.
+%%%
+%%% An association is removed when the calling process dies
+%%% or as a result of calling del/1. Adding the same term
+%%% more than once is equivalent to adding it exactly once.
+%%%
+%%% Note that since match/1 takes a pattern as argument,
+%%% specifying a term that contains match variables is
+%%% probably not a good idea
+%%% ----------------------------------------------------------
+
+-spec add(any())
+ -> true.
+
+add(T) ->
+ call({add, fun ets:insert/2, T, self()}).
+
+%%% ----------------------------------------------------------
+%%% # add_new(T)
+%%%
+%%% Input: T = term()
+%%%
+%%% Output: true | false
+%%%
+%%% Description: Like add/1 but only one process is allowed to have the
+%%% the association, false being returned if an association
+%%% already exists.
+%%% ----------------------------------------------------------
+
+-spec add_new(any())
+ -> boolean().
+
+add_new(T) ->
+ call({add, fun insert_new/2, T, self()}).
+
+%%% ----------------------------------------------------------
+%%% # repl(T, NewT)
+%%%
+%%% Input: T, NewT = term()
+%%%
+%%% Output: true | false
+%%%
+%%% Description: Like add/1 but only replace an existing association on T,
+%%% false being returned if it doesn't exist.
+%%% ----------------------------------------------------------
+
+-spec repl(any(), any())
+ -> boolean().
+
+repl(T, U) ->
+ call({repl, T, U, self()}).
+
+%%% ----------------------------------------------------------
+%%% # del(Term)
+%%%
+%%% Input: Term = term()
+%%%
+%%% Output: true
+%%%
+%%% Description: Remove any existing association of Term with self().
+%%% ----------------------------------------------------------
+
+-spec del(any())
+ -> true.
+
+del(T) ->
+ call({del, T, self()}).
+
+%%% ----------------------------------------------------------
+%%% # match(Pat)
+%%%
+%%% Input: Pat = pattern in the sense of ets:match_object/2.
+%%%
+%%% Output: list of {Term, Pid}
+%%%
+%%% Description: Return the list of associations whose Term, as specified
+%%% to add/1 or add_new/1, matches the specified pattern.
+%%%
+%%% Note that there's no guarantee that the returned processes
+%%% are still alive. (Although one that isn't will soon have
+%%% its associations removed.)
+%%% ----------------------------------------------------------
+
+-spec match(tuple())
+ -> [{term(), pid()}].
+
+match(Pat) ->
+ ets:match_object(?TABLE, ?MAPPING(Pat, '_')).
+
+%% ---------------------------------------------------------
+%% EXPORTED INTERNAL FUNCTIONS
+%% ---------------------------------------------------------
+
+start_link() ->
+ ServerName = {local, ?SERVER},
+ Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}],
+ gen_server:start_link(ServerName, ?MODULE, [], Options).
+
+state() ->
+ call(state).
+
+uptime() ->
+ call(uptime).
+
+%% pids/0
+%%
+%% Output: list of {Pid, [Term, ...]}
+
+pids() ->
+ to_list(fun swap/1).
+
+to_list(Fun) ->
+ ets:foldl(fun(T,A) -> acc(Fun, T, A) end, orddict:new(), ?TABLE).
+
+acc(Fun, ?MAPPING(Term, Pid), Dict) ->
+ append(Fun({Term, Pid}), Dict);
+acc(_, _, Dict) ->
+ Dict.
+
+append({K,V}, Dict) ->
+ orddict:append(K, V, Dict).
+
+id(T) -> T.
+
+%% terms/0
+%%
+%% Output: list of {Term, [Pid, ...]}
+
+terms() ->
+ to_list(fun id/1).
+
+swap({X,Y}) -> {Y,X}.
+
+%%% ----------------------------------------------------------
+%%% # init(Role)
+%%%
+%%% Output: {ok, State}
+%%% ----------------------------------------------------------
+
+init(_) ->
+ ets:new(?TABLE, [bag, named_table]),
+ {ok, #state{}}.
+
+%%% ----------------------------------------------------------
+%%% # handle_call(Request, From, State)
+%%% ----------------------------------------------------------
+
+handle_call({add, Fun, Key, Pid}, _, State) ->
+ B = Fun(?TABLE, {Key, Pid}),
+ monitor(B andalso no_monitor(Pid), Pid),
+ {reply, B, State};
+
+handle_call({del, Key, Pid}, _, State) ->
+ {reply, ets:delete_object(?TABLE, ?MAPPING(Key, Pid)), State};
+
+handle_call({repl, T, U, Pid}, _, State) ->
+ MatchSpec = [{?MAPPING('$1', Pid),
+ [{'=:=', '$1', {const, T}}],
+ ['$_']}],
+ {reply, repl(ets:select(?TABLE, MatchSpec), U, Pid), State};
+
+handle_call(state, _, State) ->
+ {reply, State, State};
+
+handle_call(uptime, _, #state{id = Time} = State) ->
+ {reply, diameter_lib:now_diff(Time), State};
+
+handle_call(Req, From, State) ->
+ ?UNEXPECTED([Req, From]),
+ {reply, nok, State}.
+
+%%% ----------------------------------------------------------
+%%% # handle_cast(Request, State)
+%%% ----------------------------------------------------------
+
+handle_cast(Msg, State)->
+ ?UNEXPECTED([Msg]),
+ {noreply, State}.
+
+%%% ----------------------------------------------------------
+%%% # handle_info(Request, State)
+%%% ----------------------------------------------------------
+
+handle_info({'DOWN', MRef, process, Pid, _}, State) ->
+ ets:delete_object(?TABLE, ?MONITOR(Pid, MRef)),
+ ets:match_delete(?TABLE, ?MAPPING('_', Pid)),
+ {noreply, State};
+
+handle_info(Info, State) ->
+ ?UNEXPECTED([Info]),
+ {noreply, State}.
+
+%%% ----------------------------------------------------------
+%%% # terminate(Reason, State)
+%%% ----------------------------------------------------------
+
+terminate(_Reason, _State)->
+ ok.
+
+%%% ----------------------------------------------------------
+%%% # code_change(OldVsn, State, Extra)
+%%% ----------------------------------------------------------
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%% ---------------------------------------------------------
+%% INTERNAL FUNCTIONS
+%% ---------------------------------------------------------
+
+monitor(true, Pid) ->
+ ets:insert(?TABLE, ?MONITOR(Pid, erlang:monitor(process, Pid)));
+monitor(false, _) ->
+ ok.
+
+%% Do we need a monitor for the specified Pid?
+no_monitor(Pid) ->
+ [] == ets:match_object(?TABLE, ?MONITOR(Pid, '_')).
+
+%% insert_new/2
+
+insert_new(?TABLE, {Key, _} = T) ->
+ flush(ets:lookup(?TABLE, Key)),
+ ets:insert_new(?TABLE, T).
+
+%% Remove any processes that are dead but for which we may not have
+%% received 'DOWN' yet. This is to ensure that add_new can be used
+%% to register a unique name each time a process restarts.
+flush(List) ->
+ lists:foreach(fun({_,P} = T) ->
+ del(erlang:is_process_alive(P), T)
+ end,
+ List).
+
+del(Alive, T) ->
+ Alive orelse ets:delete_object(?TABLE, T).
+
+%% repl/3
+
+repl([?MAPPING(_, Pid) = M], Key, Pid) ->
+ ets:delete_object(?TABLE, M),
+ true = ets:insert(?TABLE, ?MAPPING(Key, Pid));
+repl([], _, _) ->
+ false.
+
+%% call/1
+
+call(Request) ->
+ gen_server:call(?SERVER, Request, infinity).
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
new file mode 100644
index 0000000000..421e36ccf5
--- /dev/null
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -0,0 +1,2903 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Implements the process that represents a service.
+%%
+
+-module(diameter_service).
+-behaviour(gen_server).
+
+-export([start/1,
+ stop/1,
+ start_transport/2,
+ stop_transport/2,
+ info/2,
+ call/4]).
+
+%% towards diameter_watchdog
+-export([receive_message/3]).
+
+%% service supervisor
+-export([start_link/1]).
+
+-export([subscribe/1,
+ unsubscribe/1,
+ subscriptions/1,
+ subscriptions/0,
+ services/0,
+ services/1,
+ whois/1,
+ flush_stats/1]).
+
+%% test/debug
+-export([call_module/3,
+ state/1,
+ uptime/1]).
+
+%%% gen_server callbacks
+-export([init/1,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ terminate/2,
+ code_change/3]).
+
+%% Other callbacks.
+-export([send/1]).
+
+-include_lib("diameter/include/diameter.hrl").
+-include("diameter_internal.hrl").
+-include("diameter_types.hrl").
+
+-define(STATE_UP, up).
+-define(STATE_DOWN, down).
+
+-define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1
+-define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests
+-define(RESTART_TC, 1000). %% if restart was this recent
+
+%% Used to be able to swap this with anything else dict-like but now
+%% rely on the fact that a service's #state{} record does not change
+%% in storing in it ?STATE table and not always going through the
+%% service process. In particular, rely on the fact that operations on
+%% a ?Dict don't change the handle to it.
+-define(Dict, diameter_dict).
+
+%% Table containing outgoing requests for which a reply has yet to be
+%% received.
+-define(REQUEST_TABLE, diameter_request).
+
+%% Maintains state in a table. In contrast to previously, a service's
+%% stat is not constant and is accessed outside of the service
+%% process.
+-define(STATE_TABLE, ?MODULE).
+
+%% Workaround for dialyzer's lack of understanding of match specs.
+-type match(T)
+ :: T | '_' | '$1' | '$2' | '$3' | '$4'.
+
+%% State of service gen_server.
+-record(state,
+ {id = now(),
+ service_name, %% as passed to start_service/2, key in ?STATE_TABLE
+ service :: #diameter_service{},
+ peerT = ets_new(peers) :: ets:tid(), %% #peer{} at start_fsm
+ connT = ets_new(conns) :: ets:tid(), %% #conn{} at connection_up
+ share_peers = false :: boolean(), %% broadcast peers to remote nodes?
+ use_shared_peers = false :: boolean(), %% use broadcasted peers?
+ shared_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...]
+ local_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...]
+ monitor = false :: false | pid()}). %% process to die with
+%% shared_peers reflects the peers broadcast from remote nodes. Note
+%% that the state term itself doesn't change, which is relevant for
+%% the stateless application callbacks since the state is retrieved
+%% from ?STATE_TABLE from outside the service process. The pid in the
+%% service record is used to determine whether or not we need to call
+%% the process for a pick_peer callback.
+
+%% Record representing a watchdog process.
+-record(peer,
+ {pid :: match(pid()),
+ type :: match(connect | accept),
+ ref :: match(reference()), %% key into diameter_config
+ options :: match([transport_opt()]), %% as passed to start_transport
+ op_state = ?STATE_DOWN :: match(?STATE_DOWN | ?STATE_UP),
+ started = now(), %% at process start
+ conn = false :: match(boolean() | pid())}).
+ %% true at accept, pid() at connection_up (connT key)
+
+%% Record representing a peer_fsm process.
+-record(conn,
+ {pid :: pid(),
+ apps :: [{0..16#FFFFFFFF, app_alias()}], %% {Id, Alias}
+ caps :: #diameter_caps{},
+ started = now(), %% at process start
+ peer :: pid()}). %% key into peerT
+
+%% Record stored in diameter_request for each outgoing request.
+-record(request,
+ {from, %% arg 2 of handle_call/3
+ handler :: match(pid()), %% request process
+ transport :: match(pid()), %% peer process
+ caps :: match(#diameter_caps{}),
+ app :: match(app_alias()), %% #diameter_app.alias
+ dictionary :: match(module()), %% #diameter_app.dictionary
+ module :: match(nonempty_improper_list(module(), list())),
+ %% #diameter_app.module
+ filter :: match(peer_filter()),
+ packet :: match(#diameter_packet{})}).
+
+%% Record call/4 options are parsed into.
+-record(options,
+ {filter = none :: peer_filter(),
+ extra = [] :: list(),
+ timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF,
+ detach = false :: boolean()}).
+
+%% Since RFC 3588 requires that a Diameter agent not modify End-to-End
+%% Identifiers, the possibility of explicitly setting an End-to-End
+%% Identifier would be needed to be able to implement an agent in
+%% which one side of the communication is not implemented on top of
+%% diameter. For example, Diameter being sent or received encapsulated
+%% in some other protocol, or even another Diameter stack in a
+%% non-Erlang environment. (Not that this is likely to be a normal
+%% case.)
+%%
+%% The implemented solution is not an option but to respect any header
+%% values set in a diameter_header record returned from a
+%% prepare_request callback. A call to diameter:call/4 can communicate
+%% values to the callback using the 'extra' option if so desired.
+
+%%% ---------------------------------------------------------------------------
+%%% # start(SvcName)
+%%% ---------------------------------------------------------------------------
+
+start(SvcName) ->
+ diameter_service_sup:start_child(SvcName).
+
+start_link(SvcName) ->
+ Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}],
+ gen_server:start_link(?MODULE, [SvcName], Options).
+%% Put the arbitrary term SvcName in a list in case we ever want to
+%% send more than this and need to distinguish old from new.
+
+%%% ---------------------------------------------------------------------------
+%%% # stop(SvcName)
+%%% ---------------------------------------------------------------------------
+
+stop(SvcName) ->
+ case whois(SvcName) of
+ undefined ->
+ {error, not_started};
+ Pid ->
+ stop(call_service(Pid, stop), Pid)
+ end.
+
+stop(ok, Pid) ->
+ MRef = erlang:monitor(process, Pid),
+ receive {'DOWN', MRef, process, _, _} -> ok end;
+stop(No, _) ->
+ No.
+
+%%% ---------------------------------------------------------------------------
+%%% # start_transport(SvcName, {Ref, Type, Opts})
+%%% ---------------------------------------------------------------------------
+
+start_transport(SvcName, {_,_,_} = T) ->
+ call_service_by_name(SvcName, {start, T}).
+
+%%% ---------------------------------------------------------------------------
+%%% # stop_transport(SvcName, Refs)
+%%% ---------------------------------------------------------------------------
+
+stop_transport(_, []) ->
+ ok;
+stop_transport(SvcName, [_|_] = Refs) ->
+ call_service_by_name(SvcName, {stop, Refs}).
+
+%%% ---------------------------------------------------------------------------
+%%% # info(SvcName, Item)
+%%% ---------------------------------------------------------------------------
+
+info(SvcName, Item) ->
+ info_rc(call_service_by_name(SvcName, {info, Item})).
+
+info_rc({error, _}) ->
+ undefined;
+info_rc(Info) ->
+ Info.
+
+%%% ---------------------------------------------------------------------------
+%%% # receive_message(TPid, Pkt, MessageData)
+%%% ---------------------------------------------------------------------------
+
+%% Handle an incoming message in the watchdog process. This used to
+%% come through the service process but this avoids that becoming a
+%% bottleneck.
+
+receive_message(TPid, Pkt, T)
+ when is_pid(TPid) ->
+ #diameter_packet{header = #diameter_header{is_request = R}} = Pkt,
+ recv(R, (not R) andalso lookup_request(Pkt, TPid), TPid, Pkt, T).
+
+%% Incoming request ...
+recv(true, false, TPid, Pkt, T) ->
+ try
+ spawn(fun() -> recv_request(TPid, Pkt, T) end)
+ catch
+ error: system_limit = E -> %% discard
+ ?LOG({error, E}, now())
+ end;
+
+%% ... answer to known request ...
+recv(false, #request{from = {_, Ref}, handler = Pid} = Req, _, Pkt, _) ->
+ Pid ! {answer, Ref, Req, Pkt};
+%% Note that failover could have happened prior to this message being
+%% received and triggering failback. That is, both a failover message
+%% and answer may be on their way to the handler process. In the worst
+%% case the request process gets notification of the failover and
+%% sends to the alternate peer before an answer arrives, so it's
+%% always the case that we can receive more than one answer after
+%% failover. The first answer received by the request process wins,
+%% any others are discarded.
+
+%% ... or not.
+recv(false, false, _, _, _) ->
+ ok.
+
+%%% ---------------------------------------------------------------------------
+%%% # call(SvcName, App, Msg, Options)
+%%% ---------------------------------------------------------------------------
+
+call(SvcName, App, Msg, Options)
+ when is_list(Options) ->
+ Rec = make_options(Options),
+ Ref = make_ref(),
+ Caller = {self(), Ref},
+ Fun = fun() -> exit({Ref, call(SvcName, App, Msg, Rec, Caller)}) end,
+ try spawn_monitor(Fun) of
+ {_, MRef} ->
+ recv(MRef, Ref, Rec#options.detach, false)
+ catch
+ error: system_limit = E ->
+ {error, E}
+ end.
+
+%% Don't rely on gen_server:call/3 for the timeout handling since it
+%% makes no guarantees about not leaving a reply message in the
+%% mailbox if we catch its exit at timeout. It currently *can* do so,
+%% which is also undocumented.
+
+recv(MRef, _, true, true) ->
+ erlang:demonitor(MRef, [flush]),
+ ok;
+
+recv(MRef, Ref, Detach, Sent) ->
+ receive
+ Ref -> %% send has been attempted
+ recv(MRef, Ref, Detach, true);
+ {'DOWN', MRef, process, _, Reason} ->
+ call_rc(Reason, Ref, Sent)
+ end.
+
+%% call/5 has returned ...
+call_rc({Ref, Ans}, Ref, _) ->
+ Ans;
+
+%% ... or not. In this case failure/encode are documented.
+call_rc(_, _, Sent) ->
+ {error, choose(Sent, failure, encode)}.
+
+%% call/5
+%%
+%% In the process spawned for the outgoing request.
+
+call(SvcName, App, Msg, Opts, Caller) ->
+ c(ets:lookup(?STATE_TABLE, SvcName), App, Msg, Opts, Caller).
+
+c([#state{service_name = SvcName} = S], App, Msg, Opts, Caller) ->
+ case find_transport(App, Msg, Opts, S) of
+ {_,_,_} = T ->
+ send_request(T, Msg, Opts, Caller, SvcName);
+ false ->
+ {error, no_connection};
+ {error, _} = No ->
+ No
+ end;
+
+c([], _, _, _, _) ->
+ {error, no_service}.
+
+%% make_options/1
+
+make_options(Options) ->
+ lists:foldl(fun mo/2, #options{}, Options).
+
+mo({timeout, T}, Rec)
+ when is_integer(T), 0 =< T ->
+ Rec#options{timeout = T};
+
+mo({filter, F}, #options{filter = none} = Rec) ->
+ Rec#options{filter = F};
+mo({filter, F}, #options{filter = {all, Fs}} = Rec) ->
+ Rec#options{filter = {all, [F | Fs]}};
+mo({filter, F}, #options{filter = F0} = Rec) ->
+ Rec#options{filter = {all, [F0, F]}};
+
+mo({extra, L}, #options{extra = X} = Rec)
+ when is_list(L) ->
+ Rec#options{extra = X ++ L};
+
+mo(detach, Rec) ->
+ Rec#options{detach = true};
+
+mo(T, _) ->
+ ?ERROR({invalid_option, T}).
+
+%%% ---------------------------------------------------------------------------
+%%% # subscribe(SvcName)
+%%% # unsubscribe(SvcName)
+%%% ---------------------------------------------------------------------------
+
+subscribe(SvcName) ->
+ diameter_reg:add({?MODULE, subscriber, SvcName}).
+
+unsubscribe(SvcName) ->
+ diameter_reg:del({?MODULE, subscriber, SvcName}).
+
+subscriptions(Pat) ->
+ pmap(diameter_reg:match({?MODULE, subscriber, Pat})).
+
+subscriptions() ->
+ subscriptions('_').
+
+pmap(Props) ->
+ lists:map(fun({{?MODULE, _, Name}, Pid}) -> {Name, Pid} end, Props).
+
+%%% ---------------------------------------------------------------------------
+%%% # services(Pattern)
+%%% ---------------------------------------------------------------------------
+
+services(Pat) ->
+ pmap(diameter_reg:match({?MODULE, service, Pat})).
+
+services() ->
+ services('_').
+
+whois(SvcName) ->
+ case diameter_reg:match({?MODULE, service, SvcName}) of
+ [{_, Pid}] ->
+ Pid;
+ [] ->
+ undefined
+ end.
+
+%%% ---------------------------------------------------------------------------
+%%% # flush_stats/1
+%%%
+%%% Output: list of {{SvcName, Alias, Counter}, Value}
+%%% ---------------------------------------------------------------------------
+
+flush_stats(TPid) ->
+ diameter_stats:flush(TPid).
+
+%% ===========================================================================
+%% ===========================================================================
+
+state(Svc) ->
+ call_service(Svc, state).
+
+uptime(Svc) ->
+ call_service(Svc, uptime).
+
+%% call_module/3
+
+call_module(Service, AppMod, Request) ->
+ call_service(Service, {call_module, AppMod, Request}).
+
+%%% ---------------------------------------------------------------------------
+%%% # init([SvcName])
+%%% ---------------------------------------------------------------------------
+
+init([SvcName]) ->
+ process_flag(trap_exit, true), %% ensure terminate(shutdown, _)
+ i(SvcName, diameter_reg:add_new({?MODULE, service, SvcName})).
+
+i(SvcName, true) ->
+ {ok, i(SvcName)};
+i(_, false) ->
+ {stop, {shutdown, already_started}}.
+
+%%% ---------------------------------------------------------------------------
+%%% # handle_call(Req, From, State)
+%%% ---------------------------------------------------------------------------
+
+handle_call(state, _, S) ->
+ {reply, S, S};
+
+handle_call(uptime, _, #state{id = T} = S) ->
+ {reply, diameter_lib:now_diff(T), S};
+
+%% Start a transport.
+handle_call({start, {Ref, Type, Opts}}, _From, S) ->
+ {reply, start(Ref, {Type, Opts}, S), S};
+
+%% Stop transports.
+handle_call({stop, Refs}, _From, S) ->
+ shutdown(Refs, S),
+ {reply, ok, S};
+
+%% pick_peer with mutable state
+handle_call({pick_peer, Local, Remote, App}, _From, S) ->
+ #diameter_app{mutable = true} = App, %% assert
+ {reply, pick_peer(Local, Remote, self(), S#state.service_name, App), S};
+
+handle_call({call_module, AppMod, Req}, From, S) ->
+ call_module(AppMod, Req, From, S);
+
+handle_call({info, Item}, _From, S) ->
+ {reply, service_info(Item, S), S};
+
+handle_call(stop, _From, S) ->
+ shutdown(S),
+ {stop, normal, ok, S};
+%% The server currently isn't guaranteed to be dead when the caller
+%% gets the reply. We deal with this in the call to the server,
+%% stating a monitor that waits for DOWN before returning.
+
+handle_call(Req, From, S) ->
+ unexpected(handle_call, [Req, From], S),
+ {reply, nok, S}.
+
+%%% ---------------------------------------------------------------------------
+%%% # handle_cast(Req, State)
+%%% ---------------------------------------------------------------------------
+
+handle_cast(Req, S) ->
+ unexpected(handle_cast, [Req], S),
+ {noreply, S}.
+
+%%% ---------------------------------------------------------------------------
+%%% # handle_info(Req, State)
+%%% ---------------------------------------------------------------------------
+
+handle_info(T,S) ->
+ case transition(T,S) of
+ ok ->
+ {noreply, S};
+ #state{} = NS ->
+ {noreply, NS};
+ {stop, Reason} ->
+ {stop, {shutdown, Reason}, S}
+ end.
+
+%% transition/2
+
+%% Peer process is telling us to start a new accept process.
+transition({accepted, Pid, TPid}, S) ->
+ accepted(Pid, TPid, S),
+ ok;
+
+%% Peer process has a new open connection.
+transition({connection_up, Pid, T}, S) ->
+ connection_up(Pid, T, S);
+
+%% Peer process has left state open.
+transition({connection_down, Pid}, S) ->
+ connection_down(Pid, S);
+
+%% Peer process has returned to state open.
+transition({connection_up, Pid}, S) ->
+ connection_up(Pid, S);
+
+%% Accepting transport has lost connectivity.
+transition({close, Pid}, S) ->
+ close(Pid, S),
+ ok;
+
+%% Connecting transport is being restarted by watchdog.
+transition({reconnect, Pid}, S) ->
+ reconnect(Pid, S),
+ ok;
+
+%% Monitor process has died. Just die with a reason that tells
+%% diameter_config about the happening. If a cleaner shutdown is
+%% required then someone should stop us.
+transition({'DOWN', MRef, process, _, Reason}, #state{monitor = MRef}) ->
+ {stop, {monitor, Reason}};
+
+%% Local peer process has died.
+transition({'DOWN', _, process, Pid, Reason}, S)
+ when node(Pid) == node() ->
+ peer_down(Pid, Reason, S);
+
+%% Remote service wants to know about shared transports.
+transition({service, Pid}, S) ->
+ share_peers(Pid, S),
+ ok;
+
+%% Remote service is communicating a shared peer.
+transition({peer, TPid, Aliases, Caps}, S) ->
+ remote_peer_up(TPid, Aliases, Caps, S);
+
+%% Remote peer process has died.
+transition({'DOWN', _, process, TPid, _}, S) ->
+ remote_peer_down(TPid, S);
+
+%% Restart after tc expiry.
+transition({tc_timeout, T}, S) ->
+ tc_timeout(T, S),
+ ok;
+
+%% Request process is telling us it may have missed a failover message
+%% after a transport went down and the service process looked up
+%% outstanding requests.
+transition({failover, TRef, Seqs}, S) ->
+ failover(TRef, Seqs, S),
+ ok;
+
+transition(Req, S) ->
+ unexpected(handle_info, [Req], S),
+ ok.
+
+%%% ---------------------------------------------------------------------------
+%%% # terminate(Reason, State)
+%%% ---------------------------------------------------------------------------
+
+terminate(Reason, #state{service_name = Name} = S) ->
+ ets:delete(?STATE_TABLE, Name),
+ shutdown == Reason %% application shutdown
+ andalso shutdown(S).
+
+%%% ---------------------------------------------------------------------------
+%%% # code_change(FromVsn, State, Extra)
+%%% ---------------------------------------------------------------------------
+
+code_change(FromVsn,
+ #state{service_name = SvcName,
+ service = #diameter_service{applications = Apps}}
+ = S,
+ Extra) ->
+ lists:foreach(fun(A) ->
+ code_change(FromVsn, SvcName, Extra, A)
+ end,
+ Apps),
+ {ok, S}.
+
+code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) ->
+ {ok, S} = cb(A, code_change, [FromVsn,
+ mod_state(Alias),
+ Extra,
+ SvcName]),
+ mod_state(Alias, S).
+
+%% ===========================================================================
+%% ===========================================================================
+
+unexpected(F, A, #state{service_name = Name}) ->
+ ?UNEXPECTED(F, A ++ [Name]).
+
+cb([_|_] = M, F, A) ->
+ eval(M, F, A);
+cb(Rec, F, A) ->
+ {_, M} = app(Rec),
+ eval(M, F, A).
+
+app(#request{app = A, module = M}) ->
+ {A,M};
+app(#diameter_app{alias = A, module = M}) ->
+ {A,M}.
+
+eval([M|X], F, A) ->
+ apply(M, F, A ++ X).
+
+%% Callback with state.
+
+state_cb(#diameter_app{mutable = false, init_state = S}, {ModX, F, A}) ->
+ eval(ModX, F, A ++ [S]);
+
+state_cb(#diameter_app{mutable = true, alias = Alias}, {_,_,_} = MFA) ->
+ state_cb(MFA, Alias);
+
+state_cb({ModX,F,A}, Alias)
+ when is_list(ModX) ->
+ eval(ModX, F, A ++ [mod_state(Alias)]).
+
+choose(true, X, _) -> X;
+choose(false, _, X) -> X.
+
+ets_new(Tbl) ->
+ ets:new(Tbl, [{keypos, 2}]).
+
+insert(Tbl, Rec) ->
+ ets:insert(Tbl, Rec),
+ Rec.
+
+monitor(Pid) ->
+ erlang:monitor(process, Pid),
+ Pid.
+
+%% Using the process dictionary for the callback state was initially
+%% just a way to make what was horrendous trace (big state record and
+%% much else everywhere) somewhat more readable. There's not as much
+%% need for it now but it's no worse (except possibly that we don't
+%% see the table identifier being passed around) than an ets table so
+%% keep it.
+
+mod_state(Alias) ->
+ get({?MODULE, mod_state, Alias}).
+
+mod_state(Alias, ModS) ->
+ put({?MODULE, mod_state, Alias}, ModS).
+
+%% have_transport/2
+
+have_transport(SvcName, Ref) ->
+ [] /= diameter_config:have_transport(SvcName, Ref).
+
+%%% ---------------------------------------------------------------------------
+%%% # shutdown/2
+%%% ---------------------------------------------------------------------------
+
+shutdown(Refs, #state{peerT = PeerT}) ->
+ ets:foldl(fun(P,ok) -> s(P, Refs), ok end, ok, PeerT).
+
+s(#peer{ref = Ref, pid = Pid}, Refs) ->
+ s(lists:member(Ref, Refs), Pid);
+
+s(true, Pid) ->
+ Pid ! {shutdown, self()}; %% 'DOWN' will cleanup as usual
+s(false, _) ->
+ ok.
+
+%%% ---------------------------------------------------------------------------
+%%% # shutdown/1
+%%% ---------------------------------------------------------------------------
+
+shutdown(#state{peerT = PeerT}) ->
+ %% A transport might not be alive to receive the shutdown request
+ %% but give those that are a chance to shutdown gracefully.
+ wait(fun st/2, PeerT),
+ %% Kill the watchdogs explicitly in case there was no transport.
+ wait(fun sw/2, PeerT).
+
+wait(Fun, T) ->
+ diameter_lib:wait(ets:foldl(Fun, [], T)).
+
+st(#peer{conn = B}, Acc)
+ when is_boolean(B) ->
+ Acc;
+st(#peer{conn = Pid}, Acc) ->
+ Pid ! shutdown,
+ [Pid | Acc].
+
+sw(#peer{pid = Pid}, Acc) ->
+ exit(Pid, shutdown),
+ [Pid | Acc].
+
+%%% ---------------------------------------------------------------------------
+%%% # call_service/2
+%%% ---------------------------------------------------------------------------
+
+call_service(Pid, Req)
+ when is_pid(Pid) ->
+ cs(Pid, Req);
+call_service(SvcName, Req) ->
+ call_service_by_name(SvcName, Req).
+
+call_service_by_name(SvcName, Req) ->
+ cs(whois(SvcName), Req).
+
+cs(Pid, Req)
+ when is_pid(Pid) ->
+ try
+ gen_server:call(Pid, Req, infinity)
+ catch
+ E: Reason when E == exit ->
+ {error, {E, Reason}}
+ end;
+
+cs(undefined, _) ->
+ {error, no_service}.
+
+%%% ---------------------------------------------------------------------------
+%%% # i/1
+%%%
+%%% Output: #state{}
+%%% ---------------------------------------------------------------------------
+
+%% Intialize the state of a service gen_server.
+
+i(SvcName) ->
+ %% Split the config into a server state and a list of transports.
+ {#state{} = S, CL} = lists:foldl(fun cfg_acc/2,
+ {false, []},
+ diameter_config:lookup(SvcName)),
+
+ %% Publish the state in order to be able to access it outside of
+ %% the service process. Originally table identifiers were only
+ %% known to the service process but we now want to provide the
+ %% option of application callbacks being 'stateless' in order to
+ %% avoid having to go through a common process. (Eg. An agent that
+ %% sends a request for every incoming request.)
+ true = ets:insert_new(?STATE_TABLE, S),
+
+ %% Start fsms for each transport.
+ lists:foreach(fun(T) -> start_fsm(T,S) end, CL),
+
+ init_shared(S),
+ S.
+
+cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts},
+ {false, Acc}) ->
+ lists:foreach(fun init_mod/1, Apps),
+ S = #state{service_name = SvcName,
+ service = Rec#diameter_service{pid = self()},
+ share_peers = get_value(share_peers, Opts),
+ use_shared_peers = get_value(use_shared_peers, Opts),
+ monitor = mref(get_value(monitor, Opts))},
+ {S, Acc};
+
+cfg_acc({_Ref, Type, _Opts} = T, {S, Acc})
+ when Type == connect;
+ Type == listen ->
+ {S, [T | Acc]}.
+
+mref(false = No) ->
+ No;
+mref(P) ->
+ erlang:monitor(process, P).
+
+init_shared(#state{use_shared_peers = true,
+ service_name = Svc}) ->
+ diameter_peer:notify(Svc, {service, self()});
+init_shared(#state{use_shared_peers = false}) ->
+ ok.
+
+init_mod(#diameter_app{alias = Alias,
+ init_state = S}) ->
+ mod_state(Alias, S).
+
+start_fsm({Ref, Type, Opts}, S) ->
+ start(Ref, {Type, Opts}, S).
+
+get_value(Key, Vs) ->
+ {_, V} = lists:keyfind(Key, 1, Vs),
+ V.
+
+%%% ---------------------------------------------------------------------------
+%%% # start/3
+%%% ---------------------------------------------------------------------------
+
+%% If the initial start/3 at service/transport start succeeds then
+%% subsequent calls to start/4 on the same service will also succeed
+%% since they involve the same call to merge_service/2. We merge here
+%% rather than earlier since the service may not yet be configured
+%% when the transport is configured.
+
+start(Ref, {T, Opts}, S)
+ when T == connect;
+ T == listen ->
+ try
+ {ok, start(Ref, type(T), Opts, S)}
+ catch
+ ?FAILURE(Reason) ->
+ {error, Reason}
+ end.
+%% TODO: don't actually raise any errors yet
+
+%% There used to be a difference here between the handling of
+%% configured listening and connecting transports but now we simply
+%% tell the transport_module to start an accepting or connecting
+%% process respectively, the transport implementation initiating
+%% listening on a port as required.
+type(listen) -> accept;
+type(accept) -> listen;
+type(connect = T) -> T.
+
+%% start/4
+
+start(Ref, Type, Opts, #state{peerT = PeerT,
+ connT = ConnT,
+ service_name = SvcName,
+ service = Svc})
+ when Type == connect;
+ Type == accept ->
+ Pid = monitor(s(Type, Ref, {ConnT,
+ Opts,
+ SvcName,
+ merge_service(Opts, Svc)})),
+ insert(PeerT, #peer{pid = Pid,
+ type = Type,
+ ref = Ref,
+ options = Opts}),
+ Pid.
+
+%% Note that the service record passed into the watchdog is the merged
+%% record so that each watchdog (and peer_fsm) may get a different
+%% record. This record is what is passed back into application
+%% callbacks.
+
+s(Type, Ref, T) ->
+ diameter_watchdog:start({Type, Ref}, T).
+
+%% merge_service/2
+
+merge_service(Opts, Svc) ->
+ lists:foldl(fun ms/2, Svc, Opts).
+
+%% Limit the applications known to the fsm to those in the 'apps'
+%% option. That this might be empty is checked by the fsm. It's not
+%% checked at config-time since there's no requirement that the
+%% service be configured first. (Which could be considered a bit odd.)
+ms({applications, As}, #diameter_service{applications = Apps} = S)
+ when is_list(As) ->
+ S#diameter_service{applications
+ = [A || A <- Apps,
+ lists:member(A#diameter_app.alias, As)]};
+
+%% The fact that all capabilities can be configured on the transports
+%% means that the service doesn't necessarily represent a single
+%% locally implemented Diameter peer as identified by Origin-Host: a
+%% transport can configure its own Origin-Host. This means that the
+%% service little more than a placeholder for default capabilities
+%% plus a list of applications that individual transports can choose
+%% to support (or not).
+ms({capabilities, Opts}, #diameter_service{capabilities = Caps0} = Svc)
+ when is_list(Opts) ->
+ %% make_caps has already succeeded in diameter_config so it will succeed
+ %% again here.
+ {ok, Caps} = diameter_capx:make_caps(Caps0, Opts),
+ Svc#diameter_service{capabilities = Caps};
+
+ms(_, Svc) ->
+ Svc.
+
+%%% ---------------------------------------------------------------------------
+%%% # accepted/3
+%%% ---------------------------------------------------------------------------
+
+accepted(Pid, _TPid, #state{peerT = PeerT} = S) ->
+ #peer{ref = Ref, type = accept = T, conn = false, options = Opts}
+ = P
+ = fetch(PeerT, Pid),
+ insert(PeerT, P#peer{conn = true}), %% mark replacement transport started
+ start(Ref, T, Opts, S). %% start new peer
+
+fetch(Tid, Key) ->
+ [T] = ets:lookup(Tid, Key),
+ T.
+
+%%% ---------------------------------------------------------------------------
+%%% # connection_up/3
+%%%
+%%% Output: #state{}
+%%% ---------------------------------------------------------------------------
+
+%% Peer process has reached the open state.
+
+connection_up(Pid, {TPid, {Caps, SApps, Pkt}}, #state{peerT = PeerT,
+ connT = ConnT}
+ = S) ->
+ P = fetch(PeerT, Pid),
+ C = #conn{pid = TPid,
+ apps = SApps,
+ caps = Caps,
+ peer = Pid},
+
+ insert(ConnT, C),
+ connection_up([Pkt], P#peer{conn = TPid}, C, S).
+
+%%% ---------------------------------------------------------------------------
+%%% # connection_up/2
+%%%
+%%% Output: #state{}
+%%% ---------------------------------------------------------------------------
+
+%% Peer process has transitioned back into the open state. Note that there
+%% has been no new capabilties exchange in this case.
+
+connection_up(Pid, #state{peerT = PeerT,
+ connT = ConnT}
+ = S) ->
+ #peer{conn = TPid} = P = fetch(PeerT, Pid),
+ C = fetch(ConnT, TPid),
+ connection_up([], P, C, S).
+
+%% connection_up/4
+
+connection_up(T, P, C, #state{peerT = PeerT,
+ local_peers = LDict,
+ service_name = SvcName,
+ service
+ = #diameter_service{applications = Apps}}
+ = S) ->
+ #peer{conn = TPid, op_state = ?STATE_DOWN}
+ = P,
+ #conn{apps = SApps, caps = Caps}
+ = C,
+
+ insert(PeerT, P#peer{op_state = ?STATE_UP}),
+
+ request_peer_up(TPid),
+ report_status(up, P, C, S, T),
+ S#state{local_peers = insert_local_peer(SApps,
+ {{TPid, Caps}, {SvcName, Apps}},
+ LDict)}.
+
+insert_local_peer(SApps, T, LDict) ->
+ lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps).
+
+ilp({Id, Alias}, {TC, SA}, LDict) ->
+ init_conn(Id, Alias, TC, SA),
+ ?Dict:append(Alias, TC, LDict).
+
+init_conn(Id, Alias, TC, {SvcName, Apps}) ->
+ #diameter_app{module = ModX,
+ id = Id} %% assert
+ = find_app(Alias, Apps),
+
+ peer_cb({ModX, peer_up, [SvcName, TC]}, Alias).
+
+find_app(Alias, Apps) ->
+ lists:keyfind(Alias, #diameter_app.alias, Apps).
+
+%% A failing peer callback brings down the service. In the case of
+%% peer_up we could just kill the transport and emit an error but for
+%% peer_down we have no way to cleanup any state change that peer_up
+%% may have introduced.
+peer_cb(MFA, Alias) ->
+ try state_cb(MFA, Alias) of
+ ModS ->
+ mod_state(Alias, ModS)
+ catch
+ E: Reason ->
+ ?ERROR({E, Reason, MFA, ?STACK})
+ end.
+
+%%% ---------------------------------------------------------------------------
+%%% # connection_down/2
+%%%
+%%% Output: #state{}
+%%% ---------------------------------------------------------------------------
+
+%% Peer process has transitioned out of the open state.
+
+connection_down(Pid, #state{peerT = PeerT,
+ connT = ConnT}
+ = S) ->
+ #peer{conn = TPid}
+ = P
+ = fetch(PeerT, Pid),
+
+ C = fetch(ConnT, TPid),
+ insert(PeerT, P#peer{op_state = ?STATE_DOWN}),
+ connection_down(P,C,S).
+
+%% connection_down/3
+
+connection_down(#peer{conn = TPid,
+ op_state = ?STATE_UP}
+ = P,
+ #conn{caps = Caps,
+ apps = SApps}
+ = C,
+ #state{service_name = SvcName,
+ service = #diameter_service{applications = Apps},
+ local_peers = LDict}
+ = S) ->
+ report_status(down, P, C, S, []),
+ NewS = S#state{local_peers
+ = remove_local_peer(SApps,
+ {{TPid, Caps}, {SvcName, Apps}},
+ LDict)},
+ request_peer_down(TPid, NewS),
+ NewS.
+
+remove_local_peer(SApps, T, LDict) ->
+ lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps).
+
+rlp({Id, Alias}, {TC, SA}, LDict) ->
+ L = ?Dict:fetch(Alias, LDict),
+ down_conn(Id, Alias, TC, SA),
+ ?Dict:store(Alias, lists:delete(TC, L), LDict).
+
+down_conn(Id, Alias, TC, {SvcName, Apps}) ->
+ #diameter_app{module = ModX,
+ id = Id} %% assert
+ = find_app(Alias, Apps),
+
+ peer_cb({ModX, peer_down, [SvcName, TC]}, Alias).
+
+%%% ---------------------------------------------------------------------------
+%%% # peer_down/3
+%%%
+%%% Output: #state{}
+%%% ---------------------------------------------------------------------------
+
+%% Peer process has died.
+
+peer_down(Pid, _Reason, #state{peerT = PeerT} = S) ->
+ P = fetch(PeerT, Pid),
+ ets:delete_object(PeerT, P),
+ restart(P,S),
+ peer_down(P,S).
+
+%% peer_down/2
+
+%% The peer has never come up ...
+peer_down(#peer{conn = B}, S)
+ when is_boolean(B) ->
+ S;
+
+%% ... or it has.
+peer_down(#peer{ref = Ref,
+ conn = TPid,
+ type = Type,
+ options = Opts}
+ = P,
+ #state{service_name = SvcName,
+ connT = ConnT}
+ = S) ->
+ #conn{caps = Caps}
+ = C
+ = fetch(ConnT, TPid),
+ ets:delete_object(ConnT, C),
+ try
+ pd(P,C,S)
+ after
+ send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}})
+ end.
+
+pd(#peer{op_state = ?STATE_DOWN}, _, S) ->
+ S;
+pd(#peer{op_state = ?STATE_UP} = P, C, S) ->
+ connection_down(P,C,S).
+
+%% restart/2
+
+restart(P,S) ->
+ q_restart(restart(P), S).
+
+%% restart/1
+
+%% Always try to reconnect.
+restart(#peer{ref = Ref,
+ type = connect = T,
+ options = Opts,
+ started = Time}) ->
+ {Time, {Ref, T, Opts}};
+
+%% Transport connection hasn't yet been accepted ...
+restart(#peer{ref = Ref,
+ type = accept = T,
+ options = Opts,
+ conn = false,
+ started = Time}) ->
+ {Time, {Ref, T, Opts}};
+
+%% ... or it has: a replacement transport has already been spawned.
+restart(#peer{type = accept}) ->
+ false.
+
+%% q_restart/2
+
+%% Start the reconnect timer.
+q_restart({Time, {_Ref, Type, Opts} = T}, S) ->
+ start_tc(tc(Time, default_tc(Type, Opts)), T, S);
+q_restart(false, _) ->
+ ok.
+
+%% RFC 3588, 2.1:
+%%
+%% When no transport connection exists with a peer, an attempt to
+%% connect SHOULD be periodically made. This behavior is handled via
+%% the Tc timer, whose recommended value is 30 seconds. There are
+%% certain exceptions to this rule, such as when a peer has terminated
+%% the transport connection stating that it does not wish to
+%% communicate.
+
+default_tc(connect, Opts) ->
+ proplists:get_value(reconnect_timer, Opts, ?DEFAULT_TC);
+default_tc(accept, _) ->
+ 0.
+
+%% Bound tc below if the peer was restarted recently to avoid
+%% continuous in case of faulty config or other problems.
+tc(Time, Tc) ->
+ choose(Tc > ?RESTART_TC
+ orelse timer:now_diff(now(), Time) > 1000*?RESTART_TC,
+ Tc,
+ ?RESTART_TC).
+
+start_tc(0, T, S) ->
+ tc_timeout(T, S);
+start_tc(Tc, T, _) ->
+ erlang:send_after(Tc, self(), {tc_timeout, T}).
+
+%% tc_timeout/2
+
+tc_timeout({Ref, _Type, _Opts} = T, #state{service_name = SvcName} = S) ->
+ tc(have_transport(SvcName, Ref), T, S).
+
+tc(true, {Ref, Type, Opts}, #state{service_name = SvcName}
+ = S) ->
+ send_event(SvcName, {reconnect, Ref, Opts}),
+ start(Ref, Type, Opts, S);
+tc(false = No, _, _) -> %% removed
+ No.
+
+%%% ---------------------------------------------------------------------------
+%%% # close/2
+%%% ---------------------------------------------------------------------------
+
+%% The watchdog doesn't start a new fsm in the accept case, it
+%% simply stays alive until someone tells it to die in order for
+%% another watchdog to be able to detect that it should transition
+%% from initial into reopen rather than okay. That someone is either
+%% the accepting watchdog upon reception of a CER from the previously
+%% connected peer, or us after reconnect_timer timeout.
+
+close(Pid, #state{service_name = SvcName,
+ peerT = PeerT}) ->
+ #peer{pid = Pid,
+ type = accept,
+ ref = Ref,
+ options = Opts}
+ = fetch(PeerT, Pid),
+
+ c(Pid, have_transport(SvcName, Ref), Opts).
+
+%% Tell watchdog to (maybe) die later ...
+c(Pid, true, Opts) ->
+ Tc = proplists:get_value(reconnect_timer, Opts, 2*?DEFAULT_TC),
+ erlang:send_after(Tc, Pid, close);
+
+%% ... or now.
+c(Pid, false, _Opts) ->
+ Pid ! close.
+
+%% The RFC's only document the behaviour of Tc, our reconnect_timer,
+%% for the establishment of connections but we also give
+%% reconnect_timer semantics for a listener, being the time within
+%% which a new connection attempt is expected of a connecting peer.
+%% The value should be greater than the peer's Tc + jitter.
+
+%%% ---------------------------------------------------------------------------
+%%% # reconnect/2
+%%% ---------------------------------------------------------------------------
+
+reconnect(Pid, #state{service_name = SvcName,
+ peerT = PeerT}) ->
+ #peer{ref = Ref,
+ type = connect,
+ options = Opts}
+ = fetch(PeerT, Pid),
+ send_event(SvcName, {reconnect, Ref, Opts}).
+
+%%% ---------------------------------------------------------------------------
+%%% # call_module/4
+%%% ---------------------------------------------------------------------------
+
+%% Backwards compatibility and never documented/advertised. May be
+%% removed.
+
+call_module(Mod, Req, From, #state{service
+ = #diameter_service{applications = Apps},
+ service_name = Svc}
+ = S) ->
+ case cm([A || A <- Apps, Mod == hd(A#diameter_app.module)],
+ Req,
+ From,
+ Svc)
+ of
+ {reply = T, RC} ->
+ {T, RC, S};
+ noreply = T ->
+ {T, S};
+ Reason ->
+ {reply, {error, Reason}, S}
+ end.
+
+cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) ->
+ MFA = {ModX, handle_call, [Req, From, Svc]},
+
+ try state_cb(MFA, Alias) of
+ {noreply = T, ModS} ->
+ mod_state(Alias, ModS),
+ T;
+ {reply = T, RC, ModS} ->
+ mod_state(Alias, ModS),
+ {T, RC};
+ T ->
+ diameter_lib:error_report({invalid, T}, MFA),
+ invalid
+ catch
+ E: Reason ->
+ diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA),
+ failure
+ end;
+
+cm([], _, _, _) ->
+ unknown;
+
+cm([_,_|_], _, _, _) ->
+ multiple.
+
+%%% ---------------------------------------------------------------------------
+%%% # send_request/5
+%%% ---------------------------------------------------------------------------
+
+%% Send an outgoing request in its dedicated process.
+%%
+%% Note that both encode of the outgoing request and of the received
+%% answer happens in this process. It's also this process that replies
+%% to the caller. The service process only handles the state-retaining
+%% callbacks.
+%%
+%% The mod field of the #diameter_app{} here includes any extra
+%% arguments passed to diameter:call/2.
+
+send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) ->
+ #diameter_app{module = ModX}
+ = App,
+
+ Pkt = make_packet(Msg),
+
+ case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of
+ {send, P} ->
+ send_request(make_packet(P, Pkt),
+ TPid,
+ Caps,
+ App,
+ Opts,
+ Caller,
+ SvcName);
+ {discard, Reason} ->
+ {error, Reason};
+ discard ->
+ {error, discarded};
+ T ->
+ ?ERROR({invalid_return, prepare_request, App, T})
+ end.
+
+%% make_packet/1
+%%
+%% Turn an outgoing request as passed to call/4 into a diameter_packet
+%% record in preparation for a prepare_request callback.
+
+make_packet(Bin)
+ when is_binary(Bin) ->
+ #diameter_packet{header = diameter_codec:decode_header(Bin),
+ bin = Bin};
+
+make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) ->
+ Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]};
+
+make_packet(#diameter_packet{header = Hdr} = Pkt) ->
+ Pkt#diameter_packet{header = make_header(Hdr)};
+
+make_packet(Msg) ->
+ make_packet(#diameter_packet{msg = Msg}).
+
+%% make_header/1
+
+make_header(undefined) ->
+ Seq = diameter_session:sequence(),
+ make_header(#diameter_header{end_to_end_id = Seq,
+ hop_by_hop_id = Seq});
+
+make_header(#diameter_header{version = undefined} = Hdr) ->
+ make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION});
+
+make_header(#diameter_header{end_to_end_id = undefined} = H) ->
+ Seq = diameter_session:sequence(),
+ make_header(H#diameter_header{end_to_end_id = Seq});
+
+make_header(#diameter_header{hop_by_hop_id = undefined} = H) ->
+ Seq = diameter_session:sequence(),
+ make_header(H#diameter_header{hop_by_hop_id = Seq});
+
+make_header(#diameter_header{} = Hdr) ->
+ Hdr;
+
+make_header(T) ->
+ ?ERROR({invalid_header, T}).
+
+%% make_packet/2
+%%
+%% Reconstruct a diameter_packet from the return value of
+%% prepare_request or prepare_retransmit callback.
+
+make_packet(Bin, _)
+ when is_binary(Bin) ->
+ make_packet(Bin);
+
+make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) ->
+ Pkt;
+
+%% Returning a diameter_packet with no header from a prepare_request
+%% or prepare_retransmit callback retains the header passed into it.
+%% This is primarily so that the end to end and hop by hop identifiers
+%% are retained.
+make_packet(#diameter_packet{header = Hdr} = Pkt,
+ #diameter_packet{header = Hdr0}) ->
+ Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)};
+
+make_packet(Msg, Pkt) ->
+ Pkt#diameter_packet{msg = Msg}.
+
+%% fold_record/2
+
+fold_record(undefined, R) ->
+ R;
+fold_record(Rec, R) ->
+ diameter_lib:fold_tuple(2, Rec, R).
+
+%% send_request/7
+
+send_request(Pkt, TPid, Caps, App, Opts, Caller, SvcName) ->
+ #diameter_app{alias = Alias,
+ dictionary = Dict,
+ module = ModX,
+ answer_errors = AE}
+ = App,
+
+ EPkt = encode(Dict, Pkt),
+
+ #options{filter = Filter,
+ timeout = Timeout}
+ = Opts,
+
+ Req = #request{packet = Pkt,
+ from = Caller,
+ handler = self(),
+ transport = TPid,
+ caps = Caps,
+ app = Alias,
+ filter = Filter,
+ dictionary = Dict,
+ module = ModX},
+
+ try
+ TRef = send_request(TPid, EPkt, Req, Timeout),
+ ack(Caller),
+ handle_answer(SvcName, AE, recv_answer(Timeout, SvcName, {TRef, Req}))
+ after
+ erase_request(EPkt)
+ end.
+
+%% Tell caller a send has been attempted.
+ack({Pid, Ref}) ->
+ Pid ! Ref.
+
+%% recv_answer/3
+
+recv_answer(Timeout,
+ SvcName,
+ {TRef, #request{from = {_, Ref}, packet = RPkt} = Req}
+ = T) ->
+
+ %% Matching on TRef below ensures we ignore messages that pertain
+ %% to a previous transport prior to failover. The answer message
+ %% includes the #request{} since it's not necessarily Req; that
+ %% is, from the last peer to which we've transmitted.
+
+ receive
+ {answer = A, Ref, Rq, Pkt} -> %% Answer from peer
+ {A, Rq, Pkt};
+ {timeout = Reason, TRef, _} -> %% No timely reply
+ {error, Req, Reason};
+ {failover = Reason, TRef, false} -> %% No alternate peer
+ {error, Req, Reason};
+ {failover, TRef, Transport} -> %% Resend to alternate peer
+ try_retransmit(Timeout, SvcName, Req, Transport);
+ {failover, TRef} -> %% May have missed failover notification
+ Seqs = diameter_codec:sequence_numbers(RPkt),
+ Pid = whois(SvcName),
+ is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}),
+ recv_answer(Timeout, SvcName, T)
+ end.
+%% Note that failover starts a new timer and that expiry of an old
+%% timer value is ignored. This means that an answer could be accepted
+%% from a peer after timeout in the case of failover.
+
+try_retransmit(Timeout, SvcName, Req, Transport) ->
+ try retransmit(Transport, Req, SvcName, Timeout) of
+ T -> recv_answer(Timeout, SvcName, T)
+ catch
+ ?FAILURE(Reason) -> {error, Req, Reason}
+ end.
+
+%% handle_error/3
+
+handle_error(Req, Reason, SvcName) ->
+ #request{module = ModX,
+ packet = Pkt,
+ transport = TPid,
+ caps = Caps}
+ = Req,
+ cb(ModX, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]).
+
+msg(#diameter_packet{msg = undefined, bin = Bin}) ->
+ Bin;
+msg(#diameter_packet{msg = Msg}) ->
+ Msg.
+
+%% encode/2
+
+%% Note that prepare_request can return a diameter_packet containing
+%% header or transport_data. Even allow the returned record to contain
+%% an encoded binary. This isn't the usual case but could some in
+%% handy, for test at least. (For example, to send garbage.)
+
+%% The normal case: encode the returned message.
+encode(Dict, #diameter_packet{msg = Msg, bin = undefined} = Pkt) ->
+ D = pick_dictionary([Dict, ?BASE], Msg),
+ diameter_codec:encode(D, Pkt);
+
+%% Callback has returned an encoded binary: just send.
+encode(_, #diameter_packet{} = Pkt) ->
+ Pkt.
+
+%% pick_dictionary/2
+
+%% Pick the first dictionary that declares the application id in the
+%% specified header.
+pick_dictionary(Ds, [#diameter_header{application_id = Id} | _]) ->
+ pd(Ds, fun(D) -> Id = D:id() end);
+
+%% Pick the first dictionary that knows the specified message name.
+pick_dictionary(Ds, [MsgName|_]) ->
+ pd(Ds, fun(D) -> D:msg2rec(MsgName) end);
+
+%% Pick the first dictionary that knows the name of the specified
+%% message record.
+pick_dictionary(Ds, Rec) ->
+ Name = element(1, Rec),
+ pd(Ds, fun(D) -> D:rec2msg(Name) end).
+
+pd([D|Ds], F) ->
+ try
+ F(D),
+ D
+ catch
+ error:_ ->
+ pd(Ds, F)
+ end;
+
+pd([], _) ->
+ ?ERROR(no_dictionary).
+
+%% send_request/4
+
+send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout)
+ when node() == node(TPid) ->
+ %% Store the outgoing request before sending to avoid a race with
+ %% reply reception.
+ TRef = store_request(TPid, Bin, Req, Timeout),
+ send(TPid, Pkt),
+ TRef;
+
+%% Send using a remote transport: spawn a process on the remote node
+%% to relay the answer.
+send_request(TPid, #diameter_packet{} = Pkt, Req, Timeout) ->
+ TRef = erlang:start_timer(Timeout, self(), timeout),
+ T = {TPid, Pkt, Req, Timeout, TRef},
+ spawn(node(TPid), ?MODULE, send, [T]),
+ TRef.
+
+%% send/1
+
+send({TPid, Pkt, #request{handler = Pid} = Req, Timeout, TRef}) ->
+ Ref = send_request(TPid, Pkt, Req#request{handler = self()}, Timeout),
+ Pid ! reref(receive T -> T end, Ref, TRef).
+
+reref({T, Ref, R}, Ref, TRef) ->
+ {T, TRef, R};
+reref(T, _, _) ->
+ T.
+
+%% send/2
+
+send(Pid, Pkt) ->
+ Pid ! {send, Pkt}.
+
+%% retransmit/4
+
+retransmit({TPid, Caps, #diameter_app{alias = Alias} = App},
+ #request{app = Alias,
+ packet = Pkt}
+ = Req,
+ SvcName,
+ Timeout) ->
+ have_request(Pkt, TPid) %% Don't failover to a peer we've
+ andalso ?THROW(timeout), %% already sent to.
+
+ case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of
+ {send, P} ->
+ retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout);
+ {discard, Reason} ->
+ ?THROW(Reason);
+ discard ->
+ ?THROW(discarded);
+ T ->
+ ?ERROR({invalid_return, prepare_retransmit, App, T})
+ end.
+
+%% retransmit/5
+
+retransmit(Pkt, TPid, Caps, #request{dictionary = Dict} = Req, Timeout) ->
+ EPkt = encode(Dict, Pkt),
+
+ NewReq = Req#request{transport = TPid,
+ packet = Pkt,
+ caps = Caps},
+
+ ?LOG(retransmission, NewReq),
+ TRef = send_request(TPid, EPkt, NewReq, Timeout),
+ {TRef, NewReq}.
+
+%% store_request/4
+
+store_request(TPid, Bin, Req, Timeout) ->
+ Seqs = diameter_codec:sequence_numbers(Bin),
+ TRef = erlang:start_timer(Timeout, self(), timeout),
+ ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}),
+ ets:member(?REQUEST_TABLE, TPid)
+ orelse (self() ! {failover, TRef}), %% possibly missed failover
+ TRef.
+
+%% lookup_request/2
+
+lookup_request(Msg, TPid)
+ when is_pid(TPid) ->
+ lookup(Msg, TPid, '_');
+
+lookup_request(Msg, TRef)
+ when is_reference(TRef) ->
+ lookup(Msg, '_', TRef).
+
+lookup(Msg, TPid, TRef) ->
+ Seqs = diameter_codec:sequence_numbers(Msg),
+ Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, TRef},
+ [],
+ ['$_']}],
+ case ets:select(?REQUEST_TABLE, Spec) of
+ [{_, Req, _}] ->
+ Req;
+ [] ->
+ false
+ end.
+
+%% erase_request/1
+
+erase_request(Pkt) ->
+ ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)).
+
+%% match_requests/1
+
+match_requests(TPid) ->
+ Pat = {'_', #request{transport = TPid, _ = '_'}, '_'},
+ ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]).
+
+%% have_request/2
+
+have_request(Pkt, TPid) ->
+ Seqs = diameter_codec:sequence_numbers(Pkt),
+ Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'},
+ '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1).
+
+%% request_peer_up/1
+
+request_peer_up(TPid) ->
+ ets:insert(?REQUEST_TABLE, {TPid}).
+
+%% request_peer_down/2
+
+request_peer_down(TPid, S) ->
+ ets:delete(?REQUEST_TABLE, TPid),
+ lists:foreach(fun(T) -> failover(T,S) end, match_requests(TPid)).
+%% Note that a request process can store its request after failover
+%% notifications are sent here: store_request/4 sends the notification
+%% in that case. Note also that we'll send as many notifications to a
+%% given handler as there are peers its sent to. All but one of these
+%% will be ignored.
+
+%%% ---------------------------------------------------------------------------
+%%% recv_request/3
+%%% ---------------------------------------------------------------------------
+
+recv_request(TPid, Pkt, {ConnT, SvcName, Apps}) ->
+ try ets:lookup(ConnT, TPid) of
+ [C] ->
+ recv_request(C, TPid, Pkt, SvcName, Apps);
+ [] -> %% transport has gone down
+ ok
+ catch
+ error: badarg -> %% service has gone down (and taken table with it)
+ ok
+ end.
+
+%% recv_request/5
+
+recv_request(#conn{apps = SApps, caps = Caps}, TPid, Pkt, SvcName, Apps) ->
+ #diameter_caps{origin_host = {OH,_},
+ origin_realm = {OR,_}}
+ = Caps,
+
+ #diameter_packet{header = #diameter_header{application_id = Id}}
+ = Pkt,
+
+ recv_request(find_recv_app(Id, SApps),
+ {SvcName, OH, OR},
+ TPid,
+ Apps,
+ Caps,
+ Pkt).
+
+%% find_recv_app/2
+
+%% No one should be sending the relay identifier.
+find_recv_app(?APP_ID_RELAY, _) ->
+ false;
+
+%% With any other id we either support it locally or as a relay.
+find_recv_app(Id, SApps) ->
+ keyfind([Id, ?APP_ID_RELAY], 1, SApps).
+
+%% keyfind/3
+
+keyfind([], _, _) ->
+ false;
+keyfind([Key | Rest], Pos, L) ->
+ case lists:keyfind(Key, Pos, L) of
+ false ->
+ keyfind(Rest, Pos, L);
+ T ->
+ T
+ end.
+
+%% recv_request/6
+
+recv_request({Id, Alias}, T, TPid, Apps, Caps, Pkt) ->
+ #diameter_app{dictionary = Dict}
+ = A
+ = find_app(Alias, Apps),
+ recv_request(T, {TPid, Caps}, A, diameter_codec:decode(Id, Dict, Pkt));
+%% Note that the decode is different depending on whether or not Id is
+%% ?APP_ID_RELAY.
+
+%% DIAMETER_APPLICATION_UNSUPPORTED 3007
+%% A request was sent for an application that is not supported.
+
+recv_request(false, T, TPid, _, _, Pkt) ->
+ As = collect_avps(Pkt),
+ protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}).
+
+collect_avps(Pkt) ->
+ case diameter_codec:collect_avps(Pkt) of
+ {_Bs, As} ->
+ As;
+ As ->
+ As
+ end.
+
+%% recv_request/4
+
+%% Wrong number of bits somewhere in the message: reply.
+%%
+%% DIAMETER_INVALID_AVP_BITS 3009
+%% A request was received that included an AVP whose flag bits are
+%% set to an unrecognized value, or that is inconsistent with the
+%% AVP's definition.
+%%
+recv_request(T, {TPid, _}, _, #diameter_packet{errors = [Bs | _]} = Pkt)
+ when is_bitstring(Bs) ->
+ protocol_error(3009, T, TPid, Pkt);
+
+%% Either we support this application but don't recognize the command
+%% or we're a relay and the command isn't proxiable.
+%%
+%% DIAMETER_COMMAND_UNSUPPORTED 3001
+%% The Request contained a Command-Code that the receiver did not
+%% recognize or support. This MUST be used when a Diameter node
+%% receives an experimental command that it does not understand.
+%%
+recv_request(T,
+ {TPid, _},
+ #diameter_app{id = Id},
+ #diameter_packet{header = #diameter_header{is_proxiable = P},
+ msg = M}
+ = Pkt)
+ when ?APP_ID_RELAY /= Id, undefined == M;
+ ?APP_ID_RELAY == Id, not P ->
+ protocol_error(3001, T, TPid, Pkt);
+
+%% Error bit was set on a request.
+%%
+%% DIAMETER_INVALID_HDR_BITS 3008
+%% A request was received whose bits in the Diameter header were
+%% either set to an invalid combination, or to a value that is
+%% inconsistent with the command code's definition.
+%%
+recv_request(T,
+ {TPid, _},
+ _,
+ #diameter_packet{header = #diameter_header{is_error = true}}
+ = Pkt) ->
+ protocol_error(3008, T, TPid, Pkt);
+
+%% A message in a locally supported application or a proxiable message
+%% in the relay application. Don't distinguish between the two since
+%% each application has its own callback config. That is, the user can
+%% easily distinguish between the two cases.
+recv_request(T, TC, App, Pkt) ->
+ request_cb(T, TC, App, examine(Pkt)).
+
+%% Note that there may still be errors but these aren't protocol
+%% (3xxx) errors that lead to an answer-message.
+
+request_cb({SvcName, _OH, _OR} = T, TC, App, Pkt) ->
+ request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), App, T, TC, Pkt).
+
+%% examine/1
+%%
+%% Look for errors in a decoded message. Length errors result in
+%% decode failure in diameter_codec.
+
+examine(#diameter_packet{header = #diameter_header{version
+ = ?DIAMETER_VERSION}}
+ = Pkt) ->
+ Pkt;
+
+%% DIAMETER_UNSUPPORTED_VERSION 5011
+%% This error is returned when a request was received, whose version
+%% number is unsupported.
+
+examine(#diameter_packet{errors = Es} = Pkt) ->
+ Pkt#diameter_packet{errors = [5011 | Es]}.
+%% It's odd/unfortunate that this isn't a protocol error.
+
+%% request_cb/5
+
+%% A reply may be an answer-message, constructed either here or by
+%% the handle_request callback. The header from the incoming request
+%% is passed into the encode so that it can retrieve the relevant
+%% command code in this case. It will also then ignore Dict and use
+%% the base encoder.
+request_cb({reply, Ans},
+ #diameter_app{dictionary = Dict},
+ _,
+ {TPid, _},
+ Pkt) ->
+ reply(Ans, Dict, TPid, Pkt);
+
+%% An 3xxx result code, for which the E-bit is set in the header.
+request_cb({protocol_error, RC}, _, T, {TPid, _}, Pkt)
+ when 3000 =< RC, RC < 4000 ->
+ protocol_error(RC, T, TPid, Pkt);
+
+%% RFC 3588 says we must reply 3001 to anything unrecognized or
+%% unsupported. 'noreply' is undocumented (and inappropriately named)
+%% backwards compatibility for this, protocol_error the documented
+%% alternative.
+request_cb(noreply, _, T, {TPid, _}, Pkt) ->
+ protocol_error(3001, T, TPid, Pkt);
+
+%% Relay a request to another peer. This is equivalent to doing an
+%% explicit call/4 with the message in question except that (1) a loop
+%% will be detected by examining Route-Record AVP's, (3) a
+%% Route-Record AVP will be added to the outgoing request and (3) the
+%% End-to-End Identifier will default to that in the
+%% #diameter_header{} without the need for an end_to_end_identifier
+%% option.
+%%
+%% relay and proxy are similar in that they require the same handling
+%% with respect to Route-Record and End-to-End identifier. The
+%% difference is that a proxy advertises specific applications, while
+%% a relay advertises the relay application. If a callback doesn't
+%% want to distinguish between the cases in the callback return value
+%% then 'resend' is a neutral alternative.
+%%
+request_cb({A, Opts},
+ #diameter_app{id = Id}
+ = App,
+ T,
+ TC,
+ Pkt)
+ when A == relay, Id == ?APP_ID_RELAY;
+ A == proxy, Id /= ?APP_ID_RELAY;
+ A == resend ->
+ resend(Opts, App, T, TC, Pkt);
+
+request_cb(discard, _, _, _, _) ->
+ ok;
+
+request_cb({eval, RC, F}, App, T, TC, Pkt) ->
+ request_cb(RC, App, T, TC, Pkt),
+ diameter_lib:eval(F).
+
+%% protocol_error/4
+
+protocol_error(RC, {_, OH, OR}, TPid, #diameter_packet{avps = Avps} = Pkt) ->
+ ?LOG({error, RC}, Pkt),
+ reply(answer_message({OH, OR, RC}, Avps), ?BASE, TPid, Pkt).
+
+%% resend/5
+%%
+%% Resend a message as a relay or proxy agent.
+
+resend(Opts,
+ #diameter_app{} = App,
+ {_SvcName, OH, _OR} = T,
+ {_TPid, _Caps} = TC,
+ #diameter_packet{avps = Avps} = Pkt) ->
+ {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'),
+ resend(is_loop(Code, Vid, OH, Avps), Opts, App, T, TC, Pkt).
+
+%% DIAMETER_LOOP_DETECTED 3005
+%% An agent detected a loop while trying to get the message to the
+%% intended recipient. The message MAY be sent to an alternate peer,
+%% if one is available, but the peer reporting the error has
+%% identified a configuration problem.
+
+resend(true, _, _, T, {TPid, _}, Pkt) -> %% Route-Record loop
+ protocol_error(3005, T, TPid, Pkt);
+
+%% 6.1.8. Relaying and Proxying Requests
+%%
+%% A relay or proxy agent MUST append a Route-Record AVP to all requests
+%% forwarded. The AVP contains the identity of the peer the request was
+%% received from.
+
+resend(false,
+ Opts,
+ App,
+ {SvcName, _, _} = T,
+ {TPid, #diameter_caps{origin_host = {_, OH}}},
+ #diameter_packet{header = Hdr0,
+ avps = Avps}
+ = Pkt) ->
+ Route = #diameter_avp{data = {?BASE, 'Route-Record', OH}},
+ Seq = diameter_session:sequence(),
+ Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq},
+ Msg = [Hdr, Route | Avps],
+ resend(call(SvcName, App, Msg, Opts), T, TPid, Pkt).
+%% The incoming request is relayed with the addition of a
+%% Route-Record. Note the requirement on the return from call/4 below,
+%% which places a requirement on the value returned by the
+%% handle_answer callback of the application module in question.
+%%
+%% Note that there's nothing stopping the request from being relayed
+%% back to the sender. A pick_peer callback may want to avoid this but
+%% a smart peer might recognize the potential loop and choose another
+%% route. A less smart one will probably just relay the request back
+%% again and force us to detect the loop. A pick_peer that wants to
+%% avoid this can specify filter to avoid the possibility.
+%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}.
+%%
+%% RFC 6.3 says that a relay agent does not modify Origin-Host but
+%% says nothing about a proxy. Assume it should behave the same way.
+
+%% resend/4
+%%
+%% Relay a reply to a relayed request.
+
+%% Answer from the peer: reset the hop by hop identifier and send.
+resend(#diameter_packet{bin = B}
+ = Pkt,
+ _,
+ TPid,
+ #diameter_packet{header = #diameter_header{hop_by_hop_id = Id},
+ transport_data = TD}) ->
+ send(TPid, Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B),
+ transport_data = TD});
+%% TODO: counters
+
+%% Or not: DIAMETER_UNABLE_TO_DELIVER.
+resend(_, T, TPid, Pkt) ->
+ protocol_error(3002, T, TPid, Pkt).
+
+%% is_loop/4
+%%
+%% Is there a Route-Record AVP with our Origin-Host?
+
+is_loop(Code,
+ Vid,
+ Bin,
+ [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) ->
+ true;
+
+is_loop(_, _, _, []) ->
+ false;
+
+is_loop(Code, Vid, OH, [_ | Avps])
+ when is_binary(OH) ->
+ is_loop(Code, Vid, OH, Avps);
+
+is_loop(Code, Vid, OH, Avps) ->
+ is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps).
+
+%% reply/4
+%%
+%% Send a locally originating reply.
+
+%% No errors or a diameter_header/avp list.
+reply(Msg, Dict, TPid, #diameter_packet{errors = Es,
+ transport_data = TD}
+ = ReqPkt)
+ when [] == Es;
+ is_record(hd(Msg), diameter_header) ->
+ Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)),
+ incr(send, Pkt, Dict, TPid), %% count result codes in sent answers
+ send(TPid, Pkt#diameter_packet{transport_data = TD});
+
+%% Or not: set Result-Code and Failed-AVP AVP's.
+reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) ->
+ reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict),
+ Dict,
+ TPid,
+ Pkt#diameter_packet{errors = []}).
+
+%% make_reply_packet/2
+
+%% Binaries and header/avp lists are sent as-is.
+make_reply_packet(Bin, _)
+ when is_binary(Bin) ->
+ #diameter_packet{bin = Bin};
+make_reply_packet([#diameter_header{} | _] = Msg, _) ->
+ #diameter_packet{msg = Msg};
+
+%% Otherwise a reply message clears the R and T flags and retains the
+%% P flag. The E flag will be set at encode.
+make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) ->
+ Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION,
+ is_request = false,
+ is_error = undefined,
+ is_retransmitted = false},
+ #diameter_packet{header = Hdr,
+ msg = Msg}.
+
+%% rc/1
+
+rc({RC, _}) ->
+ RC;
+rc(RC) ->
+ RC.
+
+%% rc/4
+
+rc(Rec, RC, Failed, Dict)
+ when is_integer(RC) ->
+ set(Rec, [{'Result-Code', RC} | failed_avp(Rec, Failed, Dict)], Dict).
+
+%% Reply as name and tuple list ...
+set([_|_] = Ans, Avps, _) ->
+ Ans ++ Avps; %% Values nearer tail take precedence.
+
+%% ... or record.
+set(Rec, Avps, Dict) ->
+ Dict:'#set-'(Avps, Rec).
+
+%% failed_avp/3
+
+failed_avp(_, [] = No, _) ->
+ No;
+
+failed_avp(Rec, Failed, Dict) ->
+ [fa(Rec, [{'AVP', Failed}], Dict)].
+
+%% Reply as name and tuple list ...
+fa([MsgName | Values], FailedAvp, Dict) ->
+ R = Dict:msg2rec(MsgName),
+ try
+ Dict:'#info-'(R, {index, 'Failed-AVP'}),
+ {'Failed-AVP', [FailedAvp]}
+ catch
+ error: _ ->
+ Avps = proplists:get_value('AVP', Values, []),
+ A = #diameter_avp{name = 'Failed-AVP',
+ value = FailedAvp},
+ {'AVP', [A|Avps]}
+ end;
+
+%% ... or record.
+fa(Rec, FailedAvp, Dict) ->
+ try
+ {'Failed-AVP', [FailedAvp]}
+ catch
+ error: _ ->
+ Avps = Dict:'get-'('AVP', Rec),
+ A = #diameter_avp{name = 'Failed-AVP',
+ value = FailedAvp},
+ {'AVP', [A|Avps]}
+ end.
+
+%% 3. Diameter Header
+%%
+%% E(rror) - If set, the message contains a protocol error,
+%% and the message will not conform to the ABNF
+%% described for this command. Messages with the 'E'
+%% bit set are commonly referred to as error
+%% messages. This bit MUST NOT be set in request
+%% messages. See Section 7.2.
+
+%% 3.2. Command Code ABNF specification
+%%
+%% e-bit = ", ERR"
+%% ; If present, the 'E' bit in the Command
+%% ; Flags is set, indicating that the answer
+%% ; message contains a Result-Code AVP in
+%% ; the "protocol error" class.
+
+%% 7.1.3. Protocol Errors
+%%
+%% Errors that fall within the Protocol Error category SHOULD be treated
+%% on a per-hop basis, and Diameter proxies MAY attempt to correct the
+%% error, if it is possible. Note that these and only these errors MUST
+%% only be used in answer messages whose 'E' bit is set.
+
+%% Thus, only construct answers to protocol errors. Other errors
+%% require an message-specific answer and must be handled by the
+%% application.
+
+%% 6.2. Diameter Answer Processing
+%%
+%% When a request is locally processed, the following procedures MUST be
+%% applied to create the associated answer, in addition to any
+%% additional procedures that MAY be discussed in the Diameter
+%% application defining the command:
+%%
+%% - The same Hop-by-Hop identifier in the request is used in the
+%% answer.
+%%
+%% - The local host's identity is encoded in the Origin-Host AVP.
+%%
+%% - The Destination-Host and Destination-Realm AVPs MUST NOT be
+%% present in the answer message.
+%%
+%% - The Result-Code AVP is added with its value indicating success or
+%% failure.
+%%
+%% - If the Session-Id is present in the request, it MUST be included
+%% in the answer.
+%%
+%% - Any Proxy-Info AVPs in the request MUST be added to the answer
+%% message, in the same order they were present in the request.
+%%
+%% - The 'P' bit is set to the same value as the one in the request.
+%%
+%% - The same End-to-End identifier in the request is used in the
+%% answer.
+%%
+%% Note that the error messages (see Section 7.3) are also subjected to
+%% the above processing rules.
+
+%% 7.3. Error-Message AVP
+%%
+%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY
+%% accompany a Result-Code AVP as a human readable error message. The
+%% Error-Message AVP is not intended to be useful in real-time, and
+%% SHOULD NOT be expected to be parsed by network entities.
+
+%% answer_message/2
+
+answer_message({OH, OR, RC}, Avps) ->
+ {Code, _, Vid} = ?BASE:avp_header('Session-Id'),
+ ['answer-message', {'Origin-Host', OH},
+ {'Origin-Realm', OR},
+ {'Result-Code', RC}
+ | session_id(Code, Vid, Avps)].
+
+session_id(Code, Vid, Avps)
+ when is_list(Avps) ->
+ try
+ {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps),
+ [{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}]
+ catch
+ error: _ ->
+ []
+ end.
+
+%% find_avp/3
+
+find_avp(Code, Vid, Avps)
+ when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) ->
+ find(fun(A) -> is_avp(Code, Vid, A) end, Avps).
+
+%% The final argument here could be a list of AVP's, depending on the case,
+%% but we're only searching at the top level.
+is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) ->
+ true;
+is_avp(_, _, _) ->
+ false.
+
+find(_, []) ->
+ false;
+find(Pred, [H|T]) ->
+ case Pred(H) of
+ true ->
+ {value, H};
+ false ->
+ find(Pred, T)
+ end.
+
+%% 7. Error Handling
+%%
+%% There are certain Result-Code AVP application errors that require
+%% additional AVPs to be present in the answer. In these cases, the
+%% Diameter node that sets the Result-Code AVP to indicate the error
+%% MUST add the AVPs. Examples are:
+%%
+%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit)
+%% set, causes an answer to be sent with the Result-Code AVP set to
+%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the
+%% offending AVP.
+%%
+%% - An AVP that is received with an unrecognized value causes an
+%% answer to be returned with the Result-Code AVP set to
+%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the
+%% AVP causing the error.
+%%
+%% - A command is received with an AVP that is omitted, yet is
+%% mandatory according to the command's ABNF. The receiver issues an
+%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and
+%% creates an AVP with the AVP Code and other fields set as expected
+%% in the missing AVP. The created AVP is then added to the Failed-
+%% AVP AVP.
+%%
+%% The Result-Code AVP describes the error that the Diameter node
+%% encountered in its processing. In case there are multiple errors,
+%% the Diameter node MUST report only the first error it encountered
+%% (detected possibly in some implementation dependent order). The
+%% specific errors that can be described by this AVP are described in
+%% the following section.
+
+%% 7.5. Failed-AVP AVP
+%%
+%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides
+%% debugging information in cases where a request is rejected or not
+%% fully processed due to erroneous information in a specific AVP. The
+%% value of the Result-Code AVP will provide information on the reason
+%% for the Failed-AVP AVP.
+%%
+%% The possible reasons for this AVP are the presence of an improperly
+%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP
+%% value, the omission of a required AVP, the presence of an explicitly
+%% excluded AVP (see tables in Section 10), or the presence of two or
+%% more occurrences of an AVP which is restricted to 0, 1, or 0-1
+%% occurrences.
+%%
+%% A Diameter message MAY contain one Failed-AVP AVP, containing the
+%% entire AVP that could not be processed successfully. If the failure
+%% reason is omission of a required AVP, an AVP with the missing AVP
+%% code, the missing vendor id, and a zero filled payload of the minimum
+%% required length for the omitted AVP will be added.
+
+%%% ---------------------------------------------------------------------------
+%%% # handle_answer/3
+%%% ---------------------------------------------------------------------------
+
+%% Process an answer message in call-specific process.
+
+handle_answer(SvcName, _, {error, Req, Reason}) ->
+ handle_error(Req, Reason, SvcName);
+
+handle_answer(SvcName,
+ AnswerErrors,
+ {answer, #request{dictionary = Dict} = Req, Pkt}) ->
+ a(examine(diameter_codec:decode(Dict, Pkt)),
+ SvcName,
+ AnswerErrors,
+ Req).
+
+%% We don't really need to do a full decode if we're a relay and will
+%% just resend with a new hop by hop identifier, but might a proxy
+%% want to examine the answer?
+
+a(#diameter_packet{errors = []}
+ = Pkt,
+ SvcName,
+ AE,
+ #request{transport = TPid,
+ dictionary = Dict,
+ caps = Caps,
+ packet = P}
+ = Req) ->
+ try
+ incr(in, Pkt, Dict, TPid)
+ of
+ _ ->
+ cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}])
+ catch
+ exit: {invalid_error_bit, _} = E ->
+ e(Pkt#diameter_packet{errors = [E]}, SvcName, AE, Req)
+ end;
+
+a(#diameter_packet{} = Pkt, SvcName, AE, Req) ->
+ e(Pkt, SvcName, AE, Req).
+
+e(Pkt, SvcName, callback, #request{transport = TPid,
+ caps = Caps,
+ packet = Pkt}
+ = Req) ->
+ cb(Req, handle_answer, [Pkt, msg(Pkt), SvcName, {TPid, Caps}]);
+e(Pkt, SvcName, report, Req) ->
+ x(errors, handle_answer, [SvcName, Req, Pkt]);
+e(Pkt, SvcName, discard, Req) ->
+ x({errors, handle_answer, [SvcName, Req, Pkt]}).
+
+%% Note that we don't check that the application id in the answer's
+%% header is what we expect. (TODO: Does the rfc says anything about
+%% this?)
+
+%% incr/4
+%%
+%% Increment a stats counter for an incoming or outgoing message.
+
+%% TODO: fix
+incr(_, #diameter_packet{msg = undefined}, _, _) ->
+ ok;
+
+incr(Dir, Pkt, Dict, TPid)
+ when is_pid(TPid) ->
+ #diameter_packet{header = #diameter_header{is_error = E}
+ = Hdr,
+ msg = Rec}
+ = Pkt,
+
+ D = choose(E, ?BASE, Dict),
+ RC = int(get_avp_value(D, 'Result-Code', Rec)),
+ PE = is_protocol_error(RC),
+
+ %% Check that the E bit is set only for 3xxx result codes.
+ (not (E orelse PE))
+ orelse (E andalso PE)
+ orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]),
+
+ Ctr = rc_counter(D, Rec, RC),
+ is_tuple(Ctr)
+ andalso incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}).
+
+%% incr/2
+
+incr(TPid, Counter) ->
+ diameter_stats:incr(Counter, TPid, 1).
+
+%% RFC 3588, 7.6:
+%%
+%% All Diameter answer messages defined in vendor-specific
+%% applications MUST include either one Result-Code AVP or one
+%% Experimental-Result AVP.
+%%
+%% Maintain statistics assuming one or the other, not both, which is
+%% surely the intent of the RFC.
+
+rc_counter(_, _, RC)
+ when is_integer(RC) ->
+ {'Result-Code', RC};
+rc_counter(D, Rec, _) ->
+ rcc(get_avp_value(D, 'Experimental-Result', Rec)).
+
+%% Outgoing answers may be in any of the forms messages can be sent
+%% in. Incoming messages will be records. We're assuming here that the
+%% arity of the result code AVP's is 0 or 1.
+
+rcc([{_,_,RC} = T])
+ when is_integer(RC) ->
+ T;
+rcc({_,_,RC} = T)
+ when is_integer(RC) ->
+ T;
+rcc(_) ->
+ undefined.
+
+int([N])
+ when is_integer(N) ->
+ N;
+int(N)
+ when is_integer(N) ->
+ N;
+int(_) ->
+ undefined.
+
+is_protocol_error(RC) ->
+ 3000 =< RC andalso RC < 4000.
+
+-spec x(any(), atom(), list()) -> no_return().
+
+%% Warn and exit request process on errors in an incoming answer.
+x(Reason, F, A) ->
+ diameter_lib:warning_report(Reason, {?MODULE, F, A}),
+ x(Reason).
+
+x(T) ->
+ exit(T).
+
+%%% ---------------------------------------------------------------------------
+%%% # failover/[23]
+%%% ---------------------------------------------------------------------------
+
+%% Failover as a consequence of request_peer_down/2.
+failover({_, #request{handler = Pid} = Req, TRef}, S) ->
+ Pid ! {failover, TRef, rt(Req, S)}.
+
+%% Failover as a consequence of store_request/4.
+failover(TRef, Seqs, S)
+ when is_reference(TRef) ->
+ case lookup_request(Seqs, TRef) of
+ #request{} = Req ->
+ failover({Seqs, Req, TRef}, S);
+ false ->
+ ok
+ end.
+
+%% prepare_request returned a binary ...
+rt(#request{packet = #diameter_packet{msg = undefined}}, _) ->
+ false; %% TODO: Not what we should do.
+
+%% ... or not.
+rt(#request{packet = #diameter_packet{msg = Msg}, dictionary = D} = Req, S) ->
+ find_transport(get_destination(Msg, D), Req, S).
+
+%%% ---------------------------------------------------------------------------
+%%% # report_status/5
+%%% ---------------------------------------------------------------------------
+
+report_status(Status,
+ #peer{ref = Ref,
+ conn = TPid,
+ type = Type,
+ options = Opts},
+ #conn{apps = [_|_] = As,
+ caps = Caps},
+ #state{service_name = SvcName}
+ = S,
+ Extra) ->
+ share_peer(Status, Caps, As, TPid, S),
+ Info = [Status, Ref, {TPid, Caps}, {type(Type), Opts} | Extra],
+ send_event(SvcName, list_to_tuple(Info)).
+
+%% send_event/2
+
+send_event(SvcName, Info) ->
+ send_event(#diameter_event{service = SvcName,
+ info = Info}).
+
+send_event(#diameter_event{service = SvcName} = E) ->
+ lists:foreach(fun({_, Pid}) -> Pid ! E end, subscriptions(SvcName)).
+
+%%% ---------------------------------------------------------------------------
+%%% # share_peer/5
+%%% ---------------------------------------------------------------------------
+
+share_peer(up, Caps, Aliases, TPid, #state{share_peers = true,
+ service_name = Svc}) ->
+ diameter_peer:notify(Svc, {peer, TPid, Aliases, Caps});
+
+share_peer(_, _, _, _, _) ->
+ ok.
+
+%%% ---------------------------------------------------------------------------
+%%% # share_peers/2
+%%% ---------------------------------------------------------------------------
+
+share_peers(Pid, #state{share_peers = true,
+ local_peers = PDict}) ->
+ ?Dict:fold(fun(A,Ps,ok) -> sp(Pid, A, Ps), ok end, ok, PDict);
+
+share_peers(_, #state{share_peers = false}) ->
+ ok.
+
+sp(Pid, Alias, Peers) ->
+ lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers).
+
+%%% ---------------------------------------------------------------------------
+%%% # remote_peer_up/4
+%%% ---------------------------------------------------------------------------
+
+remote_peer_up(Pid, Aliases, Caps, #state{use_shared_peers = true,
+ service = Svc,
+ shared_peers = PDict}
+ = S) ->
+ #diameter_service{applications = Apps} = Svc,
+ Update = lists:filter(fun(A) ->
+ lists:keymember(A, #diameter_app.alias, Apps)
+ end,
+ Aliases),
+ S#state{shared_peers = rpu(Pid, Caps, PDict, Update)};
+
+remote_peer_up(_, _, _, #state{use_shared_peers = false} = S) ->
+ S.
+
+rpu(_, _, PDict, []) ->
+ PDict;
+rpu(Pid, Caps, PDict, Aliases) ->
+ erlang:monitor(process, Pid),
+ T = {Pid, Caps},
+ lists:foldl(fun(A,D) -> ?Dict:append(A, T, D) end,
+ PDict,
+ Aliases).
+
+%%% ---------------------------------------------------------------------------
+%%% # remote_peer_down/2
+%%% ---------------------------------------------------------------------------
+
+remote_peer_down(Pid, #state{use_shared_peers = true,
+ shared_peers = PDict}
+ = S) ->
+ S#state{shared_peers = lists:foldl(fun(A,D) -> rpd(Pid, A, D) end,
+ PDict,
+ ?Dict:fetch_keys(PDict))}.
+
+rpd(Pid, Alias, PDict) ->
+ ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict).
+
+%%% ---------------------------------------------------------------------------
+%%% find_transport/[34]
+%%%
+%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}}
+%%% | false
+%%% | {error, Reason}
+%%% ---------------------------------------------------------------------------
+
+%% Initial call, from an arbitrary process.
+find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) ->
+ #diameter_service{applications = Apps} = Svc,
+ ft(find_send_app(Alias, Apps), Msg, Opts, S);
+
+%% Relay or proxy send.
+find_transport(#diameter_app{} = App, Msg, Opts, S) ->
+ ft(App, Msg, Opts, S).
+
+ft(#diameter_app{module = Mod, dictionary = D} = App, Msg, Opts, S) ->
+ #options{filter = Filter,
+ extra = Xtra}
+ = Opts,
+ pick_peer(App#diameter_app{module = Mod ++ Xtra},
+ get_destination(Msg, D),
+ Filter,
+ S);
+ft(false = No, _, _, _) ->
+ No.
+
+%% This can't be used if we're a relay and sending a message
+%% in an application not known locally. (TODO)
+find_send_app(Alias, Apps) ->
+ case lists:keyfind(Alias, #diameter_app.alias, Apps) of
+ #diameter_app{id = ?APP_ID_RELAY} ->
+ false;
+ T ->
+ T
+ end.
+
+%% Retransmission, in the service process.
+find_transport([_,_] = RH,
+ Req,
+ #state{service = #diameter_service{pid = Pid,
+ applications = Apps}}
+ = S)
+ when self() == Pid ->
+ #request{app = Alias,
+ filter = Filter,
+ module = ModX}
+ = Req,
+ #diameter_app{}
+ = App
+ = lists:keyfind(Alias, #diameter_app.alias, Apps),
+
+ pick_peer(App#diameter_app{module = ModX},
+ RH,
+ Filter,
+ S).
+
+%% get_destination/2
+
+get_destination(Msg, Dict) ->
+ [str(get_avp_value(Dict, 'Destination-Realm', Msg)),
+ str(get_avp_value(Dict, 'Destination-Host', Msg))].
+
+%% This is not entirely correct. The avp could have an arity 1, in
+%% which case an empty list is a DiameterIdentity of length 0 rather
+%% than the list of no values we treat it as by mapping to undefined.
+%% This behaviour is documented.
+str([]) ->
+ undefined;
+str(T) ->
+ T.
+
+%% get_avp_value/3
+%%
+%% Find an AVP in a message of one of three forms:
+%%
+%% - a message record (as generated from a .dia spec) or
+%% - a list of an atom message name followed by 2-tuple, avp name/value pairs.
+%% - a list of a #diameter_header{} followed by #diameter_avp{} records,
+%%
+%% In the first two forms a dictionary module is used at encode to
+%% identify the type of the AVP and its arity in the message in
+%% question. The third form allows messages to be sent as is, without
+%% a dictionary, which is needed in the case of relay agents, for one.
+
+get_avp_value(Dict, Name, [#diameter_header{} | Avps]) ->
+ try
+ {Code, _, VId} = Dict:avp_header(Name),
+ [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) ->
+ C /= Code orelse V /= VId
+ end,
+ Avps),
+ avp_decode(Dict, Name, A)
+ catch
+ error: _ ->
+ undefined
+ end;
+
+get_avp_value(_, Name, [_MsgName | Avps]) ->
+ case lists:keyfind(Name, 1, Avps) of
+ {_, V} ->
+ V;
+ _ ->
+ undefined
+ end;
+
+%% Message is typically a record but not necessarily: diameter:call/4
+%% can be passed an arbitrary term.
+get_avp_value(Dict, Name, Rec) ->
+ try
+ Dict:'#get-'(Name, Rec)
+ catch
+ error:_ ->
+ undefined
+ end.
+
+avp_decode(Dict, Name, #diameter_avp{value = undefined,
+ data = Bin}) ->
+ Dict:avp(decode, Bin, Name);
+avp_decode(_, _, #diameter_avp{value = V}) ->
+ V.
+
+%%% ---------------------------------------------------------------------------
+%%% # pick_peer(App, [DestRealm, DestHost], Filter, #state{})
+%%%
+%%% Output: {TransportPid, #diameter_caps{}, App}
+%%% | false
+%%% | {error, Reason}
+%%% ---------------------------------------------------------------------------
+
+%% Find transports to a given realm/host.
+
+pick_peer(#diameter_app{alias = Alias}
+ = App,
+ [_,_] = RH,
+ Filter,
+ #state{local_peers = L,
+ shared_peers = S,
+ service_name = SvcName,
+ service = #diameter_service{pid = Pid}}) ->
+ pick_peer(peers(Alias, RH, Filter, L),
+ peers(Alias, RH, Filter, S),
+ Pid,
+ SvcName,
+ App).
+
+%% pick_peer/5
+
+pick_peer([], [], _, _, _) ->
+ false;
+
+%% App state is mutable but we're not in the service process: go there.
+pick_peer(Local, Remote, Pid, _SvcName, #diameter_app{mutable = true} = App)
+ when self() /= Pid ->
+ call_service(Pid, {pick_peer, Local, Remote, App});
+
+%% App state isn't mutable or it is and we're in the service process:
+%% do the deed.
+pick_peer(Local,
+ Remote,
+ _Pid,
+ SvcName,
+ #diameter_app{module = ModX,
+ alias = Alias,
+ init_state = S,
+ mutable = M}
+ = App) ->
+ MFA = {ModX, pick_peer, [Local, Remote, SvcName]},
+
+ try state_cb(App, MFA) of
+ {ok, {TPid, #diameter_caps{} = Caps}} when is_pid(TPid) ->
+ {TPid, Caps, App};
+ {{TPid, #diameter_caps{} = Caps}, ModS} when is_pid(TPid), M ->
+ mod_state(Alias, ModS),
+ {TPid, Caps, App};
+ {false = No, ModS} when M ->
+ mod_state(Alias, ModS),
+ No;
+ {ok, false = No} ->
+ No;
+ false = No ->
+ No;
+ {{TPid, #diameter_caps{} = Caps}, S} when is_pid(TPid) ->
+ {TPid, Caps, App}; %% Accept returned state in the immutable
+ {false = No, S} -> %% case as long it isn't changed.
+ No;
+ T ->
+ diameter_lib:error_report({invalid, T, App}, MFA)
+ catch
+ E: Reason ->
+ diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA)
+ end.
+
+%% peers/4
+
+peers(Alias, RH, Filter, Peers) ->
+ case ?Dict:find(Alias, Peers) of
+ {ok, L} ->
+ ps(L, RH, Filter, {[],[]});
+ error ->
+ []
+ end.
+
+%% Place a peer whose Destination-Host/Realm matches those of the
+%% request at the front of the result list. Could add some sort of
+%% 'sort' option to allow more control.
+
+ps([], _, _, {Ys, Ns}) ->
+ lists:reverse(Ys, Ns);
+ps([{_TPid, #diameter_caps{} = Caps} = TC | Rest], RH, Filter, Acc) ->
+ ps(Rest, RH, Filter, pacc(caps_filter(Caps, RH, Filter),
+ caps_filter(Caps, RH, {all, [host, realm]}),
+ TC,
+ Acc)).
+
+pacc(true, true, Peer, {Ts, Fs}) ->
+ {[Peer|Ts], Fs};
+pacc(true, false, Peer, {Ts, Fs}) ->
+ {Ts, [Peer|Fs]};
+pacc(_, _, _, Acc) ->
+ Acc.
+
+%% caps_filter/3
+
+caps_filter(C, RH, {neg, F}) ->
+ not caps_filter(C, RH, F);
+
+caps_filter(C, RH, {all, L})
+ when is_list(L) ->
+ lists:all(fun(F) -> caps_filter(C, RH, F) end, L);
+
+caps_filter(C, RH, {any, L})
+ when is_list(L) ->
+ lists:any(fun(F) -> caps_filter(C, RH, F) end, L);
+
+caps_filter(#diameter_caps{origin_host = {_,OH}}, [_,DH], host) ->
+ eq(undefined, DH, OH);
+
+caps_filter(#diameter_caps{origin_realm = {_,OR}}, [DR,_], realm) ->
+ eq(undefined, DR, OR);
+
+caps_filter(C, _, Filter) ->
+ caps_filter(C, Filter).
+
+%% caps_filter/2
+
+caps_filter(_, none) ->
+ true;
+
+caps_filter(#diameter_caps{origin_host = {_,OH}}, {host, H}) ->
+ eq(any, H, OH);
+
+caps_filter(#diameter_caps{origin_realm = {_,OR}}, {realm, R}) ->
+ eq(any, R, OR);
+
+%% Anything else is expected to be an eval filter. Filter failure is
+%% documented as being equivalent to a non-matching filter.
+
+caps_filter(C, T) ->
+ try
+ {eval, F} = T,
+ diameter_lib:eval([F,C])
+ catch
+ _:_ -> false
+ end.
+
+eq(Any, Id, PeerId) ->
+ Any == Id orelse try
+ iolist_to_binary(Id) == iolist_to_binary(PeerId)
+ catch
+ _:_ -> false
+ end.
+%% OctetString() can be specified as an iolist() so test for string
+%% rather then term equality.
+
+%% transports/1
+
+transports(#state{peerT = PeerT}) ->
+ ets:select(PeerT, [{#peer{conn = '$1', _ = '_'},
+ [{'is_pid', '$1'}],
+ ['$1']}]).
+
+%%% ---------------------------------------------------------------------------
+%%% # service_info/2
+%%% ---------------------------------------------------------------------------
+
+%% The config passed to diameter:start_service/2.
+-define(CAP_INFO, ['Origin-Host',
+ 'Origin-Realm',
+ 'Vendor-Id',
+ 'Product-Name',
+ 'Origin-State-Id',
+ 'Host-IP-Address',
+ 'Supported-Vendor-Id',
+ 'Auth-Application-Id',
+ 'Inband-Security-Id',
+ 'Acct-Application-Id',
+ 'Vendor-Specific-Application-Id',
+ 'Firmware-Revision']).
+
+-define(ALL_INFO, [capabilities,
+ applications,
+ transport,
+ pending,
+ statistics]).
+
+service_info(Items, S)
+ when is_list(Items) ->
+ [{complete(I), service_info(I,S)} || I <- Items];
+service_info(Item, S)
+ when is_atom(Item) ->
+ service_info(Item, S, true).
+
+service_info(Item, #state{service = Svc} = S, Complete) ->
+ case Item of
+ name ->
+ S#state.service_name;
+ 'Origin-Host' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.origin_host;
+ 'Origin-Realm' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.origin_realm;
+ 'Vendor-Id' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.vendor_id;
+ 'Product-Name' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.product_name;
+ 'Origin-State-Id' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.origin_state_id;
+ 'Host-IP-Address' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.host_ip_address;
+ 'Supported-Vendor-Id' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.supported_vendor_id;
+ 'Auth-Application-Id' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.auth_application_id;
+ 'Inband-Security-Id' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.inband_security_id;
+ 'Acct-Application-Id' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.acct_application_id;
+ 'Vendor-Specific-Application-Id' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.vendor_specific_application_id;
+ 'Firmware-Revision' ->
+ (Svc#diameter_service.capabilities)
+ #diameter_caps.firmware_revision;
+ capabilities -> service_info(?CAP_INFO, S);
+ applications -> info_apps(S);
+ transport -> info_transport(S);
+ pending -> info_pending(S);
+ statistics -> info_stats(S);
+ keys -> ?ALL_INFO ++ ?CAP_INFO; %% mostly for test
+ all -> service_info(?ALL_INFO, S);
+ _ when Complete -> service_info(complete(Item), S, false);
+ _ -> undefined
+ end.
+
+complete(Pre) ->
+ P = atom_to_list(Pre),
+ case [I || I <- [name | ?ALL_INFO] ++ ?CAP_INFO,
+ lists:prefix(P, atom_to_list(I))]
+ of
+ [I] -> I;
+ _ -> Pre
+ end.
+
+info_stats(#state{peerT = PeerT}) ->
+ Peers = ets:select(PeerT, [{#peer{ref = '$1', conn = '$2', _ = '_'},
+ [{'is_pid', '$2'}],
+ [['$1', '$2']]}]),
+ diameter_stats:read(lists:append(Peers)).
+%% TODO: include peer identities in return value
+
+info_transport(#state{peerT = PeerT, connT = ConnT}) ->
+ dict:fold(fun it/3,
+ [],
+ ets:foldl(fun(T,A) -> it_acc(ConnT, A, T) end,
+ dict:new(),
+ PeerT)).
+
+it(Ref, [[{type, connect} | _] = L], Acc) ->
+ [[{ref, Ref} | L] | Acc];
+it(Ref, [[{type, accept}, {options, Opts} | _] | _] = L, Acc) ->
+ [[{ref, Ref},
+ {type, listen},
+ {options, Opts},
+ {accept, [lists:nthtail(2,A) || A <- L]}]
+ | Acc].
+%% Each entry has the same Opts. (TODO)
+
+it_acc(ConnT, Acc, #peer{pid = Pid,
+ type = Type,
+ ref = Ref,
+ options = Opts,
+ op_state = OS,
+ started = T,
+ conn = TPid}) ->
+ dict:append(Ref,
+ [{type, Type},
+ {options, Opts},
+ {watchdog, {Pid, T, OS}}
+ | info_conn(ConnT, TPid)],
+ Acc).
+
+info_conn(ConnT, TPid) ->
+ info_conn(ets:lookup(ConnT, TPid)).
+
+info_conn([#conn{pid = Pid, apps = SApps, caps = Caps, started = T}]) ->
+ [{peer, {Pid, T}},
+ {apps, SApps},
+ {caps, info_caps(Caps)}];
+info_conn([] = No) ->
+ No.
+
+info_caps(#diameter_caps{} = C) ->
+ lists:zip(record_info(fields, diameter_caps), tl(tuple_to_list(C))).
+
+info_apps(#state{service = #diameter_service{applications = Apps}}) ->
+ lists:map(fun mk_app/1, Apps).
+
+mk_app(#diameter_app{alias = Alias,
+ dictionary = Dict,
+ module = ModX,
+ id = Id}) ->
+ [{alias, Alias},
+ {dictionary, Dict},
+ {module, ModX},
+ {id, Id}].
+
+info_pending(#state{} = S) ->
+ MatchSpec = [{{'$1',
+ #request{transport = '$2',
+ from = '$3',
+ app = '$4',
+ _ = '_'},
+ '_'},
+ [?ORCOND([{'==', T, '$2'} || T <- transports(S)])],
+ [{{'$1', [{{app, '$4'}},
+ {{transport, '$2'}},
+ {{from, '$3'}}]}}]}],
+
+ ets:select(?REQUEST_TABLE, MatchSpec).
diff --git a/lib/diameter/src/base/diameter_service_sup.erl b/lib/diameter/src/base/diameter_service_sup.erl
new file mode 100644
index 0000000000..153fff902f
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_session.erl b/lib/diameter/src/base/diameter_session.erl
new file mode 100644
index 0000000000..bb91e97f39
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_stats.erl b/lib/diameter/src/base/diameter_stats.erl
new file mode 100644
index 0000000000..71479afa95
--- /dev/null
+++ b/lib/diameter/src/base/diameter_stats.erl
@@ -0,0 +1,342 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Statistics collector.
+%%
+
+-module(diameter_stats).
+-compile({no_auto_import, [monitor/2]}).
+
+-behaviour(gen_server).
+
+-export([reg/1, reg/2,
+ incr/1, incr/2, incr/3,
+ read/1,
+ flush/0, flush/1]).
+
+%% supervisor callback
+-export([start_link/0]).
+
+%% gen_server callbacks
+-export([init/1,
+ terminate/2,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ code_change/3]).
+
+%% debug
+-export([state/0,
+ uptime/0]).
+
+-include("diameter_internal.hrl").
+
+%% ets table containing stats. reg(Pid, Ref) inserts a {Pid, Ref},
+%% incr(Counter, X, N) updates the counter keyed at {Counter, X}, and
+%% Pid death causes counters keyed on {Counter, Pid} to be deleted and
+%% added to those keyed on {Counter, Ref}.
+-define(TABLE, ?MODULE).
+
+%% Name of registered server.
+-define(SERVER, ?MODULE).
+
+%% Entries in the table.
+-define(REC(Key, Value), {Key, Value}).
+
+%% Server state.
+-record(state, {id = now()}).
+
+-type counter() :: any().
+-type contrib() :: any().
+
+%%% ---------------------------------------------------------------------------
+%%% # reg(Pid, Contrib)
+%%%
+%%% Description: Register a process as a contributor of statistics
+%%% associated with a specified term. Statistics can be
+%%% contributed by specifying either Pid or Contrib as
+%%% the second argument to incr/3. Statistics contributed
+%%% by Pid are folded into the corresponding entry for
+%%% Contrib when the process dies.
+%%%
+%%% Contrib can be any term but should not be a pid
+%%% passed as the first argument to reg/2. Subsequent
+%%% registrations for the same Pid overwrite the association
+%%% ---------------------------------------------------------------------------
+
+-spec reg(pid(), contrib())
+ -> true.
+
+reg(Pid, Contrib)
+ when is_pid(Pid) ->
+ call({reg, Pid, Contrib}).
+
+-spec reg(contrib())
+ -> true.
+
+reg(Ref) ->
+ reg(self(), Ref).
+
+%%% ---------------------------------------------------------------------------
+%%% # incr(Counter, Contrib, N)
+%%%
+%%% Description: Increment a counter for the specified contributor.
+%%%
+%%% Contrib will typically be an argument passed to reg/2
+%%% but there's nothing that requires this. In particular,
+%%% if Contrib is a pid that hasn't been registered then
+%%% counters are unaffected by the death of the process.
+%%% ---------------------------------------------------------------------------
+
+-spec incr(counter(), contrib(), integer())
+ -> integer().
+
+incr(Ctr, Contrib, N) ->
+ update_counter({Ctr, Contrib}, N).
+
+incr(Ctr, N)
+ when is_integer(N) ->
+ incr(Ctr, self(), N);
+
+incr(Ctr, Contrib) ->
+ incr(Ctr, Contrib, 1).
+
+incr(Ctr) ->
+ incr(Ctr, self(), 1).
+
+%%% ---------------------------------------------------------------------------
+%%% # read(Contribs)
+%%%
+%%% Description: Retrieve counters for the specified contributors.
+%%% ---------------------------------------------------------------------------
+
+-spec read([contrib()])
+ -> [{contrib(), [{counter(), integer()}]}].
+
+read(Contribs) ->
+ lists:foldl(fun(?REC({T,C}, N), D) -> orddict:append(C, {T,N}, D) end,
+ orddict:new(),
+ ets:select(?TABLE, [{?REC({'_', '$1'}, '_'),
+ [?ORCOND([{'=:=', '$1', {const, C}}
+ || C <- Contribs])],
+ ['$_']}])).
+
+%%% ---------------------------------------------------------------------------
+%%% # flush(Contrib)
+%%%
+%%% Description: Retrieve and delete statistics for the specified
+%%% contributor.
+%%%
+%%% If Contrib is a pid registered with reg/2 then statistics
+%%% for both and its associated contributor are retrieved.
+%%% ---------------------------------------------------------------------------
+
+-spec flush(contrib())
+ -> [{counter(), integer()}].
+
+flush(Contrib) ->
+ try
+ call({flush, Contrib})
+ catch
+ exit: _ ->
+ []
+ end.
+
+flush() ->
+ flush(self()).
+
+%%% ---------------------------------------------------------
+%%% EXPORTED INTERNAL FUNCTIONS
+%%% ---------------------------------------------------------
+
+start_link() ->
+ ServerName = {local, ?SERVER},
+ Module = ?MODULE,
+ Args = [],
+ Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}],
+ gen_server:start_link(ServerName, Module, Args, Options).
+
+state() ->
+ call(state).
+
+uptime() ->
+ call(uptime).
+
+%%% ----------------------------------------------------------
+%%% # init(_)
+%%%
+%%% Output: {ok, State}
+%%% ----------------------------------------------------------
+
+init([]) ->
+ ets:new(?TABLE, [named_table, ordered_set, public]),
+ {ok, #state{}}.
+
+%% ----------------------------------------------------------
+%% handle_call(Request, From, State)
+%% ----------------------------------------------------------
+
+handle_call(state, _, State) ->
+ {reply, State, State};
+
+handle_call(uptime, _, #state{id = Time} = State) ->
+ {reply, diameter_lib:now_diff(Time), State};
+
+handle_call({reg, Pid, Contrib}, _From, State) ->
+ monitor(not ets:member(?TABLE, Pid), Pid),
+ {reply, insert(?REC(Pid, Contrib)), State};
+
+handle_call({flush, Contrib}, _From, State) ->
+ {reply, fetch(Contrib), State};
+
+handle_call(Req, From, State) ->
+ ?UNEXPECTED([Req, From]),
+ {reply, nok, State}.
+
+%% ----------------------------------------------------------
+%% handle_cast(Request, State)
+%% ----------------------------------------------------------
+
+handle_cast({incr, Rec}, State) ->
+ update_counter(Rec),
+ {noreply, State};
+
+handle_cast(Msg, State) ->
+ ?UNEXPECTED([Msg]),
+ {noreply, State}.
+
+%% ----------------------------------------------------------
+%% handle_info(Request, State)
+%% ----------------------------------------------------------
+
+handle_info({'DOWN', _MRef, process, Pid, _}, State) ->
+ down(Pid),
+ {noreply, State};
+
+handle_info(Info, State) ->
+ ?UNEXPECTED([Info]),
+ {noreply, State}.
+
+%% ----------------------------------------------------------
+%% terminate(Reason, State)
+%% ----------------------------------------------------------
+
+terminate(_Reason, _State) ->
+ ok.
+
+%% ----------------------------------------------------------
+%% code_change(OldVsn, State, Extra)
+%% ----------------------------------------------------------
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%% ---------------------------------------------------------
+%%% INTERNAL FUNCTIONS
+%%% ---------------------------------------------------------
+
+%% monitor/2
+
+monitor(true, Pid) ->
+ erlang:monitor(process, Pid);
+monitor(false = No, _) ->
+ No.
+
+%% down/1
+
+down(Pid) ->
+ L = ets:match_object(?TABLE, ?REC({'_', Pid}, '_')),
+ [?REC(_, Ref) = T] = lookup(Pid),
+ fold(Ref, L),
+ delete_object(T),
+ delete(L).
+
+%% Fold Pid-based entries into Ref-based ones.
+fold(Ref, L) ->
+ lists:foreach(fun(?REC({K, _}, V)) -> update_counter({{K, Ref}, V}) end,
+ L).
+
+delete(Objs) ->
+ lists:foreach(fun delete_object/1, Objs).
+
+%% fetch/1
+
+fetch(X) ->
+ MatchSpec = [{?REC({'_', '$1'}, '_'),
+ [?ORCOND([{'==', '$1', {const, T}} || T <- [X | ref(X)]])],
+ ['$_']}],
+ L = ets:select(?TABLE, MatchSpec),
+ delete(L),
+ D = lists:foldl(fun sum/2, dict:new(), L),
+ dict:to_list(D).
+
+sum({{Ctr, _}, N}, Dict) ->
+ dict:update(Ctr, fun(V) -> V+N end, N, Dict).
+
+ref(Pid)
+ when is_pid(Pid) ->
+ ets:select(?TABLE, [{?REC(Pid, '$1'), [], ['$1']}]);
+ref(_) ->
+ [].
+
+%% update_counter/2
+%%
+%% From an arbitrary request process. Cast to the server process to
+%% insert a new element if the counter doesn't exists so that two
+%% processes don't do so simultaneously.
+
+update_counter(Key, N) ->
+ try
+ ets:update_counter(?TABLE, Key, N)
+ catch
+ error: badarg ->
+ cast({incr, ?REC(Key, N)})
+ end.
+
+%% update_counter/1
+%%
+%% From the server process.
+
+update_counter(?REC(Key, N) = T) ->
+ try
+ ets:update_counter(?TABLE, Key, N)
+ catch
+ error: badarg ->
+ insert(T)
+ end.
+
+insert(T) ->
+ ets:insert(?TABLE, T).
+
+lookup(Key) ->
+ ets:lookup(?TABLE, Key).
+
+delete_object(T) ->
+ ets:delete_object(?TABLE, T).
+
+%% cast/1
+
+cast(Msg) ->
+ gen_server:cast(?SERVER, Msg).
+
+%% call/1
+
+call(Request) ->
+ gen_server:call(?SERVER, Request, infinity).
diff --git a/lib/diameter/src/base/diameter_sup.erl b/lib/diameter/src/base/diameter_sup.erl
new file mode 100644
index 0000000000..e5afd23dcd
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_sync.erl b/lib/diameter/src/base/diameter_sync.erl
new file mode 100644
index 0000000000..ce2db4b3a2
--- /dev/null
+++ b/lib/diameter/src/base/diameter_sync.erl
@@ -0,0 +1,550 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% This module implements a server that serializes requests in named
+%% queues. A request is an MFA or fun and a name can be any term. A
+%% request is applied in a dedicated process that terminates when
+%% the request function returns.
+%%
+
+-module(diameter_sync).
+-behaviour(gen_server).
+
+-export([call/4, call/5,
+ cast/4, cast/5,
+ carp/1, carp/2]).
+
+%% supervisor callback
+-export([start_link/0]).
+
+%% gen_server interface
+-export([init/1,
+ terminate/2,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ code_change/3]).
+
+%% test/debug
+-export([state/0,
+ uptime/0,
+ flush/1,
+ pending/0,
+ pending/1,
+ queues/0,
+ pids/1]).
+
+-include("diameter_internal.hrl").
+
+%% Locally registered server name.
+-define(SERVER, ?MODULE).
+
+%% Message to the server to queue a request ...
+-define(REQUEST(CallOrCast, Name, Req, Max, Timeout),
+ {request, CallOrCast, Name, Req, Max, Timeout}).
+
+%% ... and to retrieve the pid of the prevailing request process.
+-define(CARP(Name),
+ {carp, Name}).
+
+%% Forever ...
+-define(TIMEOUT, 30000).
+
+%% Server state.
+-record(state,
+ {time = now(),
+ pending = 0 :: non_neg_integer(), %% outstanding requests
+ monitor = new() :: ets:tid(), %% MonitorRef -> {Name, From}
+ queue = new() :: ets:tid()}). %% Name -> queue of {Pid, Ref}
+
+%% ----------------------------------------------------------
+%% # call(Node, Name, Req, Max, Timeout)
+%% # call(Name, Req, Max, Timeout)
+%%
+%% Input: Name = term() identifying the queue in which the request is
+%% to be evaluated.
+%% Req = {M,F,A}
+%% | {Fun, Arg}
+%% | [Fun | Args]
+%% | Fun
+%% Max = Upper bound for the number of outstanding requests
+%% in the named queue for Req to be queued.
+%% If more than this number are in the queue then
+%% 'rejected' is returned to the caller. Can be any
+%% term but integer() | infinity is sufficient.
+%% Timeout = 32 bit integer() number of milliseconds after which
+%% request is cancelled (if not already started), causing
+%% 'timeout' to be returned to the caller.
+%% | infinity
+%%
+%% Output: Req() | rejected | timeout
+%%
+%% Description: Serialize a request in a named queue. Note that if
+%% 'timeout' is returned and the request itself does not
+%% return this atom then request has not been evaluated.
+%% ----------------------------------------------------------
+
+call(Name, Req, Max, Timeout) ->
+ call(node(), Name, Req, Max, Timeout).
+
+call(Node, Name, Req, Max, Timeout) ->
+ gen_call({?SERVER, Node}, ?REQUEST(call, Name, Req, Max, Timeout)).
+
+%%% ----------------------------------------------------------
+%%% # cast(Node, Name, Req, Max, Timeout)
+%%% # cast(Name, Req, Max, Timeout)
+%%%
+%%% Output: ok | rejected | timeout
+%%%
+%%% Description: Serialize a request without returning the result to the
+%%% caller. Returns after the task is queued.
+%%% ----------------------------------------------------------
+
+cast(Name, Req, Max, Timeout) ->
+ cast(node(), Name, Req, Max, Timeout).
+
+cast(Node, Name, Req, Max, Timeout) ->
+ gen_call({?SERVER, Node}, ?REQUEST(cast, Name, Req, Max, Timeout)).
+
+%% 'timeout' is only return if the server process that processes
+%% requests isn't alive. Ditto for call/carp.
+
+%%% ----------------------------------------------------------
+%%% # carp(Node, Name)
+%%% # carp(Name)
+%%%
+%%% Output: {value, Pid} | false | timeout
+%%%
+%%% Description: Return the pid of the process processing the task
+%%% at the head of the named queue. Note that the value
+%%% returned by subsequent calls changes as tasks are
+%%% completed, each task executing in a dedicated
+%%% process. The exit value of this process will be
+%%% {value, Req()} if the task returns.
+%%% ----------------------------------------------------------
+
+%% The intention of this is to let a process enqueue a task that waits
+%% for a message before completing, the target pid being retrieved
+%% with carp/[12].
+
+carp(Name) ->
+ carp(node(), Name).
+
+carp(Node, Name) ->
+ gen_call({?SERVER, Node}, ?CARP(Name)).
+
+%%% ---------------------------------------------------------
+%%% EXPORTED INTERNAL FUNCTIONS
+%%% ---------------------------------------------------------
+
+state() ->
+ call(state).
+
+uptime() ->
+ call(uptime).
+
+flush(Name) ->
+ call({flush, Name}).
+
+pending() ->
+ call(pending).
+
+pending(Name) ->
+ call({pending, Name}).
+
+queues() ->
+ call(queues).
+
+pids(Name) ->
+ call({pids, Name}).
+
+%%% ----------------------------------------------------------
+%%% # start_link()
+%%% ----------------------------------------------------------
+
+start_link() ->
+ ServerName = {local, ?SERVER},
+ Module = ?MODULE,
+ Args = [],
+ Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}],
+ gen_server:start_link(ServerName, Module, Args, Options).
+
+%%% ----------------------------------------------------------
+%%% # init(_)
+%%% ----------------------------------------------------------
+
+init(_) ->
+ {ok, #state{}}.
+
+%%% ----------------------------------------------------------
+%%% # handle_call(Request, From, State)
+%%% ----------------------------------------------------------
+
+%% Enqueue a new request.
+handle_call(?REQUEST(Type, Name, Req, Max, Timeout),
+ From,
+ #state{queue = QD} = State) ->
+ T = find(Name, QD),
+ nq(queued(T) =< Max, T, {Type, From}, Name, Req, Timeout, State);
+
+handle_call(Request, From, State) ->
+ {reply, call(Request, From, State), State}.
+
+%% call/3
+
+call(?CARP(Name), _, #state{queue = QD}) ->
+ pcar(find(Name, QD));
+
+call(state, _, State) ->
+ State;
+
+call(uptime, _, #state{time = T}) ->
+ diameter_lib:now_diff(T);
+
+call({flush, Name}, _, #state{queue = QD}) ->
+ cancel(find(Name, QD));
+
+call(pending, _, #state{pending = N}) ->
+ N;
+
+call({pending, Name}, _, #state{queue = QD}) ->
+ queued(find(Name, QD));
+
+call(queues, _, #state{queue = QD}) ->
+ fetch_keys(QD);
+
+call({pids, Name}, _, #state{queue = QD}) ->
+ plist(find(Name, QD));
+
+call(Req, From, _State) -> %% ignore
+ ?UNEXPECTED(handle_call, [Req, From]),
+ nok.
+
+%%% ----------------------------------------------------------
+%%% handle_cast(Request, State)
+%%% ----------------------------------------------------------
+
+handle_cast(Msg, State) ->
+ ?UNEXPECTED([Msg]),
+ {noreply, State}.
+
+%%% ----------------------------------------------------------
+%%% handle_info(Request, State)
+%%% ----------------------------------------------------------
+
+handle_info(Request, State) ->
+ {noreply, info(Request, State)}.
+
+%% info/2
+
+%% A request has completed execution or timed out.
+info({'DOWN', MRef, process, Pid, Info},
+ #state{pending = N,
+ monitor = MD,
+ queue = QD}
+ = State) ->
+ {Name, From} = fetch(MRef, MD),
+ reply(From, rc(Info)),
+ State#state{pending = N-1,
+ monitor = erase(MRef, MD),
+ queue = dq(fetch(Name, QD), Pid, Info, Name, QD)};
+
+info(Info, State) ->
+ ?UNEXPECTED(handle_info, [Info]),
+ State.
+
+reply({call, From}, T) ->
+ gen_server:reply(From, T);
+reply(cast, _) ->
+ ok.
+
+rc({value, T}) ->
+ T;
+rc(_) ->
+ timeout.
+
+%%% ----------------------------------------------------------
+%%% code_change(OldVsn, State, Extra)
+%%% ----------------------------------------------------------
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%% ----------------------------------------------------------
+%%% terminate(Reason, State)
+%%% ----------------------------------------------------------
+
+terminate(_Reason, _State)->
+ ok.
+
+%%% ---------------------------------------------------------
+%%% INTERNAL FUNCTIONS
+%%% ---------------------------------------------------------
+
+%% queued/1
+
+queued({ok, {N,_}}) ->
+ N;
+queued(error) ->
+ 0.
+
+%% nq/7
+
+%% Maximum number of pending requests exceeded ...
+nq(false, _, _, _Name, _Req, _Timeout, State) ->
+ {reply, rejected, State};
+
+%% ... or not.
+nq(true, T, From, Name, Req, Timeout, #state{pending = N,
+ monitor = MD,
+ queue = QD}
+ = State) ->
+ Ref = make_ref(),
+ Pid = init(Ref, Req, timeout(Timeout, T)),
+ MRef = erlang:monitor(process, Pid),
+ {noreply, State#state{pending = N+1,
+ monitor = store(MRef, {Name, from(From)}, MD),
+ queue = store(Name, nq(T, {Pid, Ref}), QD)}}.
+
+from({call, _} = T) ->
+ T;
+from({cast = T, From}) ->
+ gen_server:reply(From, ok),
+ T.
+
+%% nq/2
+
+%% Other requests in the queue: append.
+nq({ok, {N,Q}}, T) ->
+ {N+1, queue:in(T,Q)};
+
+%% Queue is empty: start execution.
+nq(error, T) ->
+ go(T),
+ {1, queue:from_list([T])}.
+
+%% Don't timeout if the request is evaluated immediately so as to
+%% avoid a race between getting a 'go' and a 'timeout'. Queueing a
+%% request in an empty queue always results in execution.
+timeout(_, error) ->
+ infinity;
+timeout(Timeout, _) ->
+ Timeout.
+
+%% dq/5
+%%
+%% A request process has terminated.
+
+dq({N,Q}, Pid, _Info, Name, QD) ->
+ {{value, T}, TQ} = queue:out(Q),
+ dq(N-1, Pid, T, TQ, Name, QD).
+
+%% dq/6
+
+%% Request was at the head of the queue: start another.
+dq(N, Pid, {Pid, _}, TQ, Name, QD) ->
+ dq(N, TQ, Name, QD);
+
+%% Or not: remove the offender from the queue.
+dq(N, Pid, T, TQ, Name, QD) ->
+ store(Name, {N, req(Pid, queue:from_list([T]), TQ)}, QD).
+
+%% dq/4
+
+%% Queue is empty: erase.
+dq(0, TQ, Name, QD) ->
+ true = queue:is_empty(TQ), %% assert
+ erase(Name, QD);
+
+%% Start the next request.
+dq(N, TQ, Name, QD) ->
+ go(queue:head(TQ)),
+ store(Name, {N, TQ}, QD).
+
+%% req/3
+%%
+%% Find and remove the queue element for the specified pid.
+
+req(Pid, HQ, Q) ->
+ {{value, T}, TQ} = queue:out(Q),
+ req(Pid, T, HQ, TQ).
+
+req(Pid, {Pid, _}, HQ, TQ) ->
+ queue:join(HQ, TQ);
+req(Pid, T, HQ, TQ) ->
+ req(Pid, queue:in(T,HQ), TQ).
+
+%% go/1
+
+go({Pid, Ref}) ->
+ Pid ! {Ref, ok}.
+
+%% init/4
+%%
+%% Start the dedicated process for handling a request. The exit value
+%% is as promised by carp/1.
+
+init(Ref, Req, Timeout) ->
+ spawn(fun() -> exit(i(Ref, Req, Timeout)) end).
+
+i(Ref, Req, Timeout) ->
+ Timer = send_timeout(Ref, Timeout),
+ MRef = erlang:monitor(process, ?SERVER),
+ receive
+ {Ref, ok} -> %% Do the deed.
+ %% Ensure we don't leave messages in the mailbox since the
+ %% request itself might receive. Alternatively, could have
+ %% done the eval in a new process but then we'd have to
+ %% relay messages arriving at this one.
+ cancel_timer(Timer),
+ erlang:demonitor(MRef, [flush]),
+ %% Ref is to ensure that we don't extract any message that
+ %% a client may have sent after retrieving self() with
+ %% carp/1, there being no guarantee that the message
+ %% banged by go/1 is received before the pid becomes
+ %% accessible.
+ {value, eval(Req)};
+ {Ref, timeout = T} ->
+ T;
+ {'DOWN', MRef, process, _Pid, _Info} = D -> %% server death
+ D
+ end.
+
+send_timeout(_Ref, infinity = No) ->
+ No;
+send_timeout(Ref, Ms) ->
+ Msg = {Ref, timeout},
+ TRef = erlang:send_after(Ms, self(), Msg),
+ {TRef, Msg}.
+
+cancel_timer(infinity = No) ->
+ No;
+cancel_timer({TRef, Msg}) ->
+ flush(Msg, erlang:cancel_timer(TRef)).
+
+flush(Msg, false) -> %% Message has already been sent ...
+ %% 'error' should never happen but crash if it does so as not to
+ %% hang the process.
+ ok = receive Msg -> ok after ?TIMEOUT -> error end;
+flush(_, _) -> %% ... or not.
+ ok.
+
+eval({M,F,A}) ->
+ apply(M,F,A);
+eval([Fun | Args]) ->
+ apply(Fun, Args);
+eval({Fun, A}) ->
+ Fun(A);
+eval(Fun) ->
+ Fun().
+
+%% pcar/1
+
+pcar({ok, {_,Q}}) ->
+ {Pid, _Ref} = queue:head(Q),
+ {value, Pid};
+pcar(error) ->
+ false.
+
+%% plist/1
+
+plist({ok, {_,Q}}) ->
+ lists:map(fun({Pid, _Ref}) -> Pid end, queue:to_list(Q));
+plist(error) ->
+ [].
+
+%% cancel/1
+%%
+%% Cancel all but the active request from the named queue. Return the
+%% number of requests cancelled.
+
+%% Just send timeout messages to each request to make them die. Note
+%% that these are guaranteed to arrive before a go message after the
+%% current request completes since both messages are sent from the
+%% server process.
+cancel({ok, {N,Q}}) ->
+ {_,TQ} = queue:split(1,Q),
+ foreach(fun({Pid, Ref}) -> Pid ! {Ref, timeout} end, N-1, TQ),
+ N-1;
+cancel(error) ->
+ 0.
+
+%% foreach/3
+
+foreach(_, 0, _) ->
+ ok;
+foreach(Fun, N, Q) ->
+ Fun(queue:head(Q)),
+ foreach(Fun, N-1, queue:tail(Q)).
+
+%% call/1
+
+%% gen_server:call/3 will exit if the target process dies.
+call(Request) ->
+ try
+ gen_server:call(?SERVER, Request, ?TIMEOUT)
+ catch
+ exit: Reason ->
+ {error, Reason}
+ end.
+
+%% dict-like table manipulation.
+
+erase(Key, Dict) ->
+ ets:delete(Dict, Key),
+ Dict.
+
+fetch(Key, Dict) ->
+ {ok, V} = find(Key, Dict),
+ V.
+
+fetch_keys(Dict) ->
+ ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict).
+
+find(Key, Dict) ->
+ case ets:lookup(Dict, Key) of
+ [{Key, V}] ->
+ {ok, V};
+ [] ->
+ error
+ end.
+
+new() ->
+ ets:new(?MODULE, [set]).
+
+store(Key, Value, Dict) ->
+ store({Key, Value}, Dict).
+
+store({_,_} = T, Dict) ->
+ ets:insert(Dict, T),
+ Dict.
+
+%% gen_call/1
+
+gen_call(Server, Req) ->
+ gen_call(Server, Req, infinity).
+
+gen_call(Server, Req, Timeout) ->
+ try
+ gen_server:call(Server, Req, Timeout)
+ catch
+ exit: _ ->
+ timeout
+ end.
diff --git a/lib/diameter/src/base/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl
new file mode 100644
index 0000000000..6b1b1b8d39
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_types.hrl b/lib/diameter/src/base/diameter_types.hrl
new file mode 100644
index 0000000000..02bf8a74dd
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
new file mode 100644
index 0000000000..b7c1491f4b
--- /dev/null
+++ b/lib/diameter/src/base/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/base/diameter_watchdog_sup.erl b/lib/diameter/src/base/diameter_watchdog_sup.erl
new file mode 100644
index 0000000000..fc837fe4ef
--- /dev/null
+++ b/lib/diameter/src/base/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]}}.