Let candidate peers be passed to diameter:call/4

To solve the problem of being able to send messages to a peer that
hasn't advertised support for the application in question, as discussed
in the parent commit. diameter:call/4 can be passed 'peer' options to
identify candidates, and the only requirement is that an appropriate
dictionary be configured for encode. Filters are applied as if
candidates had been selected by advertised application.

5 files changed, 142 insertions, 46 deletions

diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 72181a42b0..2cbe48ecce 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -21,7 +21,7 @@
 
 <copyright>
 <year>2011</year>
-<year>2016</year>
+<year>2017</year>
 <holder>Ericsson AB. All Rights Reserved.</holder>
 </copyright>
 <legalnotice>
@@ -300,6 +300,17 @@ corresponding list of filters.
 Defaults to <c>none</c>.</p>
 </item>
 
+<tag><c>{peer, &app_peer_ref;}</c></tag>
+<item>
+<p>
+Peer to which the request in question can be sent, preempting the
+selection of peers having advertised support for the Diameter
+application in question.
+Multiple options can be specified, and their order is
+respected in the candidate lists passed to a subsequent
+&app_pick_peer; callback.</p>
+</item>
+
 <tag><c>{timeout, &dict_Unsigned32;}</c></tag>
 <item>
 <p>
diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
index 253f64133c..bd92e16fba 100644
--- a/lib/diameter/src/base/diameter.erl
+++ b/lib/diameter/src/base/diameter.erl
@@ -406,4 +406,5 @@ call(SvcName, App, Message) ->
    :: {extra, list()}
     | {filter, peer_filter()}
     | {timeout, 'Unsigned32'()}
+    | {peer, peer_ref()}
     | detach.
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index be50e87179..4fc49309b5 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -282,7 +282,8 @@ whois(SvcName) ->
                   | {alias, diameter:app_alias()},
       Opts :: {fun((Dict :: module()) -> [term()]),
                diameter:peer_filter(),
-               Xtra :: list()},
+               Xtra :: list(),
+               [diameter:peer_ref()]},
       TPid :: pid(),
       Caps :: #diameter_caps{},
       App  :: #diameter_app{},
@@ -310,10 +311,10 @@ pick(#state{options = SvcOpts}
      = S,
      #diameter_app{module = ModX, dictionary = Dict}
      = App0,
-     {DestF, Filter, Xtra}) ->
+     {DestF, Filter, Xtra, TPids}) ->
     App = App0#diameter_app{module = ModX ++ Xtra},
     [_,_] = RealmAndHost = diameter_lib:eval([DestF, Dict]),
-    case pick_peer(App, RealmAndHost, Filter, S) of
+    case pick_peer(App, RealmAndHost, [Filter | TPids], S) of
         {_TPid, _Caps} = TC ->
             {{TC, App}, SvcOpts};
         false = No ->
