%% 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),
case S#state.erule of
ber ->
#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0};
_ -> []
end).
-define(TAG_CONSTRUCTED(Num),
case S#state.erule of
ber ->
#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32};
_ -> []
end).
-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),
_ = 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),
case {Terror3,Verror5,Cerror,Oerror,Exporterror,ImportError} 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,lists:flatten([Terror3,Verror5,Cerror,
Oerror,Exporterror,ImportError])}
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 = #module{ }) ->
case Module#module.imports of
{imports,[]} ->
[];
{imports,ImportList} when is_list(ImportList) ->
check_imports2(S,ImportList,[]);
_ ->
[]
end.
check_imports2(_S,[],Acc) ->
Acc;
check_imports2(S,[#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],Acc) ->
NameOfDef =
fun(#'Externaltypereference'{type=N}) -> N;
(#'Externalvaluereference'{value=N}) -> N
end,
Module = NameOfDef(ModuleRef),
Refs = [{M,R}||{{M,_},R} <- [{catch get_referenced_type(S,Ref),Ref}||Ref <- Imports]],
{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,NameOfDef(R))],
ReportError =
fun(Ref) ->
NewS=S#state{type=Ref,tname=NameOfDef(Ref)},
error({import,"imported undefined entity",NewS})
end,
check_imports2(S,SFMs,[ReportError(Err)||Err <- IllegalRefs]++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.
NameOfDef =
fun(#'Externaltypereference'{type=N}) -> N;
(#'Externalvaluereference'{value=N}) -> N;
(Other) -> Other
end,
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 [NameOfDef(X)||X <- Imports, NameOfDef(X) =:= N] of
[] -> F(SFMs,N,F);
[N] -> {NameOfDef(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};
{objectdef} ->
%% 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(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.
checko(S,[Name|Os],Acc,ExclO,ExclOS) ->
?dbg("Checking object ~p~n",[Name]),
Result =
case asn1_db:dbget(S#state.mname,Name) of
undefined ->
error({type,{internal_error,'???'},S});
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),
case is_class(S,RefType) of
true ->
NewState = update_state(S#state{type=RefType,
tname=TName},MName),
check_class(NewState,get_class_def(S,RefType));
_ ->
error({class,{internal_error,RefType},S})
end;
{pt,ClassRef,Params} ->
%% parameterized class
{_,PClassDef} = get_referenced_type(S,ClassRef),
NewParaList =
[match_parameters(S,TmpParam,S#state.parameters)||
TmpParam <- Params],
instantiate_pclass(S,PClassDef,NewParaList)
end;
check_class(S,C) when is_record(C,objectclass) ->
NewFieldSpec = check_class_fields(S,C#objectclass.fields),
C#objectclass{fields=NewFieldSpec};
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.
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),
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]),
%% io:format("check_object,object: ~p~n",[ObjectDef]),
% {MName,_ClassDef} = get_referenced_type(S,ClassRef),
NewClassRef = check_externaltypereference(S,ClassRef),
ClassDef =
case get_referenced_type(S,ClassRef) of
{MName,ClDef=#classdef{checked=false}} ->
NewState = update_state(S#state{type=ClDef,
tname=ClassRef#'Externaltypereference'.type},MName),
ObjClass=
check_class(NewState,ClDef),
#classdef{checked=true,
typespec=ObjClass};
{_,_ClDef} when is_record(_ClDef,classdef) ->
_ClDef;
{MName,_TDef=#typedef{checked=false,pos=Pos,
name=_TName,typespec=TS}} ->
ClDef = #classdef{pos=Pos,name=_TName,typespec=TS},
NewState = update_state(S#state{type=_TDef,
tname=ClassRef#'Externaltypereference'.type},MName),
ObjClass =
check_class(NewState,ClDef),
ClDef#classdef{checked=true,typespec=ObjClass};
{_,_ClDef} ->
_ClDef
end,
NewObj =
case ObjectDef of
Def when is_tuple(Def), (element(1,Def)==object) ->
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#typedef.typespec);
[] ->
%% An object with no fields. All class fields must be
%% optional or default. Check that all fields in
%% class are 'OPTIONAL' or 'DEFAULT'
class_fields_optional_check(S,ClassDef),
#'Object'{def={object,defaultsyntax,[]}};
_ ->
exit({error,{no_object,ObjectDef},S})
end,
Gen = gen_incl(S,NewObj#'Object'.def,
(ClassDef#classdef.typespec)#objectclass.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,ObjDef#typedef.typespec),
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,TmpParam,S#state.parameters)||
TmpParam <- 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,TmpParam,S#state.parameters)||
TmpParam <- Params],
instantiate_pos(S,ClassRef,PObjSetDef,NewParamList);
Unknown ->
exit({error,{unknown_object_set,Unknown},S})
end,
NewSet2 = remove_duplicate_objects(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(Set) when is_list(Set) ->
Pred = fun({A,B,_},{A,C,_}) when B =< C -> true;
({A,_,_},{B,_,_}) when A < B -> true;
('EXTENSIONMARK','EXTENSIONMARK') -> true;
(T,A) when is_tuple(T),is_atom(A) -> true;% EXTENSIONMARK last in list
(_,_) -> false
end,
lists:usort(Pred,Set).
%%
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(Ret) ->
Ret.
class_fields_optional_check(S,#classdef{typespec=ClassSpec}) ->
Fields = ClassSpec#objectclass.fields,
class_fields_optional_check1(S,Fields).
class_fields_optional_check1(_S,[]) ->
ok;
class_fields_optional_check1(S,[{typefield,_,'OPTIONAL'}|Rest]) ->
class_fields_optional_check1(S,Rest);
class_fields_optional_check1(S,[{fixedtypevaluefield,_,_,_,'OPTIONAL'}|Rest]) ->
class_fields_optional_check1(S,Rest);
class_fields_optional_check1(S,[{fixedtypevaluesetfield,_,_,'OPTIONAL'}|Rest]) ->
class_fields_optional_check1(S,Rest);
class_fields_optional_check1(S,[{objectfield,_,_,_,'OPTIONAL'}|Rest]) ->
class_fields_optional_check1(S,Rest);
class_fields_optional_check1(S,[{objectsetfield,_,_,'OPTIONAL'}|Rest]) ->
class_fields_optional_check1(S,Rest).
%% 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.
remove_duplicate_objects(osfo_intersection(InterSect,Acc)).
%% Acc.
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},FieldName} ->
{_,Def} = get_referenced_type(S,Object),
TypeDef = get_fieldname_element(S,Def,FieldName),
(TypeDef#typedef.typespec)#'ObjectSet'.set;
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,Param,S#state.parameters)||
Param<-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_fieldname_element/3
%% gets the type/value/object/... of the referenced element in FieldName
%% FieldName is a list and may have more than one element.
%% Each element in FieldName can be either {typefieldreference,AnyFieldName}
%% or {valuefieldreference,AnyFieldName}
%% Def is the def of the first object referenced by FieldName
get_fieldname_element(S,Def,[{_RefType,FieldName}]) when is_record(Def,typedef) ->
{_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def,
check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps));
get_fieldname_element(S,Def,[{_RefType,FieldName}|Rest])
when is_record(Def,typedef) ->
%% As FieldName is followd by other FieldNames it has to be an
%% object or objectset.
{_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def,
NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps)),
ObjDef = fun(#'Object'{def=D}) -> D;
(#'ObjectSet'{set=Set}) -> Set
end
(NewDef),
case ObjDef of
L when is_list(L) ->
[get_fieldname_element(S,X,Rest) || X <- L];
_ ->
get_fieldname_element(S,ObjDef,Rest)
end;
get_fieldname_element(S,{object,_,Fields},[{_RefType,FieldName}|Rest]) ->
NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,Fields)),
get_fieldname_element(S,NewDef,Rest);
get_fieldname_element(_S,Def,[]) ->
Def;
get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName])
when is_record(Def,typedef) ->
ok.
check_fieldname_element(S,{value,{_,Def}}) ->
check_fieldname_element(S,Def);
check_fieldname_element(S,TDef) when is_record(TDef,typedef) ->
check_type(S,TDef,TDef#typedef.typespec);
check_fieldname_element(S,VDef) when is_record(VDef,valuedef) ->
check_value(S,VDef);
check_fieldname_element(S,Eref)
when is_record(Eref,'Externaltypereference');
is_record(Eref,'Externalvaluereference') ->
{_,TDef}=get_referenced_type(S,Eref),
check_fieldname_element(S,TDef);
check_fieldname_element(S,Other) ->
throw({error,{assigned_object_error,"not_assigned_object",Other,S}}).
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(S,[],_,Opt,Acc) ->
case catch check_uniqueness(remove_duplicate_objects(Acc)) of
{asn1_error,_} when Opt =/= 'OPTIONAL' ->
error({'ObjectSet',"not unique objects in object set",S});
{asn1_error,_} ->
lists:reverse(Acc);
_ ->
lists:reverse(Acc)
end;
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.
check_uniqueness(NameValueList) ->
check_uniqueness1(lists:keysort(2,NameValueList)).
check_uniqueness1([]) ->
true;
check_uniqueness1([_]) ->
true;
check_uniqueness1([{_,N,_},{_,N,_}|_Rest]) ->
throw({asn1_error,{'objects in set must have unique values in UNIQUE fields',N}});
check_uniqueness1([_|Rest]) ->
check_uniqueness1(Rest).
%% 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_objectdefn(S,Def,CDef) when is_record(CDef,classdef) ->
WithSyntax = (CDef#classdef.typespec)#objectclass.syntax,
ClassFields = (CDef#classdef.typespec)#objectclass.fields,
case Def of
{object,defaultsyntax,Fields} ->
check_defaultfields(S,Fields,ClassFields);
{object,definedsyntax,Fields} ->
{_,WSSpec} = WithSyntax,
NewFields =
case catch( convert_definedsyntax(S,Fields,WSSpec,
ClassFields,[])) of
{asn1,{_ErrorType,ObjToken,ClassToken}} ->
throw({asn1,{'match error in object',ObjToken,
'found in object',ClassToken,'found in class'}});
Err={asn1,_} -> throw(Err);
Err={'EXIT',_} -> throw(Err);
DefaultFields when is_list(DefaultFields) ->
DefaultFields
end,
{object,defaultsyntax,NewFields};
{object,_ObjectId} -> % This is a DefinedObject
fixa;
Other ->
exit({error,{objectdefn,Other}})
end.
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{type=T,tname=Obj} = S,
case ordsets:subtract(Present, All) of
[] ->
ok;
[_|_]=Invalid ->
asn1_error(S, T, {invalid_fields,Invalid,Obj})
end,
case ordsets:subtract(Mandatory, Present) of
[] ->
check_defaultfields_1(S, Fields, ClassFields, []);
[_|_]=Missing ->
asn1_error(S, T, {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),
{NewField,RestFields} =
convert_to_defaultfield(S, FName, [Spec|Fields], CField),
check_defaultfields_1(S, RestFields, ClassFields, [NewField|Acc]).
convert_definedsyntax(_S,[],[],_ClassFields,Acc) ->
lists:reverse(Acc);
convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) ->
{MatchedField,RestFields,RestWS} =
match_field(S,Fields,WithSyntax,ClassFields),
if
is_list(MatchedField) ->
convert_definedsyntax(S,RestFields,RestWS,ClassFields,
lists:append(MatchedField,Acc));
true ->
convert_definedsyntax(S,RestFields,RestWS,ClassFields,
[MatchedField|Acc])
end.
get_mandatory_class_fields([{fixedtypevaluefield,Name,_,_,'MANDATORY'}|T]) ->
[Name|get_mandatory_class_fields(T)];
get_mandatory_class_fields([{objectfield,Name,_,_,'MANDATORY'}|T]) ->
[Name|get_mandatory_class_fields(T)];
get_mandatory_class_fields([{objectsetfield,Name,_,'MANDATORY'}|T]) ->
[Name|get_mandatory_class_fields(T)];
get_mandatory_class_fields([{typefield,Name,'MANDATORY'}|T]) ->
[Name|get_mandatory_class_fields(T)];
get_mandatory_class_fields([{variabletypevaluefield,Name,_,'MANDATORY'}|T]) ->
[Name|get_mandatory_class_fields(T)];
get_mandatory_class_fields([{variabletypevaluesetfield,
Name,_,'MANDATORY'}|T]) ->
[Name|get_mandatory_class_fields(T)];
get_mandatory_class_fields([_|T]) ->
get_mandatory_class_fields(T);
get_mandatory_class_fields([]) -> [].
match_field(S,Fields,WithSyntax,ClassFields) ->
match_field(S,Fields,WithSyntax,ClassFields,[]).
match_field(S,Fields,[W|Ws],ClassFields,Acc) when is_list(W) ->
case catch(match_optional_field(S,Fields,W,ClassFields,[])) of
{'EXIT',_} ->
match_field(Fields,Ws,ClassFields,Acc); %% add S
%% {[Result],RestFields} ->
%% {Result,RestFields,Ws};
{Result,RestFields} when is_list(Result) ->
{Result,RestFields,Ws};
_ ->
match_field(S,Fields,Ws,ClassFields,Acc)
end;
match_field(S,Fields,WithSyntax,ClassFields,_Acc) ->
match_mandatory_field(S,Fields,WithSyntax,ClassFields,[]).
match_optional_field(_S,RestFields,[],_,Ret) ->
{Ret,RestFields};
%% An additional optional field within an optional field
match_optional_field(S,Fields,[W|Ws],ClassFields,Ret) when is_list(W) ->
case catch match_optional_field(S,Fields,W,ClassFields,[]) of
{'EXIT',_} when length(Ws) > 0 ->
match_optional_field(S,Fields,Ws,ClassFields,Ret);
{'EXIT',_} ->
{Ret,Fields};
{asn1,{optional_matcherror,_,_}} when length(Ws) > 0 ->
match_optional_field(S,Fields,Ws,ClassFields,Ret);
{asn1,{optional_matcherror,_,_}} ->
{Ret,Fields};
{OptionalField,RestFields} ->
match_optional_field(S,RestFields,Ws,ClassFields,
lists:append(OptionalField,Ret))
end;
%% identify and skip word
match_optional_field(S,[{_,_,#'Externaltypereference'{type=WorS}}|Rest],
[WorS|Ws],ClassFields,Ret) ->
match_optional_field(S,Rest,Ws,ClassFields,Ret);
match_optional_field(S,[],_,ClassFields,Ret) ->
match_optional_field(S,[],[],ClassFields,Ret);
%% identify and skip comma
match_optional_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) ->
match_optional_field(S,Rest,Ws,ClassFields,Ret);
%% am optional setting inside another optional setting may be "double-listed"
match_optional_field(S,[Setting],DefinedSyntax,ClassFields,Ret)
when is_list(Setting) ->
match_optional_field(S,Setting,DefinedSyntax,ClassFields,Ret);
%% identify and save field data
match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) ->
?dbg("matching optional field setting: ~p with user friendly syntax: ~p~n",[Setting,W]),
WorS =
case Setting of
Type when is_record(Type,type) -> Type;
{'ValueFromObject',_,_} -> Setting;
{object,_,_} -> Setting;
{_,_,WordOrSetting} -> WordOrSetting;
Other -> Other
end,
case lists:keysearch(W,2,ClassFields) of
false ->
throw({asn1,{optional_matcherror,WorS,W}});
{value,CField} ->
{NewField,RestFields} =
convert_to_defaultfield(S,W,[WorS|Rest],CField),
match_optional_field(S,RestFields,Ws,ClassFields,[NewField|Ret])
end;
match_optional_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Ret) ->
throw({asn1,{optional_matcherror,WorS,W}}).
match_mandatory_field(_S,[],[],_,[Acc]) ->
{Acc,[],[]};
match_mandatory_field(_S,[],[],_,Acc) ->
{Acc,[],[]};
match_mandatory_field(S,[],[H|T],CF,Acc) when is_list(H) ->
match_mandatory_field(S,[],T,CF,Acc);
match_mandatory_field(_S,[],WithSyntax,_,_Acc) ->
throw({asn1,{mandatory_matcherror,[],WithSyntax}});
%match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,[Acc]) when is_list(W) ->
match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when is_list(W), length(Acc) >= 1 ->
{Acc,Fields,WithSyntax};
%% identify and skip word
%%match_mandatory_field(S,[{_,_,WorS}|Rest],
match_mandatory_field(S,[{_,_,#'Externaltypereference'{type=WorS}}|Rest],
[WorS|Ws],ClassFields,Acc) ->
match_mandatory_field(S,Rest,Ws,ClassFields,Acc);
%% identify and skip comma
match_mandatory_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) ->
match_mandatory_field(S,Rest,Ws,ClassFields,Ret);
%% identify and save field data
match_mandatory_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Acc) ->
?dbg("matching field setting: ~p with user friendly syntax: ~p~n",[Setting,W]),
WorS =
case Setting of
{object,_,_} -> Setting;
{_,_,WordOrSetting} -> WordOrSetting;
Type when is_record(Type,type) -> Type;
Other -> Other
end,
case lists:keysearch(W,2,ClassFields) of
false ->
throw({asn1,{mandatory_matcherror,WorS,W}});
{value,CField} ->
{NewField,RestFields} =
convert_to_defaultfield(S,W,[WorS|Rest],CField),
match_mandatory_field(S,RestFields,Ws,ClassFields,[NewField|Acc])
end;
match_mandatory_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Acc) ->
throw({asn1,{mandatory_matcherror,WorS,W}}).
%% Converts a field of an object from defined syntax to default syntax
%% A field may be a type, a fixed type value, an object, an objectset,
%%
convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)->
?dbg("convert field: ~p of type: ~p~n",[ObjFieldName,element(1,CField)]),
CurrMod = S#state.mname,
Strip_value_tag =
fun({value_tag,ValueSetting}) -> ValueSetting;
(VS) -> VS
end,
ObjFieldSetting = Strip_value_tag(OFS),
RestSettings = [Strip_value_tag(X)||X <- RestOFS],
case element(1,CField) of
typefield ->
TypeDef=
case ObjFieldSetting of
TypeRec when is_record(TypeRec,type) -> TypeRec#type.def;
TDef when is_record(TDef,typedef) ->
TDef#typedef{checked=true,
typespec=check_type(S,TDef,
TDef#typedef.typespec)};
_ -> ObjFieldSetting
end,
{Type,SettingsLeft} =
if
is_record(TypeDef,typedef) -> {TypeDef,RestSettings};
is_record(TypeDef,'ObjectClassFieldType') ->
T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
{oCFT_def(S,T),RestSettings};
% #typedef{checked=true,name=Name,typespec=IT};
is_tuple(TypeDef), element(1,TypeDef) == pt ->
%% this is an inlined type. If constructed
%% type save in data base
T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
#'Externaltypereference'{type=PtName} =
element(2,TypeDef),
NameList = [PtName,S#state.tname],
NewName = list_to_atom(asn1ct_gen:list2name(NameList)),
NewTDef=#typedef{checked=true,name=NewName,
typespec=T},
asn1_db:dbput(S#state.mname,NewName,NewTDef),
%%asn1ct_gen:insert_once(parameterized_objects,{NewName,type,NewTDef}),
insert_once(S,parameterized_objects,
{NewName,type,NewTDef}),
{NewTDef,RestSettings};
is_tuple(TypeDef), element(1,TypeDef)=='SelectionType' ->
T=check_type(S,#typedef{typespec=ObjFieldSetting},
ObjFieldSetting),
Name = type_name(S,T),
{#typedef{checked=true,name=Name,typespec=T},RestSettings};
true ->
case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of
ERef = #'Externaltypereference'{module=CurrMod} ->
{RefMod,T} = get_referenced_type(S,ERef),
check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings);
ERef = #'Externaltypereference'{} ->
{RefMod,T} = get_referenced_type(S,ERef),
check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings);
Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
T = check_type(S,#typedef{typespec=ObjFieldSetting},
ObjFieldSetting),
{#typedef{checked=true,name=Bif,typespec=T},RestSettings};
_ ->
%this case should not happen any more
{Mod,T} =
get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}),
case Mod of
CurrMod ->
{T,RestSettings};
ExtMod ->
#typedef{name=Name} = T,
{T#typedef{name={ExtMod,Name}},RestSettings}
end
end
end,
{{ObjFieldName,Type},SettingsLeft};
fixedtypevaluefield ->
case ObjFieldName of
Val when is_atom(Val) ->
%% ObjFieldSetting can be a value,an objectidentifiervalue,
%% an element in an enumeration or namednumberlist etc.
ValRef =
case ObjFieldSetting of
ValSetting=#'Externalvaluereference'{} ->
ValSetting;
{'ValueFromObject',{_,ObjRef},FieldName} ->
{_,Object} = get_referenced_type(S,ObjRef),
ChObject = check_object(S,Object,
Object#typedef.typespec),
get_fieldname_element(S,Object#typedef{typespec=ChObject},
FieldName);
ValSetting = #valuedef{} ->
ValSetting;
ValSetting = {'CHOICE',{Alt,_ChVal}} when is_atom(Alt) ->
#valuedef{type=element(3,CField),
value=ValSetting,
module=S#state.mname};
ValSetting ->
#identifier{val=ValSetting}
end,
?dbg("fixedtypevaluefield ValRef: ~p~n",[ValRef]),
case ValRef of
#valuedef{} ->
{{ObjFieldName,check_value(S,ValRef)},RestSettings};
_ ->
ValDef =
case catch get_referenced_type(S,ValRef) of
{error,_} ->
NewValDef =
#valuedef{name=Val,
type=element(3,CField),
value=ObjFieldSetting,
module=S#state.mname},
check_value(S,NewValDef);
{M,VDef} when is_record(VDef,valuedef) ->
check_value(update_state(S,M),
%%S#state{mname=M},
VDef);%% XXX
{M,VDef} ->
check_value(update_state(S,M),
%%S#state{mname=M},
#valuedef{name=Val,
type=element(3,CField),
value=VDef,
module=M})
end,
{{ObjFieldName,ValDef},RestSettings}
end;
Val ->
{{ObjFieldName,Val},RestSettings}
end;
fixedtypevaluesetfield ->
{{ObjFieldName,ObjFieldSetting},RestSettings};
objectfield ->
CheckObject =
fun(O) ->
O#typedef{checked=true,typespec=
check_object(S,O,O#typedef.typespec)}
end,
ObjectSpec =
case ObjFieldSetting of
Ref when is_record(Ref,'Externalvaluereference') ->
%% The object O might be a #valuedef{} if
%% e.g. the definition looks like
%% myobj SOMECLASS ::= referencedObject
{M,O} = get_referenced_type(S,Ref),
check_object(S,O,object_to_check(O)),
Ref#'Externalvaluereference'{module=M};
{'ValueFromObject',{_,ObjRef},FieldName} ->
%% This is an ObjectFromObject
{_,Object} = get_referenced_type(S,ObjRef),
ChObject = check_object(S,Object,
Object#typedef.typespec),
ObjFromObj=
get_fieldname_element(S,Object#typedef{
typespec=ChObject},
FieldName),
CheckObject(ObjFromObj);
ObjDef={object,_,_} ->
%% An object defined inlined in another object
%% class is an objectfield, that implies that
%% {objectsetfield,TypeFieldName,DefinedObjecClass,
%% OptionalitySpec}
%% DefinedObjecClass = #'Externaltypereference'{}|
%% 'TYPE-IDENTIFIER' | 'ABSTRACT-SYNTAX'
ClassName = element(3,CField),
InlinedObjName=
list_to_atom(lists:concat([S#state.tname]++
['_',ObjFieldName])),
ObjSpec = #'Object'{classname=ClassName,
def=ObjDef},
CheckedObj=
check_object(S,#typedef{typespec=ObjSpec},ObjSpec),
InlObj = #typedef{checked=true,name=InlinedObjName,
typespec=CheckedObj},
ObjKey = {InlinedObjName,InlinedObjName},
%% asn1ct_gen:insert_once(inlined_objects,ObjKey),
insert_once(S,inlined_objects,ObjKey),
%% Which module to use here? Could it be other than top_module ?
%% asn1_db:dbput(S#state.mname,InlinedObjName,InlObj),
asn1_db:dbput(get(top_module),InlinedObjName,InlObj),
InlObj;
#type{def=Eref} when is_record(Eref,'Externaltypereference') ->
{_,O} = get_referenced_type(S,Eref),
CheckObject(O);
Other ->
{_,O} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Other}),
CheckObject(O)
end,
{{ObjFieldName,ObjectSpec},RestSettings};
variabletypevaluefield ->
{{ObjFieldName,ObjFieldSetting},RestSettings};
variabletypevaluesetfield ->
{{ObjFieldName,ObjFieldSetting},RestSettings};
%% objectset_or_fixedtypevalueset_field ->
%% ok;
objectsetfield ->
ObjSetSpec = get_objectset_def(S,ObjFieldSetting,CField),
?dbg("objectsetfield, ObjSetSpec:~p~n",[ObjSetSpec]),
{{ObjFieldName,
ObjSetSpec#typedef{checked=true,
typespec=check_object(S,ObjSetSpec,
ObjSetSpec#typedef.typespec)}},RestSettings}
end.
get_objectset_def(S,Ref,CField)
when is_record(Ref,'Externaltypereference');
is_record(Ref,'Externalvaluereference') ->
{_M,T}=get_referenced_type(S,Ref),
get_objectset_def2(S,T,CField);
get_objectset_def(S,ObjectList,CField) when is_list(ObjectList) ->
%% an objctset defined in the object,though maybe
%% parsed as a SequenceOfValue
%% The ObjectList may be a list of references to
%% objects, a ValueFromObject
?dbg("objectsetfield: ~p~n",[CField]),
get_objectset_def2(S,ObjectList,CField);
get_objectset_def(S,'EXTENSIONMARK',CField) ->
?dbg("objectsetfield: ~p~n",[CField]),
get_objectset_def2(S,['EXTENSIONMARK'],CField);
get_objectset_def(_S,ObjFieldSetting={'SingleValue',_},CField) ->
%% a Union of defined objects
?dbg("objectsetfield, SingleValue~n",[]),
union_of_defed_objs(CField,ObjFieldSetting);
get_objectset_def(_S,ObjFieldSetting={{'SingleValue',_},_},CField) ->
%% a Union of defined objects
?dbg("objectsetfield, SingleValue~n",[]),
union_of_defed_objs(CField,ObjFieldSetting);
get_objectset_def(S,{object,_,[#type{def={'TypeFromObject',
{object,RefedObj},
FieldName}}]},_CField) ->
%% This case occurs when an ObjectSetFromObjects
%% production is used
{_M,Def} = get_referenced_type(S,RefedObj),
get_fieldname_element(S,Def,FieldName);
get_objectset_def(S,{object,_,[{setting,_,ERef}]},CField)
when is_record(ERef,'Externaltypereference') ->
{_,T} = get_referenced_type(S,ERef),
get_objectset_def2(S,T,CField);
get_objectset_def(S,#type{def=ERef},_CField)
when is_record(ERef,'Externaltypereference') ->
{_,T} = get_referenced_type(S,ERef),
T;
get_objectset_def(S,ObjFieldSetting,CField)
when is_atom(ObjFieldSetting) ->
ERef = #'Externaltypereference'{module=S#state.mname,
type=ObjFieldSetting},
{_,T} = get_referenced_type(S,ERef),
get_objectset_def2(S,T,CField).
get_objectset_def2(_S,T = #typedef{typespec=#'Object'{}},_CField) ->
#typedef{typespec=#'Object'{classname=Class,def=Def}} = T,
T#typedef{typespec=#'ObjectSet'{class=Class,set=[Def]}};
get_objectset_def2(_S,Set,CField) when is_list(Set) ->
{_,_,Type,_} = CField,
ClassDef = Type#type.def,
#typedef{typespec=#'ObjectSet'{class=ClassDef,
set=Set}};
get_objectset_def2(_S,T = #typedef{typespec=#'ObjectSet'{}},_CField) ->
T;
get_objectset_def2(S,T,_CField) ->
asn1ct:warning("get_objectset_def2: uncontrolled object set structure:~n~p~n",
[T],S,"get_objectset_def2: uncontrolled object set structure").
type_name(S,#type{def=Def}) ->
CurrMod = S#state.mname,
case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of
#'Externaltypereference'{module=CurrMod,type=Name} ->
Name;
#'Externaltypereference'{module=Mod,type=Name} ->
{Mod,Name};
Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
Bif
end.
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(S,T) ->
case get_OCFT_inner(S,T) of
ERef=#'Externaltypereference'{} -> ERef;
{Name,Type} -> #typedef{checked=true,name=Name,typespec=Type};
'ASN1_OPEN_TYPE' ->
#typedef{checked=true,typespec=T#type{def='ASN1_OPEN_TYPE'}}
end.
get_OCFT_inner(_S,T) ->
% Module=S#state.mname,
Def = T#type.def,
case Def#'ObjectClassFieldType'.type of
{fixedtypevaluefield,_,InnerType} ->
case asn1ct_gen:type(asn1ct_gen:get_inner(InnerType#type.def)) of
Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
{Bif,InnerType};
ERef = #'Externaltypereference'{} ->
ERef
end;
'ASN1_OPEN_TYPE' -> 'ASN1_OPEN_TYPE'
end.
union_of_defed_objs({_,_,_ObjClass=#type{def=ClassDef},_},ObjFieldSetting) ->
#typedef{typespec=#'ObjectSet'{class = ClassDef,
set = ObjFieldSetting}};
union_of_defed_objs({_,_,DefObjClassRef,_},ObjFieldSetting)
when is_record(DefObjClassRef,'Externaltypereference') ->
#typedef{typespec=#'ObjectSet'{class = DefObjClassRef,
set = ObjFieldSetting}}.
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=Vtype,value=Value,module=ModName} = V0,
V = V0#valuedef{checked=true},
Def = Vtype#type.def,
Constr = Vtype#type.constraint,
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
#classdef{} ->
throw({objectdef});
#typedef{typespec=TypeSpec} ->
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;
'ANY' ->
{opentypefieldvalue,ANYType,ANYValue} = Value,
CheckedV = check_value(SVal,#valuedef{name=Name,
type=ANYType,
value=ANYValue,
module=ModName}),
V#valuedef{value=CheckedV#valuedef.value};
'INTEGER' ->
ok = validate_integer(SVal, Value, [], Constr),
V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
{'INTEGER',NamedNumberList} ->
ok = validate_integer(SVal, Value, NamedNumberList, Constr),
V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
#'SEQUENCE'{components=Components} ->
{ok,SeqVal} = validate_sequence(SVal, Value,
Components, Constr),
V#valuedef{value=normalize_value(SVal, Vtype,
SeqVal, TopName)};
{'SelectionType',SelName,SelT} ->
CheckedT = check_selectiontype(SVal, SelName, SelT),
NewV = V#valuedef{type=CheckedT},
SelVDef = check_value(S1#state{value=NewV}, NewV),
V#valuedef{value=SelVDef#valuedef.value};
_ ->
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.
% validate_integer(S,{identifier,Pos,Id},NamedNumberList,Constr) ->
% case lists:keysearch(Id,1,NamedNumberList) of
% {value,_} -> ok;
% false -> error({value,"unknown NamedNumber",S})
% end;
%% This case occurs when there is a valuereference
%% validate_integer(S=#state{mname=M},
%% #'Externalvaluereference'{module=M,value=Id}=Ref,
validate_integer(S,#'Externalvaluereference'{value=Id}=Ref,
NamedNumberList,Constr) ->
case lists:keysearch(Id,1,NamedNumberList) of
{value,_} -> ok;
false -> validate_integer_ref(S,Ref,NamedNumberList,Constr)
%%error({value,"unknown NamedNumber",S})
end;
validate_integer(S,Id,NamedNumberList,Constr) when is_atom(Id) ->
case lists:keysearch(Id,1,NamedNumberList) of
{value,_} -> ok;
false -> validate_integer_ref(S,Id,NamedNumberList,Constr)
%error({value,"unknown NamedNumber",S})
end;
validate_integer(_S,Value,_NamedNumberList,Constr) when is_integer(Value) ->
check_integer_range(Value,Constr).
validate_integer_ref(S,Id,_,_) when is_atom(Id) ->
error({value,"unknown integer referens",S});
validate_integer_ref(S,Ref,NamedNumberList,Constr) ->
case get_referenced_type(S,Ref) of
{M,V} when is_record(V,valuedef) ->
NewS = update_state(S,M),
case check_value(NewS,V) of
#valuedef{type=#type{def='INTEGER'},value=Value} ->
validate_integer(NewS,Value,NamedNumberList,Constr);
_Err -> error({value,"unknown integer referens",S})
end;
_ ->
error({value,"unknown integer referens",S})
end.
check_integer_range(_Int, Constr) when is_list(Constr) ->
ok.
%%------------
%% This can be removed when the old parser is removed
%% The function removes 'space' atoms from the list
is_space_list([H],Acc) ->
lists:reverse([H|Acc]);
is_space_list([H,space|T],Acc) ->
is_space_list(T,[H|Acc]);
is_space_list([],Acc) ->
lists:reverse(Acc);
is_space_list([H|T],Acc) ->
is_space_list(T,[H|Acc]).
validate_objectidentifier(S,OID,ERef,C)
when is_record(ERef,'Externalvaluereference') ->
validate_objectidentifier(S,OID,[ERef],C);
validate_objectidentifier(S,OID,Tup,C) when is_tuple(Tup) ->
validate_objectidentifier(S,OID,tuple_to_list(Tup),C);
validate_objectidentifier(S,OID,L,_) ->
NewL = is_space_list(L,[]),
case validate_objectidentifier1(S,OID,NewL) of
NewL2 when is_list(NewL2) ->{ok,list_to_tuple(NewL2)};
Other -> {ok,Other}
end.
validate_objectidentifier1(S, OID, [Id|T])
when is_record(Id,'Externalvaluereference') ->
case catch get_referenced_type(S,Id) of
{M,V} when is_record(V,valuedef) ->
NewS = update_state(S,M),
case check_value(NewS,V) of
#valuedef{type=#type{def=ERef},checked=true,
value=Value} when is_tuple(Value) ->
case is_object_id(OID,NewS,ERef) of
true ->
%% T must be a RELATIVE-OID
validate_oid(true,NewS, rel_oid, T, lists:reverse(tuple_to_list(Value)));
_ ->
error({value, {"illegal "++to_string(OID),[Id|T]}, S})
end;
_ ->
error({value, {"illegal "++to_string(OID),[Id|T]}, S})
end;
_ ->
validate_oid(true,S, OID, [Id|T], [])
end;
validate_objectidentifier1(S,OID,V) ->
validate_oid(true,S,OID,V,[]).
validate_oid(false, S, OID, V, Acc) ->
error({value, {"illegal "++to_string(OID), V,Acc}, S});
validate_oid(_,_, _, [], Acc) ->
lists:reverse(Acc);
validate_oid(_, S, OID, [Value|Vrest], Acc) when is_integer(Value) ->
validate_oid(valid_objectid(OID,Value,Acc),S, OID, Vrest, [Value|Acc]);
validate_oid(_, S, OID, [{'NamedNumber',_Name,Value}|Vrest], Acc)
when is_integer(Value) ->
validate_oid(valid_objectid(OID,Value,Acc), S, OID, Vrest, [Value|Acc]);
validate_oid(_, S, OID, [Id|Vrest], Acc)
when is_record(Id,'Externalvaluereference') ->
case catch get_referenced_type(S, Id) of
{M,V} when is_record(V,valuedef) ->
NewS = update_state(S,M),
NewVal = case check_value(NewS, V) of
#valuedef{checked=true,value=Value} ->
fun(Int) when is_integer(Int) -> [Int];
(L) when is_list(L) -> L;
(T) when is_tuple(T) -> tuple_to_list(T)
end (Value);
_ ->
error({value, {"illegal "++to_string(OID),
[Id|Vrest],Acc}, S})
end,
case NewVal of
List when is_list(List) ->
validate_oid(valid_objectid(OID,NewVal,Acc), NewS,
OID, Vrest,lists:reverse(NewVal)++Acc);
_ ->
NewVal
end;
_ ->
case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of
Value when is_integer(Value) ->
validate_oid(valid_objectid(OID,Value,Acc),
S, OID,Vrest, [Value|Acc]);
false ->
error({value, {"illegal "++to_string(OID),[Id,Vrest],Acc}, S})
end
end;
validate_oid(_, S, OID, [{Atom,Value}],[])
when is_atom(Atom),is_integer(Value) ->
%% this case when an OBJECT IDENTIFIER value has been parsed as a
%% SEQUENCE value
Rec = #'Externalvaluereference'{module=S#state.mname,
value=Atom},
validate_objectidentifier1(S, OID, [Rec,Value]);
validate_oid(_, S, OID, [{Atom,EVRef}],[])
when is_atom(Atom),is_record(EVRef,'Externalvaluereference') ->
%% this case when an OBJECT IDENTIFIER value has been parsed as a
%% SEQUENCE value OTP-4354
Rec = #'Externalvaluereference'{module=EVRef#'Externalvaluereference'.module,
value=Atom},
validate_objectidentifier1(S, OID, [Rec,EVRef]);
validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) ->
Rec = #'Externalvaluereference'{module=S#state.mname,
value=Atom},
validate_oid(true,S, OID, [Rec|Rest],Acc);
validate_oid(_, S, OID, V, Acc) ->
error({value, {"illegal "++to_string(OID),V,Acc},S}).
is_object_id(OID,S,ERef=#'Externaltypereference'{}) ->
{_,OI} = get_referenced_type(S,ERef),
is_object_id(OID,S,OI#typedef.typespec);
is_object_id(o_id,_S,'OBJECT IDENTIFIER') ->
true;
is_object_id(rel_oid,_S,'RELATIVE-OID') ->
true;
is_object_id(_,_S,'INTEGER') ->
true;
is_object_id(OID,S,#type{def=Def}) ->
is_object_id(OID,S,Def);
is_object_id(_,_S,_) ->
false.
to_string(o_id) ->
"OBJECT IDENTIFIER";
to_string(rel_oid) ->
"RELATIVE-OID".
%% 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.
valid_objectid(_OID,[],_Acc) ->
true;
valid_objectid(OID,[H|T],Acc) ->
case valid_objectid(OID, H, Acc) of
true ->
valid_objectid(OID,T,[H|Acc]);
_ ->
false
end;
valid_objectid(o_id,I,[]) when I =:= 0; I =:= 1; I =:= 2 -> true;
valid_objectid(o_id,_I,[]) -> false;
valid_objectid(o_id,I,[0]) when I >= 0; I =< 4 -> true;
valid_objectid(o_id,_I,[0]) -> false;
valid_objectid(o_id,I,[1]) when I =:= 0; I =:= 2; I =:= 3 -> true;
valid_objectid(o_id,_I,[1]) -> false;
valid_objectid(o_id,_I,[2]) -> true;
valid_objectid(_,_,_) -> true.
validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
case Vtype of
#type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} ->
%% this is an 'EXTERNAL' (or INSTANCE OF)
case Value of
[{identification,_}|_RestVal] ->
{ok,to_EXTERNAL1990(S,Value)};
_ ->
{ok,Value}
end;
_ ->
{ok,Value}
end.
to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) ->
to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]);
to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) ->
to_EXTERNAL1990(S,Rest,[{'indirect-reference',I}]);
to_EXTERNAL1990(S,[{identification,{'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) ->
to_EXTERNAL1990(S,Rest,[{'indirect-reference',PCid},{'direct-reference',TrStx}]);
to_EXTERNAL1990(S,_) ->
error({value,"illegal value in EXTERNAL type",S}).
to_EXTERNAL1990(S,[V={'data-value-descriptor',_}|Rest],Acc) ->
to_EXTERNAL1990(S,Rest,[V|Acc]);
to_EXTERNAL1990(_S,[{'data-value',Val}],Acc) ->
Encoding = {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(S,Value,CType);
{'BIT STRING',CType,_} ->
normalize_bitstring(S,Value,CType);
{'OCTET STRING',CType,_} ->
normalize_octetstring(S0, Value, CType);
{'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,{Name,Int},_) when is_atom(Name),is_integer(Int) ->
Int;
normalize_integer(S,{Name,Int=#'Externalvaluereference'{}},
Type) when is_atom(Name) ->
normalize_integer(S,Int,Type);
normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) ->
case Type of
NNL when is_list(NNL) ->
case lists:keysearch(Name,1,NNL) of
{value,{Name,Val}} ->
Val;
false ->
get_normalized_value(S,Int,Type,
fun normalize_integer/3,[])
end;
_ ->
get_normalized_value(S,Int,Type,fun normalize_integer/3,[])
end;
normalize_integer(_,Int,_) ->
exit({'Unknown INTEGER value',Int}).
%% 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'{} ->
get_normalized_value(S, Value, Type,
fun normalize_bitstring/3, []);
RecList when is_list(RecList) ->
F = fun(#'Externalvaluereference'{value=Name}) ->
case lists:keymember(Name, 1, Type) of
true -> Name;
false -> throw({error,false})
end;
(Name) when is_atom(Name) ->
%% Already normalized.
Name;
(Other) ->
throw({error,Other})
end,
try
lists:map(F, RecList)
catch
throw:{error,Reason} ->
asn1ct:warning("default value not "
"compatible with type definition ~p~n",
[Reason],S,
"default value not "
"compatible with type definition"),
Value
end;
Bs when is_bitstring(Bs) ->
%% Already normalized.
Bs
end.
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 -> <<Bs/bitstring,0:(8-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,CType) ->
case Value of
{bstring,String} ->
bstring_to_binary(String);
{hstring,String} ->
hstring_to_binary(String);
Rec when is_record(Rec,'Externalvaluereference') ->
get_normalized_value(S,Value,CType,
fun normalize_octetstring/3,[]);
{Name,String} when is_atom(Name) ->
normalize_octetstring(S,String,CType);
_ ->
Item = S#state.value,
asn1_error(S, Item, illegal_octet_string_value)
end.
normalize_objectidentifier(S, Value) ->
{ok,Val} = validate_objectidentifier(S, o_id, Value, []),
Val.
normalize_relative_oid(S,Value) ->
{ok,Val} = validate_objectidentifier(S, rel_oid, Value, []),
Val.
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,Value) ->
ComponentNames = lists:map(fun(#'ComponentType'{name=Cname}) -> Cname end,
Components),
sort_value1(ComponentNames,Value,[]).
sort_value1(_,V=#'Externalvaluereference'{},_) ->
%% sort later, get the value in normalize_seq_or_set
V;
sort_value1([N|Ns],Value,Acc) ->
case lists:keysearch(N,1,Value) of
{value,V} ->sort_value1(Ns,Value,[V|Acc]);
_ -> sort_value1(Ns,Value,Acc)
end;
sort_value1([],_,Acc) ->
lists:reverse(Acc).
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,[{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
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) ->
%Tag = Ts#type.tag,
%Constr = Ts#type.constraint,
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_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_parameters(S,Ts#type.def,S#state.parameters) 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_non_typedef(S, Tref),
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 is_class(S,RefTypeDef) of
true -> throw({asn1_class,RefTypeDef});
_ -> ok
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,
{RefType1,#'Externaltypereference'{module=RefMod,
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
NewS2 = S#state{type=#typedef{typespec=RefType}},
NewC =
constraint_merge(NewS2,
check_constraints(NewS2,Constr)++
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 = case S#state.erule of
ber ->
merge_tags(Ct,RefType#type.tag);
_ ->
Ct
end
}
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,Constr)},
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,Constr),
%% erlang:display({asn1ct_check,NamedNumberList,NewL}),
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))};
%% This is a temporary hack until the full Information Obj Spec
%% in X.681 is supported
{#'Externaltypereference'{type='TYPE-IDENTIFIER'},
[{typefieldreference,_,'Type'}]} ->
Ct=maybe_illicit_implicit_tag(open_type,Tag),
TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
{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,TmpParam,S#state.parameters)||
TmpParam <- 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};
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, 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}}).
get_non_typedef(S, Tref0) ->
case get_referenced_type(S, Tref0) of
{_,#typedef{typespec=#type{def=#'Externaltypereference'{}=Tref}}} ->
get_non_typedef(S, Tref);
{_,Type} ->
Type
end.
%%
%% 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_type_from_object(S,Object,TypeField)
when is_record(Object,'Externaltypereference');
is_record(Object,'Externalvaluereference') ->
{_,ObjectDef} = get_referenced_type(S,Object),
ObjSpec = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
get_fieldname_element(S,ObjectDef#typedef{typespec=ObjSpec},TypeField).
is_class(_S,#classdef{}) ->
true;
is_class(S,#typedef{typespec=#type{def=Eref}})
when is_record(Eref,'Externaltypereference')->
is_class(S,Eref);
is_class(S,Eref) when is_record(Eref,'Externaltypereference')->
{_,NextDef} = get_referenced_type(S,Eref),
is_class(S,NextDef);
is_class(_,_) ->
false.
get_class_def(_S,CD=#classdef{}) ->
CD;
get_class_def(S,#typedef{typespec=#type{def=Eref}})
when is_record(Eref,'Externaltypereference') ->
{_,NextDef} = get_referenced_type(S,Eref),
get_class_def(S,NextDef).
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,ActArg)} of
%% {absent,beginning_uppercase} -> %% a type
%% categorize(S,type,ActArg);
{type,beginning_lowercase} -> %% a value
categorize(S,value,Governor,ActArg);
{type,beginning_uppercase} -> %% a value set
categorize(S,value_set,ActArg);
%% {absent,entirely_uppercase} -> %% a class
%% categorize(S,class,ActArg);
{{class,ClassRef},beginning_lowercase} ->
categorize(S,object,ActArg,ClassRef);
{{class,ClassRef},beginning_uppercase} ->
categorize(S,object_set,ActArg,ClassRef);
_ ->
[ActArg]
end;
categorize_arg(S,FormalArg,ActualArg) ->
%% governor is absent => a type or a class
case FormalArg of
#'Externaltypereference'{type=Name} ->
case is_class_name(Name) of
true ->
categorize(S,class,ActualArg);
_ ->
categorize(S,type,ActualArg)
end;
FA ->
throw({error,{unexpected_formal_argument,FA}})
end.
governor_category(S,#type{def=Eref})
when is_record(Eref,'Externaltypereference') ->
governor_category(S,Eref);
governor_category(_S,#type{}) ->
type;
governor_category(S,Ref) when is_record(Ref,'Externaltypereference') ->
case is_class(S,Ref) of
true ->
{class,Ref};
_ ->
type
end;
governor_category(_,Class)
when Class == 'TYPE-IDENTIFIER'; Class == 'ABSTRACT-SYNTAX' ->
class.
%% governor_category(_,_) ->
%% absent.
%% 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'{type=Name}) ->
name_category(Name);
parameter_name_style(_,#'Externalvaluereference'{value=Name}) ->
name_category(Name);
parameter_name_style(_,{valueset,_}) ->
%% It is a object set or value set
beginning_uppercase;
parameter_name_style(#'Externalvaluereference'{},_) ->
beginning_lowercase;
parameter_name_style(#'Externaltypereference'{type=Name},_) ->
name_category(Name);
parameter_name_style(_,_) ->
undefined.
name_category(Atom) when is_atom(Atom) ->
name_category(atom_to_list(Atom));
name_category([H|T]) ->
case is_lowercase(H) of
true ->
beginning_lowercase;
_ ->
case is_class_name(T) of
true ->
entirely_uppercase;
_ ->
beginning_uppercase
end
end;
name_category(_) ->
undefined.
is_lowercase(X) when X >= $A,X =< $W ->
false;
is_lowercase(_) ->
true.
is_class_name(Name) when is_atom(Name) ->
is_class_name(atom_to_list(Name));
is_class_name(Name) ->
case [X||X <- Name, X >= $a,X =< $w] of
[] ->
true;
_ ->
false
end.
%% categorize(S,Category,Parameter) -> CategorizedParameter
%% If Parameter has an abstract syntax of another category than
%% Category, transform it to a known syntax.
categorize(_S,type,{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(_S,type,Def) when is_record(Def,type) ->
[#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,C) when is_list(C) ->
check_constraints(S, C, []).
resolv_tuple_or_list(S,List) when is_list(List) ->
lists:map(fun(X)->resolv_value(S,X) end, List);
resolv_tuple_or_list(S,{Lb,Ub}) ->
{resolv_value(S,Lb),resolv_value(S,Ub)}.
%%%-----------------------------------------
%% If the constraint value is a defined value the valuename
%% is replaced by the actual value
%%
resolv_value(S,Val) ->
Id = match_parameters(S,Val, S#state.parameters),
resolv_value1(S,Id).
resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) ->
case catch resolve_namednumber(S, S#state.type, Name) of
V when is_integer(V) ->
V;
_ ->
case get_referenced_type(S,ERef) of
{Err,_Reason} when Err == error; Err == 'EXIT' ->
throw({error,{asn1,{undefined_type_or_value,
Name}}});
{_M,VDef} ->
resolv_value1(S,VDef)
end
end;
resolv_value1(S, {gt,V}) ->
case resolv_value1(S, V) of
Int when is_integer(Int) ->
Int + 1;
Other ->
throw({error,{asn1,{not_integer_value,Other}}})
end;
resolv_value1(S, {lt,V}) ->
case resolv_value1(S, V) of
Int when is_integer(Int) ->
Int - 1;
Other ->
throw({error,{asn1,{not_integer_value,Other}}})
end;
resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference,
FieldName}]}) ->
%% FieldName can hold either a fixed-type value or a variable-type value
%% Object is a DefinedObject, i.e. a #'Externaltypereference'
resolve_value_from_object(S,Object,FieldName);
resolv_value1(_,#valuedef{checked=true,value=V}) ->
V;
resolv_value1(S,#valuedef{type=_T,
value={'ValueFromObject',{object,Object},
[{valuefieldreference,
FieldName}]}}) ->
resolve_value_from_object(S,Object,FieldName);
resolv_value1(S,VDef = #valuedef{}) ->
#valuedef{value=Val} = check_value(S,VDef),
Val;
resolv_value1(_,V) ->
V.
resolve_value_from_object(S,Object,FieldName) ->
{_,ObjTDef} = get_referenced_type(S,Object),
TS = check_object(S,ObjTDef,ObjTDef#typedef.typespec),
{_,_,Components} = TS#'Object'.def,
case lists:keysearch(FieldName,1,Components) of
{value,{_,#valuedef{value=Val}}} ->
Val;
_ ->
error({value,"illegal value in constraint",S})
end.
resolve_namednumber(S,#typedef{typespec=Type},Name) ->
case Type#type.def of
{'ENUMERATED',NameList} ->
resolve_namednumber_1(S, Name, NameList, Type);
{'INTEGER',NameList} ->
resolve_namednumber_1(S, Name, NameList, Type);
_ ->
not_enumerated
end.
resolve_namednumber_1(S, Name, NameList, Type) ->
NamedNumberList = check_enumerated(S, NameList, Type#type.constraint),
{_,N} = lookup_enum_value(S, Name, NamedNumberList),
N.
check_constraints(S,[{'ContainedSubtype',Type} | Rest], 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,Rest,CType#type.constraint ++ Acc);
check_constraints(S,[C | Rest], Acc) ->
check_constraints(S,Rest,[check_constraint(S,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,Ext) when is_record(Ext,'Externaltypereference') ->
check_externaltypereference(S,Ext);
check_constraint(S,{'SizeConstraint',{Lb,Ub}})
when is_list(Lb); tuple_size(Lb) =:= 2 ->
NewLb = range_check(resolv_tuple_or_list(S,Lb)),
NewUb = range_check(resolv_tuple_or_list(S,Ub)),
{'SizeConstraint',{NewLb,NewUb}};
check_constraint(S,{'SizeConstraint',{Lb,Ub}}) ->
case {resolv_value(S,Lb),resolv_value(S,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,{'SizeConstraint',Lb}) ->
{'SizeConstraint',resolv_value(S,Lb)};
check_constraint(S,{'SingleValue', L}) when is_list(L) ->
F = fun(A) -> resolv_value(S,A) end,
{'SingleValue',lists:sort(lists:map(F,L))};
check_constraint(S,{'SingleValue', V}) when is_integer(V) ->
Val = resolv_value(S,V),
%% [{'SingleValue',Val},{'ValueRange',{Val,Val}}]; % Why adding value range?
{'SingleValue',Val};
check_constraint(S,{'SingleValue', V}) ->
{'SingleValue',resolv_value(S,V)};
check_constraint(S,{'ValueRange', {Lb, Ub}}) ->
{'ValueRange',{resolv_value(S,Lb),resolv_value(S,Ub)}};
%% In case of a constraint with extension marks like (1..Ub,...)
check_constraint(S,{VR={'ValueRange', {_Lb, _Ub}},Rest}) ->
{check_constraint(S,VR),Rest};
check_constraint(_S,{'PermittedAlphabet',PA}) ->
{'PermittedAlphabet',permitted_alphabet_cnstr(PA)};
check_constraint(S,{valueset,Type}) ->
{valueset,check_type(S,S#state.tname,Type)};
check_constraint(_S,ST={simpletable,Type}) when is_atom(Type) ->
%% An already checked constraint
ST;
check_constraint(S,{simpletable,Type}) ->
Def = case Type of
#type{def=D} -> D;
{'SingleValue',ObjRef = #'Externalvaluereference'{}} ->
ObjRef
end,
C = match_parameters(S,Def,S#state.parameters),
case C of
#'Externaltypereference'{} ->
ERef = check_externaltypereference(S,C),
{simpletable,ERef#'Externaltypereference'.type};
#type{def=#'Externaltypereference'{}=ExtTypeRef} ->
ERef = check_externaltypereference(S, ExtTypeRef),
{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',{_,ORef},FieldName} ->
%% This is an ObjectFromObject
{_,Object} = get_referenced_type(S,ORef),
ChObject = check_object(S,Object,
Object#typedef.typespec),
ObjFromObj=
get_fieldname_element(S,Object#typedef{
typespec=ChObject},
FieldName),
{simpletable,ObjFromObj};
%% ObjFromObj#typedef{checked=true,typespec=
%% check_object(S,ObjFromObj,
%% ObjFromObj#typedef.typespec)}};
_ ->
check_type(S,S#state.tname,Type),%% this seems stupid.
OSName = Def#'Externaltypereference'.type,
{simpletable,OSName}
end;
check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) ->
%% Objset is an 'Externaltypereference' record, since Objset is
%% a DefinedObjectSet.
RealObjset = match_parameters(S,Objset,S#state.parameters),
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,Type) when is_record(Type,type) ->
#type{def=Def} = check_type(S,S#state.tname,Type),
Def;
check_constraint(S,C) when is_list(C) ->
lists:map(fun(X)->check_constraint(S,X) end,C);
% else keep the constraint unchanged
check_constraint(_S,Any) ->
% io:format("Constraint = ~p~n",[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_type(S,Ext) when is_record(Ext,'Externaltypereference') ->
case match_parameters(S,Ext, S#state.parameters) of
Ext ->
#'Externaltypereference'{pos=Pos,module=Emod,type=Etype} = Ext,
case S#state.mname of
Emod -> % a local reference in this module
get_referenced1(S,Emod,Etype,Pos);
_ ->% always when multi file compiling
case lists:member(Emod,S#state.inputmodules) of
true ->
get_referenced1(S,Emod,Etype,Pos);
false ->
get_referenced(S,Emod,Etype,Pos)
end
end;
ERef = #'Externaltypereference'{} ->
get_referenced_type(S,ERef);
Other ->
{undefined,Other}
end;
get_referenced_type(S=#state{mname=Emod},
ERef=#'Externalvaluereference'{pos=P,module=Emod,
value=Eval}) ->
case match_parameters(S,ERef,S#state.parameters) of
ERef ->
get_referenced1(S,Emod,Eval,P);
OtherERef when is_record(OtherERef,'Externalvaluereference') ->
get_referenced_type(S,OtherERef);
Value ->
{Emod,Value}
end;
get_referenced_type(S,ERef=#'Externalvaluereference'{pos=Pos,module=Emod,
value=Eval}) ->
case match_parameters(S,ERef,S#state.parameters) of
ERef ->
case lists:member(Emod,S#state.inputmodules) of
true ->
get_referenced1(S,Emod,Eval,Pos);
false ->
get_referenced(S,Emod,Eval,Pos)
end;
OtherERef ->
get_referenced_type(S,OtherERef)
end;
get_referenced_type(S,#identifier{val=Name,pos=Pos}) ->
get_referenced1(S,undefined,Name,Pos);
get_referenced_type(_S,Type) ->
{undefined,Type}.
%% 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.
check_and_save(S,#'Externaltypereference'{module=M}=ERef,#typedef{checked=false}=TDef,Settings)
when S#state.mname /= M ->
%% This ERef is an imported type (or maybe a set.asn compilation)
NewS = S#state{mname=M,module=load_asn1_module(S,M),
type=TDef,tname=get_datastr_name(TDef)},
Type=check_type(NewS,TDef,TDef#typedef.typespec),%XXX
CheckedTDef = TDef#typedef{checked=true,
typespec=Type},
asn1_db:dbput(M,get_datastr_name(TDef),CheckedTDef),
{merged_name(S,ERef),Settings};
check_and_save(S,#'Externaltypereference'{module=M,type=N}=Eref,
#ptypedef{name=Name,args=Params} = PTDef,Settings) ->
%% instantiate a parameterized type
%% The parameterized type should be saved as a type in the module
%% it was instantiated.
NewS = S#state{mname=M,module=load_asn1_module(S,M),
type=PTDef,tname=Name},
{Args,RestSettings} = lists:split(length(Params),Settings),
Type = check_type(NewS,PTDef,#type{def={pt,Eref,Args}}),
ERefName = new_reference_name(N),
ERefNew = #'Externaltypereference'{type=ERefName,module=S#state.mname},
NewTDef=#typedef{checked=true,name=ERefName,
typespec=Type},
insert_once(S,parameterized_objects,{ERefName,type,NewTDef}),
asn1_db:dbput(S#state.mname,ERefNew#'Externaltypereference'.type,
NewTDef),
{ERefNew,RestSettings};
check_and_save(_S,ERef,TDef,Settings) ->
%% This might be a renamed type in a set of specs, so rename the ERef
{ERef#'Externaltypereference'{type=asn1ct:get_name_of_def(TDef)},Settings}.
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,Name,[]) ->
Name;
match_parameters(_S,#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) ->
NewName;
match_parameters(_S,#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
NewName;
match_parameters(_S,#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) ->
NewName;
match_parameters(_S,#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) ->
NewName;
match_parameters(_S,#type{def=#'Externaltypereference'{module=M,type=Name}},
[{#'Externaltypereference'{module=M,type=Name},Type}]) ->
Type;
match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}},
[{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) ->
NewName;
match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}},
[{{_,#'Externaltypereference'{type=Name}},
NewName=#type{def=#'Externaltypereference'{}}}|_T]) ->
NewName#type.def;
match_parameters(_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_parameters(S,{valueset,T=#type{def={pt,_,_Args}}},_Parameters) ->
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_parameters(S,{valueset,{pos,{objectset,_,POSref},Args}},Parameters) ->
match_parameters(S,{valueset,#type{def={pt,POSref,Args}}},Parameters);
match_parameters(S,Name, [_H|T]) ->
%%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]),
match_parameters(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_integer(_S,[],_C) ->
[];
check_integer(S,NamedNumberList,_C) ->
case [X || X <- NamedNumberList, tuple_size(X) =:= 2] of
NamedNumberList ->
%% An already checked integer with NamedNumberList
NamedNumberList;
_ ->
case check_unique(NamedNumberList,2) of
[] ->
check_int(S,NamedNumberList,[]);
L when is_list(L) ->
error({type,{duplicates,L},S}),
unchanged
end
end.
check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when is_integer(Num) ->
check_int(S,T,[{Id,Num}|Acc]);
check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) ->
Val = dbget_ex(S,S#state.mname,Name),
check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc);
check_int(S,[{'NamedNumber',Id,{'Externalvaluereference',_,Mod,Name}}|T],Acc) ->
Val = dbget_ex(S,Mod,Name),
check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc);
check_int(_S,[],Acc) ->
lists:keysort(2,Acc).
check_real(_S,_Constr) ->
ok.
check_bitstring(_S,[],_Constr) ->
[];
check_bitstring(S,NamedNumberList,_Constr) ->
case check_unique(NamedNumberList,2) of
[] ->
check_bitstr(S,NamedNumberList,[]);
L when is_list(L) ->
error({type,{duplicates,L},S}),
unchanged
end.
check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when is_integer(Num) ->
check_bitstr(S,T,[{Id,Num}|Acc]);
check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when is_atom(Name) ->
%%check_bitstr(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) ->
%% io:format("asn1ct_check:check_bitstr/3 hej hop ~w~n",[Name]),
Val = dbget_ex(S,S#state.mname,Name),
%% io:format("asn1ct_check:check_bitstr/3: ~w~n",[Val]),
check_bitstr(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc);
check_bitstr(S,[],Acc) ->
case check_unique(Acc,2) of
[] ->
lists:keysort(2,Acc);
L when is_list(L) ->
error({type,{duplicate_values,L},S}),
unchanged
end;
%% When a BIT STRING already is checked, for instance a COMPONENTS OF S
%% where S is a sequence that has a component that is a checked BS, the
%% NamedNumber list is a list of {atom(),integer()} elements.
check_bitstr(S,[El={Id,Num}|Rest],Acc) when is_atom(Id),is_integer(Num) ->
check_bitstr(S,Rest,[El|Acc]).
%% 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,'TYPE-IDENTIFIER') ->
ok;
check_type_identifier(S,Eref=#'Externaltypereference'{}) ->
case get_referenced_type(S,Eref) of
{_,#classdef{name='TYPE-IDENTIFIER'}} -> ok;
{_,#classdef{typespec=NextEref}}
when is_record(NextEref,'Externaltypereference') ->
check_type_identifier(S,NextEref);
{_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} ->
check_type_identifier(S,(TD#typedef.typespec)#type.def);
Err ->
error({type,{"object set in type INSTANCE OF "
"not of class TYPE-IDENTIFIER",Eref,Err},S})
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 =
case S#state.erule of
ber ->
[?TAG_CONSTRUCTED(?N_INSTANCE_OF)];
_ -> []
end,
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,C1TypeTag}=
case S#state.erule of
ber ->
{[{'UNIVERSAL',8}],
[#tag{class='UNIVERSAL',
number=6,
type='IMPLICIT',
form=0}]};
_ -> {[{'UNIVERSAL','INTEGER'}],[]}
end,
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(_,[]) ->
{false,[],[],[]};
instance_of_constraints(S, [{simpletable,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,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2,Root) ->
Val = dbget_ex(S,S#state.mname,Name),
check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],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(S,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 constraint_member(simpletable,Cnstr) of
{true,{simpletable,_OSRef}} ->
simple_table_info(S,OCFT,Path);
_ ->
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 constraint_member(componentrelation,Type#type.constraint) of
%% [{componentrelation,_,AtNotation}] ->
{true,{_,_,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);
_ ->
[]
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 constraint_member(componentrelation,Type#type.constraint) of
{true,{_,_,AtNotation}} ->
AtNot = extract_at_notation(AtNotation),
evaluate_atpath(S,NamePath,CNames,AtNot);
_ ->
[]
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.
constraint_member(componentrelation,[CRel={componentrelation,_,_}|_Rest]) ->
{true,CRel};
constraint_member(simpletable,[ST={simpletable,_}|_Rest]) ->
{true,ST};
constraint_member(Key,[_H|T]) ->
constraint_member(Key,T);
constraint_member(_,[]) ->
false.
%% 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 constraint_member(componentrelation,Constraint) of
{true,{_,{_,_,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};
_ ->
%% 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 Cons of
% [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] ->
case constraint_member(componentrelation,Cons) of
{true,{_,{_,_,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}];
_ ->
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(S,Def) ->
case S#state.erule of
ber ->
[];
_ ->
case Def of
'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such
[];
_ ->
[asn1ct_gen:def_to_tag(Def)]
end
end.
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([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{mname=Where}, Item, Error) ->
Pos = asn1ct:get_pos_of_def(Item),
{structured_error,{Where,Pos},?MODULE,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_octet_string_value) ->
"expecting a bstring or an hstring as value for an OCTET STRING";
format_error({invalid_fields,Fields,Obj}) ->
io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]);
format_error({missing_mandatory_fields,Fields,Obj}) ->
io_lib:format("missing mandatory ~s in ~p",
[format_fields(Fields),Obj]);
format_error({undefined,Name}) ->
io_lib:format("'~s' is referenced, but is not defined", [Name]);
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({import,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) ->
PosOfDef =
fun(#'Externaltypereference'{pos=P}) -> P;
(#'Externalvaluereference'{pos=P}) -> P
end,
Pos = PosOfDef(Ref),
io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]),
{error,{import,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) ->
NameAbsList = default_class_list(S),
include_default_class1(Module,NameAbsList).
include_default_class1(_,[]) ->
ok;
include_default_class1(Module,[{Name,TS}|Rest]) ->
case asn1_db:dbget(Module,Name) of
undefined ->
C = #classdef{checked=true,name=Name,
typespec=TS},
asn1_db:dbput(Module,Name,C);
_ -> ok
end,
include_default_class1(Module,Rest).
default_class_list(S) ->
[{'TYPE-IDENTIFIER',
{objectclass,
[{fixedtypevaluefield,
id,
#type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER),
def='OBJECT IDENTIFIER'},
'UNIQUE',
'MANDATORY'},
{typefield,'Type','MANDATORY'}],
{'WITH SYNTAX',
[{typefieldreference,'Type'},
'IDENTIFIED',
'BY',
{valuefieldreference,id}]}}},
{'ABSTRACT-SYNTAX',
{objectclass,
[{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]}}],
{'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(S, [H|T], Check) ->
Type = asn1_db:dbget(S#state.mname, H),
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) -> [].
