Merge branch 'anders/diameter/callback_redirection/OTP-9777'

* anders/diameter/callback_redirection/OTP-9777:
  Update documentation
  Use diameter_callback in relay and tls suites
  Use diameter_callback in failover suite
  Update app suite
  Smarter diameter_callback

10 files changed, 217 insertions, 87 deletions

diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 2d8edb1301..93e2603c10 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -107,7 +107,9 @@ belonging to the application.</p>
 <marker id="application_module"/>
 </item>
 
-<tag><c>application_module() = Mod | [Mod | ExtraArgs]</c></tag>
+<tag><c>application_module() = Mod
+                             | [Mod | ExtraArgs]
+                             | #diameter_callback{}</c></tag>
 <item>
 <code>
 Mod = atom()
@@ -125,6 +127,14 @@ specified to <seealso marker="#call">call/4</seealso>, in which case
 the call-specific arguments are appended to any specified with the
 callback module.</p>
 
+<p>
+Specifying a <c>#diameter_callback{}</c> record allows individual
+functions to be configured in place of the usual <seealso
+marker="diameter_app">diameter_app(3)</seealso> callbacks, with
+default implementations provided by module <c>diameter_callback</c>
+unless otherwise specified.
+See that module for details.</p>
+
 <marker id="application_opt"/>
 </item>
 
diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl
index 0fa7fd406f..4273262015 100644
--- a/lib/diameter/include/diameter.hrl
+++ b/lib/diameter/include/diameter.hrl
@@ -107,6 +107,21 @@
          transport = sctp,       %% | tcp,
          protocol  = diameter}). %% | radius | 'tacacs+'
 
+%% A diameter_callback record can be specified as an application
+%% module in order to selectively receive callbacks or alter their
+%% form.
+-record(diameter_callback,
+        {peer_up,
+         peer_down,
+         pick_peer,
+         prepare_request,
+         prepare_retransmit,
+         handle_request,
+         handle_answer,
+         handle_error,
+         default,
+         extra = []}).
+
 %% The diameter service and diameter_apps records are only passed
 %% through the transport interface when starting a transport process,
 %% although typically a transport implementation will (and probably
diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
index ecd3d9542a..336f0c1f2d 100644
--- a/lib/diameter/src/base/diameter.erl
+++ b/lib/diameter/src/base/diameter.erl
@@ -73,6 +73,7 @@
               'IPFilterRule'/0,
               'QoSFilterRule'/0]).
 
+-include_lib("diameter/include/diameter.hrl").
 -include("diameter_internal.hrl").
 
 %% ---------------------------------------------------------------------------
@@ -298,7 +299,8 @@ call(SvcName, App, Message) ->
 
 -type app_module()
    :: module()
-    | maybe_improper_list(module(), list()).
+    | maybe_improper_list(module(), list())
+    | #diameter_callback{}.
 
 %% Identifier returned by add_transport/2
 
diff --git a/lib/diameter/src/base/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl
index 6d5c8cdca1..90431099b0 100644
--- a/lib/diameter/src/base/diameter_callback.erl
+++ b/lib/diameter/src/base/diameter_callback.erl
@@ -18,11 +18,58 @@
 %%
 
 %%
