diff options
Diffstat (limited to 'lib/asn1/src/asn1ct_gen_check.erl')
-rw-r--r-- | lib/asn1/src/asn1ct_gen_check.erl | 271 |
1 files changed, 271 insertions, 0 deletions
diff --git a/lib/asn1/src/asn1ct_gen_check.erl b/lib/asn1/src/asn1ct_gen_check.erl new file mode 100644 index 0000000000..d80a02dfbf --- /dev/null +++ b/lib/asn1/src/asn1ct_gen_check.erl @@ -0,0 +1,271 @@ +%% vim: tabstop=8:shiftwidth=4 +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. 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% +%% +%% + +-module(asn1ct_gen_check). +-export([emit/3]). + +-import(asn1ct_gen, [emit/1]). +-include("asn1_records.hrl"). + +emit(Type, Default, Value) -> + Key = {Type,Default}, + Gen = fun(Fd, Name) -> + file:write(Fd, gen(Name, Type, Default)) + end, + emit(" case "), + asn1ct_func:call_gen("is_default_", Key, Gen, [Value]), + emit([" of",nl, + "true -> {[],0};",nl, + "false ->",nl]). + +gen(Name, #type{def=T}, Default) -> + NameStr = atom_to_list(Name), + [NameStr,"(asn1_DEFAULT) ->\n", + "true;\n"|case do_gen(T, Default) of + {literal,Literal} -> + [NameStr,"(",term2str(Literal),") ->\n","true;\n", + NameStr,"(_) ->\n","false.\n\n"]; + {exception,Func,Args} -> + [NameStr,"(Value) ->\n", + "try ",Func,"(Value",arg2str(Args),") of\n", + "_ -> true\n" + "catch throw:false -> false\n" + "end.\n\n"] + end]. + +do_gen(_, asn1_NOVALUE) -> + {literal,asn1_NOVALUE}; +do_gen(#'Externaltypereference'{module=M,type=T}, Default) -> + #typedef{typespec=#type{def=Td}} = asn1_db:dbget(M, T), + do_gen(Td, Default); +do_gen('BOOLEAN', Default) -> + {literal,Default}; +do_gen({'BIT STRING',[]}, Default) -> + true = is_bitstring(Default), %Assertion. + case asn1ct:use_legacy_types() of + false -> + {literal,Default}; + true -> + {exception,need(check_legacy_bitstring, 2),[Default]} + end; +do_gen({'BIT STRING',[_|_]=NBL}, Default) -> + do_named_bitstring(NBL, Default); +do_gen({'ENUMERATED',_}, Default) -> + {literal,Default}; +do_gen('INTEGER', Default) -> + {literal,Default}; +do_gen({'INTEGER',NNL}, Default) -> + {exception,need(check_int, 3),[Default,NNL]}; +do_gen('NULL', Default) -> + {literal,Default}; +do_gen('OCTET STRING', Default) -> + true = is_binary(Default), %Assertion. + case asn1ct:use_legacy_types() of + false -> + {literal,Default}; + true -> + {exception,need(check_octetstring, 2),[Default]} + end; +do_gen('OBJECT IDENTIFIER', Default0) -> + Default = pre_process_oid(Default0), + {exception,need(check_objectidentifier, 2),[Default]}; +do_gen({'CHOICE',Cs}, Default) -> + {Tag,Value} = Default, + [Type] = [Type || #'ComponentType'{name=T,typespec=Type} <- Cs, + T =:= Tag], + case do_gen(Type#type.def, Value) of + {literal,Lit} -> + {literal,{Tag,Lit}}; + {exception,Func0,Args} -> + Key = {Tag,Func0,Args}, + Gen = fun(Fd, Name) -> + S = gen_choice(Name, Tag, Func0, Args), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_choice", Key, Gen), + {exception,atom_to_list(Func),[]} + end; +do_gen(#'SEQUENCE'{components=Cs}, Default) -> + do_seq_set(Cs, Default); +do_gen({'SEQUENCE OF',Type}, Default) -> + do_sof(Type, Default); +do_gen(#'SET'{components=Cs}, Default) -> + do_seq_set(Cs, Default); +do_gen({'SET OF',Type}, Default) -> + do_sof(Type, Default); +do_gen(Type, Default) -> + case asn1ct_gen:unify_if_string(Type) of + restrictedstring -> + {exception,need(check_restrictedstring, 2),[Default]}; + _ -> + %% Open type. Do our best. + {literal,Default} + end. + +do_named_bitstring(NBL, Default0) when is_list(Default0) -> + Default = lists:sort(Default0), + Bs = asn1ct_gen:named_bitstring_value(Default, NBL), + Func = case asn1ct:use_legacy_types() of + false -> check_named_bitstring; + true -> check_legacy_named_bitstring + end, + {exception,need(Func, 4),[Default,Bs,bit_size(Bs)]}; +do_named_bitstring(_, Default) when is_bitstring(Default) -> + Func = case asn1ct:use_legacy_types() of + false -> check_named_bitstring; + true -> check_legacy_named_bitstring + end, + {exception,need(Func, 3),[Default,bit_size(Default)]}. + +do_seq_set(Cs0, Default) -> + Tag = element(1, Default), + Cs1 = [T || #'ComponentType'{typespec=T} <- Cs0], + Cs = components(Cs1, tl(tuple_to_list(Default))), + case are_all_literals(Cs) of + true -> + Literal = list_to_tuple([Tag|[L || {literal,L} <- Cs]]), + {literal,Literal}; + false -> + Key = {Cs,Default}, + Gen = fun(Fd, Name) -> + S = gen_components(Name, Tag, Cs), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_cs_", Key, Gen), + {exception,atom_to_list(Func),[]} + end. + +do_sof(Type, Default0) -> + Default = lists:sort(Default0), + Cs0 = lists:duplicate(length(Default), Type), + Cs = components(Cs0, Default), + case are_all_literals(Cs) of + true -> + Literal = [Lit || {literal,Lit} <- Cs], + {exception,need(check_literal_sof, 2),[Literal]}; + false -> + Key = Cs, + Gen = fun(Fd, Name) -> + S = gen_sof(Name, Cs), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_sof", Key, Gen), + {exception,atom_to_list(Func),[]} + end. + +are_all_literals([{literal,_}|T]) -> + are_all_literals(T); +are_all_literals([_|_]) -> + false; +are_all_literals([]) -> true. + +gen_components(Name, Tag, Cs) -> + [atom_to_list(Name),"(Value) ->\n", + "case Value of\n", + "{",term2str(Tag)|gen_cs_1(Cs, 1, [])]. + +gen_cs_1([{literal,Lit}|T], I, Acc) -> + [",\n",term2str(Lit)|gen_cs_1(T, I, Acc)]; +gen_cs_1([H|T], I, Acc) -> + Var = "E"++integer_to_list(I), + [",\n",Var|gen_cs_1(T, I+1, [{Var,H}|Acc])]; +gen_cs_1([], _, Acc) -> + ["} ->\n"|gen_cs_2(Acc, "")]. + +gen_cs_2([{Var,{exception,Func,Args}}|T], Sep) -> + [Sep,Func,"(",Var,arg2str(Args),")"|gen_cs_2(T, ",\n")]; +gen_cs_2([], _) -> + [";\n", + "_ ->\n" + "throw(false)\n" + "end.\n"]. + +gen_sof(Name, Cs) -> + [atom_to_list(Name),"(Value) ->\n", + "case length(Value) of\n", + integer_to_list(length(Cs))," -> ok;\n" + "_ -> throw(false)\n" + "end,\n" + "T0 = lists:sort(Value)"|gen_sof_1(Cs, 1)]. + +gen_sof_1([{exception,Func,Args}|Cs], I) -> + NumStr = integer_to_list(I), + H = "H" ++ NumStr, + T = "T" ++ NumStr, + Prev = "T" ++ integer_to_list(I-1), + [",\n", + "[",H,case Cs of + [] -> []; + [_|_] -> ["|",T] + end,"] = ",Prev,",\n", + Func,"(",H,arg2str(Args),")"|gen_sof_1(Cs, I+1)]; +gen_sof_1([], _) -> + ".\n". + +components([#type{def=Def}|Ts], [V|Vs]) -> + [do_gen(Def, V)|components(Ts, Vs)]; +components([], []) -> []. + +gen_choice(Name, Tag, Func, Args) -> + NameStr = atom_to_list(Name), + [NameStr,"({",term2str(Tag),",Value}) ->\n" + " ",Func,"(Value",arg2str(Args),");\n", + NameStr,"(_) ->\n" + " throw(false).\n"]. + +pre_process_oid(Oid) -> + Reserved = reserved_oid(), + pre_process_oid(tuple_to_list(Oid), Reserved, []). + +pre_process_oid([H|T]=Tail, Res0, Acc) -> + case lists:keyfind(H, 2, Res0) of + false -> + {lists:reverse(Acc),Tail}; + {Names0,H,Res} -> + Names = case is_list(Names0) of + false -> [Names0]; + true -> Names0 + end, + Keys = [H|Names], + pre_process_oid(T, Res, [Keys|Acc]) + end. + +reserved_oid() -> + [{['itu-t',ccitt],0, + [{recommendation,0,[]}, + {question,1,[]}, + {administration,2,[]}, + {'network-operator',3,[]}, + {'identified-organization',4,[]}]}, + {iso,1,[{standard,0,[]}, + {'member-body',2,[]}, + {'identified-organization',3,[]}]}, + {['joint-iso-itu-t','joint-iso-ccitt'],2,[]}]. + +arg2str(Args) -> + [", "++term2str(Arg) || Arg <- Args]. + +term2str(T) -> + io_lib:format("~w", [T]). + +need(F, A) -> + asn1ct_func:need({check,F,A}), + atom_to_list(F). |