Merge branch 'anders/diameter/capx_vs_dpr/OTP-14338'

* anders/diameter/capx_vs_dpr/OTP-14338:
  Let candidate peers be passed to diameter:call/4
  Comment on RFC ambiguity regarding application identifiers
  Remove trailing whitespace

9 files changed, 187 insertions, 50 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_capx.erl b/lib/diameter/src/base/diameter_capx.erl
index 837125339a..62b05644b2 100644
--- a/lib/diameter/src/base/diameter_capx.erl
+++ b/lib/diameter/src/base/diameter_capx.erl
@@ -416,7 +416,48 @@ bcaps(N, Caps) ->
 %% common_applications/3
 %%
 %% Identify the (local) applications to be supported on the connection
-%% in question.
+%% in question. The RFC says this:
+%%
+%% 2.4 Application Identifiers
+%%
+%%    Relay and redirect agents MUST advertise the Relay Application ID,
+%%    while all other Diameter nodes MUST advertise locally supported
+%%    applications.
+%%
+%% Taken literally, every Diameter node should then advertise support
+%% for the Diameter common messages application, with id 0, since no
+%% node can perform capabilities exchange without it. Expecting this,
+%% or regarding the support as implicit, renders the Result-Code 5010
+%% (DIAMETER_NO_COMMON_APPLICATION) meaningless however, since every
+%% node would regard the common application as being in common with
+%% the peer. In practice, nodes may or may not advertise support for
+%% Diameter common messages.
+%%
+%% That only explicitly advertised applications should be considered
+%% when computing the intersection with the peer is supported here:
+%%
+%% 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 Ids against all of the
+%%    Application-Id AVPs (Auth-Application-Id, Acct-Application-Id, and
+%%    Vendor-Specific-Application-Id) present in the CER.
+%%
+%% The same section also has the following about capabilities exchange
+%% messages.
+%%
+%%    The receiver only issues commands to its peers that have advertised
+%%    support for the Diameter application that defines the command.
+%%
+%% This statement is also difficult to interpret literally since it
+%% would disallow D[WP]R and more when Diameter common messages isn't
+%% advertised. In practice, diameter lets requests be sent as long as
+%% there's a dictionary configured to support it, peer selection by
+%% advertised application being possible to preempt by passing
+%% candidate peers directly to diameter:call/4. The peer can always
+%% answer 3001 (DIAMETER_COMMAND_UNSUPPORTED) or 3007
+%% (DIAMETER_APPLICATION_UNSUPPORTED) if this is objectionable.
 
 common_applications(LCaps, RCaps, #diameter_service{applications = Apps}) ->
     LA = app_union(LCaps),
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index 8e383818ea..a976a8b998 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 af7ac10f13..85378babea 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()}).
@@ -1305,36 +1306,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}).
 
 %% ---------------------------------------------------------------------------
@@ -1684,8 +1690,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
diff --git a/lib/diameter/test/diameter_gen_sctp_SUITE.erl b/lib/diameter/test/diameter_gen_sctp_SUITE.erl
index d76d2bdbd3..ccee6baec1 100644
--- a/lib/diameter/test/diameter_gen_sctp_SUITE.erl
+++ b/lib/diameter/test/diameter_gen_sctp_SUITE.erl
@@ -393,7 +393,7 @@ stat(T4, <<?MAGIC, Bin/binary>>) ->
 mark(Bin, T) ->
     Info = term_to_binary([diameter_lib:now() | T]),
     <<Info/binary, Bin/binary>>.
-    
+
 %% unmark/1
 
 unmark(Bin) ->
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
index 5353688bf4..5d74e63b8d 100644
--- a/lib/diameter/test/diameter_relay_SUITE.erl
+++ b/lib/diameter/test/diameter_relay_SUITE.erl
@@ -302,7 +302,7 @@ stats(?RELAY1, L) ->
                              %% RAR x 2 (send_timeout_[12])
      {{{0,257,0},recv},3},   %% CEA
      {{{0,257,0},send},1},   %%  "
-     {{{0,257,1},recv},1},   %% CER 
+     {{{0,257,1},recv},1},   %% CER
      {{{0,257,1},send},3},   %%  "
      {{{relay,0},recv,{'Result-Code',2001}},2},  %% STA x 2 (send[34])
      {{{relay,0},recv,{'Result-Code',3005}},1},  %% ASA     (send_loop)
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 871a27f8b1..84b41f14b7 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -455,7 +455,7 @@ add_transports(Config) ->
            server_service = SN,
            server_sender = SS,
            server_throttle = ST}
-        = group(Config), 
+        = group(Config),
     LRef = ?util:listen(SN,
                         [T,
                          {sender, SS},