@@ -1522,8 +1523,14 @@ pick_peer(Local,
 
 %% peers/4
 
-peers(Alias, RH, Filter, T) ->
-    filter(Alias, RH, Filter, T, true).
+%% No peer options pointing at specific peers: search for them.
+peers(Alias, RH, [Filter], T) ->
+    filter(Alias, RH, Filter, T, true);
+
+%% Or just lookup.
+peers(_Alias, RH, [Filter | TPids], {PeerT, _AppT, _IdentT}) ->
+    {Ts, _} = filter(caps(PeerT, TPids), RH, Filter),
+    Ts.
 
 %% filter/5
 %%
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index 54f39afbf0..7a5a3d662a 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -64,7 +64,8 @@
 
 %% Record diameter:call/4 options are parsed into.
 -record(options,
-        {filter = none  :: diameter:peer_filter(),
+        {peers = []     :: [diameter:peer_ref()],
+         filter = none  :: diameter:peer_filter(),
          extra = []     :: list(),
          timeout = 5000 :: 0..16#FFFFFFFF,  %% for outgoing requests
          detach = false :: boolean()}).
@@ -1275,36 +1276,41 @@ send_R(SvcName, AppOrAlias, Msg, CallOpts, Caller) ->
 %% make_options/1
 
 make_options(Options) ->
-    make_opts(Options, false, [], none, 5000).
+    make_opts(Options, [], false, [], none, 5000).
 
 %% Do our own recursion since this is faster than a lists:foldl/3
 %% setting elements in an #options{} accumulator.
 
-make_opts([], Detach, Extra, Filter, Tmo) ->
-    #options{detach = Detach,
+make_opts([], Peers, Detach, Extra, Filter, Tmo) ->
+    #options{peers = lists:reverse(Peers),
+             detach = Detach,
              extra = Extra,
              filter = Filter,
              timeout = Tmo};
 
-make_opts([{timeout, Tmo} | Rest], Detach, Extra, Filter, _)
+make_opts([{timeout, Tmo} | Rest], Peers, Detach, Extra, Filter, _)
   when is_integer(Tmo), 0 =< Tmo ->
-    make_opts(Rest, Detach, Extra, Filter, Tmo);
+    make_opts(Rest, Peers, Detach, Extra, Filter, Tmo);
 
-make_opts([{filter, F} | Rest], Detach, Extra, none, Tmo) ->
-    make_opts(Rest, Detach, Extra, F, Tmo);
-make_opts([{filter, F} | Rest], Detach, Extra, {all, Fs}, Tmo) ->
-    make_opts(Rest, Detach, Extra, {all, [F|Fs]}, Tmo);
-make_opts([{filter, F} | Rest], Detach, Extra, F0, Tmo) ->
-    make_opts(Rest, Detach, Extra, {all, [F0, F]}, Tmo);
+make_opts([{filter, F} | Rest], Peers, Detach, Extra, none, Tmo) ->
+    make_opts(Rest, Peers, Detach, Extra, F, Tmo);
+make_opts([{filter, F} | Rest], Peers, Detach, Extra, {all, Fs}, Tmo) ->
+    make_opts(Rest, Peers, Detach, Extra, {all, [F|Fs]}, Tmo);
+make_opts([{filter, F} | Rest], Peers, Detach, Extra, F0, Tmo) ->
+    make_opts(Rest, Peers, Detach, Extra, {all, [F0, F]}, Tmo);
 
-make_opts([{extra, L} | Rest], Detach, Extra, Filter, Tmo)
+make_opts([{extra, L} | Rest], Peers, Detach, Extra, Filter, Tmo)
   when is_list(L) ->
-    make_opts(Rest, Detach, Extra ++ L, Filter, Tmo);
+    make_opts(Rest, Peers, Detach, Extra ++ L, Filter, Tmo);
 
-make_opts([detach | Rest], _, Extra, Filter, Tmo) ->
-    make_opts(Rest, true, Extra, Filter, Tmo);
+make_opts([detach | Rest], Peers, _, Extra, Filter, Tmo) ->
+    make_opts(Rest, Peers, true, Extra, Filter, Tmo);
 
-make_opts([T | _], _, _, _, _) ->
+make_opts([{peer, TPid} | Rest], Peers, Detach, Extra, Filter, Tmo)
+  when is_pid(TPid) ->
+    make_opts(Rest, [TPid | Peers], Detach, Extra, Filter, Tmo);
+
+make_opts([T | _], _, _, _, _, _) ->
     ?ERROR({invalid_option, T}).
 
 %% ---------------------------------------------------------------------------
@@ -1654,8 +1660,8 @@ pick_peer(_, _, undefined, _) ->
 pick_peer(SvcName,
           AppOrAlias,
           Msg,
-          #options{filter = Filter, extra = Xtra}) ->
-    X = {fun(D) -> get_destination(D, Msg) end, Filter, Xtra},
+          #options{peers = TPids, filter = Filter, extra = Xtra}) ->
+    X = {fun(D) -> get_destination(D, Msg) end, Filter, Xtra, TPids},
     case diameter_service:pick_peer(SvcName, AppOrAlias, X) of
         false ->
             {error, no_connection};
diff --git a/lib/diameter/test/diameter_dpr_SUITE.erl b/lib/diameter/test/diameter_dpr_SUITE.erl
index 55702fbf78..779b919d3c 100644
--- a/lib/diameter/test/diameter_dpr_SUITE.erl
+++ b/lib/diameter/test/diameter_dpr_SUITE.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2012-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2017. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -27,6 +27,8 @@
 -export([suite/0,
          all/0,
          groups/0,
+         init_per_suite/1,
+         end_per_suite/1,
          init_per_group/2,
          end_per_group/2]).
 
@@ -56,16 +58,12 @@
 
 %% Config for diameter:start_service/2.
 -define(SERVICE(Host),
-        [{'Origin-Host', Host},
+        [{'Origin-Host', Host ++ ".erlang.org"},
          {'Origin-Realm', "erlang.org"},
          {'Host-IP-Address', [?ADDR]},
          {'Vendor-Id', hd(Host)},  %% match this in disconnect/5
          {'Product-Name', "OTP/diameter"},
-         {'Acct-Application-Id', [0]},
-         {restrict_connections, false},
-         {application, [{dictionary, diameter_gen_base_rfc6733},
-                        {alias, common},
-                        {module, #diameter_callback{_ = false}}]}]).
+         {restrict_connections, false}]).
 
 %% Disconnect reasons that diameter passes as the first argument of a
 %% function configured as disconnect_cb.
@@ -89,13 +87,19 @@ suite() ->
     [{timetrap, {seconds, 60}}].
 
 all() ->
-    [start, send_dpr, stop | [{group, R} || R <- ?REASONS]].
+    [{group, R} || R <- [client, server, uncommon | ?REASONS]].
 
 %% The group determines how transports are terminated: by remove_transport,
 %% stop_service or application stop.
 groups() ->
-    Ts = tc(),
-    [{R, [], Ts} || R <- ?REASONS].
+    [{R, [], [start, send_dpr, stop]} || R <- [client, server, uncommon]]
+        ++ [{R, [], Ts} || Ts <- [tc()], R <- ?REASONS].
+
+init_per_suite(Config) ->  %% not need, but a useful place to enable trace
+    Config.
+
+end_per_suite(_Config) ->
+    ok.
 
 init_per_group(Name, Config) ->
     [{group, Name} | Config].
@@ -107,29 +111,86 @@ tc() ->
     [start, connect, remove_transport, stop_service, check, stop].
 
 %% ===========================================================================
-%% start/stop testcases
 
-start(_Config) ->
-    ok = diameter:start(),
-    ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)),
-    ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)).
+%% start/1
 
-send_dpr(_Config) ->
+start(Config)
+  when is_list(Config) ->
+    Grp = group(Config),
+    ok = diameter:start(),
+    ok = diameter:start_service(?SERVER, service(?SERVER, Grp)),
+    ok = diameter:start_service(?CLIENT, service(?CLIENT, Grp)).
+
+service(?SERVER = Svc, _) ->
+    ?SERVICE(Svc)
+        ++ [{'Acct-Application-Id', [0,3]},
+            {application, [{dictionary, diameter_gen_base_rfc6733},
+                           {alias, common},
+                           {module, #diameter_callback{_ = false}}]},
+            {application, [{dictionary, diameter_gen_acct_rfc6733},
+                           {alias, acct},
+                           {module, #diameter_callback{_ = false}}]}];
+
+%% Client that receives a server DPR despite no explicit support for
+%% Diameter common messages.
+service(?CLIENT = Svc, server) ->
+    ?SERVICE(Svc)
+        ++ [{'Acct-Application-Id', [3]},
+            {application, [{dictionary, diameter_gen_acct_rfc6733},
+                           {alias, acct},
+                           {module, #diameter_callback{_ = false}}]}];
+
+%% Client that sends DPR despite advertised only the accounting
+%% application. The dictionary is required for encode.
+service(?CLIENT = Svc, uncommon) ->
+    ?SERVICE(Svc)
+        ++ [{'Acct-Application-Id', [3]},
+            {application, [{dictionary, diameter_gen_base_rfc6733},
+                           {alias, common},
+                           {module, #diameter_callback{_ = false}}]},
+            {application, [{dictionary, diameter_gen_acct_rfc6733},
+                           {alias, acct},
+                           {module, #diameter_callback{_ = false}}]}];
+
+service(?CLIENT = Svc, _) ->
+    ?SERVICE(Svc)
+        ++ [{'Auth-Application-Id', [0]},
+            {application, [{dictionary, diameter_gen_base_rfc6733},
+                           {alias, common},
+                           {module, #diameter_callback{_ = false}}]}].
+
+%% send_dpr/1
+
+send_dpr(Config) ->
     LRef = ?util:listen(?SERVER, tcp),
     Ref = ?util:connect(?CLIENT, tcp, LRef, [{dpa_timeout, 10000}]),
+    Svc = sender(group(Config)),
+    [Info] = diameter:service_info(Svc, connections),
+    {_, {TPid, _}} = lists:keyfind(peer, 1, Info),
     #diameter_base_DPA{'Result-Code' = 2001}
-        = diameter:call(?CLIENT,
+        = diameter:call(Svc,
                         common,
-                        ['DPR', {'Origin-Host', "CLIENT.erlang.org"},
-                                {'Origin-Realm', "erlang.org"},
-                                {'Disconnect-Cause', 0}]),
-    ok =  receive  %% endure the transport dies on DPA
+                        ['DPR', {'Origin-Host', Svc ++ ".erlang.org"},
+                         {'Origin-Realm', "erlang.org"},
+                         {'Disconnect-Cause', 0}],
+                        [{peer, TPid}]),
+    ok =  receive  %% ensure the transport dies on DPA
               #diameter_event{service = ?CLIENT, info = {down, Ref, _, _}} ->
                   ok
           after 5000 ->
                   erlang:process_info(self(), messages)
           end.
 
+%% sender/1
+
+sender(server) ->
+    ?SERVER;
+
+sender(_) ->
+    ?CLIENT.
+
+%% connect/1
+
 connect(Config) ->
     Pid = spawn(fun init/0),  %% process for disconnect_cb to bang
     Grp = group(Config),
@@ -138,16 +199,22 @@ connect(Config) ->
             || RCs <- ?RETURNS],
     ?util:write_priv(Config, config, [Pid | Refs]).
 
+%% remove_transport/1
+
 %% Remove all the client transports only in the transport group.
 remove_transport(Config) ->
     transport == group(Config)
         andalso (ok = diameter:remove_transport(?CLIENT, true)).
 
+%% stop_service/1
+
 %% Stop the service only in the service group.
 stop_service(Config) ->
     service == group(Config)
         andalso (ok = diameter:stop_service(?CLIENT)).
 
+%% check/1
+
 %% Check for callbacks before diameter:stop/0, not the other way around
 %% for the timing reason explained below.
 check(Config) ->
@@ -157,9 +224,13 @@ check(Config) ->
     Dict = receive {Pid, D} -> D end,  %% get it
     check(Refs, ?RETURNS, Grp, Dict).  %% check for callbacks
 
+%% stop/1
+
 stop(_Config) ->
     ok = diameter:stop().
 
+%% ===========================================================================
+
 %% Whether or not there are callbacks after diameter:stop() depends on
 %% timing as long as the server runs on the same node: a server
 %% transport could close the connection before the client has chance