%% vim: tabstop=8:shiftwidth=4 %% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1997-2013. 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_check). %% Main Module for ASN.1 compile time functions %-compile(export_all). %% Avoid warning for local function error/1 clashing with autoimported BIF. -compile({no_auto_import,[error/1]}). -export([check/2,storeindb/2,format_error/1]). %-define(debug,1). -include("asn1_records.hrl"). %%% The tag-number for universal types -define(N_BOOLEAN, 1). -define(N_INTEGER, 2). -define(N_BIT_STRING, 3). -define(N_OCTET_STRING, 4). -define(N_NULL, 5). -define(N_OBJECT_IDENTIFIER, 6). -define(N_OBJECT_DESCRIPTOR, 7). -define(N_EXTERNAL, 8). % constructed -define(N_INSTANCE_OF,8). -define(N_REAL, 9). -define(N_ENUMERATED, 10). -define(N_EMBEDDED_PDV, 11). % constructed -define(N_UTF8String, 12). -define('N_RELATIVE-OID',13). -define(N_SEQUENCE, 16). -define(N_SET, 17). -define(N_NumericString, 18). -define(N_PrintableString, 19). -define(N_TeletexString, 20). -define(N_VideotexString, 21). -define(N_IA5String, 22). -define(N_UTCTime, 23). -define(N_GeneralizedTime, 24). -define(N_GraphicString, 25). -define(N_VisibleString, 26). -define(N_GeneralString, 27). -define(N_UniversalString, 28). -define(N_CHARACTER_STRING, 29). % constructed -define(N_BMPString, 30). -define(TAG_PRIMITIVE(Num), #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}). -define(TAG_CONSTRUCTED(Num), #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}). -record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> %%Predicates used to filter errors TupleIs = fun({T,_},T) -> true; (_,_) -> false end, IsClass = fun(X) -> TupleIs(X,asn1_class) end, IsObjSet = fun(X) -> TupleIs(X,objectsetdef) end, IsPObjSet = fun(X) -> TupleIs(X,pobjectsetdef) end, IsObject = fun(X) -> TupleIs(X,objectdef) end, IsValueSet = fun(X) -> TupleIs(X,valueset) end, Element2 = fun(X) -> element(2,X) end, Element1 = fun(X) -> element(1,X) end, %% initialize internal book keeping save_asn1db_uptodate(S,S#state.erule,S#state.mname), put(top_module,S#state.mname), ParamError = checkp(S, ParameterizedTypes), %must do this before the templates are used %% table to save instances of parameterized objects,object sets asn1ct_table:new(parameterized_objects), asn1ct_table:new(inlined_objects), Terror = checkt(S, Types), ?dbg("checkt finished with errors:~n~p~n~n",[Terror]), %% get parameterized object sets sent to checkt/3 %% and update Terror {PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror), Verror = checkv(S, Values ++ ObjectSets), %value sets may be parsed as object sets ?dbg("checkv finished with errors:~n~p~n~n",[Verror]), %% get information object classes wrongly sent to checkt/3 %% and update Terror2 {AddClasses,Terror3} = filter_errors(IsClass,Terror2), NewClasses = Classes++AddClasses, Cerror = checkc(S, NewClasses), ?dbg("checkc finished with errors:~n~p~n~n",[Cerror]), %% get object sets incorrectly sent to checkv/3 %% and update Verror {ObjSetNames,Verror2} = filter_errors(IsObjSet,Verror), %% get parameterized object sets incorrectly sent to checkv/3 %% and update Verror2 {PObjSetNames,Verror3} = filter_errors(IsPObjSet,Verror2), %% get objects incorrectly sent to checkv/3 %% and update Verror3 {ObjectNames,Verror4} = filter_errors(IsObject,Verror3), NewObjects = Objects++ObjectNames, NewObjectSets = ObjSetNames ++ PObjSetNames ++ PObjSetNames1, %% get value sets %% and update Verror4 {ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4), {Oerror,ExclO,ExclOS} = checko(S,NewObjects ++ NewObjectSets, [],[],[]), ?dbg("checko finished with errors:~n~p~n~n",[Oerror]), InlinedObjTuples = asn1ct_table:to_list(inlined_objects), InlinedObjects = lists:map(Element2,InlinedObjTuples), asn1ct_table:delete(inlined_objects), ParameterizedElems = asn1ct_table:to_list(parameterized_objects), ParObjectSets = lists:filter(fun({_OSName,objectset,_}) -> true; (_)-> false end,ParameterizedElems), ParObjectSetNames = lists:map(Element1,ParObjectSets), ParTypes = lists:filter(fun({_TypeName,type,_}) -> true; (_) -> false end, ParameterizedElems), ParTypesNames = lists:map(Element1,ParTypes), asn1ct_table:delete(parameterized_objects), put(asn1_reference,undefined), Exporterror = check_exports(S,S#state.module), ImportError = check_imports(S,S#state.module), AllErrors = lists:flatten([ParamError,Terror3,Verror5,Cerror, Oerror,Exporterror,ImportError]), case AllErrors of [] -> ContextSwitchTs = context_switch_in_spec(), InstanceOf = instance_of_in_spec(S#state.mname), NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs ++ InstanceOf ++ ParTypesNames, NewValues = lists:subtract(Values,PObjSetNames++ObjectNames++ ValueSetNames), {ok, {NewTypes,NewValues,ParameterizedTypes, NewClasses,NewObjects,NewObjectSets}, {NewTypes,NewValues,ParameterizedTypes,NewClasses, lists:subtract(NewObjects,ExclO)++InlinedObjects, lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}}; _ -> {error,AllErrors} end. context_switch_in_spec() -> L = [{external,'EXTERNAL'}, {embedded_pdv,'EMBEDDED PDV'}, {character_string,'CHARACTER STRING'}], F = fun({T,TName},Acc) -> case get(T) of generate -> erase(T), [TName|Acc]; _ -> Acc end end, lists:foldl(F,[],L). instance_of_in_spec(ModName) -> case get(instance_of) of L when is_list(L) -> case lists:member(ModName,L) of true -> erase(instance_of), ['INSTANCE OF']; _ -> erase(instance_of), [] end; _ -> [] end. instance_of_decl(ModName) -> Mods = get_instance_of(), case lists:member(ModName,Mods) of true -> ok; _ -> put(instance_of,[ModName|Mods]) end. get_instance_of() -> case get(instance_of) of undefined -> []; L -> L end. put_once(T,State) -> %% state is one of undefined, unchecked, generate %% undefined > unchecked > generate case get(T) of PrevS when PrevS > State -> put(T,State); _ -> ok end. filter_errors(Pred,ErrorList) -> Element2 = fun(X) -> element(2,X) end, RemovedTupleElements = lists:filter(Pred,ErrorList), RemovedNames = lists:map(Element2,RemovedTupleElements), %% remove value set name tuples from Verror RestErrors = lists:subtract(ErrorList,RemovedTupleElements), {RemovedNames,RestErrors}. check_exports(S,Module = #module{}) -> case Module#module.exports of {exports,[]} -> []; {exports,all} -> []; {exports,ExportList} when is_list(ExportList) -> IsNotDefined = fun(X) -> case catch get_referenced_type(S,X) of {error,{asn1,_}} -> true; _ -> false end end, case lists:filter(IsNotDefined,ExportList) of [] -> []; NoDefExp -> GetName = fun(T = #'Externaltypereference'{type=N})-> %%{exported,undefined,entity,N} NewS=S#state{type=T,tname=N}, error({export,"exported undefined entity",NewS}) end, lists:map(GetName,NoDefExp) end end. check_imports(S, #module{imports={imports,Imports}}) -> check_imports_1(S, Imports, []). check_imports_1(_S, [], Acc) -> Acc; check_imports_1(S, [#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs], Acc0) -> Module = name_of_def(ModuleRef), Refs0 = [{catch get_referenced_type(S, Ref),Ref} || Ref <- Imports], Refs = [{M,R} || {{M,_},R} <- Refs0], {Illegal,Other} = lists:splitwith(fun({error,_}) -> true; (_) -> false end, Refs), ChainedRefs = [R || {M,R} <- Other, M =/= Module], IllegalRefs = [R || {error,R} <- Illegal] ++ [R || {M,R} <- ChainedRefs, ok =/= chained_import(S, Module, M, name_of_def(R))], Acc = [return_asn1_error(S, Ref, {undefined_import,name_of_def(Ref),Module}) || Ref <- IllegalRefs] ++ Acc0, check_imports_1(S, SFMs, Acc). chained_import(S,ImpMod,DefMod,Name) -> %% Name is a referenced structure that is not defined in ImpMod, %% but must be present in the Imports list of ImpMod. The chain of %% imports of Name must end in DefMod. GetImports = fun(_M_) -> case asn1_db:dbget(_M_,'MODULE') of #module{imports={imports,ImportList}} -> ImportList; _ -> [] end end, FindNameInImports = fun([],N,_) -> {no_mod,N}; ([#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],N,F) -> case [name_of_def(X) || X <- Imports, name_of_def(X) =:= N] of [] -> F(SFMs,N,F); [N] -> {name_of_def(ModuleRef),N} end end, case GetImports(ImpMod) of [] -> error; Imps -> case FindNameInImports(Imps,Name,FindNameInImports) of {no_mod,_} -> error; {DefMod,_} -> ok; {OtherMod,_} -> chained_import(S,OtherMod,DefMod,Name) end end. checkt(S0, Names) -> Check = fun do_checkt/3, %% NOTE: check_type/3 will store information in the process %% dictionary if context switching types are encountered; %% therefore we must force the evaluation order. Types = check_fold(S0, Names, Check), CtxtSwitch = check_contextswitchingtypes(S0, []), check_fold(S0, lists:reverse(CtxtSwitch), Check) ++ Types. do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) -> NewS = S#state{type=Type0,tname=Name}, try check_type(NewS, Type0, TypeSpec) of #type{}=Ts -> case Type0#typedef.checked of true -> %already checked and updated ok; _ -> Type = Type0#typedef{checked=true, typespec=Ts}, asn1_db:dbput(NewS#state.mname, Name, Type), ok end catch {error,Reason} -> error({type,Reason,NewS}); {asn1_class,_ClassDef} -> {asn1_class,Name}; pobjectsetdef -> {pobjectsetdef,Name}; pvalueset -> {pvalueset,Name} end. check_contextswitchingtypes(S,Acc) -> CSTList=[{external,'EXTERNAL'}, {embedded_pdv,'EMBEDDED PDV'}, {character_string,'CHARACTER STRING'}], check_contextswitchingtypes(S,CSTList,Acc). check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) -> case get(T) of unchecked -> put(T,generate), check_contextswitchingtypes(S,Ts,[TName|Acc]); _ -> check_contextswitchingtypes(S,Ts,Acc) end; check_contextswitchingtypes(_,[],Acc) -> Acc. checkv(S, Names) -> check_fold(S, Names, fun do_checkv/3). do_checkv(S, Name, Value) when is_record(Value, valuedef); is_record(Value, typedef); %Value set may be parsed as object set. is_record(Value, pvaluedef); is_record(Value, pvaluesetdef) -> NewS = S#state{value=Value}, try check_value(NewS, Value) of {valueset,VSet} -> Pos = asn1ct:get_pos_of_def(Value), CheckedVSDef = #typedef{checked=true,pos=Pos, name=Name,typespec=VSet}, asn1_db:dbput(NewS#state.mname, Name, CheckedVSDef), {valueset,Name}; V -> %% update the valuedef asn1_db:dbput(NewS#state.mname, Name, V), ok catch {error,Reason} -> error({value,Reason,NewS}); {pobjectsetdef} -> {pobjectsetdef,Name}; {objectsetdef} -> {objectsetdef,Name}; {asn1_class, _} -> %% this is an object, save as typedef #valuedef{checked=C,pos=Pos,name=N,type=Type, value=Def} = Value, ClassName = Type#type.def, NewSpec = #'Object'{classname=ClassName,def=Def}, NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, asn1_db:dbput(NewS#state.mname, Name, NewDef), {objectdef,Name} end. %% Check parameterized types. checkp(S, Names) -> check_fold(S, Names, fun do_checkp/3). do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) -> S = S0#state{type=Type0,tname=Name}, try check_ptype(S, Type0, TypeSpec) of #type{}=Ts -> Type = Type0#ptypedef{checked=true,typespec=Ts}, asn1_db:dbput(S#state.mname, Name, Type), ok catch {error,Reason} -> error({type,Reason,S}); {asn1_class,_ClassDef} -> {asn1_class,Name}; {asn1_param_class,_} -> ok end. %% Check class definitions. checkc(S, Names) -> check_fold(S, Names, fun do_checkc/3). do_checkc(S, Name, Class) -> case is_classname(Name) of false -> return_asn1_error(S, {illegal_class_name,Name}); true -> do_checkc_1(S, Name, Class) end. do_checkc_1(S0, Name, Class0) -> {Class1,ClassSpec} = case Class0 of #classdef{} -> {Class0,Class0}; #typedef{} -> {#classdef{name=Name},Class0#typedef.typespec} end, S = S0#state{type=Class0,tname=Name}, try check_class(S, ClassSpec) of C -> Class = Class1#classdef{checked=true,typespec=C}, asn1_db:dbput(S#state.mname, Name, Class), ok catch {error,Reason} -> error({class,Reason,S}) end. %% is_classname(Atom) -> true|false. is_classname(Name) when is_atom(Name) -> lists:all(fun($-) -> true; (D) when $0 =< D, D =< $9 -> true; (UC) when $A =< UC, UC =< $Z -> true; (_) -> false end, atom_to_list(Name)). checko(S0,[Name|Os],Acc,ExclO,ExclOS) -> Item = asn1_db:dbget(S0#state.mname, Name), S = S0#state{error_context=Item}, Result = case Item of Object when is_record(Object,typedef) -> NewS = S#state{type=Object,tname=Name}, case catch(check_object(NewS,Object,Object#typedef.typespec)) of {error,Reason} -> error({type,Reason,NewS}); {'EXIT',Reason} -> error({type,{internal_error,Reason},NewS}); {asn1,Reason} -> error({type,Reason,NewS}); O -> NewObj = Object#typedef{checked=true,typespec=O}, asn1_db:dbput(NewS#state.mname,Name,NewObj), if is_record(O,'Object') -> case O#'Object'.gen of true -> {ok,ExclO,ExclOS}; false -> {ok,[Name|ExclO],ExclOS} end; is_record(O,'ObjectSet') -> case O#'ObjectSet'.gen of true -> {ok,ExclO,ExclOS}; false -> {ok,ExclO,[Name|ExclOS]} end end end; PObject when is_record(PObject,pobjectdef) -> NewS = S#state{type=PObject,tname=Name}, case (catch check_pobject(NewS,PObject)) of {error,Reason} -> error({type,Reason,NewS}); {'EXIT',Reason} -> error({type,{internal_error,Reason},NewS}); {asn1,Reason} -> error({type,Reason,NewS}); PO -> NewPObj = PObject#pobjectdef{def=PO}, asn1_db:dbput(NewS#state.mname,Name,NewPObj), {ok,[Name|ExclO],ExclOS} end; PObjSet when is_record(PObjSet,pvaluesetdef) -> %% this is a parameterized object set. Might be a parameterized %% value set, couldn't it? NewS = S#state{type=PObjSet,tname=Name}, case (catch check_pobjectset(NewS,PObjSet)) of {error,Reason} -> error({type,Reason,NewS}); {'EXIT',Reason} -> error({type,{internal_error,Reason},NewS}); {asn1,Reason} -> error({type,Reason,NewS}); POS -> %%NewPObjSet = PObjSet#pvaluesetdef{valueset=POS}, asn1_db:dbput(NewS#state.mname,Name,POS), {ok,ExclO,[Name|ExclOS]} end end, case Result of {ok,NewExclO,NewExclOS} -> checko(S,Os,Acc,NewExclO,NewExclOS); _ -> checko(S,Os,[Result|Acc],ExclO,ExclOS) end; checko(_S,[],Acc,ExclO,ExclOS) -> {lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}. check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) -> case Ch of true -> TS; idle -> TS; _ -> store_class(S,idle,CDef,Name), CheckedTS = check_class(S,TS), store_class(S,true,CDef#classdef{typespec=CheckedTS},Name), CheckedTS end; check_class(S = #state{mname=M,tname=T},ClassSpec) when is_record(ClassSpec,type) -> Def = ClassSpec#type.def, case Def of #'Externaltypereference'{module=M,type=T} -> #objectclass{fields=Def}; % in case of recursive definitions Tref = #'Externaltypereference'{type=TName} -> {MName,RefType} = get_referenced_type(S,Tref), #classdef{} = CD = get_class_def(S, RefType), NewState = update_state(S#state{type=RefType, tname=TName}, MName), check_class(NewState, CD); {pt,ClassRef,Params} -> %% parameterized class {_,PClassDef} = get_referenced_type(S,ClassRef), NewParaList = match_parameters(S, Params), instantiate_pclass(S,PClassDef,NewParaList) end; check_class(S, #objectclass{}=C) -> check_objectclass(S, C); check_class(_S,{poc,_ObjSet,_Params}) -> 'fix this later'; check_class(S,ClassName) -> {RefMod,Def} = get_referenced_type(S,ClassName), case Def of ClassDef when is_record(ClassDef,classdef) -> case ClassDef#classdef.checked of true -> ClassDef#classdef.typespec; idle -> ClassDef#classdef.typespec; false -> Name=ClassName#'Externaltypereference'.type, store_class(S,idle,ClassDef,Name), % NewS = S#state{mname=RefMod,type=Def,tname=Name}, NewS = update_state(S#state{type=Def,tname=Name},RefMod), CheckedTS = check_class(NewS,ClassDef#classdef.typespec), store_class(S,true,ClassDef#classdef{typespec=CheckedTS},Name), CheckedTS end; TypeDef when is_record(TypeDef,typedef) -> %% this case may occur when a definition is a reference %% to a class definition. case TypeDef#typedef.typespec of #type{def=Ext} when is_record(Ext,'Externaltypereference') -> check_class(S,Ext) end end. check_objectclass(S, #objectclass{fields=Fs0,syntax=Syntax0}=C) -> Fs = check_class_fields(S, Fs0), case Syntax0 of {'WITH SYNTAX',Syntax1} -> Syntax = preprocess_syntax(S, Syntax1, Fs), C#objectclass{fields=Fs,syntax={preprocessed_syntax,Syntax}}; _ -> C#objectclass{fields=Fs} end. instantiate_pclass(S=#state{parameters=_OldArgs},PClassDef,Params) -> #ptypedef{args=Args,typespec=Type} = PClassDef, MatchedArgs = match_args(S,Args, Params, []), % NewS = S#state{type=Type,parameters=MatchedArgs++OldArgs,abscomppath=[]}, NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]}, check_class(NewS,#classdef{name=S#state.tname,typespec=Type}). store_class(S,Mode,ClassDef,ClassName) -> NewCDef = ClassDef#classdef{checked=Mode}, asn1_db:dbput(S#state.mname,ClassName,NewCDef). check_class_fields(S,Fields) -> check_class_fields(S,Fields,[]). check_class_fields(S,[F|Fields],Acc) -> NewField = case element(1,F) of fixedtypevaluefield -> {_,Name,Type,Unique,OSpec} = F, RefType = check_type(S,#typedef{typespec=Type},Type), {fixedtypevaluefield,Name,RefType,Unique,OSpec}; object_or_fixedtypevalue_field -> {_,Name,Type,Unique,OSpec} = F, Type2 = maybe_unchecked_OCFT(S,Type), Cat = case asn1ct_gen:type(asn1ct_gen:get_inner(Type2#type.def)) of Def when is_record(Def,'Externaltypereference') -> {_,D} = get_referenced_type(S, Def, true), D; {undefined,user} -> %% neither of {primitive,bif} or {constructed,bif} {_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}), D; _ -> Type end, case Cat of Class when is_record(Class,classdef) -> %% Type must be a referenced type => change it %% to an external reference. ToExt = fun(#type{def= CE = #'Externaltypereference'{}}) -> CE; (T) -> T end, {objectfield,Name,ToExt(Type),Unique,OSpec}; _ -> RefType = check_type(S,#typedef{typespec=Type},Type), {fixedtypevaluefield,Name,RefType,Unique,OSpec} end; objectset_or_fixedtypevalueset_field -> {_,Name,Type,OSpec} = F, RefType = case (catch check_type(S,#typedef{typespec=Type},Type)) of {asn1_class,_ClassDef} -> case if_current_checked_type(S,Type) of true -> Type#type.def; _ -> check_class(S,Type) end; CheckedType when is_record(CheckedType,type) -> CheckedType; _ -> error({class,"internal error, check_class_fields",S}) end, if is_record(RefType,'Externaltypereference') -> {objectsetfield,Name,Type,OSpec}; is_record(RefType,classdef) -> {objectsetfield,Name,Type,OSpec}; is_record(RefType,objectclass) -> {objectsetfield,Name,Type,OSpec}; true -> {fixedtypevaluesetfield,Name,RefType,OSpec} end; typefield -> case F of {TF,Name,{'DEFAULT',Type}} -> {TF,Name,{'DEFAULT',check_type(S,#typedef{typespec=Type},Type)}}; _ -> F end; _ -> F end, check_class_fields(S,Fields,[NewField|Acc]); check_class_fields(_S,[],Acc) -> lists:reverse(Acc). maybe_unchecked_OCFT(S,Type) -> case Type#type.def of #'ObjectClassFieldType'{type=undefined} -> check_type(S,#typedef{typespec=Type},Type); _ -> Type end. if_current_checked_type(S,#type{def=Def}) -> CurrentModule = S#state.mname, CurrentCheckedName = S#state.tname, MergedModules = S#state.inputmodules, % CurrentCheckedModule = S#state.mname, case Def of #'Externaltypereference'{module=CurrentModule, type=CurrentCheckedName} -> true; #'Externaltypereference'{module=ModuleName, type=CurrentCheckedName} -> case MergedModules of undefined -> false; _ -> lists:member(ModuleName,MergedModules) end; _ -> false end. check_pobject(_S,PObject) when is_record(PObject,pobjectdef) -> Def = PObject#pobjectdef.def, Def. check_pobjectset(S,PObjSet) -> #pvaluesetdef{pos=Pos,name=Name,args=Args,type=Type, valueset=ValueSet}=PObjSet, {Mod,Def} = get_referenced_type(S,Type#type.def), case Def of #classdef{} -> ClassName = #'Externaltypereference'{module=Mod, type=get_datastr_name(Def)}, {valueset,Set} = ValueSet, % ObjectSet = #'ObjectSet'{class={objectclassname,ClassName}, ObjectSet = #'ObjectSet'{class=ClassName, set=Set}, #pobjectsetdef{pos=Pos,name=Name,args=Args,class=Type#type.def, def=ObjectSet}; _ -> PObjSet end. check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) -> ObjSpec; check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> ?dbg("check_object ~p~n",[ObjectDef]), _ = check_externaltypereference(S,ClassRef), {ClassDef, NewClassRef} = case get_referenced_type(S, ClassRef, true) of {MName,#classdef{checked=false, name=CLName}=ClDef} -> Type = ClassRef#'Externaltypereference'.type, NewState = update_state(S#state{type=ClDef, tname=Type}, MName), ObjClass = check_class(NewState, ClDef), {ClDef#classdef{checked=true, typespec=ObjClass}, #'Externaltypereference'{module=MName, type=CLName}}; {MName,#classdef{name=CLName}=ClDef} -> {ClDef, #'Externaltypereference'{module=MName, type=CLName}}; _ -> asn1_error(S, illegal_object) end, NewObj = case ObjectDef of {object,_,_}=Def -> NewSettingList = check_objectdefn(S,Def,ClassDef), #'Object'{def=NewSettingList}; {po,{object,DefObj},ArgsList} -> {_,Object} = get_referenced_type(S,DefObj),%DefObj is a %%#'Externalvaluereference' or a #'Externaltypereference' %% Maybe this call should be catched and in case of an exception %% a not initialized parameterized object should be returned. instantiate_po(S,ClassDef,Object,ArgsList); {pv,{simpledefinedvalue,ObjRef},ArgList} -> {_,Object} = get_referenced_type(S,ObjRef), instantiate_po(S,ClassDef,Object,ArgList); #'Externalvaluereference'{} -> {_,Object} = get_referenced_type(S,ObjectDef), check_object(S, Object, object_to_check(Object)); [] -> %% An object with no fields (parsed as a value). Def = {object,defaultsyntax,[]}, NewSettingList = check_objectdefn(S, Def, ClassDef), #'Object'{def=NewSettingList} end, Fields = (ClassDef#classdef.typespec)#objectclass.fields, Gen = gen_incl(S,NewObj#'Object'.def, Fields), NewObj#'Object'{classname=NewClassRef,gen=Gen}; check_object(S, _ObjSetDef, ObjSet=#'ObjectSet'{class=ClassRef}) -> %% io:format("check_object,SET: ~p~n",[ObjSet#'ObjectSet'.set]), ?dbg("check_object set: ~p~n",[ObjSet#'ObjectSet'.set]), {_,ClassDef} = get_referenced_type(S,ClassRef), NewClassRef = check_externaltypereference(S,ClassRef), {UniqueFieldName,UniqueInfo} = case (catch get_unique_fieldname(S,ClassDef)) of {error,'__undefined_',_} -> {{unique,undefined},{unique,undefined}}; {asn1,Msg,_} -> error({class,Msg,S}); {'EXIT',Msg} -> error({class,{internal_error,Msg},S}); Other -> {element(1,Other),Other} end, NewObjSet= case prepare_objset(ObjSet#'ObjectSet'.set) of {set,SET,EXT} -> CheckedSet = check_object_list(S,NewClassRef,SET), NewSet = get_unique_valuelist(S,CheckedSet,UniqueInfo), ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=extensionmark(NewSet,EXT)}; {'SingleValue',ERef = #'Externalvaluereference'{}} -> {RefedMod,ObjDef} = get_referenced_type(S,ERef), #'Object'{def=CheckedObj} = check_object(S, ObjDef, object_to_check(ObjDef)), NewSet = get_unique_valuelist(S,[{{RefedMod,get_datastr_name(ObjDef)}, CheckedObj}], UniqueInfo), ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; ['EXTENSIONMARK'] -> ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=['EXTENSIONMARK']}; OSref when is_record(OSref,'Externaltypereference') -> {_,OS=#typedef{typespec=OSdef}} = get_referenced_type(S,OSref), check_object(S,OS,OSdef); {Type,{'EXCEPT',Exclusion}} when is_record(Type,type) -> {_,TDef} = get_referenced_type(S,Type#type.def), OS = TDef#typedef.typespec, NewSet = reduce_objectset(OS#'ObjectSet'.set,Exclusion), NewOS = OS#'ObjectSet'{set=NewSet}, check_object(S,TDef#typedef{typespec=NewOS}, NewOS); #type{def={pt,DefinedObjSet,ParamList}} -> {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), NewParamList = match_parameters(S, ParamList), instantiate_pos(S,ClassRef,PObjSetDef,NewParamList); %% actually this is an ObjectSetFromObjects construct, it %% is when the object set is retrieved from an object %% field. #type{def=#'ObjectClassFieldType'{classname=ObjName, fieldname=FieldName}} -> {RefedObjMod,TDef} = get_referenced_type(S,ObjName), OS=TDef#typedef.typespec, %% should get the right object set here. Get the field %% FieldName out of the object set OS of class %% OS#'ObjectSet'.class OS2=check_object(S,TDef,OS), NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2), ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; {'ObjectSetFromObjects',{_,_,ObjName},FieldName} -> {RefedObjMod,TDef} = get_referenced_type(S,ObjName), OS=TDef#typedef.typespec, %% should get the right object set here. Get the field %% FieldName out of the object set OS of class %% OS#'ObjectSet'.class OS2=check_object(S,TDef,OS), NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2), ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; {'ObjectSetFromObjects',{_,ObjName},FieldName} -> %% This is a ObjectSetFromObjects, i.e. %% ObjectSetFromObjects ::= ReferencedObjects "." FieldName %% with a defined object as ReferencedObjects. And %% the FieldName of the Class (object) contains an object set. {RefedObjMod,TDef} = get_referenced_type(S,ObjName), O1 = TDef#typedef.typespec, O2 = check_object(S,TDef,O1), NewSet = object_set_from_objects(S,RefedObjMod,FieldName,O2), OS2=ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}, %%io:format("ObjectSet: ~p~n",[OS2]), OS2; {pos,{objectset,_,DefinedObjSet},Params} -> {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), NewParamList = match_parameters(S, Params), instantiate_pos(S,ClassRef,PObjSetDef,NewParamList); Unknown -> exit({error,{unknown_object_set,Unknown},S}) end, NewSet2 = remove_duplicate_objects(S, NewObjSet#'ObjectSet'.set), NewObjSet2 = NewObjSet#'ObjectSet'{set=NewSet2}, Gen = gen_incl_set(S,NewObjSet2#'ObjectSet'.set, ClassDef), ?dbg("check_object done~n",[]), NewObjSet2#'ObjectSet'{class=NewClassRef,gen=Gen}. %% remove_duplicate_objects/1 remove duplicates of objects. %% For instance may Set contain objects of same class from %% different object sets that in fact might be duplicates. remove_duplicate_objects(S, Set0) when is_list(Set0) -> Set1 = lists:map(fun({_,Id,_}=Orig) -> {{a,Id},Orig}; ('EXTENSIONMARK'=Ext) -> {{z,Ext},Ext} end, Set0), Set2 = sofs:relation(Set1), Set3 = sofs:relation_to_family(Set2), Set = sofs:to_external(Set3), remove_duplicate_objects_1(S, Set). remove_duplicate_objects_1(S, [{{a,no_unique_value},Objs}|T]) -> Objs ++ remove_duplicate_objects_1(S, T); remove_duplicate_objects_1(S, [{_,[_]=Objs}|T]) -> Objs ++ remove_duplicate_objects_1(S, T); remove_duplicate_objects_1(S, [{{_,Id},[_|_]=Objs}|T]) -> MakeSortable = fun(What) -> sortable_type(S, What) end, Tagged = order_tag_set(Objs, MakeSortable), case lists:ukeysort(1, Tagged) of [{_,Obj}] -> [Obj|remove_duplicate_objects_1(S, T)]; [_|_] -> asn1_error(S, S#state.type, {non_unique_object,Id}) end; remove_duplicate_objects_1(_, []) -> []. order_tag_set([{_, _, Fields}=Orig|Fs], Fun) -> Pair = {[{FId, traverse(F, Fun)} || {FId, F} <- Fields], Orig}, [Pair|order_tag_set(Fs, Fun)]; order_tag_set([], _) -> []. sortable_type(S, #'Externaltypereference'{}=ERef) -> try get_referenced_type(S, ERef) of {_,#typedef{}=OI} -> OI#typedef{pos=undefined,name=undefined} catch _:_ -> ERef end; sortable_type(_, #typedef{}=TD) -> asn1ct:unset_pos_mod(TD#typedef{name=undefined}); sortable_type(_, Type) -> asn1ct:unset_pos_mod(Type). traverse(Structure0, Fun) -> Structure = Fun(Structure0), traverse_1(Structure, Fun). traverse_1(#typedef{typespec=TS0} = TD, Fun) -> TS = traverse(TS0, Fun), TD#typedef{typespec=TS}; traverse_1(#valuedef{type=TS0} = VD, Fun) -> TS = traverse(TS0, Fun), VD#valuedef{type=TS}; traverse_1(#type{def=TS0} = TD, Fun) -> TS = traverse(TS0, Fun), TD#type{def=TS}; traverse_1(#'SEQUENCE'{components=Cs0} = Seq, Fun) -> Cs = traverse_seq_set(Cs0, Fun), Seq#'SEQUENCE'{components=Cs}; traverse_1({'SEQUENCE OF',Type0}, Fun) -> Type = traverse(Type0, Fun), {'SEQUENCE OF',Type}; traverse_1({'SET OF',Type0}, Fun) -> Type = traverse(Type0, Fun), {'SET OF',Type}; traverse_1(#'SET'{components=Cs0} = Set, Fun) -> Cs = traverse_seq_set(Cs0, Fun), Set#'SET'{components=Cs}; traverse_1({'CHOICE', Cs0}, Fun) -> Cs = traverse_seq_set(Cs0, Fun), {'CHOICE', Cs}; traverse_1(Leaf, _) -> Leaf. traverse_seq_set(List, Fun) when is_list(List) -> traverse_seq_set_1(List, Fun); traverse_seq_set({Set, Ext}, Fun) -> {traverse_seq_set_1(Set, Fun), traverse_seq_set_1(Ext, Fun)}; traverse_seq_set({Set1, Set2, Set3}, Fun) -> {traverse_seq_set_1(Set1, Fun), traverse_seq_set_1(Set2, Fun), traverse_seq_set_1(Set3, Fun)}. traverse_seq_set_1([#'ComponentType'{} = CT0|Cs], Fun) -> CT = #'ComponentType'{typespec=TS0} = Fun(CT0), TS = traverse(TS0, Fun), [CT#'ComponentType'{typespec=TS}|traverse_seq_set_1(Cs, Fun)]; traverse_seq_set_1([{'COMPONENTS OF', _} = CO0|Cs], Fun) -> {'COMPONENTS OF', TS0} = Fun(CO0), TS = traverse(TS0, Fun), [{'COMPONENTS OF', TS}|traverse_seq_set_1(Cs, Fun)]; traverse_seq_set_1([], _) -> []. %% extensionmark(L,true) -> case lists:member('EXTENSIONMARK',L) of true -> L; _ -> L ++ ['EXTENSIONMARK'] end; extensionmark(L,_) -> L. object_to_check(#typedef{typespec=ObjDef}) -> ObjDef; object_to_check(#valuedef{type=ClassName,value=ObjectRef}) -> %% If the object definition is parsed as an object the ClassName %% is parsed as a type #'Object'{classname=ClassName#type.def,def=ObjectRef}. prepare_objset({'SingleValue',Set}) when is_list(Set) -> {set,Set,false}; prepare_objset(L=['EXTENSIONMARK']) -> L; prepare_objset(Set) when is_list(Set) -> {set,Set,false}; prepare_objset({{'SingleValue',Set},Ext}) -> {set,merge_sets(Set,Ext),true}; %%prepare_objset({Set,Ext}) when is_list(Set),is_list(Ext) -> %% {set,lists:append([Set,Ext]),true}; prepare_objset({Set,Ext}) when is_list(Set) -> {set,merge_sets(Set,Ext),true}; prepare_objset({{object,definedsyntax,_ObjFields}=Set,Ext}) -> {set,merge_sets(Set, Ext),true}; prepare_objset(ObjDef={object,definedsyntax,_ObjFields}) -> {set,[ObjDef],false}; prepare_objset({ObjDef=#type{},Ext}) when is_list(Ext) -> {set,[ObjDef|Ext],true}; prepare_objset({#type{}=Type,#type{}=Ext}) -> {set,[Type,Ext],true}; prepare_objset(Ret) -> Ret. %% ObjectSetFromObjects functionality %% The fieldname is a list of field names.They may be objects or %% object sets. If ObjectSet is an object set the resulting object set %% is the union of object sets if the last field name is an object %% set. If the last field is an object the resulting object set is %% the set of objects in ObjectSet. object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet) -> object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,[]). object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,InterSect) when is_record(ObjectSet,'ObjectSet') -> #'ObjectSet'{class=Cl,set=Set} = ObjectSet, {_,ClassDef} = get_referenced_type(S,Cl), object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Set,InterSect,[]); object_set_from_objects(S,RefedObjMod,FieldName,Object,InterSect) when is_record(Object,'Object') -> #'Object'{classname=Cl,def=Def}=Object, object_set_from_objects(S,RefedObjMod,Cl,FieldName,[Def],InterSect,[]). object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,['EXTENSIONMARK'|Os], InterSect,Acc) -> object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,%%Acc); ['EXTENSIONMARK'|Acc]); object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,[O|Os],InterSect,Acc) -> case object_set_from_objects2(S,mod_of_obj(RefedObjMod,element(1,O)), ClassDef,FieldName,element(3,O),InterSect) of ObjS when is_list(ObjS) -> object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,ObjS++Acc); Obj -> object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,[Obj|Acc]) end; object_set_from_objects(S,_RefedObjMod,_ClassDef,_FieldName,[],InterSect,Acc) -> %% For instance may Acc contain objects of same class from %% different object sets that in fact might be duplicates. Set = osfo_intersection(InterSect,Acc), remove_duplicate_objects(S, Set). object_set_from_objects2(S,RefedObjMod,ClassDef,[{valuefieldreference,OName}], Fields,_InterSect) -> %% this is an object case lists:keysearch(OName,1,Fields) of {value,{_,TDef}} -> mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef); _ -> [] % it may be an absent optional field end; object_set_from_objects2(S,RefedObjMod,ClassDef,[{typefieldreference,OSName}], Fields,_InterSect) -> %% this is an object set case lists:keysearch(OSName,1,Fields) of {value,{_,TDef}} -> case TDef#typedef.typespec of #'ObjectSet'{class=_NextClName,set=NextSet} ->%% = TDef#typedef.typespec, NextSet; #'Object'{def=_ObjDef} -> mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef) %% ObjDef %% error({error,{internal,unexpected_object,TDef}}) end; _ -> [] % it may be an absent optional field end; object_set_from_objects2(S,RefedObjMod,_ClassDef,[{valuefieldreference,OName}|Rest], Fields,InterSect) -> %% this is an object case lists:keysearch(OName,1,Fields) of {value,{_,TDef}} -> #'Object'{classname=NextClName,def=ODef}=TDef#typedef.typespec, {_,_,NextFields}=ODef, {_,NextClass} = get_referenced_type(S,NextClName), object_set_from_objects2(S,RefedObjMod,NextClass,Rest,NextFields,InterSect); _ -> [] end; object_set_from_objects2(S,RefedObjMod,_ClassDef,[{typefieldreference,OSName}|Rest], Fields,InterSect) -> %% this is an object set Next = {NextClName,NextSet} = case lists:keysearch(OSName,1,Fields) of {value,{_,TDef}} when is_record(TDef,'ObjectSet') -> #'ObjectSet'{class=NextClN,set=NextS} = TDef, {NextClN,NextS}; {value,{_,#typedef{typespec=OS}}} -> %% objectsets in defined syntax will come here as typedef{} %% #'ObjectSet'{class=NextClN,set=NextS} = OS, case OS of #'ObjectSet'{class=NextClN,set=NextS} -> {NextClN,NextS}; #'Object'{classname=NextClN,def=NextDef} -> {NextClN,[NextDef]} end; _ -> {[],[]} end, case Next of {[],[]} -> []; _ -> {_,NextClass} = get_referenced_type(S,NextClName), object_set_from_objects(S,RefedObjMod,NextClass,Rest,NextSet,InterSect,[]) end. mk_object_set_from_object(S,RefedObjMod,TDef,Class) -> #'Object'{classname=_NextClName,def=ODef} = TDef#typedef.typespec, {_,_,NextFields}=ODef, UniqueFieldName = case (catch get_unique_fieldname(S,Class)) of {error,'__undefined_',_} -> {unique,undefined}; {asn1,Msg,_} -> error({class,Msg,S}); {'EXIT',Msg} -> error({class,{internal_error,Msg},S}); {Other,_} -> Other end, VDef = get_unique_value(S,NextFields,UniqueFieldName), %% XXXXXXXXXXX case VDef of [] -> ['EXTENSIONMARK']; _ -> {{RefedObjMod,get_datastr_name(TDef)},VDef,NextFields} end. mod_of_obj(_RefedObjMod,{NewMod,ObjName}) when is_atom(NewMod),is_atom(ObjName) -> NewMod; mod_of_obj(RefedObjMod,_) -> RefedObjMod. merge_sets(Root,{'SingleValue',Ext}) -> merge_sets(Root,Ext); merge_sets(Root,Ext) when is_list(Root),is_list(Ext) -> Root ++ Ext; merge_sets(Root,Ext) when is_list(Ext) -> [Root|Ext]; merge_sets(Root,Ext) when is_list(Root) -> Root++[Ext]; merge_sets(Root,Ext) -> [Root]++[Ext]. reduce_objectset(ObjectSet,Exclusion) -> case Exclusion of {'SingleValue',#'Externalvaluereference'{value=Name}} -> case lists:keysearch(Name,1,ObjectSet) of {value,El} -> lists:subtract(ObjectSet,[El]); _ -> ObjectSet end end. %% Checks a list of objects or object sets and returns a list of selected %% information for the code generation. check_object_list(S,ClassRef,ObjectList) -> check_object_list(S,ClassRef,ObjectList,[]). check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> ?dbg("check_object_list: ~p~n",[ObjOrSet]), case ObjOrSet of ObjDef when is_tuple(ObjDef),(element(1,ObjDef)==object) -> Def = check_object(S,#typedef{typespec=ObjDef}, % #'Object'{classname={objectclassname,ClassRef}, #'Object'{classname=ClassRef, def=ObjDef}), check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def#'Object'.def}|Acc]); {'SingleValue',Ref = #'Externalvaluereference'{}} -> ?dbg("{SingleValue,Externalvaluereference}~n",[]), {RefedMod,ObjName, #'Object'{def=Def}} = check_referenced_object(S,Ref), check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]); ObjRef when is_record(ObjRef,'Externalvaluereference') -> ?dbg("Externalvaluereference~n",[]), {RefedMod,ObjName, #'Object'{def=Def}} = check_referenced_object(S,ObjRef), check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]); {'ValueFromObject',{object,Object},FieldNames} -> case extract_field(S, Object, FieldNames) of #'Object'{def=Def} -> check_object_list(S, ClassRef, Objs, [{{no_mod,no_name},Def}|Acc]); _ -> asn1_error(S, illegal_object) end; ObjSet when is_record(ObjSet,type) -> ObjSetDef = case ObjSet#type.def of Ref when is_record(Ref,'Externaltypereference') -> {_,D} = get_referenced_type(S,ObjSet#type.def), D; Other -> throw({asn1_error,{'unknown objecset',Other,S}}) end, #'ObjectSet'{set=ObjectsInSet} = check_object(S,ObjSetDef,ObjSetDef#typedef.typespec), AccList = transform_set_to_object_list(ObjectsInSet,[]), check_object_list(S,ClassRef,Objs,AccList++Acc); union -> check_object_list(S,ClassRef,Objs,Acc); {pos,{objectset,_,DefinedObjectSet},Params} -> OSDef = #type{def={pt,DefinedObjectSet,Params}}, #'ObjectSet'{set=Set} = check_object(S,ObjOrSet,#'ObjectSet'{class=ClassRef, set=OSDef}), check_object_list(S,ClassRef,Objs,Set ++ Acc); {pv,{simpledefinedvalue,DefinedObject},Params} -> Args = match_parameters(S, Params), #'Object'{def=Def} = check_object(S,ObjOrSet, #'Object'{classname=ClassRef , def={po,{object,DefinedObject}, Args}}), check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]); {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) -> NewSet = check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,[]), check_object_list(S,ClassRef,Objs,NewSet++Acc); {{'ObjectSetFromObjects',Os,FieldName},InterSection} when is_tuple(Os) -> NewSet = check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,InterSection), check_object_list(S,ClassRef,Objs,NewSet++Acc); Other -> exit({error,{'unknown object',Other},S}) end; %% Finally reverse the accumulated list and if there are any extension %% marks in the object set put one indicator of that in the end of the %% list. check_object_list(_,_,[],Acc) -> lists:reverse(Acc). check_referenced_object(S,ObjRef) when is_record(ObjRef,'Externalvaluereference')-> case get_referenced_type(S,ObjRef) of {RefedMod,ObjectDef} when is_record(ObjectDef,valuedef) -> ?dbg("Externalvaluereference, ObjectDef: ~p~n",[ObjectDef]), #type{def=ClassRef} = ObjectDef#valuedef.type, Def = ObjectDef#valuedef.value, {RefedMod,get_datastr_name(ObjectDef), check_object(update_state(S,RefedMod),ObjectDef,#'Object'{classname=ClassRef, def=Def})}; {RefedMod,ObjectDef} when is_record(ObjectDef,typedef) -> {RefedMod,get_datastr_name(ObjectDef), check_object(update_state(S,RefedMod),ObjectDef,ObjectDef#typedef.typespec)} end. check_ObjectSetFromObjects(S,ObjName,FieldName,InterSection) -> {RefedMod,TDef} = get_referenced_type(S,ObjName), ObjOrSet = check_object(update_state(S,RefedMod),TDef,TDef#typedef.typespec), InterSec = prepare_intersection(S,InterSection), _NewSet = object_set_from_objects(S,RefedMod,FieldName,ObjOrSet,InterSec). prepare_intersection(_S,[]) -> []; prepare_intersection(S,{'EXCEPT',ObjRef}) -> except_names(S,ObjRef); prepare_intersection(_S,T) -> exit({error,{internal_error,not_implemented,object_set_from_objects,T}}). except_names(_S,{'SingleValue',#'Externalvaluereference'{value=ObjName}}) -> [{except,ObjName}]; except_names(_,T) -> exit({error,{internal_error,not_implemented,object_set_from_objects,T}}). osfo_intersection(InterSect,ObjList) -> Res = [X|| X = {{_,N},_,_} <- ObjList, lists:member({except,N},InterSect) == false], case lists:member('EXTENSIONMARK',ObjList) of true -> Res ++ ['EXTENSIONMARK']; _ -> Res end. %% get_type_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) -> %% Type get_type_from_object(S, Object, FieldNames) when is_record(Object, 'Externaltypereference'); is_record(Object, 'Externalvaluereference') -> extract_field(S, Object, FieldNames). %% get_value_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) -> %% UntaggedValue get_value_from_object(S, Def, FieldNames) -> case extract_field(S, Def, FieldNames) of #valuedef{value=Val} -> Val; {valueset,_}=Val -> Val; _ -> asn1_error(S, illegal_value) end. %% extract_field(State, ObjectOrObjectSet, [{RefType,FieldName}]) %% RefType = typefieldreference | valuefieldreference %% %% Get the type, value, object, object set, or value set from the %% referenced object or object set. The list of field name tuples %% may have more than one element. All field names but the last %% refers to either an object or object set. extract_field(S, Def0, FieldNames) -> {_,Def1} = get_referenced_type(S, Def0), Def2 = check_object(S, Def1, Def1#typedef.typespec), Def = Def1#typedef{typespec=Def2}, get_fieldname_element(S, Def, FieldNames). %% get_fieldname_element(State, Element, [{RefType,FieldName}] %% RefType = typefieldreference | valuefieldreference %% %% Get the type, value, object, object set, or value set from the referenced %% element. The list of field name tuples may have more than one element. %% All field names but the last refers to either an object or object set. get_fieldname_element(S, #typedef{}=Def, [{_RefType,FieldName}]) -> Object = (Def#typedef.typespec)#'Object'.def, check_fieldname_element(S, FieldName, Object); get_fieldname_element(S, #typedef{}=Def, [{_RefType,FieldName}|T]) -> %% As FieldName is followed by other FieldNames it has to be an %% object or objectset. Object = (Def#typedef.typespec)#'Object'.def, case check_fieldname_element(S, FieldName, Object) of #'Object'{def=D} -> get_fieldname_element(S, D, T); #'ObjectSet'{set=Set0} -> Set = [get_fieldname_element(S, X, T) || X <- Set0], get_fieldname_return_set(Set) end; get_fieldname_element(S, {_,_,_}=Object, [{_RefType,FieldName}|T]) -> Def = check_fieldname_element(S, FieldName, Object), get_fieldname_element(S, Def, T); get_fieldname_element(_S, Def, []) -> Def. get_fieldname_return_set([#valuedef{}|_]=L) -> {valueset,L}. check_fieldname_element(S, Name, {_,_,Fields}) -> case lists:keyfind(Name, 1, Fields) of {Name,Def} -> check_fieldname_element_1(S, Def); false -> asn1_error(S, {undefined_field,Name}) end. check_fieldname_element_1(S, #typedef{typespec=Ts}=TDef) -> case Ts of #'Object'{} -> check_object(S, TDef, Ts); _ -> check_type(S, TDef, Ts) end; check_fieldname_element_1(S, #valuedef{}=VDef) -> try check_value(S, VDef) catch throw:{asn1_class, _} -> #valuedef{checked=C,pos=Pos,name=N,type=Type, value=Def} = VDef, ClassName = Type#type.def, NewSpec = #'Object'{classname=ClassName,def=Def}, NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, check_fieldname_element_1(S, NewDef) end; check_fieldname_element_1(_S, {value_tag,Val}) -> #valuedef{value=Val}; check_fieldname_element_1(S, Eref) when is_record(Eref, 'Externaltypereference'); is_record(Eref, 'Externalvaluereference') -> {_,TDef} = get_referenced_type(S, Eref), check_fieldname_element_1(S, TDef). transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) -> transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]); transform_set_to_object_list(['EXTENSIONMARK'|Objs],Acc) -> %% transform_set_to_object_list(Objs,['EXTENSIONMARK'|Acc]); transform_set_to_object_list(Objs,Acc); transform_set_to_object_list([],Acc) -> Acc. get_unique_valuelist(_S,ObjSet,{unique,undefined}) -> % no unique field in object lists:map(fun({N,{_,_,F}})->{N,no_unique_value,F}; (V={_,_,_}) ->V; ({A,B}) -> {A,no_unique_value,B} end, ObjSet); get_unique_valuelist(S,ObjSet,{UFN,Opt}) -> get_unique_vlist(S,ObjSet,UFN,Opt,[]). get_unique_vlist(_S,[],_,_,[]) -> ['EXTENSIONMARK']; get_unique_vlist(_, [], _, _Opt, Acc) -> lists:reverse(Acc); get_unique_vlist(S,['EXTENSIONMARK'|Rest],UniqueFieldName,Opt,Acc) -> get_unique_vlist(S,Rest,UniqueFieldName,Opt,Acc); get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Opt,Acc) -> {_,_,Fields} = Obj, NewObjInf = case get_unique_value(S,Fields,UniqueFieldName) of #valuedef{value=V} -> [{ObjName,V,Fields}]; [] -> []; % maybe the object only was a reference to an % empty object set. no_unique_value -> [{ObjName,no_unique_value,Fields}] end, get_unique_vlist(S,Rest,UniqueFieldName,Opt,NewObjInf++Acc); get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Opt,Acc) -> get_unique_vlist(S,Rest,UniqueFieldName,Opt,[V|Acc]). get_unique_value(S,Fields,UniqueFieldName) -> Module = S#state.mname, case lists:keysearch(UniqueFieldName,1,Fields) of {value,Field} -> case element(2,Field) of VDef when is_record(VDef,valuedef) -> VDef; {'ValueFromObject',Object,Name} -> case Object of {object,Ext} when is_record(Ext,'Externaltypereference') -> OtherModule = Ext#'Externaltypereference'.module, ExtObjName = Ext#'Externaltypereference'.type, ObjDef = asn1_db:dbget(OtherModule,ExtObjName), ObjSpec = ObjDef#typedef.typespec, get_unique_value(OtherModule,element(3,ObjSpec),Name); {object,{_,_,ObjName}} -> ObjDef = asn1_db:dbget(Module,ObjName), ObjSpec = ObjDef#typedef.typespec, get_unique_value(Module,element(3,ObjSpec),Name); {po,Object,_Params} -> exit({error,{'parameterized object not implemented yet', Object},S}) end; Value when is_atom(Value);is_number(Value) -> #valuedef{value=Value,module=Module}; {'CHOICE',{C,Value}} when is_atom(C) -> %% #valuedef{value=normalize_value(S,element(3,Field),VDef,[])} case Value of Scalar when is_atom(Scalar);is_number(Scalar) -> #valuedef{value=Value,module=Module}; Eref = #'Externalvaluereference'{} -> element(2,get_referenced_type(S,Eref)) end end; false -> case Fields of [{_,#typedef{typespec=#'ObjectSet'{set=['EXTENSIONMARK']}}}] -> []; _ -> no_unique_value end end. %% instantiate_po/4 %% ClassDef is the class of Object, %% Object is the Parameterized object, which is referenced, %% ArgsList is the list of actual parameters %% returns an #'Object' record. instantiate_po(S=#state{parameters=_OldArgs},_ClassDef,Object,ArgsList) when is_record(Object,pobjectdef) -> FormalParams = get_pt_args(Object), MatchedArgs = match_args(S,FormalParams,ArgsList,[]), % NewS = S#state{type=Object,parameters=MatchedArgs++OldArgs}, NewS = S#state{type=Object,parameters=MatchedArgs}, check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class, def=Object#pobjectdef.def}). %% instantiate_pos/4 %% ClassDef is the class of ObjectSetDef, %% ObjectSetDef is the Parameterized object set, which is referenced %% on the right side of the assignment, %% ArgsList is the list of actual parameters, i.e. real objects instantiate_pos(S=#state{parameters=_OldArgs},ClassRef,ObjectSetDef,ArgsList) -> % ClassName = ClassDef#classdef.name, FormalParams = get_pt_args(ObjectSetDef), OSet = case get_pt_spec(ObjectSetDef) of {valueset,Set} -> % #'ObjectSet'{class=name2Extref(S#state.mname, % ClassName),set=Set}; #'ObjectSet'{class=ClassRef,set=Set}; Set when is_record(Set,'ObjectSet') -> Set; _ -> error({type,"parameterized object set failure",S}) end, MatchedArgs = match_args(S,FormalParams,ArgsList,[]), % NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs++OldArgs}, NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs}, check_object(NewS,ObjectSetDef,OSet). %% gen_incl -> boolean() %% If object with Fields has any of the corresponding class' typefields %% then return value is true otherwise it is false. %% If an object lacks a typefield but the class has a type field that %% is OPTIONAL then we want gen to be true gen_incl(S,{_,_,Fields},CFields)-> gen_incl1(S,Fields,CFields). gen_incl1(_,_,[]) -> false; gen_incl1(S,Fields,[C|CFields]) -> case element(1,C) of typefield -> true; %% should check that field is OPTIONAL or DEFUALT if %% the object lacks this field objectfield -> case lists:keysearch(element(2,C),1,Fields) of {value,Field} -> ClassRef = case element(3,C) of #type{def=Ref} -> Ref; Eref when is_record(Eref,'Externaltypereference') -> Eref end, ClassFields = get_objclass_fields(S,ClassRef), ObjDef = case element(2,Field) of TDef when is_record(TDef,typedef) -> check_object(S,TDef,TDef#typedef.typespec); ERef -> {_,T} = get_referenced_type(S,ERef), check_object(S,T,object_to_check(T)) end, case gen_incl(S,ObjDef#'Object'.def, ClassFields) of true -> true; _ -> gen_incl1(S,Fields,CFields) end; _ -> gen_incl1(S,Fields,CFields) end; _ -> gen_incl1(S,Fields,CFields) end. get_objclass_fields(S,Eref=#'Externaltypereference'{}) -> {_,ClassDef} = get_referenced_type(S,Eref), get_objclass_fields(S,ClassDef); get_objclass_fields(S,CD=#classdef{typespec=#'Externaltypereference'{}}) -> get_objclass_fields(S,CD#classdef.typespec); get_objclass_fields(_,#classdef{typespec=CDef}) when is_record(CDef,objectclass) -> CDef#objectclass.fields. %% first if no unique field in the class return false.(don't generate code) gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) when is_record(Eref,'Externaltypereference') -> %% When a Defined class is a reference toanother class definition {_,CDef} = get_referenced_type(S,Eref), gen_incl_set(S,Fields,CDef); gen_incl_set(S,Fields,ClassDef) -> case catch get_unique_fieldname(S,ClassDef) of Tuple when tuple_size(Tuple) =:= 3 -> false; _ -> gen_incl_set1(S,Fields, (ClassDef#classdef.typespec)#objectclass.fields) end. %% if any of the existing or potentially existing objects has a typefield %% then return true. gen_incl_set1(_,[],_CFields)-> false; gen_incl_set1(_,['EXTENSIONMARK'],_) -> true; %% Fields are the fields of an object in the object set. %% CFields are the fields of the class of the object set. gen_incl_set1(_,['EXTENSIONMARK'|_],_) -> true; gen_incl_set1(S,[Object|Rest],CFields)-> Fields = element(tuple_size(Object), Object), case gen_incl1(S,Fields,CFields) of true -> true; false -> gen_incl_set1(S,Rest,CFields) end. %%% %%% Check an object definition. %%% check_objectdefn(S, Def, #classdef{typespec=ObjClass}) -> #objectclass{syntax=Syntax0,fields=ClassFields} = ObjClass, case Def of {object,defaultsyntax,Fields} -> check_defaultfields(S, Fields, ClassFields); {object,definedsyntax,Fields} -> Syntax = get_syntax(S, Syntax0, ClassFields), case match_syntax(S, Syntax, Fields, []) of {match,NewFields,[]} -> {object,defaultsyntax,NewFields}; {match,_,[What|_]} -> syntax_match_error(S, What); {nomatch,[What|_]} -> syntax_match_error(S, What); {nomatch,[]} -> syntax_match_error(S) end end. %%% %%% Pre-process the simplified syntax so that it can be more %%% easily matched. %%% get_syntax(_, {preprocessed_syntax,Syntax}, _) -> Syntax; get_syntax(S, {'WITH SYNTAX',Syntax}, ClassFields) -> preprocess_syntax(S, Syntax, ClassFields). preprocess_syntax(S, Syntax0, Cs) -> Syntax = preprocess_syntax_1(S, Syntax0, Cs, true), Present0 = preprocess_get_fields(Syntax, []), Present1 = lists:sort(Present0), Present = ordsets:from_list(Present1), case Present =:= Present1 of false -> Dupl = Present1 -- Present, asn1_error(S, {syntax_duplicated_fields,Dupl}); true -> ok end, Mandatory0 = get_mandatory_class_fields(Cs), Mandatory = ordsets:from_list(Mandatory0), case ordsets:subtract(Mandatory, Present) of [] -> Syntax; [_|_]=Missing -> asn1_error(S, {syntax_missing_mandatory_fields,Missing}) end. preprocess_syntax_1(S, [H|T], Cs, Mandatory) when is_list(H) -> [{optional,preprocess_syntax_1(S, H, Cs, false)}| preprocess_syntax_1(S, T, Cs, Mandatory)]; preprocess_syntax_1(S, [{valuefieldreference,Name}|T], Cs, Mandatory) -> F = preprocess_check_field(S, Name, Cs, Mandatory), [F|preprocess_syntax_1(S, T, Cs, Mandatory)]; preprocess_syntax_1(S, [{typefieldreference,Name}|T], Cs, Mandatory) -> F = preprocess_check_field(S, Name, Cs, Mandatory), [F|preprocess_syntax_1(S, T, Cs, Mandatory)]; preprocess_syntax_1(S,[{Token,_}|T], Cs, Mandatory) when is_atom(Token) -> [{token,Token}|preprocess_syntax_1(S, T, Cs, Mandatory)]; preprocess_syntax_1(S, [Token|T], Cs, Mandatory) when is_atom(Token) -> [{token,Token}|preprocess_syntax_1(S, T, Cs, Mandatory)]; preprocess_syntax_1(_, [], _, _) -> []. preprocess_check_field(S, Name, Cs, Mandatory) -> case lists:keyfind(Name, 2, Cs) of Tuple when is_tuple(Tuple) -> case not Mandatory andalso is_mandatory_class_field(Tuple) of true -> asn1_error(S, {syntax_mandatory_in_optional_group,Name}); false -> {field,Tuple} end; false -> asn1_error(S, {syntax_undefined_field,Name}) end. preprocess_get_fields([{field,F}|T], Acc) -> Name = element(2, F), preprocess_get_fields(T, [Name|Acc]); preprocess_get_fields([{optional,L}|T], Acc) -> preprocess_get_fields(T, preprocess_get_fields(L, Acc)); preprocess_get_fields([_|T], Acc) -> preprocess_get_fields(T, Acc); preprocess_get_fields([], Acc) -> Acc. %%% %%% Match the actual fields in the object definition to %%% the pre-processed simplified syntax. %%% match_syntax(S, [{token,Token}|T], [A|As]=Args, Acc) -> case A of {word_or_setting,_,#'Externaltypereference'{type=Token}} -> match_syntax(S, T, As, Acc); {Token,Line} when is_integer(Line) -> match_syntax(S, T, As, Acc); _ -> {nomatch,Args} end; match_syntax(S, [{field,Field}|T]=Fs, [A|As0]=Args0, Acc) -> try match_syntax_type(S, Field, A) of {match,Match} -> match_syntax(S, T, As0, lists:reverse(Match)++Acc); {params,_Name,#ptypedef{args=Params}=P,Ref} -> {Args,As} = lists:split(length(Params), As0), Val = match_syntax_params(S, P, Ref, Args), match_syntax(S, Fs, [Val|As], Acc) catch _:_ -> {nomatch,Args0} end; match_syntax(S, [{optional,L}|T], As0, Acc) -> case match_syntax(S, L, As0, []) of {match,Match,As} -> match_syntax(S, T, As, lists:reverse(Match)++Acc); {nomatch,As0} -> match_syntax(S, T, As0, Acc); {nomatch,_}=NoMatch -> NoMatch end; match_syntax(_, [_|_], [], _Acc) -> {nomatch,[]}; match_syntax(_, [], As, Acc) -> {match,Acc,As}. match_syntax_type(S, Type, {value_tag,Val}) -> match_syntax_type(S, Type, Val); match_syntax_type(S, Type, {setting,_,Val}) -> match_syntax_type(S, Type, Val); match_syntax_type(S, Type, {word_or_setting,_,Val}) -> match_syntax_type(S, Type, Val); match_syntax_type(_S, _Type, {Atom,Line}) when is_atom(Atom), is_integer(Line) -> throw(nomatch); match_syntax_type(S, {fixedtypevaluefield,Name,#type{}=T,_,_}=Type, #'Externalvaluereference'{}=ValRef0) -> try get_referenced_type(S, ValRef0) of {M,#valuedef{}=ValDef} -> match_syntax_type(update_state(S, M), Type, ValDef) catch throw:{error,_} -> ValRef = #valuedef{name=Name, type=T, value=ValRef0, module=S#state.mname}, match_syntax_type(S, Type, ValRef) end; match_syntax_type(S, {fixedtypevaluefield,Name,#type{},_,_}, #valuedef{}=Val0) -> Val = check_value(S, Val0), {match,[{Name,Val}]}; match_syntax_type(S, {fixedtypevaluefield,Name,#type{},_,_}, {'ValueFromObject',{object,Object},FieldNames}) -> Val = extract_field(S, Object, FieldNames), {match,[{Name,Val}]}; match_syntax_type(S, {fixedtypevaluefield,Name,#type{}=T,_,_}=Type, Any) -> ValDef = #valuedef{name=Name,type=T,value=Any,module=S#state.mname}, match_syntax_type(S, Type, ValDef); match_syntax_type(_S, {fixedtypevaluesetfield,Name,#type{},_}, Any) -> {match,[{Name,Any}]}; match_syntax_type(S, {objectfield,Name,_,_,_}, #'Externalvaluereference'{}=Ref) -> {M,Obj} = get_referenced_type(S, Ref), check_object(S, Obj, object_to_check(Obj)), {match,[{Name,Ref#'Externalvaluereference'{module=M}}]}; match_syntax_type(S, {objectfield,Name,Class,_,_}, {object,_,_}=ObjDef) -> InlinedObjName = list_to_atom(lists:concat([S#state.tname, '_',Name])), ObjSpec = #'Object'{classname=Class,def=ObjDef}, CheckedObj = check_object(S, #typedef{typespec=ObjSpec}, ObjSpec), InlObj = #typedef{checked=true,name=InlinedObjName,typespec=CheckedObj}, ObjKey = {InlinedObjName, InlinedObjName}, insert_once(S, inlined_objects, ObjKey), %% Which module to use here? Could it be other than top_module? asn1_db:dbput(get(top_module), InlinedObjName, InlObj), {match,[{Name,InlObj}]}; match_syntax_type(_S, {objectfield,Name,_,_,_}, Any) -> {match,[{Name,Any}]}; match_syntax_type(S, {objectsetfield,Name,CDef0,_}, Any) -> CDef = case CDef0 of #type{def=CDef1} -> CDef1; CDef1 -> CDef1 end, case match_syntax_objset(S, Any, CDef) of #typedef{typespec=#'ObjectSet'{}=Ts0}=Def -> Ts = check_object(S, Def, Ts0), {match,[{Name,Def#typedef{checked=true,typespec=Ts}}]}; _ -> syntax_match_error(S, Any) end; match_syntax_type(S, {typefield,Name0,_}, #type{def={pt,_,_}=Def}=Actual) -> %% This is an inlined type. If constructed type, save in data base. T = check_type(S, #typedef{typespec=Actual}, Actual), #'Externaltypereference'{type=PtName} = element(2, Def), NameList = [PtName,S#state.tname], Name = list_to_atom(asn1ct_gen:list2name(NameList)), NewTDef = #typedef{checked=true,name=Name,typespec=T}, asn1_db:dbput(S#state.mname, Name, NewTDef), insert_once(S, parameterized_objects, {Name,type,NewTDef}), {match,[{Name0,NewTDef}]}; match_syntax_type(S, {typefield,Name,_}, #type{def=#'ObjectClassFieldType'{}}=Actual) -> T = check_type(S, #typedef{typespec=Actual}, Actual), {match,[{Name,ocft_def(T)}]}; match_syntax_type(S, {typefield,Name,_}, #type{def=#'Externaltypereference'{}=Ref}) -> match_syntax_external(S, Name, Ref); match_syntax_type(S, {typefield,Name,_}, #type{def=Def}=Actual) -> T = check_type(S, #typedef{typespec=Actual}, Actual), TypeName = asn1ct_gen:type(asn1ct_gen:get_inner(Def)), {match,[{Name,#typedef{checked=true,name=TypeName,typespec=T}}]}; match_syntax_type(S, {typefield,Name,_}, #'Externaltypereference'{}=Ref) -> match_syntax_external(S, Name, Ref); match_syntax_type(_S, {variabletypevaluefield,Name,_,_}, Any) -> {match,[{Name,Any}]}; match_syntax_type(_S, {variabletypevaluesetfield,Name,_,_}, Any) -> {match,[{Name,Any}]}; match_syntax_type(_S, _Type, _Actual) -> throw(nomatch). match_syntax_params(S0, #ptypedef{name=Name}=PtDef, #'Externaltypereference'{module=M,type=N}=ERef0, Args) -> S = S0#state{mname=M,module=load_asn1_module(S0, M), type=PtDef,tname=Name}, Type = check_type(S, PtDef, #type{def={pt,ERef0,Args}}), ERefName = new_reference_name(N), ERef = #'Externaltypereference'{type=ERefName,module=S0#state.mname}, TDef = #typedef{checked=true,name=ERefName,typespec=Type}, insert_once(S0, parameterized_objects, {ERefName,type,TDef}), asn1_db:dbput(S0#state.mname, ERef#'Externaltypereference'.type, TDef), ERef. match_syntax_external(#state{mname=Mname}=S0, Name, Ref0) -> {M,T0} = get_referenced_type(S0, Ref0), Ref1 = Ref0#'Externaltypereference'{module=M}, case T0 of #ptypedef{} -> {params,Name,T0,Ref1}; #typedef{checked=false}=TDef0 when Mname =/= M -> %% This typedef is an imported type (or maybe a set.asn %% compilation). S = S0#state{mname=M,module=load_asn1_module(S0, M), type=TDef0,tname=get_datastr_name(TDef0)}, Type = check_type(S, TDef0, TDef0#typedef.typespec), TDef = TDef0#typedef{checked=true,typespec=Type}, asn1_db:dbput(M, get_datastr_name(TDef), TDef), {match,[{Name,merged_name(S, Ref1)}]}; TDef -> %% This might be a renamed type in a set of specs, %% so rename the ref. Type = asn1ct:get_name_of_def(TDef), Ref = Ref1#'Externaltypereference'{type=Type}, {match,[{Name,Ref}]} end. match_syntax_objset(S, #'Externaltypereference'{}=Ref, _) -> {_,T} = get_referenced_type(S, Ref), T; match_syntax_objset(S, #'Externalvaluereference'{}=Ref, _) -> {_,T} = get_referenced_type(S, Ref), T; match_syntax_objset(_, [_|_]=Set, ClassDef) -> make_objset(ClassDef, Set); match_syntax_objset(_, {'SingleValue',_}=Set, ClassDef) -> make_objset(ClassDef, Set); match_syntax_objset(_, {{'SingleValue',_},_}=Set, ClassDef) -> make_objset(ClassDef, Set); match_syntax_objset(S, {object,definedsyntax,Words}, ClassDef) -> case Words of [Word] -> match_syntax_objset_1(S, Word, ClassDef); [_|_] -> %% More than one word does not make sense. none end; match_syntax_objset(S, #type{def=#'Externaltypereference'{}=Set}, ClassDef) -> match_syntax_objset(S, Set, ClassDef); match_syntax_objset(_, #type{}, _) -> none. match_syntax_objset_1(S, {setting,_,Set}, ClassDef) -> %% Word that starts with an uppercase letter. match_syntax_objset(S, Set, ClassDef); match_syntax_objset_1(S, {word_or_setting,_,Set}, ClassDef) -> %% Word in uppercase/hyphens only. match_syntax_objset(S, Set, ClassDef); match_syntax_objset_1(S, #type{def={'TypeFromObject', {object,Object}, FieldNames}}, _) -> #typedef{checked=true,typespec=extract_field(S, Object, FieldNames)}; match_syntax_objset_1(_, #type{def=#'ObjectClassFieldType'{}}=Set, ClassDef) -> make_objset(ClassDef, Set). make_objset(ClassDef, Set) -> #typedef{typespec=#'ObjectSet'{class=ClassDef,set=Set}}. syntax_match_error(S) -> asn1_error(S, syntax_nomatch). syntax_match_error(S, What0) -> What = printable_string(What0), asn1_error(S, {syntax_nomatch,What}). printable_string(Def) -> printable_string_1(Def). printable_string_1({word_or_setting,_,Def}) -> printable_string_1(Def); printable_string_1({value_tag,V}) -> printable_string_1(V); printable_string_1({#seqtag{val=Val1},Val2}) -> atom_to_list(Val1) ++ " " ++ printable_string_1(Val2); printable_string_1(#type{def=Def}) -> atom_to_list(asn1ct_gen:get_inner(Def)); printable_string_1(#'Externaltypereference'{type=Type}) -> atom_to_list(Type); printable_string_1(#'Externalvaluereference'{value=Type}) -> atom_to_list(Type); printable_string_1({Atom,Line}) when is_atom(Atom), is_integer(Line) -> q(Atom); printable_string_1({object,definedsyntax,L}) -> q(string:join([printable_string_1(Item) || Item <- L], " ")); printable_string_1([_|_]=Def) -> case lists:all(fun is_integer/1, Def) of true -> lists:flatten(io_lib:format("~p", [Def])); false -> q(string:join([printable_string_1(Item) || Item <- Def], " ")) end; printable_string_1(Def) -> lists:flatten(io_lib:format("~p", [Def])). q(S) -> lists:concat(["\"",S,"\""]). check_defaultfields(S, Fields, ClassFields) -> Present = ordsets:from_list([F || {F,_} <- Fields]), Mandatory0 = get_mandatory_class_fields(ClassFields), Mandatory = ordsets:from_list(Mandatory0), All = ordsets:from_list([element(2, F) || F <- ClassFields]), #state{tname=Obj} = S, case ordsets:subtract(Present, All) of [] -> ok; [_|_]=Invalid -> asn1_error(S, {invalid_fields,Invalid,Obj}) end, case ordsets:subtract(Mandatory, Present) of [] -> check_defaultfields_1(S, Fields, ClassFields, []); [_|_]=Missing -> asn1_error(S, {missing_mandatory_fields,Missing,Obj}) end. check_defaultfields_1(_S, [], _ClassFields, Acc) -> {object,defaultsyntax,lists:reverse(Acc)}; check_defaultfields_1(S, [{FName,Spec}|Fields], ClassFields, Acc) -> CField = lists:keyfind(FName, 2, ClassFields), {match,Match} = match_syntax_type(S, CField, Spec), check_defaultfields_1(S, Fields, ClassFields, Match++Acc). get_mandatory_class_fields(ClassFields) -> [element(2, F) || F <- ClassFields, is_mandatory_class_field(F)]. is_mandatory_class_field({fixedtypevaluefield,_,_,_,'MANDATORY'}) -> true; is_mandatory_class_field({objectfield,_,_,_,'MANDATORY'}) -> true; is_mandatory_class_field({objectsetfield,_,_,'MANDATORY'}) -> true; is_mandatory_class_field({typefield,_,'MANDATORY'}) -> true; is_mandatory_class_field({variabletypevaluefield,_,_,'MANDATORY'}) -> true; is_mandatory_class_field({variabletypevaluesetfield,_,_,'MANDATORY'}) -> true; is_mandatory_class_field(_) -> false. merged_name(#state{inputmodules=[]},ERef) -> ERef; merged_name(S,ERef=#'Externaltypereference'{module=M}) -> case {S#state.mname,lists:member(M,S#state.inputmodules)} of {M,_} -> ERef; {MergeM,true} -> %% maybe the reference is renamed NewName = renamed_reference(S,ERef), ERef#'Externaltypereference'{module=MergeM,type=NewName}; {_,_} -> % i.e. M /= MergeM, not an inputmodule ERef end. ocft_def(#type{def=#'ObjectClassFieldType'{type=OCFT}}=T) -> case OCFT of {fixedtypevaluefield,_,InnerType} -> case asn1ct_gen:type(asn1ct_gen:get_inner(InnerType#type.def)) of Bif when Bif =:= {primitive,bif}; Bif =:= {constructed,bif} -> #typedef{checked=true,name=Bif,typespec=InnerType}; #'Externaltypereference'{}=Ref -> Ref end; 'ASN1_OPEN_TYPE' -> #typedef{checked=true,typespec=T#type{def='ASN1_OPEN_TYPE'}} end. check_value(OldS,V) when is_record(V,pvaluesetdef) -> #pvaluesetdef{checked=Checked,type=Type} = V, case Checked of true -> V; {error,_} -> V; false -> case get_referenced_type(OldS,Type#type.def) of {_,Class} when is_record(Class,classdef) -> throw({pobjectsetdef}); _ -> continue end end; check_value(_OldS,V) when is_record(V,pvaluedef) -> %% Fix this case later V; check_value(OldS,V) when is_record(V,typedef) -> %% This case when a value set has been parsed as an object set. %% It may be a value set ?dbg("check_value, V: ~p~n",[V]), #typedef{typespec=TS} = V, case TS of #'ObjectSet'{class=ClassRef} -> {RefM,TSDef} = get_referenced_type(OldS,ClassRef), %%IsObjectSet(TSDef); case TSDef of #classdef{} -> throw({objectsetdef}); #typedef{typespec=#type{def=Eref}} when is_record(Eref,'Externaltypereference') -> %% This case if the class reference is a defined %% reference to class check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}}); #typedef{} -> % an ordinary value set with a type in #typedef.typespec ValueSet = TS#'ObjectSet'.set, Type=check_type(OldS,TSDef,TSDef#typedef.typespec), Value = check_value(OldS,#valuedef{type=Type, value=ValueSet, module=RefM}), {valueset,Type#type{constraint=Value#valuedef.value}} end; _ -> throw({objectsetdef}) end; check_value(S,#valuedef{pos=Pos,name=Name,type=Type, value={valueset,Constr}}) -> NewType = Type#type{constraint=[Constr]}, {valueset, check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)}; check_value(S, #valuedef{}=V) -> ?dbg("check_value, V: ~p~n",[V0]), case V of #valuedef{checked=true} -> V; #valuedef{checked=false} -> check_valuedef(S, V) end. check_valuedef(#state{recordtopname=TopName}=S0, V0) -> #valuedef{name=Name,type=Vtype0,value=Value,module=ModName} = V0, V = V0#valuedef{checked=true}, Vtype = check_type(S0, #typedef{name=Name,typespec=Vtype0},Vtype0), Def = Vtype#type.def, S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name}, SVal = update_state(S1, ModName), case Def of #'Externaltypereference'{type=RecName}=Ext -> {RefM,Type} = get_referenced_type(S1, Ext), %% If V isn't a value but an object Type is a #classdef{} S2 = update_state(S1, RefM), case Type of #typedef{typespec=TypeSpec0}=TypeDef -> TypeSpec = check_type(S2, TypeDef, TypeSpec0), S3 = case is_contextswitchtype(Type) of true -> S2; false -> S2#state{recordtopname=[RecName|TopName]} end, #valuedef{value=CheckedVal} = check_value(S3, V0#valuedef{type=TypeSpec}), V#valuedef{value=CheckedVal}; #type{} -> %% A parameter that couldn't be categorized. #valuedef{value=CheckedVal} = check_value(S2#state{recordtopname=[RecName|TopName]}, V#valuedef{type=Type}), V#valuedef{value=CheckedVal} end; 'ASN1_OPEN_TYPE' -> {opentypefieldvalue,ANYType,ANYValue} = Value, CheckedV = check_value(SVal,#valuedef{name=Name, type=ANYType, value=ANYValue, module=ModName}), V#valuedef{value=CheckedV#valuedef.value}; 'INTEGER' -> V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; {'INTEGER',_NamedNumberList} -> V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; #'SEQUENCE'{} -> {ok,SeqVal} = convert_external(SVal, Value), V#valuedef{value=normalize_value(SVal, Vtype, SeqVal, TopName)}; _ -> V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)} end. is_contextswitchtype(#typedef{name='EXTERNAL'})-> true; is_contextswitchtype(#typedef{name='EMBEDDED PDV'}) -> true; is_contextswitchtype(#typedef{name='CHARACTER STRING'}) -> true; is_contextswitchtype(_) -> false. %%% %%% Start of OBJECT IDENTFIER/RELATIVE-OID validation. %%% validate_objectidentifier(S, OidType, #'Externalvaluereference'{}=Id) -> %% Must be an OBJECT IDENTIFIER or RELATIVE-OID depending on OidType. get_oid_value(S, OidType, false, Id); validate_objectidentifier(S, OidType, {'ValueFromObject',{object,Obj},Fields}) -> %% Must be an OBJECT IDENTIFIER/RELATIVE-OID depending on OidType. case extract_field(S, Obj, Fields) of #valuedef{checked=true,value=Value,type=Type} when is_tuple(Value) -> _ = get_oid_type(S, OidType, Type), Value; _ -> asn1_error(S, {illegal_oid,OidType}) end; validate_objectidentifier(S, OidType, [{#seqtag{module=Mod,pos=Pos,val=Atom},Val}]) -> %% This case is when an OBJECT IDENTIFIER value has been parsed as a %% SEQUENCE value. Rec = #'Externalvaluereference'{pos=Pos, module=Mod, value=Atom}, validate_oid(S, OidType, [Rec,Val], []); validate_objectidentifier(S, OidType, [_|_]=L0) -> validate_oid(S, OidType, L0, []); validate_objectidentifier(S, OidType, _) -> asn1_error(S, {illegal_oid,OidType}). get_oid_value(S, OidType, AllowInteger, #'Externalvaluereference'{}=Id) -> case get_referenced_type(S, Id) of {_,#valuedef{checked=Checked,type=Type,value=V}} -> case get_oid_type(S, OidType, Type) of 'INTEGER' when not AllowInteger -> asn1_error(S, {illegal_oid,OidType}); _ when Checked -> V; 'INTEGER' -> V; _ -> validate_objectidentifier(S, OidType, V) end; _ -> asn1_error(S, {illegal_oid,OidType}) end. validate_oid(S, OidType, [], Acc) -> Oid = lists:reverse(Acc), validate_oid_path(S, OidType, Oid), list_to_tuple(Oid); validate_oid(S, OidType, [Value|Vrest], Acc) when is_integer(Value) -> validate_oid(S, OidType, Vrest, [Value|Acc]); validate_oid(S, OidType, [{'NamedNumber',_Name,Value}|Vrest], Acc) when is_integer(Value) -> validate_oid(S, OidType, Vrest, [Value|Acc]); validate_oid(S, OidType, [#'Externalvaluereference'{}=Id|Vrest], Acc) -> NeededOidType = case Acc of [] -> o_id; [_|_] -> rel_oid end, try get_oid_value(S, NeededOidType, true, Id) of Val when is_integer(Val) -> validate_oid(S, OidType, Vrest, [Val|Acc]); Val when is_tuple(Val) -> L = tuple_to_list(Val), validate_oid(S, OidType, Vrest, lists:reverse(L, Acc)) catch _:_ -> case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of Value when is_integer(Value) -> validate_oid(S, OidType,Vrest, [Value|Acc]); false -> asn1_error(S, {illegal_oid,OidType}) end end; validate_oid(S, OidType, _V, _Acc) -> asn1_error(S, {illegal_oid,OidType}). get_oid_type(S, OidType, #type{def=Def}) -> get_oid_type(S, OidType, Def); get_oid_type(S, OidType, #'Externaltypereference'{}=Id) -> {_,OI} = get_referenced_type(S, Id), get_oid_type(S, OidType, OI#typedef.typespec); get_oid_type(_S, o_id, 'OBJECT IDENTIFIER'=T) -> T; get_oid_type(_S, rel_oid, 'RELATIVE-OID'=T) -> T; get_oid_type(_S, _, 'INTEGER'=T) -> T; get_oid_type(S, OidType, _) -> asn1_error(S, {illegal_oid,OidType}). %% ITU-T Rec. X.680 Annex B - D reserved_objectid('itu-t',[]) -> 0; reserved_objectid('ccitt',[]) -> 0; %% arcs below "itu-t" reserved_objectid('recommendation',[0]) -> 0; reserved_objectid('question',[0]) -> 1; reserved_objectid('administration',[0]) -> 2; reserved_objectid('network-operator',[0]) -> 3; reserved_objectid('identified-organization',[0]) -> 4; %% arcs below "recommendation" reserved_objectid('a',[0,0]) -> 1; reserved_objectid('b',[0,0]) -> 2; reserved_objectid('c',[0,0]) -> 3; reserved_objectid('d',[0,0]) -> 4; reserved_objectid('e',[0,0]) -> 5; reserved_objectid('f',[0,0]) -> 6; reserved_objectid('g',[0,0]) -> 7; reserved_objectid('h',[0,0]) -> 8; reserved_objectid('i',[0,0]) -> 9; reserved_objectid('j',[0,0]) -> 10; reserved_objectid('k',[0,0]) -> 11; reserved_objectid('l',[0,0]) -> 12; reserved_objectid('m',[0,0]) -> 13; reserved_objectid('n',[0,0]) -> 14; reserved_objectid('o',[0,0]) -> 15; reserved_objectid('p',[0,0]) -> 16; reserved_objectid('q',[0,0]) -> 17; reserved_objectid('r',[0,0]) -> 18; reserved_objectid('s',[0,0]) -> 19; reserved_objectid('t',[0,0]) -> 20; reserved_objectid('u',[0,0]) -> 21; reserved_objectid('v',[0,0]) -> 22; reserved_objectid('w',[0,0]) -> 23; reserved_objectid('x',[0,0]) -> 24; reserved_objectid('y',[0,0]) -> 25; reserved_objectid('z',[0,0]) -> 26; reserved_objectid(iso,[]) -> 1; %% arcs below "iso", note that number 1 is not used reserved_objectid('standard',[1]) -> 0; reserved_objectid('member-body',[1]) -> 2; reserved_objectid('identified-organization',[1]) -> 3; reserved_objectid('joint-iso-itu-t',[]) -> 2; reserved_objectid('joint-iso-ccitt',[]) -> 2; reserved_objectid(_,_) -> false. validate_oid_path(_, rel_oid, _) -> ok; validate_oid_path(_, o_id, [0,I|_]) when 0 =< I, I =< 9 -> ok; validate_oid_path(_, o_id, [1,I|_]) when 0 =< I, I =< 3 -> ok; validate_oid_path(_, o_id, [2|_]) -> ok; validate_oid_path(S, o_id=OidType, _) -> asn1_error(S, {illegal_oid,OidType}). %%% %%% End of OBJECT IDENTFIER/RELATIVE-OID validation. %%% convert_external(S=#state{type=Vtype}, Value) -> case Vtype of #type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} -> %% this is an 'EXTERNAL' (or INSTANCE OF) case Value of [{#seqtag{val=identification},_}|_] -> {ok,to_EXTERNAL1990(S, Value)}; _ -> {ok,Value} end; _ -> {ok,Value} end. to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, {'CHOICE',{syntax,Stx}}}|Rest]) -> to_EXTERNAL1990(S, Rest, [{T#seqtag{val='direct-reference'},Stx}]); to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, {'CHOICE',{'presentation-context-id',I}}}|Rest]) -> to_EXTERNAL1990(S, Rest, [{T#seqtag{val='indirect-reference'},I}]); to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, {'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) -> to_EXTERNAL1990(S, Rest, [{T#seqtag{val='indirect-reference'},PCid}, {T#seqtag{val='direct-reference'},TrStx}]); to_EXTERNAL1990(S, _) -> error({value,"illegal value in EXTERNAL type",S}). to_EXTERNAL1990(S, [V={#seqtag{val='data-value-descriptor'},_}|Rest], Acc) -> to_EXTERNAL1990(S, Rest, [V|Acc]); to_EXTERNAL1990(_S, [{#seqtag{val='data-value'}=T,Val}], Acc) -> Encoding = {T#seqtag{val=encoding},{'CHOICE',{'octet-aligned',Val}}}, lists:reverse([Encoding|Acc]); to_EXTERNAL1990(S, _, _) -> error({value,"illegal value in EXTERNAL type",S}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Functions to normalize the default values of SEQUENCE %% and SET components into Erlang valid format %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% normalize_value(_,_,mandatory,_) -> mandatory; normalize_value(_,_,'OPTIONAL',_) -> 'OPTIONAL'; normalize_value(S0, Type, {'DEFAULT',Value}, NameList) -> S = S0#state{value=Value}, case catch get_canonic_type(S,Type,NameList) of {'BOOLEAN',CType,_} -> normalize_boolean(S,Value,CType); {'INTEGER',CType,_} -> normalize_integer(S0, Value, CType); {'BIT STRING',CType,_} -> normalize_bitstring(S,Value,CType); {'OCTET STRING',_,_} -> normalize_octetstring(S0, Value); {'NULL',_CType,_} -> %%normalize_null(Value); 'NULL'; {'RELATIVE-OID',_,_} -> normalize_relative_oid(S,Value); {'OBJECT IDENTIFIER',_,_} -> normalize_objectidentifier(S,Value); {'ObjectDescriptor',_,_} -> normalize_objectdescriptor(Value); {'REAL',_,_} -> normalize_real(Value); {'ENUMERATED',CType,_} -> normalize_enumerated(S,Value,CType); {'CHOICE',CType,NewNameList} -> normalize_choice(S,Value,CType,NewNameList); {'SEQUENCE',CType,NewNameList} -> normalize_sequence(S,Value,CType,NewNameList); {'SEQUENCE OF',CType,NewNameList} -> normalize_seqof(S,Value,CType,NewNameList); {'SET',CType,NewNameList} -> normalize_set(S,Value,CType,NewNameList); {'SET OF',CType,NewNameList} -> normalize_setof(S,Value,CType,NewNameList); {restrictedstring,CType,_} -> normalize_restrictedstring(S,Value,CType); {'ASN1_OPEN_TYPE',{typefield,_TF},NL} -> %an open type normalize_objectclassfieldvalue(S,Value,NL); Err -> asn1ct:warning("could not check default value ~p~nType:~n~p~nNameList:~n~p~n", [Value,Type,Err],S,"could not check default value"), Value end; normalize_value(S,Type,Val,NameList) -> normalize_value(S,Type,{'DEFAULT',Val},NameList). normalize_boolean(S,{Name,Bool},CType) when is_atom(Name) -> normalize_boolean(S,Bool,CType); normalize_boolean(_,true,_) -> true; normalize_boolean(_,false,_) -> false; normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) -> get_normalized_value(S,Bool,CType,fun normalize_boolean/3,[]); normalize_boolean(_,Other,_) -> throw({error,{asn1,{'invalid default value',Other}}}). normalize_integer(_S, Int, _) when is_integer(Int) -> Int; normalize_integer(S, #'Externalvaluereference'{value=Name}=Ref, NNL) -> case lists:keyfind(Name, 1, NNL) of {Name,Val} -> Val; false -> try get_referenced_value(S, Ref) of Val when is_integer(Val) -> Val; _ -> asn1_error(S, illegal_integer_value) catch throw:_ -> asn1_error(S, illegal_integer_value) end end; normalize_integer(S0, {'ValueFromObject',{object,Obj},FieldNames}, _) -> S = S0#state{type=S0#state.value}, case extract_field(S, Obj, FieldNames) of #valuedef{value=Val} when is_integer(Val) -> Val; _ -> asn1_error(S, illegal_integer_value) end; normalize_integer(S, _, _) -> asn1_error(S, illegal_integer_value). %% normalize_bitstring(S, Value, Type) -> bitstring() %% Convert a literal value for a BIT STRING to an Erlang bit string. %% normalize_bitstring(S, Value, Type)-> case Value of {hstring,String} when is_list(String) -> hstring_to_bitstring(String); {bstring,String} when is_list(String) -> bstring_to_bitstring(String); #'Externalvaluereference'{} -> Val = get_referenced_value(S, Value), normalize_bitstring(S, Val, Type); {'ValueFromObject',{object,Obj},FieldNames} -> case extract_field(S, Obj, FieldNames) of #valuedef{value=Val} -> normalize_bitstring(S, Val, Type); _ -> asn1_error(S, illegal_bitstring_value) end; RecList when is_list(RecList) -> [normalize_bs_item(S, Item, Type) || Item <- RecList]; Bs when is_bitstring(Bs) -> %% Already normalized. Bs; _ -> asn1_error(S, illegal_bitstring_value) end. normalize_bs_item(S, #'Externalvaluereference'{value=Name}, Type) -> case lists:keymember(Name, 1, Type) of true -> Name; false -> asn1_error(S, illegal_bitstring_value) end; normalize_bs_item(_, Atom, _) when is_atom(Atom) -> Atom; normalize_bs_item(S, _, _) -> asn1_error(S, illegal_bitstring_value). hstring_to_binary(L) -> byte_align(hstring_to_bitstring(L)). bstring_to_binary(L) -> byte_align(bstring_to_bitstring(L)). byte_align(Bs) -> case bit_size(Bs) rem 8 of 0 -> Bs; N -> <> end. hstring_to_bitstring(L) -> << <<(hex_to_int(D)):4>> || D <- L >>. bstring_to_bitstring(L) -> << <<(D-$0):1>> || D <- L >>. hex_to_int(D) when $0 =< D, D =< $9 -> D - $0; hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10). %% normalize_octetstring/1 changes representation of input Value to a %% list of octets. %% Format of Value is one of: %% {bstring,String} each element in String corresponds to one bit in an octet %% {hstring,String} each element in String corresponds to one byte in an octet %% #'Externalvaluereference' normalize_octetstring(S, Value) -> case Value of {bstring,String} -> bstring_to_binary(String); {hstring,String} -> hstring_to_binary(String); #'Externalvaluereference'{} -> case get_referenced_value(S, Value) of String when is_binary(String) -> String; Other -> normalize_octetstring(S, Other) end; {'ValueFromObject',{object,Obj},FieldNames} -> case extract_field(S, Obj, FieldNames) of #valuedef{value=Val} when is_binary(Val) -> Val; _ -> asn1_error(S, illegal_octet_string_value) end; _ -> asn1_error(S, illegal_octet_string_value) end. normalize_objectidentifier(S, Value) -> validate_objectidentifier(S, o_id, Value). normalize_relative_oid(S, Value) -> validate_objectidentifier(S, rel_oid, Value). normalize_objectdescriptor(Value) -> Value. normalize_real(Value) -> Value. normalize_enumerated(S, Id0, NNL) -> {Id,_} = lookup_enum_value(S, Id0, NNL), Id. lookup_enum_value(S, Id, {Base,Ext}) -> %% Extensible ENUMERATED. lookup_enum_value(S, Id, Base++Ext); lookup_enum_value(S, #'Externalvaluereference'{value=Id}, NNL) -> lookup_enum_value(S, Id, NNL); lookup_enum_value(S, Id, NNL) when is_atom(Id) -> case lists:keyfind(Id, 1, NNL) of {_,_}=Ret -> Ret; false -> asn1_error(S, S#state.value, {undefined,Id}) end. normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) -> case catch lists:keysearch(C,#'ComponentType'.name,CType) of {value,#'ComponentType'{typespec=CT,name=Name}} -> {C,normalize_value(S,CT,{'DEFAULT',V}, [Name|NameList])}; Other -> asn1ct:warning("Wrong format of type/value ~p/~p~n",[Other,V],S, "Wrong format of type/value"), {C,V} end; normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) when is_list(ValueList) -> lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList); normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) -> {M,#valuedef{value=V}}=get_referenced_type(S,Val), normalize_choice(update_state(S,M),{'CHOICE',V},CType,NameList); % get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]); normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList) when is_atom(Name) -> % normalize_choice(S,ChoiceVal,CType,NameList). normalize_choice(S,{'CHOICE',CV},CType,NameList); normalize_choice(_S,V,_CType,_NameList) -> exit({error,{bad_choice_value,V}}). %% normalize_choice(NameList,S,CVal = {'CHOICE',{_,_}},CType,_) -> %% normalize_choice(S,CVal,CType,NameList); %% normalize_choice(NameList,S,CVal={'DEFAULT',VL},CType,_) when is_list(VL)-> %% normalize_choice(S,CVal,CType,NameList); %% normalize_choice(NameList,S,CV={Name,_CV},CType,_) when is_atom(Name)-> %% normalize_choice(S,{'CHOICE',CV},CType,NameList); %% normalize_choice(_,_S,V,_,_) -> %% V. normalize_sequence(S,Value,Components,NameList) when is_tuple(Components) -> normalize_sequence(S,Value,lists:flatten(tuple_to_list(Components)), NameList); normalize_sequence(S,{Name,Value},Components,NameList) when is_atom(Name),is_list(Value) -> normalize_sequence(S,Value,Components,NameList); normalize_sequence(S,Value,Components,NameList) -> normalized_record('SEQUENCE',S,Value,Components,NameList). normalize_set(S,Value,Components,NameList) when is_tuple(Components) -> normalize_set(S,Value,lists:flatten(tuple_to_list(Components)),NameList); normalize_set(S,{Name,Value},Components,NameList) when is_atom(Name),is_list(Value) -> normalized_record('SET',S,Value,Components,NameList); normalize_set(S,Value,Components,NameList) -> NewName = list_to_atom(asn1ct_gen:list2name(NameList)), case is_record_normalized(S,NewName,Value,length(Components)) of true -> Value; _ -> SortedVal = sort_value(Components,Value), normalized_record('SET',S,SortedVal,Components,NameList) end. sort_value(Components, Value0) when is_list(Value0) -> {Keys0,_} = lists:mapfoldl(fun(#'ComponentType'{name=N}, I) -> {{N,I},I+1} end, 0, Components), Keys = gb_trees:from_orddict(orddict:from_list(Keys0)), Value1 = [{case gb_trees:lookup(N, Keys) of {value,K} -> K; none -> 'end' end,Pair} || {#seqtag{val=N},_}=Pair <- Value0], Value = lists:sort(Value1), [Pair || {_,Pair} <- Value]; sort_value(_Components, #'Externalvaluereference'{}=Value) -> %% Sort later. Value. sort_val_if_set(['SET'|_],Val,Type) -> sort_value(Type,Val); sort_val_if_set(_,Val,_) -> Val. normalized_record(SorS,S,Value,Components,NameList) -> NewName = list_to_atom(lists:concat([get_record_prefix_name(S), asn1ct_gen:list2name(NameList)])), case is_record_normalized(S,NewName,Value,length(Components)) of true -> Value; _ -> NoComps = length(Components), case normalize_seq_or_set(SorS,S,Value,Components,NameList,[]) of ListOfVals when length(ListOfVals) == NoComps -> list_to_tuple([NewName|ListOfVals]); _ -> error({type,{illegal,default,value,Value},S}) end end. is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> case get_referenced_type(S,V) of {_M,#valuedef{type=_T1,value=V2}} -> is_record_normalized(S,Name,V2,NumComps); _ -> false end; is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> (tuple_size(Value) =:= (NumComps + 1)) andalso (element(1, Value) =:= Name); is_record_normalized(_,_,_,_) -> false. normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs], [#'ComponentType'{name=Cname,typespec=TS}|Cs], NameList, Acc) -> NewNameList = case TS#type.def of #'Externaltypereference'{type=TName} -> [TName]; _ -> [Cname|NameList] end, NVal = normalize_value(S,TS,{'DEFAULT',V},NewNameList), normalize_seq_or_set(SorS,S,Vs,Cs,NameList,[NVal|Acc]); normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs], [#'ComponentType'{prop='OPTIONAL'}|Cs], NameList,Acc) -> normalize_seq_or_set(SorS,S,Values,Cs,NameList,[asn1_NOVALUE|Acc]); normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs], [#'ComponentType'{name=Cname2,typespec=TS, prop={'DEFAULT',Value}}|Cs], NameList,Acc) -> NewNameList = case TS#type.def of #'Externaltypereference'{type=TName} -> [TName]; _ -> [Cname2|NameList] end, NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), normalize_seq_or_set(SorS,S,Values,Cs,NameList,[NVal|Acc]); normalize_seq_or_set(_SorS,_S,[],[],_,Acc) -> lists:reverse(Acc); %% If default value is {} ComponentTypes in SEQUENCE are marked DEFAULT %% or OPTIONAL (or the type is defined SEQUENCE{}, which is handled by %% the previous case). normalize_seq_or_set(SorS,S,[], [#'ComponentType'{name=Name,typespec=TS, prop={'DEFAULT',Value}}|Cs], NameList,Acc) -> NewNameList = case TS#type.def of #'Externaltypereference'{type=TName} -> [TName]; _ -> [Name|NameList] end, NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), normalize_seq_or_set(SorS,S,[],Cs,NameList,[NVal|Acc]); normalize_seq_or_set(SorS,S,[],[#'ComponentType'{prop='OPTIONAL'}|Cs], NameList,Acc) -> normalize_seq_or_set(SorS,S,[],Cs,NameList,[asn1_NOVALUE|Acc]); normalize_seq_or_set(SorS,S,Value=#'Externalvaluereference'{}, Cs,NameList,Acc) -> get_normalized_value(S,Value,Cs,fun normalize_seq_or_set/6, [SorS,NameList,Acc]); normalize_seq_or_set(_SorS,S,V,_,_,_) -> error({type,{illegal,default,value,V},S}). normalize_seqof(S,Value,Type,NameList) -> normalize_s_of('SEQUENCE OF',S,Value,Type,NameList). normalize_setof(S,Value,Type,NameList) -> normalize_s_of('SET OF',S,Value,Type,NameList). normalize_s_of(SorS,S,Value,Type,NameList) when is_list(Value) -> DefValueList = lists:map(fun(X) -> {'DEFAULT',X} end,Value), Suffix = asn1ct_gen:constructed_suffix(SorS,Type), Def = Type#type.def, InnerType = asn1ct_gen:get_inner(Def), WhatKind = asn1ct_gen:type(InnerType), NewNameList = case WhatKind of {constructed,bif} -> [Suffix|NameList]; #'Externaltypereference'{type=Name} -> [Name]; _ -> [] end, NormFun = fun (X) -> normalize_value(S,Type,X, NewNameList) end, case catch lists:map(NormFun, DefValueList) of List when is_list(List) -> List; _ -> asn1ct:warning("~p could not handle value ~p~n",[SorS,Value],S, "could not handle value"), Value end; normalize_s_of(SorS,S,Value,Type,NameList) when is_record(Value,'Externalvaluereference') -> get_normalized_value(S,Value,Type,fun normalize_s_of/5, [SorS,NameList]). %% normalize_restrictedstring handles all format of restricted strings. %% tuple case % normalize_restrictedstring(_S,[Int1,Int2],_) when is_integer(Int1),is_integer(Int2) -> % {Int1,Int2}; % %% quadruple case % normalize_restrictedstring(_S,[Int1,Int2,Int3,Int4],_) when is_integer(Int1), % is_integer(Int2), % is_integer(Int3), % is_integer(Int4) -> % {Int1,Int2,Int3,Int4}; %% character string list case normalize_restrictedstring(S,[H|T],CType) when is_list(H);is_tuple(H) -> [normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)]; %% character sting case normalize_restrictedstring(_S,CString,_) when is_list(CString) -> CString; %% definedvalue case or argument in a parameterized type normalize_restrictedstring(S,ERef,CType) when is_record(ERef,'Externalvaluereference') -> get_normalized_value(S,ERef,CType, fun normalize_restrictedstring/3,[]); %% normalize_restrictedstring(S,{Name,Val},CType) when is_atom(Name) -> normalize_restrictedstring(S,Val,CType). normalize_objectclassfieldvalue(S,{opentypefieldvalue,Type,Value},NameList) -> %% An open type has per definition no type. Thus should the type %% information of the default type be available at %% encode/decode. But as encoding the default value causes special %% treatment (no encoding) whatever type is used the type %% information is not necessary in encode/decode. normalize_value(S,Type,Value,NameList); normalize_objectclassfieldvalue(_S,Other,_NameList) -> %% If the type info was thrown away in an earlier step the value %% is already normalized. Other. get_normalized_value(S,Val,Type,Func,AddArg) -> case catch get_referenced_type(S,Val) of {ExtM,_VDef = #valuedef{type=_T1,value=V}} -> %% should check that Type and T equals V2 = sort_val_if_set(AddArg,V,Type), call_Func(update_state(S,ExtM),V2,Type,Func,AddArg); {error,_} -> asn1ct:warning("default value not comparable ~p~n",[Val],S), Val; {ExtM,NewVal} -> V2 = sort_val_if_set(AddArg,NewVal,Type), call_Func(update_state(S,ExtM),V2,Type,Func,AddArg); _ -> asn1ct:warning("default value not comparable ~p~n",[Val],S, "default value not comparable"), Val end. call_Func(S,Val,Type,Func,ArgList) -> case ArgList of [] -> Func(S,Val,Type); [LastArg] -> Func(S,Val,Type,LastArg); [Arg1,LastArg1] -> Func(Arg1,S,Val,Type,LastArg1); [Arg1,LastArg1,LastArg2] -> Func(Arg1,S,Val,Type,LastArg1,LastArg2) end. get_canonic_type(S,Type,NameList) -> {InnerType,NewType,NewNameList} = case Type#type.def of 'INTEGER'=Name -> {Name,[],NameList}; Name when is_atom(Name) -> {Name,Type,NameList}; Ref when is_record(Ref,'Externaltypereference') -> {_,#typedef{name=Name,typespec=RefedType}} = get_referenced_type(S,Ref), get_canonic_type(S,RefedType,[Name]); {Name,T} when is_atom(Name) -> {Name,T,NameList}; Seq when is_record(Seq,'SEQUENCE') -> {'SEQUENCE',Seq#'SEQUENCE'.components,NameList}; Set when is_record(Set,'SET') -> {'SET',Set#'SET'.components,NameList}; #'ObjectClassFieldType'{type=T} -> {'ASN1_OPEN_TYPE',T,NameList} end, {asn1ct_gen:unify_if_string(InnerType),NewType,NewNameList}. check_ptype(S,Type,Ts) when is_record(Ts,type) -> check_formal_parameters(S, Type#ptypedef.args), Def = Ts#type.def, NewDef= case Def of Seq when is_record(Seq,'SEQUENCE') -> Components = expand_components(S,Seq#'SEQUENCE'.components), #newt{type=Seq#'SEQUENCE'{pname=get_datastr_name(Type), components = Components}}; Set when is_record(Set,'SET') -> Components = expand_components(S,Set#'SET'.components), #newt{type=Set#'SET'{pname=get_datastr_name(Type), components = Components}}; _Other -> #newt{} end, Ts2 = case NewDef of #newt{type=unchanged} -> Ts; #newt{type=TDef}-> Ts#type{def=TDef} end, Ts2; %parameterized class check_ptype(_S,_PTDef,Ts) when is_record(Ts,objectclass) -> throw({asn1_param_class,Ts}). check_formal_parameters(S, Args) -> _ = [check_formal_parameter(S, A) || A <- Args], ok. check_formal_parameter(_, {_,_}) -> ok; check_formal_parameter(_, #'Externaltypereference'{}) -> ok; check_formal_parameter(S, #'Externalvaluereference'{value=Name}) -> asn1_error(S, {illegal_typereference,Name}). % check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> % check_class(S,ObjSpec); check_type(_S,Type,Ts) when is_record(Type,typedef), (Type#typedef.checked==true) -> Ts; check_type(_S,Type,Ts) when is_record(Type,typedef), (Type#typedef.checked==idle) -> % the check is going on Ts; check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> {Def,Tag,Constr,IsInlined} = case match_parameter(S, Ts#type.def) of #type{tag=PTag,constraint=_Ctmp,def=Dtmp,inlined=Inl} -> {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl}; #typedef{typespec=#type{tag=PTag,def=Dtmp,inlined=Inl}} -> {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl}; Dtmp -> {Dtmp,Ts#type.tag,Ts#type.constraint,Ts#type.inlined} end, TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr, inlined=IsInlined}, TestFun = fun(Tref) -> {_, MaybeChoice} = get_referenced_type(S, Tref, true), case catch((MaybeChoice#typedef.typespec)#type.def) of {'CHOICE',_} -> maybe_illicit_implicit_tag(choice,Tag); 'ANY' -> maybe_illicit_implicit_tag(open_type,Tag); 'ANY DEFINED BY' -> maybe_illicit_implicit_tag(open_type,Tag); 'ASN1_OPEN_TYPE' -> maybe_illicit_implicit_tag(open_type,Tag); _ -> Tag end end, NewDef= case Def of Ext when is_record(Ext,'Externaltypereference') -> {RefMod,RefTypeDef,IsParamDef} = case get_referenced_type(S, Ext) of {undefined,TmpTDef} -> %% A parameter {get(top_module),TmpTDef,true}; {TmpRefMod,TmpRefDef} -> {TmpRefMod,TmpRefDef,false} end, case get_class_def(S, RefTypeDef) of none -> ok; #classdef{} -> throw({asn1_class,RefTypeDef}) end, Ct = TestFun(Ext), {RefType,ExtRef} = case RefTypeDef#typedef.checked of true -> {RefTypeDef#typedef.typespec,Ext}; _ -> %% Put as idle to prevent recursive loops NewRefTypeDef1 = RefTypeDef#typedef{checked=idle}, asn1_db:dbput(RefMod, get_datastr_name(NewRefTypeDef1), NewRefTypeDef1), NewS = S#state{mname=RefMod, module=load_asn1_module(S,RefMod), tname=get_datastr_name(NewRefTypeDef1), type=NewRefTypeDef1, abscomppath=[],recordtopname=[]}, RefType1 = check_type(NewS,RefTypeDef,RefTypeDef#typedef.typespec), %% update the type and mark as checked NewRefTypeDef2 = RefTypeDef#typedef{checked=true,typespec = RefType1}, TmpName = get_datastr_name(NewRefTypeDef2), asn1_db:dbput(RefMod, TmpName, NewRefTypeDef2), case {RefMod == get(top_module),IsParamDef} of {true,true} -> Key = {TmpName, type, NewRefTypeDef2}, asn1ct_gen:insert_once(parameterized_objects, Key); _ -> ok end, Pos = Ext#'Externaltypereference'.pos, {RefType1,#'Externaltypereference'{module=RefMod, pos=Pos, type=TmpName}} end, case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of true -> %% Here we expand to a built in type and inline it Constr2 = check_constraints(S, RefType, Constr), NewC = constraint_merge(S, Constr2 ++ RefType#type.constraint), TempNewDef#newt{ type = RefType#type.def, tag = merge_tags(Ct,RefType#type.tag), constraint = NewC}; _ -> %% Here we only expand the tags and keep the ext ref. NewExt = ExtRef#'Externaltypereference'{module=merged_mod(S,RefMod,Ext)}, TempNewDef#newt{ type = check_externaltypereference(S,NewExt), tag = merge_tags(Ct,RefType#type.tag)} end; 'ANY' -> Ct=maybe_illicit_implicit_tag(open_type,Tag), TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; {'ANY_DEFINED_BY',_} -> Ct=maybe_illicit_implicit_tag(open_type,Tag), TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 'INTEGER' -> TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; {'INTEGER',NamedNumberList} -> TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList)}, tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; 'REAL' -> check_real(S,Constr), TempNewDef#newt{tag=merge_tags(Tag,?TAG_PRIMITIVE(?N_REAL))}; {'BIT STRING',NamedNumberList} -> NewL = check_bitstring(S, NamedNumberList), TempNewDef#newt{type={'BIT STRING',NewL}, tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))}; 'NULL' -> TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_NULL))}; 'OBJECT IDENTIFIER' -> check_objectidentifier(S,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER))}; 'ObjectDescriptor' -> TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_DESCRIPTOR))}; 'EXTERNAL' -> put_once(external,unchecked), TempNewDef#newt{type= #'Externaltypereference'{module=S#state.mname, type='EXTERNAL'}, tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_EXTERNAL))}; {'INSTANCE OF',DefinedObjectClass,Constraint} -> %% check that DefinedObjectClass is of TYPE-IDENTIFIER class %% If Constraint is empty make it the general INSTANCE OF type %% If Constraint is not empty make an inlined type %% convert INSTANCE OF to the associated type IOFDef=check_instance_of(S,DefinedObjectClass,Constraint), TempNewDef#newt{type=IOFDef, tag=merge_tags(Tag,?TAG_CONSTRUCTED(?N_INSTANCE_OF))}; {'ENUMERATED',NamedNumberList} -> TempNewDef#newt{type= {'ENUMERATED', check_enumerated(S,NamedNumberList,Constr)}, tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED)), constraint=[]}; 'EMBEDDED PDV' -> put_once(embedded_pdv,unchecked), TempNewDef#newt{type= #'Externaltypereference'{module=S#state.mname, type='EMBEDDED PDV'}, tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_EMBEDDED_PDV))}; 'BOOLEAN'-> check_boolean(S,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_BOOLEAN))}; 'OCTET STRING' -> check_octetstring(S,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_OCTET_STRING))}; 'NumericString' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_NumericString))}; TString when TString =:= 'TeletexString'; TString =:= 'T61String' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_TeletexString))}; 'VideotexString' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_VideotexString))}; 'UTCTime' -> TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_UTCTime))}; 'GeneralizedTime' -> TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralizedTime))}; 'GraphicString' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_GraphicString))}; 'VisibleString' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_VisibleString))}; 'GeneralString' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralString))}; 'PrintableString' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_PrintableString))}; 'IA5String' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_IA5String))}; 'BMPString' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_BMPString))}; 'UniversalString' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_UniversalString))}; 'UTF8String' -> check_restrictedstring(S,Def,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_UTF8String))}; 'RELATIVE-OID' -> check_relative_oid(S,Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?'N_RELATIVE-OID'))}; 'CHARACTER STRING' -> put_once(character_string,unchecked), TempNewDef#newt{type= #'Externaltypereference'{module=S#state.mname, type='CHARACTER STRING'}, tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_CHARACTER_STRING))}; Seq when is_record(Seq,'SEQUENCE') -> RecordName = case TopName of [] -> [get_datastr_name(Type)]; % [Type#typedef.name]; _ -> TopName end, {TableCInf,Components} = check_sequence(S#state{recordtopname= RecordName}, Type,Seq#'SEQUENCE'.components), TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=tablecinf_choose(Seq,TableCInf), components=Components}, tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; {'SEQUENCE OF',Components} -> TempNewDef#newt{type={'SEQUENCE OF',check_sequenceof(S,Type,Components)}, tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; {'CHOICE',Components} -> Ct = maybe_illicit_implicit_tag(choice,Tag), TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct}; Set when is_record(Set,'SET') -> RecordName= case TopName of [] -> [get_datastr_name(Type)]; % [Type#typedef.name]; _ -> TopName end, {Sorted,TableCInf,Components} = check_set(S#state{recordtopname=RecordName}, Type,Set#'SET'.components), TempNewDef#newt{type=Set#'SET'{sorted=Sorted, tablecinf=tablecinf_choose(Set,TableCInf), components=Components}, tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; {'SET OF',Components} -> TempNewDef#newt{type={'SET OF',check_setof(S,Type,Components)}, tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; {pt,Ptype,ParaList} -> %% Ptype might be a parameterized - type, object set or %% value set. If it isn't a parameterized type notify the %% calling function. {_RefMod,Ptypedef} = get_referenced_type(S,Ptype), notify_if_not_ptype(S,Ptypedef), NewParaList = match_parameters(S, ParaList), Instance = instantiate_ptype(S,Ptypedef,NewParaList), TempNewDef#newt{type=Instance#type.def, tag=merge_tags(Tag,Instance#type.tag), constraint=Instance#type.constraint, inlined=yes}; OCFT=#'ObjectClassFieldType'{classname=ClRef} -> %% this case occures in a SEQUENCE when %% the type of the component is a ObjectClassFieldType ClassSpec = check_class(S,ClRef), NewTypeDef = maybe_open_type(S,ClassSpec, OCFT#'ObjectClassFieldType'{class=ClassSpec},Constr), InnerTag = get_innertag(S,NewTypeDef), MergedTag = merge_tags(Tag,InnerTag), Ct = case is_open_type(NewTypeDef) of true -> maybe_illicit_implicit_tag(open_type,MergedTag); _ -> MergedTag end, case TopName of [] when Type#typedef.name =/= undefined -> %% This is a top-level type. #type{def=Simplified} = simplify_type(#type{def=NewTypeDef}), TempNewDef#newt{type=Simplified,tag=Ct}; _ -> TempNewDef#newt{type=NewTypeDef,tag=Ct} end; {'TypeFromObject',{object,Object},TypeField} -> CheckedT = get_type_from_object(S,Object,TypeField), TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), type=CheckedT#type.def}; {valueset,Vtype} -> TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}}; {'SelectionType',Name,T} -> CheckedT = check_selectiontype(S,Name,T), TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), type=CheckedT#type.def}; 'ASN1_OPEN_TYPE' -> TempNewDef; Other -> exit({'cant check' ,Other}) end, #newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef, Ts#type{def=TDef, inlined=Inlined, constraint=check_constraints(S, #type{def=TDef}, NewConstr), tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) -> TempTag#tag{type=TTx}; (Other) -> Other end, NewTags)}; check_type(_S,Type,Ts) -> exit({error,{asn1,internal_error,Type,Ts}}). %% %% Simplify the backends by getting rid of an #'ObjectClassFieldType'{} %% with a type known at compile time. %% simplify_comps(Comps) -> [simplify_comp(Comp) || Comp <- Comps]. simplify_comp(#'ComponentType'{typespec=Type0}=C) -> Type = simplify_type(Type0), C#'ComponentType'{typespec=Type}; simplify_comp(Other) -> Other. simplify_type(#type{tag=Tag,def=Inner}=T) -> case Inner of #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}} -> Type#type{tag=Tag}; _ -> T end. %% tablecinf_choose. A SEQUENCE or SET may be inserted in another %% SEQUENCE or SET by the COMPONENTS OF directive. If this inserted %% type is a referenced type that already has been checked it already %% has its tableconstraint information. Furthermore this information %% may be lost in the analysis in the new environment. Assume this %% SEQUENCE/SET has a simpletable constraint and a componentrelation %% constraint whose atlist points to the outermost component of its %% "standalone" definition. This will cause the analysis to fail as it %% will not find the right atlist component in the outermost %% environment in the new inlined environment. tablecinf_choose(SetOrSeq,false) -> tablecinf_choose(SetOrSeq); tablecinf_choose(_, TableCInf) -> TableCInf. tablecinf_choose(#'SET'{tablecinf=TCI}) -> TCI; tablecinf_choose(#'SEQUENCE'{tablecinf=TCI}) -> TCI. get_innertag(_S,#'ObjectClassFieldType'{type=Type}) -> case Type of % #type{tag=Tag} -> Tag; % {fixedtypevaluefield,_,#type{tag=[]}=T} -> get_taglist(S,T); {fixedtypevaluefield,_,#type{tag=Tag}} -> Tag; {TypeFieldName,_} when is_atom(TypeFieldName) -> []; _ -> [] end. %% get_class_def(S, Type) -> #classdef{} | 'none'. get_class_def(S, #typedef{typespec=#type{def=#'Externaltypereference'{}=Eref}}) -> {_,NextDef} = get_referenced_type(S, Eref, true), get_class_def(S, NextDef); get_class_def(S, #'Externaltypereference'{}=Eref) -> {_,NextDef} = get_referenced_type(S, Eref, true), get_class_def(S, NextDef); get_class_def(_S, #classdef{}=CD) -> CD; get_class_def(_S, _) -> none. maybe_illicit_implicit_tag(Kind,Tag) -> case Tag of [#tag{type='IMPLICIT'}|_T] -> throw({error,{asn1,{implicit_tag_before,Kind}}}); [ChTag = #tag{type={default,_}}|T] -> case Kind of open_type -> [ChTag#tag{type='EXPLICIT',form=32}|T]; %X.680 30.6c, X.690 8.14.2 choice -> [ChTag#tag{type='EXPLICIT',form=32}|T] % X.680 28.6 c, 30.6c end; _ -> Tag % unchanged end. merged_mod(S,RefMod,Ext) -> case S of #state{inputmodules=[]} -> RefMod; _ -> Ext#'Externaltypereference'.module end. %% maybe_open_type/2 -> #ObjectClassFieldType with updated fieldname and %% type %% if the FieldRefList points out a typefield and the class don't have %% any UNIQUE field, so that a component relation constraint cannot specify %% the type of a typefield, return 'ASN1_OPEN_TYPE'. %% maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, OCFT=#'ObjectClassFieldType'{fieldname=FieldRefList}, Constr) -> Type = get_ObjectClassFieldType(S,Fs,FieldRefList), FieldNames=get_referenced_fieldname(FieldRefList), case last_fieldname(FieldRefList) of {valuefieldreference,_} -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type=Type}; {typefieldreference,_} -> case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), asn1ct_gen:get_constraint(Constr,componentrelation)}of {Tuple,_} when tuple_size(Tuple) =:= 3 -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; {_,no} -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; _ -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type=Type} end end. last_fieldname(FieldRefList) when is_list(FieldRefList) -> lists:last(FieldRefList); last_fieldname({FieldName,_}) when is_atom(FieldName) -> [A|_] = atom_to_list(FieldName), case is_lowercase(A) of true -> {valuefieldreference,FieldName}; _ -> {typefieldreference,FieldName} end. is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) -> true; is_open_type(#'ObjectClassFieldType'{}) -> false. notify_if_not_ptype(S,#pvaluesetdef{type=Type}) -> case Type#type.def of Ref when is_record(Ref,'Externaltypereference') -> case get_referenced_type(S,Ref) of {_,#classdef{}} -> throw(pobjectsetdef); {_,#typedef{}} -> throw(pvalueset) end; T when is_record(T,type) -> % this must be a value set throw(pvalueset) end; notify_if_not_ptype(_S,PT=#ptypedef{}) -> %% this may be a parameterized CLASS, in that case throw an %% asn1_class exception case PT#ptypedef.typespec of #objectclass{} -> throw({asn1_class,PT}); _ -> ok end; notify_if_not_ptype(S,#pobjectsetdef{class=Cl}) -> case Cl of #'Externaltypereference'{} -> case get_referenced_type(S,Cl) of {_,#classdef{}} -> throw(pobjectsetdef); {_,#typedef{}} -> throw(pvalueset) end; _ -> throw(pobjectsetdef) end; notify_if_not_ptype(_S,PT) -> throw({error,{"supposed to be a parameterized type",PT}}). % fix me instantiate_ptype(S,Ptypedef,ParaList) -> #ptypedef{args=Args,typespec=Type} = Ptypedef, NewType = check_ptype(S,Ptypedef,Type#type{inlined=yes}), MatchedArgs = match_args(S,Args, ParaList, []), OldArgs = S#state.parameters, NewS = S#state{type=NewType,parameters=MatchedArgs++OldArgs,abscomppath=[]}, %% NewS = S#state{type=NewType,parameters=MatchedArgs,abscomppath=[]}, check_type(NewS, Ptypedef#ptypedef{typespec=NewType}, NewType). get_datastr_name(#typedef{name=N}) -> N; get_datastr_name(#classdef{name=N}) -> N; get_datastr_name(#valuedef{name=N}) -> N; get_datastr_name(#ptypedef{name=N}) -> N; get_datastr_name(#pvaluedef{name=N}) -> N; get_datastr_name(#pvaluesetdef{name=N}) -> N; get_datastr_name(#pobjectdef{name=N}) -> N; get_datastr_name(#pobjectsetdef{name=N}) -> N. get_pt_args(#ptypedef{args=Args}) -> Args; get_pt_args(#pvaluesetdef{args=Args}) -> Args; get_pt_args(#pvaluedef{args=Args}) -> Args; get_pt_args(#pobjectdef{args=Args}) -> Args; get_pt_args(#pobjectsetdef{args=Args}) -> Args. get_pt_spec(#ptypedef{typespec=Type}) -> Type; get_pt_spec(#pvaluedef{value=Value}) -> Value; get_pt_spec(#pvaluesetdef{valueset=VS}) -> VS; get_pt_spec(#pobjectdef{def=Def}) -> Def; get_pt_spec(#pobjectsetdef{def=Def}) -> Def. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% match_args(S,FormalArgs, ActualArgs, Accumulator) -> Result %% S = #state{} %% FormalArgs = [term()] | [{Governor,Parameter}] %% ActualArgs = [term()] %% Accumulator = [term()] %% Result = [{term(),term()}] | throw() %% Governor = #type{} | Reference | 'TYPE-IDENTIFIER' | 'ABSTRACT-SYNTAX' %% Parameter = Reference | {Governor,Reference} %% Reference = #'Externaltypereference'{} | #'Externalvaluerference'{} %% %% Different categories of parameters and governors (Dubuisson p.382) %% +----------------+-------------------------------+----------------------+ %% |Governor is | Parameter name style | Parameter is | %% +----------------+-------------------------------+----------------------+ %% | absent | begins with uppercase,(bu) | a type | %% | | | | %% | a type | begins with a lowercase,(bl)| a value | %% | | | | %% | a type | begins with an uppercase | a value set | %% | | | | %% | absent | entirely in uppercase, (eu) | a class (or type) | %% | | | | %% | a class name | begins with a lowercase | an object | %% | | | | %% | a class name | begins with an uppercase | an object set | %% +----------------+-------------------------------+----------------------+ %% %% Matches each of the formal parameters to corresponding actual %% parameter, and changes format of the actual parameter according to %% above table if necessary. match_args(S,FA = [FormArg|Ft], AA = [ActArg|At], Acc) -> OldParams = S#state.parameters, case categorize_arg(S,FormArg,ActArg) of [CategorizedArg] -> match_args(S#state{parameters= [{FormArg,CategorizedArg}|OldParams]}, Ft, At, [{FormArg,CategorizedArg}|Acc]); CategorizedArgs -> match_args(S#state{parameters=CategorizedArgs++OldParams}, FA, CategorizedArgs ++ AA, Acc) end; match_args(_S,[], [], Acc) -> lists:reverse(Acc); match_args(_,_, _, _) -> throw({error,{asn1,{wrong_number_of_arguments}}}). %%%%%%%%%%%%%%%%% %% categorize_arg(S,FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg} %% categorize_arg(S,{Governor,Param},ActArg) -> case {governor_category(S, Governor),parameter_name_style(Param)} of {type,beginning_lowercase} -> %a value categorize(S, value, Governor, ActArg); {type,beginning_uppercase} -> %a value set categorize(ActArg); {{class,ClassRef},beginning_lowercase} -> categorize(S, object, ActArg, ClassRef); {{class,ClassRef},beginning_uppercase} -> categorize(S, object_set, ActArg, ClassRef) end; categorize_arg(_S, _FormalArg, ActualArg) -> %% Governor is absent -- must be a type or a class. We have already %% checked that the FormalArg begins with an uppercase letter. categorize(ActualArg). %% governor_category(S, Item) -> type | {class,#'Externaltypereference'{}} %% Determine whether Item is a type or a class. governor_category(S, #type{def=#'Externaltypereference'{}=Eref}) -> governor_category(S, Eref); governor_category(_S, #type{}) -> type; governor_category(S, #'Externaltypereference'{}=Ref) -> case get_class_def(S, Ref) of #classdef{pos=Pos,module=Mod,name=Name} -> {class,#'Externaltypereference'{pos=Pos,module=Mod,type=Name}}; none -> type end. %% parameter_name_style(Param,Data) -> Result %% gets the Parameter and the name of the Data and if it exists tells %% whether it begins with a lowercase letter or is partly or entirely %% spelled with uppercase letters. Otherwise returns undefined %% parameter_name_style(#'Externaltypereference'{}) -> beginning_uppercase; parameter_name_style(#'Externalvaluereference'{}) -> beginning_lowercase. is_lowercase(X) when X >= $A,X =< $W -> false; is_lowercase(_) -> true. %% categorize(Parameter) -> CategorizedParameter %% If Parameter has an abstract syntax of another category than %% Category, transform it to a known syntax. categorize({object,_,Type}) -> %% One example of this case is an object with a parameterized type %% having a locally defined type as parameter. Def = fun(D = #type{}) -> #typedef{name = new_reference_name("type_argument"), typespec = D#type{inlined=yes}}; ({setting,_,Eref}) when is_record(Eref,'Externaltypereference') -> Eref; (D) -> D end, [Def(X)||X<-Type]; categorize(#type{}=Def) -> [#typedef{name = new_reference_name("type_argument"), typespec = Def#type{inlined=yes}}]; categorize(Def) -> [Def]. categorize(S,object_set,Def,ClassRef) -> NewObjSetSpec = check_object(S,Def,#'ObjectSet'{class = ClassRef, set = parse_objectset(Def)}), Name = new_reference_name("object_set_argument"), [save_object_set_instance(S,Name,NewObjSetSpec)]; categorize(_S,object,Def,_ClassRef) -> %% should be handled [Def]; categorize(_S,value,_Type,Value) when is_record(Value,valuedef) -> [Value]; categorize(S,value,Type,Value) -> %% [check_value(S,#valuedef{type=Type,value=Value})]. [#valuedef{type=Type,value=Value,module=S#state.mname}]. parse_objectset({valueset,#type{def=#'Externaltypereference'{}=Ref}}) -> Ref; parse_objectset({valueset,Set}) -> Set; parse_objectset(#type{def=Ref}) when is_record(Ref,'Externaltypereference') -> Ref; parse_objectset(Set) -> %% extend this later Set. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% check_constraints/2 %% check_constraints(S, T, C) when is_list(C) -> check_constraints(S, T, C, []). resolve_tuple_or_list(S, HostType, List) when is_list(List) -> [resolve_value(S, HostType, X) || X <- List]; resolve_tuple_or_list(S, HostType, {Lb,Ub}) -> {resolve_value(S, HostType, Lb),resolve_value(S, HostType, Ub)}. %%%----------------------------------------- %% If the constraint value is a defined value the valuename %% is replaced by the actual value %% resolve_value(S, HostType, Val) -> Id = match_parameter(S, Val), resolve_value1(S, HostType, Id). resolve_value1(S, HostType, #'Externalvaluereference'{value=Name}=ERef) -> case resolve_namednumber(S, HostType, Name) of V when is_integer(V) -> V; not_named -> resolve_value1(S, HostType, get_referenced_value(S, ERef)) end; resolve_value1(S, HostType, {gt,V}) -> case resolve_value1(S, HostType, V) of Int when is_integer(Int) -> Int + 1; _Other -> asn1_error(S, illegal_integer_value) end; resolve_value1(S, HostType, {lt,V}) -> case resolve_value1(S, HostType, V) of Int when is_integer(Int) -> Int - 1; _Other -> asn1_error(S, illegal_integer_value) end; resolve_value1(S, _HostType, {'ValueFromObject',{object,Object},FieldName}) -> get_value_from_object(S, Object, FieldName); resolve_value1(_, _, #valuedef{checked=true,value=V}) -> V; resolve_value1(S, _, #valuedef{value={'ValueFromObject', {object,Object},FieldName}}) -> get_value_from_object(S, Object, FieldName); resolve_value1(S, _HostType, #valuedef{}=VDef) -> #valuedef{value=Val} = check_value(S,VDef), Val; resolve_value1(_, _, V) -> V. resolve_namednumber(S, #type{def=Def}=Type, Name) -> case Def of {'ENUMERATED',NameList} -> resolve_namednumber_1(S, Name, NameList, Type); {'INTEGER',NameList} -> resolve_namednumber_1(S, Name, NameList, Type); _ -> not_named end. resolve_namednumber_1(S, Name, NameList, Type) -> try NamedNumberList = check_enumerated(S, NameList, Type#type.constraint), {_,N} = lookup_enum_value(S, Name, NamedNumberList), N catch _:_ -> not_named end. check_constraints(S, HostType, [{'ContainedSubtype',Type}|T], Acc) -> {RefMod,CTDef} = get_referenced_type(S,Type#type.def), NewS = S#state{module=load_asn1_module(S,RefMod),mname=RefMod, type=CTDef,tname=get_datastr_name(CTDef)}, CType = check_type(NewS,S#state.tname,CTDef#typedef.typespec), check_constraints(S, HostType, T, CType#type.constraint ++ Acc); check_constraints(S, HostType, [C0|T], Acc) -> C = check_constraint(S, HostType, C0), check_constraints(S, HostType, T, [C|Acc]); check_constraints(S, _, [], Acc) -> constraint_merge(S,Acc). range_check(F={FixV,FixV}) -> % FixV; F; range_check(VR={Lb,Ub}) when Lb < Ub -> VR; range_check(Err={_,_}) -> throw({error,{asn1,{illegal_size_constraint,Err}}}); range_check(Value) -> Value. check_constraint(S, _HostType, #'Externaltypereference'{}=Ext) -> check_externaltypereference(S, Ext); check_constraint(S, HostType, {'SizeConstraint',{Lb,Ub}}) when is_list(Lb); tuple_size(Lb) =:= 2 -> NewLb = range_check(resolve_tuple_or_list(S, HostType, Lb)), NewUb = range_check(resolve_tuple_or_list(S, HostType, Ub)), {'SizeConstraint',{NewLb,NewUb}}; check_constraint(S, HostType, {'SizeConstraint',{Lb,Ub}}) -> case {resolve_value(S, HostType, Lb),resolve_value(S, HostType, Ub)} of {FixV,FixV} -> {'SizeConstraint',FixV}; {Low,High} when Low < High -> {'SizeConstraint',{Low,High}}; Err -> throw({error,{asn1,{illegal_size_constraint,Err}}}) end; check_constraint(S, HostType, {'SizeConstraint',Lb}) -> {'SizeConstraint',resolve_value(S, HostType, Lb)}; check_constraint(S, HostType, {'SingleValue', L}) when is_list(L) -> F = fun(A) -> resolve_value(S, HostType, A) end, {'SingleValue',lists:sort(lists:map(F,L))}; check_constraint(S, HostType, {'SingleValue', V}) -> {'SingleValue',resolve_value(S, HostType, V)}; check_constraint(S, HostType, {'ValueRange', {Lb, Ub}}) -> {'ValueRange',{resolve_value(S, HostType, Lb), resolve_value(S, HostType, Ub)}}; %% In case of a constraint with extension marks like (1..Ub,...) check_constraint(S, HostType, {VR={'ValueRange', {_Lb, _Ub}},Rest}) -> {check_constraint(S, HostType, VR),Rest}; check_constraint(_S, _HostType, {'PermittedAlphabet',PA}) -> {'PermittedAlphabet',permitted_alphabet_cnstr(PA)}; check_constraint(S, HostType, {valueset,Type}) -> {valueset,check_type(S, #typedef{typespec=HostType}, Type)}; check_constraint(_S, _HostType, {simpletable,Type}=ST) when is_atom(Type) -> %% An already checked constraint ST; check_constraint(S, HostType, {simpletable,Type}) -> Def = case Type of #type{def=D} -> D; {'SingleValue',ObjRef = #'Externalvaluereference'{}} -> ObjRef end, C = match_parameter(S, Def), case C of #'Externaltypereference'{} -> ERef = check_externaltypereference(S,C), {simpletable,ERef#'Externaltypereference'.type}; {valueset,#type{def=ERef=#'Externaltypereference'{}}} -> % this is an object set {_,TDef} = get_referenced_type(S,ERef), case TDef#typedef.typespec of #'ObjectSet'{} -> check_object(S,TDef,TDef#typedef.typespec), {simpletable,ERef#'Externaltypereference'.type}; Err -> exit({error,{internal_error,Err}}) end; #'Externalvaluereference'{} -> %% This is an object set with a referenced object {_,TorVDef} = get_referenced_type(S,C), GetObjectSet = fun(#typedef{typespec=O}) when is_record(O,'Object') -> #'ObjectSet'{class=O#'Object'.classname, set={'SingleValue',C}}; (#valuedef{type=Cl,value=O}) when is_record(O,'Externalvaluereference'), is_record(Cl,type) -> %% an object might reference another object #'ObjectSet'{class=Cl#type.def, set={'SingleValue',O}}; (Err) -> exit({error,{internal_error,simpletable_constraint,Err}}) end, ObjSet = GetObjectSet(TorVDef), {simpletable,check_object(S,Type,ObjSet)}; #'ObjectSet'{} -> io:format("ALERT: simpletable forbidden case!~n",[]), {simpletable,check_object(S,Type,C)}; {'ValueFromObject',{_,Object},FieldNames} -> %% This is an ObjectFromObject. {simpletable,extract_field(S, Object, FieldNames)}; _ -> check_type(S, HostType, Type),%% this seems stupid. OSName = Def#'Externaltypereference'.type, {simpletable,OSName} end; check_constraint(S, _HostType, {componentrelation,{objectset,Opos,Objset},Id}) -> %% Objset is an 'Externaltypereference' record, since Objset is %% a DefinedObjectSet. RealObjset = match_parameter(S, Objset), ObjSetRef = case RealObjset of #'Externaltypereference'{} -> RealObjset; #type{def=#'Externaltypereference'{}} -> RealObjset#type.def; {valueset,OS = #type{def=#'Externaltypereference'{}}} -> OS#type.def end, Ext = check_externaltypereference(S,ObjSetRef), {componentrelation,{objectset,Opos,Ext},Id}; check_constraint(S, HostType, #type{}=Type) -> #type{def=Def} = check_type(S, HostType, Type), Def; check_constraint(S, HostType, C) when is_list(C) -> [check_constraint(S, HostType, X) || X <- C]; %% else keep the constraint unchanged check_constraint(_S, _HostType, Any) -> Any. permitted_alphabet_cnstr(T) when is_tuple(T) -> permitted_alphabet_cnstr([T]); permitted_alphabet_cnstr(L) when is_list(L) -> VRexpand = fun({'ValueRange',{A,B}}) -> {'SingleValue',expand_valuerange(A,B)}; (Other) -> Other end, L2 = lists:map(VRexpand,L), %% first perform intersection L3 = permitted_alphabet_intersection(L2), [Res] = permitted_alphabet_union(L3), Res. expand_valuerange([A],[A]) -> [A]; expand_valuerange([A],[B]) when A < B -> [A|expand_valuerange([A+1],[B])]. permitted_alphabet_intersection(C) -> permitted_alphabet_merge(C,intersection, []). permitted_alphabet_union(C) -> permitted_alphabet_merge(C,union, []). permitted_alphabet_merge([],_,Acc) -> lists:reverse(Acc); permitted_alphabet_merge([{'SingleValue',L1}, UorI, {'SingleValue',L2}|Rest],UorI,Acc) when is_list(L1),is_list(L2) -> UI = ordsets:UorI([ordsets:from_list(L1),ordsets:from_list(L2)]), permitted_alphabet_merge([{'SingleValue',UI}|Rest],UorI,Acc); permitted_alphabet_merge([C1|Rest],UorI,Acc) -> permitted_alphabet_merge(Rest,UorI,[C1|Acc]). %% constraint_merge/2 %% Compute the intersection of the outermost level of the constraint list. %% See Dubuisson second paragraph and fotnote on page 285. %% If constraints with extension are included in combined constraints. The %% resulting combination will have the extension of the last constraint. Thus, %% there will be no extension if the last constraint is without extension. %% The rootset of all constraints are considered in the "outermoust %% intersection". See section 13.1.2 in Dubuisson. constraint_merge(St, Cs0) -> Cs = constraint_merge_1(St, Cs0), normalize_cs(Cs). normalize_cs([{'SingleValue',[V]}|Cs]) -> [{'SingleValue',V}|normalize_cs(Cs)]; normalize_cs([{'SingleValue',[_|_]=L0}|Cs]) -> [H|T] = L = lists:usort(L0), [case is_range(H, T) of false -> {'SingleValue',L}; true -> {'ValueRange',{H,lists:last(T)}} end|normalize_cs(Cs)]; normalize_cs([{'ValueRange',{Sv,Sv}}|Cs]) -> [{'SingleValue',Sv}|normalize_cs(Cs)]; normalize_cs([{'ValueRange',{'MIN','MAX'}}|Cs]) -> normalize_cs(Cs); normalize_cs([{'SizeConstraint',C0}|Cs]) -> case normalize_size_constraint(C0) of none -> normalize_cs(Cs); C -> [{'SizeConstraint',C}|normalize_cs(Cs)] end; normalize_cs([H|T]) -> [H|normalize_cs(T)]; normalize_cs([]) -> []. %% Normalize a size constraint to make it non-ambiguous and %% easy to interpret for the backends. %% %% Returns one of the following terms: %% {LowerBound,UpperBound} %% {{LowerBound,UpperBound},[]} % Extensible %% none % Remove size constraint from list %% %% where: %% LowerBound = integer() %% UpperBound = integer() | 'MAX' normalize_size_constraint(Sv) when is_integer(Sv) -> {Sv,Sv}; normalize_size_constraint({Root,Ext}) when is_list(Ext) -> {normalize_size_constraint(Root),[]}; normalize_size_constraint({{_,_},Ext}) when is_integer(Ext) -> normalize_size_constraint(Ext); normalize_size_constraint([H|T]) -> {H,lists:last(T)}; normalize_size_constraint({0,'MAX'}) -> none; normalize_size_constraint({Lb,Ub}=Range) when is_integer(Lb), is_integer(Ub) orelse Ub =:= 'MAX' -> Range. is_range(Prev, [H|T]) when Prev =:= H - 1 -> is_range(H, T); is_range(_, [_|_]) -> false; is_range(_, []) -> true. constraint_merge_1(_S, [H]=C) when is_tuple(H) -> C; constraint_merge_1(_S, []) -> []; constraint_merge_1(S, C) -> %% skip all extension but the last extension C1 = filter_extensions(C), %% perform all internal level intersections, intersections first %% since they have precedence over unions C2 = lists:map(fun(X)when is_list(X)->constraint_intersection(S,X); (X) -> X end, C1), %% perform all internal level unions C3 = lists:map(fun(X)when is_list(X)->constraint_union(S,X); (X) -> X end, C2), %% now get intersection of the outermost level %% get the least common single value constraint SVs = get_constraints(C3,'SingleValue'), CombSV = intersection_of_sv(S,SVs), %% get the least common value range constraint VRs = get_constraints(C3,'ValueRange'), CombVR = intersection_of_vr(S,VRs), %% get the least common size constraint SZs = get_constraints(C3,'SizeConstraint'), CombSZ = intersection_of_size(S,SZs), RestC = ordsets:subtract(ordsets:from_list(C3), ordsets:from_list(SZs ++ VRs ++ SVs)), %% get the least common combined constraint. That is the union of each %% deep constraint and merge of single value and value range constraints. %% FIXME: Removing 'intersection' from the flattened list essentially %% means that intersections are converted to unions! Cs = combine_constraints(S, CombSV, CombVR, CombSZ++RestC), [X || X <- lists:flatten(Cs), X =/= intersection, X =/= union]. %% constraint_union(S,C) takes a list of constraints as input and %% merge them to a union. Unions are performed when two %% constraints is found with an atom union between. %% The list may be nested. Fix that later !!! constraint_union(_S,[]) -> []; constraint_union(_S,C=[_E]) -> C; constraint_union(S,C) when is_list(C) -> case lists:member(union,C) of true -> constraint_union1(S,C,[]); _ -> C end; % SV = get_constraints(C,'SingleValue'), % SV1 = constraint_union_sv(S,SV), % VR = get_constraints(C,'ValueRange'), % VR1 = constraint_union_vr(VR), % RestC = ordsets:filter(fun({'SingleValue',_})->false; % ({'ValueRange',_})->false; % (_) -> true end,ordsets:from_list(C)), % SV1++VR1++RestC; constraint_union(_S,C) -> [C]. constraint_union1(S, [{'ValueRange',{Lb1,Ub1}},union, {'ValueRange',{Lb2,Ub2}}|Rest], Acc) -> AunionB = {'ValueRange',{c_min(Lb1, Lb2),max(Ub1, Ub2)}}, constraint_union1(S, [AunionB|Rest], Acc); constraint_union1(S,[A={'SingleValue',_},union,B={'SingleValue',_}|Rest],Acc) -> AunionB = constraint_union_sv(S,[A,B]), constraint_union1(S,Rest,Acc ++ AunionB); constraint_union1(S,[A={'SingleValue',_},union,B={'ValueRange',_}|Rest],Acc) -> AunionB = union_sv_vr(S,A,B), constraint_union1(S, AunionB++Rest, Acc); constraint_union1(S,[A={'ValueRange',_},union,B={'SingleValue',_}|Rest],Acc) -> AunionB = union_sv_vr(S,B,A), constraint_union1(S, AunionB++Rest, Acc); constraint_union1(S,[union|Rest],Acc) -> %skip when unsupported constraints constraint_union1(S,Rest,Acc); constraint_union1(S,[A|Rest],Acc) -> constraint_union1(S,Rest,[A|Acc]); constraint_union1(_S,[],Acc) -> Acc. constraint_union_sv(_S,SV) -> Values=lists:map(fun({_,V})->V end,SV), case ordsets:from_list(Values) of [] -> []; [N] -> [{'SingleValue',N}]; L -> [{'SingleValue',L}] end. c_min('MIN', _) -> 'MIN'; c_min(_, 'MIN') -> 'MIN'; c_min(A, B) -> min(A, B). union_sv_vr(_S,{'SingleValue',SV},VR) when is_integer(SV) -> union_sv_vr(_S,{'SingleValue',[SV]},VR); union_sv_vr(_S,{'SingleValue',SV},{'ValueRange',{VLb,VUb}}) when is_list(SV) -> L = lists:sort(SV++[VLb,VUb]), {Lb,L1} = case lists:member('MIN',L) of true -> {'MIN',L--['MIN']}; % remove 'MIN' so it does not disturb false -> {hd(L),tl(L)} end, Ub = case lists:member('MAX',L1) of true -> 'MAX'; false -> lists:last(L1) end, case SV of [H] -> H; _ -> SV end, %% for now we through away the Singlevalues so that they don't disturb %% in the code generating phase (the effective Valuerange is already %% calculated. If we want to keep the Singlevalues as well for %% use in code gen phases we need to introduce a new representation %% like {'ValueRange',{Lb,Ub},[ListOfRanges|AntiValues|Singlevalues] %% These could be used to generate guards which allows only the specific %% values , not the full range [{'ValueRange',{Lb,Ub}}]. %% get_constraints/2 %% Arguments are a list of constraints, which has the format {key,value}, %% and a constraint type %% Returns a list of constraints only of the requested type or the atom %% 'no' if no such constraints were found get_constraints(L=[{CType,_}],CType) -> L; get_constraints(C,CType) -> keysearch_allwithkey(CType,1,C). %% keysearch_allwithkey(Key,Ix,L) %% Types: %% Key = is_atom() %% Ix = integer() %% L = [TwoTuple] %% TwoTuple = [{atom(),term()}|...] %% Returns a List that contains all %% elements from L that has a key Key as element Ix keysearch_allwithkey(Key,Ix,L) -> lists:filter(fun(X) when is_tuple(X) -> case element(Ix,X) of Key -> true; _ -> false end; (_) -> false end, L). %% filter_extensions(C) %% takes a list of constraints as input and returns a list with the %% constraints and all extensions but the last are removed. filter_extensions([L]) when is_list(L) -> [filter_extensions(L)]; filter_extensions(C=[_H]) -> C; filter_extensions(C) when is_list(C) -> filter_extensions(C,[], []). filter_extensions([],Acc,[]) -> Acc; filter_extensions([],Acc,[EC|ExtAcc]) -> CwoExt = remove_extension(ExtAcc,[]), CwoExt ++ [EC|Acc]; filter_extensions([C={A,_E}|T],Acc,ExtAcc) when is_tuple(A) -> filter_extensions(T,Acc,[C|ExtAcc]); filter_extensions([C={'SizeConstraint',{A,_B}}|T],Acc,ExtAcc) when is_list(A);is_tuple(A) -> filter_extensions(T,Acc,[C|ExtAcc]); filter_extensions([C={'PermittedAlphabet',{{'SingleValue',_},E}}|T],Acc,ExtAcc) when is_tuple(E); is_list(E) -> filter_extensions(T,Acc,[C|ExtAcc]); filter_extensions([H|T],Acc,ExtAcc) -> filter_extensions(T,[H|Acc],ExtAcc). remove_extension([],Acc) -> Acc; remove_extension([{'SizeConstraint',{A,_B}}|R],Acc) -> remove_extension(R,[{'SizeConstraint',A}|Acc]); remove_extension([{C,_E}|R],Acc) when is_tuple(C) -> remove_extension(R,[C|Acc]); remove_extension([{'PermittedAlphabet',{A={'SingleValue',_}, E}}|R],Acc) when is_tuple(E);is_list(E) -> remove_extension(R,[{'PermittedAlphabet',A}|Acc]). %% constraint_intersection(S,C) takes a list of constraints as input and %% performs intersections. Intersecions are performed when an %% atom intersection is found between two constraints. %% The list may be nested. Fix that later !!! constraint_intersection(_S,[]) -> []; constraint_intersection(_S,C=[_E]) -> C; constraint_intersection(S,C) when is_list(C) -> % io:format("constraint_intersection: ~p~n",[C]), case lists:member(intersection,C) of true -> constraint_intersection1(S,C,[]); _ -> C end; constraint_intersection(_S,C) -> [C]. constraint_intersection1(S,[A,intersection,B|Rest],Acc) -> AisecB = c_intersect(S,A,B), constraint_intersection1(S, AisecB++Rest, Acc); constraint_intersection1(S,[A|Rest],Acc) -> constraint_intersection1(S,Rest,[A|Acc]); constraint_intersection1(_, [], [C]) -> C; constraint_intersection1(_,[],Acc) -> lists:reverse(Acc). c_intersect(S,C1={'SingleValue',_},C2={'SingleValue',_}) -> intersection_of_sv(S,[C1,C2]); c_intersect(S,C1={'ValueRange',_},C2={'ValueRange',_}) -> intersection_of_vr(S,[C1,C2]); c_intersect(S,C1={'ValueRange',_},C2={'SingleValue',_}) -> intersection_sv_vr(S,[C2],[C1]); c_intersect(S,C1={'SingleValue',_},C2={'ValueRange',_}) -> intersection_sv_vr(S,[C1],[C2]); c_intersect(_S,C1,C2) -> [C1,C2]. %% combine_constraints(S,SV,VR,CComb) %% Types: %% S = is_record(state,S) %% SV = [] | [SVC] %% VR = [] | [VRC] %% CComb = [] | [Lists] %% SVC = {'SingleValue',integer()} | {'SingleValue',[integer(),...]} %% VRC = {'ValueRange',{Lb,Ub}} %% Lists = List of lists containing any constraint combination %% Lb = 'MIN' | integer() %% Ub = 'MAX' | integer() %% Returns a combination of the least common constraint among SV,VR and all %% elements in CComb combine_constraints(_S,[],VR,CComb) -> VR ++ CComb; % combine_combined_cnstr(S,VR,CComb); combine_constraints(_S,SV,[],CComb) -> SV ++ CComb; % combine_combined_cnstr(S,SV,CComb); combine_constraints(S,SV,VR,CComb) -> C=intersection_sv_vr(S,SV,VR), C ++ CComb. % combine_combined_cnstr(S,C,CComb). intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}]) when is_integer(SV) -> case is_int_in_vr(SV,C2) of true -> [C1]; _ -> %%error({type,{"asn1 illegal constraint",C1,C2},S}) %throw({error,{"asn1 illegal constraint",C1,C2}}) %io:format("warning: could not analyze constraint ~p~n",[[C1,C2]]), [C1,C2] end; intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2]) when is_list(SV) -> case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of [] -> %%error({type,{"asn1 illegal constraint",C1,C2},S}); %throw({error,{"asn1 illegal constraint",C1,C2}}); %io:format("warning: could not analyze constraint ~p~n",[[C1,C2]]), [C1,C2]; [V] -> [{'SingleValue',V}]; L -> [{'SingleValue',L}] end. %% Size constraint [{'SizeConstraint',1},{'SizeConstraint',{{1,64},[]}}] intersection_of_size(_,[]) -> []; intersection_of_size(_,C=[_SZ]) -> C; intersection_of_size(S,[SZ,SZ|Rest]) -> intersection_of_size(S,[SZ|Rest]); intersection_of_size(S,C=[C1={_,Int},{_,Range}|Rest]) when is_integer(Int),is_tuple(Range) -> case Range of {Lb,Ub} when Int >= Lb, Int =< Ub -> intersection_of_size(S,[C1|Rest]); {{Lb,Ub},Ext} when is_list(Ext),Int >= Lb,Int =< Ub -> intersection_of_size(S,[C1|Rest]); _ -> throw({error,{asn1,{illegal_size_constraint,C}}}) end; intersection_of_size(S,[C1={_,Range},C2={_,Int}|Rest]) when is_integer(Int),is_tuple(Range) -> intersection_of_size(S,[C2,C1|Rest]); intersection_of_size(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) -> Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])), Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])), intersection_of_size(S,[{'SizeConstraint',{Lb,Ub}}|Rest]); intersection_of_size(_,SZ) -> throw({error,{asn1,{illegal_size_constraint,SZ}}}). intersection_of_vr(_,[]) -> []; intersection_of_vr(_,VR=[_C]) -> VR; intersection_of_vr(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) -> Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])), Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])), intersection_of_vr(S,[{'ValueRange',{Lb,Ub}}|Rest]); intersection_of_vr(_S,VR) -> %%error({type,{asn1,{illegal_value_range_constraint,VR}},S}); throw({error,{asn1,{illegal_value_range_constraint,VR}}}). intersection_of_sv(_,[]) -> []; intersection_of_sv(_,SV=[_C]) -> SV; intersection_of_sv(S,[SV,SV|Rest]) -> intersection_of_sv(S,[SV|Rest]); intersection_of_sv(S,[{_,Int},{_,SV}|Rest]) when is_integer(Int), is_list(SV) -> SV2=intersection_of_sv1(S,Int,SV), intersection_of_sv(S,[SV2|Rest]); intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when is_integer(Int), is_list(SV) -> SV2=intersection_of_sv1(S,Int,SV), intersection_of_sv(S,[SV2|Rest]); intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when is_list(SV1), is_list(SV2) -> SV3=common_set(SV1,SV2), intersection_of_sv(S,[SV3|Rest]); intersection_of_sv(_S,SV) -> %%error({type,{asn1,{illegal_single_value_constraint,SV}},S}). throw({error,{asn1,{illegal_single_value_constraint,SV}}}). intersection_of_sv1(_S,Int,SV) when is_integer(Int),is_list(SV) -> case lists:member(Int,SV) of true -> {'SingleValue',Int}; _ -> %%error({type,{asn1,{illegal_single_value_constraint,Int,SV}},S}) throw({error,{asn1,{illegal_single_value_constraint,Int,SV}}}) end; intersection_of_sv1(_S,SV1,SV2) -> %%error({type,{asn1,{illegal_single_value_constraint,SV1,SV2}},S}). throw({error,{asn1,{illegal_single_value_constraint,SV1,SV2}}}). greatest_LB([H]) -> H; greatest_LB(L) -> greatest_LB1(lists:reverse(L)). greatest_LB1(['MIN',H2|_T])-> H2; greatest_LB1([H|_T]) -> H. smallest_UB(L) -> hd(L). common_set(SV1,SV2) -> lists:filter(fun(X)->lists:member(X,SV1) end,SV2). is_int_in_vr(Int,{_,{'MIN','MAX'}}) when is_integer(Int) -> true; is_int_in_vr(Int,{_,{'MIN',Ub}}) when is_integer(Int),Int =< Ub -> true; is_int_in_vr(Int,{_,{Lb,'MAX'}}) when is_integer(Int),Int >= Lb -> true; is_int_in_vr(Int,{_,{Lb,Ub}}) when is_integer(Int),Int >= Lb,Int =< Ub -> true; is_int_in_vr(_,_) -> false. check_imported(S,Imodule,Name) -> check_imported(S,Imodule,Name,false). check_imported(S,Imodule,Name,IsParsed) -> case asn1_db:dbget(Imodule,'MODULE') of undefined when IsParsed == true -> ErrStr = io_lib:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]), error({imported,ErrStr,S}); undefined -> parse_and_save(S,Imodule), check_imported(S,Imodule,Name,true); Im when is_record(Im,module) -> case is_exported(Im,Name) of false -> ErrStr = io_lib:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]), error({imported,ErrStr,S}); _ -> ok end end, ok. is_exported(Module,Name) when is_record(Module,module) -> {exports,Exports} = Module#module.exports, case Exports of all -> true; [] -> false; L when is_list(L) -> case lists:keysearch(Name,#'Externaltypereference'.type,Exports) of false -> false; _ -> true end end. check_externaltypereference(S,Etref=#'Externaltypereference'{module=Emod})-> Currmod = S#state.mname, MergedMods = S#state.inputmodules, case Emod of Currmod -> %% reference to current module or to imported reference check_reference(S,Etref); _ -> %% io:format("Type ~s IMPORTED FROM ~s~n",[Etype,Emod]), case lists:member(Emod,MergedMods) of true -> check_reference(S,Etref); false -> {NewMod,_} = get_referenced_type(S,Etref), Etref#'Externaltypereference'{module=NewMod} end end. check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) -> ModName = S#state.mname, case asn1_db:dbget(ModName,Name) of undefined -> case imported(S,Name) of {ok,Imodule} -> check_imported(S,Imodule,Name), #'Externaltypereference'{module=Imodule,type=Name}; %% case check_imported(S,Imodule,Name) of %% ok -> %% #'Externaltypereference'{module=Imodule,type=Name}; %% Err -> %% Err %% end; _ -> %may be a renamed type in multi file compiling! {M,T}=get_renamed_reference(S,Name,Emod), NewName = asn1ct:get_name_of_def(T), NewPos = asn1ct:get_pos_of_def(T), #'Externaltypereference'{pos=NewPos, module=M, type=NewName} end; _ -> %% cannot do check_type here due to recursive definitions, like %% S ::= SEQUENCE {a INTEGER, b S}. This implies that references %% that appear before the definition will be an %% Externaltypereference in the abstract syntax tree #'Externaltypereference'{pos=Pos,module=ModName,type=Name} end. get_referenced_value(S, T) -> case get_referenced_type(S, T) of {ExtMod,#valuedef{value=#'Externalvaluereference'{}=Ref}} -> get_referenced_value(update_state(S, ExtMod), Ref); {_,#valuedef{value=Val}} -> Val end. get_referenced_type(S, T) -> get_referenced_type(S, T, false). get_referenced_type(S, T, Recurse) -> case do_get_referenced_type(S, T) of {_,#typedef{typespec=#type{def=#'Externaltypereference'{}=ERef}}} when Recurse -> get_referenced_type(S, ERef, Recurse); {_,_}=Res -> Res end. do_get_referenced_type(S, T0) -> case match_parameter(S, T0) of T0 -> do_get_ref_type_1(S, T0); T -> do_get_referenced_type(S, T) end. do_get_ref_type_1(S, #'Externaltypereference'{pos=P, module=M, type=T}) -> do_get_ref_type_2(S, P, M, T); do_get_ref_type_1(S, #'Externalvaluereference'{pos=P, module=M, value=V}) -> do_get_ref_type_2(S, P, M, V); do_get_ref_type_1(_, T) -> {undefined,T}. do_get_ref_type_2(#state{mname=Current,inputmodules=Modules}=S, Pos, M, T) -> case M =:= Current orelse lists:member(M, Modules) of true -> get_referenced1(S, M, T, Pos); false -> get_referenced(S, M, T, Pos) end. %% get_referenced/3 %% The referenced entity Ename may in case of an imported parameterized %% type reference imported entities in the other module, which implies that %% asn1_db:dbget will fail even though the referenced entity exists. Thus %% Emod may be the module that imports the entity Ename and not holds the %% data about Ename. get_referenced(S,Emod,Ename,Pos) -> ?dbg("get_referenced: ~p~n",[Ename]), parse_and_save(S,Emod), ?dbg("get_referenced,parse_and_save ~n",[]), case asn1_db:dbget(Emod,Ename) of undefined -> %% May be an imported entity in module Emod or Emod may not exist case asn1_db:dbget(Emod,'MODULE') of undefined -> throw({error,{asn1,{module_not_found,Emod}}}); _ -> NewS = update_state(S,Emod), get_imported(NewS,Ename,Emod,Pos) end; T when is_record(T,typedef) -> ?dbg("get_referenced T: ~p~n",[T]), {Emod,T}; % should add check that T is exported here V -> ?dbg("get_referenced V: ~p~n",[V]), {Emod,V} end. get_referenced1(S,ModuleName,Name,Pos) -> case asn1_db:dbget(S#state.mname,Name) of undefined -> %% ModuleName may be other than S#state.mname when %% multi file compiling is used. get_imported(S,Name,ModuleName,Pos); T -> {S#state.mname,T} end. get_imported(S,Name,Module,Pos) -> ?dbg("get_imported, Module: ~p, Name: ~p~n",[Module,Name]), case imported(S,Name) of {ok,Imodule} -> parse_and_save(S,Imodule), case asn1_db:dbget(Imodule,'MODULE') of undefined -> throw({error,{asn1,{module_not_found,Imodule}}}); Im when is_record(Im,module) -> case is_exported(Im,Name) of false -> throw({error, {asn1,{not_exported,{Im,Name}}}}); _ -> ?dbg("get_imported, is_exported ~p, ~p~n",[Imodule,Name]), get_referenced_type(S, #'Externaltypereference' {module=Imodule, type=Name,pos=Pos}) end end; _ -> get_renamed_reference(S,Name,Module) end. save_object_set_instance(S,Name,ObjSetSpec) when is_record(ObjSetSpec,'ObjectSet') -> NewObjSet = #typedef{checked=true,name=Name,typespec=ObjSetSpec}, asn1_db:dbput(S#state.mname,Name,NewObjSet), case ObjSetSpec of #'ObjectSet'{uniquefname={unique,undefined}} -> ok; _ -> %% Should be generated iff %% ObjSpec#'ObjectSet'.uniquefname /= {unique,undefined} ObjSetKey = {Name,objectset,NewObjSet}, %% asn1ct_gen:insert_once(parameterized_objects,ObjSetKey) insert_once(S,parameterized_objects,ObjSetKey) end, #'Externaltypereference'{module=S#state.mname,type=Name}. %% load_asn1_module do not check that the module is saved. %% If get_referenced_type is called before the module must %% be saved. load_asn1_module(#state{mname=M,module=Mod},M)-> Mod; load_asn1_module(_,M) -> asn1_db:dbget(M,'MODULE'). parse_and_save(S,Module) when is_record(S,state) -> Erule = S#state.erule, case asn1db_member(S,Erule,Module) of true -> ok; _ -> case asn1ct:parse_and_save(Module,S) of ok -> save_asn1db_uptodate(S,Erule,Module); Err -> Err end end. asn1db_member(S,Erule,Module) -> Asn1dbUTL = get_asn1db_uptodate(S), lists:member({Erule,Module},Asn1dbUTL). save_asn1db_uptodate(S,Erule,Module) -> Asn1dbUTL = get_asn1db_uptodate(S), Asn1dbUTL2 = lists:keydelete(Module,2,Asn1dbUTL), put_asn1db_uptodate([{Erule,Module}|Asn1dbUTL2]). get_asn1db_uptodate(S) -> case get(asn1db_uptodate) of undefined -> [{S#state.erule,S#state.mname}]; %initialize L -> L end. put_asn1db_uptodate(L) -> put(asn1db_uptodate,L). update_state(S,undefined) -> S; update_state(S=#state{mname=ModuleName},ModuleName) -> S; update_state(S,ModuleName) -> case lists:member(ModuleName,S#state.inputmodules) of true -> S; _ -> parse_and_save(S,ModuleName), case asn1_db:dbget(ModuleName,'MODULE') of RefedMod when is_record(RefedMod,module) -> S#state{mname=ModuleName,module=RefedMod}; _ -> throw({error,{asn1,{module_does_not_exist,ModuleName}}}) end end. get_renamed_reference(S,Name,Module) -> case renamed_reference(S,Name,Module) of undefined -> throw({error,{asn1,{undefined_type,Name}}}); NewTypeName when NewTypeName =/= Name -> get_referenced1(S,Module,NewTypeName,undefined) end. renamed_reference(S,#'Externaltypereference'{type=Name,module=Module}) -> case renamed_reference(S,Name,Module) of undefined -> Name; Other -> Other end. renamed_reference(S,Name,Module) -> %% first check if there is a renamed type in this module %% second check if any type was imported with this name case asn1ct_table:exists(renamed_defs) of false -> undefined; true -> case asn1ct_table:match(renamed_defs, {'$1',Name,Module}) of [] -> case asn1ct_table:exists(original_imports) of false -> undefined; true -> case asn1ct_table:match(original_imports, {Module,'$1'}) of [] -> undefined; [[ImportsList]] -> case get_importmoduleoftype(ImportsList,Name) of undefined -> undefined; NextMod -> renamed_reference(S,Name,NextMod) end end end; [[NewTypeName]] -> NewTypeName end end. get_importmoduleoftype([I|Is],Name) -> Index = #'Externaltypereference'.type, case lists:keysearch(Name,Index,I#'SymbolsFromModule'.symbols) of {value,_Ref} -> (I#'SymbolsFromModule'.module)#'Externaltypereference'.type; _ -> get_importmoduleoftype(Is,Name) end; get_importmoduleoftype([],_) -> undefined. match_parameters(S, Names) -> [match_parameter(S, Name) || Name <- Names]. match_parameter(#state{parameters=Ps}=S, Name) -> match_parameter(S, Name, Ps). match_parameter(_S, Name, []) -> Name; match_parameter(_S, #'Externaltypereference'{type=Name}, [{#'Externaltypereference'{type=Name},NewName}|_T]) -> NewName; match_parameter(_S, #'Externaltypereference'{type=Name}, [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> NewName; match_parameter(_S, #'Externalvaluereference'{value=Name}, [{#'Externalvaluereference'{value=Name},NewName}|_T]) -> NewName; match_parameter(_S, #'Externalvaluereference'{value=Name}, [{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) -> NewName; match_parameter(_S, #type{def=#'Externaltypereference'{module=M,type=Name}}, [{#'Externaltypereference'{module=M,type=Name},Type}]) -> Type; match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, [{{_,#'Externaltypereference'{type=Name}}, {valueset,#type{def=NewName}}}|_T]) -> NewName; match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, [{{_,#'Externaltypereference'{type=Name}}, NewName=#type{def=#'Externaltypereference'{}}}|_T]) -> NewName#type.def; match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> NewName; %% When a parameter is a parameterized element it has to be %% instantiated now! match_parameter(S, {valueset,T=#type{def={pt,_,_Args}}}, _Ps) -> case catch check_type(S,#typedef{name=S#state.tname,typespec=T},T) of pobjectsetdef -> {_,ObjRef,_Params} = T#type.def, {_,ObjDef}=get_referenced_type(S,ObjRef), %%ObjDef is a pvaluesetdef where the type field holds the class ClassRef = case ObjDef of #pvaluesetdef{type=TDef} -> TDef#type.def; #pobjectsetdef{class=ClRef} -> ClRef end, %% The reference may not have the home module of the class {HomeMod,_} = get_referenced_type(S,ClassRef), RightClassRef = ClassRef#'Externaltypereference'{module=HomeMod}, ObjectSet = #'ObjectSet'{class=RightClassRef,set=T}, ObjSpec = check_object(S,#typedef{typespec=ObjectSet},ObjectSet), Name = list_to_atom(asn1ct_gen:list2name([get_datastr_name(ObjDef)|S#state.recordtopname])), save_object_set_instance(S,Name,ObjSpec); pvaluesetdef -> error({pvaluesetdef,"parameterized valueset",S}); {error,_Reason} -> error({type,"error in parameter",S}); Ts when is_record(Ts,type) -> Ts#type.def end; %% same as previous, only depends on order of parsing match_parameter(S, {valueset,{pos,{objectset,_,POSref},Args}}, Ps) -> match_parameter(S, {valueset,#type{def={pt,POSref,Args}}}, Ps); match_parameter(S, Name, [_H|T]) -> %%io:format("match_parameter(~p,~p)~n",[Name,[H|T]]), match_parameter(S, Name, T). imported(S,Name) -> {imports,Ilist} = (S#state.module)#module.imports, imported1(Name,Ilist). imported1(Name, [#'SymbolsFromModule'{symbols=Symlist, module=#'Externaltypereference'{type=ModuleName}}|T]) -> case lists:keysearch(Name,#'Externaltypereference'.type,Symlist) of {value,_V} -> {ok,ModuleName}; _ -> imported1(Name,T) end; imported1(_Name,[]) -> false. %% Check the named number list for an INTEGER or a BIT STRING. check_named_number_list(_S, []) -> []; check_named_number_list(_S, [{_,_}|_]=NNL) -> %% The named number list has already been checked. NNL; check_named_number_list(S, NNL0) -> %% Check that the names are unique. case check_unique(NNL0, 2) of [] -> NNL1 = [{Id,resolve_valueref(S, Val)} || {'NamedNumber',Id,Val} <- NNL0], NNL = lists:keysort(2, NNL1), case check_unique(NNL, 2) of [] -> NNL; [Val|_] -> asn1_error(S, {value_reused,Val}) end; [H|_] -> asn1_error(S, {namelist_redefinition,H}) end. resolve_valueref(S, #'Externalvaluereference'{module=Mod,value=Name}) -> dbget_ex(S, Mod, Name); resolve_valueref(_, Val) when is_integer(Val) -> Val. check_integer(S, NNL) -> check_named_number_list(S, NNL). check_bitstring(S, NNL0) -> NNL = check_named_number_list(S, NNL0), _ = [asn1_error(S, {invalid_bit_number,Bit}) || {_,Bit} <- NNL, Bit < 0], NNL. check_real(_S,_Constr) -> ok. %% Check INSTANCE OF %% check that DefinedObjectClass is of TYPE-IDENTIFIER class %% If Constraint is empty make it the general INSTANCE OF type %% If Constraint is not empty make an inlined type %% convert INSTANCE OF to the associated type check_instance_of(S,DefinedObjectClass,Constraint) -> check_type_identifier(S,DefinedObjectClass), iof_associated_type(S,Constraint). check_type_identifier(S, Eref=#'Externaltypereference'{type=Class}) -> case get_referenced_type(S, Eref) of {_,#classdef{name='TYPE-IDENTIFIER'}} -> ok; {_,#classdef{typespec=#'Externaltypereference'{}=NextEref}} -> check_type_identifier(S, NextEref); {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> check_type_identifier(S, (TD#typedef.typespec)#type.def); _ -> asn1_error(S, {illegal_instance_of,Class}) end. iof_associated_type(S,[]) -> %% in this case encode/decode functions for INSTANCE OF must be %% generated case get(instance_of) of undefined -> AssociateSeq = iof_associated_type1(S,[]), Tag = [?TAG_CONSTRUCTED(?N_INSTANCE_OF)], TypeDef=#typedef{checked=true, name='INSTANCE OF', typespec=#type{tag=Tag, def=AssociateSeq}}, asn1_db:dbput(S#state.mname,'INSTANCE OF',TypeDef), instance_of_decl(S#state.mname); %% put(instance_of,{generate,S#state.mname}); _ -> instance_of_decl(S#state.mname), ok end, #'Externaltypereference'{module=S#state.mname,type='INSTANCE OF'}; iof_associated_type(S,C) -> iof_associated_type1(S,C). iof_associated_type1(S,C) -> {TableCInf,Comp1Cnstr,Comp2Cnstr,Comp2tablecinf}= instance_of_constraints(S,C), ModuleName = S#state.mname, Typefield_type= case C of [] -> 'ASN1_OPEN_TYPE'; _ -> {typefield,'Type'} end, ObjIdTag = [{'UNIVERSAL',8}], C1TypeTag = [#tag{class='UNIVERSAL', number=6, type='IMPLICIT', form=0}], TypeIdentifierRef=#'Externaltypereference'{module=ModuleName, type='TYPE-IDENTIFIER'}, ObjectIdentifier = #'ObjectClassFieldType'{classname=TypeIdentifierRef, class=[], %% fieldname=[{valuefieldreference,id}], fieldname={id,[]}, type={fixedtypevaluefield,id, #type{def='OBJECT IDENTIFIER'}}}, Typefield = #'ObjectClassFieldType'{classname=TypeIdentifierRef, class=[], %% fieldname=[{typefieldreference,'Type'}], fieldname={'Type',[]}, type=Typefield_type}, IOFComponents = [#'ComponentType'{name='type-id', typespec=#type{tag=C1TypeTag, def=ObjectIdentifier, constraint=Comp1Cnstr}, prop=mandatory, tags=ObjIdTag}, #'ComponentType'{name=value, typespec=#type{tag=[#tag{class='CONTEXT', number=0, type='EXPLICIT', form=32}], def=Typefield, constraint=Comp2Cnstr, tablecinf=Comp2tablecinf}, prop=mandatory, tags=[{'CONTEXT',0}]}], #'SEQUENCE'{tablecinf=TableCInf, components=simplify_comps(IOFComponents)}. %% returns the leading attribute, the constraint of the components and %% the tablecinf value for the second component. instance_of_constraints(S, Constr) -> case lists:keyfind(simpletable, 1, Constr) of false -> {false,[],[],[]}; {simpletable,Type} -> instance_of_constraints_1(S, Type) end. instance_of_constraints_1(S, Type) -> #type{def=#'Externaltypereference'{type=Name}} = Type, ModuleName = S#state.mname, ObjectSetRef=#'Externaltypereference'{module=ModuleName, type=Name}, CRel=[{componentrelation,{objectset, undefined, %% pos ObjectSetRef}, [{innermost, [#'Externalvaluereference'{module=ModuleName, value=type}]}]}], Mod = S#state.mname, TableCInf=#simpletableattributes{objectsetname={Mod,Name}, c_name='type-id', c_index=1, usedclassfield=id, uniqueclassfield=id, valueindex=[]}, {TableCInf,[{simpletable,Name}],CRel,[{objfun,ObjectSetRef}]}. %% Check ENUMERATED %% **************************************** %% Check that all values are unique %% assign values to un-numbered identifiers %% check that the constraints are allowed and correct %% put the updated info back into database check_enumerated(_S,[{Name,Number}|_Rest]= NNList,_Constr) when is_atom(Name), is_integer(Number)-> %% already checked , just return the same list NNList; check_enumerated(_S,{[{Name,Number}|_Rest],L}= NNList,_Constr) when is_atom(Name), is_integer(Number), is_list(L)-> %% already checked , contains extension marker, just return the same lists NNList; check_enumerated(S,NamedNumberList,_Constr) -> check_enum(S,NamedNumberList,[],[],[]). %% identifiers are put in Acc2 %% returns either [{Name,Number}] or {[{Name,Number}],[{ExtName,ExtNumber}]} %% the latter is returned if the ENUMERATION contains EXTENSIONMARK check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2,Root) when is_integer(Num) -> check_enum(S,T,[{Id,Num}|Acc1],Acc2,Root); check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2,_Root) -> NewAcc2 = lists:keysort(2,Acc1), NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[],[]), { NewList, check_enum(S,T,[],[],enum_counts(NewList))}; check_enum(S,[Id|T],Acc1,Acc2,Root) when is_atom(Id) -> check_enum(S,T,Acc1,[Id|Acc2],Root); check_enum(_S,[],Acc1,Acc2,Root) -> NewAcc2 = lists:keysort(2,Acc1), enum_number(lists:reverse(Acc2),NewAcc2,0,[],Root). % assign numbers to identifiers , numbers from 0 ... but must not % be the same as already assigned to NamedNumbers enum_number(Identifiers,NamedNumbers,Cnt,Acc,[]) -> enum_number(Identifiers,NamedNumbers,Cnt,Acc); enum_number(Identifiers,NamedNumbers,_Cnt,Acc,CountL) -> enum_extnumber(Identifiers,NamedNumbers,Acc,CountL). enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num > Cnt -> enum_number(T,[{Id,Num}|T2],Cnt+1,[{H,Cnt}|Acc]); enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num < Cnt -> % negative Num enum_number(T,T2,Cnt+1,[{H,Cnt},{Id,Num}|Acc]); enum_number([],L2,_Cnt,Acc) -> lists:append([lists:reverse(Acc),L2]); enum_number(L,[{Id,Num}|T2],Cnt,Acc) -> % Num == Cnt enum_number(L,T2,Cnt+1,[{Id,Num}|Acc]); enum_number([H|T],[],Cnt,Acc) -> enum_number(T,[],Cnt+1,[{H,Cnt}|Acc]). enum_extnumber(Identifiers,NamedNumbers,Acc,[C]) -> check_add_enum_numbers(NamedNumbers,[C]), enum_number(Identifiers,NamedNumbers,C,Acc); enum_extnumber([H|T],[{Id,Num}|T2],Acc,[C|Counts]) when Num > C -> enum_extnumber(T,[{Id,Num}|T2],[{H,C}|Acc],Counts); enum_extnumber([],L2,Acc,Cnt) -> check_add_enum_numbers(L2, Cnt), lists:concat([lists:reverse(Acc),L2]); enum_extnumber(_Identifiers,[{Id,Num}|_T2],_Acc,[C|_]) when Num < C -> %% enum_extnumber(Identifiers,T2,[{Id,Num}|Acc],Counts); exit({error,{asn1,"AdditionalEnumeration element with same number as root element",{Id,Num}}}); enum_extnumber(Identifiers,[{Id,Num}|T2],Acc,[_C|Counts]) -> % Num =:= C enum_extnumber(Identifiers,T2,[{Id,Num}|Acc],Counts); enum_extnumber([H|T],[],Acc,[C|Counts]) -> enum_extnumber(T,[],[{H,C}|Acc],Counts). enum_counts([]) -> [0]; enum_counts(L) -> Used=[I||{_,I}<-L], AddEnumLb = lists:max(Used) + 1, lists:foldl(fun(El,AccIn)->lists:delete(El,AccIn) end, lists:seq(0,AddEnumLb), Used). check_add_enum_numbers(L, Cnt) -> Max = lists:max(Cnt), Fun = fun({_,N}=El) when N < Max -> case lists:member(N,Cnt) of false -> exit({error,{asn1,"AdditionalEnumeration element with same number as root element",El}}); _ -> ok end; (_) -> ok end, lists:foreach(Fun,L). check_boolean(_S,_Constr) -> ok. check_octetstring(_S,_Constr) -> ok. % check all aspects of a SEQUENCE % - that all component names are unique % - that all TAGS are ok (when TAG default is applied) % - that each component is of a valid type % - that the extension marks are valid check_sequence(S,Type,Comps) -> Components = expand_components(S,Comps), case check_unique([C||C <- Components ,is_record(C,'ComponentType')] ,#'ComponentType'.name) of [] -> %% sort_canonical(Components), Components2 = maybe_automatic_tags(S,Components), %% check the table constraints from here. The outermost type %% is Type, the innermost is Comps (the list of components) NewComps = check_each_component2(S,Type,Components2), check_unique_sequence_tags(S,NewComps), %% CRelInf is the "leading attribute" information %% necessary for code generating of the look up in the %% object set table, %% i.e. getenc_ObjectSet/getdec_ObjectSet. %% {objfun,ERef} tuple added in NewComps2 in tablecinf %% field in type record of component relation constrained %% type {CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps), %% CompListWithTblInf has got a lot unecessary info about %% the involved class removed, as the class of the object %% set. CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2), NewComps3 = textual_order(CompListWithTblInf), NewComps4 = simplify_comps(NewComps3), CompListTuple = complist_as_tuple(NewComps4), {CRelInf,CompListTuple}; Dupl -> throw({error,{asn1,{duplicate_components,Dupl}}}) end. complist_as_tuple(CompList) -> complist_as_tuple(CompList, [], [], [], root). complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, root) -> complist_as_tuple(T, Acc, Ext, Acc2, ext); complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, ext) -> complist_as_tuple(T, Acc, Ext, Acc2, root2); complist_as_tuple([#'EXTENSIONMARK'{}|_T], _Acc, _Ext, _Acc2, root2) -> throw({error,{asn1,{too_many_extension_marks}}}); complist_as_tuple([C|T], Acc, Ext, Acc2, root) -> complist_as_tuple(T, [C|Acc], Ext, Acc2, root); complist_as_tuple([C|T], Acc, Ext, Acc2, ext) -> complist_as_tuple(T, Acc, [C|Ext], Acc2, ext); complist_as_tuple([C|T], Acc, Ext, Acc2, root2) -> complist_as_tuple(T, Acc, Ext, [C|Acc2], root2); complist_as_tuple([], Acc, _Ext, _Acc2, root) -> lists:reverse(Acc); complist_as_tuple([], Acc, Ext, _Acc2, ext) -> {lists:reverse(Acc),lists:reverse(Ext)}; complist_as_tuple([], Acc, Ext, Acc2, root2) -> {lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}. expand_components(S, [{'COMPONENTS OF',Type}|T]) -> CompList = expand_components2(S,get_referenced_type(S,Type#type.def)), expand_components(S,CompList) ++ expand_components(S,T); expand_components(S,[H|T]) -> [H|expand_components(S,T)]; expand_components(_,[]) -> []. expand_components2(_S,{_,#typedef{typespec=#type{def=Seq}}}) when is_record(Seq,'SEQUENCE') -> case Seq#'SEQUENCE'.components of {R1,_Ext,R2} -> R1 ++ R2; {Root,_Ext} -> Root; Root -> take_only_rootset(Root) end; expand_components2(_S,{_,#typedef{typespec=#type{def=Set}}}) when is_record(Set,'SET') -> case Set#'SET'.components of {R1,_Ext,R2} -> R1 ++ R2; {Root,_Ext} -> Root; Root -> take_only_rootset(Root) end; expand_components2(_S,{_,#typedef{typespec=RefType=#type{def=#'Externaltypereference'{}}}}) -> [{'COMPONENTS OF',RefType}]; expand_components2(S,{_,PT={pt,_,_}}) -> PTType = check_type(S,PT,#type{def=PT}), expand_components2(S,{dummy,#typedef{typespec=PTType}}); expand_components2(S,{_,OCFT = #'ObjectClassFieldType'{}}) -> UncheckedType = #type{def=OCFT}, Type = check_type(S,#typedef{typespec=UncheckedType},UncheckedType), expand_components2(S, {undefined,ocft_def(Type)}); expand_components2(S,{_,ERef}) when is_record(ERef,'Externaltypereference') -> expand_components2(S,get_referenced_type(S,ERef)); expand_components2(_S,Err) -> throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}}). take_only_rootset([])-> []; take_only_rootset([#'EXTENSIONMARK'{}|_T])-> []; take_only_rootset([H|T]) -> [H|take_only_rootset(T)]. check_unique_sequence_tags(S,CompList) -> TagComps = case complist_as_tuple(CompList) of {R1,Ext,R2} -> R1 ++ [C#'ComponentType'{prop='OPTIONAL'}|| C = #'ComponentType'{} <- Ext]++R2; {R1,Ext} -> R1 ++ [C#'ComponentType'{prop='OPTIONAL'}|| C = #'ComponentType'{} <- Ext]; _ -> CompList end, check_unique_sequence_tags0(S,TagComps). check_unique_sequence_tags0(S,[#'ComponentType'{prop=mandatory}|Rest]) -> check_unique_sequence_tags0(S,Rest); check_unique_sequence_tags0(S,[C=#'ComponentType'{}|Rest]) -> check_unique_sequence_tags1(S,Rest,[C]);% optional or default check_unique_sequence_tags0(S,[_ExtensionMarker|Rest]) -> check_unique_sequence_tags0(S,Rest); check_unique_sequence_tags0(_S,[]) -> true. check_unique_sequence_tags1(S,[C|Rest],Acc) when is_record(C,'ComponentType') -> case C#'ComponentType'.prop of mandatory -> check_unique_tags(S,lists:reverse([C|Acc])), check_unique_sequence_tags(S,Rest); _ -> check_unique_sequence_tags1(S,Rest,[C|Acc]) % default or optional end; check_unique_sequence_tags1(S,[H|Rest],Acc) -> check_unique_sequence_tags1(S,Rest,[H|Acc]); check_unique_sequence_tags1(S,[],Acc) -> check_unique_tags(S,lists:reverse(Acc)). check_sequenceof(S,Type,Component) when is_record(Component,type) -> simplify_type(check_type(S, Type, Component)). check_set(S,Type,Components) -> {TableCInf,NewComponents} = check_sequence(S,Type,Components), check_distinct_tags(NewComponents,[]), case {lists:member(der,S#state.options),S#state.erule} of {true,_} -> {Sorted,SortedComponents} = sort_components(der,S,NewComponents), {Sorted,TableCInf,SortedComponents}; {_,PER} when PER =:= per; PER =:= uper -> {Sorted,SortedComponents} = sort_components(per,S,NewComponents), {Sorted,TableCInf,SortedComponents}; _ -> {false,TableCInf,NewComponents} end. %% check that all tags are distinct according to X.680 26.3 check_distinct_tags({C1,C2,C3},Acc) when is_list(C1),is_list(C2),is_list(C3) -> check_distinct_tags(C1++C2++C3,Acc); check_distinct_tags({C1,C2},Acc) when is_list(C1),is_list(C2) -> check_distinct_tags(C1++C2,Acc); check_distinct_tags([#'ComponentType'{tags=[T]}|Cs],Acc) -> check_distinct(T,Acc), check_distinct_tags(Cs,[T|Acc]); check_distinct_tags([C=#'ComponentType'{tags=[T|Ts]}|Cs],Acc) -> check_distinct(T,Acc), check_distinct_tags([C#'ComponentType'{tags=Ts}|Cs],[T|Acc]); check_distinct_tags([#'ComponentType'{tags=[]}|_Cs],_Acc) -> throw({error,"Not distinct tags in SET"}); check_distinct_tags([],_) -> ok. check_distinct(T,Acc) -> case lists:member(T,Acc) of true -> throw({error,"Not distinct tags in SET"}); _ -> ok end. %% sorting in canonical order according to X.680 8.6, X.691 9.2 %% DER: all components shall be sorted in canonical order. %% PER: only root components shall be sorted in canonical order. The %% extension components shall remain in textual order. %% sort_components(der,S=#state{tname=TypeName},Components) -> {R1,Ext,R2} = extension(textual_order(Components)), CompsList = case Ext of noext -> R1; _ -> R1 ++ Ext ++ R2 end, case {untagged_choice(S,CompsList),Ext} of {false,noext} -> {true,sort_components1(S,TypeName,CompsList,[],[],[],[])}; {false,_} -> {true,{sort_components1(S,TypeName,CompsList,[],[],[],[]), []}}; {true,noext} -> %% sort in run-time {dynamic,R1}; _ -> {dynamic,{R1, Ext, R2}} end; sort_components(per,S=#state{tname=TypeName},Components) -> {R1,Ext,R2} = extension(textual_order(Components)), Root = tag_untagged_choice(S,R1++R2), case Ext of noext -> {true,sort_components1(S,TypeName,Root,[],[],[],[])}; _ -> {true,{sort_components1(S,TypeName,Root,[],[],[],[]), Ext}} end. sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs], UnivAcc,ApplAcc,ContAcc,PrivAcc) -> sort_components1(S,TypeName,Cs,[C|UnivAcc],ApplAcc,ContAcc,PrivAcc); sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'APPLICATION',_}|_R]}|Cs], UnivAcc,ApplAcc,ContAcc,PrivAcc) -> sort_components1(S,TypeName,Cs,UnivAcc,[C|ApplAcc],ContAcc,PrivAcc); sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'CONTEXT',_}|_R]}|Cs], UnivAcc,ApplAcc,ContAcc,PrivAcc) -> sort_components1(S,TypeName,Cs,UnivAcc,ApplAcc,[C|ContAcc],PrivAcc); sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'PRIVATE',_}|_R]}|Cs], UnivAcc,ApplAcc,ContAcc,PrivAcc) -> sort_components1(S,TypeName,Cs,UnivAcc,ApplAcc,ContAcc,[C|PrivAcc]); sort_components1(S,TypeName,[],UnivAcc,ApplAcc,ContAcc,PrivAcc) -> I = #'ComponentType'.tags, ascending_order_check(S,TypeName,sort_universal_type(UnivAcc)) ++ ascending_order_check(S,TypeName,lists:keysort(I,ApplAcc)) ++ ascending_order_check(S,TypeName,lists:keysort(I,ContAcc)) ++ ascending_order_check(S,TypeName,lists:keysort(I,PrivAcc)). ascending_order_check(S,TypeName,Components) -> ascending_order_check1(S,TypeName,Components), Components. ascending_order_check1(S,TypeName, [C1 = #'ComponentType'{tags=[{_,T}|_]}, C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) -> asn1ct:warning("Indistinct tag ~p in SET ~p, components ~p and ~p~n", [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name],S, "Indistinct tag in SET"), ascending_order_check1(S,TypeName,[C2|Rest]); ascending_order_check1(S,TypeName, [C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]}, C2 = #'ComponentType'{tags=[{'UNIVERSAL',T2}|_]}|Rest]) -> case (decode_type(T1) == decode_type(T2)) of true -> asn1ct:warning("Indistinct tags ~p and ~p in" " SET ~p, components ~p and ~p~n", [T1,T2,TypeName,C1#'ComponentType'.name, C2#'ComponentType'.name],S, "Indistinct tags and in SET"), ascending_order_check1(S,TypeName,[C2|Rest]); _ -> ascending_order_check1(S,TypeName,[C2|Rest]) end; ascending_order_check1(S,N,[_|Rest]) -> ascending_order_check1(S,N,Rest); ascending_order_check1(_,_,[]) -> ok. sort_universal_type(Components) -> List = lists:map(fun(C) -> #'ComponentType'{tags=[{_,T}|_]} = C, {decode_type(T),C} end, Components), SortedList = lists:keysort(1,List), lists:map(fun(X)->element(2,X) end,SortedList). decode_type(I) when is_integer(I) -> I; decode_type(T) -> asn1ct_gen_ber_bin_v2:decode_type(T). untagged_choice(_S,[#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) -> true; untagged_choice(S,[#'ComponentType'{typespec=#type{tag=[],def=ExRef}}|Rest]) when is_record(ExRef,'Externaltypereference')-> case get_referenced_type(S,ExRef) of {_,#typedef{typespec=#type{tag=[], def={'CHOICE',_}}}} -> true; _ -> untagged_choice(S,Rest) end; untagged_choice(S,[_|Rest]) -> untagged_choice(S,Rest); untagged_choice(_,[]) -> false. tag_untagged_choice(S,Cs) -> tag_untagged_choice(S,Cs,[]). tag_untagged_choice(S,[C = #'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|Rest],Acc) -> TagList = C#'ComponentType'.tags, TaggedC = C#'ComponentType'{tags=get_least_tag(TagList)}, tag_untagged_choice(S,Rest,[TaggedC|Acc]); tag_untagged_choice(S,[C = #'ComponentType'{typespec=#type{tag=[],def=ExRef}}|Rest],Acc) when is_record(ExRef,'Externaltypereference') -> case get_referenced_type(S,ExRef) of {_,#typedef{typespec=#type{tag=[], def={'CHOICE',_}}}} -> TagList = C#'ComponentType'.tags, TaggedC = C#'ComponentType'{tags = get_least_tag(TagList)}, tag_untagged_choice(S,Rest,[TaggedC|Acc]); _ -> tag_untagged_choice(S,Rest,[C|Acc]) end; tag_untagged_choice(S,[C|Rest],Acc) -> tag_untagged_choice(S,Rest,[C|Acc]); tag_untagged_choice(_S,[],Acc) -> Acc. get_least_tag([]) -> []; get_least_tag(TagList) -> %% The smallest tag 'PRIVATE' < 'CONTEXT' < 'APPLICATION' < 'UNIVERSAL' Pred = fun({'PRIVATE',_},{'CONTEXT',_}) -> true; ({'CONTEXT',_},{'APPLICATION',_}) -> true; ({'APPLICATION',_},{'UNIVERSAL',_}) -> true; ({A,T1},{A,T2}) when T1 =< T2 -> true; (_,_) -> false end, [T|_] = lists:sort(Pred,TagList), [T]. %% adds the textual order to the components to keep right order of %% components in the asn1-value. textual_order(Cs) -> Fun = fun(C=#'ComponentType'{},Index) -> {C#'ComponentType'{textual_order=Index},Index+1}; (Other,Index) -> {Other,Index} end, {NewCs,_} = textual_order(Cs,Fun,1), NewCs. textual_order(Cs,Fun,IxIn) when is_list(Cs) -> lists:mapfoldl(Fun,IxIn,Cs); textual_order({Root,Ext},Fun,IxIn) -> {NewRoot,IxR} = textual_order(Root,Fun,IxIn), {NewExt,_} = textual_order(Ext,Fun,IxR), {{NewRoot,NewExt},dummy}; textual_order({Root1,Ext,Root2},Fun,IxIn) -> {NewRoot1,IxR} = textual_order(Root1,Fun,IxIn), {NewExt,IxE} = textual_order(Ext,Fun,IxR), {NewRoot2,_} = textual_order(Root2,Fun,IxE), {{NewRoot1,NewExt,NewRoot2},dummy}. extension(Components) when is_list(Components) -> {Components,noext,[]}; extension({Root,ExtList}) -> ToOpt = fun(mandatory) -> 'OPTIONAL'; (X) -> X end, {Root, [X#'ComponentType'{prop=ToOpt(Y)}|| X = #'ComponentType'{prop=Y}<-ExtList],[]}; extension({Root1,ExtList,Root2}) -> ToOpt = fun(mandatory) -> 'OPTIONAL'; (X) -> X end, {Root1, [X#'ComponentType'{prop=ToOpt(Y)}|| X = #'ComponentType'{prop=Y}<-ExtList], Root2}. check_setof(S,Type,Component) when is_record(Component,type) -> simplify_type(check_type(S, Type, Component)). check_selectiontype(S,Name,#type{def=Eref}) when is_record(Eref,'Externaltypereference') -> {RefMod,TypeDef} = get_referenced_type(S,Eref), NewS = S#state{module=load_asn1_module(S,RefMod), mname=RefMod, type=TypeDef, tname=get_datastr_name(TypeDef)}, check_selectiontype2(NewS,Name,TypeDef); check_selectiontype(S,Name,Type=#type{def={pt,_,_}}) -> TName = case S#state.recordtopname of [] -> S#state.tname; N -> N end, TDef = #typedef{name=TName,typespec=Type}, check_selectiontype2(S,Name,TDef); check_selectiontype(S,Name,Type) -> Msg = lists:flatten(io_lib:format("SelectionType error: ~w < ~w must be a reference to a CHOICE.",[Name,Type])), error({type,Msg,S}). check_selectiontype2(S,Name,TypeDef) -> NewS = S#state{recordtopname=get_datastr_name(TypeDef)}, CheckedType = check_type(NewS,TypeDef,TypeDef#typedef.typespec), Components = get_choice_components(S,CheckedType#type.def), case lists:keysearch(Name,#'ComponentType'.name,Components) of {value,C} -> %% The selected type will have the tag of the selected type. _T = C#'ComponentType'.typespec; % T#type{tag=def_to_tag(NewS,T#type.def)}; _ -> Msg = lists:flatten(io_lib:format("error checking SelectionType: ~w~n",[Name])), error({type,Msg,S}) end. check_restrictedstring(_S,_Def,_Constr) -> ok. check_objectidentifier(_S,_Constr) -> ok. check_relative_oid(_S,_Constr) -> ok. % check all aspects of a CHOICE % - that all alternative names are unique % - that all TAGS are ok (when TAG default is applied) % - that each alternative is of a valid type % - that the extension marks are valid check_choice(S,Type,Components) when is_list(Components) -> Components1 = [C||C = #'ComponentType'{} <- Components], case check_unique(Components1,#'ComponentType'.name) of [] -> %% sort_canonical(Components), Components2 = maybe_automatic_tags(S,Components), NewComps = check_each_alternative2(S,Type,Components2), %% ExtensionAdditionGroup markers i.e '[[' ']]' are not %% significant for encoding/decoding a choice %% therefore we remove them here NewComps2 = lists:filter(fun(#'ExtensionAdditionGroup'{}) -> false; ('ExtensionAdditionGroupEnd') -> false; (_) -> true end,NewComps), NewComps3 = simplify_comps(NewComps2), check_unique_tags(S, NewComps3), complist_as_tuple(NewComps3); Dupl -> throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}}) end; check_choice(_S,_,[]) -> []. maybe_automatic_tags(S,C) -> TagNos = tag_nums(C), case (S#state.module)#module.tagdefault of 'AUTOMATIC' -> generate_automatic_tags(S,C,TagNos); _ -> %% maybe is the module a multi file module were only some of %% the modules have defaulttag AUTOMATIC TAGS then the names %% of those types are saved in the table automatic_tags Name= S#state.tname, case is_automatic_tagged_in_multi_file(Name) of true -> generate_automatic_tags(S,C,TagNos); false -> C end end. %% Pos == 1 for Root1, 2 for Ext, 3 for Root2 tag_nums(Cl) -> tag_nums(Cl,0,0). tag_nums([#'EXTENSIONMARK'{}|Rest],Ext,Root2) -> tag_nums_ext(Rest,Ext,Root2); tag_nums([_|Rest],Ext,Root2) -> tag_nums(Rest,Ext+1,Root2+1); tag_nums([],Ext,Root2) -> [0,Ext,Root2]. tag_nums_ext([#'EXTENSIONMARK'{}|Rest],Ext,Root2) -> tag_nums_root2(Rest,Ext,Root2); tag_nums_ext([_|Rest],Ext,Root2) -> tag_nums_ext(Rest,Ext,Root2); tag_nums_ext([],Ext,_Root2) -> [0,Ext,0]. tag_nums_root2([_|Rest],Ext,Root2) -> tag_nums_root2(Rest,Ext+1,Root2); tag_nums_root2([],Ext,Root2) -> [0,Ext,Root2]. is_automatic_tagged_in_multi_file(Name) -> case asn1ct_table:exists(automatic_tags) of false -> %% this case when not multifile compilation false; true -> case asn1ct_table:lookup(automatic_tags, Name) of [] -> false; _ -> true end end. generate_automatic_tags(_S,C,TagNo) -> case any_manual_tag(C) of true -> C; false -> generate_automatic_tags1(C,TagNo) end. generate_automatic_tags1([H|T],[TagNo|TagNos]) when is_record(H,'ComponentType') -> #'ComponentType'{typespec=Ts} = H, NewTs = Ts#type{tag=[#tag{class='CONTEXT', number=TagNo, type={default,'IMPLICIT'}, form= 0 }]}, % PRIMITIVE [H#'ComponentType'{typespec=NewTs}|generate_automatic_tags1(T,[TagNo+1|TagNos])]; generate_automatic_tags1([ExtMark = #'EXTENSIONMARK'{}|T],[_TagNo|TagNos]) -> [ExtMark | generate_automatic_tags1(T,TagNos)]; generate_automatic_tags1([H|T],TagList) -> % ExtensionAdditionGroup etc are just ignored [H | generate_automatic_tags1(T,TagList)]; generate_automatic_tags1([],_) -> []. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Returns true if there is at least one ComponentType with a manually %% specified tag. No manual tag is indicated by typespec=#type{tag=[]} %% so we check if we find a tag =/= [] and return true in that case %% all other things in the componentlist like (EXTENSIONMARK, %% ExtensionAdditionGroup,...) except ComponentType is simply %% ignored/skipped any_manual_tag([#'ComponentType'{typespec=#type{tag=Tag}}|_Rest]) when Tag =/= []-> true; any_manual_tag([_|Rest]) -> any_manual_tag(Rest); any_manual_tag([]) -> false. check_unique_tags(S,C) -> case (S#state.module)#module.tagdefault of 'AUTOMATIC' -> case any_manual_tag(C) of false -> true; _ -> collect_and_sort_tags(C,[]) end; _ -> collect_and_sort_tags(C,[]) end. collect_and_sort_tags([C|Rest],Acc) when is_record(C,'ComponentType') -> collect_and_sort_tags(Rest,C#'ComponentType'.tags ++ Acc); collect_and_sort_tags([_|Rest],Acc) -> collect_and_sort_tags(Rest,Acc); collect_and_sort_tags([],Acc) -> {Dupl,_}= lists:mapfoldl(fun(El,El)->{{dup,El},El};(El,_Prev)-> {El,El} end,notag,lists:sort(Acc)), Dupl2 = [Dup|| {dup,Dup} <- Dupl], if length(Dupl2) > 0 -> throw({error,{asn1,{duplicates_of_the_tags,Dupl2}}}); true -> true end. check_unique(L,Pos) -> Slist = lists:keysort(Pos,L), check_unique2(Slist,Pos,[]). check_unique2([A,B|T],Pos,Acc) when element(Pos,A) == element(Pos,B) -> check_unique2([B|T],Pos,[element(Pos,B)|Acc]); check_unique2([_|T],Pos,Acc) -> check_unique2(T,Pos,Acc); check_unique2([],_,Acc) -> lists:reverse(Acc). %% Replaces check_each_component and does the same work except that %% it keeps the complist as a flat list and does not create a tuple with root and %% extensions separated check_each_component2(S,Type,Components) -> check_each_component2(S,Type,Components,[]). check_each_component2(S = #state{abscomppath=Path,recordtopname=TopName}, Type, [C = #'ComponentType'{name=Cname,typespec=Ts,prop=Prop}|Ct], Acc) -> NewAbsCPath = case Ts#type.def of #'Externaltypereference'{} -> []; _ -> [Cname|Path] end,%%XXX Cname = 'per-message-indicators' CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, recordtopname=[Cname|TopName]},Type,Ts), NewTags = get_taglist(S,CheckedTs), NewProp = case normalize_value(S,CheckedTs,Prop,[Cname|TopName]) of mandatory -> mandatory; 'OPTIONAL' -> 'OPTIONAL'; DefaultValue -> {'DEFAULT',DefaultValue} end, NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags}, check_each_component2(S,Type,Ct,[NewC|Acc]); check_each_component2(S,Type,[OtherMarker|Ct],Acc) -> %% let 'EXTENSIONMARK' and 'ExtensionAdditionGroup' markers pass through as is check_each_component2(S,Type,Ct,[OtherMarker|Acc]); check_each_component2(_S,_,[],Acc) -> lists:reverse(Acc). %% check_each_alternative2(S,Type,{Rlist,ExtList}) -> %% {check_each_alternative(S,Type,Rlist), %% check_each_alternative(S,Type,ExtList)}; check_each_alternative2(S,Type,[C|Ct]) -> check_each_alternative2(S,Type,[C|Ct],[]). check_each_alternative2(S=#state{abscomppath=Path,recordtopname=TopName}, Type, [C = #'ComponentType'{name=Cname,typespec=Ts}|Ct], Acc) -> NewAbsCPath = case Ts#type.def of #'Externaltypereference'{} -> []; _ -> [Cname|Path] end, CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, recordtopname=[Cname|TopName]},Type,Ts), NewTags = get_taglist(S,CheckedTs), NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags}, check_each_alternative2(S,Type,Ct,[NewC|Acc]); check_each_alternative2(S,Type,[OtherMarker|Ct],Acc) -> %% let 'EXTENSIONMARK' and 'ExtensionAdditionGroup' markers pass through as is check_each_alternative2(S,Type,Ct,[OtherMarker|Acc]); check_each_alternative2(_S,_,[],Acc) -> lists:reverse(Acc). %% componentrelation_leadingattr/2 searches the structure for table %% constraints, if any is found componentrelation_leadingattr/5 is %% called. componentrelation_leadingattr(S,CompList) -> %% get_simple_table_if_used/2 should find out whether there are any %% component relation constraints in the entire tree of Cs1 that %% relates to this level. It returns information about the simple %% table constraint necessary for the the call to %% componentrelation_leadingattr/6. The step when the leading %% attribute and the syntax tree is modified to support the code %% generating. case get_simple_table_if_used(S,CompList) of [] -> {false,CompList}; _ -> componentrelation_leadingattr(S,CompList,CompList,[],[]) end. %%FIXME expand_ExtAddGroups([C#'ExtensionAdditionGroup'{components=ExtAdds}|T], %% CurrPos,PosAcc,CompAcc) -> %% expand_ExtAddGroups(T,CurrPos+ L = lenght(ExtAdds),[{CurrPos,L}|PosAcc],ExtAdds++CompAcc); %% expand_ExtAddGroups([C|T],CurrPos,PosAcc,CompAcc) -> %% expand_ExtAddGroups(T,CurrPos+ 1,PosAcc,[C|CompAcc]); %% expand_ExtAddGroups([],_CurrPos,PosAcc,CompAcc) -> %% {lists:reverse(PosAcc),lists:reverse(CompAcc)}. %% componentrelation_leadingattr/6 when all components are searched %% the new modified components are returned together with the "leading %% attribute" information, which later is stored in the tablecinf %% field in the SEQUENCE/SET record. The "leading attribute" %% information is used to generate the lookup in the object set %% table. The other information gathered in the #type.tablecinf field %% is used in code generating phase too, to recognice the proper %% components for "open type" encoding and to propagate the result of %% the object set lookup when needed. componentrelation_leadingattr(_,[],_CompList,[],NewCompList) -> {false,lists:reverse(NewCompList)}; componentrelation_leadingattr(_,[],_CompList,LeadingAttr,NewCompList) -> {lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later componentrelation_leadingattr(S,[C= #'ComponentType'{}|Cs],CompList,Acc,CompAcc) -> {LAAcc,NewC} = case catch componentrelation1(S,C#'ComponentType'.typespec, [C#'ComponentType'.name]) of {'EXIT',_} -> {[],C}; {CRI=[{_A1,_B1,_C1,_D1}|_Rest],NewTSpec} -> %% {ObjectSet,AtPath,ClassDef,Path} %% _A1 is a reference to the object set of the %% component relation constraint. %% _B1 is the path of names in the at-list of the %% component relation constraint. %% _C1 is the class definition of the %% ObjectClassFieldType. %% _D1 is the path of components that was traversed to %% find this constraint. case leading_attr_index(S,CompList,CRI, lists:reverse(S#state.abscomppath),[]) of [] -> {[],C}; [{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] -> OS = object_set_mod_name(S,ObjSet), UniqueFieldName = case (catch get_unique_fieldname(S,#classdef{typespec=ClassDef})) of {error,'__undefined_',_} -> no_unique; {asn1,Msg,_} -> error({type,Msg,S}); {'EXIT',Msg} -> error({type,{internal_error,Msg},S}); {Other,_} -> Other end, % UsedFieldName = get_used_fieldname(S,Attr,STList), %% Res should be done differently: even though %% a unique field name exists it is not %% certain that the ObjectClassFieldType of %% the simple table constraint picks that %% class field. Res = #simpletableattributes{objectsetname=OS, %% c_name=asn1ct_gen:un_hyphen_var(Attr), c_name=Attr, c_index=N, usedclassfield=UniqueFieldName, uniqueclassfield=UniqueFieldName, valueindex=ValueIndex}, {[Res],C#'ComponentType'{typespec=NewTSpec}} end; _ -> %% no constraint was found {[],C} end, componentrelation_leadingattr(S,Cs,CompList,LAAcc++Acc, [NewC|CompAcc]); componentrelation_leadingattr(S,[NotComponentType|Cs],CompList,LeadingAttr,NewCompList) -> componentrelation_leadingattr(S,Cs,CompList,LeadingAttr,[NotComponentType|NewCompList]). object_set_mod_name(_S,ObjSet) when is_atom(ObjSet) -> ObjSet; object_set_mod_name(#state{mname=M}, #'Externaltypereference'{module=M,type=T}) -> {M,T}; object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) -> case lists:member(M,S#state.inputmodules) of true -> T; false -> {M,T} end. %% get_simple_table_if_used/2 searches the structure of Cs for any %% component relation constraints due to the present level of the %% structure. If there are any, the necessary information for code %% generation of the look up functionality in the object set table are %% returned. get_simple_table_if_used(S,Cs) -> CNames = [Name||#'ComponentType'{name=Name}<-Cs], JustComponents = [C || C = #'ComponentType'{}<-Cs], RefedSimpleTable=any_component_relation(S,JustComponents,CNames,[],[]), get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)). remove_doubles(L) -> remove_doubles(L,[]). remove_doubles([H|T],Acc) -> NewT = remove_doubles1(H,T), remove_doubles(NewT,[H|Acc]); remove_doubles([],Acc) -> Acc. remove_doubles1(El,L) -> case lists:delete(El,L) of L -> L; NewL -> remove_doubles1(El,NewL) end. %% get_simple_table_info searches the commponents Cs by the path from %% an at-list (third argument), and follows into a component of it if %% necessary, to get information needed for code generating. %% %% Returns a list of tuples with three elements. It holds a list of %% atoms that is the path, the name of the field of the class that are %% referred to in the ObjectClassFieldType, and the name of the unique %% field of the class of the ObjectClassFieldType. %% % %% The level information outermost/innermost must be kept. There are % %% at least two possibilities to cover here for an outermost case: 1) % %% Both the simple table and the component relation have a common path % %% at least one step below the outermost level, i.e. the leading % %% information shall be on a sub level. 2) They don't have any common % %% path. get_simple_table_info(S,Cs,[AtList|Rest]) -> [get_simple_table_info1(S,Cs,AtList,[])|get_simple_table_info(S,Cs,Rest)]; get_simple_table_info(_,_,[]) -> []. get_simple_table_info1(S,Cs,[Cname|Cnames],Path) when is_list(Cs) -> case lists:keysearch(Cname,#'ComponentType'.name,Cs) of {value,C} -> get_simple_table_info1(S,C,Cnames,[Cname|Path]); _ -> error({type,"Missing expected simple table constraint",S}) end; get_simple_table_info1(S,#'ComponentType'{typespec=TS},[],Path) -> %% In this component there must be a simple table constraint %% o.w. the asn1 code is wrong. #type{def=OCFT,constraint=Cnstr} = TS, case lists:keymember(simpletable, 1, Cnstr) of true -> simple_table_info(S,OCFT,Path); false -> error({type,{"missing expected simple table constraint", Cnstr},S}) end; get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) -> Components = get_atlist_components(TS#type.def), get_simple_table_info1(S,Components,Cnames,Path). simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef, class=ObjectClass, fieldname=FieldName},Path) -> ObjectClassFieldName = case FieldName of {LastFieldName,[]} -> LastFieldName; {_FirstFieldName,FieldNames} -> lists:last(FieldNames) end, %%ObjectClassFieldName is the last element in the dotted %%list of the ObjectClassFieldType. The last element may %%be of another class, that is referenced from the class %%of the ObjectClassFieldType ClassDef = case ObjectClass of [] -> {_,CDef}=get_referenced_type(S,ClRef), CDef; _ -> #classdef{typespec=ObjectClass} end, UniqueName = case (catch get_unique_fieldname(S,ClassDef)) of {error,'__undefined_',_} -> no_unique; {asn1,Msg,_} -> error({type,Msg,S}); {'EXIT',Msg} -> error({type,{internal_error,Msg},S}); {Other,_} -> Other end, {lists:reverse(Path),ObjectClassFieldName,UniqueName}; simple_table_info(S,Type,_) -> error({type,{"the type referenced by a componentrelation constraint must be a ObjectClassFieldType",Type},S}). %% any_component_relation searches for all component relation %% constraints that refers to the actual level and returns a list of %% the "name path" in the at-list to the component relation constraint %% that must refer to a simple table constraint. The list is empty if %% no component relation constraints were found. %% %% NamePath has the names of all components that are followed from the %% beginning of the search. CNames holds the names of all components %% of the start level, this info is used if an outermost at-notation %% is found to check the validity of the at-list. any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,NamePath,Acc) -> CRelPath = case lists:keyfind(componentrelation, 1, Type#type.constraint) of {_,_,AtNotation} -> %% Found component relation constraint, now check %% whether this constraint is relevant for the level %% where the search started AtNot = extract_at_notation(AtNotation), %% evaluate_atpath returns the relative path to the %% simple table constraint from where the component %% relation is found. evaluate_atpath(S,NamePath,CNames,AtNot); false -> [] end, InnerAcc = case {Type#type.inlined, asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of {no,{constructed,bif}} -> {InnerCs,NewNamePath} = case get_components(Type#type.def) of T when is_record(T,type) -> {T,NamePath}; IC -> {IC,[CName|NamePath]} end, %% here we are interested in components of an %% SEQUENCE/SET OF as well as SEQUENCE, SET and CHOICE any_component_relation(S,InnerCs,CNames,NewNamePath,[]); _ -> [] end, any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc); any_component_relation(S,Type,CNames,NamePath,Acc) when is_record(Type,type) -> CRelPath = case lists:keyfind(componentrelation, 1, Type#type.constraint) of {_,_,AtNotation} -> AtNot = extract_at_notation(AtNotation), evaluate_atpath(S,NamePath,CNames,AtNot); false -> [] end, InnerAcc = case {Type#type.inlined, asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of {no,{constructed,bif}} -> InnerCs = get_components(Type#type.def), any_component_relation(S,InnerCs,CNames,NamePath,[]); _ -> [] end, InnerAcc ++ CRelPath ++ Acc; %% Just skip the markers for ExtensionAdditionGroup start and end %% in this function any_component_relation(S,[#'ExtensionAdditionGroup'{}|Cs],CNames,NamePath,Acc) -> any_component_relation(S,Cs,CNames,NamePath,Acc); any_component_relation(S,['ExtensionAdditionGroupEnd'|Cs],CNames,NamePath,Acc) -> any_component_relation(S,Cs,CNames,NamePath,Acc); any_component_relation(_,[],_,_,Acc) -> Acc. %% evaluate_atpath/4 finds out whether the at notation refers to the %% search level. The list of referenced names in the AtNot list shall %% begin with a name that exists on the level it refers to. If the %% found AtPath is refering to the same sub-branch as the simple table %% has, then there shall not be any leading attribute info on this %% level. evaluate_atpath(_,[],Cnames,{innermost,AtPath=[Ref|_Refs]}) -> %% any innermost constraint found deeper in the structure is %% ignored. case lists:member(Ref,Cnames) of true -> [AtPath]; false -> [] end; %% In this case must check that the AtPath doesn't step any step of %% the NamePath, in that case the constraint will be handled in an %% inner level. evaluate_atpath(S=#state{abscomppath=TopPath},NamePath,Cnames,{outermost,AtPath=[_Ref|_Refs]}) -> AtPathBelowTop = case TopPath of [] -> AtPath; _ -> case lists:prefix(TopPath,AtPath) of true -> lists:subtract(AtPath,TopPath); _ -> [] end end, case {NamePath,AtPathBelowTop} of {[H|_T1],[H|_T2]} -> []; % this must be handled in lower level {_,[]} -> [];% this must be handled in an above level {_,[H|_T]} -> case lists:member(H,Cnames) of true -> [AtPathBelowTop]; _ -> %% error({type,{asn1,"failed to analyze at-path",AtPath},S}) throw({type,{asn1,"failed to analyze at-path",AtPath},S}) end end; evaluate_atpath(_,_,_,_) -> []. %% Type may be any of SEQUENCE, SET, CHOICE, SEQUENCE OF, SET OF but %% only the three first have valid components. get_atlist_components(Def) -> get_components(atlist,Def). get_components(Def) -> get_components(any,Def). get_components(_,#'SEQUENCE'{components=Cs}) -> tuple2complist(Cs); get_components(_,#'SET'{components=Cs}) -> tuple2complist(Cs); get_components(_,{'CHOICE',Cs}) -> tuple2complist(Cs); %do not step in inlined structures get_components(any,{'SEQUENCE OF',T = #type{def=_Def,inlined=no}}) -> % get_components(any,Def); T; get_components(any,{'SET OF',T = #type{def=_Def,inlined=no}}) -> % get_components(any,Def); T; get_components(_,_) -> []. tuple2complist({R,E}) -> R ++ E; tuple2complist({R1,E,R2}) -> R1 ++ E ++ R2; tuple2complist(List) when is_list(List) -> List. get_choice_components(_S,{'CHOICE',Components}) when is_list(Components)-> Components; get_choice_components(_S,{'CHOICE',{C1,C2}}) when is_list(C1),is_list(C2) -> C1++C2; get_choice_components(S,ERef=#'Externaltypereference'{}) -> {_RefMod,TypeDef}=get_referenced_type(S,ERef), #typedef{typespec=TS} = TypeDef, get_choice_components(S,TS#type.def). extract_at_notation([{Level,[#'Externalvaluereference'{value=Name}|Rest]}]) -> {Level,[Name|extract_at_notation1(Rest)]}; extract_at_notation(At) -> exit({error,{asn1,{at_notation,At}}}). extract_at_notation1([#'Externalvaluereference'{value=Name}|Rest]) -> [Name|extract_at_notation1(Rest)]; extract_at_notation1([]) -> []. %% componentrelation1/1 identifies all componentrelation constraints %% that exist in C or in the substructure of C. Info about the found %% constraints are returned in a list. It is ObjectSet, the reference %% to the object set, AttrPath, the name atoms extracted from the %% at-list in the component relation constraint, ClassDef, the %% objectclass record of the class of the ObjectClassFieldType, Path, %% that is the component name "path" from the searched level to this %% constraint. %% %% The function is called with one component of the type in turn and %% with the component name in Path at the first call. When called from %% within, the name of the inner component is added to Path. componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI}, Path) -> Ret = % case Constraint of % [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> case lists:keyfind(componentrelation, 1, Constraint) of {_,{_,_,ObjectSet},AtList} -> [{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList, %% Note: if Path is longer than one,i.e. it is within %% an inner type of the actual level, then the only %% relevant at-list is of "outermost" type. %% #'ObjectClassFieldType'{class=ClassDef} = Def, ClassDef = get_ObjectClassFieldType_classdef(S,Def), AtPath = lists:map(fun(#'Externalvaluereference'{value=V})->V end, AL), {[{ObjectSet,AtPath,ClassDef,Path}],Def}; false -> %% check the inner type of component innertype_comprel(S,Def,Path) end, case Ret of nofunobj -> nofunobj; %% ignored by caller {CRelI=[{ObjSet,_,_,_}],NewDef} -> %% TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), {CRelI,C#type{tablecinf=[{objfun,ObjSet}|TCItmp],def=NewDef}}; {CompRelInf,NewDef} -> %% more than one tuple in CompRelInf TCItmp = lists:subtract(TCI,[{objfun,anyset}]), {CompRelInf,C#type{tablecinf=[{objfun,anyset}|TCItmp],def=NewDef}} end. innertype_comprel(S,{'SEQUENCE OF',Type},Path) -> case innertype_comprel1(S,Type,Path) of nofunobj -> nofunobj; {CompRelInf,NewType} -> {CompRelInf,{'SEQUENCE OF',NewType}} end; innertype_comprel(S,{'SET OF',Type},Path) -> case innertype_comprel1(S,Type,Path) of nofunobj -> nofunobj; {CompRelInf,NewType} -> {CompRelInf,{'SET OF',NewType}} end; innertype_comprel(S,{'CHOICE',CTypeList},Path) -> case componentlist_comprel(S,CTypeList,[],Path,[]) of nofunobj -> nofunobj; {CompRelInf,NewCs} -> {CompRelInf,{'CHOICE',NewCs}} end; innertype_comprel(S,Seq = #'SEQUENCE'{components=Cs},Path) -> case componentlist_comprel(S,Cs,[],Path,[]) of nofunobj -> nofunobj; {CompRelInf,NewCs} -> {CompRelInf,Seq#'SEQUENCE'{components=NewCs}} end; innertype_comprel(S,Set = #'SET'{components=Cs},Path) -> case componentlist_comprel(S,Cs,[],Path,[]) of nofunobj -> nofunobj; {CompRelInf,NewCs} -> {CompRelInf,Set#'SET'{components=NewCs}} end; innertype_comprel(_,_,_) -> nofunobj. componentlist_comprel(S,[C = #'ComponentType'{name=Name,typespec=Type}|Cs], Acc,Path,NewCL) -> case catch componentrelation1(S,Type,Path++[Name]) of {'EXIT',_} -> componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); nofunobj -> componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); {CRelInf,NewType} -> componentlist_comprel(S,Cs,CRelInf++Acc,Path, [C#'ComponentType'{typespec=NewType}|NewCL]) end; componentlist_comprel(_,[],Acc,_,NewCL) -> case Acc of [] -> nofunobj; _ -> {Acc,lists:reverse(NewCL)} end. innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) -> Ret = case lists:keyfind(componentrelation, 1, Cons) of {_,{_,_,ObjectSet},AtList} -> %% This AtList must have an "outermost" at sign to be %% relevent here. [{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2] = AtList, %% #'ObjectClassFieldType'{class=ClassDef} = Def, ClassDef = get_ObjectClassFieldType_classdef(S,Def), AtPath = lists:map(fun(#'Externalvaluereference'{value=V})->V end, AL), [{ObjectSet,AtPath,ClassDef,Path}]; false -> innertype_comprel(S,Def,Path) end, case Ret of nofunobj -> nofunobj; L = [{ObjSet,_,_,_}] -> TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), {L,T#type{tablecinf=[{objfun,ObjSet}|TCItmp]}}; {CRelInf,NewDef} -> TCItmp = lists:subtract(TCI,[{objfun,anyset}]), {CRelInf,T#type{def=NewDef,tablecinf=[{objfun,anyset}|TCItmp]}} end. %% leading_attr_index counts the index and picks the name of the %% component that is at the actual level in the at-list of the %% component relation constraint (AttrP). AbsP is the path of %% component names from the top type level to the actual level. AttrP %% is a list with the atoms from the at-list. leading_attr_index(S,Cs,[H={_,AttrP,_,_}|T],AbsP,Acc) -> AttrInfo = case lists:prefix(AbsP,AttrP) of %% why this ?? It is necessary when in same situation as %% TConstrChoice, there is an inner structure with an %% outermost at-list and the "leading attribute" code gen %% may be at a level some steps below the outermost level. true -> RelativAttrP = lists:subtract(AttrP,AbsP), %% The header is used to calculate the index of the %% component and to give the fun, received from the %% object set look up, an unique name. The tail is %% used to match the proper value input to the fun. {hd(RelativAttrP),tl(RelativAttrP)}; false -> {hd(AttrP),tl(AttrP)} end, case leading_attr_index1(S,Cs,H,AttrInfo,1) of 0 -> leading_attr_index(S,Cs,T,AbsP,Acc); Res -> leading_attr_index(S,Cs,T,AbsP,[Res|Acc]) end; leading_attr_index(_,_Cs,[],_,Acc) -> lists:reverse(Acc). leading_attr_index1(_,[],_,_,_) -> 0; leading_attr_index1(S,[C|Cs],Arg={ObjectSet,_,CDef,P}, AttrInfo={Attr,SubAttr},N) -> case C#'ComponentType'.name of Attr -> ValueMatch = value_match(S,C,Attr,SubAttr), {ObjectSet,Attr,N,CDef,P,ValueMatch}; _ -> leading_attr_index1(S,Cs,Arg,AttrInfo,N+1) end. %% value_math gathers information for a proper value match in the %% generated encode function. For a SEQUENCE or a SET the index of the %% component is counted. For a CHOICE the index is 2. value_match(S,C,Name,SubAttr) -> value_match(S,C,Name,SubAttr,[]). % C has name Name value_match(_S,#'ComponentType'{},_Name,[],Acc) -> Acc;% do not reverse, indexes in reverse order value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) -> InnerType = asn1ct_gen:get_inner(Type#type.def), Components = case get_atlist_components(Type#type.def) of [] -> error({type,{asn1,"element in at list must be a " "SEQUENCE, SET or CHOICE.",Name},S}); Comps -> Comps end, {Index,ValueIndex} = component_value_index(S,InnerType,At,Components), value_match(S,lists:nth(Index,Components),At,Ats,[ValueIndex|Acc]). component_value_index(S,'CHOICE',At,Components) -> {component_index(S,At,Components),2}; component_value_index(S,_,At,Components) -> %% SEQUENCE or SET Index = component_index(S,At,Components), {Index,{Index+1,At}}. component_index(S,Name,Components) -> component_index1(S,Name,Components,1). component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) -> N; component_index1(S,Name,[_C|Cs],N) -> component_index1(S,Name,Cs,N+1); component_index1(S,Name,[],_) -> error({type,{asn1,"component of at-list was not" " found in substructure",Name},S}). get_unique_fieldname(_S,ClassDef) when is_record(ClassDef,classdef) -> %% {_,Fields,_} = ClassDef#classdef.typespec, Fields = (ClassDef#classdef.typespec)#objectclass.fields, get_unique_fieldname1(Fields,[]); get_unique_fieldname(S,#typedef{typespec=#type{def=ClassRef}}) -> %% A class definition may be referenced as %% REFED-CLASS ::= DEFINED-CLASS and then REFED-CLASS is a typedef {_M,ClassDef} = get_referenced_type(S,ClassRef), get_unique_fieldname(S,ClassDef). get_unique_fieldname1([],[]) -> throw({error,'__undefined_',[]}); get_unique_fieldname1([],[Name]) -> Name; get_unique_fieldname1([],Acc) -> throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc}); get_unique_fieldname1([{fixedtypevaluefield,Name,_,'UNIQUE',Opt}|Rest],Acc) -> get_unique_fieldname1(Rest,[{Name,Opt}|Acc]); get_unique_fieldname1([_H|T],Acc) -> get_unique_fieldname1(T,Acc). get_tableconstraint_info(S,Type,{CheckedTs,EComps,CheckedTs2}) -> {get_tableconstraint_info(S,Type,CheckedTs,[]), get_tableconstraint_info(S,Type,EComps,[]), get_tableconstraint_info(S,Type,CheckedTs2,[])}; get_tableconstraint_info(S,Type,{CheckedTs,EComps}) -> {get_tableconstraint_info(S,Type,CheckedTs,[]), get_tableconstraint_info(S,Type,EComps,[])}; get_tableconstraint_info(S,Type,CheckedTs) -> get_tableconstraint_info(S,Type,CheckedTs,[]). get_tableconstraint_info(_S,_Type,[],Acc) -> lists:reverse(Acc); get_tableconstraint_info(S,Type,[C=#'ComponentType'{typespec=CheckedTs}|Cs],Acc) -> AccComp = case CheckedTs#type.def of %% ObjectClassFieldType OCFT=#'ObjectClassFieldType'{} -> NewOCFT = OCFT#'ObjectClassFieldType'{class=[]}, C#'ComponentType'{typespec= CheckedTs#type{ def=NewOCFT }}; % constraint=[{tableconstraint_info, % FieldRef}]}}; {'SEQUENCE OF',SOType} when is_record(SOType,type), (element(1,SOType#type.def)=='CHOICE') -> CTypeList = element(2,SOType#type.def), NewInnerCList = get_tableconstraint_info(S,Type,CTypeList), C#'ComponentType'{typespec= CheckedTs#type{ def={'SEQUENCE OF', SOType#type{def={'CHOICE', NewInnerCList}}}}}; {'SET OF',SOType} when is_record(SOType,type), (element(1,SOType#type.def)=='CHOICE') -> CTypeList = element(2,SOType#type.def), NewInnerCList = get_tableconstraint_info(S,Type,CTypeList), C#'ComponentType'{typespec= CheckedTs#type{ def={'SET OF', SOType#type{def={'CHOICE', NewInnerCList}}}}}; _ -> C end, get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]); get_tableconstraint_info(S,Type,[C|Cs],Acc) -> get_tableconstraint_info(S,Type,Cs,[C|Acc]). get_referenced_fieldname([{_,FirstFieldname}]) -> {FirstFieldname,[]}; get_referenced_fieldname([{_,FirstFieldname}|Rest]) -> {FirstFieldname,lists:map(fun(X)->element(2,X) end,Rest)}; get_referenced_fieldname(Def={FieldName,RestFieldName}) when is_atom(FieldName),is_list(RestFieldName)-> Def; get_referenced_fieldname(Def) -> {no_type,Def}. %% get_ObjectClassFieldType extracts the type from the chain of %% objects that leads to a final type. get_ObjectClassFieldType(S,ERef,PrimFieldNameList) when is_record(ERef,'Externaltypereference') -> {MName,Type} = get_referenced_type(S,ERef), NewS = update_state(S#state{type=Type, tname=ERef#'Externaltypereference'.type},MName), ClassSpec = check_class(NewS,Type), Fields = ClassSpec#objectclass.fields, get_ObjectClassFieldType(S,Fields,PrimFieldNameList); get_ObjectClassFieldType(S,Fields,L=[_PrimFieldName1|_Rest]) -> check_PrimitiveFieldNames(S,Fields,L), get_OCFType(S,Fields,L); get_ObjectClassFieldType(S,ERef,{FieldName,Rest}) -> get_ObjectClassFieldType(S,ERef,Rest ++ [FieldName]). check_PrimitiveFieldNames(_S,_Fields,_) -> ok. %% get_ObjectClassFieldType_classdef gets the def of the class of the %% ObjectClassFieldType, i.e. the objectclass record. If the type has %% been checked (it may be a field type of an internal SEQUENCE) the %% class field = [], then the classdef has to be fetched by help of %% the class reference in the classname field. get_ObjectClassFieldType_classdef(S,#'ObjectClassFieldType'{classname=Name,class=[]}) -> {_,#classdef{typespec=TS}} = get_referenced_type(S,Name), TS; get_ObjectClassFieldType_classdef(_,#'ObjectClassFieldType'{class=Cl}) -> Cl. get_OCFType(S,Fields,FieldnameList=[{_FieldType,_PrimFieldName}|_]) -> get_OCFType(S,Fields,[PFN||{_,PFN} <- FieldnameList]); get_OCFType(S,Fields,[PrimFieldName|Rest]) -> case lists:keysearch(PrimFieldName,2,Fields) of {value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} -> {fixedtypevaluefield,PrimFieldName,Type}; {value,{objectfield,_,ClassRef,_Unique,_OptSpec}} -> {MName,ClassDef} = get_referenced_type(S,ClassRef), NewS = update_state(S#state{type=ClassDef, tname=get_datastr_name(ClassDef)}, MName), CheckedCDef = check_class(NewS,ClassDef), get_OCFType(S,CheckedCDef#objectclass.fields,Rest); {value,{objectsetfield,_,Type,_OptSpec}} -> {MName,ClassDef} = get_referenced_type(S,Type#type.def), NewS = update_state(S#state{type=ClassDef, tname=get_datastr_name(ClassDef)}, MName), CheckedCDef = check_class(NewS,ClassDef), get_OCFType(S,CheckedCDef#objectclass.fields,Rest); {value,Other} -> {element(1,Other),PrimFieldName}; _ -> throw({error,lists:flatten(io_lib:format("undefined FieldName in ObjectClassFieldType: ~w",[PrimFieldName]))}) end. get_taglist(S,Ext) when is_record(Ext,'Externaltypereference') -> {_,T} = get_referenced_type(S,Ext), get_taglist(S,T#typedef.typespec); get_taglist(S,Type) when is_record(Type,type) -> case Type#type.tag of [] -> get_taglist(S,Type#type.def); [Tag|_] -> [asn1ct_gen:def_to_tag(Tag)] end; get_taglist(S,{'CHOICE',{Rc,Ec}}) -> get_taglist1(S,Rc ++ Ec); get_taglist(S,{'CHOICE',{R1,E,R2}}) -> get_taglist1(S,R1 ++ E ++ R2); get_taglist(S,{'CHOICE',Components}) -> get_taglist1(S,Components); %% ObjectClassFieldType OTP-4390 get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) -> []; get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) -> get_taglist(S,Type); get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList}) when is_list(FieldNameList) -> case get_ObjectClassFieldType(S,ERef,FieldNameList) of {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed end; get_taglist(S,{ObjCl,FieldNameList}) when is_record(ObjCl,objectclass), is_list(FieldNameList) -> case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed end; get_taglist(_, _) -> []. get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when is_list(TagL) -> %% tag_list has been here , just return TagL and continue with next alternative TagL ++ get_taglist1(S,Rest); get_taglist1(S,[#'ComponentType'{typespec=Ts,tags=undefined}|Rest]) -> get_taglist(S,Ts) ++ get_taglist1(S,Rest); get_taglist1(S,[_H|Rest]) -> % skip EXTENSIONMARK get_taglist1(S,Rest); get_taglist1(_S,[]) -> []. %% def_to_tag(S,Def) -> %% case asn1ct_gen:def_to_tag(Def) of %% {'UNIVERSAL',T} -> %% case asn1ct_gen:prim_bif(T) of %% true -> %% ?TAG_PRIMITIVE(tag_number(T)); %% _ -> %% ?TAG_CONSTRUCTED(tag_number(T)) %% end; %% _ -> [] %% end. %% tag_number('BOOLEAN') -> 1; %% tag_number('INTEGER') -> 2; %% tag_number('BIT STRING') -> 3; %% tag_number('OCTET STRING') -> 4; %% tag_number('NULL') -> 5; %% tag_number('OBJECT IDENTIFIER') -> 6; %% tag_number('ObjectDescriptor') -> 7; %% tag_number('EXTERNAL') -> 8; %% tag_number('INSTANCE OF') -> 8; %% tag_number('REAL') -> 9; %% tag_number('ENUMERATED') -> 10; %% tag_number('EMBEDDED PDV') -> 11; %% tag_number('UTF8String') -> 12; %% %%tag_number('RELATIVE-OID') -> 13; %% tag_number('SEQUENCE') -> 16; %% tag_number('SEQUENCE OF') -> 16; %% tag_number('SET') -> 17; %% tag_number('SET OF') -> 17; %% tag_number('NumericString') -> 18; %% tag_number('PrintableString') -> 19; %% tag_number('TeletexString') -> 20; %% %%tag_number('T61String') -> 20; %% tag_number('VideotexString') -> 21; %% tag_number('IA5String') -> 22; %% tag_number('UTCTime') -> 23; %% tag_number('GeneralizedTime') -> 24; %% tag_number('GraphicString') -> 25; %% tag_number('VisibleString') -> 26; %% %%tag_number('ISO646String') -> 26; %% tag_number('GeneralString') -> 27; %% tag_number('UniversalString') -> 28; %% tag_number('CHARACTER STRING') -> 29; %% tag_number('BMPString') -> 30. dbget_ex(_S,Module,Key) -> case asn1_db:dbget(Module,Key) of undefined -> throw({error,{asn1,{undefined,{Module,Key}}}}); % this is catched on toplevel type or value T -> T end. merge_tags(T1, T2) when is_list(T2) -> merge_tags2(T1 ++ T2, []); merge_tags(T1, T2) -> merge_tags2(T1 ++ [T2], []). merge_tags2([T1= #tag{type='IMPLICIT'}, T2 |Rest], Acc) -> merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); merge_tags2([T1= #tag{type={default,'IMPLICIT'}}, T2 |Rest], Acc) -> merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); merge_tags2([T1= #tag{type={default,'AUTOMATIC'}}, T2 |Rest], Acc) -> merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); merge_tags2([H|T],Acc) -> merge_tags2(T, [H|Acc]); merge_tags2([], Acc) -> lists:reverse(Acc). %% merge_constraints(C1, []) -> %% C1; %% merge_constraints([], C2) -> %% C2; %% merge_constraints(C1, C2) -> %% {SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]), %% SizeC = merge_constraints(SList), %% ValueC = merge_constraints(VList), %% PermAlphaC = merge_constraints(PAList), %% case Rest of %% [] -> %% SizeC ++ ValueC ++ PermAlphaC; %% _ -> %% throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}}) %% end. %% merge_constraints([]) -> []; %% merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2, %% High1 =< High2 -> %% merge_constraints([C1|Rest]); %% merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) -> %% [C1|merge_constraints([C2|Rest])]; %% merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) -> %% throw({error,asn1,{conflicting_constraints,{C1,C2}}}); %% merge_constraints([C]) -> %% [C]. %% splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> %% splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc); %% splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> %% splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc); %% splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> %% splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc); %% splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) -> %% splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]); %% splitlist([],Sacc,Vacc,PAacc,Restacc) -> %% {lists:reverse(Sacc), %% lists:reverse(Vacc), %% lists:reverse(PAacc), %% lists:reverse(Restacc)}. storeindb(S,M) when is_record(M,module) -> TVlist = M#module.typeorval, NewM = M#module{typeorval=findtypes_and_values(TVlist)}, asn1_db:dbnew(NewM#module.name, S#state.erule), asn1_db:dbput(NewM#module.name,'MODULE', NewM), Res = storeindb(#state{mname=NewM#module.name}, TVlist, []), include_default_class(S,NewM#module.name), include_default_type(NewM#module.name), Res. storeindb(#state{mname=Module}=S, [H|T], Errors) -> Name = asn1ct:get_name_of_def(H), case asn1_db:dbget(Module, Name) of undefined -> asn1_db:dbput(Module, Name, H), storeindb(S, T, Errors); Prev -> PrevLine = asn1ct:get_pos_of_def(Prev), Error = return_asn1_error(S, H, {already_defined,Name,PrevLine}), storeindb(S, T, [Error|Errors]) end; storeindb(_, [], []) -> ok; storeindb(_, [], [_|_]=Errors) -> {error,Errors}. findtypes_and_values(TVList) -> findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values, %% Parameterizedtypes,Classes,Objects and ObjectSets findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,typedef),is_record(H#typedef.typespec,'Object') -> findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#typedef.name|Oacc],OSacc); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,typedef),is_record(H#typedef.typespec,'ObjectSet') -> findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#typedef.name|OSacc]); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,typedef) -> findtypes_and_values(T,[H#typedef.name|Tacc],Vacc,Pacc,Cacc,Oacc,OSacc); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,valuedef) -> findtypes_and_values(T,Tacc,[H#valuedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,ptypedef) -> findtypes_and_values(T,Tacc,Vacc,[H#ptypedef.name|Pacc],Cacc,Oacc,OSacc); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,classdef) -> findtypes_and_values(T,Tacc,Vacc,Pacc,[H#classdef.name|Cacc],Oacc,OSacc); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,pvaluedef) -> findtypes_and_values(T,Tacc,[H#pvaluedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,pvaluesetdef) -> findtypes_and_values(T,Tacc,[H#pvaluesetdef.name|Vacc],Pacc,Cacc,Oacc,OSacc); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,pobjectdef) -> findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#pobjectdef.name|Oacc],OSacc); findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) when is_record(H,pobjectsetdef) -> findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#pobjectsetdef.name|OSacc]); findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) -> {lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc), lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}. return_asn1_error(#state{error_context=Context}=S, Error) -> return_asn1_error(S, Context, Error). return_asn1_error(#state{mname=Where}, Item, Error) -> Pos = asn1ct:get_pos_of_def(Item), {structured_error,{Where,Pos},?MODULE,Error}. asn1_error(S, Error) -> throw({error,return_asn1_error(S, Error)}). asn1_error(S, Item, Error) -> throw({error,return_asn1_error(S, Item, Error)}). format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); format_error(illegal_bitstring_value) -> "expecting a BIT STRING value"; format_error({illegal_class_name,Class}) -> io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]); format_error({illegal_instance_of,Class}) -> io_lib:format("using INSTANCE OF on class '~s' is illegal, " "because INSTANCE OF may only be used on the class TYPE-IDENTIFIER", [Class]); format_error(illegal_integer_value) -> "expecting an integer value"; format_error(illegal_object) -> "expecting an object"; format_error({illegal_oid,o_id}) -> "illegal OBJECT IDENTIFIER"; format_error({illegal_oid,rel_oid}) -> "illegal RELATIVE-OID"; format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; format_error({illegal_typereference,Name}) -> io_lib:format("'~p' is used as a typereference, but does not start with an uppercase letter", [Name]); format_error(illegal_value) -> "expected a value"; format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); format_error({invalid_bit_number,Bit}) -> io_lib:format("the bit number '~p' is invalid", [Bit]); format_error({missing_mandatory_fields,Fields,Obj}) -> io_lib:format("missing mandatory ~s in ~p", [format_fields(Fields),Obj]); format_error({namelist_redefinition,Name}) -> io_lib:format("the name '~s' can not be redefined", [Name]); format_error({syntax_duplicated_fields,Fields}) -> io_lib:format("~s must only occur once in the syntax list", [format_fields(Fields)]); format_error(syntax_nomatch) -> "unexpected end of object definition"; format_error({syntax_mandatory_in_optional_group,Name}) -> io_lib:format("the field '&~s' must not be within an optional group since it is not optional", [Name]); format_error({syntax_missing_mandatory_fields,Fields}) -> io_lib:format("missing mandatory ~s in the syntax list", [format_fields(Fields)]); format_error({syntax_nomatch,Actual}) -> io_lib:format("~s is not the next item allowed according to the defined syntax", [Actual]); format_error({syntax_undefined_field,Field}) -> io_lib:format("'&~s' is not a field of the class being defined", [Field]); format_error({undefined,Name}) -> io_lib:format("'~s' is referenced, but is not defined", [Name]); format_error({undefined_field,FieldName}) -> io_lib:format("the field '&~s' is undefined", [FieldName]); format_error({undefined_import,Ref,Module}) -> io_lib:format("'~s' is not exported from ~s", [Ref,Module]); format_error({value_reused,Val}) -> io_lib:format("the value '~p' is used more than once", [Val]); format_error({non_unique_object,Id}) -> io_lib:format("object set with a UNIQUE field value of '~p' is used more than once", [Id]); format_error(Other) -> io_lib:format("~p", [Other]). format_fields([F]) -> io_lib:format("field '&~s'", [F]); format_fields([H|T]) -> [io_lib:format("fields '&~s'", [H])| [io_lib:format(", '&~s'", [F]) || F <- T]]. error({_,{structured_error,_,_,_}=SE,_}) -> SE; error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> Pos = Ref#'Externaltypereference'.pos, io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), {error,{export,Pos,Mname,Typename,Msg}}; % error({type,{Msg1,Msg2},#state{mname=Mname,type=Type,tname=Typename}}) % when is_record(Type,typedef) -> % io:format("asn1error:~p:~p:~p ~p~n", % [Type#typedef.pos,Mname,Typename,Msg1]), % {error,{type,Type#typedef.pos,Mname,Typename,Msg1,Msg2}}; error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) when is_record(Type,type) -> io:format("asn1error:~p:~p~n~p~n", [Mname,Typename,Msg]), {error,{type,Mname,Typename,Msg}}; error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) when is_record(Type,typedef) -> io:format("asn1error:~p:~p:~p~n~p~n", [Type#typedef.pos,Mname,Typename,Msg]), {error,{type,Type#typedef.pos,Mname,Typename,Msg}}; error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) when is_record(Type,ptypedef) -> io:format("asn1error:~p:~p:~p~n~p~n", [Type#ptypedef.pos,Mname,Typename,Msg]), {error,{type,Type#ptypedef.pos,Mname,Typename,Msg}}; error({type,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) when is_record(Value,valuedef) -> io:format("asn1error:~p:~p:~p~n~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]), {error,{type,Value#valuedef.pos,Mname,Valuename,Msg}}; error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) when is_record(Type,pobjectdef) -> io:format("asn1error:~p:~p:~p~n~p~n", [Type#pobjectdef.pos,Mname,Typename,Msg]), {error,{type,Type#pobjectdef.pos,Mname,Typename,Msg}}; error({value,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) when is_record(Value,valuedef) -> io:format("asn1error:~p:~p:~p~n~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]), {error,{value,Value#valuedef.pos,Mname,Valuename,Msg}}; error({Other,Msg,#state{mname=Mname,value=#valuedef{pos=Pos},vname=Valuename}}) -> io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Valuename,Msg]), {error,{Other,Pos,Mname,Valuename,Msg}}; error({Other,Msg,#state{mname=Mname,type=#typedef{pos=Pos},tname=Typename}}) -> io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), {error,{Other,Pos,Mname,Typename,Msg}}; error({Other,Msg,#state{mname=Mname,type=#classdef{pos=Pos},tname=Typename}}) -> io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), {error,{Other,Pos,Mname,Typename,Msg}}; error({Other,Msg,#state{mname=Mname,type=Type,tname=Typename}}) -> io:format("asn1error:~p:~p:~p~n~p~n",[asn1ct:get_pos_of_def(Type),Mname,Typename,Msg]), {error,{Other,asn1ct:get_pos_of_def(Type),Mname,Typename,Msg}}. include_default_type(Module) -> NameAbsList = default_type_list(), include_default_type1(Module,NameAbsList). include_default_type1(_,[]) -> ok; include_default_type1(Module,[{Name,TS}|Rest]) -> case asn1_db:dbget(Module,Name) of undefined -> T = #typedef{name=Name, typespec=TS}, asn1_db:dbput(Module,Name,T); _ -> ok end, include_default_type1(Module,Rest). default_type_list() -> %% The EXTERNAL type is represented, according to ASN.1 1997, %% as a SEQUENCE with components: identification, data-value-descriptor %% and data-value. Syntax = #'ComponentType'{name=syntax, typespec=#type{def='OBJECT IDENTIFIER'}, prop=mandatory}, Presentation_Cid = #'ComponentType'{name='presentation-context-id', typespec=#type{def='INTEGER'}, prop=mandatory}, Transfer_syntax = #'ComponentType'{name='transfer-syntax', typespec=#type{def='OBJECT IDENTIFIER'}, prop=mandatory}, Negotiation_items = #type{def= #'SEQUENCE'{components= [Presentation_Cid, Transfer_syntax#'ComponentType'{prop=mandatory}]}}, Context_negot = #'ComponentType'{name='context-negotiation', typespec=Negotiation_items, prop=mandatory}, Data_value_descriptor = #'ComponentType'{name='data-value-descriptor', typespec=#type{def='ObjectDescriptor'}, prop='OPTIONAL'}, Data_value = #'ComponentType'{name='data-value', typespec=#type{def='OCTET STRING'}, prop=mandatory}, %% The EXTERNAL type is represented, according to ASN.1 1990, %% as a SEQUENCE with components: direct-reference, indirect-reference, %% data-value-descriptor and encoding. Direct_reference = #'ComponentType'{name='direct-reference', typespec=#type{def='OBJECT IDENTIFIER'}, prop='OPTIONAL', tags=[{'UNIVERSAL',6}]}, Indirect_reference = #'ComponentType'{name='indirect-reference', typespec=#type{def='INTEGER'}, prop='OPTIONAL', tags=[{'UNIVERSAL',2}]}, Single_ASN1_type = #'ComponentType'{name='single-ASN1-type', typespec=#type{tag=[{tag,'CONTEXT',0, 'EXPLICIT',32}], def='ANY'}, prop=mandatory, tags=[{'CONTEXT',0}]}, Octet_aligned = #'ComponentType'{name='octet-aligned', typespec=#type{tag=[{tag,'CONTEXT',1, 'IMPLICIT',0}], def='OCTET STRING'}, prop=mandatory, tags=[{'CONTEXT',1}]}, Arbitrary = #'ComponentType'{name=arbitrary, typespec=#type{tag=[{tag,'CONTEXT',2, 'IMPLICIT',0}], def={'BIT STRING',[]}}, prop=mandatory, tags=[{'CONTEXT',2}]}, Encoding = #'ComponentType'{name=encoding, typespec=#type{def={'CHOICE', [Single_ASN1_type,Octet_aligned, Arbitrary]}}, prop=mandatory}, EXTERNAL_components1990 = [Direct_reference,Indirect_reference,Data_value_descriptor,Encoding], %% The EMBEDDED PDV type is represented by a SEQUENCE type %% with components: identification and data-value Abstract = #'ComponentType'{name=abstract, typespec=#type{def='OBJECT IDENTIFIER'}, prop=mandatory}, Transfer = #'ComponentType'{name=transfer, typespec=#type{def='OBJECT IDENTIFIER'}, prop=mandatory}, AbstractTrSeq = #'SEQUENCE'{components=[Abstract,Transfer]}, Syntaxes = #'ComponentType'{name=syntaxes, typespec=#type{def=AbstractTrSeq}, prop=mandatory}, Fixed = #'ComponentType'{name=fixed, typespec=#type{def='NULL'}, prop=mandatory}, Negotiations = [Syntaxes,Syntax,Presentation_Cid,Context_negot, Transfer_syntax,Fixed], Identification2 = #'ComponentType'{name=identification, typespec=#type{def={'CHOICE',Negotiations}}, prop=mandatory}, EmbeddedPdv_components = [Identification2,Data_value], %% The CHARACTER STRING type is represented by a SEQUENCE type %% with components: identification and string-value String_value = #'ComponentType'{name='string-value', typespec=#type{def='OCTET STRING'}, prop=mandatory}, CharacterString_components = [Identification2,String_value], [{'EXTERNAL', #type{tag=[#tag{class='UNIVERSAL', number=8, type='IMPLICIT', form=32}], def=#'SEQUENCE'{components= EXTERNAL_components1990}}}, {'EMBEDDED PDV', #type{tag=[#tag{class='UNIVERSAL', number=11, type='IMPLICIT', form=32}], def=#'SEQUENCE'{components=EmbeddedPdv_components}}}, {'CHARACTER STRING', #type{tag=[#tag{class='UNIVERSAL', number=29, type='IMPLICIT', form=32}], def=#'SEQUENCE'{components=CharacterString_components}}} ]. include_default_class(S, Module) -> _ = [include_default_class1(S, Module, ClassDef) || ClassDef <- default_class_list()], ok. include_default_class1(S, Module, {Name,Ts0}) -> case asn1_db:dbget(Module, Name) of undefined -> #objectclass{fields=Fields, syntax={'WITH SYNTAX',Syntax0}} = Ts0, Syntax = preprocess_syntax(S, Syntax0, Fields), Ts = Ts0#objectclass{syntax={preprocessed_syntax,Syntax}}, C = #classdef{checked=true,module=Module, name=Name,typespec=Ts}, asn1_db:dbput(Module, Name, C); _ -> ok end. default_class_list() -> [{'TYPE-IDENTIFIER', #objectclass{fields=[{fixedtypevaluefield, id, #type{tag=[?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER)], def='OBJECT IDENTIFIER'}, 'UNIQUE', 'MANDATORY'}, {typefield,'Type','MANDATORY'}], syntax={'WITH SYNTAX', [{typefieldreference,'Type'}, 'IDENTIFIED', 'BY', {valuefieldreference,id}]}}}, {'ABSTRACT-SYNTAX', #objectclass{fields=[{fixedtypevaluefield, id, #type{tag=[?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER)], def='OBJECT IDENTIFIER'}, 'UNIQUE', 'MANDATORY'}, {typefield,'Type','MANDATORY'}, {fixedtypevaluefield, property, #type{tag=[?TAG_PRIMITIVE(?N_BIT_STRING)], def={'BIT STRING',[]}}, undefined, {'DEFAULT', [0,1,0]}}], syntax={'WITH SYNTAX', [{typefieldreference,'Type'}, 'IDENTIFIED', 'BY', {valuefieldreference,id}, ['HAS', 'PROPERTY', {valuefieldreference,property}]]}}}]. new_reference_name(Name) -> case get(asn1_reference) of undefined -> put(asn1_reference,1), list_to_atom(lists:concat([internal_,Name,"_",1])); Num when is_integer(Num) -> put(asn1_reference,Num+1), list_to_atom(lists:concat([internal_,Name,"_",Num+1])) end. get_record_prefix_name(S) -> case lists:keysearch(record_name_prefix,1,S#state.options) of {value,{_,Prefix}} -> Prefix; _ -> "" end. insert_once(S,Tab,Key) -> case get(top_module) of M when M == S#state.mname -> asn1ct_gen:insert_once(Tab,Key), ok; _ -> skipped end. check_fold(S0, [H|T], Check) -> Type = asn1_db:dbget(S0#state.mname, H), S = S0#state{error_context=Type}, case Check(S, H, Type) of ok -> check_fold(S, T, Check); Error -> [Error|check_fold(S, T, Check)] end; check_fold(_, [], Check) when is_function(Check, 3) -> []. name_of_def(#'Externaltypereference'{type=N}) -> N; name_of_def(#'Externalvaluereference'{value=N}) -> N.