1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2010-2020. 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-module(diameter_codegen).
22
23%%
24%% This module generates erl/hrl files for encode/decode modules from
25%% the orddict parsed from a dictionary file by diameter_dict_util.
26%% The generated code is simple (one-liners), and is called from
27%% diameter_gen. The orddict itself is returned by dict/0 in the
28%% generated module and diameter_dict_util calls this function when
29%% importing dictionaries as a consequence of @inherits sections. That
30%% is, @inherits introduces a dependency on the beam file of another
31%% dictionary.
32%%
33
34-export([from_dict/4,
35         is_printable_ascii/1]). %% used by ?TERM/1 in diameter_forms.hrl
36
37-include("diameter_forms.hrl").
38-include("diameter_vsn.hrl").
39
40-define(S, atom_to_list).
41-define(A, list_to_atom).
42
43-define(Atom(T), ?ATOM(?A(T))).
44
45%% ===========================================================================
46
47-spec from_dict(File, ParseD, Opts, Mode)
48   -> ok
49    | term()
50 when File :: string(),
51      ParseD :: orddict:orddict(),
52      Opts :: list(),
53      Mode :: parse | forms | erl | hrl.
54
55from_dict(File, ParseD, Opts, Mode) ->
56    Outdir = proplists:get_value(outdir, Opts, "."),
57    Return = proplists:get_value(return, Opts, false),
58    Mod = mod(File, orddict:find(name, ParseD)),
59    putr(verbose, lists:member(verbose, Opts)),
60    try
61        maybe_write(Return, Mode, Outdir, Mod, gen(Mode, ParseD, ?A(Mod)))
62    after
63        eraser(verbose)
64    end.
65
66mod(File, error) ->
67    filename:rootname(filename:basename(File));
68mod(_, {ok, Mod}) ->
69    Mod.
70
71maybe_write(true, _, _, _, T) ->
72    T;
73
74maybe_write(_, Mode, Outdir, Mod, T) ->
75    Path = filename:join(Outdir, Mod),  %% minus extension
76    do_write(Mode, [Path, $., ext(Mode)], T).
77
78ext(parse) ->
79    "D";
80ext(forms) ->
81    "F";
82ext(T) ->
83    ?S(T).
84
85do_write(M, Path, T)
86  when M == parse;
87       M == forms ->
88    write_term(Path, T);
89do_write(_, Path, T) ->
90    write(Path, T).
91
92write(Path, T) ->
93    write(Path, "~s", T).
94
95write_term(Path, T) ->
96    write(Path, "~p.~n", T).
97
98write(Path, Fmt, T) ->
99    {ok, Fd} = file:open(Path, [write]),
100    io:fwrite(Fd, Fmt, [T]),
101    ok = file:close(Fd).
102
103%% Optional reports when running verbosely.
104report(What, Data) ->
105    report(getr(verbose), What, Data),
106    Data.
107
108report(true, Tag, Data) ->
109    io:format(">>~n>> ~p ~p~n", [Tag, Data]);
110report(false, _, _) ->
111    ok.
112
113putr(Key, Value) ->
114    put({?MODULE, Key}, Value).
115
116getr(Key) ->
117    get({?MODULE, Key}).
118
119eraser(Key) ->
120    erase({?MODULE, Key}).
121
122%% ===========================================================================
123%% ===========================================================================
124
125is_printable_ascii(C) ->
126    16#20 =< C andalso C =< 16#7F.
127
128get_value(Key, Plist) ->
129    proplists:get_value(Key, Plist, []).
130
131gen(parse, ParseD, _Mod) ->
132    [?VERSION | ParseD];
133
134gen(forms, ParseD, Mod) ->
135    preprocess(Mod, erl_forms(Mod, ParseD));
136
137gen(hrl, ParseD, Mod) ->
138    gen_hrl(Mod, ParseD);
139
140gen(erl, ParseD, Mod) ->
141    [header(), prettypr(erl_forms(Mod, ParseD)), $\n].
142
143erl_forms(Mod, ParseD) ->
144    Forms = [[{?attribute, module, Mod},
145              {?attribute, compile, {parse_transform, diameter_exprecs}},
146              {?attribute, compile, nowarn_unused_function},
147              {?attribute, dialyzer, no_return}],
148             make_hrl_forms(ParseD),
149             [{?attribute, export, [{name, 0},
150                                    {id, 0},
151                                    {vendor_id, 0},
152                                    {vendor_name, 0},
153                                    {decode_avps, 3}, %% in diameter_gen.hrl
154                                    {encode_avps, 3}, %%
155                                    {grouped_avp, 4}, %%
156                                    {msg_name, 2},
157                                    {msg_header, 1},
158                                    {rec2msg, 1},
159                                    {msg2rec, 1},
160                                    {name2rec, 1},
161                                    {avp_name, 2},
162                                    {avp_arity, 1},
163                                    {avp_arity, 2},
164                                    {avp_header, 1},
165                                    {avp, 4},
166                                    {enumerated_avp, 3},
167                                    {empty_value, 2},
168                                    {dict, 0}]},
169              %% diameter.hrl is included for #diameter_avp
170              {?attribute, include_lib, "diameter/include/diameter.hrl"},
171              {?attribute, include_lib, "diameter/include/diameter_gen.hrl"},
172              f_name(Mod),
173              f_id(ParseD),
174              f_vendor_id(ParseD),
175              f_vendor_name(ParseD),
176              f_msg_name(ParseD),
177              f_msg_header(ParseD),
178              f_rec2msg(ParseD),
179              f_msg2rec(ParseD),
180              f_name2rec(ParseD),
181              f_avp_name(ParseD),
182              f_avp_arity_1(ParseD),
183              f_avp_arity_2(ParseD),
184              f_avp_header(ParseD),
185              f_avp(ParseD),
186              f_enumerated_avp(ParseD),
187              f_empty_value(ParseD),
188              f_dict(ParseD),
189              {eof, ?LINE}]],
190
191    lists:append(Forms).
192
193make_hrl_forms(ParseD) ->
194    {_Prefix, MsgRecs, GrpRecs, ImportedGrpRecs}
195        = make_record_forms(ParseD),
196
197    RecordForms = MsgRecs ++ GrpRecs ++ lists:flatmap(fun({_,Fs}) -> Fs end,
198                                                      ImportedGrpRecs),
199
200    RecNames = lists:map(fun({attribute,_,record,{N,_}}) -> N end,
201                         RecordForms),
202
203    %% export_records is used by the diameter_exprecs parse transform.
204    [{?attribute, export_records, RecNames} | RecordForms].
205
206make_record_forms(ParseD) ->
207    Prefix = prefix(ParseD),
208
209    MsgRecs = a_record(Prefix, fun msg_proj/1, get_value(messages, ParseD)),
210    GrpRecs = a_record(Prefix, fun grp_proj/1, get_value(grouped, ParseD)),
211
212    ImportedGrpRecs = [{M, a_record(Prefix, fun grp_proj/1, Gs)}
213                       || {M,Gs} <- get_value(import_groups, ParseD)],
214
215    {to_upper(Prefix), MsgRecs, GrpRecs, ImportedGrpRecs}.
216
217msg_proj({Name, _, _, _, Avps}) ->
218    {Name, Avps}.
219
220grp_proj({Name, _, _, Avps}) ->
221    {Name, Avps}.
222
223%% a_record/3
224
225a_record(Prefix, ProjF, L) ->
226    lists:map(fun(T) -> a_record(ProjF(T), Prefix) end, L).
227
228a_record({Nm, Avps}, Prefix) ->
229    Name = list_to_atom(Prefix ++ Nm),
230    Fields = lists:map(fun field/1, Avps),
231    {?attribute, record, {Name, Fields}}.
232
233field(Avp) ->
234    {Name, Arity} = avp_info(Avp),
235    if 1 == Arity ->
236            {?record_field, ?Atom(Name)};
237       true ->
238            {?record_field, ?Atom(Name), ?NIL}
239    end.
240
241%%% ------------------------------------------------------------------------
242%%% # name/0
243%%% ------------------------------------------------------------------------
244
245f_name(Name) ->
246    {?function, name, 0,
247     [{?clause, [], [], [?ATOM(Name)]}]}.
248
249%%% ------------------------------------------------------------------------
250%%% # id/0
251%%% ------------------------------------------------------------------------
252
253f_id(ParseD) ->
254    {?function, id, 0,
255     [c_id(orddict:find(id, ParseD))]}.
256
257c_id({ok, Id}) ->
258    {?clause, [], [], [?INTEGER(Id)]};
259
260c_id(error) ->
261    ?BADARG(0).
262
263%%% ------------------------------------------------------------------------
264%%% # vendor_id/0
265%%% ------------------------------------------------------------------------
266
267f_vendor_id(ParseD) ->
268    {?function, vendor_id, 0,
269     [{?clause, [], [], [b_vendor_id(orddict:find(vendor, ParseD))]}]}.
270
271b_vendor_id({ok, {Id, _}}) ->
272    ?INTEGER(Id);
273b_vendor_id(error) ->
274    ?APPLY(erlang, error, [?TERM(undefined)]).
275
276%%% ------------------------------------------------------------------------
277%%% # vendor_name/0
278%%% ------------------------------------------------------------------------
279
280f_vendor_name(ParseD) ->
281    {?function, vendor_name, 0,
282     [{?clause, [], [], [b_vendor_name(orddict:find(vendor, ParseD))]}]}.
283
284b_vendor_name({ok, {_, Name}}) ->
285    ?Atom(Name);
286b_vendor_name(error) ->
287    ?APPLY(erlang, error, [?TERM(undefined)]).
288
289%%% ------------------------------------------------------------------------
290%%% # msg_name/1
291%%% ------------------------------------------------------------------------
292
293f_msg_name(ParseD) ->
294    {?function, msg_name, 2, msg_name(ParseD)}.
295
296%% Return the empty name for any unknown command to which
297%% DIAMETER_COMMAND_UNSUPPORTED should be replied.
298
299msg_name(ParseD) ->
300    lists:flatmap(fun c_msg_name/1, proplists:get_value(command_codes,
301                                                        ParseD,
302                                                        []))
303        ++ [{?clause, [?VAR('_'), ?VAR('_')], [], [?ATOM('')]}].
304
305c_msg_name({Code, Req, Ans}) ->
306    [{?clause, [?INTEGER(Code), ?ATOM(true)],
307      [],
308      [?Atom(Req)]},
309     {?clause, [?INTEGER(Code), ?ATOM(false)],
310      [],
311      [?Atom(Ans)]}].
312
313%%% ------------------------------------------------------------------------
314%%% # msg2rec/1
315%%% ------------------------------------------------------------------------
316
317f_msg2rec(ParseD) ->
318    {?function, msg2rec, 1, msg2rec(ParseD)}.
319
320msg2rec(ParseD) ->
321    Pre = prefix(ParseD),
322    lists:map(fun(T) -> c_msg2rec(T, Pre) end, get_value(messages, ParseD))
323        ++ [?BADARG(1)].
324
325c_msg2rec({N,_,_,_,_}, Pre) ->
326    c_name2rec(N, Pre).
327
328%%% ------------------------------------------------------------------------
329%%% # rec2msg/1
330%%% ------------------------------------------------------------------------
331
332f_rec2msg(ParseD) ->
333    {?function, rec2msg, 1, rec2msg(ParseD)}.
334
335rec2msg(ParseD) ->
336    Pre = prefix(ParseD),
337    lists:map(fun(T) -> c_rec2msg(T, Pre) end, get_value(messages, ParseD))
338        ++ [?BADARG(1)].
339
340c_rec2msg({N,_,_,_,_}, Pre) ->
341    {?clause, [?Atom(rec_name(N, Pre))], [], [?Atom(N)]}.
342
343%%% ------------------------------------------------------------------------
344%%% # name2rec/1
345%%% ------------------------------------------------------------------------
346
347f_name2rec(ParseD) ->
348    {?function, name2rec, 1, name2rec(ParseD)}.
349
350name2rec(ParseD) ->
351    Pre = prefix(ParseD),
352    Groups = get_value(grouped, ParseD)
353          ++ lists:flatmap(fun avps/1, get_value(import_groups, ParseD)),
354    lists:map(fun({N,_,_,_}) -> c_name2rec(N, Pre) end, Groups)
355        ++ [{?clause, [?VAR('T')], [], [?CALL(msg2rec, [?VAR('T')])]}].
356
357c_name2rec(Name, Pre) ->
358    {?clause, [?Atom(Name)], [], [?Atom(rec_name(Name, Pre))]}.
359
360avps({_Mod, Avps}) ->
361    Avps.
362
363%%% ------------------------------------------------------------------------
364%%% # avp_name/1
365%%% ------------------------------------------------------------------------
366
367f_avp_name(ParseD) ->
368    {?function, avp_name, 2, avp_name(ParseD)}.
369
370%% 3588, 4.1:
371%%
372%%    AVP Code
373%%       The AVP Code, combined with the Vendor-Id field, identifies the
374%%       attribute uniquely.  AVP numbers 1 through 255 are reserved for
375%%       backward compatibility with RADIUS, without setting the Vendor-Id
376%%       field.  AVP numbers 256 and above are used for Diameter, which are
377%%       allocated by IANA (see Section 11.1).
378
379avp_name(ParseD) ->
380    Avps = get_value(avp_types, ParseD),
381    Imported = get_value(import_avps, ParseD),
382    Vid = orddict:find(vendor, ParseD),
383    Vs = vendor_id_map(ParseD),
384
385    lists:map(fun(T) -> c_avp_name(T, Vs, Vid) end, Avps)
386        ++ lists:flatmap(fun(T) -> c_imported_avp_name(T, Vs) end, Imported)
387        ++ [{?clause, [?VAR('_'), ?VAR('_')], [], [?ATOM('AVP')]}].
388
389c_avp_name({Name, Code, Type, Flags}, Vs, Vid) ->
390    c_avp_name_(?TERM({?A(Name), ?A(Type)}),
391                ?INTEGER(Code),
392                vid(Name, Flags, Vs, Vid)).
393
394%% Note that an imported AVP's vendor id is determined by
395%% avp_vendor_id in the inheriting module and vendor in the inherited
396%% module. In particular, avp_vendor_id in the inherited module is
397%% ignored so can't just call Mod:avp_header/1 to retrieve the vendor
398%% id. A vendor id specified in @grouped is equivalent to one
399%% specified as avp_vendor_id.
400
401c_imported_avp_name({Mod, Avps}, Vs) ->
402    lists:map(fun(A) -> c_avp_name(A, Vs, {module, Mod}) end, Avps).
403
404c_avp_name_(T, Code, undefined = U) ->
405    {?clause, [Code, ?ATOM(U)],
406     [],
407     [T]};
408
409c_avp_name_(T, Code, Vid) ->
410    {?clause, [Code, ?INTEGER(Vid)],
411     [],
412     [T]}.
413
414vendor_id_map(ParseD) ->
415    lists:flatmap(fun({V,Ns}) -> [{N,V} || N <- Ns] end,
416                  get_value(avp_vendor_id, ParseD))
417        ++ lists:flatmap(fun({_,_,[],_}) -> [];
418                            ({N,_,[V],_}) -> [{N,V}]
419                         end,
420                         get_value(grouped, ParseD)).
421
422%%% ------------------------------------------------------------------------
423%%% # avp_arity/1
424%%% ------------------------------------------------------------------------
425
426f_avp_arity_1(ParseD) ->
427    {?function, avp_arity, 1, avp_arities(ParseD) ++ [?BADARG(1)]}.
428
429avp_arities(ParseD) ->
430    Msgs = get_value(messages, ParseD),
431    Groups = get_value(grouped, ParseD)
432          ++ lists:flatmap(fun avps/1, get_value(import_groups, ParseD)),
433    lists:map(fun c_avp_arities/1, Msgs ++ Groups).
434
435c_avp_arities({N,_,_,_,As}) ->
436    c_avp_arities(N,As);
437c_avp_arities({N,_,_,As}) ->
438    c_avp_arities(N,As).
439
440c_avp_arities(Name, Avps) ->
441    Arities = [{?A(N), A} || T <- Avps, {N,A} <- [avp_info(T)]],
442    {?clause, [?Atom(Name)], [], [?TERM(Arities)]}.
443
444%%% ------------------------------------------------------------------------
445%%% # avp_arity/2
446%%% ------------------------------------------------------------------------
447
448f_avp_arity_2(ParseD) ->
449    {?function, avp_arity, 2, avp_arity(ParseD)}.
450
451avp_arity(ParseD) ->
452    Msgs = get_value(messages, ParseD),
453    Groups = get_value(grouped, ParseD)
454          ++ lists:flatmap(fun avps/1, get_value(import_groups, ParseD)),
455    c_avp_arity(Msgs ++ Groups)
456        ++ [{?clause, [?VAR('_'), ?VAR('_')], [], [?INTEGER(0)]}].
457
458c_avp_arity(L)
459  when is_list(L) ->
460    lists:flatmap(fun c_avp_arity/1, L);
461
462c_avp_arity({N,_,_,_,As}) ->
463    c_avp_arity(N,As);
464c_avp_arity({N,_,_,As}) ->
465    c_avp_arity(N,As).
466
467c_avp_arity(Name, Avps) ->
468    lists:map(fun(A) -> c_arity(Name, A) end, Avps).
469
470c_arity(Name, Avp) ->
471    {AvpName, Arity} = avp_info(Avp),
472    {?clause, [?Atom(Name), ?Atom(AvpName)], [], [?TERM(Arity)]}.
473
474%%% ------------------------------------------------------------------------
475%%% # avp/3
476%%% ------------------------------------------------------------------------
477
478f_avp(ParseD) ->
479    {?function, avp, 4, avp(ParseD) ++ [?BADARG(4)]}.
480
481avp(ParseD) ->
482    Native     = get_value(avp_types, ParseD),
483    CustomMods = get_value(custom_types, ParseD),
484    TypeMods   = get_value(codecs, ParseD),
485    Imported   = get_value(import_avps, ParseD),
486    Enums      = get_value(enum, ParseD),
487
488    Custom = lists:map(fun({M,As}) -> {M, custom_types, As} end,
489                       CustomMods)
490        ++ lists:map(fun({M,As}) -> {M, codecs, As} end,
491                     TypeMods),
492    avp(types(Native), Imported, Custom, Enums).
493
494types(Avps) ->
495    lists:map(fun({N,_,T,_}) -> {N,T} end, Avps).
496
497avp(Native, Imported, Custom, Enums) ->
498    report(native, Native),
499    report(imported, Imported),
500    report(custom, Custom),
501
502    TypeDict = lists:foldl(fun({N,_,T,_}, D) -> orddict:store(N,T,D) end,
503                           orddict:from_list(Native),
504                           lists:flatmap(fun avps/1, Imported)),
505
506    CustomNames = lists:flatmap(fun({_,_,Ns}) -> Ns end, Custom),
507
508    lists:map(fun c_base_avp/1,
509              lists:filter(fun({N,_}) -> not_in(CustomNames, N) end,
510                           Native))
511        ++ lists:flatmap(fun(I) -> cs_imported_avp(I, Enums, CustomNames) end,
512                         Imported)
513        ++ lists:flatmap(fun(C) -> cs_custom_avp(C, TypeDict) end, Custom).
514
515not_in(List, X) ->
516    not lists:member(X, List).
517
518c_base_avp({AvpName, "Enumerated"}) ->
519    {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('_')],
520     [],
521     [?CALL(enumerated_avp, [?VAR('T'), ?Atom(AvpName), ?VAR('Data')])]};
522
523c_base_avp({AvpName, "Grouped"}) ->
524    {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('Opts')],
525     [],
526     [?CALL(grouped_avp, [?VAR('T'),
527                          ?Atom(AvpName),
528                          ?VAR('Data'),
529                          ?VAR('Opts')])]};
530
531c_base_avp({AvpName, Type}) ->
532    {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('Opts')],
533     [],
534     [?APPLY(diameter_types, ?A(Type), [?VAR('T'),
535                                        ?VAR('Data'),
536                                        ?VAR('Opts')])]}.
537
538cs_imported_avp({Mod, Avps}, Enums, CustomNames) ->
539    lists:map(fun(A) -> imported_avp(Mod, A, Enums) end,
540              lists:filter(fun({N,_,_,_}) -> not_in(CustomNames, N) end,
541                           Avps)).
542
543imported_avp(_Mod, {AvpName, _, "Grouped" = T, _}, _) ->
544    c_base_avp({AvpName, T});
545
546imported_avp(Mod, {AvpName, _, "Enumerated" = T, _}, Enums) ->
547    case lists:keymember(AvpName, 1, Enums) of
548        true ->
549            c_base_avp({AvpName, T});
550        false ->
551            c_imported_avp(Mod, AvpName)
552    end;
553
554imported_avp(Mod, {AvpName, _, _, _}, _) ->
555    c_imported_avp(Mod, AvpName).
556
557c_imported_avp(Mod, AvpName) ->
558    {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('Opts')],
559     [],
560     [?CALL(avp, [?VAR('T'),
561                  ?VAR('Data'),
562                  ?Atom(AvpName),
563                  ?VAR('Opts'),
564                  ?ATOM(Mod)])]}.
565
566cs_custom_avp({Mod, Key, Avps}, Dict) ->
567    lists:map(fun(N) -> c_custom_avp(Mod, Key, N, orddict:fetch(N, Dict)) end,
568              Avps).
569
570c_custom_avp(Mod, Key, AvpName, Type) ->
571    {F,A} = custom(Key, AvpName, Type),
572    {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('Opts')],
573     [],
574     [?APPLY(?A(Mod), ?A(F), [?VAR('T'),
575                              ?Atom(A),
576                              ?VAR('Data'),
577                              ?VAR('Opts')])]}.
578
579custom(custom_types, AvpName, Type) ->
580    {AvpName, Type};
581custom(codecs, AvpName, Type) ->
582    {Type, AvpName}.
583
584%%% ------------------------------------------------------------------------
585%%% # enumerated_avp/3
586%%% ------------------------------------------------------------------------
587
588f_enumerated_avp(ParseD) ->
589    {?function, enumerated_avp, 3, enumerated_avp(ParseD) ++ [?BADARG(3)]}.
590
591enumerated_avp(ParseD) ->
592    Enums = get_value(enum, ParseD),
593    lists:flatmap(fun cs_enumerated_avp/1, Enums)
594        ++ lists:flatmap(fun({M,Es}) -> enumerated_avp(M, Es, Enums) end,
595                         get_value(import_enums, ParseD)).
596
597enumerated_avp(Mod, Es, Enums) ->
598    lists:flatmap(fun({N,_}) ->
599                          cs_enumerated_avp(lists:keymember(N, 1, Enums),
600                                            Mod,
601                                            N)
602                  end,
603                  Es).
604
605cs_enumerated_avp(true, Mod, Name) ->
606    [{?clause, [?VAR('T'), ?Atom(Name), ?VAR('Data')],
607     [],
608     [?APPLY(Mod, enumerated_avp, [?VAR('T'),
609                                   ?Atom(Name),
610                                   ?VAR('Data')])]}];
611cs_enumerated_avp(false, _, _) ->
612    [].
613
614cs_enumerated_avp({AvpName, Values}) ->
615    lists:flatmap(fun(V) -> c_enumerated_avp(AvpName, V) end, Values).
616
617c_enumerated_avp(AvpName, {_,I}) ->
618    [{?clause, [?ATOM(decode), ?Atom(AvpName), ?TERM(<<I:32>>)],
619      [],
620      [?TERM(I)]},
621     {?clause, [?ATOM(encode), ?Atom(AvpName), ?INTEGER(I)],
622      [],
623      [?TERM(<<I:32>>)]}].
624
625%%% ------------------------------------------------------------------------
626%%% msg_header/1
627%%% ------------------------------------------------------------------------
628
629f_msg_header(ParseD) ->
630    {?function, msg_header, 1, msg_header(ParseD) ++ [?BADARG(1)]}.
631
632msg_header(ParseD) ->
633    msg_header(get_value(messages, ParseD), ParseD).
634
635msg_header([], _) ->
636    [];
637msg_header(Msgs, ParseD) ->
638    ApplId = orddict:fetch(id, ParseD),
639
640    lists:map(fun({M,C,F,_,_}) -> c_msg_header(M, C, F, ApplId) end, Msgs).
641
642%% Note that any application id in the message header spec is ignored.
643
644c_msg_header(Name, Code, Flags, ApplId) ->
645    {?clause, [?Atom(Name)],
646     [],
647     [?TERM({Code, encode_msg_flags(Flags), ApplId})]}.
648
649encode_msg_flags(Flags) ->
650    lists:foldl(fun emf/2, 0, Flags).
651
652emf('REQ', N) -> N bor 2#10000000;
653emf('PXY', N) -> N bor 2#01000000;
654emf('ERR', N) -> N bor 2#00100000.
655
656%%% ------------------------------------------------------------------------
657%%% # avp_header/1
658%%% ------------------------------------------------------------------------
659
660f_avp_header(ParseD) ->
661    {?function, avp_header, 1, avp_header(ParseD) ++ [?BADARG(1)]}.
662
663avp_header(ParseD) ->
664    Native = get_value(avp_types, ParseD),
665    Imported = get_value(import_avps, ParseD),
666    Vid = orddict:find(vendor, ParseD),
667    Vs = vendor_id_map(ParseD),
668
669    lists:flatmap(fun(A) -> c_avp_header(A, Vs, Vid) end,
670                  Native ++ Imported).
671
672c_avp_header({Name, Code, _Type, Flags}, Vs, Vid) ->
673    [{?clause, [?Atom(Name)],
674      [],
675      [?TERM({Code, encode_avp_flags(Flags), vid(Name, Flags, Vs, Vid)})]}];
676
677c_avp_header({Mod, Avps}, Vs, _Vid) ->
678    lists:map(fun(A) -> c_imported_avp_header(A, Mod, Vs) end, Avps).
679
680%% Note that avp_vendor_id in the inherited dictionary is ignored. The
681%% value must be changed in the inheriting dictionary. This is
682%% consistent with the semantics of avp_name/2.
683
684c_imported_avp_header({Name, _Code, _Type, _Flags}, Mod, Vs) ->
685    Apply = ?APPLY(Mod, avp_header, [?Atom(Name)]),
686    {?clause, [?Atom(Name)],
687     [],
688     [case proplists:get_value(Name, Vs) of
689          undefined ->
690              Apply;
691          Vid ->
692              ?CALL(setelement, [?INTEGER(3), Apply, ?INTEGER(Vid)])
693      end]}.
694
695encode_avp_flags(Fs) ->
696    lists:foldl(fun eaf/2, 0, Fs).
697
698eaf($V, F) -> 2#10000000 bor F;
699eaf($M, F) -> 2#01000000 bor F;
700eaf($P, F) -> 2#00100000 bor F.
701
702vid(Name, Flags, Vs, Vid) ->
703    v(lists:member($V, Flags), Name, Vs, Vid).
704
705v(true = T, Name, Vs, {module, Mod}) ->
706    v(T, Name, Vs, {ok, {Mod:vendor_id(), Mod:vendor_name()}});
707
708v(true, Name, Vs, Vid) ->
709    case proplists:get_value(Name, Vs) of
710        undefined ->
711            {ok, {Id, _}} = Vid,
712            Id;
713        Id ->
714            Id
715    end;
716v(false, _, _, _) ->
717    undefined.
718
719%%% ------------------------------------------------------------------------
720%%% # empty_value/0
721%%% ------------------------------------------------------------------------
722
723f_empty_value(ParseD) ->
724    {?function, empty_value, 2, empty_value(ParseD)}.
725
726empty_value(ParseD) ->
727    Imported = lists:flatmap(fun avps/1, get_value(import_enums, ParseD)),
728    Groups = get_value(grouped, ParseD)
729        ++ lists:flatmap(fun avps/1, get_value(import_groups, ParseD)),
730    Enums = [T || {N,_} = T <- get_value(enum, ParseD),
731                  not lists:keymember(N, 1, Imported)]
732        ++ Imported,
733    lists:map(fun c_empty_value/1, Groups ++ Enums)
734        ++ [{?clause, [?VAR('Name'), ?VAR('Opts')],
735             [],
736             [?CALL(empty, [?VAR('Name'), ?VAR('Opts')])]}].
737
738c_empty_value({Name, _, _, _}) ->
739    {?clause, [?Atom(Name), ?VAR('Opts')],
740     [],
741     [?CALL(empty_group, [?Atom(Name), ?VAR('Opts')])]};
742
743c_empty_value({Name, _}) ->
744    {?clause, [?Atom(Name), ?VAR('_')],
745     [],
746     [?TERM(<<0:32>>)]}.
747
748%%% ------------------------------------------------------------------------
749%%% # dict/0
750%%% ------------------------------------------------------------------------
751
752f_dict(ParseD) ->
753    {?function, dict, 0,
754     [{?clause, [], [], [?TERM([?VERSION | ParseD])]}]}.
755
756%%% ------------------------------------------------------------------------
757%%% # gen_hrl/2
758%%% ------------------------------------------------------------------------
759
760gen_hrl(Mod, ParseD) ->
761    {Prefix, MsgRecs, GrpRecs, ImportedGrpRecs}
762        = make_record_forms(ParseD),
763
764    [hrl_header(Mod),
765     forms("Message records",     MsgRecs),
766     forms("Grouped AVP records", GrpRecs),
767     lists:map(fun({M,Fs}) ->
768                       forms("Grouped AVP records from " ++ atom_to_list(M),
769                             Fs)
770               end,
771               ImportedGrpRecs),
772     format("ENUM Macros", m_enums(Prefix, false, get_value(enum, ParseD))),
773     format("DEFINE Macros", m_enums(Prefix, false, get_value(define, ParseD))),
774     lists:map(fun({M,Es}) ->
775                       format("ENUM Macros from " ++ atom_to_list(M),
776                              m_enums(Prefix, true, Es))
777               end,
778               get_value(import_enums, ParseD))].
779
780forms(_, [] = No) ->
781    No;
782forms(Banner, Forms) ->
783    format(Banner, prettypr(Forms)).
784
785format(_, [] = No) ->
786    No;
787format(Banner, Str) ->
788    [banner(Banner), Str, $\n].
789
790prettypr(Forms) ->
791    erl_prettypr:format(erl_syntax:form_list(Forms)).
792
793banner(Heading) ->
794    ["\n\n"
795     "%%% -------------------------------------------------------\n"
796     "%%% ", Heading, ":\n"
797     "%%% -------------------------------------------------------\n\n"].
798
799z(S) ->
800    string:join(string:tokens(S, "\s\t"), "\s").
801
802m_enums(Prefix, Wrap, Enums) ->
803    lists:map(fun(T) -> m_enum(Prefix, Wrap, T) end, Enums).
804
805m_enum(Prefix, B, {Name, Values}) ->
806    P = Prefix ++ to_upper(Name) ++ "_",
807    lists:map(fun({A,I}) ->
808                      N = ["'", P, to_upper(z(A)), "'"],
809                      wrap(B,
810                           N,
811                           ["-define(", N, ", ", integer_to_list(I), ").\n"])
812              end,
813              Values).
814
815wrap(true, Name, Def) ->
816    ["-ifndef(", Name, ").\n", Def, "-endif.\n"];
817wrap(false, _, Def) ->
818    Def.
819
820to_upper(A) when is_atom(A) ->
821    to_upper(atom_to_list(A));
822to_upper(S) ->
823    lists:map(fun tu/1, S).
824
825tu(C) when C >= $a, C =< $z ->
826    C + $A - $a;
827tu(C) ->
828    C.
829
830header() ->
831    ("%% -------------------------------------------------------------------\n"
832     "%% This is a generated file.\n"
833     "%% -------------------------------------------------------------------\n"
834     "\n").
835
836hrl_header(Name) ->
837    header() ++ "-hrl_name('" ++ ?S(Name) ++ ".hrl').\n".
838
839%% avp_info/1
840
841avp_info(Entry) ->  %% {Name, Arity}
842    case Entry of
843        {{A}} -> {A, 1};
844        {A}   -> {A, 1};
845        [A]   -> {A, {0,1}};
846        {Q,T} ->
847            {A,_} = avp_info(T),
848            {A, arity(T,Q)}
849    end.
850
851%% Normalize arity to 1 or {N,X} where N is an integer. A record field
852%% for an AVP is list-valued iff the normalized arity is not 1.
853arity({{_}}, '*' = Inf) -> {0, Inf};
854arity([_],   '*' = Inf) -> {0, Inf};
855arity({_},   '*' = Inf) -> {1, Inf};
856arity(_,   {_,_} = Q)   -> Q.
857
858prefix(ParseD) ->
859    case orddict:find(prefix, ParseD) of
860        {ok, P} ->
861            P ++ "_";
862        error ->
863            ""
864    end.
865
866rec_name(Name, Prefix) ->
867    Prefix ++ Name.
868
869%% ===========================================================================
870%% preprocess/2
871%%
872%% Preprocess forms as generated by 'forms' option. In particular,
873%% replace the include_lib attributes in generated forms by the
874%% corresponding forms, extracting the latter from an existing
875%% dictionary (diameter_gen_relay). The resulting forms can be
876%% compiled to beam using compile:forms/2 (which does no preprocessing
877%% of it's own; DiY currently appears to be the only way to preprocess
878%% a forms list).
879
880preprocess(Mod, Forms) ->
881    {_, Beam, _} = code:get_object_code(diameter_gen_relay),
882    pp(Forms, remod(Mod, abstract_code(Beam))).
883
884pp(Forms, {ok, Code}) ->
885    Files = files(Code, []),
886    lists:flatmap(fun(T) -> include(T, Files) end, Forms);
887
888pp(Forms, {error, Reason}) ->
889    erlang:error({forms, Reason, Forms}).
890
891%% Replace literal diameter_gen_relay atoms in the extracted forms.
892%% ?MODULE for example.
893
894remod(Mod, L)
895  when is_list(L) ->
896    [remod(Mod, T) || T <- L];
897
898remod(Mod, {atom, _, diameter_gen_relay} = T) ->
899    setelement(3, T, Mod);
900
901remod(Mod, T)
902  when is_tuple(T) ->
903    list_to_tuple(remod(Mod, tuple_to_list(T)));
904
905remod(_, T) ->
906    T.
907
908%% Replace include_lib by the corresponding forms.
909
910include({attribute, _, include_lib, Path}, Files) ->
911    Inc = filename:basename(Path),
912    [{Inc, Forms}] = [T || {F, _} = T <- Files, F == Inc], %% expect one
913    lists:flatmap(fun filter/1, Forms);
914
915include(T, _) ->
916    [T].
917
918%% Extract abstract code.
919
920abstract_code(Beam) ->
921    case beam_lib:chunks(Beam, [abstract_code]) of
922        {ok, {_Mod, [{abstract_code, {_Vsn, Code}}]}} ->
923            {ok, Code};
924        {ok, {_Mod, [{abstract_code, no_abstract_code = No}]}} ->
925            {error, No};
926        {error = E, beam_lib, Reason} ->
927            {E, Reason}
928    end.
929
930%% Extract filename/forms pairs for included forms.
931
932files([{attribute, _, file, {Path, _}} | T], Acc) ->
933    {Body, Rest} = lists:splitwith(fun({attribute, _, file, _}) -> false;
934                                      (_) -> true
935                                   end,
936                                   T),
937    files(Rest, [{filename:basename(Path), Body} | Acc]);
938
939files([], Acc) ->
940    Acc.
941
942%% Only retain record diameter_avp and functions not generated by
943%% diameter_exprecs.
944
945filter({attribute, _, record, {diameter_avp, _}} = T) ->
946    [T];
947
948filter({function, _, Name, _, _} = T) ->
949    case ?S(Name) of
950        [$#|_] ->  %% generated by diameter_exprecs
951            [];
952        _ ->
953            [T]
954    end;
955
956filter(_) ->
957    [].
958