1%% vim: tabstop=8:shiftwidth=4
2%%
3%% %CopyrightBegin%
4%%
5%% Copyright Ericsson AB 2014-2017. All Rights Reserved.
6%%
7%% Licensed under the Apache License, Version 2.0 (the "License");
8%% you may not use this file except in compliance with the License.
9%% You may obtain a copy of the License at
10%%
11%%     http://www.apache.org/licenses/LICENSE-2.0
12%%
13%% Unless required by applicable law or agreed to in writing, software
14%% distributed under the License is distributed on an "AS IS" BASIS,
15%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
16%% See the License for the specific language governing permissions and
17%% limitations under the License.
18%%
19%% %CopyrightEnd%
20%%
21%%
22
23-module(asn1ct_gen_check).
24-export([emit/4]).
25
26-import(asn1ct_gen, [emit/1]).
27-include("asn1_records.hrl").
28
29emit(Gen, Type, Default, Value) ->
30    Key = {Type,Default},
31    DoGen = fun(Fd, Name) ->
32                    file:write(Fd, gen(Gen, Name, Type, Default))
33            end,
34    emit(" case "),
35    asn1ct_func:call_gen("is_default_", Key, DoGen, [Value]),
36    emit([" of",nl,
37	  "true -> {[],0};",nl,
38	  "false ->",nl]).
39
40gen(#gen{pack=Pack}=Gen, Name, #type{def=T}, Default) ->
41    DefMarker = case Pack of
42                    record -> "asn1_DEFAULT";
43                    map -> atom_to_list(?MISSING_IN_MAP)
44                end,
45    NameStr = atom_to_list(Name),
46    [NameStr,"(",DefMarker,") ->\n",
47     "true;\n"|
48     case do_gen(Gen, T, Default) of
49         {literal,Literal} ->
50             [NameStr,"(Def) when Def =:= ",term2str(Literal)," ->\n",
51              "true;\n",
52              NameStr,"(_) ->\n","false.\n\n"];
53         {exception,Func,Args} ->
54             [NameStr,"(Value) ->\n",
55              "try ",Func,"(Value",arg2str(Args),") of\n",
56              "_ -> true\n"
57              "catch throw:false -> false\n"
58              "end.\n\n"]
59     end].
60
61do_gen(_Gen, _, asn1_NOVALUE) ->
62    {literal,asn1_NOVALUE};
63do_gen(Gen, #'Externaltypereference'{module=M,type=T}, Default) ->
64    #typedef{typespec=#type{def=Td}} = asn1_db:dbget(M, T),
65    do_gen(Gen, Td, Default);
66do_gen(_Gen, 'BOOLEAN', Default) ->
67    {literal,Default};
68do_gen(_Gen, {'BIT STRING',[]}, Default) ->
69    true = is_bitstring(Default),		%Assertion.
70    case asn1ct:use_legacy_types() of
71	false ->
72	    {literal,Default};
73	true ->
74	    {exception,need(check_legacy_bitstring, 2),[Default]}
75    end;
76do_gen(_Gen, {'BIT STRING',[_|_]=NBL}, Default) ->
77    do_named_bitstring(NBL, Default);
78do_gen(_Gen, {'ENUMERATED',_}, Default) ->
79    {literal,Default};
80do_gen(_Gen, 'INTEGER', Default) ->
81    {literal,Default};
82do_gen(_Gen, {'INTEGER',NNL}, Default) ->
83    {exception,need(check_int, 3),[Default,NNL]};
84do_gen(_Gen, 'NULL', Default) ->
85    {literal,Default};
86do_gen(_Gen, 'OCTET STRING', Default) ->
87    true = is_binary(Default),			%Assertion.
88    case asn1ct:use_legacy_types() of
89	false ->
90	    {literal,Default};
91	true ->
92	    {exception,need(check_octetstring, 2),[Default]}
93    end;
94do_gen(_Gen, 'OBJECT IDENTIFIER', Default0) ->
95    Default = pre_process_oid(Default0),
96    {exception,need(check_objectidentifier, 2),[Default]};
97do_gen(Gen, {'CHOICE',Cs}, Default) ->
98    {Tag,Value} = Default,
99    [Type] = [Type || #'ComponentType'{name=T,typespec=Type} <- Cs,
100		      T =:= Tag],
101    case do_gen(Gen, Type#type.def, Value) of
102	{literal,Lit} ->
103	    {literal,{Tag,Lit}};
104	{exception,Func0,Args} ->
105	    Key = {Tag,Func0,Args},
106	    DoGen = fun(Fd, Name) ->
107                            S = gen_choice(Name, Tag, Func0, Args),
108                            ok = file:write(Fd, S)
109		  end,
110	    Func = asn1ct_func:call_gen("is_default_choice", Key, DoGen),
111	    {exception,atom_to_list(Func),[]}
112    end;
113do_gen(Gen, #'SEQUENCE'{components=Cs}, Default) ->
114    do_seq_set(Gen, Cs, Default);
115do_gen(Gen, {'SEQUENCE OF',Type}, Default) ->
116    do_sof(Gen, Type, Default);
117do_gen(Gen, #'SET'{components=Cs}, Default) ->
118    do_seq_set(Gen, Cs, Default);
119do_gen(Gen, {'SET OF',Type}, Default) ->
120    do_sof(Gen, Type, Default);
121do_gen(_Gen, Type, Default) ->
122    case asn1ct_gen:unify_if_string(Type) of
123	restrictedstring ->
124	    {exception,need(check_restrictedstring, 2),[Default]};
125	_ ->
126	    %% Open type. Do our best.
127	    {literal,Default}
128    end.
129
130do_named_bitstring(NBL, Default0) when is_list(Default0) ->
131    Default = lists:sort(Default0),
132    Bs = asn1ct_gen:named_bitstring_value(Default, NBL),
133    Func = case asn1ct:use_legacy_types() of
134	       false -> check_named_bitstring;
135	       true -> check_legacy_named_bitstring
136	   end,
137    {exception,need(Func, 4),[Default,Bs,bit_size(Bs)]};
138do_named_bitstring(_, Default) when is_bitstring(Default) ->
139    Func = case asn1ct:use_legacy_types() of
140	       false -> check_named_bitstring;
141	       true -> check_legacy_named_bitstring
142	   end,
143    {exception,need(Func, 3),[Default,bit_size(Default)]}.
144
145do_seq_set(#gen{pack=record}=Gen, Cs0, Default) ->
146    Tag = element(1, Default),
147    Cs1 = [T || #'ComponentType'{typespec=T} <- Cs0],
148    Cs = components(Gen, Cs1, tl(tuple_to_list(Default))),
149    case are_all_literals(Cs) of
150	true ->
151	    Literal = list_to_tuple([Tag|[L || {literal,L} <- Cs]]),
152	    {literal,Literal};
153	false ->
154	    Key = {Cs,Default},
155	    DoGen = fun(Fd, Name) ->
156                            S = gen_components(Name, Tag, Cs),
157                            ok = file:write(Fd, S)
158                    end,
159	    Func = asn1ct_func:call_gen("is_default_cs_", Key, DoGen),
160	    {exception,atom_to_list(Func),[]}
161    end;
162do_seq_set(#gen{pack=map}=Gen, Cs0, Default) ->
163    Cs1 = [{N,T} || #'ComponentType'{name=N,typespec=T} <- Cs0],
164    Cs = map_components(Gen, Cs1, Default),
165    AllLiterals = lists:all(fun({_,{literal,_}}) -> true;
166                               ({_,_}) -> false
167                            end, Cs),
168    case AllLiterals of
169	true ->
170            L = [{Name,Lit} || {Name,{literal,Lit}} <- Cs],
171	    {literal,maps:from_list(L)};
172	false ->
173	    Key = {Cs,Default},
174	    DoGen = fun(Fd, Name) ->
175                            S = gen_map_components(Name, Cs),
176                            ok = file:write(Fd, S)
177                    end,
178	    Func = asn1ct_func:call_gen("is_default_cs_", Key, DoGen),
179	    {exception,atom_to_list(Func),[]}
180    end.
181
182do_sof(Gen, Type, Default0) ->
183    Default = lists:sort(Default0),
184    Cs0 = lists:duplicate(length(Default), Type),
185    Cs = components(Gen, Cs0, Default),
186    case are_all_literals(Cs) of
187	true ->
188	    Literal = [Lit || {literal,Lit} <- Cs],
189	    {exception,need(check_literal_sof, 2),[Literal]};
190	false ->
191	    Key = Cs,
192	    DoGen = fun(Fd, Name) ->
193                            S = gen_sof(Name, Cs),
194                            ok = file:write(Fd, S)
195		  end,
196	    Func = asn1ct_func:call_gen("is_default_sof", Key, DoGen),
197	    {exception,atom_to_list(Func),[]}
198    end.
199
200are_all_literals([{literal,_}|T]) ->
201    are_all_literals(T);
202are_all_literals([_|_]) ->
203    false;
204are_all_literals([]) -> true.
205
206gen_components(Name, Tag, Cs) ->
207    [atom_to_list(Name),"(Value) ->\n",
208     "case Value of\n",
209     "{",term2str(Tag)|gen_cs_1(Cs, 1, [])].
210
211gen_cs_1([{literal,Lit}|T], I, Acc) ->
212    [",\n",term2str(Lit)|gen_cs_1(T, I, Acc)];
213gen_cs_1([H|T], I, Acc) ->
214    Var = "E"++integer_to_list(I),
215    [",\n",Var|gen_cs_1(T, I+1, [{Var,H}|Acc])];
216gen_cs_1([], _, Acc) ->
217    ["} ->\n"|gen_cs_2(Acc, "")].
218
219gen_cs_2([{Var,{exception,Func,Args}}|T], Sep) ->
220    [Sep,Func,"(",Var,arg2str(Args),")"|gen_cs_2(T, ",\n")];
221gen_cs_2([], _) ->
222    [";\n",
223     "_ ->\n"
224     "throw(false)\n"
225     "end.\n"].
226
227gen_map_components(Name, Cs) ->
228    [atom_to_list(Name),"(Value) ->\n",
229     "case Value of\n",
230     "#{"|gen_map_cs_1(Cs, 1, "", [])].
231
232gen_map_cs_1([{Name,{literal,Lit}}|T], I, Sep, Acc) ->
233    Var = "E"++integer_to_list(I),
234    G = Var ++ " =:= " ++ term2str(Lit),
235    [Sep,term2str(Name),":=",Var|
236     gen_map_cs_1(T, I+1, ",\n", [{guard,G}|Acc])];
237gen_map_cs_1([{Name,Exc}|T], I, Sep, Acc) ->
238    Var = "E"++integer_to_list(I),
239    [Sep,term2str(Name),":=",Var|
240     gen_map_cs_1(T, I+1, ",\n", [{exc,{Var,Exc}}|Acc])];
241gen_map_cs_1([], _, _, Acc) ->
242    G = lists:join(", ", [S || {guard,S} <- Acc]),
243    Exc = [E || {exc,E} <- Acc],
244    Body = gen_map_cs_2(Exc, ""),
245    case G of
246        [] ->
247            ["} ->\n"|Body];
248        [_|_] ->
249            ["} when ",G," ->\n"|Body]
250    end.
251
252gen_map_cs_2([{Var,{exception,Func,Args}}|T], Sep) ->
253    [Sep,Func,"(",Var,arg2str(Args),")"|gen_map_cs_2(T, ",\n")];
254gen_map_cs_2([], _) ->
255    [";\n",
256     "_ ->\n"
257     "throw(false)\n"
258     "end.\n"].
259
260gen_sof(Name, Cs) ->
261    [atom_to_list(Name),"(Value) ->\n",
262     "case length(Value) of\n",
263     integer_to_list(length(Cs))," -> ok;\n"
264     "_ -> throw(false)\n"
265     "end,\n"
266     "T0 = lists:sort(Value)"|gen_sof_1(Cs, 1)].
267
268gen_sof_1([{exception,Func,Args}|Cs], I) ->
269    NumStr = integer_to_list(I),
270    H = "H" ++ NumStr,
271    T = "T" ++ NumStr,
272    Prev = "T" ++ integer_to_list(I-1),
273    [",\n",
274     "[",H,case Cs of
275	       [] -> [];
276	       [_|_] -> ["|",T]
277	   end,"] = ",Prev,",\n",
278     Func,"(",H,arg2str(Args),")"|gen_sof_1(Cs, I+1)];
279gen_sof_1([], _) ->
280    ".\n".
281
282components(Gen, [#type{def=Def}|Ts], [V|Vs]) ->
283    [do_gen(Gen, Def, V)|components(Gen, Ts, Vs)];
284components(_Gen, [], []) -> [].
285
286map_components(Gen, [{Name,#type{def=Def}}|Ts], Value) ->
287    case maps:find(Name, Value) of
288        {ok,V} ->
289            [{Name,do_gen(Gen, Def, V)}|map_components(Gen, Ts, Value)];
290        error ->
291            map_components(Gen, Ts, Value)
292    end;
293map_components(_Gen, [], _Value) -> [].
294
295gen_choice(Name, Tag, Func, Args) ->
296    NameStr = atom_to_list(Name),
297    [NameStr,"({",term2str(Tag),",Value}) ->\n"
298     " ",Func,"(Value",arg2str(Args),");\n",
299     NameStr,"(_) ->\n"
300     " throw(false).\n"].
301
302pre_process_oid(Oid) ->
303    Reserved = reserved_oid(),
304    pre_process_oid(tuple_to_list(Oid), Reserved, []).
305
306pre_process_oid([H|T]=Tail, Res0, Acc) ->
307    case lists:keyfind(H, 2, Res0) of
308	false ->
309	    {lists:reverse(Acc),Tail};
310	{Names0,H,Res} ->
311	    Names = case is_list(Names0) of
312			false -> [Names0];
313			true -> Names0
314		    end,
315	    Keys = [H|Names],
316	    pre_process_oid(T, Res, [Keys|Acc])
317    end.
318
319reserved_oid() ->
320    [{['itu-t',ccitt],0,
321      [{recommendation,0,[]},
322       {question,1,[]},
323       {administration,2,[]},
324       {'network-operator',3,[]},
325       {'identified-organization',4,[]}]},
326     {iso,1,[{standard,0,[]},
327	     {'member-body',2,[]},
328	     {'identified-organization',3,[]}]},
329     {['joint-iso-itu-t','joint-iso-ccitt'],2,[]}].
330
331arg2str(Args) ->
332    [", "++term2str(Arg) || Arg <- Args].
333
334term2str(T) ->
335    io_lib:format("~w", [T]).
336
337need(F, A) ->
338    asn1ct_func:need({check,F,A}),
339    atom_to_list(F).
340