1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2010-2021. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%
22%% Tests of traffic between two Diameter nodes, one client, one server.
23%% The traffic isn't meant to be sensible, just to exercise code.
24%%
25
26-module(diameter_traffic_SUITE).
27
28-export([suite/0,
29         all/0,
30         groups/0,
31         init_per_suite/0,
32         init_per_suite/1,
33         end_per_suite/1,
34         init_per_group/1,
35         init_per_group/2,
36         end_per_group/2,
37         init_per_testcase/2,
38         end_per_testcase/2]).
39
40%% testcases
41-export([rfc4005/1,
42         start/1,
43         start_services/1,
44         add_transports/1,
45         result_codes/1,
46         send_ok/1,
47         send_nok/1,
48         send_eval/1,
49         send_bad_answer/1,
50         send_protocol_error/1,
51         send_experimental_result/1,
52         send_arbitrary/1,
53         send_proxy_info/1,
54         send_unknown/1,
55         send_unknown_short/1,
56         send_unknown_mandatory/1,
57         send_unknown_short_mandatory/1,
58         send_noreply/1,
59         send_grouped_error/1,
60         send_unsupported/1,
61         send_unsupported_app/1,
62         send_error_bit/1,
63         send_unsupported_version/1,
64         send_long_avp_length/1,
65         send_short_avp_length/1,
66         send_zero_avp_length/1,
67         send_invalid_avp_length/1,
68         send_invalid_reject/1,
69         send_unexpected_mandatory_decode/1,
70         send_unexpected_mandatory/1,
71         send_too_many/1,
72         send_long/1,
73         send_maxlen/1,
74         send_nopeer/1,
75         send_noapp/1,
76         send_discard/1,
77         send_any_1/1,
78         send_any_2/1,
79         send_all_1/1,
80         send_all_2/1,
81         send_timeout/1,
82         send_error/1,
83         send_detach/1,
84         send_encode_error/1,
85         send_destination_1/1,
86         send_destination_2/1,
87         send_destination_3/1,
88         send_destination_4/1,
89         send_destination_5/1,
90         send_destination_6/1,
91         send_bad_option_1/1,
92         send_bad_option_2/1,
93         send_bad_filter_1/1,
94         send_bad_filter_2/1,
95         send_bad_filter_3/1,
96         send_bad_filter_4/1,
97         send_multiple_filters_1/1,
98         send_multiple_filters_2/1,
99         send_multiple_filters_3/1,
100         send_anything/1,
101         remove_transports/1,
102         empty/1,
103         stop_services/1,
104         stop/1]).
105
106%% diameter callbacks
107-export([peer_up/4,
108         peer_down/4,
109         pick_peer/7, pick_peer/8,
110         prepare_request/6, prepare_request/7,
111         prepare_retransmit/6,
112         handle_answer/7, handle_answer/8,
113         handle_error/7,
114         handle_request/4]).
115
116%% diameter_{tcp,sctp} callbacks
117-export([message/3]).
118
119-include_lib("kernel/include/inet_sctp.hrl").
120
121-include("diameter.hrl").
122-include("diameter_gen_base_rfc3588.hrl").
123-include("diameter_gen_base_accounting.hrl").
124%% The listening transports use RFC 3588 dictionaries, the client
125%% transports use either 3588 or 6733. (So can't use the record
126%% definitions in the latter case.)
127
128%% ===========================================================================
129
130%% Fraction of shuffle/parallel groups to randomly skip.
131-define(SKIP, 0.90).
132
133%% Positive number of testcases from which to select (randomly) from
134%% tc(), the list of testcases to run, or [] to run all. The random
135%% selection is to limit the time it takes for the suite to run.
136-define(LIMIT, #{tcp => 42, sctp => 5}).
137
138-define(util, diameter_util).
139
140-define(A, list_to_atom).
141-define(L, atom_to_list).
142-define(B, iolist_to_binary).
143
144%% Don't use is_record/2 since dictionary hrl's aren't included.
145%% (Since they define conflicting records with the same names.)
146-define(is_record(Rec, Name), (Name == element(1, Rec))).
147
148-define(ADDR, {127,0,0,1}).
149
150-define(REALM, "erlang.org").
151-define(HOST(Host, Realm), Host ++ [$.|Realm]).
152
153-define(EXTRA, an_extra_argument).
154
155%% Sequence mask for End-to-End and Hop-by-Hop identifiers.
156-define(CLIENT_MASK, {1,26}).  %% 1 in top 6 bits
157
158%% How to construct outgoing messages.
159-define(ENCODINGS, [list, record, map]).
160
161%% How to decode incoming messages.
162-define(DECODINGS, [record, none, map, list, record_from_map]).
163
164%% Which dictionary to use in the clients.
165-define(RFCS, [rfc3588, rfc6733, rfc4005]).
166
167%% Whether to decode stringish Diameter types to strings, or leave
168%% them as binary.
169-define(STRING_DECODES, [false, true]).
170
171%% Which transport protocol to use.
172-define(TRANSPORTS, [tcp, sctp]).
173
174%% Send from a dedicated process?
175-define(SENDERS, [true, false]).
176
177%% Message callbacks from diameter_{tcp,sctp}?
178-define(CALLBACKS, [true, false]).
179
180-record(group,
181        {transport,
182         strings,
183         encoding,
184         client_service,
185         client_dict,
186         client_sender,
187         server_service,
188         server_decoding,
189         server_sender,
190         server_throttle}).
191
192%% Not really what we should be setting unless the message is sent in
193%% the common application but diameter doesn't care.
194-define(APP_ID, ?DIAMETER_APP_ID_COMMON).
195
196%% An Application-ID the server doesn't support.
197-define(BAD_APP, 42).
198
199%% A common match when receiving answers in a client.
200-define(answer_message(SessionId, ResultCode),
201        ['answer-message' | #{'Session-Id' := SessionId,
202                              'Origin-Host' := _,
203                              'Origin-Realm' := _,
204                              'Result-Code' := ResultCode}]).
205-define(answer_message(ResultCode),
206        ['answer-message' | #{'Origin-Host' := _,
207                              'Origin-Realm' := _,
208                              'Result-Code' := ResultCode}]).
209
210%% Config for diameter:start_service/2.
211-define(SERVICE(Name, Grp),
212        [{'Origin-Host', Name ++ "." ++ ?REALM},
213         {'Origin-Realm', ?REALM},
214         {'Host-IP-Address', [?ADDR]},
215         {'Vendor-Id', 12345},
216         {'Product-Name', "OTP/diameter"},
217         {'Auth-Application-Id', [0]},  %% common messages
218         {'Acct-Application-Id', [3]},  %% base accounting
219         {restrict_connections, false},
220         {string_decode, Grp#group.strings},
221         {avp_dictionaries, [diameter_gen_doic_rfc7683]},
222         {incoming_maxlen, 1 bsl 21}
223         | [{application, [{dictionary, D},
224                           {module, [?MODULE, Grp]},
225                           {answer_errors, callback}]}
226            || D <- [diameter_gen_base_rfc3588,
227                     diameter_gen_base_accounting,
228                     diameter_gen_base_rfc6733,
229                     diameter_gen_acct_rfc6733,
230                     nas4005],
231               D /= nas4005 orelse have_nas()]]).
232
233-define(SUCCESS,
234        ?'DIAMETER_BASE_RESULT-CODE_SUCCESS').
235-define(COMMAND_UNSUPPORTED,
236        ?'DIAMETER_BASE_RESULT-CODE_COMMAND_UNSUPPORTED').
237-define(TOO_BUSY,
238        ?'DIAMETER_BASE_RESULT-CODE_TOO_BUSY').
239-define(APPLICATION_UNSUPPORTED,
240        ?'DIAMETER_BASE_RESULT-CODE_APPLICATION_UNSUPPORTED').
241-define(INVALID_HDR_BITS,
242        ?'DIAMETER_BASE_RESULT-CODE_INVALID_HDR_BITS').
243-define(INVALID_AVP_BITS,
244        ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_BITS').
245-define(AVP_UNSUPPORTED,
246        ?'DIAMETER_BASE_RESULT-CODE_AVP_UNSUPPORTED').
247-define(UNSUPPORTED_VERSION,
248        ?'DIAMETER_BASE_RESULT-CODE_UNSUPPORTED_VERSION').
249-define(TOO_MANY,
250        ?'DIAMETER_BASE_RESULT-CODE_AVP_OCCURS_TOO_MANY_TIMES').
251-define(REALM_NOT_SERVED,
252        ?'DIAMETER_BASE_RESULT-CODE_REALM_NOT_SERVED').
253-define(UNABLE_TO_DELIVER,
254        ?'DIAMETER_BASE_RESULT-CODE_UNABLE_TO_DELIVER').
255-define(INVALID_AVP_LENGTH,
256        ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_LENGTH').
257
258-define(EVENT_RECORD,
259        ?'DIAMETER_BASE_ACCOUNTING-RECORD-TYPE_EVENT_RECORD').
260-define(AUTHORIZE_ONLY,
261        ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY').
262-define(AUTHORIZE_AUTHENTICATE,
263        ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_AUTHENTICATE').
264
265-define(LOGOUT,
266        ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT').
267-define(BAD_ANSWER,
268        ?'DIAMETER_BASE_TERMINATION-CAUSE_BAD_ANSWER').
269-define(USER_MOVED,
270        ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED').
271
272%% ===========================================================================
273
274suite() ->
275    [{timetrap, {seconds, 10}}].
276
277all() ->
278    [rfc4005, start, result_codes, {group, traffic}, empty, stop].
279
280%% Redefine this to run one or more groups for debugging purposes.
281-define(GROUPS, []).
282%-define(GROUPS, [[sctp,rfc6733,record,map,false,false,true,false]]).
283
284%% Issues with gen_sctp sporadically cause huge numbers of failed
285%% testcases when running testcases in parallel.
286groups() ->
287    Names = names([] == ?GROUPS orelse ?GROUPS),
288    [{P, [P], Ts} || Ts <- [tc()], P <- [shuffle, parallel]]
289        ++
290        [{?util:name(N), [], [{group, if T == sctp; S -> shuffle;
291                                         true         -> parallel end}]}
292         || [T,_,_,_,S|_] = N <- Names]
293        ++
294        [{T, [], [{group, ?util:name(N)} || N <- Names,
295                                            T == hd(N)]}
296         || T <- ?TRANSPORTS]
297        ++
298        [{traffic, [], [{group, T} || T <- ?TRANSPORTS]}].
299
300names() ->
301    [[T,R,E,D,S,ST,SS,CS] || T  <- ?TRANSPORTS,
302                             R  <- ?RFCS,
303                             E  <- ?ENCODINGS,
304                             D  <- ?DECODINGS,
305                             S  <- ?STRING_DECODES,
306                             ST <- ?CALLBACKS,
307                             SS <- ?SENDERS,
308                             CS <- ?SENDERS,
309                             ?SKIP =< rand:uniform()].
310
311names(true) ->
312    names(names());
313
314names(Names) ->
315    [N || N <- Names,
316          [CS,SS|_] <- [lists:reverse(N)],
317          SS orelse CS].  %% avoid deadlock
318
319%% --------------------
320
321init_per_suite() ->
322    [{timetrap, {seconds, 60}}].
323
324init_per_suite(Config) ->
325    [{rfc4005, compile_and_load()}, {sctp, ?util:have_sctp()} | Config].
326
327end_per_suite(_Config) ->
328    code:delete(nas4005),
329    code:purge(nas4005),
330    ok.
331
332%% --------------------
333
334init_per_group(_) ->
335    [{timetrap, {seconds, 30}}].
336
337init_per_group(Name, Config)
338  when Name == shuffle;
339       Name == parallel ->
340    start_services(Config),
341    add_transports(Config),
342    replace({sleep, Name == parallel}, Config);
343
344init_per_group(sctp = Name, Config) ->
345    {_, Sctp} = lists:keyfind(Name, 1, Config),
346    if Sctp ->
347            Config;
348       true ->
349            {skip, Name}
350    end;
351
352init_per_group(Name, Config) ->
353    Nas = proplists:get_value(rfc4005, Config, false),
354    case ?util:name(Name) of
355        [_,R,_,_,_,_,_,_] when R == rfc4005, true /= Nas ->
356            {skip, rfc4005};
357        [T,R,E,D,S,ST,SS,CS] ->
358            G = #group{transport = T,
359                       strings = S,
360                       encoding = E,
361                       client_service = [$C|?util:unique_string()],
362                       client_dict = appdict(R),
363                       client_sender = CS,
364                       server_service = [$S|?util:unique_string()],
365                       server_decoding = D,
366                       server_sender = SS,
367                       server_throttle = ST},
368            replace([{group, G}, {runlist, select(T)}], Config);
369        _ ->
370            Config
371    end.
372
373end_per_group(Name, Config)
374  when Name == shuffle;
375       Name == parallel ->
376    remove_transports(Config),
377    stop_services(Config);
378
379end_per_group(_, _) ->
380    ok.
381
382select(T) ->
383    try maps:get(T, ?LIMIT) of
384        N ->
385            lists:sublist(?util:scramble(tc()), max(5, rand:uniform(N)))
386    catch
387        error:_ -> ?LIMIT
388    end.
389
390%% --------------------
391
392%% Work around common_test accumulating Config improperly, causing
393%% testcases to get Config from groups and suites they're not in.
394init_per_testcase(N, Config)
395  when N == rfc4005;
396       N == start;
397       N == result_codes;
398       N == empty;
399       N == stop ->
400    Config;
401
402%% Skip testcases that can reasonably fail under SCTP.
403init_per_testcase(Name, Config) ->
404    TCs = proplists:get_value(runlist, Config, []),
405    Run = [] == TCs orelse lists:member(Name, TCs),
406    case [G || #group{transport = sctp} = G
407                   <- [proplists:get_value(group, Config)]]
408    of
409        [_] when Name == send_maxlen;
410                 Name == send_long ->
411            {skip, sctp};
412        _ when not Run ->
413            {skip, random};
414        _ ->
415            proplists:get_value(sleep, Config, false)
416                andalso timer:sleep(rand:uniform(200)),
417            [{testcase, Name} | Config]
418    end.
419
420end_per_testcase(_, _) ->
421    ok.
422
423%% replace/2
424%%
425%% Work around common_test running init functions inappropriately, and
426%% this accumulating more config than expected.
427
428replace(Pairs, Config)
429  when is_list(Pairs) ->
430    lists:foldl(fun replace/2, Config, Pairs);
431
432replace({Key, _} = T, Config) ->
433    [T | lists:keydelete(Key, 1, Config)].
434
435%% --------------------
436
437%% Testcases to run when services are started and connections
438%% established.
439tc() ->
440    [send_ok,
441     send_nok,
442     send_eval,
443     send_bad_answer,
444     send_protocol_error,
445     send_experimental_result,
446     send_arbitrary,
447     send_proxy_info,
448     send_unknown,
449     send_unknown_short,
450     send_unknown_mandatory,
451     send_unknown_short_mandatory,
452     send_noreply,
453     send_grouped_error,
454     send_unsupported,
455     send_unsupported_app,
456     send_error_bit,
457     send_unsupported_version,
458     send_long_avp_length,
459     send_short_avp_length,
460     send_zero_avp_length,
461     send_invalid_avp_length,
462     send_invalid_reject,
463     send_unexpected_mandatory_decode,
464     send_unexpected_mandatory,
465     send_too_many,
466     send_long,
467     send_maxlen,
468     send_nopeer,
469     send_noapp,
470     send_discard,
471     send_any_1,
472     send_any_2,
473     send_all_1,
474     send_all_2,
475     send_timeout,
476     send_error,
477     send_detach,
478     send_encode_error,
479     send_destination_1,
480     send_destination_2,
481     send_destination_3,
482     send_destination_4,
483     send_destination_5,
484     send_destination_6,
485     send_bad_option_1,
486     send_bad_option_2,
487     send_bad_filter_1,
488     send_bad_filter_2,
489     send_bad_filter_3,
490     send_bad_filter_4,
491     send_multiple_filters_1,
492     send_multiple_filters_2,
493     send_multiple_filters_3,
494     send_anything].
495
496%% ===========================================================================
497%% start/stop testcases
498
499start(_Config) ->
500    ok = diameter:start().
501
502start_services(Config) ->
503    #group{client_service = CN,
504           server_service = SN,
505           server_decoding = SD}
506        = Grp
507        = group(Config),
508    ok = diameter:start_service(SN, [{traffic_counters, bool()},
509                                     {decode_format, SD}
510                                     | ?SERVICE(SN, Grp)]),
511    ok = diameter:start_service(CN, [{traffic_counters, bool()},
512                                     {sequence, ?CLIENT_MASK},
513                                     {decode_format, map},
514                                     {strict_arities, decode}
515                                     | ?SERVICE(CN, Grp)]).
516
517bool() ->
518    0.5 =< rand:uniform().
519
520add_transports(Config) ->
521    #group{transport = T,
522           encoding = E,
523           client_service = CN,
524           client_sender = CS,
525           server_service = SN,
526           server_sender = SS,
527           server_throttle = ST}
528        = group(Config),
529    LRef = ?util:listen(SN,
530                        [T,
531                         {sender, SS},
532                         {message_cb, ST andalso {?MODULE, message, [0]}}]
533                        ++ [{packet, hd(?util:scramble([false, raw]))}
534                            || T == sctp andalso CS]
535                        ++ [{unordered, unordered()} || T == sctp],
536                        [{capabilities_cb, fun capx/2},
537                         {pool_size, 8}
538                         | server_apps()]),
539    Cs = [?util:connect(CN,
540                        [T, {sender, CS} | client_opts(T)],
541                        LRef,
542                        [{id, Id}
543                         | client_apps(R, [{'Origin-State-Id', origin(Id)}])])
544          || D <- ?DECODINGS,  %% for multiple candidate peers
545             R <- ?RFCS,
546             R /= rfc4005 orelse have_nas(),
547             Id <- [{D,E}]],
548    ?util:write_priv(Config, "transport", [LRef | Cs]).
549
550unordered() ->
551    element(rand:uniform(4), {true, false, 1, 2}).
552
553client_opts(tcp) ->
554    [];
555client_opts(sctp) ->
556    [{unordered, unordered()}
557     | [{sctp_initmsg, #sctp_initmsg{num_ostreams = N,
558                                     max_instreams = 5}}
559        || N <- [rand:uniform(8)],
560           N =< 6]].
561
562server_apps() ->
563    B = have_nas(),
564    [{applications, [diameter_gen_base_rfc3588,
565                     diameter_gen_base_accounting]
566                    ++ [nas4005 || B]},
567     {capabilities, [{'Auth-Application-Id', [0] ++ [1 || B]}, %% common, NAS
568                     {'Acct-Application-Id', [3]}]}].          %% accounting
569
570client_apps(D, Caps) ->
571    if D == rfc4005 ->
572            [{applications, [nas4005]},
573             {capabilities, [{'Auth-Application-Id', [1]},     %% NAS
574                             {'Acct-Application-Id', []}
575                             | Caps]}];
576       true ->
577            D0 = dict0(D),
578            [{applications, [acct(D0), D0]},
579             {capabilities, Caps}]
580    end.
581
582have_nas() ->
583    false /= code:is_loaded(nas4005).
584
585remove_transports(Config) ->
586    #group{client_service = CN,
587           server_service = SN}
588        = group(Config),
589    [LRef | Cs] = ?util:read_priv(Config, "transport"),
590    try
591        [] = [T || C <- Cs, T <- [?util:disconnect(CN, C, SN, LRef)], T /= ok]
592    after
593        ok = diameter:remove_transport(SN, LRef)
594    end.
595
596stop_services(Config) ->
597    #group{client_service = CN,
598           server_service = SN}
599        = group(Config),
600    ok = diameter:stop_service(CN),
601    ok = diameter:stop_service(SN).
602
603%% Ensure even transports have been removed from request table.
604empty(_Config) ->
605    [] = ets:tab2list(diameter_request).
606
607stop(_Config) ->
608    ok = diameter:stop().
609
610capx(_, #diameter_caps{origin_host = {OH,DH}}) ->
611    io:format("connection: ~p -> ~p~n", [DH,OH]),
612    ok.
613
614%% ===========================================================================
615
616%% Fail only this testcase if the RFC 4005 dictionary hasn't been
617%% successfully compiled and loaded.
618rfc4005(Config) ->
619    true = proplists:get_value(rfc4005, Config).
620
621%% Ensure that result codes have the expected values.
622result_codes(_Config) ->
623    {2001,
624     3001, 3002, 3003, 3004, 3007, 3008, 3009,
625     5001, 5009, 5011, 5014}
626        = {?SUCCESS,
627           ?COMMAND_UNSUPPORTED,
628           ?UNABLE_TO_DELIVER,
629           ?REALM_NOT_SERVED,
630           ?TOO_BUSY,
631           ?APPLICATION_UNSUPPORTED,
632           ?INVALID_HDR_BITS,
633           ?INVALID_AVP_BITS,
634           ?AVP_UNSUPPORTED,
635           ?TOO_MANY,
636           ?UNSUPPORTED_VERSION,
637           ?INVALID_AVP_LENGTH}.
638
639%% Send an ACR and expect success.
640send_ok(Config) ->
641    Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
642                  {'Accounting-Record-Number', 1}],
643    ['ACA' | #{'Result-Code' := ?SUCCESS,
644               'Session-Id' := _}]
645        = call(Config, Req).
646
647%% Send an accounting ACR that the server answers badly to.
648send_nok(Config) ->
649    Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
650                  {'Accounting-Record-Number', 0}],
651
652    ?answer_message(?INVALID_AVP_BITS)
653        = call(Config, Req).
654
655%% Send an ACR and expect success.
656send_eval(Config) ->
657    Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
658                  {'Accounting-Record-Number', 3}],
659
660    ['ACA' | #{'Result-Code' := ?SUCCESS,
661               'Session-Id' := _}]
662        = call(Config, Req).
663
664%% Send an accounting ACR that the server tries to answer with an
665%% inappropriate header. That the error is detected is coded in
666%% handle_answer.
667send_bad_answer(Config) ->
668    Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
669                  {'Accounting-Record-Number', 2}],
670    ?answer_message(?SUCCESS)
671        = call(Config, Req).
672
673%% Send an ACR that the server callback answers explicitly with a
674%% protocol error and some AVPs to check the decoding of.
675send_protocol_error(Config) ->
676    Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
677                  {'Accounting-Record-Number', 4}],
678
679    ['answer-message' | #{'Result-Code' := ?TOO_BUSY,
680                          'AVP' := [OLR | _]} = Avps]
681        = call(Config, Req),
682
683    #diameter_avp{name = 'OC-OLR',
684                  value = #{'OC-Sequence-Number' := 1,
685                            'OC-Report-Type' := 0,  %% HOST_REPORT
686                            'OC-Reduction-Percentage' := [25],
687                            'OC-Validity-Duration' := [60],
688                            'AVP' := [OSF]}}
689        = OLR,
690    #diameter_avp{name = 'OC-Supported-Features',
691                  value = #{} = Fs}
692        = OSF,
693    0 = maps:size(Fs),
694
695    #group{client_dict = D} = group(Config),
696
697    if D == nas4005 ->
698            error = maps:find('Failed-AVP', Avps),
699            #{'AVP' := [_,Failed]}
700                = Avps,
701            #diameter_avp{name = 'Failed-AVP',
702                          value = #{'AVP' := [NP,FR,AP]}}
703                = Failed,
704            #diameter_avp{name = 'NAS-Port',
705                          value = 44}
706                = NP,
707            #diameter_avp{name = 'Firmware-Revision',
708                          value = 12}
709                = FR,
710            #diameter_avp{name = 'Auth-Grace-Period',
711                          value = 13}
712                = AP;
713
714       D == diameter_gen_base_rfc3588;
715       D == diameter_gen_basr_accounting ->
716            error = maps:find('Failed-AVP', Avps),
717            #{'AVP' := [_,Failed]}
718                = Avps,
719
720            #diameter_avp{name = 'Failed-AVP',
721                           value = #{'AVP' := [NP,FR,AP]}}
722                = Failed,
723            #diameter_avp{name = undefined,
724                          value = undefined}
725                = NP,
726            #diameter_avp{name = 'Firmware-Revision',
727                          value = 12}
728                = FR,
729            #diameter_avp{name = 'Auth-Grace-Period',
730                          value = 13}
731                = AP;
732
733       D == diameter_gen_base_rfc6733;
734       D == diameter_gen_acct_rfc6733 ->
735            #{'Failed-AVP' := [#{'AVP' := [NP,FR,AP]}],
736              'AVP' := [_]}
737                = Avps,
738            #diameter_avp{name = undefined,
739                          value = undefined}
740                = NP,
741            #diameter_avp{name = 'Firmware-Revision',
742                          value = 12}
743                = FR,
744            #diameter_avp{name = 'Auth-Grace-Period',
745                          value = 13}
746                = AP
747    end.
748
749%% Send a 3xxx Experimental-Result in an answer not setting the E-bit
750%% and missing a Result-Code.
751send_experimental_result(Config) ->
752    Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD},
753                  {'Accounting-Record-Number', 5}],
754    ['ACA' | #{'Session-Id' := _}]
755        = call(Config, Req).
756
757%% Send an ASR with an arbitrary non-mandatory AVP and expect success
758%% and the same AVP in the reply.
759send_arbitrary(Config) ->
760    Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name',
761                                         value = "XXX"}]}],
762    ['ASA' | #{'Session-Id' := _,
763               'Result-Code' := ?SUCCESS,
764               'AVP' := [#diameter_avp{name = 'Product-Name',
765                                       value = V}]}]
766        = call(Config, Req),
767    "XXX" = string(V, Config).
768
769%% Send Proxy-Info in an ASR that the peer answers with 3xxx, and
770%% ensure that the AVP is returned.
771send_proxy_info(Config) ->
772    H0 = ?B(?util:unique_string()),
773    S0 = ?B(?util:unique_string()),
774    Req = ['ASR', {'Proxy-Info', #{'Proxy-Host'  => H0,
775                                   'Proxy-State' => S0}}],
776    ['answer-message' | #{'Result-Code' := 3999,
777                          'Proxy-Info' := [#{'Proxy-Host' := H,
778                                             'Proxy-State' := S}]}]
779        = call(Config, Req),
780    [H0, S0] = [?B(X) || X <- [H,S]].
781
782%% Send an unknown AVP (to some client) and check that it comes back.
783send_unknown(Config) ->
784    Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
785                                         is_mandatory = false,
786                                         data = <<17>>}]}],
787    ['ASA' | #{'Session-Id' := _,
788               'Result-Code' := ?SUCCESS,
789               'AVP' := [#diameter_avp{code = 999,
790                                       is_mandatory = false,
791                                       data = <<17>>}]}]
792        = call(Config, Req).
793
794%% Ditto, and point the AVP length past the end of the message. Expect
795%% 5014.
796send_unknown_short(Config) ->
797    send_unknown_short(Config, false, ?INVALID_AVP_LENGTH).
798
799send_unknown_short(Config, M, RC) ->
800    Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
801                                         is_mandatory = M,
802                                         data = <<17>>}]}],
803    ['ASA' | #{'Session-Id' := _,
804               'Result-Code' := RC,
805               'Failed-AVP' := [#{'AVP' := [Avp]}]}]
806        = call(Config, Req),
807    #diameter_avp{code = 999,
808                  is_mandatory = M,
809                  data = <<17, _/binary>>} %% extra bits from padding
810        = Avp.
811
812%% Ditto but set the M flag.
813send_unknown_mandatory(Config) ->
814    Req = ['ASR', {'AVP', [#diameter_avp{code = 999,
815                                         is_mandatory = true,
816                                         data = <<17>>}]}],
817    ['ASA' | #{'Session-Id' := _,
818               'Result-Code' := ?AVP_UNSUPPORTED,
819               'Failed-AVP' := [#{'AVP' := [Avp]}]}]
820        = call(Config, Req),
821    #diameter_avp{code = 999,
822                  is_mandatory = true,
823                  data = <<17>>}
824        = Avp.
825
826%% Ditto, and point the AVP length past the end of the message. Expect
827%% 5014 instead of 5001.
828send_unknown_short_mandatory(Config) ->
829    send_unknown_short(Config, true, ?INVALID_AVP_LENGTH).
830
831%% Send an ASR containing an unexpected mandatory Session-Timeout.
832%% Expect 5001, and check that the value in Failed-AVP was decoded.
833send_unexpected_mandatory_decode(Config) ->
834    Req = ['ASR', {'AVP', [#diameter_avp{code = 27,  %% Session-Timeout
835                                         is_mandatory = true,
836                                         data = <<12:32>>}]}],
837    ['ASA' | #{'Session-Id' := _,
838               'Result-Code' := ?AVP_UNSUPPORTED,
839               'Failed-AVP' := [#{'AVP' := [Avp]}]}]
840        = call(Config, Req),
841    #diameter_avp{code = 27,
842                  is_mandatory = true,
843                  value = 12,
844                  data = <<12:32>>}
845        = Avp.
846
847%% Try to two Auth-Application-Id in ASR expect 5009.
848send_too_many(Config) ->
849    Req = ['ASR', {'Auth-Application-Id', [?APP_ID, 44]}],
850
851    ['ASA' | #{'Session-Id' := _,
852               'Result-Code' := ?TOO_MANY,
853               'Failed-AVP' := [#{'AVP' := [Avp]}]}]
854        = call(Config, Req),
855    #diameter_avp{name = 'Auth-Application-Id',
856                  value = 44}
857        = Avp.
858
859%% Send an containing a faulty Grouped AVP (empty Proxy-Host in
860%% Proxy-Info) and expect that only the faulty AVP is sent in
861%% Failed-AVP. The encoded values of Proxy-Host and Proxy-State are
862%% swapped in prepare_request since an empty Proxy-Host is an encode
863%% error.
864send_grouped_error(Config) ->
865    Req = ['ASR', {'Proxy-Info', [[{'Proxy-Host', "abcd"},
866                                   {'Proxy-State', ""}]]}],
867    ['ASA' | #{'Session-Id' := _,
868               'Result-Code' := ?INVALID_AVP_LENGTH,
869               'Failed-AVP' := [#{'AVP' := [Avp]}]}]
870        = call(Config, Req),
871    #diameter_avp{name = 'Proxy-Info', value = #{'Proxy-Host' := H}}
872        = Avp,
873    <<0>> = ?B(H).
874
875%% Send an STR that the server ignores.
876send_noreply(Config) ->
877    Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
878    {timeout, _} = call(Config, Req).
879
880%% Send an unsupported command and expect 3001.
881send_unsupported(Config) ->
882    Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
883    ?answer_message(?COMMAND_UNSUPPORTED)
884        = call(Config, Req).
885
886%% Send an unsupported application and expect 3007.
887send_unsupported_app(Config) ->
888    Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
889    ?answer_message(?APPLICATION_UNSUPPORTED)
890        = call(Config, Req).
891
892%% Send a request with the E bit set and expect 3008.
893send_error_bit(Config) ->
894    Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}],
895    ?answer_message(?INVALID_HDR_BITS)
896        = call(Config, Req).
897
898%% Send a bad version and check that we get 5011.
899send_unsupported_version(Config) ->
900    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
901    ['STA' | #{'Session-Id' := _,
902               'Result-Code' := ?UNSUPPORTED_VERSION}]
903        = call(Config, Req).
904
905%% Send a request containing an AVP length > data size.
906send_long_avp_length(Config) ->
907    send_invalid_avp_length(Config).
908
909%% Send a request containing an AVP length < data size.
910send_short_avp_length(Config) ->
911    send_invalid_avp_length(Config).
912
913%% Send a request containing an AVP whose advertised length is < 8.
914send_zero_avp_length(Config) ->
915    send_invalid_avp_length(Config).
916
917%% Send a request containing an AVP length that doesn't match the
918%% AVP's type.
919send_invalid_avp_length(Config) ->
920    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
921
922    ['STA' | #{'Session-Id' := _,
923               'Result-Code' := ?INVALID_AVP_LENGTH,
924               'Origin-Host' := _,
925               'Origin-Realm' := _,
926               'Failed-AVP' := [#{'AVP' := [_]}]}]
927        = call(Config, Req).
928
929%% Send a request containing 5xxx errors that the server rejects with
930%% 3xxx.
931send_invalid_reject(Config) ->
932    Req = ['STR', {'Termination-Cause', ?USER_MOVED}],
933
934    ?answer_message(?TOO_BUSY)
935        = call(Config, Req).
936
937%% Send an STR containing a known AVP, but one that's not expected and
938%% that sets the M-bit.
939send_unexpected_mandatory(Config) ->
940    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
941
942    ['STA' | #{'Session-Id' := _,
943               'Result-Code' := ?AVP_UNSUPPORTED}]
944        = call(Config, Req).
945
946%% Send something long that will be fragmented by TCP.
947send_long(Config) ->
948    Req = ['STR', {'Termination-Cause', ?LOGOUT},
949                  {'User-Name', [binary:copy(<<$X>>, 1 bsl 20)]}],
950    ['STA' | #{'Session-Id' := _,
951               'Result-Code' := ?SUCCESS}]
952        = call(Config, Req).
953
954%% Send something longer than the configure incoming_maxlen.
955send_maxlen(Config) ->
956    Req = ['STR', {'Termination-Cause', ?LOGOUT},
957                  {'User-Name', [binary:copy(<<$X>>, 1 bsl 21)]}],
958    {timeout, _} = call(Config, Req).
959
960%% Send something for which pick_peer finds no suitable peer.
961send_nopeer(Config) ->
962    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
963    {error, no_connection} = call(Config, Req, [{extra, [?EXTRA]}]).
964
965%% Send something on an unconfigured application.
966send_noapp(Config) ->
967    #group{client_service = CN}
968        = group(Config),
969    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
970    {error, no_connection} = diameter:call(CN, unknown_alias, Req).
971
972%% Send something that's discarded by prepare_request.
973send_discard(Config) ->
974    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
975    {error, unprepared} = call(Config, Req).
976
977%% Send with a disjunctive filter.
978send_any_1(Config) ->
979    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
980    {error, no_connection} = call(Config, Req, [{filter, {any, []}}]).
981send_any_2(Config) ->
982    #group{server_service = SN}
983        = group(Config),
984    Req = ['STR', {'Termination-Cause', ?LOGOUT},
985                  {'Destination-Host', [?HOST(SN, "unknown.org")]}],
986    ?answer_message(?UNABLE_TO_DELIVER)
987        = call(Config, Req, [{filter, {first, [{all, [host, realm]},
988                                               realm]}}]).
989
990%% Send with a conjunctive filter.
991send_all_1(Config) ->
992    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
993    Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM),
994    ['STA' | #{'Session-Id' := _,
995               'Result-Code' := ?SUCCESS}]
996        = call(Config, Req, [{filter, {all, [{host, any},
997                                             {realm, Realm}]}}]).
998send_all_2(Config) ->
999    #group{server_service = SN}
1000        = group(Config),
1001    Req = ['STR', {'Termination-Cause', ?LOGOUT},
1002                  {'Destination-Host', [?HOST(SN, "unknown.org")]}],
1003    {error, no_connection}
1004        = call(Config, Req, [{filter, {all, [host, realm]}}]).
1005
1006%% Timeout before the server manages an answer.
1007send_timeout(Config) ->
1008    Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}],
1009    {timeout, _} = call(Config, Req, [{timeout, 1000}]).
1010
1011%% Explicitly answer with an answer-message and ensure that we
1012%% received the Session-Id.
1013send_error(Config) ->
1014    Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}],
1015    ?answer_message([_], ?TOO_BUSY)
1016        = call(Config, Req).
1017
1018%% Send a request with the detached option and receive it as a message
1019%% from handle_answer instead.
1020send_detach(Config) ->
1021    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
1022    Ref = make_ref(),
1023    ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]),
1024    ['STA' | #{'Session-Id' := _,
1025               'Result-Code' := ?SUCCESS}]
1026        = receive {Ref, T} -> T end.
1027
1028%% Send a request which can't be encoded and expect {error, encode}.
1029send_encode_error(Config) ->
1030    {error, encode} = call(Config, ['STR', {'Termination-Cause', huh}]).
1031
1032%% Send with filtering and expect success.
1033send_destination_1(Config) ->
1034    #group{server_service = SN}
1035        = group(Config),
1036    Req = ['STR', {'Termination-Cause', ?LOGOUT},
1037                  {'Destination-Host', [?HOST(SN, ?REALM)]}],
1038    ['STA' | #{'Session-Id' := _,
1039               'Result-Code' := ?SUCCESS}]
1040        = call(Config, Req, [{filter, {all, [host, realm]}}]).
1041send_destination_2(Config) ->
1042    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
1043    ['STA' | #{'Session-Id' := _,
1044               'Result-Code' := ?SUCCESS}]
1045        = call(Config, Req, [{filter, {all, [host, realm]}}]).
1046
1047%% Send with filtering on and expect failure when specifying an
1048%% unknown host or realm.
1049send_destination_3(Config) ->
1050    Req = ['STR', {'Termination-Cause', ?LOGOUT},
1051                  {'Destination-Realm', <<"unknown.org">>}],
1052    {error, no_connection}
1053        = call(Config, Req, [{filter, {all, [host, realm]}}]).
1054send_destination_4(Config) ->
1055    #group{server_service = SN}
1056        = group(Config),
1057    Req = ['STR', {'Termination-Cause', ?LOGOUT},
1058                  {'Destination-Host', [?HOST(SN, ["unknown.org"])]}],
1059    {error, no_connection}
1060        = call(Config, Req, [{filter, {all, [host, realm]}}]).
1061
1062%% Send without filtering and expect an error answer when specifying
1063%% an unknown host or realm.
1064send_destination_5(Config) ->
1065    Req = ['STR', {'Termination-Cause', ?LOGOUT},
1066                  {'Destination-Realm', [<<"unknown.org">>]}],
1067    ?answer_message(?REALM_NOT_SERVED)
1068        = call(Config, Req).
1069send_destination_6(Config) ->
1070    #group{server_service = SN}
1071        = group(Config),
1072    Req = ['STR', {'Termination-Cause', ?LOGOUT},
1073                  {'Destination-Host', [?HOST(SN, "unknown.org")]}],
1074    ?answer_message(?UNABLE_TO_DELIVER)
1075        = call(Config, Req).
1076
1077%% Specify an invalid option and expect failure.
1078send_bad_option_1(Config) ->
1079    send_bad_option(Config, x).
1080send_bad_option_2(Config) ->
1081    send_bad_option(Config, {extra, false}).
1082
1083send_bad_option(Config, Opt) ->
1084    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
1085    try call(Config, Req, [Opt]) of
1086        T -> erlang:error({?MODULE, ?LINE, T})
1087    catch
1088        error: _ -> ok
1089    end.
1090
1091%% Specify an invalid filter and expect no matching peers.
1092send_bad_filter_1(Config) ->
1093    send_bad_filter(Config, {all, none}).
1094send_bad_filter_2(Config) ->
1095    send_bad_filter(Config, {host, x}).
1096send_bad_filter_3(Config) ->
1097    send_bad_filter(Config, {eval, fun() -> true end}).
1098send_bad_filter_4(Config) ->
1099    send_bad_filter(Config, {eval, {?MODULE, not_exported, []}}).
1100
1101send_bad_filter(Config, F) ->
1102    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
1103    {error, no_connection} = call(Config, Req, [{filter, F}]).
1104
1105%% Specify multiple filter options and expect them be conjunctive.
1106send_multiple_filters_1(Config) ->
1107    Fun = fun(#diameter_caps{}) -> true end,
1108    ['STA' | #{'Session-Id' := _,
1109               'Result-Code' := ?SUCCESS}]
1110        = send_multiple_filters(Config, [host, {eval, Fun}]).
1111send_multiple_filters_2(Config) ->
1112    E = {erlang, is_tuple, []},
1113    {error, no_connection}
1114        = send_multiple_filters(Config, [realm, {neg, {eval, E}}]).
1115send_multiple_filters_3(Config) ->
1116    E1 = [fun(#diameter_caps{}, ok) -> true end, ok],
1117    E2 = {erlang, is_tuple, []},
1118    E3 = {erlang, is_record, [diameter_caps]},
1119    E4 = [{erlang, is_record, []}, diameter_caps],
1120    ['STA' | #{'Session-Id' := _,
1121               'Result-Code' := ?SUCCESS}]
1122        = send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]).
1123
1124send_multiple_filters(Config, Fs) ->
1125    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
1126    call(Config, Req, [{filter, F} || F <- Fs]).
1127
1128%% Ensure that we can pass a request in any form to diameter:call/4,
1129%% only the return value from the prepare_request callback being
1130%% significant.
1131send_anything(Config) ->
1132    ['STA' | #{'Session-Id' := _,
1133               'Result-Code' := ?SUCCESS}]
1134        = call(Config, anything).
1135
1136%% ===========================================================================
1137
1138group(Config) ->
1139    #group{} = proplists:get_value(group, Config).
1140
1141string(V, Config) ->
1142    #group{strings = B} = group(Config),
1143    decode(V,B).
1144
1145decode(S, true)
1146  when is_list(S) ->
1147    S;
1148decode(B, false)
1149  when is_binary(B) ->
1150    binary_to_list(B).
1151
1152call(Config, Req) ->
1153    call(Config, Req, []).
1154
1155call(Config, Req, Opts) ->
1156    Name = proplists:get_value(testcase, Config),
1157    #group{encoding = Enc,
1158           client_service = CN,
1159           client_dict = Dict0}
1160        = group(Config),
1161    diameter:call(CN,
1162                  dict(Req, Dict0),
1163                  msg(Req, Enc, Dict0),
1164                  [{extra, [Name, diameter_lib:now()]} | Opts]).
1165
1166origin({D,E}) ->
1167    4*decode(D) + encode(E);
1168
1169origin(N) ->
1170    {decode(N bsr 2), encode(N rem 4)}.
1171
1172%% Map atoms. The atoms are part of (constructed) group names, so it's
1173%% good that they're readable.
1174
1175decode(record) -> 0;
1176decode(list)   -> 1;
1177decode(map)    -> 2;
1178decode(none)   -> 3;
1179decode(record_from_map) -> 4;
1180decode(0) -> record;
1181decode(1) -> list;
1182decode(2) -> map;
1183decode(3) -> none;
1184decode(4) -> record_from_map.
1185
1186encode(record) -> 0;
1187encode(list)   -> 1;
1188encode(map)    -> 2;
1189encode(0) -> record;
1190encode(1) -> list;
1191encode(2) -> map.
1192
1193msg([H|_] = Msg, record = E, diameter_gen_base_rfc3588)
1194  when H == 'ACR';
1195       H == 'ACA' ->
1196    msg(Msg, E, diameter_gen_base_accounting);
1197
1198msg([H|_] = Msg, record = E, diameter_gen_base_rfc6733)
1199  when H == 'ACR';
1200       H == 'ACA' ->
1201    msg(Msg, E, diameter_gen_acct_rfc6733);
1202
1203msg([H|T], record, Dict) ->
1204    Dict:'#new-'(Dict:msg2rec(H), T);
1205
1206msg([H|As], map, _)
1207  when is_list(As) ->
1208    [H | maps:from_list(As)];
1209
1210msg(Msg, _, _) ->
1211    Msg.
1212
1213to_map(#diameter_packet{msg = [_MsgName | Avps] = Msg},
1214       #group{server_decoding = map})
1215  when is_map(Avps) ->
1216    Msg;
1217
1218to_map(#diameter_packet{msg = [MsgName | Avps]},
1219       #group{server_decoding = list}) ->
1220    [MsgName | maps:from_list(Avps)];
1221
1222to_map(#diameter_packet{header = H, msg = Rec},
1223       #group{server_decoding = D})
1224  when D == record;
1225       D == record_from_map ->
1226    rec_to_map(Rec, dict(H));
1227
1228%% No record decode: do it ourselves.
1229to_map(#diameter_packet{header = H,
1230                        msg = Name,
1231                        bin = Bin},
1232      #group{server_decoding = none,
1233             strings = B}) ->
1234    Opts = #{decode_format => map,
1235             string_decode => B,
1236             avp_dictionaries => [diameter_gen_doic_rfc7683],
1237             strict_mbit => true,
1238             rfc => 6733},
1239    #diameter_packet{msg = [MsgName | _Map] = Msg}
1240        = diameter_codec:decode(dict(H), Opts, Bin),
1241    {MsgName, _} = {Name, Msg},  %% assert
1242    Msg.
1243
1244dict(#diameter_header{application_id = Id,
1245                      cmd_code = Code}) ->
1246    if Id == 1 ->
1247            nas4005;
1248       Code == 271 ->
1249            diameter_gen_base_accounting;
1250       true ->
1251            diameter_gen_base_rfc3588
1252    end.
1253
1254rec_to_map(Rec, Dict) ->
1255    [R | Vs] = Dict:'#get-'(Rec),
1256    [Dict:rec2msg(R) | maps:from_list([T || {_,V} = T <- Vs,
1257                                            V /= undefined,
1258                                            V /= []])].
1259
1260appdict(rfc4005) ->
1261    nas4005;
1262appdict(D) ->
1263    dict0(D).
1264
1265dict0(D) ->
1266    ?A("diameter_gen_base_" ++ ?L(D)).
1267
1268dict(Msg, Dict) ->
1269    d(name(Msg), Dict).
1270
1271d(N, nas4005 = D) ->
1272    if N == {list, 'answer-message'};
1273       N == {map, 'answer-message'};
1274       N == {record, 'diameter_base_answer-message'} ->
1275            diameter_gen_base_rfc3588;
1276       true ->
1277            D
1278    end;
1279d(N, Dict0)
1280  when N == {list, 'ACR'};
1281       N == {list, 'ACA'};
1282       N == {map, 'ACR'};
1283       N == {map, 'ACA'};
1284       N == {record, diameter_base_accounting_ACR};
1285       N == {record, diameter_base_accounting_ACA} ->
1286    acct(Dict0);
1287d(_, Dict0) ->
1288    Dict0.
1289
1290acct(diameter_gen_base_rfc3588) ->
1291    diameter_gen_base_accounting;
1292acct(diameter_gen_base_rfc6733) ->
1293    diameter_gen_acct_rfc6733.
1294
1295%% Set only values that aren't already.
1296
1297set(_, [N | As], Vs) ->
1298    [N | if is_map(As) ->
1299                 maps:merge(maps:from_list(Vs), As);
1300            is_list(As) ->
1301                 Vs ++ As
1302         end];
1303
1304set(#group{client_dict = Dict0} = _Group, Rec, Vs) ->
1305    Dict = dict(Rec, Dict0),
1306    lists:foldl(fun({F,_} = FV, A) ->
1307                        reset(Dict, Dict:'#get-'(F, A), FV, A)
1308                end,
1309                Rec,
1310                Vs).
1311
1312reset(Dict, E, FV, Rec)
1313  when E == undefined;
1314       E == [] ->
1315    Dict:'#set-'(FV, Rec);
1316
1317reset(_, _, _, Rec) ->
1318    Rec.
1319
1320%% ===========================================================================
1321%% diameter callbacks
1322
1323%% peer_up/4
1324
1325peer_up(_SvcName, _Peer, State, _Group) ->
1326    State.
1327
1328%% peer_down/3
1329
1330peer_down(_SvcName, _Peer, State, _Group) ->
1331    State.
1332
1333%% pick_peer/7-8
1334
1335pick_peer(Peers, _, [$C|_], _State, Group, Name, _)
1336  when Name /= send_detach ->
1337    find(Group, Peers).
1338
1339pick_peer(_Peers, _, [$C|_], _State, _Group, send_nopeer, _, ?EXTRA) ->
1340    false;
1341
1342pick_peer(Peers, _, [$C|_], _State, Group, send_detach, _, {_,_}) ->
1343    find(Group, Peers).
1344
1345find(#group{encoding = E,
1346            client_service = CN,
1347            server_decoding = D},
1348     [_|_] = Peers) ->
1349    Id = {D,E},
1350    [P] = [P || P <- Peers, id(Id, P, CN)],
1351    {ok, P}.
1352
1353id(Id, {Pid, _Caps}, SvcName) ->
1354    [{ref, _}, {type, _}, {options, Opts} | _]
1355        = diameter:service_info(SvcName, Pid),
1356    lists:member({id, Id}, Opts).
1357
1358%% prepare_request/6-7
1359
1360prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, _, send_discard, _) ->
1361    {discard, unprepared};
1362
1363prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, Name, _) ->
1364    {send, prepare(Pkt, Caps, Name, Group)}.
1365
1366prepare_request(Pkt, [$C|_], {_Ref, Caps}, Group, send_detach, _, _) ->
1367    {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}.
1368
1369log(#diameter_packet{bin = Bin} = P, T)
1370  when is_binary(Bin) ->
1371    io:format("~p: ~p~n", [T,P]).
1372
1373%% prepare/4
1374
1375prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
1376  when N == send_unknown_short_mandatory;
1377       N == send_unknown_short ->
1378    Req = prepare(Pkt, Caps, Group),
1379
1380    #diameter_packet{header = #diameter_header{length = L},
1381                     bin = Bin}
1382        = E
1383        = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
1384
1385    %% Find the unknown AVP data at the end of the message and alter
1386    %% its length header.
1387
1388    {Padding, [17|_]} = lists:splitwith(fun(C) -> C == 0 end,
1389                                       lists:reverse(binary_to_list(Bin))),
1390
1391    Offset = L - length(Padding) - 4,
1392    <<H:Offset/binary, Len:24, T/binary>> = Bin,
1393    E#diameter_packet{bin = <<H/binary, (Len+9):24, T/binary>>};
1394
1395prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
1396  when N == send_long_avp_length;
1397       N == send_short_avp_length;
1398       N == send_zero_avp_length ->
1399    Req = prepare(Pkt, Caps, Group),
1400    %% Second last AVP in our STR is Auth-Application-Id of type
1401    %% Unsigned32: set AVP Length to a value other than 12 and place
1402    %% it last in the message (so as not to mess with Termination-Cause).
1403    #diameter_packet{header = #diameter_header{length = L},
1404                     bin = B}
1405        = E
1406        = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
1407    Offset = L - 24,  %% to Auth-Application-Id
1408    <<H:Offset/binary,
1409      Hdr:5/binary, 12:24, Data:4/binary,
1410      T:12/binary>>
1411        = B,
1412    AL = case N of
1413             send_long_avp_length  -> 13;
1414             send_short_avp_length -> 11;
1415             send_zero_avp_length  -> 0
1416         end,
1417    E#diameter_packet{bin = <<H/binary,
1418                              T/binary,
1419                              Hdr/binary, AL:24, Data/binary>>};
1420
1421prepare(Pkt, Caps, N, #group{client_dict = Dict0} = Group)
1422  when N == send_invalid_avp_length;
1423       N == send_invalid_reject ->
1424    Req = prepare(Pkt, Caps, Group),
1425    %% Second last AVP in our STR is Auth-Application-Id of type
1426    %% Unsigned32: send data of length 8.
1427    #diameter_packet{header = #diameter_header{length = L},
1428                     bin = B0}
1429        = E
1430        = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
1431    Offset = L - 7 - 12,  %% to AVP Length
1432    <<H0:Offset/binary, 12:24, T:16/binary>> = B0,
1433    <<V, L:24, H/binary>> = H0,  %% assert
1434    E#diameter_packet{bin = <<V, (L+4):24, H/binary, 16:24, 0:32, T/binary>>};
1435
1436prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict = Dict0}
1437                                              = Group) ->
1438    Req = prepare(Pkt, Caps, Group),
1439    #diameter_packet{bin = <<V, Len:24, T/binary>>}
1440        = E
1441        = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
1442    {Code, Flags, undefined} = Dict0:avp_header('Proxy-State'),
1443    Avp = <<Code:32, Flags, 8:24>>,
1444    E#diameter_packet{bin = <<V, (Len+8):24, T/binary, Avp/binary>>};
1445
1446prepare(Pkt, Caps, send_grouped_error, #group{client_dict = Dict0}
1447                                              = Group) ->
1448    Req = prepare(Pkt, Caps, Group),
1449    #diameter_packet{bin = Bin}
1450        = E
1451        = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
1452    {Code, Flags, undefined} = Dict0:avp_header('Proxy-Info'),
1453    %% Find Proxy-Info by looking for its header.
1454    Pattern = <<Code:32, Flags, 28:24>>,
1455    {Offset, 8} = binary:match(Bin, Pattern),
1456
1457    %% Extract and swap Proxy-Host/State payloads.
1458
1459    <<H:Offset/binary,
1460      PI:8/binary,
1461      PH:5/binary,
1462      12:24,
1463      Payload:4/binary,
1464      PS:5/binary,
1465      8:24,
1466      T/binary>>
1467        = Bin,
1468
1469    E#diameter_packet{bin = <<H/binary,
1470                              PI/binary,
1471                              PH/binary,
1472                              8:24,
1473                              PS:5/binary,
1474                              12:24,
1475                              Payload/binary,
1476                              T/binary>>};
1477
1478prepare(Pkt, Caps, send_unsupported, #group{client_dict = Dict0} = Group) ->
1479    Req = prepare(Pkt, Caps, Group),
1480    #diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>}
1481        = E
1482        = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
1483    E#diameter_packet{bin = <<H/binary, 42:24, T/binary>>};
1484
1485prepare(Pkt, Caps, send_unsupported_app, #group{client_dict = Dict0}
1486                                         = Group) ->
1487    Req = prepare(Pkt, Caps, Group),
1488    #diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>}
1489        = E
1490        = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}),
1491    E#diameter_packet{bin = <<H/binary, ?BAD_APP:32, T/binary>>};
1492
1493prepare(Pkt, Caps, send_error_bit, Group) ->
1494    #diameter_packet{header = Hdr} = Pkt,
1495    Pkt#diameter_packet{header = Hdr#diameter_header{is_error = true},
1496                        msg = prepare(Pkt, Caps, Group)};
1497
1498prepare(Pkt, Caps, send_unsupported_version, Group) ->
1499    #diameter_packet{header = Hdr} = Pkt,
1500    Pkt#diameter_packet{header = Hdr#diameter_header{version = 42},
1501                        msg = prepare(Pkt, Caps, Group)};
1502
1503prepare(Pkt, Caps, send_anything, Group) ->
1504    Req = ['STR', {'Termination-Cause', ?LOGOUT}],
1505    prepare(Pkt#diameter_packet{msg = Req}, Caps, Group);
1506
1507prepare(Pkt, Caps, _Name, Group) ->
1508    prepare(Pkt, Caps, Group).
1509
1510%% prepare/3
1511
1512prepare(#diameter_packet{msg = Req} = Pkt, Caps, Group) ->
1513    set(name(Req), Pkt, Caps, Group).
1514
1515%% set/4
1516
1517set(N, #diameter_packet{msg = Req}, Caps, Group)
1518  when N == {record, diameter_base_accounting_ACR};
1519       N == {record, nas_ACR};
1520       N == {map, 'ACR'};
1521       N == {list, 'ACR'} ->
1522    #diameter_caps{origin_host  = {OH, _},
1523                   origin_realm = {OR, DR}}
1524        = Caps,
1525
1526    set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
1527                     {'Origin-Host',  [OH]},
1528                     {'Origin-Realm', [OR]},
1529                     {'Destination-Realm', [DR]}]);
1530
1531set(N, #diameter_packet{msg = Req}, Caps, Group)
1532  when N == {record, diameter_base_ASR};
1533       N == {record, nas_ASR};
1534       N == {map, 'ASR'};
1535       N == {list, 'ASR'} ->
1536    #diameter_caps{origin_host  = {OH, DH},
1537                   origin_realm = {OR, DR}}
1538        = Caps,
1539    set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
1540                     {'Origin-Host',  [OH]},
1541                     {'Origin-Realm', [OR]},
1542                     {'Destination-Host',  [DH]},
1543                     {'Destination-Realm', [DR]},
1544                     {'Auth-Application-Id', ?APP_ID}]);
1545
1546set(N, #diameter_packet{msg = Req}, Caps, Group)
1547  when N == {record, diameter_base_STR};
1548       N == {record, nas_STR};
1549       N == {map, 'STR'};
1550       N == {list, 'STR'} ->
1551    #diameter_caps{origin_host  = {OH, _},
1552                   origin_realm = {OR, DR}}
1553        = Caps,
1554    set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
1555                     {'Origin-Host',  [OH]},
1556                     {'Origin-Realm', [OR]},
1557                     {'Destination-Realm', [DR]},
1558                     {'Auth-Application-Id', ?APP_ID}]);
1559
1560set(N, #diameter_packet{msg = Req}, Caps, Group)
1561  when N == {record, diameter_base_RAR};
1562       N == {record, nas_RAR};
1563       N == {map, 'RAR'};
1564       N == {list, 'RAR'} ->
1565    #diameter_caps{origin_host  = {OH, DH},
1566                   origin_realm = {OR, DR}}
1567        = Caps,
1568    set(Group, Req, [{'Session-Id', [diameter:session_id(OH)]},
1569                     {'Origin-Host',  [OH]},
1570                     {'Origin-Realm', [OR]},
1571                     {'Destination-Host',  [DH]},
1572                     {'Destination-Realm', [DR]},
1573                     {'Auth-Application-Id', ?APP_ID}]).
1574
1575%% name/1
1576
1577name([H|#{}]) ->
1578    {map, H};
1579
1580name([H|_]) ->
1581    {list, H};
1582
1583name(Rec) ->
1584    try
1585        {record, element(1, Rec)}
1586    catch
1587        error: badarg ->
1588            false
1589    end.
1590
1591%% prepare_retransmit/6
1592
1593prepare_retransmit(_Pkt, false, _Peer, _Group, _Name, _) ->
1594    discard.
1595
1596%% handle_answer/7-8
1597
1598handle_answer(Pkt, Req, [$C|_], Peer, Group, Name, _) ->
1599    answer(Pkt, Req, Peer, Name, Group).
1600
1601handle_answer(Pkt, Req, [$C|_], Peer, Group, send_detach = Name, _, X) ->
1602    {Pid, Ref} = X,
1603    Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}.
1604
1605answer(Pkt, Req, _Peer, Name, #group{client_dict = Dict0}) ->
1606    #diameter_packet{header = H, msg = Ans, errors = Es} = Pkt,
1607    ApplId = app(Req, Name, Dict0),
1608    #diameter_header{application_id = ApplId} = H,  %% assert
1609    answer(Ans, Es, Name).
1610
1611%% Missing Result-Code and inappropriate Experimental-Result-Code.
1612answer(Ans, Es, send_experimental_result) ->
1613    [{5004, #diameter_avp{name = 'Experimental-Result'}},
1614     {5005, #diameter_avp{name = 'Result-Code'}}]
1615        =  Es,
1616    Ans;
1617
1618%% An inappropriate E-bit results in a decode error ...
1619answer(Ans, Es, send_bad_answer) ->
1620    [{5004, #diameter_avp{name = 'Result-Code'}} | _] = Es,
1621    Ans;
1622
1623%% ... while other errors are reflected in Failed-AVP.
1624answer(Ans, [], _) ->
1625    Ans.
1626
1627app(_, send_unsupported_app, _) ->
1628    ?BAD_APP;
1629app(Req, _, Dict0) ->
1630    Dict = dict(Req, Dict0),
1631    Dict:id().
1632
1633%% handle_error/7
1634
1635handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, _, Time) ->
1636    Now = diameter_lib:now(),
1637    {Reason, {diameter_lib:timestamp(Time),
1638              diameter_lib:timestamp(Now),
1639              diameter_lib:micro_diff(Now, Time)}};
1640
1641handle_error(Reason, _Req, [$C|_], _Peer, _, _, _Time) ->
1642    {error, Reason}.
1643
1644%% handle_request/4
1645
1646%% Note that diameter will set Result-Code and Failed-AVPs if
1647%% #diameter_packet.errors is non-null.
1648
1649handle_request(#diameter_packet{header = H, avps = As}
1650               = Pkt,
1651               _,
1652               {_Ref, Caps},
1653               #group{encoding = E,
1654                      server_decoding = D}
1655               = Grp) ->
1656    #diameter_header{end_to_end_id = EI,
1657                     hop_by_hop_id = HI}
1658        = H,
1659    {V,B} = ?CLIENT_MASK,
1660    V = EI bsr B,  %% assert
1661    V = HI bsr B,  %%
1662    #diameter_caps{origin_state_id = {_,[Id]}} = Caps,
1663    {D,E} = T = origin(Id),  %% assert
1664    wrap(T, H, request(to_map(Pkt, Grp), [H|As], Caps)).
1665
1666wrap(Id, H, {Tag, Action, Post}) ->
1667    {Tag, wrap(Id, H, Action), Post};
1668
1669wrap(_, _, {reply, [#diameter_header{} | _]} = T) ->
1670    T;
1671
1672wrap({_,E}, H, {reply, Ans}) ->
1673    Msg = base_to_nas(msg(Ans, E, diameter_gen_base_rfc3588), H),
1674    {reply, wrap(Msg)};
1675
1676wrap(_, _, T) ->
1677    T.
1678
1679%% Randomly wrap the answer in a diameter_packet.
1680
1681wrap(#diameter_packet{} = Pkt) ->
1682    Pkt;
1683
1684wrap(Msg) ->
1685    case rand:uniform(2) of
1686        1 -> #diameter_packet{msg = Msg};
1687        2 -> Msg
1688    end.
1689
1690%% base_to_nas/2
1691
1692base_to_nas(#diameter_packet{msg = Msg} = Pkt, H) ->
1693    Pkt#diameter_packet{msg = base_to_nas(Msg, H)};
1694
1695base_to_nas(Rec, #diameter_header{application_id = 1})
1696  when is_tuple(Rec), not ?is_record(Rec, 'diameter_base_answer-message') ->
1697    D = case element(1, Rec) of
1698            diameter_base_accounting_ACA ->
1699                diameter_gen_base_accounting;
1700            _ ->
1701                diameter_gen_base_rfc3588
1702        end,
1703    [R | Values] = D:'#get-'(Rec),
1704    "diameter_base_" ++ N = ?L(R),
1705    Name = ?A("nas_" ++ if N == "accounting_ACA" ->
1706                                "ACA";
1707                           true ->
1708                                N
1709                        end),
1710    nas4005:'#new-'([Name | Values]);
1711
1712base_to_nas(Msg, _) ->
1713    Msg.
1714
1715%% request/3
1716
1717%% send_experimental_result
1718request(['ACR' | #{'Accounting-Record-Number' := 5}],
1719        [Hdr | Avps],
1720        #diameter_caps{origin_host = {OH, _},
1721                       origin_realm = {OR, _}}) ->
1722    [H,R|T] = [A || N <- ['Origin-Host',
1723                          'Origin-Realm',
1724                          'Session-Id',
1725                          'Accounting-Record-Type',
1726                          'Accounting-Record-Number'],
1727                    #diameter_avp{} = A
1728                        <- [lists:keyfind(N, #diameter_avp.name, Avps)]],
1729    Ans = [Hdr#diameter_header{is_request = false},
1730           H#diameter_avp{data = OH},
1731           R#diameter_avp{data = OR},
1732           #diameter_avp{name = 'Experimental-Result',
1733                         code = 297,
1734                         need_encryption = false,
1735                         data = [#diameter_avp{data = {?DIAMETER_DICT_COMMON,
1736                                                       'Vendor-Id',
1737                                                       123}},
1738                                 #diameter_avp{data
1739                                               = {?DIAMETER_DICT_COMMON,
1740                                                  'Experimental-Result-Code',
1741                                                  3987}}]}
1742           | T],
1743    {reply, Ans};
1744
1745request(Msg, _Avps, Caps) ->
1746    request(Msg, Caps).
1747
1748%% request/2
1749
1750%% send_nok
1751request(['ACR' | #{'Accounting-Record-Number' := 0}],
1752        _) ->
1753    {eval_packet, {protocol_error, ?INVALID_AVP_BITS}, [fun log/2, invalid]};
1754
1755%% send_bad_answer
1756request(['ACR' | #{'Session-Id' := SId,
1757                   'Accounting-Record-Type' := RT,
1758                   'Accounting-Record-Number' := 2 = RN}],
1759        #diameter_caps{origin_host = {OH, _},
1760                       origin_realm = {OR, _}}) ->
1761    Ans = ['ACA', {'Result-Code', ?SUCCESS},
1762                  {'Session-Id', SId},
1763                  {'Origin-Host', OH},
1764                  {'Origin-Realm', OR},
1765                  {'Accounting-Record-Type', RT},
1766                  {'Accounting-Record-Number', RN}],
1767
1768    {reply, #diameter_packet{header = #diameter_header{is_error = true},%% NOT
1769                             msg = Ans}};
1770
1771%% send_eval
1772request(['ACR' | #{'Session-Id' := SId,
1773                   'Accounting-Record-Type' := RT,
1774                   'Accounting-Record-Number' := 3 = RN}],
1775        #diameter_caps{origin_host = {OH, _},
1776                       origin_realm = {OR, _}}) ->
1777    Ans = ['ACA', {'Result-Code', ?SUCCESS},
1778                  {'Session-Id', SId},
1779                  {'Origin-Host', OH},
1780                  {'Origin-Realm', OR},
1781                  {'Accounting-Record-Type', RT},
1782                  {'Accounting-Record-Number', RN}],
1783    {eval, {reply, Ans}, {erlang, now, []}};
1784
1785%% send_ok
1786request(['ACR' | #{'Session-Id' := SId,
1787                   'Accounting-Record-Type' := RT,
1788                   'Accounting-Record-Number' := 1 = RN}],
1789        #diameter_caps{origin_host = {OH, _},
1790                       origin_realm = {OR, _}}) ->
1791    {reply, ['ACA', {'Result-Code', ?SUCCESS},
1792                    {'Session-Id', SId},
1793                    {'Origin-Host', OH},
1794                    {'Origin-Realm', OR},
1795                    {'Accounting-Record-Type', RT},
1796                    {'Accounting-Record-Number', RN}]};
1797
1798%% send_protocol_error
1799request(['ACR' | #{'Accounting-Record-Number' := 4}],
1800        #diameter_caps{origin_host = {OH, _},
1801                       origin_realm = {OR, _}}) ->
1802    %% Include a DOIC AVP that will be encoded/decoded because of
1803    %% avp_dictionaries config.
1804    OLR = #{'OC-Sequence-Number' => 1,
1805            'OC-Report-Type' => 0,  %% HOST_REPORT
1806            'OC-Reduction-Percentage' => [25],
1807            'OC-Validity-Duration' => [60],
1808            'AVP' => [{'OC-Supported-Features', []}]},
1809    %% Include a NAS Failed-AVP AVP that will only be decoded under
1810    %% that application. Encode as 'AVP' since RFC 3588 doesn't list
1811    %% Failed-AVP in the answer-message grammar while RFC 6733 does.
1812    NP = #diameter_avp{data = {nas4005, 'NAS-Port', 44}},
1813    FR = #diameter_avp{name = 'Firmware-Revision', value = 12}, %% M=0
1814    AP = #diameter_avp{name = 'Auth-Grace-Period', value = 13}, %% M=1
1815    Failed = #diameter_avp{data = {diameter_gen_base_rfc3588,
1816                                   'Failed-AVP',
1817                                   [{'AVP', [NP,FR,AP]}]}},
1818    Ans = ['answer-message', {'Result-Code', ?TOO_BUSY},
1819                             {'Origin-Host', OH},
1820                             {'Origin-Realm', OR},
1821                             {'AVP', [{'OC-OLR', OLR}, Failed]}],
1822    {reply, Ans};
1823
1824%% send_proxy_info
1825request(['ASR' | #{'Proxy-Info' := _}],
1826        _) ->
1827    {protocol_error, 3999};
1828
1829request(['ASR' | #{'Session-Id' := SId} = Avps],
1830        #diameter_caps{origin_host = {OH, _},
1831                       origin_realm = {OR, _}}) ->
1832    {reply, ['ASA', {'Result-Code', ?SUCCESS},
1833                    {'Session-Id', SId},
1834                    {'Origin-Host', OH},
1835                    {'Origin-Realm', OR},
1836                    {'AVP', maps:get('AVP', Avps, [])}]};
1837
1838%% send_invalid_reject
1839request(['STR' | #{'Termination-Cause' := ?USER_MOVED}],
1840        _Caps) ->
1841    {protocol_error, ?TOO_BUSY};
1842
1843%% send_noreply
1844request(['STR' | #{'Termination-Cause' := T}],
1845        _Caps)
1846  when T /= ?LOGOUT ->
1847    discard;
1848
1849%% send_destination_5
1850request(['STR' | #{'Destination-Realm' := R}],
1851        #diameter_caps{origin_realm = {OR, _}})
1852  when R /= undefined, R /= OR ->
1853    {protocol_error, ?REALM_NOT_SERVED};
1854
1855%% send_destination_6
1856request(['STR' | #{'Destination-Host' := [H]}],
1857        #diameter_caps{origin_host = {OH, _}})
1858  when H /= OH ->
1859    {protocol_error, ?UNABLE_TO_DELIVER};
1860
1861request(['STR' | #{'Session-Id' := SId}],
1862        #diameter_caps{origin_host  = {OH, _},
1863                       origin_realm = {OR, _}}) ->
1864    {reply, ['STA', {'Result-Code', ?SUCCESS},
1865                    {'Session-Id', SId},
1866                    {'Origin-Host', OH},
1867                    {'Origin-Realm', OR}]};
1868
1869%% send_error/send_timeout
1870request(['RAR' | #{}], _Caps) ->
1871    receive after 2000 -> {protocol_error, ?TOO_BUSY} end.
1872
1873%% message/3
1874%%
1875%% Limit the number of messages received. More can be received if read
1876%% in the same packet.
1877
1878message(recv = D, {[_], Bin}, N) ->
1879    message(D, Bin, N);
1880message(Dir, #diameter_packet{bin = Bin}, N) ->
1881    message(Dir, Bin, N);
1882
1883%% incoming request
1884message(recv, <<_:32, 1:1, _/bits>> = Bin, N) ->
1885    [Bin, N < 16, fun ?MODULE:message/3, N+1];
1886
1887%% incoming answer
1888message(recv, Bin, _) ->
1889    [Bin];
1890
1891%% outgoing
1892message(send, Bin, _) ->
1893    [Bin];
1894
1895%% sent request
1896message(ack, <<_:32, 1:1, _/bits>>, _) ->
1897    [];
1898
1899%% sent answer or discarded request
1900message(ack, _, N) ->
1901    [N =< 16, fun ?MODULE:message/3, N-1].
1902
1903%% ------------------------------------------------------------------------
1904
1905compile_and_load() ->
1906    try
1907        Path = hd([P || H <- [[here(), ".."], [code:lib_dir(diameter)]],
1908                        P <- [filename:join(H ++ ["examples",
1909                                                  "dict",
1910                                                  "rfc4005_nas.dia"])],
1911                        {ok, _} <- [file:read_file_info(P)]]),
1912        {ok, [Forms]}
1913            = diameter_make:codec(Path, [return,
1914                                      forms,
1915                                   {name, "nas4005"},
1916                                {prefix, "nas"},
1917                             {inherits, "common/diameter_gen_base_rfc3588"}]),
1918        {ok, nas4005, Bin, []} = compile:forms(Forms, [debug_info, return]),
1919        {module, nas4005} = code:load_binary(nas4005, "nas4005", Bin),
1920        true
1921    catch
1922        E:R:Stack ->
1923            {E, R, Stack}
1924    end.
1925
1926here() ->
1927    filename:dirname(code:which(?MODULE)).
1928