-%% A minimal application callback module.
+%% A diameter callback module that can redirect selected callbacks,
+%% providing reasonable default implementations otherwise.
+%%
+%% To order alternate callbacks, configure a #diameter_callback record
+%% as the Diameter application callback in question. The record has
+%% one field for each callback function as well as 'default' and
+%% 'extra' fields. A function-specific field can be set to a
+%% diameter:evaluable() in order to redirect the callback
+%% corresponding to that field, or to 'false' to request the default
+%% callback implemented in this module. If neither of these fields are
+%% set then the 'default' field determines the form of the callback: a
+%% module name results in the usual callback as if the module had been
+%% configured directly as the callback module, a diameter_evaluable()
+%% in a callback applied to the atom-valued callback name and argument
+%% list. For all callbacks not to this module, the 'extra' field is a
+%% list of additional arguments, following arguments supplied by
+%% diameter but preceeding those of the diameter:evaluable() being
+%% applied.
+%%
+%% For example, the following config to diameter:start_service/2, in
+%% an 'application' tuple, would result in only a mymod:peer_down/3
+%% callback, this module implementing the remaining callbacks.
+%%
+%%   {module, #diameter_callback{peer_down = {mymod, down, []}}}
+%%
+%% Equivalently, this can also be specified with a [Mod | Args]
+%% field/value list as follows.
+%%
+%%   {module, [diameter_callback, {peer_down, {mymod, down, []}}]}
+%%
+%% The following would result in this module suppying peer_up and
+%% peer_down callback, others taking place in module mymod.
+%%
+%%   {module, #diameter_callback{peer_up = false,
+%%                               peer_down = false,
+%%                               default = mymod}}
+%%
+%% The following would result in all callbacks taking place as
+%% calls to mymod:diameter/2.
+%%
+%%   {module, #diameter_callback{default = {mymod, diameter, []}}}
+%%
+%% The following are equivalent and result in all callbacks being
+%% provided by this module.
+%%
+%%   {module, #diameter_callback{}}
+%%   {module, diameter_callback}
 %%
 
 -module(diameter_callback).
 
+%% Default callbacks when no aleternate is specified.
 -export([peer_up/3,
          peer_down/3,
          pick_peer/4,
@@ -32,6 +79,16 @@
          handle_answer/4,
          handle_error/4]).
 
+%% Callbacks taking a #diameter_callback record.
+-export([peer_up/4,
+         peer_down/4,
+         pick_peer/5,
+         prepare_request/4,
+         prepare_retransmit/4,
+         handle_request/4,
+         handle_answer/5,
+         handle_error/5]).
+
 -include_lib("diameter/include/diameter.hrl").
 
 %%% ----------------------------------------------------------
@@ -41,51 +98,137 @@
 peer_up(_Svc, _Peer, State) ->
     State.
 
+peer_up(Svc, Peer, State, D) ->
+    cb(peer_up,
+       [Svc, Peer, State],
+       D#diameter_callback.peer_up,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # peer_down/3
 %%% ----------------------------------------------------------
 
-peer_down(_SvcName, _Peer, State) ->
+peer_down(_Svc, _Peer, State) ->
     State.
 
+peer_down(Svc, Peer, State, D) ->
+    cb(peer_down,
+       [Svc, Peer, State],
+       D#diameter_callback.peer_down,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # pick_peer/4
 %%% ----------------------------------------------------------
 
-pick_peer([Peer|_], _, _SvcName, _State) ->
-    {ok, Peer}.
+pick_peer([Peer|_], _, _Svc, _State) ->
+    {ok, Peer};
+pick_peer([], _, _Svc, _State) ->
+    false.
+
+pick_peer(PeersL, PeersR, Svc, State, D) ->
+    cb(pick_peer,
+       [PeersL, PeersR, Svc, State],
+       D#diameter_callback.pick_peer,
+       D).
 
 %%% ----------------------------------------------------------
 %%% # prepare_request/3
 %%% ----------------------------------------------------------
 
-prepare_request(Pkt, _SvcName, _Peer) ->
+prepare_request(Pkt, _Svc, _Peer) ->
     {send, Pkt}.
 
+prepare_request(Pkt, Svc, Peer, D) ->
+    cb(prepare_request,
+       [Pkt, Svc, Peer],
+       D#diameter_callback.prepare_request,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # prepare_retransmit/3
 %%% ----------------------------------------------------------
 
-prepare_retransmit(Pkt, _SvcName, _Peer) ->
+prepare_retransmit(Pkt, _Svc, _Peer) ->
     {send, Pkt}.
 
+prepare_retransmit(Pkt, Svc, Peer, D) ->
+    cb(prepare_retransmit,
+       [Pkt, Svc, Peer],
+       D#diameter_callback.prepare_retransmit,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # handle_request/3
 %%% ----------------------------------------------------------
 
-handle_request(_Pkt, _SvcName, _Peer) ->
+handle_request(_Pkt, _Svc, _Peer) ->
     {protocol_error, 3001}.  %% DIAMETER_COMMAND_UNSUPPORTED
 
+handle_request(Pkt, Svc, Peer, D) ->
+    cb(handle_request,
+       [Pkt, Svc, Peer],
+       D#diameter_callback.handle_request,
+       D).
+
 %%% ----------------------------------------------------------
 %%% # handle_answer/4
 %%% ----------------------------------------------------------
 
-handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) ->
-    Ans.
+handle_answer(#diameter_packet{msg = Ans, errors = []}, _Req, _Svc, _Peer) ->
+    Ans;
+handle_answer(#diameter_packet{msg = Ans, errors = Es}, _Req, _Svc, _Peer) ->
+    [Ans | Es].
+
+handle_answer(Pkt, Req, Svc, Peer, D) ->
+    cb(handle_answer,
+       [Pkt, Req, Svc, Peer],
+       D#diameter_callback.handle_answer,
+       D).
 
 %%% ---------------------------------------------------------------------------
 %%% # handle_error/4
 %%% ---------------------------------------------------------------------------
 
-handle_error(Reason, _Req, _SvcName, _Peer) ->
+handle_error(Reason, _Req, _Svc, _Peer) ->
     {error, Reason}.
+
+handle_error(Reason, Req, Svc, Peer, D) ->
+    cb(handle_error,
+       [Reason, Req, Svc, Peer],
+       D#diameter_callback.handle_error,
+       D).
+
+%% ===========================================================================
+
+%% cb/4
+
+%% Unspecified callback: use default field to determine something
+%% appropriate.
+cb(CB, Args, undefined, D) ->
+    cb(CB, Args, D);
+
+%% Explicitly requested default.
+cb(CB, Args, false, _) ->
+    apply(?MODULE, CB, Args);
+
+%% A specified callback.
+cb(_, Args, F, #diameter_callback{extra = X}) ->
+    diameter_lib:eval([[F|X] | Args]).
+
+%% cb/3
+
+%% No user-supplied default: call ours.
+cb(CB, Args, #diameter_callback{default = undefined}) ->
+    apply(?MODULE, CB, Args);
+
+%% Default is a module name: make the usual callback.
+cb(CB, Args, #diameter_callback{default = M,
+                                extra = X})
+  when is_atom(M) ->
+    apply(M, CB, Args ++ X);
+
+%% Default is something else: apply if to callback name and arguments.
+cb(CB, Args, #diameter_callback{default = F,
+                                extra = X}) ->
+    diameter_lib:eval([F, CB, Args | X]).
diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl
index a6b48fe65b..9253af0de2 100644
--- a/lib/diameter/src/base/diameter_config.erl
+++ b/lib/diameter/src/base/diameter_config.erl
@@ -605,6 +605,13 @@ app_acc({application, Opts}, Acc) ->
 app_acc(_, Acc) ->
     Acc.
 
+init_mod(#diameter_callback{} = R) ->
+    init_mod([diameter_callback, R]);
+init_mod([diameter_callback, #diameter_callback{}] = L) ->
+    L;
+init_mod([diameter_callback = M | L])
+  when is_list(L) ->
+    [M, init_cb(L)];
 init_mod(M)
   when is_atom(M) ->
     [M];
@@ -614,6 +621,14 @@ init_mod([M|_] = L)
 init_mod(M) ->
     ?THROW({module, M}).
 
+init_cb(List) ->
+    Fields = record_info(fields, diameter_callback),
+    Defaults = lists:zip(Fields, tl(tuple_to_list(#diameter_callback{}))),
+    Values = [V || F <- Fields,
+                   D <- [proplists:get_value(F, Defaults)],
+                   V <- [proplists:get_value(F, List, D)]],
+    #diameter_callback{} = list_to_tuple([diameter_callback | Values]).
+
 init_mutable(M)
   when M == true;
        M == false ->
diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk
index d3125a7b57..c5d448b2ff 100644
--- a/lib/diameter/src/modules.mk
+++ b/lib/diameter/src/modules.mk
@@ -32,6 +32,7 @@ DICT_YRL = \
 RT_MODULES = \
 	base/diameter \
 	base/diameter_app \
+	base/diameter_callback \
 	base/diameter_capx \
 	base/diameter_config \
 	base/diameter_codec \
@@ -61,7 +62,6 @@ RT_MODULES = \
 
 # Handwritten (compile time) modules not included in the app file.
 CT_MODULES = \
-	base/diameter_callback \
 	base/diameter_dbg \
 	base/diameter_info \
 	compiler/diameter_codegen \
diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl
index 7da145fb3b..808f2cd30d 100644
--- a/lib/diameter/test/diameter_app_SUITE.erl
+++ b/lib/diameter/test/diameter_app_SUITE.erl
@@ -50,8 +50,7 @@
                            diameter_exprecs,
                            diameter_make]).
 
--define(HELP_MODULES, [diameter_callback,
-                       diameter_dbg,
+-define(HELP_MODULES, [diameter_dbg,
                        diameter_info]).
 
 %% ===========================================================================
diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl
index aef2447587..429b6328e6 100644
--- a/lib/diameter/test/diameter_failover_SUITE.erl
+++ b/lib/diameter/test/diameter_failover_SUITE.erl
@@ -48,13 +48,9 @@
          stop/1]).
 
 %% diameter callbacks
--export([peer_up/3,
-         peer_down/3,
-         pick_peer/4,
+-export([pick_peer/4,
          prepare_request/3,
-         prepare_retransmit/3,
          handle_answer/4,
-         handle_error/4,
          handle_request/3]).
 
 -include("diameter.hrl").
@@ -90,7 +86,12 @@
          {'Acct-Application-Id', [Dict:id()]},
          {application, [{alias, ?APP_ALIAS},
                         {dictionary, Dict},
-                        {module, ?MODULE},
+                        {module, #diameter_callback
+                                  {peer_up = false,
+                                   peer_down = false,
+                                   handle_error = false,
+                                   prepare_retransmit = false,
+                                   default = ?MODULE}},
                         {answer_errors, callback}]}]).
 
 -define(SUCCESS, 2001).
@@ -180,16 +181,6 @@ set([H|T], Vs) ->
 %% ===========================================================================
 %% diameter callbacks
 
-%% peer_up/3
-
-peer_up(_SvcName, _Peer, State) ->
-    State.
-
-%% peer_down/3
-
-peer_down(_SvcName, _Peer, State) ->
-    State.
-
 %% pick_peer/4
 
 %% Choose a server other than SERVER3 or SERVER5 if possible.
@@ -218,22 +209,12 @@ prepare(#diameter_packet{msg = Req}, Caps) ->
               {'Origin-Host',  OH},
               {'Origin-Realm', OR}]).
 
-%% prepare_retransmit/3
-
-prepare_retransmit(Pkt, ?CLIENT, _Peer) ->
-    {send, Pkt}.
-
 %% handle_answer/4
 
 handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
     #diameter_packet{msg = Rec, errors = []} = Pkt,
     Rec.
 
-%% handle_error/4
-
-handle_error(Reason, _Req, ?CLIENT, _Peer) ->
-    {error, Reason}.
-
 %% handle_request/3
 
 %% Only SERVER3 actually answers.
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
index b8e194ba9e..c0351f8cf2 100644
--- a/lib/diameter/test/diameter_relay_SUITE.erl
+++ b/lib/diameter/test/diameter_relay_SUITE.erl
@@ -55,13 +55,10 @@
          stop/1]).
 
 %% diameter callbacks
--export([peer_up/3,
-         peer_down/3,
-         pick_peer/4,
+-export([pick_peer/4,
          prepare_request/3,
          prepare_retransmit/3,
          handle_answer/4,
-         handle_error/4,
          handle_request/3]).
 
 -include("diameter.hrl").
@@ -101,7 +98,10 @@
          {'Acct-Application-Id', [Dict:id()]},
          {application, [{alias, ?APP_ALIAS},
                         {dictionary, Dict},
-                        {module, ?MODULE},
+                        {module, #diameter_callback{peer_up = false,
+                                                    peer_down = false,
+                                                    handle_error = false,
+                                                    default = ?MODULE}},
                         {answer_errors, callback}]}]).
 
 -define(SUCCESS, 2001).
@@ -255,16 +255,6 @@ set([H|T], Vs) ->
 %% ===========================================================================
 %% diameter callbacks
 
-%% peer_up/3
-
-peer_up(_SvcName, _Peer, State) ->
-    State.
-
-%% peer_down/3
-
-peer_down(_SvcName, _Peer, State) ->
-    State.
-
 %% pick_peer/4
 
 pick_peer([Peer | _], _, Svc, _State)
@@ -308,11 +298,6 @@ handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
     #diameter_packet{msg = Rec, errors = []} = Pkt,
     Rec.
 
-%% handle_error/4
-
-handle_error(Reason, _Req, _Svc, _Peer) ->
-    {error, Reason}.
-
 %% handle_request/3
 
 handle_request(Pkt, OH, {_Ref, #diameter_caps{origin_host = {OH,_}} = Caps})
diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl
index 4abc7bb23f..7854411d2e 100644
--- a/lib/diameter/test/diameter_tls_SUITE.erl
+++ b/lib/diameter/test/diameter_tls_SUITE.erl
@@ -58,13 +58,9 @@
          stop_ssl/1]).
 
 %% diameter callbacks
--export([peer_up/3,
-         peer_down/3,
-         pick_peer/4,
-         prepare_request/3,
+-export([prepare_request/3,
          prepare_retransmit/3,
          handle_answer/4,
-         handle_error/4,
          handle_request/3]).
 
 -include("diameter.hrl").
@@ -104,7 +100,11 @@
          {'Auth-Application-Id', [Dict:id()]},
          {application, [{alias, ?APP_ALIAS},
                         {dictionary, Dict},
-                        {module, ?MODULE},
+                        {module, #diameter_callback{peer_up = false,
+                                                    peer_down = false,
+                                                    pick_peer = false,
+                                                    handle_error = false,
+                                                    default = ?MODULE}},
                         {answer_errors, callback}]}]).
 
 %% Config for diameter:add_transport/2. In the listening case, listen
@@ -245,21 +245,6 @@ send5(_Config) ->
 %% ===========================================================================
 %% diameter callbacks
 
-%% peer_up/3
-
-peer_up(_SvcName, _Peer, State) ->
-    State.
-
-%% peer_down/3
-
-peer_down(_SvcName, _Peer, State) ->
-    State.
-
-%% pick_peer/4
-
-pick_peer([Peer], _, ?CLIENT, _State) ->
-    {ok, Peer}.
-
 %% prepare_request/3
 
 prepare_request(#diameter_packet{msg = Req},
@@ -284,11 +269,6 @@ handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
     #diameter_packet{msg = Rec, errors = []} = Pkt,
     Rec.
 
-%% handle_error/4
-
-handle_error(Reason, _Req, ?CLIENT, _Peer) ->
-    {error, Reason}.
-
 %% handle_request/3
 
 handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}},