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