aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/src/compiler/diameter_spec_util.erl
diff options
context:
space:
mode:
authorAnders Svensson <[email protected]>2011-12-07 16:51:46 +0100
committerAnders Svensson <[email protected]>2011-12-07 16:51:46 +0100
commit24f0d3ee266d56cc83435401230a8bb85a0464d3 (patch)
treeecb3a5e9d8539e87efb5677494894f3ced97a2cb /lib/diameter/src/compiler/diameter_spec_util.erl
parent977f7510818925d9293361c14788fdb872614ac1 (diff)
parentf2a4059d06f8b76d2c1da14197f170deebd64f45 (diff)
downloadotp-24f0d3ee266d56cc83435401230a8bb85a0464d3.tar.gz
otp-24f0d3ee266d56cc83435401230a8bb85a0464d3.tar.bz2
otp-24f0d3ee266d56cc83435401230a8bb85a0464d3.zip
Merge branch 'anders/diameter/dict_error_identification/OTP-9639'
* anders/diameter/dict_error_identification/OTP-9639: (27 commits) Update documentation Improve base_rfc3588.dia formatting Make typo fix backwards compatible Fix base_rfc3588.dia typo Check compiler dependencies in app suite Move type definitions into diameter.erl Fix interpretation of vendor id in @grouped Add range checks on dictionary integers Don't explicitly load inherited modules Tweak diameter_make interface Add format testcase to compiler suite Add diameter_dict_util:format/1 for reconstructing a dictionary file Make diameter_types usable with @codecs Minor codegen tweaks Remove unnecessary includes Add compiler suite Update app suite Update codec suite Vendor id fixes No longer inherit common dictionary in relay dictionary ...
Diffstat (limited to 'lib/diameter/src/compiler/diameter_spec_util.erl')
-rw-r--r--lib/diameter/src/compiler/diameter_spec_util.erl1089
1 files changed, 0 insertions, 1089 deletions
diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl
deleted file mode 100644
index 62536bf06d..0000000000
--- a/lib/diameter/src/compiler/diameter_spec_util.erl
+++ /dev/null
@@ -1,1089 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-%% This module turns a .dia (aka spec) file into the orddict that
-%% diameter_codegen.erl in turn morphs into .erl and .hrl files for
-%% encode and decode of Diameter messages and AVPs.
-%%
-
--module(diameter_spec_util).
-
--export([parse/2]).
-
--define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})).
--define(ATOM, list_to_atom).
-
-%% parse/1
-%%
-%% Output: orddict()
-
-parse(Path, Opts) ->
- put({?MODULE, verbose}, lists:member(verbose, Opts)),
- {ok, B} = file:read_file(Path),
- Chunks = chunk(B),
- Spec = reset(make_spec(Chunks), Opts, [name, prefix, inherits]),
- true = groups_defined(Spec), %% sanity checks
- true = customs_defined(Spec), %%
- Full = import_enums(import_groups(import_avps(insert_codes(Spec), Opts))),
- true = enums_defined(Full), %% sanity checks
- true = v_flags_set(Spec),
- Full.
-
-reset(Spec, Opts, Keys) ->
- lists:foldl(fun(K,S) ->
- reset([{A,?ATOM(V)} || {A,V} <- Opts, A == K], S)
- end,
- Spec,
- Keys).
-
-reset(L, Spec)
- when is_list(L) ->
- lists:foldl(fun reset/2, Spec, L);
-
-reset({inherits = Key, '-'}, Spec) ->
- orddict:erase(Key, Spec);
-reset({inherits = Key, Dict}, Spec) ->
- orddict:append(Key, Dict, Spec);
-reset({Key, Atom}, Spec) ->
- orddict:store(Key, Atom, Spec);
-reset(_, Spec) ->
- Spec.
-
-%% Optional reports when running verbosely.
-report(What, Data) ->
- report(get({?MODULE, verbose}), What, Data).
-
-report(true, Tag, Data) ->
- io:format("##~n## ~p ~p~n", [Tag, Data]);
-report(false, _, _) ->
- ok.
-
-%% chunk/1
-
-chunk(B) ->
- chunkify(normalize(binary_to_list(B))).
-
-%% normalize/1
-%%
-%% Replace CR NL by NL, multiple NL by one, tab by space, and strip
-%% comments and leading/trailing space from each line. Precludes
-%% semicolons being used for any other purpose than comments.
-
-normalize(Str) ->
- nh(Str, []).
-
-nh([], Acc) ->
- lists:reverse(Acc);
-
-%% Trim leading whitespace.
-nh(Str, Acc) ->
- nb(trim(Str), Acc).
-
-%% tab -> space
-nb([$\t|Rest], Acc) ->
- nb(Rest, [$\s|Acc]);
-
-%% CR NL -> NL
-nb([$\r,$\n|Rest], Acc) ->
- nt(Rest, Acc);
-
-%% Gobble multiple newlines before starting over again.
-nb([$\n|Rest], Acc) ->
- nt(Rest, Acc);
-
-%% Comment.
-nb([$;|Rest], Acc) ->
- nb(lists:dropwhile(fun(C) -> C /= $\n end, Rest), Acc);
-
-%% Just an ordinary character. Boring ...
-nb([C|Rest], Acc) ->
- nb(Rest, [C|Acc]);
-
-nb([] = Str, Acc) ->
- nt(Str, Acc).
-
-%% Discard a subsequent newline.
-nt(T, [$\n|_] = Acc) ->
- nh(T, trim(Acc));
-
-%% Trim whitespace from the end of the line before continuing.
-nt(T, Acc) ->
- nh(T, [$\n|trim(Acc)]).
-
-trim(S) ->
- lists:dropwhile(fun(C) -> lists:member(C, "\s\t") end, S).
-
-%% chunkify/1
-%%
-%% Split the spec file into pieces delimited by lines starting with
-%% @Tag. Returns a list of {Tag, Args, Chunk} where Chunk is the
-%% string extending to the next delimiter. Note that leading
-%% whitespace has already been stripped.
-
-chunkify(Str) ->
- %% Drop characters to the start of the first chunk.
- {_, Rest} = split_chunk([$\n|Str]),
- chunkify(Rest, []).
-
-chunkify([], Acc) ->
- lists:reverse(Acc);
-
-chunkify(Rest, Acc) ->
- {H,T} = split_chunk(Rest),
- chunkify(T, [split_tag(H) | Acc]).
-
-split_chunk(Str) ->
- split_chunk(Str, []).
-
-split_chunk([] = Rest, Acc) ->
- {lists:reverse(Acc), Rest};
-split_chunk([$@|Rest], [$\n|_] = Acc) ->
- {lists:reverse(Acc), Rest};
-split_chunk([C|Rest], Acc) ->
- split_chunk(Rest, [C|Acc]).
-
-%% Expect a tag and its arguments on a single line.
-split_tag(Str) ->
- {L, Rest} = get_until($\n, Str),
- [{tag, Tag} | Toks] = diameter_spec_scan:parse(L),
- {Tag, Toks, trim(Rest)}.
-
-get_until(EndT, L) ->
- {H, [EndT | T]} = lists:splitwith(fun(C) -> C =/= EndT end, L),
- {H,T}.
-
-%% ------------------------------------------------------------------------
-%% make_spec/1
-%%
-%% Turn chunks into spec.
-
-make_spec(Chunks) ->
- lists:foldl(fun(T,A) -> report(chunk, T), chunk(T,A) end,
- orddict:new(),
- Chunks).
-
-chunk({T, [X], []}, Dict)
- when T == name;
- T == prefix ->
- store(T, atomize(X), Dict);
-
-chunk({id = T, [{number, I}], []}, Dict) ->
- store(T, I, Dict);
-
-chunk({vendor = T, [{number, I}, N], []}, Dict) ->
- store(T, {I, atomize(N)}, Dict);
-
-%% inherits -> [{Mod, [AvpName, ...]}, ...]
-chunk({inherits = T, [_,_|_] = Args, []}, Acc) ->
- Mods = [atomize(A) || A <- Args],
- append_list(T, [{M,[]} || M <- Mods], Acc);
-chunk({inherits = T, [Mod], Body}, Acc) ->
- append(T, {atomize(Mod), parse_avp_names(Body)}, Acc);
-
-%% avp_types -> [{AvpName, Code, Type, Flags, Encr}, ...]
-chunk({avp_types = T, [], Body}, Acc) ->
- store(T, parse_avp_types(Body), Acc);
-
-%% custom_types -> [{Mod, [AvpName, ...]}, ...]
-chunk({custom_types = T, [Mod], Body}, Dict) ->
- [_|_] = Avps = parse_avp_names(Body),
- append(T, {atomize(Mod), Avps}, Dict);
-
-%% messages -> [{MsgName, Code, Type, Appl, Avps}, ...]
-chunk({messages = T, [], Body}, Acc) ->
- store(T, parse_messages(Body), Acc);
-
-%% grouped -> [{AvpName, Code, Vendor, Avps}, ...]
-chunk({grouped = T, [], Body}, Acc) ->
- store(T, parse_groups(Body), Acc);
-
-%% avp_vendor_id -> [{Id, [AvpName, ...]}, ...]
-chunk({avp_vendor_id = T, [{number, I}], Body}, Dict) ->
- [_|_] = Names = parse_avp_names(Body),
- append(T, {I, Names}, Dict);
-
-%% enums -> [{AvpName, [{Value, Name}, ...]}, ...]
-chunk({enum, [N], Str}, Dict) ->
- append(enums, {atomize(N), parse_enums(Str)}, Dict);
-
-%% defines -> [{DefineName, [{Value, Name}, ...]}, ...]
-chunk({define, [N], Str}, Dict) ->
- append(defines, {atomize(N), parse_enums(Str)}, Dict);
-chunk({result_code, [_] = N, Str}, Dict) -> %% backwards compatibility
- chunk({define, N, Str}, Dict);
-
-%% commands -> [{Name, Abbrev}, ...]
-chunk({commands = T, [], Body}, Dict) ->
- store(T, parse_commands(Body), Dict);
-
-chunk(T, _) ->
- ?ERROR({unknown_tag, T}).
-
-store(Key, Value, Dict) ->
- error == orddict:find(Key, Dict) orelse ?ERROR({duplicate, Key}),
- orddict:store(Key, Value, Dict).
-append(Key, Value, Dict) ->
- orddict:append(Key, Value, Dict).
-append_list(Key, Values, Dict) ->
- orddict:append_list(Key, Values, Dict).
-
-atomize({tag, T}) ->
- T;
-atomize({name, T}) ->
- ?ATOM(T).
-
-get_value(Keys, Spec)
- when is_list(Keys) ->
- [get_value(K, Spec) || K <- Keys];
-get_value(Key, Spec) ->
- proplists:get_value(Key, Spec, []).
-
-%% ------------------------------------------------------------------------
-%% enums_defined/1
-%% groups_defined/1
-%% customs_defined/1
-%%
-%% Ensure that every local enum/grouped/custom is defined as an avp
-%% with an appropriate type.
-
-enums_defined(Spec) ->
- Avps = get_value(avp_types, Spec),
- Import = get_value(import_enums, Spec),
- lists:all(fun({N,_}) ->
- true = enum_defined(N, Avps, Import)
- end,
- get_value(enums, Spec)).
-
-enum_defined(Name, Avps, Import) ->
- case lists:keyfind(Name, 1, Avps) of
- {Name, _, 'Enumerated', _, _} ->
- true;
- {Name, _, T, _, _} ->
- ?ERROR({avp_has_wrong_type, Name, 'Enumerated', T});
- false ->
- lists:any(fun({_,Is}) -> lists:keymember(Name, 1, Is) end, Import)
- orelse ?ERROR({avp_not_defined, Name, 'Enumerated'})
- end.
-%% Note that an AVP is imported only if referenced by a message or
-%% grouped AVP, so the final branch will fail if an enum definition is
-%% extended without this being the case.
-
-groups_defined(Spec) ->
- Avps = get_value(avp_types, Spec),
- lists:all(fun({N,_,_,_}) -> true = group_defined(N, Avps) end,
- get_value(grouped, Spec)).
-
-group_defined(Name, Avps) ->
- case lists:keyfind(Name, 1, Avps) of
- {Name, _, 'Grouped', _, _} ->
- true;
- {Name, _, T, _, _} ->
- ?ERROR({avp_has_wrong_type, Name, 'Grouped', T});
- false ->
- ?ERROR({avp_not_defined, Name, 'Grouped'})
- end.
-
-customs_defined(Spec) ->
- Avps = get_value(avp_types, Spec),
- lists:all(fun(A) -> true = custom_defined(A, Avps) end,
- lists:flatmap(fun last/1, get_value(custom_types, Spec))).
-
-custom_defined(Name, Avps) ->
- case lists:keyfind(Name, 1, Avps) of
- {Name, _, T, _, _} when T == 'Grouped';
- T == 'Enumerated' ->
- ?ERROR({avp_has_invalid_custom_type, Name, T});
- {Name, _, _, _, _} ->
- true;
- false ->
- ?ERROR({avp_not_defined, Name})
- end.
-
-last({_,Xs}) -> Xs.
-
-%% ------------------------------------------------------------------------
-%% v_flags_set/1
-
-v_flags_set(Spec) ->
- Avps = get_value(avp_types, Spec)
- ++ lists:flatmap(fun last/1, get_value(import_avps, Spec)),
- Vs = lists:flatmap(fun last/1, get_value(avp_vendor_id, Spec)),
-
- lists:all(fun(N) -> vset(N, Avps) end, Vs).
-
-vset(Name, Avps) ->
- A = lists:keyfind(Name, 1, Avps),
- false == A andalso ?ERROR({avp_not_defined, Name}),
- {Name, _Code, _Type, Flags, _Encr} = A,
- lists:member('V', Flags) orelse ?ERROR({v_flag_not_set, A}).
-
-%% ------------------------------------------------------------------------
-%% insert_codes/1
-
-insert_codes(Spec) ->
- [Msgs, Cmds] = get_value([messages, commands], Spec),
-
- %% Code -> [{Name, Flags}, ...]
- Dict = lists:foldl(fun({N,C,Fs,_,_}, D) -> dict:append(C,{N,Fs},D) end,
- dict:new(),
- Msgs),
-
- %% list() of {Code, {ReqName, ReqAbbr}, {AnsName, AnsAbbr}}
- %% If the name and abbreviation are the same then the 2-tuples
- %% are replaced by the common atom()-valued name.
- Codes = dict:fold(fun(C,Ns,A) -> [make_code(C, Ns, Cmds) | A] end,
- [],
- dict:erase(-1, Dict)), %% answer-message
-
- orddict:store(command_codes, Codes, Spec).
-
-make_code(Code, [_,_] = Ns, Cmds) ->
- {Req, Ans} = make_names(Ns, lists:map(fun({_,Fs}) ->
- lists:member('REQ', Fs)
- end,
- Ns)),
- {Code, abbrev(Req, Cmds), abbrev(Ans, Cmds)};
-
-make_code(Code, Cs, _) ->
- ?ERROR({missing_request_or_answer, Code, Cs}).
-
-%% 3.3. Diameter Command Naming Conventions
-%%
-%% Diameter command names typically includes one or more English words
-%% followed by the verb Request or Answer. Each English word is
-%% delimited by a hyphen. A three-letter acronym for both the request
-%% and answer is also normally provided.
-
-make_names([{Rname,_},{Aname,_}], [true, false]) ->
- {Rname, Aname};
-make_names([{Aname,_},{Rname,_}], [false, true]) ->
- {Rname, Aname};
-make_names([_,_] = Names, _) ->
- ?ERROR({inconsistent_command_flags, Names}).
-
-abbrev(Name, Cmds) ->
- case abbr(Name, get_value(Name, Cmds)) of
- Name ->
- Name;
- Abbr ->
- {Name, Abbr}
- end.
-
-%% No explicit abbreviation: construct.
-abbr(Name, []) ->
- ?ATOM(abbr(string:tokens(atom_to_list(Name), "-")));
-
-%% Abbreviation was specified.
-abbr(_Name, Abbr) ->
- Abbr.
-
-%% No hyphens: already abbreviated.
-abbr([Abbr]) ->
- Abbr;
-
-%% XX-Request/Answer ==> XXR/XXA
-abbr([[_,_] = P, T])
- when T == "Request";
- T == "Answer" ->
- P ++ [hd(T)];
-
-%% XXX-...-YYY-Request/Answer ==> X...YR/X...YA
-abbr([_,_|_] = L) ->
- lists:map(fun erlang:hd/1, L).
-
-%% ------------------------------------------------------------------------
-%% import_avps/2
-
-import_avps(Spec, Options) ->
- Msgs = get_value(messages, Spec),
- Groups = get_value(grouped, Spec),
-
- %% Messages and groups require AVP's referenced by them.
- NeededAvps
- = ordsets:from_list(lists:flatmap(fun({_,_,_,_,As}) ->
- [avp_name(A) || A <- As]
- end,
- Msgs)
- ++ lists:flatmap(fun({_,_,_,As}) ->
- [avp_name(A) || A <- As]
- end,
- Groups)),
- MissingAvps = missing_avps(NeededAvps, Spec),
-
- report(needed, NeededAvps),
- report(missing, MissingAvps),
-
- Import = inherit(get_value(inherits, Spec), Options),
-
- report(imported, Import),
-
- ImportedAvps = lists:map(fun({N,_,_,_,_}) -> N end,
- lists:flatmap(fun last/1, Import)),
-
- Unknown = MissingAvps -- ImportedAvps,
-
- [] == Unknown orelse ?ERROR({undefined_avps, Unknown}),
-
- orddict:store(import_avps, Import, orddict:erase(inherits, Spec)).
-
-%% missing_avps/2
-%%
-%% Given a list of AVP names and parsed spec, return the list of
-%% AVP's that aren't defined in this spec.
-
-missing_avps(NeededNames, Spec) ->
- Avps = get_value(avp_types, Spec),
- Groups = lists:map(fun({N,_,_,As}) ->
- {N, [avp_name(A) || A <- As]}
- end,
- get_value(grouped, Spec)),
- Names = ordsets:from_list(['AVP' | lists:map(fun({N,_,_,_,_}) -> N end,
- Avps)]),
- missing_avps(NeededNames, [], {Names, Groups}).
-
-avp_name({'<',A,'>'}) -> A;
-avp_name({A}) -> A;
-avp_name([A]) -> A;
-avp_name({_, A}) -> avp_name(A).
-
-missing_avps(NeededNames, MissingNames, {Names, _} = T) ->
- missing(ordsets:filter(fun(N) -> lists:member(N, NeededNames) end, Names),
- ordsets:union(NeededNames, MissingNames),
- T).
-
-%% Nothing found locally.
-missing([], MissingNames, _) ->
- MissingNames;
-
-%% Or not. Keep looking for for the AVP's needed by the found AVP's of
-%% type Grouped.
-missing(FoundNames, MissingNames, {_, Groups} = T) ->
- NeededNames = lists:flatmap(fun({N,As}) ->
- choose(lists:member(N, FoundNames), As, [])
- end,
- Groups),
- missing_avps(ordsets:from_list(NeededNames),
- ordsets:subtract(MissingNames, FoundNames),
- T).
-
-%% inherit/2
-
-inherit(Inherits, Options) ->
- Dirs = [D || {include, D} <- Options] ++ ["."],
- lists:foldl(fun(T,A) -> find_avps(T, A, Dirs) end, [], Inherits).
-
-find_avps({Mod, AvpNames}, Acc, Path) ->
- report(inherit_from, Mod),
- Avps = avps_from_beam(find_beam(Mod, Path), Mod), %% could be empty
- [{Mod, lists:sort(find_avps(AvpNames, Avps))} | Acc].
-
-find_avps([], Avps) ->
- Avps;
-find_avps(Names, Avps) ->
- lists:filter(fun({N,_,_,_,_}) -> lists:member(N, Names) end, Avps).
-
-%% find_beam/2
-
-find_beam(Mod, Dirs)
- when is_atom(Mod) ->
- find_beam(atom_to_list(Mod), Dirs);
-find_beam(Mod, Dirs) ->
- Beam = Mod ++ code:objfile_extension(),
- case try_path(Dirs, Beam) of
- {value, Path} ->
- Path;
- false ->
- ?ERROR({beam_not_on_path, Beam, Dirs})
- end.
-
-try_path([D|Ds], Fname) ->
- Path = filename:join(D, Fname),
- case file:read_file_info(Path) of
- {ok, _} ->
- {value, Path};
- _ ->
- try_path(Ds, Fname)
- end;
-try_path([], _) ->
- false.
-
-%% avps_from_beam/2
-
-avps_from_beam(Path, Mod) ->
- report(beam, Path),
- ok = load_module(code:is_loaded(Mod), Mod, Path),
- orddict:fetch(avp_types, Mod:dict()).
-
-load_module(false, Mod, Path) ->
- R = filename:rootname(Path, code:objfile_extension()),
- {module, Mod} = code:load_abs(R),
- ok;
-load_module({file, _}, _, _) ->
- ok.
-
-choose(true, X, _) -> X;
-choose(false, _, X) -> X.
-
-%% ------------------------------------------------------------------------
-%% import_groups/1
-%% import_enums/1
-%%
-%% For each inherited module, store the content of imported AVP's of
-%% type grouped/enumerated in a new key.
-
-import_groups(Spec) ->
- orddict:store(import_groups, import(grouped, Spec), Spec).
-
-import_enums(Spec) ->
- orddict:store(import_enums, import(enums, Spec), Spec).
-
-import(Key, Spec) ->
- lists:flatmap(fun(T) -> import_key(Key, T) end,
- get_value(import_avps, Spec)).
-
-import_key(Key, {Mod, Avps}) ->
- Imports = lists:flatmap(fun(T) ->
- choose(lists:keymember(element(1,T),
- 1,
- Avps),
- [T],
- [])
- end,
- get_value(Key, Mod:dict())),
- if Imports == [] ->
- [];
- true ->
- [{Mod, Imports}]
- end.
-
-%% ------------------------------------------------------------------------
-%% parse_enums/1
-%%
-%% Enums are specified either as the integer value followed by the
-%% name or vice-versa. In the former case the name of the enum is
-%% taken to be the string up to the end of line, which may contain
-%% whitespace. In the latter case the integer may be parenthesized,
-%% specified in hex and followed by an inline comment. This is
-%% historical and will likely be changed to require a precise input
-%% format.
-%%
-%% Output: list() of {integer(), atom()}
-
-parse_enums(Str) ->
- lists:flatmap(fun(L) -> parse_enum(trim(L)) end, string:tokens(Str, "\n")).
-
-parse_enum([]) ->
- [];
-
-parse_enum(Str) ->
- REs = [{"^(0[xX][0-9A-Fa-f]+|[0-9]+)\s+(.*?)\s*$", 1, 2},
- {"^(.+?)\s+(0[xX][0-9A-Fa-f]+|[0-9]+)(\s+.*)?$", 2, 1},
- {"^(.+?)\s+\\((0[xX][0-9A-Fa-f]+|[0-9]+)\\)(\s+.*)?$", 2, 1}],
- parse_enum(Str, REs).
-
-parse_enum(Str, REs) ->
- try lists:foreach(fun(R) -> enum(Str, R) end, REs) of
- ok ->
- ?ERROR({bad_enum, Str})
- catch
- throw: {enum, T} ->
- [T]
- end.
-
-enum(Str, {Re, I, N}) ->
- case re:run(Str, Re, [{capture, all_but_first, list}]) of
- {match, Vs} ->
- T = list_to_tuple(Vs),
- throw({enum, {to_int(element(I,T)), ?ATOM(element(N,T))}});
- nomatch ->
- ok
- end.
-
-to_int([$0,X|Hex])
- when X == $x;
- X == $X ->
- {ok, [I], _} = io_lib:fread("~#", "16#" ++ Hex),
- I;
-to_int(I) ->
- list_to_integer(I).
-
-%% ------------------------------------------------------------------------
-%% parse_messages/1
-%%
-%% Parse according to the ABNF for message specifications in 3.2 of
-%% RFC 3588 (shown below). We require all message and AVP names to
-%% start with a digit or uppercase character, except for the base
-%% answer-message, which is treated as a special case. Allowing names
-%% that start with a digit is more than the RFC specifies but the name
-%% doesn't affect what's sent over the wire. (Certains 3GPP standards
-%% use names starting with a digit. eg 3GPP-Charging-Id in TS32.299.)
-
-%%
-%% Sadly, not even the RFC follows this grammar. In particular, except
-%% in the example in 3.2, it wraps each command-name in angle brackets
-%% ('<' '>') which makes parsing a sequence of specifications require
-%% lookahead: after 'optional' avps have been parsed, it's not clear
-%% whether a '<' is a 'fixed' or whether it's the start of a
-%% subsequent message until we see whether or not '::=' follows the
-%% closing '>'. Require the grammar as specified.
-%%
-%% Output: list of {Name, Code, Flags, ApplId, Avps}
-%%
-%% Name = atom()
-%% Code = integer()
-%% Flags = integer()
-%% ApplId = [] | [integer()]
-%% Avps = see parse_avps/1
-
-parse_messages(Str) ->
- p_cmd(trim(Str), []).
-
-%% command-def = command-name "::=" diameter-message
-%%
-%% command-name = diameter-name
-%%
-%% diameter-name = ALPHA *(ALPHA / DIGIT / "-")
-%%
-%% diameter-message = header [ *fixed] [ *required] [ *optional]
-%% [ *fixed]
-%%
-%% header = "<" Diameter-Header:" command-id
-%% [r-bit] [p-bit] [e-bit] [application-id]">"
-%%
-%% The header spec (and example that follows it) is slightly mangled
-%% and, given the examples in the RFC should as follows:
-%%
-%% header = "<" "Diameter Header:" command-id
-%% [r-bit] [p-bit] [e-bit] [application-id]">"
-%%
-%% This is what's required/parsed below, modulo whitespace. This is
-%% also what's specified in the current draft standard at
-%% http://ftp.ietf.org/drafts/wg/dime.
-%%
-%% Note that the grammar specifies the order fixed, required,
-%% optional. In practise there seems to be little difference between
-%% the latter two since qualifiers can be used to change the
-%% semantics. For example 1*[XXX] and *1{YYY} specify 1 or more of the
-%% optional avp XXX and 0 or 1 of the required avp YYY, making the
-%% iotional avp required and the required avp optional. The current
-%% draft addresses this somewhat by requiring that min for a qualifier
-%% on an optional avp must be 0 if present. It doesn't say anything
-%% about required avps however, so specifying a min of 0 would still
-%% be possible. The draft also does away with the trailing *fixed.
-%%
-%% What will be parsed here will treat required and optional
-%% interchangeably. That is. only require that required/optional
-%% follow and preceed fixed, not that optional avps must follow
-%% required ones. We already have several specs for which this parsing
-%% is necessary and there seems to be no harm in accepting it.
-
-p_cmd("", Acc) ->
- lists:reverse(Acc);
-
-p_cmd(Str, Acc) ->
- {Next, Rest} = split_def(Str),
- report(command, Next),
- p_cmd(Rest, [p_cmd(Next) | Acc]).
-
-p_cmd("answer-message" ++ Str) ->
- p_header([{name, 'answer-message'} | diameter_spec_scan:parse(Str)]);
-
-p_cmd(Str) ->
- p_header(diameter_spec_scan:parse(Str)).
-
-%% p_header/1
-
-p_header(['<', {name, _} = N, '>' | Toks]) ->
- p_header([N | Toks]);
-
-p_header([{name, 'answer-message' = N}, '::=',
- '<', {name, "Diameter"}, {name, "Header"}, ':', {tag, code},
- ',', {name, "ERR"}, '[', {name, "PXY"}, ']', '>'
- | Toks]) ->
- {N, -1, ['ERR', 'PXY'], [], parse_avps(Toks)};
-
-p_header([{name, Name}, '::=',
- '<', {name, "Diameter"}, {name, "Header"}, ':', {number, Code}
- | Toks]) ->
- {Flags, Rest} = p_flags(Toks),
- {ApplId, [C|_] = R} = p_appl(Rest),
- '>' == C orelse ?ERROR({invalid_flag, {Name, Code, Flags, ApplId}, R}),
- {?ATOM(Name), Code, Flags, ApplId, parse_avps(tl(R))};
-
-p_header(Toks) ->
- ?ERROR({invalid_header, Toks}).
-
-%% application-id = 1*DIGIT
-%%
-%% command-id = 1*DIGIT
-%% ; The Command Code assigned to the command
-%%
-%% r-bit = ", REQ"
-%% ; If present, the 'R' bit in the Command
-%% ; Flags is set, indicating that the message
-%% ; is a request, as opposed to an answer.
-%%
-%% p-bit = ", PXY"
-%% ; If present, the 'P' bit in the Command
-%% ; Flags is set, indicating that the message
-%% ; is proxiable.
-%%
-%% e-bit = ", ERR"
-%% ; If present, the 'E' bit in the Command
-%% ; Flags is set, indicating that the answer
-%% ; message contains a Result-Code AVP in
-%% ; the "protocol error" class.
-
-p_flags(Toks) ->
- lists:foldl(fun p_flags/2, {[], Toks}, ["REQ", "PXY", "ERR"]).
-
-p_flags(N, {Acc, [',', {name, N} | Toks]}) ->
- {[?ATOM(N) | Acc], Toks};
-
-p_flags(_, T) ->
- T.
-
-%% The RFC doesn't specify ',' before application-id but this seems a
-%% bit inconsistent. Accept a comma if it exists.
-p_appl([',', {number, I} | Toks]) ->
- {[I], Toks};
-p_appl([{number, I} | Toks]) ->
- {[I], Toks};
-p_appl(Toks) ->
- {[], Toks}.
-
-%% parse_avps/1
-%%
-%% Output: list() of Avp | {Qual, Avp}
-%%
-%% Qual = '*' | {Min, '*'} | {'*', Max} | {Min, Max}
-%% Avp = {'<', Name, '>'} | {Name} | [Name]
-%%
-%% Min, Max = integer() >= 0
-
-parse_avps(Toks) ->
- p_avps(Toks, ['<', '|', '<'], []).
-%% The list corresponds to the delimiters expected at the front, middle
-%% and back of the avp specification, '|' representing '{' and '['.
-
-%% fixed = [qual] "<" avp-spec ">"
-%% ; Defines the fixed position of an AVP
-%%
-%% required = [qual] "{" avp-spec "}"
-%% ; The AVP MUST be present and can appear
-%% ; anywhere in the message.
-%%
-%% optional = [qual] "[" avp-name "]"
-%% ; The avp-name in the 'optional' rule cannot
-%% ; evaluate to any AVP Name which is included
-%% ; in a fixed or required rule. The AVP can
-%% ; appear anywhere in the message.
-%%
-%% qual = [min] "*" [max]
-%% ; See ABNF conventions, RFC 2234 Section 6.6.
-%% ; The absence of any qualifiers depends on whether
-%% ; it precedes a fixed, required, or optional
-%% ; rule. If a fixed or required rule has no
-%% ; qualifier, then exactly one such AVP MUST
-%% ; be present. If an optional rule has no
-%% ; qualifier, then 0 or 1 such AVP may be
-%% ; present.
-%% ;
-%% ; NOTE: "[" and "]" have a different meaning
-%% ; than in ABNF (see the optional rule, above).
-%% ; These braces cannot be used to express
-%% ; optional fixed rules (such as an optional
-%% ; ICV at the end). To do this, the convention
-%% ; is '0*1fixed'.
-%%
-%% min = 1*DIGIT
-%% ; The minimum number of times the element may
-%% ; be present. The default value is zero.
-%%
-%% max = 1*DIGIT
-%% ; The maximum number of times the element may
-%% ; be present. The default value is infinity. A
-%% ; value of zero implies the AVP MUST NOT be
-%% ; present.
-%%
-%% avp-spec = diameter-name
-%% ; The avp-spec has to be an AVP Name, defined
-%% ; in the base or extended Diameter
-%% ; specifications.
-%%
-%% avp-name = avp-spec / "AVP"
-%% ; The string "AVP" stands for *any* arbitrary
-%% ; AVP Name, which does not conflict with the
-%% ; required or fixed position AVPs defined in
-%% ; the command code definition.
-%%
-
-p_avps([], _, Acc) ->
- lists:reverse(Acc);
-
-p_avps(Toks, Delim, Acc) ->
- {Qual, Rest} = p_qual(Toks),
- {Avp, R, D} = p_avp(Rest, Delim),
- T = if Qual == false ->
- Avp;
- true ->
- {Qual, Avp}
- end,
- p_avps(R, D, [T | Acc]).
-
-p_qual([{number, Min}, '*', {number, Max} | Toks]) ->
- {{Min, Max}, Toks};
-p_qual([{number, Min}, '*' = Max | Toks]) ->
- {{Min, Max}, Toks};
-p_qual(['*' = Min, {number, Max} | Toks]) ->
- {{Min, Max}, Toks};
-p_qual(['*' = Q | Toks]) ->
- {Q, Toks};
-p_qual(Toks) ->
- {false, Toks}.
-
-p_avp([B, {name, Name}, E | Toks], [_|_] = Delim) ->
- {avp(B, ?ATOM(Name), E),
- Toks,
- delim(choose(B == '<', B, '|'), Delim)};
-p_avp(Toks, Delim) ->
- ?ERROR({invalid_avp, Toks, Delim}).
-
-avp('<' = B, Name, '>' = E) ->
- {B, Name, E};
-avp('{', Name, '}') ->
- {Name};
-avp('[', Name, ']') ->
- [Name];
-avp(B, Name, E) ->
- ?ERROR({invalid_avp, B, Name, E}).
-
-delim(B, D) ->
- if B == hd(D) -> D; true -> tl(D) end.
-
-%% split_def/1
-%%
-%% Strip one command definition off head of a string.
-
-split_def(Str) ->
- sdh(Str, []).
-
-%% Look for the "::=" starting off the definition.
-sdh("", _) ->
- ?ERROR({missing, '::='});
-sdh("::=" ++ Rest, Acc) ->
- sdb(Rest, [$=,$:,$:|Acc]);
-sdh([C|Rest], Acc) ->
- sdh(Rest, [C|Acc]).
-
-%% Look for the "::=" starting off the following definition.
-sdb("::=" ++ _ = Rest, Acc) ->
- sdt(trim(Acc), Rest);
-sdb("" = Rest, Acc) ->
- sd(Acc, Rest);
-sdb([C|Rest], Acc) ->
- sdb(Rest, [C|Acc]).
-
-%% Put name characters of the subsequent specification back into Rest.
-sdt([C|Acc], Rest)
- when C /= $\n, C /= $\s ->
- sdt(Acc, [C|Rest]);
-
-sdt(Acc, Rest) ->
- sd(Acc, Rest).
-
-sd(Acc, Rest) ->
- {trim(lists:reverse(Acc)), Rest}.
-%% Note that Rest is already trimmed of leading space.
-
-%% ------------------------------------------------------------------------
-%% parse_groups/1
-%%
-%% Parse according to the ABNF for message specifications in 4.4 of
-%% RFC 3588 (shown below). Again, allow names starting with a digit
-%% and also require "AVP Header" without "-" since this is what
-%% the RFC uses in all examples.
-%%
-%% Output: list of {Name, Code, Vendor, Avps}
-%%
-%% Name = atom()
-%% Code = integer()
-%% Vendor = [] | [integer()]
-%% Avps = see parse_avps/1
-
-parse_groups(Str) ->
- p_group(trim(Str), []).
-
-%% grouped-avp-def = name "::=" avp
-%%
-%% name-fmt = ALPHA *(ALPHA / DIGIT / "-")
-%%
-%% name = name-fmt
-%% ; The name has to be the name of an AVP,
-%% ; defined in the base or extended Diameter
-%% ; specifications.
-%%
-%% avp = header [ *fixed] [ *required] [ *optional]
-%% [ *fixed]
-%%
-%% header = "<" "AVP-Header:" avpcode [vendor] ">"
-%%
-%% avpcode = 1*DIGIT
-%% ; The AVP Code assigned to the Grouped AVP
-%%
-%% vendor = 1*DIGIT
-%% ; The Vendor-ID assigned to the Grouped AVP.
-%% ; If absent, the default value of zero is
-%% ; used.
-
-p_group("", Acc) ->
- lists:reverse(Acc);
-
-p_group(Str, Acc) ->
- {Next, Rest} = split_def(Str),
- report(group, Next),
- p_group(Rest, [p_group(diameter_spec_scan:parse(Next)) | Acc]).
-
-p_group([{name, Name}, '::=', '<', {name, "AVP"}, {name, "Header"},
- ':', {number, Code}
- | Toks]) ->
- {Id, [C|_] = R} = p_vendor(Toks),
- C == '>' orelse ?ERROR({invalid_group_header, R}),
- {?ATOM(Name), Code, Id, parse_avps(tl(R))};
-
-p_group(Toks) ->
- ?ERROR({invalid_group, Toks}).
-
-p_vendor([{number, I} | Toks]) ->
- {[I], Toks};
-p_vendor(Toks) ->
- {[], Toks}.
-
-%% ------------------------------------------------------------------------
-%% parse_avp_names/1
-
-parse_avp_names(Str) ->
- [p_name(N) || N <- diameter_spec_scan:parse(Str)].
-
-p_name({name, N}) ->
- ?ATOM(N);
-p_name(T) ->
- ?ERROR({invalid_avp_name, T}).
-
-%% ------------------------------------------------------------------------
-%% parse_avp_types/1
-%%
-%% Output: list() of {Name, Code, Type, Flags, Encr}
-
-parse_avp_types(Str) ->
- p_avp_types(Str, []).
-
-p_avp_types(Str, Acc) ->
- p_type(diameter_spec_scan:split(Str, 3), Acc).
-
-p_type({[],[]}, Acc) ->
- lists:reverse(Acc);
-
-p_type({[{name, Name}, {number, Code}, {name, Type}], Str}, Acc) ->
- {Flags, Encr, Rest} = try
- p_avp_flags(trim(Str), [])
- catch
- throw: {?MODULE, Reason} ->
- ?ERROR({invalid_avp_type, Reason})
- end,
- p_avp_types(Rest, [{?ATOM(Name), Code, ?ATOM(type(Type)), Flags, Encr}
- | Acc]);
-
-p_type(T, _) ->
- ?ERROR({invalid_avp_type, T}).
-
-p_avp_flags([C|Str], Acc)
- when C == $M;
- C == $P;
- C == $V ->
- p_avp_flags(Str, [?ATOM([C]) | Acc]);
-%% Could support lowercase here if there's a use for distinguishing
-%% between Must and Should in the future in deciding whether or not
-%% to set a flag.
-
-p_avp_flags([$-|Str], Acc) ->
- %% Require encr on same line as flags if specified.
- {H,T} = lists:splitwith(fun(C) -> C /= $\n end, Str),
-
- {[{name, [$X|X]} | Toks], Rest} = diameter_spec_scan:split([$X|H], 2),
-
- "" == X orelse throw({?MODULE, {invalid_avp_flag, Str}}),
-
- Encr = case Toks of
- [] ->
- "-";
- [{_, E}] ->
- (E == "Y" orelse E == "N")
- orelse throw({?MODULE, {invalid_encr, E}}),
- E
- end,
-
- Flags = ordsets:from_list(lists:reverse(Acc)),
-
- {Flags, ?ATOM(Encr), Rest ++ T};
-
-p_avp_flags(Str, Acc) ->
- p_avp_flags([$-|Str], Acc).
-
-type("DiamIdent") -> "DiameterIdentity"; %% RFC 3588
-type("DiamURI") -> "DiameterURI"; %% RFC 3588
-type("IPFltrRule") -> "IPFilterRule"; %% RFC 4005
-type("QoSFltrRule") -> "QoSFilterRule"; %% RFC 4005
-type(N)
- when N == "OctetString";
- N == "Integer32";
- N == "Integer64";
- N == "Unsigned32";
- N == "Unsigned64";
- N == "Float32";
- N == "Float64";
- N == "Grouped";
- N == "Enumerated";
- N == "Address";
- N == "Time";
- N == "UTF8String";
- N == "DiameterIdentity";
- N == "DiameterURI";
- N == "IPFilterRule";
- N == "QoSFilterRule" ->
- N;
-type(N) ->
- ?ERROR({invalid_avp_type, N}).
-
-%% ------------------------------------------------------------------------
-%% parse_commands/1
-
-parse_commands(Str) ->
- p_abbr(diameter_spec_scan:parse(Str), []).
-
- p_abbr([{name, Name}, {name, Abbrev} | Toks], Acc)
- when length(Abbrev) < length(Name) ->
- p_abbr(Toks, [{?ATOM(Name), ?ATOM(Abbrev)} | Acc]);
-
-p_abbr([], Acc) ->
- lists:reverse(Acc);
-
-p_abbr(T, _) ->
- ?ERROR({invalid_command, T}).