aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/test/diameter_traffic_SUITE.erl
diff options
context:
space:
mode:
authorAnders Svensson <[email protected]>2017-08-18 10:58:16 +0200
committerAnders Svensson <[email protected]>2017-08-18 10:58:16 +0200
commitc568b8ac624f39bf5a8d4e66f1db32ea629937f4 (patch)
tree4aa1ec71affb64b433e406caff733277d70c800f /lib/diameter/test/diameter_traffic_SUITE.erl
parent0cf60db18f71f727a28ba726e0338ef41ec17542 (diff)
parentfa233bb7bc4f37632166c468a0381e695433c318 (diff)
downloadotp-c568b8ac624f39bf5a8d4e66f1db32ea629937f4.tar.gz
otp-c568b8ac624f39bf5a8d4e66f1db32ea629937f4.tar.bz2
otp-c568b8ac624f39bf5a8d4e66f1db32ea629937f4.zip
Merge branch 'anders/diameter/codec/OTP-14511' into maint
* anders/diameter/codec/OTP-14511: (26 commits) Limit SCTP testing in traffic suite Increase init_per_group timetrap in traffic suite Add diameter_util:eprof/1 for test Don't search forms unnecessarily in diameter_exprecs parse transform Increase init_per_suite timetrap in traffic suite Don't count AVPs unnecessarily at encode Test decode_format record_from_map in traffic suite Tweak limiting of testcases in traffic suite Don't take length of AVP lists unnecessarily at encode Tweak map-valued decode Rearrange group names in traffic suite Randomly wrap answers in diameter_packet in transport suite Don't exercise client/server encoding independently in traffic suite Add decode_format record_from_map Rename record_decode -> decode_format Create fewer client connections in traffic suite Test record_decode in traffic suite Map answers to maps in traffic suite Test map encoding in traffic suite Let messages and grouped AVPs be decoded to lists ...
Diffstat (limited to 'lib/diameter/test/diameter_traffic_SUITE.erl')
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl811
1 files changed, 531 insertions, 280 deletions
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 84b41f14b7..f05c850513 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -27,15 +27,18 @@
-export([suite/0,
all/0,
groups/0,
+ init_per_suite/0,
init_per_suite/1,
end_per_suite/1,
+ init_per_group/1,
init_per_group/2,
end_per_group/2,
init_per_testcase/2,
end_per_testcase/2]).
%% testcases
--export([start/1,
+-export([rfc4005/1,
+ start/1,
start_services/1,
add_transports/1,
result_codes/1,
@@ -98,14 +101,14 @@
stop/1]).
%% diameter callbacks
--export([peer_up/3,
- peer_down/3,
- pick_peer/6, pick_peer/7,
- prepare_request/5, prepare_request/6,
- prepare_retransmit/5,
- handle_answer/6, handle_answer/7,
- handle_error/6,
- handle_request/3]).
+-export([peer_up/4,
+ peer_down/4,
+ pick_peer/7, pick_peer/8,
+ prepare_request/6, prepare_request/7,
+ prepare_retransmit/6,
+ handle_answer/7, handle_answer/8,
+ handle_error/7,
+ handle_request/4]).
%% diameter_{tcp,sctp} callbacks
-export([message/3]).
@@ -119,13 +122,18 @@
%% ===========================================================================
+%% Positive number of testcases from which to select (randomly) from
+%% tc(), the list of testcases to run, or [] to run all. The random
+%% selection is to limit the time it takes for the suite to run.
+-define(LIMIT, #{tcp => 42, sctp => 5}).
+
-define(util, diameter_util).
-define(A, list_to_atom).
-define(L, atom_to_list).
%% Don't use is_record/2 since dictionary hrl's aren't included.
-%% (Since they define conflicting reqcords with the same names.)
+%% (Since they define conflicting records with the same names.)
-define(is_record(Rec, Name), (Name == element(1, Rec))).
-define(ADDR, {127,0,0,1}).
@@ -138,14 +146,14 @@
%% Sequence mask for End-to-End and Hop-by-Hop identifiers.
-define(CLIENT_MASK, {1,26}). %% 1 in top 6 bits
-%% How to construct messages, as record or list.
--define(ENCODINGS, [list, record]).
+%% How to construct outgoing messages.
+-define(ENCODINGS, [list, record, map]).
-%% How to send answers, in a diameter_packet or not.
--define(CONTAINERS, [pkt, msg]).
+%% How to decode incoming messages.
+-define(DECODINGS, [record, false, map, list, record_from_map]).
-%% Which common dictionary to use in the clients.
--define(RFCS, [rfc3588, rfc6733]).
+%% Which dictionary to use in the clients.
+-define(RFCS, [rfc3588, rfc6733, rfc4005]).
%% Whether to decode stringish Diameter types to strings, or leave
%% them as binary.
@@ -163,13 +171,12 @@
-record(group,
{transport,
strings,
+ encoding,
client_service,
- client_encoding,
- client_dict0,
+ client_dict,
client_sender,
server_service,
- server_encoding,
- server_container,
+ server_decoding,
server_sender,
server_throttle}).
@@ -182,34 +189,36 @@
%% A common match when receiving answers in a client.
-define(answer_message(SessionId, ResultCode),
- ['answer-message',
- {'Session-Id', SessionId},
- {'Origin-Host', _},
- {'Origin-Realm', _},
- {'Result-Code', ResultCode}
- | _]).
+ ['answer-message' | #{'Session-Id' := SessionId,
+ 'Origin-Host' := _,
+ 'Origin-Realm' := _,
+ 'Result-Code' := ResultCode}]).
-define(answer_message(ResultCode),
- ?answer_message(_, ResultCode)).
+ ['answer-message' | #{'Origin-Host' := _,
+ 'Origin-Realm' := _,
+ 'Result-Code' := ResultCode}]).
%% Config for diameter:start_service/2.
--define(SERVICE(Name, Decode),
+-define(SERVICE(Name, Grp),
[{'Origin-Host', Name ++ "." ++ ?REALM},
{'Origin-Realm', ?REALM},
{'Host-IP-Address', [?ADDR]},
{'Vendor-Id', 12345},
{'Product-Name', "OTP/diameter"},
- {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]},
- {'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]},
+ {'Auth-Application-Id', [0]}, %% common messages
+ {'Acct-Application-Id', [3]}, %% base accounting
{restrict_connections, false},
- {string_decode, Decode},
+ {string_decode, Grp#group.strings},
{incoming_maxlen, 1 bsl 21}
| [{application, [{dictionary, D},
- {module, ?MODULE},
+ {module, [?MODULE, Grp]},
{answer_errors, callback}]}
|| D <- [diameter_gen_base_rfc3588,
diameter_gen_base_accounting,
diameter_gen_base_rfc6733,
- diameter_gen_acct_rfc6733]]]).
+ diameter_gen_acct_rfc6733,
+ nas4005],
+ D /= nas4005 orelse have_nas()]]).
-define(SUCCESS,
?'DIAMETER_BASE_RESULT-CODE_SUCCESS').
@@ -254,59 +263,64 @@ suite() ->
[{timetrap, {seconds, 10}}].
all() ->
- [start, result_codes, {group, traffic}, empty, stop].
+ [rfc4005, start, result_codes, {group, traffic}, empty, stop].
+
+%% Redefine this to run one or more groups for debugging purposes.
+-define(GROUPS, []).
+%-define(GROUPS, [[tcp,rfc6733,record,map,false,false,false,false]]).
+%% Issues with gen_sctp sporadically cause huge numbers of failed
+%% testcases when running testcases in parallel.
groups() ->
- [{P, [P], Ts} || Ts <- [tc(tc())], P <- [shuffle, parallel]]
+ Names = names(),
+ [{P, [P], Ts} || Ts <- [tc()], P <- [shuffle, parallel]]
++
- [{?util:name([T,R,D,A,C,S,SS,ST,CS]),
- [],
- [{group, if S -> shuffle; not S -> parallel end}]}
- || T <- ?TRANSPORTS,
- R <- ?ENCODINGS,
- D <- ?RFCS,
- A <- ?ENCODINGS,
- C <- ?CONTAINERS,
- S <- ?STRING_DECODES,
- SS <- ?SENDERS,
- ST <- ?CALLBACKS,
- CS <- ?SENDERS]
+ [{?util:name(N), [], [{group, if T == sctp; S -> shuffle;
+ true -> parallel end}]}
+ || [T,_,_,_,S|_] = N <- Names]
++
- [{T, [], groups([[T,R,D,A,C,S,SS,ST,CS]
- || R <- ?ENCODINGS,
- D <- ?RFCS,
- A <- ?ENCODINGS,
- C <- ?CONTAINERS,
- S <- ?STRING_DECODES,
- SS <- ?SENDERS,
- ST <- ?CALLBACKS,
- CS <- ?SENDERS,
- SS orelse CS])} %% avoid deadlock
+ [{T, [], [{group, ?util:name(N)} || N <- names(Names, ?GROUPS),
+ T == hd(N)]}
|| T <- ?TRANSPORTS]
++
[{traffic, [], [{group, T} || T <- ?TRANSPORTS]}].
-%groups(_) -> %% debug
-% Name = [sctp,record,rfc6733,record,pkt,false,false,false,false],
-% [{group, ?util:name(Name)}];
-groups(Names) ->
- [{group, ?util:name(L)} || L <- Names].
+names() ->
+ [[T,R,E,D,S,ST,SS,CS] || T <- ?TRANSPORTS,
+ R <- ?RFCS,
+ E <- ?ENCODINGS,
+ D <- ?DECODINGS,
+ S <- ?STRING_DECODES,
+ ST <- ?CALLBACKS,
+ SS <- ?SENDERS,
+ CS <- ?SENDERS].
+
+names(Names, []) ->
+ [N || N <- Names,
+ [CS,SS|_] <- [lists:reverse(N)],
+ SS orelse CS]; %% avoid deadlock
-%tc([N|_]) -> %% debug
-% [N];
-tc(L) ->
- L.
+names(_, Names) ->
+ Names.
%% --------------------
+init_per_suite() ->
+ [{timetrap, {seconds, 60}}].
+
init_per_suite(Config) ->
- [{sctp, ?util:have_sctp()} | Config].
+ [{rfc4005, compile_and_load()}, {sctp, ?util:have_sctp()} | Config].
end_per_suite(_Config) ->
+ code:delete(nas4005),
+ code:purge(nas4005),
ok.
%% --------------------
+init_per_group(_) ->
+ [{timetrap, {seconds, 30}}].
+
init_per_group(Name, Config)
when Name == shuffle;
Name == parallel ->
@@ -322,24 +336,22 @@ init_per_group(sctp = Name, Config) ->
end;
init_per_group(Name, Config) ->
+ Nas = proplists:get_value(rfc4005, Config, false),
case ?util:name(Name) of
- [T,R,D,A,C,S,SS,ST,CS] ->
+ [_,R,_,_,_,_,_,_] when R == rfc4005, true /= Nas ->
+ {skip, rfc4005};
+ [T,R,E,D,S,ST,SS,CS] ->
G = #group{transport = T,
strings = S,
+ encoding = E,
client_service = [$C|?util:unique_string()],
- client_encoding = R,
- client_dict0 = dict0(D),
+ client_dict = appdict(R),
client_sender = CS,
server_service = [$S|?util:unique_string()],
- server_encoding = A,
- server_container = C,
+ server_decoding = D,
server_sender = SS,
server_throttle = ST},
- %% Limit the number of testcase, since the number of
- %% groups is large.
- All = ?util:scramble(tc()),
- TCs = lists:sublist(All, rand:uniform(32)),
- [{group, G}, {runlist, TCs} | Config];
+ [{group, G}, {runlist, select(T)} | Config];
_ ->
Config
end.
@@ -353,6 +365,14 @@ end_per_group(Name, Config)
end_per_group(_, _) ->
ok.
+select(T) ->
+ try maps:get(T, ?LIMIT) of
+ N ->
+ lists:sublist(?util:scramble(tc()), max(5, rand:uniform(N)))
+ catch
+ error:_ -> ?LIMIT
+ end.
+
%% --------------------
%% Skip testcases that can reasonably fail under SCTP.
@@ -440,16 +460,19 @@ start(_Config) ->
ok = diameter:start().
start_services(Config) ->
- #group{strings = S,
- client_service = CN,
- server_service = SN}
+ #group{client_service = CN,
+ server_service = SN,
+ server_decoding = SD}
+ = Grp
= group(Config),
- ok = diameter:start_service(SN, ?SERVICE(SN, S)),
+ ok = diameter:start_service(SN, [{decode_format, SD}
+ | ?SERVICE(SN, Grp)]),
ok = diameter:start_service(CN, [{sequence, ?CLIENT_MASK}
- | ?SERVICE(CN, S)]).
+ | ?SERVICE(CN, Grp)]).
add_transports(Config) ->
#group{transport = T,
+ encoding = E,
client_service = CN,
client_sender = CS,
server_service = SN,
@@ -459,30 +482,46 @@ add_transports(Config) ->
LRef = ?util:listen(SN,
[T,
{sender, SS},
- {message_cb, ST andalso {?MODULE, message, [4]}}
+ {message_cb, ST andalso {?MODULE, message, [0]}}
| [{packet, hd(?util:scramble([false, raw]))}
|| T == sctp andalso CS]],
[{capabilities_cb, fun capx/2},
- {pool_size, 8},
- {applications, apps(rfc3588)}]
+ {pool_size, 8}
+ | server_apps()]
++ [{spawn_opt, {erlang, spawn, []}} || CS]),
Cs = [?util:connect(CN,
[T, {sender, CS}],
LRef,
- [{id, Id},
- {capabilities, [{'Origin-State-Id', origin(Id)}]},
- {applications, apps(D)}])
- || A <- ?ENCODINGS,
- C <- ?CONTAINERS,
- D <- ?RFCS,
- Id <- [{A,C}]],
- %% The server uses the client's Origin-State-Id to decide how to
- %% answer.
+ [{id, Id}
+ | client_apps(R, [{'Origin-State-Id', origin(Id)}])])
+ || D <- ?DECODINGS, %% for multiple candidate peers
+ R <- ?RFCS,
+ R /= rfc4005 orelse have_nas(),
+ Id <- [{D,E}]],
?util:write_priv(Config, "transport", [LRef | Cs]).
-apps(D0) ->
- D = dict0(D0),
- [acct(D), D].
+server_apps() ->
+ B = have_nas(),
+ [{applications, [diameter_gen_base_rfc3588,
+ diameter_gen_base_accounting]
+ ++ [nas4005 || B]},
+ {capabilities, [{'Auth-Application-Id', [0] ++ [1 || B]}, %% common, NAS
+ {'Acct-Application-Id', [3]}]}]. %% accounting
+
+client_apps(D, Caps) ->
+ if D == rfc4005 ->
+ [{applications, [nas4005]},
+ {capabilities, [{'Auth-Application-Id', [1]}, %% NAS
+ {'Acct-Application-Id', []}
+ | Caps]}];
+ true ->
+ D0 = dict0(D),
+ [{applications, [acct(D0), D0]},
+ {capabilities, Caps}]
+ end.
+
+have_nas() ->
+ false /= code:is_loaded(nas4005).
remove_transports(Config) ->
#group{client_service = CN,
@@ -515,6 +554,11 @@ capx(_, #diameter_caps{origin_host = {OH,DH}}) ->
%% ===========================================================================
+%% Fail only this testcase if the RFC 4005 dictionary hasn't been
+%% successfully compiled and loaded.
+rfc4005(Config) ->
+ true = proplists:get_value(rfc4005, Config).
+
%% Ensure that result codes have the expected values.
result_codes(_Config) ->
{2001, 3001, 3002, 3003, 3004, 3007, 3008, 3009, 5001, 5011, 5014}
@@ -535,7 +579,8 @@ send_ok(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 1}],
- ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['ACA' | #{'Result-Code' := ?SUCCESS,
+ 'Session-Id' := _}]
= call(Config, Req).
%% Send an accounting ACR that the server answers badly to.
@@ -551,7 +596,8 @@ send_eval(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 3}],
- ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['ACA' | #{'Result-Code' := ?SUCCESS,
+ 'Session-Id' := _}]
= call(Config, Req).
%% Send an accounting ACR that the server tries to answer with an
@@ -577,7 +623,7 @@ send_protocol_error(Config) ->
send_experimental_result(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 5}],
- ['ACA', {'Session-Id', _} | _]
+ ['ACA' | #{'Session-Id' := _}]
= call(Config, Req).
%% Send an ASR with an arbitrary non-mandatory AVP and expect success
@@ -585,11 +631,11 @@ send_experimental_result(Config) ->
send_arbitrary(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name',
value = "XXX"}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS,
+ 'AVP' := [#diameter_avp{name = 'Product-Name',
+ value = V}]}]
= call(Config, Req),
- {'AVP', [#diameter_avp{name = 'Product-Name',
- value = V}]}
- = lists:last(Avps),
"XXX" = string(V, Config).
%% Send an unknown AVP (to some client) and check that it comes back.
@@ -597,12 +643,12 @@ send_unknown(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
is_mandatory = false,
data = <<17>>}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps]
- = call(Config, Req),
- {'AVP', [#diameter_avp{code = 999,
- is_mandatory = false,
- data = <<17>>}]}
- = lists:last(Avps).
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS,
+ 'AVP' := [#diameter_avp{code = 999,
+ is_mandatory = false,
+ data = <<17>>}]}]
+ = call(Config, Req).
%% Ditto, and point the AVP length past the end of the message. Expect
%% 5014.
@@ -613,28 +659,28 @@ send_unknown_short(Config, M, RC) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
is_mandatory = M,
data = <<17>>}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', RC} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := RC,
+ 'Failed-AVP' := Avps}]
= call(Config, Req),
- [#'diameter_base_Failed-AVP'{'AVP' = As}]
- = proplists:get_value('Failed-AVP', Avps),
- [#diameter_avp{code = 999,
- is_mandatory = M,
- data = <<17, _/binary>>}] %% extra bits from padding
- = As.
+ [[#diameter_avp{code = 999,
+ is_mandatory = M,
+ data = <<17, _/binary>>}]] %% extra bits from padding
+ = failed_avps(Avps, Config).
%% Ditto but set the M flag.
send_unknown_mandatory(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
is_mandatory = true,
data = <<17>>}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?AVP_UNSUPPORTED,
+ 'Failed-AVP' := Avps}]
= call(Config, Req),
- [#'diameter_base_Failed-AVP'{'AVP' = As}]
- = proplists:get_value('Failed-AVP', Avps),
- [#diameter_avp{code = 999,
- is_mandatory = true,
- data = <<17>>}]
- = As.
+ [[#diameter_avp{code = 999,
+ is_mandatory = true,
+ data = <<17>>}]]
+ = failed_avps(Avps, Config).
%% Ditto, and point the AVP length past the end of the message. Expect
%% 5014 instead of 5001.
@@ -647,15 +693,15 @@ send_unexpected_mandatory_decode(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 27, %% Session-Timeout
is_mandatory = true,
data = <<12:32>>}]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?AVP_UNSUPPORTED,
+ 'Failed-AVP' := Avps}]
= call(Config, Req),
- [#'diameter_base_Failed-AVP'{'AVP' = As}]
- = proplists:get_value('Failed-AVP', Avps),
- [#diameter_avp{code = 27,
- is_mandatory = true,
- value = 12,
- data = <<12:32>>}]
- = As.
+ [[#diameter_avp{code = 27,
+ is_mandatory = true,
+ value = 12,
+ data = <<12:32>>}]]
+ = failed_avps(Avps, Config).
%% Send an containing a faulty Grouped AVP (empty Proxy-Host in
%% Proxy-Info) and expect that only the faulty AVP is sent in
@@ -665,15 +711,13 @@ send_unexpected_mandatory_decode(Config) ->
send_grouped_error(Config) ->
Req = ['ASR', {'Proxy-Info', [[{'Proxy-Host', "abcd"},
{'Proxy-State', ""}]]}],
- ['ASA', {'Session-Id', _}, {'Result-Code', ?INVALID_AVP_LENGTH} | Avps]
+ ['ASA' | #{'Session-Id' := _,
+ 'Result-Code' := ?INVALID_AVP_LENGTH,
+ 'Failed-AVP' := Avps}]
= call(Config, Req),
- [#'diameter_base_Failed-AVP'{'AVP' = As}]
- = proplists:get_value('Failed-AVP', Avps),
- [#diameter_avp{name = 'Proxy-Info',
- value = #'diameter_base_Proxy-Info'
- {'Proxy-Host' = Empty,
- 'Proxy-State' = undefined}}]
- = As,
+ [[#diameter_avp{name = 'Proxy-Info', value = V}]]
+ = failed_avps(Avps, Config),
+ {Empty, undefined, []} = proxy_info(V, Config),
<<0>> = iolist_to_binary(Empty).
%% Send an STR that the server ignores.
@@ -702,7 +746,8 @@ send_error_bit(Config) ->
%% Send a bad version and check that we get 5011.
send_unsupported_version(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?UNSUPPORTED_VERSION} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?UNSUPPORTED_VERSION}]
= call(Config, Req).
%% Send a request containing an AVP length > data size.
@@ -722,17 +767,13 @@ send_zero_avp_length(Config) ->
send_invalid_avp_length(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', {'Session-Id', _},
- {'Result-Code', ?INVALID_AVP_LENGTH},
- {'Origin-Host', _},
- {'Origin-Realm', _},
- {'User-Name', _},
- {'Class', _},
- {'Error-Message', _},
- {'Error-Reporting-Host', _},
- {'Failed-AVP', [#'diameter_base_Failed-AVP'{'AVP' = [_]}]}
- | _]
- = call(Config, Req).
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?INVALID_AVP_LENGTH,
+ 'Origin-Host' := _,
+ 'Origin-Realm' := _,
+ 'Failed-AVP' := Avps}]
+ = call(Config, Req),
+ [[_]] = failed_avps(Avps, Config).
%% Send a request containing 5xxx errors that the server rejects with
%% 3xxx.
@@ -747,14 +788,16 @@ send_invalid_reject(Config) ->
send_unexpected_mandatory(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?AVP_UNSUPPORTED}]
= call(Config, Req).
%% Send something long that will be fragmented by TCP.
send_long(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'User-Name', [binary:copy(<<$X>>, 1 bsl 20)]}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, Req).
%% Send something longer than the configure incoming_maxlen.
@@ -797,7 +840,8 @@ send_any_2(Config) ->
send_all_1(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM),
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, Req, [{filter, {all, [{host, any},
{realm, Realm}]}}]).
send_all_2(Config) ->
@@ -826,9 +870,9 @@ send_detach(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
Ref = make_ref(),
ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]),
- Ans = receive {Ref, T} -> T end,
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
- = Ans.
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
+ = receive {Ref, T} -> T end.
%% Send a request which can't be encoded and expect {error, encode}.
send_encode_error(Config) ->
@@ -840,11 +884,13 @@ send_destination_1(Config) ->
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Host', [?HOST(SN, ?REALM)]}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, Req, [{filter, {all, [host, realm]}}]).
send_destination_2(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, Req, [{filter, {all, [host, realm]}}]).
%% Send with filtering on and expect failure when specifying an
@@ -908,7 +954,8 @@ send_bad_filter(Config, F) ->
%% Specify multiple filter options and expect them be conjunctive.
send_multiple_filters_1(Config) ->
Fun = fun(#diameter_caps{}) -> true end,
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= send_multiple_filters(Config, [host, {eval, Fun}]).
send_multiple_filters_2(Config) ->
E = {erlang, is_tuple, []},
@@ -919,7 +966,8 @@ send_multiple_filters_3(Config) ->
E2 = {erlang, is_tuple, []},
E3 = {erlang, is_record, [diameter_caps]},
E4 = [{erlang, is_record, []}, diameter_caps],
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]).
send_multiple_filters(Config, Fs) ->
@@ -930,11 +978,35 @@ send_multiple_filters(Config, Fs) ->
%% only the return value from the prepare_request callback being
%% significant.
send_anything(Config) ->
- ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
+ ['STA' | #{'Session-Id' := _,
+ 'Result-Code' := ?SUCCESS}]
= call(Config, anything).
%% ===========================================================================
+failed_avps(Avps, Config) ->
+ #group{client_dict = D} = proplists:get_value(group, Config),
+ [failed_avp(D, T) || T <- Avps].
+
+failed_avp(nas4005, {'nas_Failed-AVP', As}) ->
+ As;
+failed_avp(_, #'diameter_base_Failed-AVP'{'AVP' = As}) ->
+ As.
+
+proxy_info(Rec, Config) ->
+ #group{client_dict = D} = proplists:get_value(group, Config),
+ if D == nas4005 ->
+ {'nas_Proxy-Info', H, S, As}
+ = Rec,
+ {H,S,As};
+ true ->
+ #'diameter_base_Proxy-Info'{'Proxy-Host' = H,
+ 'Proxy-State' = S,
+ 'AVP' = As}
+ = Rec,
+ {H,S,As}
+ end.
+
group(Config) ->
#group{} = proplists:get_value(group, Config).
@@ -954,58 +1026,135 @@ call(Config, Req) ->
call(Config, Req, Opts) ->
Name = proplists:get_value(testcase, Config),
- #group{client_service = CN,
- client_encoding = ReqEncoding,
- client_dict0 = Dict0}
- = Group
+ #group{encoding = Enc,
+ client_service = CN,
+ client_dict = Dict0}
= group(Config),
diameter:call(CN,
dict(Req, Dict0),
- msg(Req, ReqEncoding, Dict0),
- [{extra, [{Name, Group}, diameter_lib:now()]} | Opts]).
+ msg(Req, Enc, Dict0),
+ [{extra, [Name, diameter_lib:now()]} | Opts]).
-origin({A,C}) ->
- 2*codec(A) + container(C);
+origin({D,E}) ->
+ 4*decode(D) + encode(E);
origin(N) ->
- {codec(N band 2), container(N rem 2)}.
-
-%% Map booleans, but the readable atoms are part of (constructed)
-%% group names, so it's good that they're readable.
-
-codec(record) -> 0;
-codec(list) -> 1;
-codec(0) -> record;
-codec(_) -> list.
-
-container(pkt) -> 0;
-container(msg) -> 1;
-container(0) -> pkt;
-container(_) -> msg.
+ {decode(N bsr 2), encode(N rem 4)}.
+
+%% Map atoms. The atoms are part of (constructed) group names, so it's
+%% good that they're readable.
+
+decode(record) -> 0;
+decode(list) -> 1;
+decode(map) -> 2;
+decode(false) -> 3;
+decode(record_from_map) -> 4;
+decode(0) -> record;
+decode(1) -> list;
+decode(2) -> map;
+decode(3) -> false;
+decode(4) -> record_from_map.
+
+encode(record) -> 0;
+encode(list) -> 1;
+encode(map) -> 2;
+encode(0) -> record;
+encode(1) -> list;
+encode(2) -> map.
msg([H|_] = Msg, record = E, diameter_gen_base_rfc3588)
when H == 'ACR';
H == 'ACA' ->
msg(Msg, E, diameter_gen_base_accounting);
+
msg([H|_] = Msg, record = E, diameter_gen_base_rfc6733)
when H == 'ACR';
H == 'ACA' ->
msg(Msg, E, diameter_gen_acct_rfc6733);
+
msg([H|T], record, Dict) ->
Dict:'#new-'(Dict:msg2rec(H), T);
+
+msg([H|As], map, _)
+ when is_list(As) ->
+ [H | maps:from_list(As)];
+
msg(Msg, _, _) ->
Msg.
+to_map(#diameter_packet{msg = [_MsgName | Avps] = Msg},
+ #group{server_decoding = map})
+ when is_map(Avps) ->
+ Msg;
+
+to_map(#diameter_packet{msg = [MsgName | Avps]},
+ #group{server_decoding = list}) ->
+ [MsgName | maps:from_list(Avps)];
+
+to_map(#diameter_packet{header = H, msg = Rec},
+ #group{server_decoding = D})
+ when D == record;
+ D == record_from_map ->
+ rec_to_map(Rec, dict(H));
+
+%% No record decode: do it ourselves.
+to_map(#diameter_packet{header = H,
+ msg = false,
+ bin = Bin},
+ #group{server_decoding = false,
+ strings = B}) ->
+ Opts = #{decode_format => map,
+ string_decode => B,
+ strict_mbit => true,
+ rfc => 6733},
+ #diameter_packet{msg = [_MsgName | _Map] = Msg}
+ = diameter_codec:decode(dict(H), Opts, Bin),
+ Msg.
+
+dict(#diameter_header{application_id = Id,
+ cmd_code = Code}) ->
+ if Id == 1 ->
+ nas4005;
+ Code == 271 ->
+ diameter_gen_base_accounting;
+ true ->
+ diameter_gen_base_rfc3588
+ end.
+
+rec_to_map(Rec, Dict) ->
+ [R | Vs] = Dict:'#get-'(Rec),
+ [Dict:rec2msg(R) | maps:from_list([T || {_,V} = T <- Vs,
+ V /= undefined,
+ V /= []])].
+
+appdict(rfc4005) ->
+ nas4005;
+appdict(D) ->
+ dict0(D).
+
dict0(D) ->
?A("diameter_gen_base_" ++ ?L(D)).
-dict(Msg, Dict0)
- when 'ACR' == hd(Msg);
- 'ACA' == hd(Msg);
- ?is_record(Msg, diameter_base_accounting_ACR);
- ?is_record(Msg, diameter_base_accounting_ACA) ->
+dict(Msg, Dict) ->
+ d(name(Msg), Dict).
+
+d(N, nas4005 = D) ->
+ if N == {list, 'answer-message'};
+ N == {map, 'answer-message'};
+ N == {record, 'diameter_base_answer-message'} ->
+ diameter_gen_base_rfc3588;
+ true ->
+ D
+ end;
+d(N, Dict0)
+ when N == {list, 'ACR'};
+ N == {list, 'ACA'};
+ N == {map, 'ACR'};
+ N == {map, 'ACA'};
+ N == {record, diameter_base_accounting_ACR};
+ N == {record, diameter_base_accounting_ACA} ->
acct(Dict0);
-dict(_, Dict0) ->
+d(_, Dict0) ->
Dict0.
acct(diameter_gen_base_rfc3588) ->
@@ -1014,53 +1163,60 @@ acct(diameter_gen_base_rfc6733) ->
diameter_gen_acct_rfc6733.
%% Set only values that aren't already.
-set(_, [H|T], Vs) ->
- [H | Vs ++ T];
-set(#group{client_dict0 = Dict0} = _Group, Rec, Vs) ->
+
+set(_, [N | As], Vs) ->
+ [N | if is_map(As) ->
+ maps:merge(maps:from_list(Vs), As);
+ is_list(As) ->
+ Vs ++ As
+ end];
+
+set(#group{client_dict = Dict0} = _Group, Rec, Vs) ->
Dict = dict(Rec, Dict0),
lists:foldl(fun({F,_} = FV, A) ->
- set(Dict, Dict:'#get-'(F, A), FV, A)
+ reset(Dict, Dict:'#get-'(F, A), FV, A)
end,
Rec,
Vs).
-set(Dict, E, FV, Rec)
+reset(Dict, E, FV, Rec)
when E == undefined;
E == [] ->
Dict:'#set-'(FV, Rec);
-set(_, _, _, Rec) ->
+
+reset(_, _, _, Rec) ->
Rec.
%% ===========================================================================
%% diameter callbacks
-%% peer_up/3
+%% peer_up/4
-peer_up(_SvcName, _Peer, State) ->
+peer_up(_SvcName, _Peer, State, _Group) ->
State.
%% peer_down/3
-peer_down(_SvcName, _Peer, State) ->
+peer_down(_SvcName, _Peer, State, _Group) ->
State.
-%% pick_peer/6-7
+%% pick_peer/7-8
-pick_peer(Peers, _, [$C|_], _State, {Name, Group}, _)
+pick_peer(Peers, _, [$C|_], _State, Group, Name, _)
when Name /= send_detach ->
find(Group, Peers).
-pick_peer(_Peers, _, [$C|_], _State, {send_nopeer, _}, _, ?EXTRA) ->
+pick_peer(_Peers, _, [$C|_], _State, _Group, send_nopeer, _, ?EXTRA) ->
false;
-pick_peer(Peers, _, [$C|_], _State, {send_detach, Group}, _, {_,_}) ->
+pick_peer(Peers, _, [$C|_], _State, Group, send_detach, _, {_,_}) ->
find(Group, Peers).
-find(#group{client_service = CN,
- server_encoding = A,
- server_container = C},
+find(#group{encoding = E,
+ client_service = CN,
+ server_decoding = D},
[_|_] = Peers) ->
- Id = {A,C},
+ Id = {D,E},
[P] = [P || P <- Peers, id(Id, P, CN)],
{ok, P}.
@@ -1069,15 +1225,15 @@ id(Id, {Pid, _Caps}, SvcName) ->
= diameter:service_info(SvcName, Pid),
lists:member({id, Id}, Opts).
-%% prepare_request/5-6
+%% prepare_request/6-7
-prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, {send_discard, _}, _) ->
+prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, _, send_discard, _) ->
{discard, unprepared};
-prepare_request(Pkt, [$C|_], {_Ref, Caps}, {Name, Group}, _) ->
+prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, Name, _) ->
{send, prepare(Pkt, Caps, Name, Group)}.
-prepare_request(Pkt, [$C|_], {_Ref, Caps}, {send_detach, Group}, _, _) ->
+prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, send_detach, _, _) ->
{eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}.
log(#diameter_packet{bin = Bin} = P, T)
@@ -1086,7 +1242,7 @@ log(#diameter_packet{bin = Bin} = P, T)
%% prepare/4
-prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
+prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
when N == send_unknown_short_mandatory;
N == send_unknown_short ->
Req = prepare(Pkt, Caps, Group),
@@ -1106,7 +1262,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
<<H:Offset/binary, Len:24, T/binary>> = Bin,
E#diameter_packet{bin = <<H/binary, (Len+9):24, T/binary>>};
-prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
+prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
when N == send_long_avp_length;
N == send_short_avp_length;
N == send_zero_avp_length ->
@@ -1132,7 +1288,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
T/binary,
Hdr/binary, AL:24, Data/binary>>};
-prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
+prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
when N == send_invalid_avp_length;
N == send_invalid_reject ->
Req = prepare(Pkt, Caps, Group),
@@ -1147,7 +1303,7 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group)
<<V, L:24, H/binary>> = H0, %% assert
E#diameter_packet{bin = <<V, (L+4):24, H/binary, 16:24, 0:32, T/binary>>};
-prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0}
+prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<V, Len:24, T/binary>>}
@@ -1157,7 +1313,7 @@ prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0}
Avp = <<Code:32, Flags, 8:24>>,
E#diameter_packet{bin = <<V, (Len+8):24, T/binary, Avp/binary>>};
-prepare(Pkt, Caps, send_grouped_error, #group{client_dict0 = Dict0}
+prepare(Pkt, Caps, send_grouped_error, #group{client_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = Bin}
@@ -1189,14 +1345,14 @@ prepare(Pkt, Caps, send_grouped_error, #group{client_dict0 = Dict0}
Payload/binary,
T/binary>>};
-prepare(Pkt, Caps, send_unsupported, #group{client_dict0 = Dict0} = Group) ->
+prepare(Pkt, Caps, send_unsupported, #group{client_dict = Dict0} = Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
E#diameter_packet{bin = <<H/binary, 42:24, T/binary>>};
-prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0}
+prepare(Pkt, Caps, send_unsupported_app, #group{client_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>}
@@ -1223,9 +1379,16 @@ prepare(Pkt, Caps, _Name, Group) ->
%% prepare/3
-prepare(#diameter_packet{msg = Req}, Caps, Group)
- when ?is_record(Req, diameter_base_accounting_ACR);
- 'ACR' == hd(Req) ->
+prepare(#diameter_packet{msg = Req} = Pkt, Caps, Group) ->
+ set(name(Req), Pkt, Caps, Group).
+
+%% set/4
+
+set(N, #diameter_packet{msg = Req}, Caps, Group)
+ when N == {record, diameter_base_accounting_ACR};
+ N == {record, nas_ACR};
+ N == {map, 'ACR'};
+ N == {list, 'ACR'} ->
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, DR}}
= Caps,
@@ -1235,9 +1398,11 @@ prepare(#diameter_packet{msg = Req}, Caps, Group)
{'Origin-Realm', OR},
{'Destination-Realm', DR}]);
-prepare(#diameter_packet{msg = Req}, Caps, Group)
- when ?is_record(Req, diameter_base_ASR);
- 'ASR' == hd(Req) ->
+set(N, #diameter_packet{msg = Req}, Caps, Group)
+ when N == {record, diameter_base_ASR};
+ N == {record, nas_ASR};
+ N == {map, 'ASR'};
+ N == {list, 'ASR'} ->
#diameter_caps{origin_host = {OH, DH},
origin_realm = {OR, DR}}
= Caps,
@@ -1248,9 +1413,11 @@ prepare(#diameter_packet{msg = Req}, Caps, Group)
{'Destination-Realm', DR},
{'Auth-Application-Id', ?APP_ID}]);
-prepare(#diameter_packet{msg = Req}, Caps, Group)
- when ?is_record(Req, diameter_base_STR);
- 'STR' == hd(Req) ->
+set(N, #diameter_packet{msg = Req}, Caps, Group)
+ when N == {record, diameter_base_STR};
+ N == {record, nas_STR};
+ N == {map, 'STR'};
+ N == {list, 'STR'} ->
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, DR}}
= Caps,
@@ -1260,9 +1427,11 @@ prepare(#diameter_packet{msg = Req}, Caps, Group)
{'Destination-Realm', DR},
{'Auth-Application-Id', ?APP_ID}]);
-prepare(#diameter_packet{msg = Req}, Caps, Group)
- when ?is_record(Req, diameter_base_RAR);
- 'RAR' == hd(Req) ->
+set(N, #diameter_packet{msg = Req}, Caps, Group)
+ when N == {record, diameter_base_RAR};
+ N == {record, nas_RAR};
+ N == {map, 'RAR'};
+ N == {list, 'RAR'} ->
#diameter_caps{origin_host = {OH, DH},
origin_realm = {OR, DR}}
= Caps,
@@ -1273,27 +1442,42 @@ prepare(#diameter_packet{msg = Req}, Caps, Group)
{'Destination-Realm', DR},
{'Auth-Application-Id', ?APP_ID}]).
-%% prepare_retransmit/5
+%% name/1
+
+name([H|#{}]) ->
+ {map, H};
+
+name([H|_]) ->
+ {list, H};
+
+name(Rec) ->
+ try
+ {record, element(1, Rec)}
+ catch
+ error: badarg ->
+ false
+ end.
+
+%% prepare_retransmit/6
-prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) ->
+prepare_retransmit(_Pkt, false, _Peer, _Group, _Name, _) ->
discard.
-%% handle_answer/6-7
+%% handle_answer/7-8
-handle_answer(Pkt, Req, [$C|_], Peer, {Name, Group}, _) ->
+handle_answer(Pkt, Req, [$C|_], Peer, Group, Name, _) ->
answer(Pkt, Req, Peer, Name, Group).
-handle_answer(Pkt, Req, [$C|_], Peer, {send_detach = Name, Group}, _, X) ->
+handle_answer(Pkt, Req, [$C|_], Peer, Group, send_detach = Name, _, X) ->
{Pid, Ref} = X,
Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}.
-answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) ->
+answer(Pkt, Req, _Peer, Name, #group{client_dict = Dict0}) ->
#diameter_packet{header = H, msg = Ans, errors = Es} = Pkt,
ApplId = app(Req, Name, Dict0),
#diameter_header{application_id = ApplId} = H, %% assert
Dict = dict(Ans, Dict0),
- [R | Vs] = Dict:'#get-'(answer(Ans, Es, Name)),
- [Dict:rec2msg(R) | Vs].
+ rec_to_map(answer(Ans, Es, Name), Dict).
%% Missing Result-Code and inappropriate Experimental-Result-Code.
answer(Rec, Es, send_experimental_result) ->
@@ -1317,25 +1501,29 @@ app(Req, _, Dict0) ->
Dict = dict(Req, Dict0),
Dict:id().
-%% handle_error/6
+%% handle_error/7
-handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, Time) ->
+handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, _, Time) ->
Now = diameter_lib:now(),
{Reason, {diameter_lib:timestamp(Time),
diameter_lib:timestamp(Now),
diameter_lib:micro_diff(Now, Time)}};
-handle_error(Reason, _Req, [$C|_], _Peer, _, _Time) ->
+handle_error(Reason, _Req, [$C|_], _Peer, _, _, _Time) ->
{error, Reason}.
-%% handle_request/3
+%% handle_request/4
%% Note that diameter will set Result-Code and Failed-AVPs if
%% #diameter_packet.errors is non-null.
-handle_request(#diameter_packet{header = H, msg = M, avps = As},
+handle_request(#diameter_packet{header = H, avps = As}
+ = Pkt,
_,
- {_Ref, Caps}) ->
+ {_Ref, Caps},
+ #group{encoding = E,
+ server_decoding = D}
+ = Grp) ->
#diameter_header{end_to_end_id = EI,
hop_by_hop_id = HI}
= H,
@@ -1343,24 +1531,62 @@ handle_request(#diameter_packet{header = H, msg = M, avps = As},
V = EI bsr B, %% assert
V = HI bsr B, %%
#diameter_caps{origin_state_id = {_,[Id]}} = Caps,
- answer(origin(Id), request(M, [H|As], Caps)).
+ {D,E} = T = origin(Id), %% assert
+ wrap(T, H, request(to_map(Pkt, Grp), [H|As], Caps)).
+
+wrap(Id, H, {Tag, Action, Post}) ->
+ {Tag, wrap(Id, H, Action), Post};
-answer(T, {Tag, Action, Post}) ->
- {Tag, answer(T, Action), Post};
-answer(_, {reply, [#diameter_header{} | _]} = T) ->
+wrap(_, _, {reply, [#diameter_header{} | _]} = T) ->
T;
-answer({A,C}, {reply, Ans}) ->
- answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)});
-answer(pkt, {reply, Ans})
- when not is_record(Ans, diameter_packet) ->
- {reply, #diameter_packet{msg = Ans}};
-answer(_, T) ->
+
+wrap({_,E}, H, {reply, Ans}) ->
+ Msg = base_to_nas(msg(Ans, E, diameter_gen_base_rfc3588), H),
+ {reply, wrap(Msg)};
+
+wrap(_, _, T) ->
T.
+%% Randomly wrap the answer in a diameter_packet.
+
+wrap(#diameter_packet{} = Pkt) ->
+ Pkt;
+
+wrap(Msg) ->
+ case rand:uniform(2) of
+ 1 -> #diameter_packet{msg = Msg};
+ 2 -> Msg
+ end.
+
+%% base_to_nas/2
+
+base_to_nas(#diameter_packet{msg = Msg} = Pkt, H) ->
+ Pkt#diameter_packet{msg = base_to_nas(Msg, H)};
+
+base_to_nas(Rec, #diameter_header{application_id = 1})
+ when is_tuple(Rec), not ?is_record(Rec, 'diameter_base_answer-message') ->
+ D = case element(1, Rec) of
+ diameter_base_accounting_ACA ->
+ diameter_gen_base_accounting;
+ _ ->
+ diameter_gen_base_rfc3588
+ end,
+ [R | Values] = D:'#get-'(Rec),
+ "diameter_base_" ++ N = ?L(R),
+ Name = ?A("nas_" ++ if N == "accounting_ACA" ->
+ "ACA";
+ true ->
+ N
+ end),
+ nas4005:'#new-'([Name | Values]);
+
+base_to_nas(Msg, _) ->
+ Msg.
+
%% request/3
%% send_experimental_result
-request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 5},
+request(['ACR' | #{'Accounting-Record-Number' := 5}],
[Hdr | Avps],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
@@ -1393,14 +1619,14 @@ request(Msg, _Avps, Caps) ->
%% request/2
%% send_nok
-request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 0},
+request(['ACR' | #{'Accounting-Record-Number' := 0}],
_) ->
{eval_packet, {protocol_error, ?INVALID_AVP_BITS}, [fun log/2, invalid]};
%% send_bad_answer
-request(#diameter_base_accounting_ACR{'Session-Id' = SId,
- 'Accounting-Record-Type' = RT,
- 'Accounting-Record-Number' = 2 = RN},
+request(['ACR' | #{'Session-Id' := SId,
+ 'Accounting-Record-Type' := RT,
+ 'Accounting-Record-Number' := 2 = RN}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
Ans = ['ACA', {'Result-Code', ?SUCCESS},
@@ -1414,9 +1640,9 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId,
msg = Ans}};
%% send_eval
-request(#diameter_base_accounting_ACR{'Session-Id' = SId,
- 'Accounting-Record-Type' = RT,
- 'Accounting-Record-Number' = 3 = RN},
+request(['ACR' | #{'Session-Id' := SId,
+ 'Accounting-Record-Type' := RT,
+ 'Accounting-Record-Number' := 3 = RN}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
Ans = ['ACA', {'Result-Code', ?SUCCESS},
@@ -1428,9 +1654,9 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId,
{eval, {reply, Ans}, {erlang, now, []}};
%% send_ok
-request(#diameter_base_accounting_ACR{'Session-Id' = SId,
- 'Accounting-Record-Type' = RT,
- 'Accounting-Record-Number' = 1 = RN},
+request(['ACR' | #{'Session-Id' := SId,
+ 'Accounting-Record-Type' := RT,
+ 'Accounting-Record-Number' := 1 = RN}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
{reply, ['ACA', {'Result-Code', ?SUCCESS},
@@ -1441,7 +1667,7 @@ request(#diameter_base_accounting_ACR{'Session-Id' = SId,
{'Accounting-Record-Number', RN}]};
%% send_protocol_error
-request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 4},
+request(['ACR' | #{'Accounting-Record-Number' := 4}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
Ans = ['answer-message', {'Result-Code', ?TOO_BUSY},
@@ -1449,40 +1675,39 @@ request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 4},
{'Origin-Realm', OR}],
{reply, Ans};
-request(#diameter_base_ASR{'Session-Id' = SId,
- 'AVP' = Avps},
+request(['ASR' | #{'Session-Id' := SId} = Avps],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
{reply, ['ASA', {'Result-Code', ?SUCCESS},
{'Session-Id', SId},
{'Origin-Host', OH},
{'Origin-Realm', OR},
- {'AVP', Avps}]};
+ {'AVP', maps:get('AVP', Avps, [])}]};
%% send_invalid_reject
-request(#diameter_base_STR{'Termination-Cause' = ?USER_MOVED},
+request(['STR' | #{'Termination-Cause' := ?USER_MOVED}],
_Caps) ->
{protocol_error, ?TOO_BUSY};
%% send_noreply
-request(#diameter_base_STR{'Termination-Cause' = T},
+request(['STR' | #{'Termination-Cause' := T}],
_Caps)
when T /= ?LOGOUT ->
discard;
%% send_destination_5
-request(#diameter_base_STR{'Destination-Realm' = R},
+request(['STR' | #{'Destination-Realm' := R}],
#diameter_caps{origin_realm = {OR, _}})
when R /= undefined, R /= OR ->
{protocol_error, ?REALM_NOT_SERVED};
%% send_destination_6
-request(#diameter_base_STR{'Destination-Host' = [H]},
+request(['STR' | #{'Destination-Host' := [H]}],
#diameter_caps{origin_host = {OH, _}})
when H /= OH ->
{protocol_error, ?UNABLE_TO_DELIVER};
-request(#diameter_base_STR{'Session-Id' = SId},
+request(['STR' | #{'Session-Id' := SId}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
{reply, ['STA', {'Result-Code', ?SUCCESS},
@@ -1491,7 +1716,7 @@ request(#diameter_base_STR{'Session-Id' = SId},
{'Origin-Realm', OR}]};
%% send_error/send_timeout
-request(#diameter_base_RAR{}, _Caps) ->
+request(['RAR' | #{}], _Caps) ->
receive after 2000 -> {protocol_error, ?TOO_BUSY} end.
%% message/3
@@ -1505,8 +1730,8 @@ message(Dir, #diameter_packet{bin = Bin}, N) ->
message(Dir, Bin, N);
%% incoming request
-message(recv, <<_:32, 1, _/bits>> = Bin, N) ->
- [Bin, 1 < N, fun ?MODULE:message/3, N-1];
+message(recv, <<_:32, 1:1, _/bits>> = Bin, N) ->
+ [Bin, N < 16, fun ?MODULE:message/3, N+1];
%% incoming answer
message(recv, Bin, _) ->
@@ -1517,9 +1742,35 @@ message(send, Bin, _) ->
[Bin];
%% sent request
-message(ack, <<_:32, 1, _/bits>>, _) ->
+message(ack, <<_:32, 1:1, _/bits>>, _) ->
[];
%% sent answer or discarded request
message(ack, _, N) ->
- [0 =< N, fun ?MODULE:message/3, N+1].
+ [N =< 16, fun ?MODULE:message/3, N-1].
+
+%% ------------------------------------------------------------------------
+
+compile_and_load() ->
+ try
+ Path = hd([P || H <- [[here(), ".."], [code:lib_dir(diameter)]],
+ P <- [filename:join(H ++ ["examples",
+ "dict",
+ "rfc4005_nas.dia"])],
+ {ok, _} <- [file:read_file_info(P)]]),
+ {ok, [Forms]}
+ = diameter_make:codec(Path, [return,
+ forms,
+ {name, "nas4005"},
+ {prefix, "nas"},
+ {inherits, "common/diameter_gen_base_rfc3588"}]),
+ {ok, nas4005, Bin, []} = compile:forms(Forms, [debug_info, return]),
+ {module, nas4005} = code:load_binary(nas4005, "nas4005", Bin),
+ true
+ catch
+ E:R ->
+ {E, R, erlang:get_stacktrace()}
+ end.
+
+here() ->
+ filename:dirname(code:which(?MODULE)).