%% %% %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, <> = Bin, E#diameter_packet{bin = <>}; 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 <> = 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 = <>}; 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 <> = B0, <> = H0, %% assert E#diameter_packet{bin = <>}; prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict = Dict0} = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <>} = E = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), {Code, Flags, undefined} = Dict0:avp_header('Proxy-State'), Avp = <>, E#diameter_packet{bin = <>}; 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 = <>, {Offset, 8} = binary:match(Bin, Pattern), %% Extract and swap Proxy-Host/State payloads. <> = Bin, E#diameter_packet{bin = <>}; prepare(Pkt, Caps, send_unsupported, #group{client_dict = Dict0} = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <>} = E = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), E#diameter_packet{bin = <>}; prepare(Pkt, Caps, send_unsupported_app, #group{client_dict = Dict0} = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <>} = E = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), E#diameter_packet{bin = <>}; 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)).