%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2010-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.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
%%
%% Tests of traffic between two Diameter nodes, one client, one server.
%%
-module(diameter_traffic_SUITE).
-export([suite/0,
all/0,
groups/0,
init_per_suite/1,
end_per_suite/1,
init_per_group/2,
end_per_group/2,
init_per_testcase/2,
end_per_testcase/2]).
%% testcases
-export([rfc4005/1,
start/1,
start_services/1,
add_transports/1,
result_codes/1,
send_ok/1,
send_nok/1,
send_eval/1,
send_bad_answer/1,
send_protocol_error/1,
send_experimental_result/1,
send_arbitrary/1,
send_unknown/1,
send_unknown_short/1,
send_unknown_mandatory/1,
send_unknown_short_mandatory/1,
send_noreply/1,
send_grouped_error/1,
send_unsupported/1,
send_unsupported_app/1,
send_error_bit/1,
send_unsupported_version/1,
send_long_avp_length/1,
send_short_avp_length/1,
send_zero_avp_length/1,
send_invalid_avp_length/1,
send_invalid_reject/1,
send_unexpected_mandatory_decode/1,
send_unexpected_mandatory/1,
send_too_many/1,
send_long/1,
send_maxlen/1,
send_nopeer/1,
send_noapp/1,
send_discard/1,
send_any_1/1,
send_any_2/1,
send_all_1/1,
send_all_2/1,
send_timeout/1,
send_error/1,
send_detach/1,
send_encode_error/1,
send_destination_1/1,
send_destination_2/1,
send_destination_3/1,
send_destination_4/1,
send_destination_5/1,
send_destination_6/1,
send_bad_option_1/1,
send_bad_option_2/1,
send_bad_filter_1/1,
send_bad_filter_2/1,
send_bad_filter_3/1,
send_bad_filter_4/1,
send_multiple_filters_1/1,
send_multiple_filters_2/1,
send_multiple_filters_3/1,
send_anything/1,
remove_transports/1,
empty/1,
stop_services/1,
stop/1]).
%% diameter callbacks
-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]).
-include_lib("kernel/include/inet_sctp.hrl").
-include("diameter.hrl").
-include("diameter_gen_base_rfc3588.hrl").
-include("diameter_gen_base_accounting.hrl").
%% The listening transports use RFC 3588 dictionaries, the client
%% transports use either 3588 or 6733. (So can't use the record
%% definitions in the latter case.)
%% ===========================================================================
%% 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, 42).
-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 records with the same names.)
-define(is_record(Rec, Name), (Name == element(1, Rec))).
-define(ADDR, {127,0,0,1}).
-define(REALM, "erlang.org").
-define(HOST(Host, Realm), Host ++ [$.|Realm]).
-define(EXTRA, an_extra_argument).
%% Sequence mask for End-to-End and Hop-by-Hop identifiers.
-define(CLIENT_MASK, {1,26}). %% 1 in top 6 bits
%% How to construct outgoing messages.
-define(ENCODINGS, [list, record, map]).
%% How to decode incoming messages.
-define(DECODINGS, [record, false, map, list, record_from_map]).
%% 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.
-define(STRING_DECODES, [false, true]).
%% Which transport protocol to use.
-define(TRANSPORTS, [tcp, sctp]).
%% Send from a dedicated process?
-define(SENDERS, [true, false]).
%% Message callbacks from diameter_{tcp,sctp}?
-define(CALLBACKS, [true, false]).
-record(group,
{transport,
strings,
encoding,
client_service,
client_dict,
client_sender,
server_service,
server_decoding,
server_sender,
server_throttle}).
%% Not really what we should be setting unless the message is sent in
%% the common application but diameter doesn't care.
-define(APP_ID, ?DIAMETER_APP_ID_COMMON).
%% An Application-ID the server doesn't support.
-define(BAD_APP, 42).
%% 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}]).
-define(answer_message(ResultCode),
['answer-message' | #{'Origin-Host' := _,
'Origin-Realm' := _,
'Result-Code' := ResultCode}]).
%% Config for diameter:start_service/2.
-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', [0]}, %% common messages
{'Acct-Application-Id', [3]}, %% base accounting
{restrict_connections, false},
{string_decode, Grp#group.strings},
{incoming_maxlen, 1 bsl 21}
| [{application, [{dictionary, D},
{module, [?MODULE, Grp]},
{answer_errors, callback}]}
|| D <- [diameter_gen_base_rfc3588,
diameter_gen_base_accounting,
diameter_gen_base_rfc6733,
diameter_gen_acct_rfc6733,
nas4005],
D /= nas4005 orelse have_nas()]]).
-define(SUCCESS,
?'DIAMETER_BASE_RESULT-CODE_SUCCESS').
-define(COMMAND_UNSUPPORTED,
?'DIAMETER_BASE_RESULT-CODE_COMMAND_UNSUPPORTED').
-define(TOO_BUSY,
?'DIAMETER_BASE_RESULT-CODE_TOO_BUSY').
-define(APPLICATION_UNSUPPORTED,
?'DIAMETER_BASE_RESULT-CODE_APPLICATION_UNSUPPORTED').
-define(INVALID_HDR_BITS,
?'DIAMETER_BASE_RESULT-CODE_INVALID_HDR_BITS').
-define(INVALID_AVP_BITS,
?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_BITS').
-define(AVP_UNSUPPORTED,
?'DIAMETER_BASE_RESULT-CODE_AVP_UNSUPPORTED').
-define(UNSUPPORTED_VERSION,
?'DIAMETER_BASE_RESULT-CODE_UNSUPPORTED_VERSION').
-define(TOO_MANY,
?'DIAMETER_BASE_RESULT-CODE_AVP_OCCURS_TOO_MANY_TIMES').
-define(REALM_NOT_SERVED,
?'DIAMETER_BASE_RESULT-CODE_REALM_NOT_SERVED').
-define(UNABLE_TO_DELIVER,
?'DIAMETER_BASE_RESULT-CODE_UNABLE_TO_DELIVER').
-define(INVALID_AVP_LENGTH,
?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_LENGTH').
-define(EVENT_RECORD,
?'DIAMETER_BASE_ACCOUNTING-RECORD-TYPE_EVENT_RECORD').
-define(AUTHORIZE_ONLY,
?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY').
-define(AUTHORIZE_AUTHENTICATE,
?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_AUTHENTICATE').
-define(LOGOUT,
?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT').
-define(BAD_ANSWER,
?'DIAMETER_BASE_TERMINATION-CAUSE_BAD_ANSWER').
-define(USER_MOVED,
?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED').
%% ===========================================================================
suite() ->
[{timetrap, {seconds, 10}}].
all() ->
[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]]).
groups() ->
Names = names(),
[{P, [P], Ts} || Ts <- [tc()], P <- [shuffle, parallel]]
++
[{?util:name(N), [], [{group, if S -> shuffle; not S -> parallel end}]}
|| [_,_,_,_,S|_] = N <- Names]
++
[{T, [], [{group, ?util:name(N)} || N <- names(Names, ?GROUPS),
T == hd(N)]}
|| T <- ?TRANSPORTS]
++
[{traffic, [], [{group, T} || T <- ?TRANSPORTS]}].
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
names(_, Names) ->
Names.
%% --------------------
init_per_suite(Config) ->
[{rfc4005, compile_and_load()}, {sctp, ?util:have_sctp()} | Config].
end_per_suite(_Config) ->
code:delete(nas4005),
code:purge(nas4005),
ok.
%% --------------------
init_per_group(Name, Config)
when Name == shuffle;
Name == parallel ->
start_services(Config),
add_transports(Config),
[{sleep, Name == parallel} | Config];
init_per_group(sctp = Name, Config) ->
{_, Sctp} = lists:keyfind(Name, 1, Config),
if Sctp ->
Config;
true ->
{skip, Name}
end;
init_per_group(Name, Config) ->
Nas = proplists:get_value(rfc4005, Config, false),
case ?util:name(Name) of
[_,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_dict = appdict(R),
client_sender = CS,
server_service = [$S|?util:unique_string()],
server_decoding = D,
server_sender = SS,
server_throttle = ST},
[{group, G}, {runlist, select()} | Config];
_ ->
Config
end.
end_per_group(Name, Config)
when Name == shuffle;
Name == parallel ->
remove_transports(Config),
stop_services(Config);
end_per_group(_, _) ->
ok.
select() ->
try rand:uniform(?LIMIT) of
N -> lists:sublist(?util:scramble(tc()), max(N,5))
catch
error:_ -> ?LIMIT
end.
%% --------------------
%% Skip testcases that can reasonably fail under SCTP.
init_per_testcase(Name, Config) ->
TCs = proplists:get_value(runlist, Config, []),
Run = [] == TCs orelse lists:member(Name, TCs),
case [G || #group{transport = sctp} = G
<- [proplists:get_value(group, Config)]]
of
[_] when Name == send_maxlen;
Name == send_long ->
{skip, sctp};
_ when not Run ->
{skip, random};
_ ->
proplists:get_value(sleep, Config, false)
andalso timer:sleep(rand:uniform(200)),
[{testcase, Name} | Config]
end.
end_per_testcase(_, _) ->
ok.
%% --------------------
%% Testcases to run when services are started and connections
%% established.
tc() ->
[send_ok,
send_nok,
send_eval,
send_bad_answer,
send_protocol_error,
send_experimental_result,
send_arbitrary,
send_unknown,
send_unknown_short,
send_unknown_mandatory,
send_unknown_short_mandatory,
send_noreply,
send_grouped_error,
send_unsupported,
send_unsupported_app,
send_error_bit,
send_unsupported_version,
send_long_avp_length,
send_short_avp_length,
send_zero_avp_length,
send_invalid_avp_length,
send_invalid_reject,
send_unexpected_mandatory_decode,
send_unexpected_mandatory,
send_too_many,
send_long,
send_maxlen,
send_nopeer,
send_noapp,
send_discard,
send_any_1,
send_any_2,
send_all_1,
send_all_2,
send_timeout,
send_error,
send_detach,
send_encode_error,
send_destination_1,
send_destination_2,
send_destination_3,
send_destination_4,
send_destination_5,
send_destination_6,
send_bad_option_1,
send_bad_option_2,
send_bad_filter_1,
send_bad_filter_2,
send_bad_filter_3,
send_bad_filter_4,
send_multiple_filters_1,
send_multiple_filters_2,
send_multiple_filters_3,
send_anything].
%% ===========================================================================
%% start/stop testcases
start(_Config) ->
ok = diameter:start().
start_services(Config) ->
#group{client_service = CN,
server_service = SN,
server_decoding = SD}
= Grp
= group(Config),
ok = diameter:start_service(SN, [{decode_format, SD}
| ?SERVICE(SN, Grp)]),
ok = diameter:start_service(CN, [{sequence, ?CLIENT_MASK},
{strict_arities, decode}
| ?SERVICE(CN, Grp)]).
add_transports(Config) ->
#group{transport = T,
encoding = E,
client_service = CN,
client_sender = CS,
server_service = SN,
server_sender = SS,
server_throttle = ST}
= group(Config),
LRef = ?util:listen(SN,
[T,
{sender, SS},
{message_cb, ST andalso {?MODULE, message, [0]}}]
++ [{packet, hd(?util:scramble([false, raw]))}
|| T == sctp andalso CS]
++ [{unordered, unordered()} || T == sctp],
[{capabilities_cb, fun capx/2},
{pool_size, 8}
| server_apps()]
++ [{spawn_opt, {erlang, spawn, []}} || CS]),
Cs = [?util:connect(CN,
[T, {sender, CS} | client_opts(T)],
LRef,
[{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]).
unordered() ->
element(rand:uniform(4), {true, false, 1, 2}).
client_opts(tcp) ->
[];
client_opts(sctp) ->
[{unordered, unordered()}
| [{sctp_initmsg, #sctp_initmsg{num_ostreams = N,
max_instreams = 5}}
|| N <- [rand:uniform(8)],
N =< 6]].
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,
server_service = SN}
= group(Config),
[LRef | Cs] = ?util:read_priv(Config, "transport"),
try
[] = [T || C <- Cs, T <- [?util:disconnect(CN, C, SN, LRef)], T /= ok]
after
ok = diameter:remove_transport(SN, LRef)
end.
stop_services(Config) ->
#group{client_service = CN,
server_service = SN}
= group(Config),
ok = diameter:stop_service(CN),
ok = diameter:stop_service(SN).
%% Ensure even transports have been removed from request table.
empty(_Config) ->
[] = ets:tab2list(diameter_request).
stop(_Config) ->
ok = diameter:stop().
capx(_, #diameter_caps{origin_host = {OH,DH}}) ->
io:format("connection: ~p -> ~p~n", [DH,OH]),
ok.
%% ===========================================================================
%% 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, 5009, 5011, 5014}
= {?SUCCESS,
?COMMAND_UNSUPPORTED,
?UNABLE_TO_DELIVER,
?REALM_NOT_SERVED,
?TOO_BUSY,
?APPLICATION_UNSUPPORTED,
?INVALID_HDR_BITS,
?INVALID_AVP_BITS,
?AVP_UNSUPPORTED,
?TOO_MANY,
?UNSUPPORTED_VERSION,
?INVALID_AVP_LENGTH}.
%% Send an ACR and expect success.
send_ok(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 1}],
['ACA' | #{'Result-Code' := ?SUCCESS,
'Session-Id' := _}]
= call(Config, Req).
%% Send an accounting ACR that the server answers badly to.
send_nok(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 0}],
?answer_message(?INVALID_AVP_BITS)
= call(Config, Req).
%% Send an ACR and expect success.
send_eval(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 3}],
['ACA' | #{'Result-Code' := ?SUCCESS,
'Session-Id' := _}]
= call(Config, Req).
%% Send an accounting ACR that the server tries to answer with an
%% inappropriate header. That the error is detected is coded in
%% handle_answer.
send_bad_answer(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 2}],
?answer_message(?SUCCESS)
= call(Config, Req).
%% Send an ACR that the server callback answers explicitly with a
%% protocol error.
send_protocol_error(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 4}],
?answer_message(?TOO_BUSY)
= call(Config, Req).
%% Send a 3xxx Experimental-Result in an answer not setting the E-bit
%% and missing a Result-Code.
send_experimental_result(Config) ->
Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
{'Accounting-Record-Number', 5}],
['ACA' | #{'Session-Id' := _}]
= call(Config, Req).
%% Send an ASR with an arbitrary non-mandatory AVP and expect success
%% and the same AVP in the reply.
send_arbitrary(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name',
value = "XXX"}]}],
['ASA' | #{'Session-Id' := _,
'Result-Code' := ?SUCCESS,
'AVP' := [#diameter_avp{name = 'Product-Name',
value = V}]}]
= call(Config, Req),
"XXX" = string(V, Config).
%% Send an unknown AVP (to some client) and check that it comes back.
send_unknown(Config) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
is_mandatory = false,
data = <<17>>}]}],
['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.
send_unknown_short(Config) ->
send_unknown_short(Config, false, ?INVALID_AVP_LENGTH).
send_unknown_short(Config, M, RC) ->
Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
is_mandatory = M,
data = <<17>>}]}],
['ASA' | #{'Session-Id' := _,
'Result-Code' := RC,
'Failed-AVP' := Avps}]
= call(Config, Req),
[[#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,
'Failed-AVP' := Avps}]
= call(Config, Req),
[[#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.
send_unknown_short_mandatory(Config) ->
send_unknown_short(Config, true, ?INVALID_AVP_LENGTH).
%% Send an ASR containing an unexpected mandatory Session-Timeout.
%% Expect 5001, and check that the value in Failed-AVP was decoded.
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,
'Failed-AVP' := Avps}]
= call(Config, Req),
[[#diameter_avp{code = 27,
is_mandatory = true,
value = 12,
data = <<12:32>>}]]
= failed_avps(Avps, Config).
%% Try to two Auth-Application-Id in ASR expect 5009.
send_too_many(Config) ->
Req = ['ASR', {'Auth-Application-Id', [?APP_ID, 44]}],
['ASA' | #{'Session-Id' := _,
'Result-Code' := ?TOO_MANY,
'Failed-AVP' := Avps}]
= call(Config, Req),
[[#diameter_avp{name = 'Auth-Application-Id',
value = 44}]]
= 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
%% Failed-AVP. The encoded values of Proxy-Host and Proxy-State are
%% swapped in prepare_request since an empty Proxy-Host is an encode
%% error.
send_grouped_error(Config) ->
Req = ['ASR', {'Proxy-Info', [[{'Proxy-Host', "abcd"},
{'Proxy-State', ""}]]}],
['ASA' | #{'Session-Id' := _,
'Result-Code' := ?INVALID_AVP_LENGTH,
'Failed-AVP' := Avps}]
= call(Config, Req),
[[#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.
send_noreply(Config) ->
Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
{timeout, _} = call(Config, Req).
%% Send an unsupported command and expect 3001.
send_unsupported(Config) ->
Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
?answer_message(?COMMAND_UNSUPPORTED)
= call(Config, Req).
%% Send an unsupported application and expect 3007.
send_unsupported_app(Config) ->
Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
?answer_message(?APPLICATION_UNSUPPORTED)
= call(Config, Req).
%% Send a request with the E bit set and expect 3008.
send_error_bit(Config) ->
Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
?answer_message(?INVALID_HDR_BITS)
= call(Config, Req).
%% 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}]
= call(Config, Req).
%% Send a request containing an AVP length > data size.
send_long_avp_length(Config) ->
send_invalid_avp_length(Config).
%% Send a request containing an AVP length < data size.
send_short_avp_length(Config) ->
send_invalid_avp_length(Config).
%% Send a request containing an AVP whose advertised length is < 8.
send_zero_avp_length(Config) ->
send_invalid_avp_length(Config).
%% Send a request containing an AVP length that doesn't match the
%% AVP's type.
send_invalid_avp_length(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
['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.
send_invalid_reject(Config) ->
Req = ['STR', {'Termination-Cause', ?USER_MOVED}],
?answer_message(?TOO_BUSY)
= call(Config, Req).
%% Send an STR containing a known AVP, but one that's not expected and
%% that sets the M-bit.
send_unexpected_mandatory(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
['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}]
= call(Config, Req).
%% Send something longer than the configure incoming_maxlen.
send_maxlen(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'User-Name', [binary:copy(<<$X>>, 1 bsl 21)]}],
{timeout, _} = call(Config, Req).
%% Send something for which pick_peer finds no suitable peer.
send_nopeer(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
{error, no_connection} = call(Config, Req, [{extra, [?EXTRA]}]).
%% Send something on an unconfigured application.
send_noapp(Config) ->
#group{client_service = CN}
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
{error, no_connection} = diameter:call(CN, unknown_alias, Req).
%% Send something that's discarded by prepare_request.
send_discard(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
{error, unprepared} = call(Config, Req).
%% Send with a disjunctive filter.
send_any_1(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
{error, no_connection} = call(Config, Req, [{filter, {any, []}}]).
send_any_2(Config) ->
#group{server_service = SN}
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Host', [?HOST(SN, "unknown.org")]}],
?answer_message(?UNABLE_TO_DELIVER)
= call(Config, Req, [{filter, {first, [{all, [host, realm]},
realm]}}]).
%% Send with a conjunctive filter.
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}]
= call(Config, Req, [{filter, {all, [{host, any},
{realm, Realm}]}}]).
send_all_2(Config) ->
#group{server_service = SN}
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Host', [?HOST(SN, "unknown.org")]}],
{error, no_connection}
= call(Config, Req, [{filter, {all, [host, realm]}}]).
%% Timeout before the server manages an answer.
send_timeout(Config) ->
Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}],
{timeout, _} = call(Config, Req, [{timeout, 1000}]).
%% Explicitly answer with an answer-message and ensure that we
%% received the Session-Id.
send_error(Config) ->
Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}],
?answer_message([_], ?TOO_BUSY)
= call(Config, Req).
%% Send a request with the detached option and receive it as a message
%% from handle_answer instead.
send_detach(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
Ref = make_ref(),
ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]),
['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) ->
{error, encode} = call(Config, ['STR', {'Termination-Cause', huh}]).
%% Send with filtering and expect success.
send_destination_1(Config) ->
#group{server_service = SN}
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Host', [?HOST(SN, ?REALM)]}],
['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}]
= call(Config, Req, [{filter, {all, [host, realm]}}]).
%% Send with filtering on and expect failure when specifying an
%% unknown host or realm.
send_destination_3(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Realm', <<"unknown.org">>}],
{error, no_connection}
= call(Config, Req, [{filter, {all, [host, realm]}}]).
send_destination_4(Config) ->
#group{server_service = SN}
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Host', [?HOST(SN, ["unknown.org"])]}],
{error, no_connection}
= call(Config, Req, [{filter, {all, [host, realm]}}]).
%% Send without filtering and expect an error answer when specifying
%% an unknown host or realm.
send_destination_5(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Realm', [<<"unknown.org">>]}],
?answer_message(?REALM_NOT_SERVED)
= call(Config, Req).
send_destination_6(Config) ->
#group{server_service = SN}
= group(Config),
Req = ['STR', {'Termination-Cause', ?LOGOUT},
{'Destination-Host', [?HOST(SN, "unknown.org")]}],
?answer_message(?UNABLE_TO_DELIVER)
= call(Config, Req).
%% Specify an invalid option and expect failure.
send_bad_option_1(Config) ->
send_bad_option(Config, x).
send_bad_option_2(Config) ->
send_bad_option(Config, {extra, false}).
send_bad_option(Config, Opt) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
try call(Config, Req, [Opt]) of
T -> erlang:error({?MODULE, ?LINE, T})
catch
error: _ -> ok
end.
%% Specify an invalid filter and expect no matching peers.
send_bad_filter_1(Config) ->
send_bad_filter(Config, {all, none}).
send_bad_filter_2(Config) ->
send_bad_filter(Config, {host, x}).
send_bad_filter_3(Config) ->
send_bad_filter(Config, {eval, fun() -> true end}).
send_bad_filter_4(Config) ->
send_bad_filter(Config, {eval, {?MODULE, not_exported, []}}).
send_bad_filter(Config, F) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
{error, no_connection} = call(Config, Req, [{filter, 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}]
= send_multiple_filters(Config, [host, {eval, Fun}]).
send_multiple_filters_2(Config) ->
E = {erlang, is_tuple, []},
{error, no_connection}
= send_multiple_filters(Config, [realm, {neg, {eval, E}}]).
send_multiple_filters_3(Config) ->
E1 = [fun(#diameter_caps{}, ok) -> true end, ok],
E2 = {erlang, is_tuple, []},
E3 = {erlang, is_record, [diameter_caps]},
E4 = [{erlang, is_record, []}, diameter_caps],
['STA' | #{'Session-Id' := _,
'Result-Code' := ?SUCCESS}]
= send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]).
send_multiple_filters(Config, Fs) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
call(Config, Req, [{filter, F} || F <- Fs]).
%% Ensure that we can pass a request in any form to diameter:call/4,
%% only the return value from the prepare_request callback being
%% significant.
send_anything(Config) ->
['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).
string(V, Config) ->
#group{strings = B} = group(Config),
decode(V,B).
decode(S, true)
when is_list(S) ->
S;
decode(B, false)
when is_binary(B) ->
binary_to_list(B).
call(Config, Req) ->
call(Config, Req, []).
call(Config, Req, Opts) ->
Name = proplists:get_value(testcase, Config),
#group{encoding = Enc,
client_service = CN,
client_dict = Dict0}
= group(Config),
diameter:call(CN,
dict(Req, Dict0),
msg(Req, Enc, Dict0),
[{extra, [Name, diameter_lib:now()]} | Opts]).
origin({D,E}) ->
4*decode(D) + encode(E);
origin(N) ->
{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, 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);
d(_, Dict0) ->
Dict0.
acct(diameter_gen_base_rfc3588) ->
diameter_gen_base_accounting;
acct(diameter_gen_base_rfc6733) ->
diameter_gen_acct_rfc6733.
%% Set only values that aren't already.
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) ->
reset(Dict, Dict:'#get-'(F, A), FV, A)
end,
Rec,
Vs).
reset(Dict, E, FV, Rec)
when E == undefined;
E == [] ->
Dict:'#set-'(FV, Rec);
reset(_, _, _, Rec) ->
Rec.
%% ===========================================================================
%% diameter callbacks
%% peer_up/4
peer_up(_SvcName, _Peer, State, _Group) ->
State.
%% peer_down/3
peer_down(_SvcName, _Peer, State, _Group) ->
State.
%% pick_peer/7-8
pick_peer(Peers, _, [$C|_], _State, Group, Name, _)
when Name /= send_detach ->
find(Group, Peers).
pick_peer(_Peers, _, [$C|_], _State, _Group, send_nopeer, _, ?EXTRA) ->
false;
pick_peer(Peers, _, [$C|_], _State, Group, send_detach, _, {_,_}) ->
find(Group, Peers).
find(#group{encoding = E,
client_service = CN,
server_decoding = D},
[_|_] = Peers) ->
Id = {D,E},
[P] = [P || P <- Peers, id(Id, P, CN)],
{ok, P}.
id(Id, {Pid, _Caps}, SvcName) ->
[{ref, _}, {type, _}, {options, Opts} | _]
= diameter:service_info(SvcName, Pid),
lists:member({id, Id}, Opts).
%% prepare_request/6-7
prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, _, send_discard, _) ->
{discard, unprepared};
prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, Name, _) ->
{send, prepare(Pkt, Caps, Name, 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)
when is_binary(Bin) ->
io:format("~p: ~p~n", [T,P]).
%% prepare/4
prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
when N == send_unknown_short_mandatory;
N == send_unknown_short ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{header = #diameter_header{length = L},
bin = Bin}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
%% Find the unknown AVP data at the end of the message and alter
%% its length header.
{Padding, [17|_]} = lists:splitwith(fun(C) -> C == 0 end,
lists:reverse(binary_to_list(Bin))),
Offset = L - length(Padding) - 4,
<<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_dict = Dict0} = Group)
when N == send_long_avp_length;
N == send_short_avp_length;
N == send_zero_avp_length ->
Req = prepare(Pkt, Caps, Group),
%% Second last AVP in our STR is Auth-Application-Id of type
%% Unsigned32: set AVP Length to a value other than 12 and place
%% it last in the message (so as not to mess with Termination-Cause).
#diameter_packet{header = #diameter_header{length = L},
bin = B}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
Offset = L - 24, %% to Auth-Application-Id
<<H:Offset/binary,
Hdr:5/binary, 12:24, Data:4/binary,
T:12/binary>>
= B,
AL = case N of
send_long_avp_length -> 13;
send_short_avp_length -> 11;
send_zero_avp_length -> 0
end,
E#diameter_packet{bin = <<H/binary,
T/binary,
Hdr/binary, AL:24, Data/binary>>};
prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
when N == send_invalid_avp_length;
N == send_invalid_reject ->
Req = prepare(Pkt, Caps, Group),
%% Second last AVP in our STR is Auth-Application-Id of type
%% Unsigned32: send data of length 8.
#diameter_packet{header = #diameter_header{length = L},
bin = B0}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
Offset = L - 7 - 12, %% to AVP Length
<<H0:Offset/binary, 12:24, T:16/binary>> = B0,
<<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_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<V, Len:24, T/binary>>}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
{Code, Flags, undefined} = Dict0:avp_header('Proxy-State'),
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_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = Bin}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
{Code, Flags, undefined} = Dict0:avp_header('Proxy-Info'),
%% Find Proxy-Info by looking for its header.
Pattern = <<Code:32, Flags, 28:24>>,
{Offset, 8} = binary:match(Bin, Pattern),
%% Extract and swap Proxy-Host/State payloads.
<<H:Offset/binary,
PI:8/binary,
PH:5/binary,
12:24,
Payload:4/binary,
PS:5/binary,
8:24,
T/binary>>
= Bin,
E#diameter_packet{bin = <<H/binary,
PI/binary,
PH/binary,
8:24,
PS:5/binary,
12:24,
Payload/binary,
T/binary>>};
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_dict = Dict0}
= Group) ->
Req = prepare(Pkt, Caps, Group),
#diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>}
= E
= diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
E#diameter_packet{bin = <<H/binary, ?BAD_APP:32, T/binary>>};
prepare(Pkt, Caps, send_error_bit, Group) ->
#diameter_packet{header = Hdr} = Pkt,
Pkt#diameter_packet{header = Hdr#diameter_header{is_error = true},
msg = prepare(Pkt, Caps, Group)};
prepare(Pkt, Caps, send_unsupported_version, Group) ->
#diameter_packet{header = Hdr} = Pkt,
Pkt#diameter_packet{header = Hdr#diameter_header{version = 42},
msg = prepare(Pkt, Caps, Group)};
prepare(Pkt, Caps, send_anything, Group) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT}],
prepare(Pkt#diameter_packet{msg = Req}, Caps, Group);
prepare(Pkt, Caps, _Name, Group) ->
prepare(Pkt, Caps, Group).
%% prepare/3
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,
set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
{'Origin-Host', [OH]},
{'Origin-Realm', [OR]},
{'Destination-Realm', [DR]}]);
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,
set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
{'Origin-Host', [OH]},
{'Origin-Realm', [OR]},
{'Destination-Host', [DH]},
{'Destination-Realm', [DR]},
{'Auth-Application-Id', ?APP_ID}]);
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,
set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
{'Origin-Host', [OH]},
{'Origin-Realm', [OR]},
{'Destination-Realm', [DR]},
{'Auth-Application-Id', ?APP_ID}]);
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,
set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
{'Origin-Host', [OH]},
{'Origin-Realm', [OR]},
{'Destination-Host', [DH]},
{'Destination-Realm', [DR]},
{'Auth-Application-Id', ?APP_ID}]).
%% 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, _Group, _Name, _) ->
discard.
%% handle_answer/7-8
handle_answer(Pkt, Req, [$C|_], Peer, Group, Name, _) ->
answer(Pkt, Req, Peer, Name, Group).
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_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),
rec_to_map(answer(Ans, Es, Name), Dict).
%% Missing Result-Code and inappropriate Experimental-Result-Code.
answer(Rec, Es, send_experimental_result) ->
[{5004, #diameter_avp{name = 'Experimental-Result'}},
{5005, #diameter_avp{name = 'Result-Code'}}]
= Es,
Rec;
%% An inappropriate E-bit results in a decode error ...
answer(Rec, Es, send_bad_answer) ->
[{5004, #diameter_avp{name = 'Result-Code'}} | _] = Es,
Rec;
%% ... while other errors are reflected in Failed-AVP.
answer(Rec, [], _) ->
Rec.
app(_, send_unsupported_app, _) ->
?BAD_APP;
app(Req, _, Dict0) ->
Dict = dict(Req, Dict0),
Dict:id().
%% handle_error/7
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) ->
{error, Reason}.
%% 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, avps = As}
= Pkt,
_,
{_Ref, Caps},
#group{encoding = E,
server_decoding = D}
= Grp) ->
#diameter_header{end_to_end_id = EI,
hop_by_hop_id = HI}
= H,
{V,B} = ?CLIENT_MASK,
V = EI bsr B, %% assert
V = HI bsr B, %%
#diameter_caps{origin_state_id = {_,[Id]}} = 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};
wrap(_, _, {reply, [#diameter_header{} | _]} = T) ->
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(['ACR' | #{'Accounting-Record-Number' := 5}],
[Hdr | Avps],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
[H,R|T] = [A || N <- ['Origin-Host',
'Origin-Realm',
'Session-Id',
'Accounting-Record-Type',
'Accounting-Record-Number'],
#diameter_avp{} = A
<- [lists:keyfind(N, #diameter_avp.name, Avps)]],
Ans = [Hdr#diameter_header{is_request = false},
H#diameter_avp{data = OH},
R#diameter_avp{data = OR},
#diameter_avp{name = 'Experimental-Result',
code = 297,
need_encryption = false,
data = [#diameter_avp{data = {?DIAMETER_DICT_COMMON,
'Vendor-Id',
123}},
#diameter_avp{data
= {?DIAMETER_DICT_COMMON,
'Experimental-Result-Code',
3987}}]}
| T],
{reply, Ans};
request(Msg, _Avps, Caps) ->
request(Msg, Caps).
%% request/2
%% send_nok
request(['ACR' | #{'Accounting-Record-Number' := 0}],
_) ->
{eval_packet, {protocol_error, ?INVALID_AVP_BITS}, [fun log/2, invalid]};
%% send_bad_answer
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},
{'Session-Id', SId},
{'Origin-Host', OH},
{'Origin-Realm', OR},
{'Accounting-Record-Type', RT},
{'Accounting-Record-Number', RN}],
{reply, #diameter_packet{header = #diameter_header{is_error = true},%% NOT
msg = Ans}};
%% send_eval
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},
{'Session-Id', SId},
{'Origin-Host', OH},
{'Origin-Realm', OR},
{'Accounting-Record-Type', RT},
{'Accounting-Record-Number', RN}],
{eval, {reply, Ans}, {erlang, now, []}};
%% send_ok
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},
{'Session-Id', SId},
{'Origin-Host', OH},
{'Origin-Realm', OR},
{'Accounting-Record-Type', RT},
{'Accounting-Record-Number', RN}]};
%% send_protocol_error
request(['ACR' | #{'Accounting-Record-Number' := 4}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
Ans = ['answer-message', {'Result-Code', ?TOO_BUSY},
{'Origin-Host', OH},
{'Origin-Realm', OR}],
{reply, Ans};
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', maps:get('AVP', Avps, [])}]};
%% send_invalid_reject
request(['STR' | #{'Termination-Cause' := ?USER_MOVED}],
_Caps) ->
{protocol_error, ?TOO_BUSY};
%% send_noreply
request(['STR' | #{'Termination-Cause' := T}],
_Caps)
when T /= ?LOGOUT ->
discard;
%% send_destination_5
request(['STR' | #{'Destination-Realm' := R}],
#diameter_caps{origin_realm = {OR, _}})
when R /= undefined, R /= OR ->
{protocol_error, ?REALM_NOT_SERVED};
%% send_destination_6
request(['STR' | #{'Destination-Host' := [H]}],
#diameter_caps{origin_host = {OH, _}})
when H /= OH ->
{protocol_error, ?UNABLE_TO_DELIVER};
request(['STR' | #{'Session-Id' := SId}],
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
{reply, ['STA', {'Result-Code', ?SUCCESS},
{'Session-Id', SId},
{'Origin-Host', OH},
{'Origin-Realm', OR}]};
%% send_error/send_timeout
request(['RAR' | #{}], _Caps) ->
receive after 2000 -> {protocol_error, ?TOO_BUSY} end.
%% message/3
%%
%% Limit the number of messages received. More can be received if read
%% in the same packet.
message(recv = D, {[_], Bin}, N) ->
message(D, Bin, N);
message(Dir, #diameter_packet{bin = Bin}, N) ->
message(Dir, Bin, N);
%% incoming request
message(recv, <<_:32, 1:1, _/bits>> = Bin, N) ->
[Bin, N < 16, fun ?MODULE:message/3, N+1];
%% incoming answer
message(recv, Bin, _) ->
[Bin];
%% outgoing
message(send, Bin, _) ->
[Bin];
%% sent request
message(ack, <<_:32, 1:1, _/bits>>, _) ->
[];
%% sent answer or discarded request
message(ack, _, N) ->
[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)).