aboutsummaryrefslogtreecommitdiffstats
path: root/lib/diameter/src/compiler/diameter_spec_util.erl
diff options
context:
space:
mode:
authorAnders Svensson <[email protected]>2011-05-18 18:29:12 +0200
committerAnders Svensson <[email protected]>2011-05-18 18:29:12 +0200
commit3c15ff32e89e401b4dde2b8acc9699be2614b996 (patch)
tree184dc988fb2ab3af04a532bc59cc794a8d74fbd3 /lib/diameter/src/compiler/diameter_spec_util.erl
parentb1e768e86593178810c8a0b3c38443dcf6be5181 (diff)
downloadotp-3c15ff32e89e401b4dde2b8acc9699be2614b996.tar.gz
otp-3c15ff32e89e401b4dde2b8acc9699be2614b996.tar.bz2
otp-3c15ff32e89e401b4dde2b8acc9699be2614b996.zip
Initial commit of the diameter application.
The application provides an implementation of the Diameter protocol as defined in RFC 3588.
Diffstat (limited to 'lib/diameter/src/compiler/diameter_spec_util.erl')
-rw-r--r--lib/diameter/src/compiler/diameter_spec_util.erl1052
1 files changed, 1052 insertions, 0 deletions
diff --git a/lib/diameter/src/compiler/diameter_spec_util.erl b/lib/diameter/src/compiler/diameter_spec_util.erl
new file mode 100644
index 0000000000..322d53a199
--- /dev/null
+++ b/lib/diameter/src/compiler/diameter_spec_util.erl
@@ -0,0 +1,1052 @@
+%%
+%% %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, Options) ->
+ put({?MODULE, verbose}, lists:member(verbose, Options)),
+ {ok, B} = file:read_file(Path),
+ Chunks = chunk(B),
+ Spec = make_spec(Chunks),
+ true = enums_defined(Spec), %% sanity checks
+ true = groups_defined(Spec), %%
+ true = customs_defined(Spec), %%
+ Full = import_enums(import_groups(import_avps(insert_codes(Spec),
+ Options))),
+ true = v_flags_set(Spec),
+ Full.
+
+%% 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);
+
+%% result_codes -> [{ResultName, [{Value, Name}, ...]}, ...]
+chunk({result_code, [N], Str}, Dict) ->
+ append(result_codes, {atomize(N), parse_enums(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) ->
+ is_defined(Spec, 'Enumerated', enums).
+
+groups_defined(Spec) ->
+ is_defined(Spec, 'Grouped', grouped).
+
+is_defined(Spec, Type, Key) ->
+ Avps = get_value(avp_types, Spec),
+ lists:all(fun(T) -> true = is_local(name(Key, T), Type, Avps) end,
+ get_value(Key, Spec)).
+
+name(enums, {N,_}) -> N;
+name(grouped, {N,_,_,_}) -> N.
+
+is_local(Name, Type, Avps) ->
+ case lists:keyfind(Name, 1, Avps) of
+ {Name, _, Type, _, _} ->
+ true;
+ {Name, _, T, _, _} ->
+ ?ERROR({avp_has_wrong_type, Name, Type, T});
+ false ->
+ ?ERROR({avp_not_defined, Name, Type})
+ end.
+
+customs_defined(Spec) ->
+ Avps = get_value(avp_types, Spec),
+ lists:all(fun(A) -> true = is_local(A, Avps) end,
+ lists:flatmap(fun last/1, get_value(custom_types, Spec))).
+
+is_local(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
+
+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}).