1
%% ``The contents of this file are subject to the Erlang Public License,
2
%% Version 1.1, (the "License"); you may not use this file except in
3
%% compliance with the License. You should have received a copy of the
4
%% Erlang Public License along with this software. If not, it can be
5
%% retrieved via the world wide web at http://www.erlang.org/.
7
%% Software distributed under the License is distributed on an "AS IS"
8
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
9
%% the License for the specific language governing rights and limitations
12
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
13
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
14
%% AB. All Rights Reserved.''
16
%% $Id: asn1ct_check.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $
18
-module(asn1ct_check).
20
%% Main Module for ASN.1 compile time functions
22
%-compile(export_all).
23
-export([check/2,storeindb/1]).
24
-include("asn1_records.hrl").
25
%%% The tag-number for universal types
26
-define(N_BOOLEAN, 1).
27
-define(N_INTEGER, 2).
28
-define(N_BIT_STRING, 3).
29
-define(N_OCTET_STRING, 4).
31
-define(N_OBJECT_IDENTIFIER, 6).
32
-define(N_OBJECT_DESCRIPTOR, 7).
33
-define(N_EXTERNAL, 8). % constructed
34
-define(N_INSTANCE_OF,8).
36
-define(N_ENUMERATED, 10).
37
-define(N_EMBEDDED_PDV, 11). % constructed
38
-define(N_SEQUENCE, 16).
40
-define(N_NumericString, 18).
41
-define(N_PrintableString, 19).
42
-define(N_TeletexString, 20).
43
-define(N_VideotexString, 21).
44
-define(N_IA5String, 22).
45
-define(N_UTCTime, 23).
46
-define(N_GeneralizedTime, 24).
47
-define(N_GraphicString, 25).
48
-define(N_VisibleString, 26).
49
-define(N_GeneralString, 27).
50
-define(N_UniversalString, 28).
51
-define(N_CHARACTER_STRING, 29). % constructed
52
-define(N_BMPString, 30).
54
-define(TAG_PRIMITIVE(Num),
57
#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0};
60
-define(TAG_CONSTRUCTED(Num),
63
#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32};
67
-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag
68
-record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value
70
check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
71
%%Predicates used to filter errors
72
TupleIs = fun({T,_},T) -> true;
75
IsClass = fun(X) -> TupleIs(X,asn1_class) end,
76
IsObjSet = fun(X) -> TupleIs(X,objectsetdef) end,
77
IsPObjSet = fun(X) -> TupleIs(X,pobjectsetdef) end,
78
IsObject = fun(X) -> TupleIs(X,objectdef) end,
79
IsValueSet = fun(X) -> TupleIs(X,valueset) end,
80
Element2 = fun(X) -> element(2,X) end,
82
_Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used
83
Terror = checkt(S,Types,[]),
85
%% get parameterized object sets sent to checkt/3
88
{PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror),
90
Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets
92
%% get information object classes wrongly sent to checkt/3
95
{AddClasses,Terror3} = filter_errors(IsClass,Terror2),
97
NewClasses = Classes++AddClasses,
99
Cerror = checkc(S,NewClasses,[]),
101
%% get object sets incorrectly sent to checkv/3
104
{ObjSetNames,Verror2} = filter_errors(IsObjSet,Verror),
106
%% get parameterized object sets incorrectly sent to checkv/3
107
%% and update Verror2
109
{PObjSetNames,Verror3} = filter_errors(IsPObjSet,Verror2),
111
%% get objects incorrectly sent to checkv/3
112
%% and update Verror3
114
{ObjectNames,Verror4} = filter_errors(IsObject,Verror3),
116
NewObjects = Objects++ObjectNames,
117
NewObjectSets = ObjSetNames ++ PObjSetNames ++ PObjSetNames1,
120
%% and update Verror4
122
{ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4),
124
asn1ct:create_ets_table(inlined_objects,[named_table]),
125
{Oerror,ExclO,ExclOS} = checko(S,NewObjects ++
128
InlinedObjTuples = ets:tab2list(inlined_objects),
129
InlinedObjects = lists:map(Element2,InlinedObjTuples),
130
ets:delete(inlined_objects),
132
Exporterror = check_exports(S,S#state.module),
133
case {Terror3,Verror5,Cerror,Oerror,Exporterror} of
135
ContextSwitchTs = context_switch_in_spec(),
136
InstanceOf = instance_of_in_spec(),
137
NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs
139
NewValues = lists:subtract(Values,PObjSetNames++ObjectNames++
142
{NewTypes,NewValues,ParameterizedTypes,
143
NewClasses,NewObjects,NewObjectSets},
144
{NewTypes,NewValues,ParameterizedTypes,NewClasses,
145
lists:subtract(NewObjects,ExclO)++InlinedObjects,
146
lists:subtract(NewObjectSets,ExclOS)}};
147
_ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror,
148
Oerror,Exporterror])}}
151
context_switch_in_spec() ->
152
L = [{external,'EXTERNAL'},
153
{embedded_pdv,'EMBEDDED PDV'},
154
{character_string,'CHARACTER STRING'}],
155
F = fun({T,TName},Acc) ->
157
generate -> erase(T),
164
instance_of_in_spec() ->
165
case get(instance_of) of
173
filter_errors(Pred,ErrorList) ->
174
Element2 = fun(X) -> element(2,X) end,
175
RemovedTupleElements = lists:filter(Pred,ErrorList),
176
RemovedNames = lists:map(Element2,RemovedTupleElements),
177
%% remove value set name tuples from Verror
178
RestErrors = lists:subtract(ErrorList,RemovedTupleElements),
179
{RemovedNames,RestErrors}.
182
check_exports(S,Module = #module{}) ->
183
case Module#module.exports of
188
{exports,ExportList} when list(ExportList) ->
191
case catch get_referenced_type(S,X) of
197
case lists:filter(IsNotDefined,ExportList) of
202
fun(T = #'Externaltypereference'{type=N})->
203
%%{exported,undefined,entity,N}
204
NewS=S#state{type=T,tname=N},
205
error({export,"exported undefined entity",NewS})
207
lists:map(GetName,NoDefExp)
211
checkt(S,[Name|T],Acc) ->
212
%%io:format("check_typedef:~p~n",[Name]),
214
case asn1_db:dbget(S#state.mname,Name) of
216
error({type,{internal_error,'???'},S});
217
Type when record(Type,typedef) ->
218
NewS = S#state{type=Type,tname=Name},
219
case catch(check_type(NewS,Type,Type#typedef.typespec)) of
221
error({type,Reason,NewS});
223
error({type,{internal_error,Reason},NewS});
224
{asn1_class,_ClassDef} ->
227
{pobjectsetdef,Name};
231
case Type#typedef.checked of
232
true -> % already checked and updated
235
NewTypeDef = Type#typedef{checked=true,typespec = Ts},
236
%io:format("checkt:dbput:~p, ~p~n",[S#state.mname,NewTypeDef#typedef.name]),
237
asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type
246
checkt(S,T,[Result|Acc])
249
case check_contextswitchingtypes(S,[]) of
256
check_contextswitchingtypes(S,Acc) ->
257
CSTList=[{external,'EXTERNAL'},
258
{embedded_pdv,'EMBEDDED PDV'},
259
{character_string,'CHARACTER STRING'}],
260
check_contextswitchingtypes(S,CSTList,Acc).
262
check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) ->
266
check_contextswitchingtypes(S,Ts,[TName|Acc]);
268
check_contextswitchingtypes(S,Ts,Acc)
270
check_contextswitchingtypes(_,[],Acc) ->
273
checkv(S,[Name|T],Acc) ->
274
%%io:format("check_valuedef:~p~n",[Name]),
275
Result = case asn1_db:dbget(S#state.mname,Name) of
276
undefined -> error({value,{internal_error,'???'},S});
277
Value when record(Value,valuedef);
278
record(Value,typedef); %Value set may be parsed as object set.
279
record(Value,pvaluedef);
280
record(Value,pvaluesetdef) ->
281
NewS = S#state{value=Value},
282
case catch(check_value(NewS,Value)) of
284
error({value,Reason,NewS});
286
error({value,{internal_error,Reason},NewS});
288
{pobjectsetdef,Name};
292
%% this is an object, save as typedef
293
#valuedef{checked=C,pos=Pos,name=N,type=Type,
295
% Currmod = S#state.mname,
297
% #'Externaltypereference'{module=Mod,
298
% type=CName}} = Type,
303
% {objectclassname,CName};
305
% {objectclassname,Mod,CName}
307
NewSpec = #'Object'{classname=ClassName,
309
NewDef = #typedef{checked=C,pos=Pos,name=N,
311
asn1_db:dbput(NewS#state.mname,Name,NewDef),
314
Pos = asn1ct:get_pos_of_def(Value),
315
CheckedVSDef = #typedef{checked=true,pos=Pos,
316
name=Name,typespec=VSet},
317
asn1_db:dbput(NewS#state.mname,Name,CheckedVSDef),
320
%% update the valuedef
321
asn1_db:dbput(NewS#state.mname,Name,V),
329
checkv(S,T,[Result|Acc])
335
checkp(S,[Name|T],Acc) ->
336
%io:format("check_ptypedef:~p~n",[Name]),
337
Result = case asn1_db:dbget(S#state.mname,Name) of
339
error({type,{internal_error,'???'},S});
340
Type when record(Type,ptypedef) ->
341
NewS = S#state{type=Type,tname=Name},
342
case catch(check_ptype(NewS,Type,Type#ptypedef.typespec)) of
344
error({type,Reason,NewS});
346
error({type,{internal_error,Reason},NewS});
347
{asn1_class,_ClassDef} ->
350
NewType = Type#ptypedef{checked=true,typespec = Ts},
351
asn1_db:dbput(NewS#state.mname,Name,NewType), % update the type
359
checkp(S,T,[Result|Acc])
367
checkc(S,[Name|Cs],Acc) ->
369
case asn1_db:dbget(S#state.mname,Name) of
371
error({class,{internal_error,'???'},S});
374
record(Class,classdef) ->
375
Class#classdef.typespec;
376
record(Class,typedef) ->
377
Class#typedef.typespec
379
NewS = S#state{type=Class,tname=Name},
380
case catch(check_class(NewS,ClassSpec)) of
382
error({class,Reason,NewS});
384
error({class,{internal_error,Reason},NewS});
386
%% update the classdef
389
record(Class,classdef) ->
390
Class#classdef{checked=true,typespec=C};
391
record(Class,typedef) ->
392
#classdef{checked=true,name=Name,typespec=C}
394
asn1_db:dbput(NewS#state.mname,Name,NewClass),
402
checkc(S,Cs,[Result|Acc])
405
%% include_default_class(S#state.mname),
408
checko(S,[Name|Os],Acc,ExclO,ExclOS) ->
410
case asn1_db:dbget(S#state.mname,Name) of
412
error({type,{internal_error,'???'},S});
413
Object when record(Object,typedef) ->
414
NewS = S#state{type=Object,tname=Name},
415
case catch(check_object(NewS,Object,Object#typedef.typespec)) of
417
error({type,Reason,NewS});
419
error({type,{internal_error,Reason},NewS});
421
error({type,Reason,NewS});
423
NewObj = Object#typedef{checked=true,typespec=O},
424
asn1_db:dbput(NewS#state.mname,Name,NewObj),
426
record(O,'Object') ->
427
case O#'Object'.gen of
431
{ok,[Name|ExclO],ExclOS}
433
record(O,'ObjectSet') ->
434
case O#'ObjectSet'.gen of
438
{ok,ExclO,[Name|ExclOS]}
442
PObject when record(PObject,pobjectdef) ->
443
NewS = S#state{type=PObject,tname=Name},
444
case (catch check_pobject(NewS,PObject)) of
446
error({type,Reason,NewS});
448
error({type,{internal_error,Reason},NewS});
450
error({type,Reason,NewS});
452
NewPObj = PObject#pobjectdef{def=PO},
453
asn1_db:dbput(NewS#state.mname,Name,NewPObj),
454
{ok,[Name|ExclO],ExclOS}
456
PObjSet when record(PObjSet,pvaluesetdef) ->
457
%% this is a parameterized object set. Might be a parameterized
458
%% value set, couldn't it?
459
NewS = S#state{type=PObjSet,tname=Name},
460
case (catch check_pobjectset(NewS,PObjSet)) of
462
error({type,Reason,NewS});
464
error({type,{internal_error,Reason},NewS});
466
error({type,Reason,NewS});
468
%%NewPObjSet = PObjSet#pvaluesetdef{valueset=POS},
469
asn1_db:dbput(NewS#state.mname,Name,POS),
470
{ok,ExclO,[Name|ExclOS]}
474
{ok,NewExclO,NewExclOS} ->
475
checko(S,Os,Acc,NewExclO,NewExclOS);
477
checko(S,Os,[Result|Acc],ExclO,ExclOS)
479
checko(_S,[],Acc,ExclO,ExclOS) ->
480
{lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}.
482
check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) ->
487
NewCDef = CDef#classdef{checked=idle},
488
asn1_db:dbput(S#state.mname,Name,NewCDef),
489
CheckedTS = check_class(S,TS),
490
asn1_db:dbput(S#state.mname,Name,
491
NewCDef#classdef{checked=true,
492
typespec=CheckedTS}),
495
check_class(S = #state{mname=M,tname=T},ClassSpec)
496
when record(ClassSpec,type) ->
497
Def = ClassSpec#type.def,
499
#'Externaltypereference'{module=M,type=T} ->
500
#objectclass{fields=Def}; % in case of recursive definitions
501
Tref when record(Tref,'Externaltypereference') ->
502
{_,RefType} = get_referenced_type(S,Tref),
504
% RefClass when record(RefClass,classdef) ->
505
% check_class(S,RefClass#classdef.typespec)
507
case is_class(S,RefType) of
509
check_class(S,get_class_def(S,RefType));
511
error({class,{internal_error,RefType},S})
514
% check_class(S,{objectclassname,ModuleName,ClassName}) when atom(ModuleName),atom(ClassName) ->
516
check_class(S,C) when record(C,objectclass) ->
517
NewFieldSpec = check_class_fields(S,C#objectclass.fields),
518
C#objectclass{fields=NewFieldSpec};
519
%check_class(S,{objectclassname,ClassName}) ->
520
check_class(S,ClassName) ->
521
{_,Def} = get_referenced_type(S,ClassName),
523
ClassDef when record(ClassDef,classdef) ->
524
case ClassDef#classdef.checked of
526
ClassDef#classdef.typespec;
528
ClassDef#classdef.typespec;
530
check_class(S,ClassDef#classdef.typespec)
532
TypeDef when record(TypeDef,typedef) ->
533
%% this case may occur when a definition is a reference
534
%% to a class definition.
535
case TypeDef#typedef.typespec of
536
#type{def=Ext} when record(Ext,'Externaltypereference') ->
540
check_class(_S,{poc,_ObjSet,_Params}) ->
543
check_class_fields(S,Fields) ->
544
check_class_fields(S,Fields,[]).
546
check_class_fields(S,[F|Fields],Acc) ->
549
fixedtypevaluefield ->
550
{_,Name,Type,Unique,OSpec} = F,
551
RefType = check_type(S,#typedef{typespec=Type},Type),
552
{fixedtypevaluefield,Name,RefType,Unique,OSpec};
553
object_or_fixedtypevalue_field ->
554
{_,Name,Type,Unique,OSpec} = F,
556
case asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def)) of
557
Def when record(Def,typereference);
558
record(Def,'Externaltypereference') ->
559
{_,D} = get_referenced_type(S,Def),
562
%% neither of {primitive,bif} or {constructed,bif}
563
%% {_,D} = get_referenced_type(S,#typereference{val=Type#type.def}),
564
{_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}),
570
Class when record(Class,classdef) ->
571
{objectfield,Name,Type,Unique,OSpec};
573
RefType = check_type(S,#typedef{typespec=Type},Type),
574
{fixedtypevaluefield,Name,RefType,Unique,OSpec}
576
objectset_or_fixedtypevalueset_field ->
577
{_,Name,Type,OSpec} = F,
578
%% RefType = check_type(S,#typedef{typespec=Type},Type),
580
case (catch check_type(S,#typedef{typespec=Type},Type)) of
581
{asn1_class,_ClassDef} ->
582
case if_current_checked_type(S,Type) of
588
CheckedType when record(CheckedType,type) ->
591
error({class,"internal error, check_class_fields",S})
594
record(RefType,'Externaltypereference') ->
595
{objectsetfield,Name,Type,OSpec};
596
record(RefType,classdef) ->
597
{objectsetfield,Name,Type,OSpec};
598
record(RefType,objectclass) ->
599
{objectsetfield,Name,Type,OSpec};
601
{fixedtypevaluesetfield,Name,RefType,OSpec}
605
{TF,Name,{'DEFAULT',Type}} ->
606
{TF,Name,{'DEFAULT',check_type(S,#typedef{typespec=Type},Type)}};
611
check_class_fields(S,Fields,[NewField|Acc]);
612
check_class_fields(_S,[],Acc) ->
615
if_current_checked_type(S,#type{def=Def}) ->
616
CurrentCheckedName = S#state.tname,
617
MergedModules = S#state.inputmodules,
618
% CurrentCheckedModule = S#state.mname,
620
#'Externaltypereference'{module=CurrentCheckedName,
621
type=CurrentCheckedName} ->
623
#'Externaltypereference'{module=ModuleName,
624
type=CurrentCheckedName} ->
625
case MergedModules of
629
lists:member(ModuleName,MergedModules)
637
check_pobject(_S,PObject) when record(PObject,pobjectdef) ->
638
Def = PObject#pobjectdef.def,
642
check_pobjectset(S,PObjSet) ->
643
#pvaluesetdef{pos=Pos,name=Name,args=Args,type=Type,
644
valueset=ValueSet}=PObjSet,
645
{Mod,Def} = get_referenced_type(S,Type#type.def),
648
ClassName = #'Externaltypereference'{module=Mod,
649
type=Def#classdef.name},
650
{valueset,Set} = ValueSet,
651
% ObjectSet = #'ObjectSet'{class={objectclassname,ClassName},
652
ObjectSet = #'ObjectSet'{class=ClassName,
654
#pobjectsetdef{pos=Pos,name=Name,args=Args,class=Type#type.def,
660
check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) ->
662
check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) ->
663
{_,_ClassDef} = get_referenced_type(S,ClassRef),
664
NewClassRef = check_externaltypereference(S,ClassRef),
666
case _ClassDef#classdef.checked of
668
#classdef{checked=true,
669
typespec=check_class(S,_ClassDef#classdef.typespec)};
675
Def when tuple(Def), (element(1,Def)==object) ->
676
NewSettingList = check_objectdefn(S,Def,ClassDef),
677
#'Object'{def=NewSettingList};
678
% Def when tuple(Def), (element(1,Def)=='ObjectFromObject') ->
680
{po,{object,DefObj},ArgsList} ->
681
{_,Object} = get_referenced_type(S,DefObj),%DefObj is a
682
%%#'Externalvaluereference' or a #'Externaltypereference'
683
%% Maybe this call should be catched and in case of an exception
684
%% an nonallocated parameterized object should be returned.
685
instantiate_po(S,ClassDef,Object,ArgsList);
686
#'Externalvaluereference'{} ->
687
{_,Object} = get_referenced_type(S,ObjectDef),
688
check_object(S,Object,Object#typedef.typespec);
690
exit({error,{no_object,ObjectDef},S})
692
Gen = gen_incl(S,NewObj#'Object'.def,
693
(ClassDef#classdef.typespec)#objectclass.fields),
694
NewObj#'Object'{classname=NewClassRef,gen=Gen};
696
%%check_object(S,ObjSetDef,ObjSet=#type{def={pt,ObjSetRef,Args}}) ->
701
ObjSet=#'ObjectSet'{class=ClassRef}) ->
702
{_,ClassDef} = get_referenced_type(S,ClassRef),
703
NewClassRef = check_externaltypereference(S,ClassRef),
705
case (catch get_unique_fieldname(ClassDef)) of
706
{error,'__undefined_'} -> {unique,undefined};
707
{asn1,Msg,_} -> error({class,Msg,S});
711
case ObjSet#'ObjectSet'.set of
712
{'SingleValue',Set} when list(Set) ->
713
CheckedSet = check_object_list(S,NewClassRef,Set),
714
NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
715
ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
717
{'SingleValue',{definedvalue,ObjName}} ->
718
{_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}),
719
#'Object'{def=CheckedObj} =
720
check_object(S,ObjDef,ObjDef#typedef.typespec),
721
NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name,
724
ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
726
{'SingleValue',#'Externalvaluereference'{value=ObjName}} ->
727
{_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}),
728
#'Object'{def=CheckedObj} =
729
check_object(S,ObjDef,ObjDef#typedef.typespec),
730
NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name,
733
ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
736
ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
737
set=['EXTENSIONMARK']};
738
Set when list(Set) ->
739
CheckedSet = check_object_list(S,NewClassRef,Set),
740
NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
741
ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
743
{Set,Ext} when list(Set) ->
744
CheckedSet = check_object_list(S,NewClassRef,Set++Ext),
745
NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
746
ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
747
set=NewSet++['EXTENSIONMARK']};
748
{{'SingleValue',Set},Ext} ->
749
CheckedSet = check_object_list(S,NewClassRef,
750
merge_sets(Set,Ext)),
751
NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
752
ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
753
set=NewSet++['EXTENSIONMARK']};
754
{Type,{'EXCEPT',Exclusion}} when record(Type,type) ->
755
{_,TDef} = get_referenced_type(S,Type#type.def),
756
OS = TDef#typedef.typespec,
757
NewSet = reduce_objectset(OS#'ObjectSet'.set,Exclusion),
758
NewOS = OS#'ObjectSet'{set=NewSet},
759
check_object(S,TDef#typedef{typespec=NewOS},
761
#type{def={pt,DefinedObjSet,ParamList}} ->
762
{_,PObjSetDef} = get_referenced_type(S,DefinedObjSet),
763
instantiate_pos(S,ClassDef,PObjSetDef,ParamList);
764
{ObjDef={object,definedsyntax,_ObjFields},_Ext} ->
765
CheckedSet = check_object_list(S,NewClassRef,[ObjDef]),
766
NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
767
ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
768
set=NewSet++['EXTENSIONMARK']}
770
Gen = gen_incl_set(S,NewObjSet#'ObjectSet'.set,
772
NewObjSet#'ObjectSet'{class=NewClassRef,gen=Gen}.
775
merge_sets(Set,Ext) when list(Set),list(Ext) ->
777
merge_sets(Set,Ext) when list(Ext) ->
779
merge_sets(Set,{'SingleValue',Ext}) when list(Set) ->
781
merge_sets(Set,{'SingleValue',Ext}) ->
784
reduce_objectset(ObjectSet,Exclusion) ->
786
{'SingleValue',#'Externalvaluereference'{value=Name}} ->
787
case lists:keysearch(Name,1,ObjectSet) of
789
lists:subtract(ObjectSet,[El]);
795
%% Checks a list of objects or object sets and returns a list of selected
796
%% information for the code generation.
797
check_object_list(S,ClassRef,ObjectList) ->
798
check_object_list(S,ClassRef,ObjectList,[]).
800
check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) ->
802
ObjDef when tuple(ObjDef),(element(1,ObjDef)==object) ->
804
check_object(S,#typedef{typespec=ObjDef},
805
% #'Object'{classname={objectclassname,ClassRef},
806
#'Object'{classname=ClassRef,
808
check_object_list(S,ClassRef,Objs,[{no_name,Def#'Object'.def}|Acc]);
809
{'SingleValue',{definedvalue,ObjName}} ->
810
{_,ObjectDef} = get_referenced_type(S,#identifier{val=ObjName}),
811
#'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
812
check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]);
813
{'SingleValue',Ref = #'Externalvaluereference'{}} ->
814
{_,ObjectDef} = get_referenced_type(S,Ref),
815
#'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
816
check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]);
817
ObjRef when record(ObjRef,'Externalvaluereference') ->
818
{_,ObjectDef} = get_referenced_type(S,ObjRef),
819
#'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
820
check_object_list(S,ClassRef,Objs,
821
%% [{ObjRef#'Externalvaluereference'.value,Def}|Acc]);
822
[{ObjectDef#typedef.name,Def}|Acc]);
823
{'ValueFromObject',{_,Object},FieldName} ->
824
{_,Def} = get_referenced_type(S,Object),
825
%% TypeOrVal = get_fieldname_element(S,Def,FieldName);%% this must result in an object set
826
TypeDef = get_fieldname_element(S,Def,FieldName),
827
(TypeDef#typedef.typespec)#'ObjectSet'.set;
828
ObjSet when record(ObjSet,type) ->
830
case ObjSet#type.def of
831
Ref when record(Ref,typereference);
832
record(Ref,'Externaltypereference') ->
833
{_,D} = get_referenced_type(S,ObjSet#type.def),
836
throw({asn1_error,{'unknown objecset',Other,S}})
838
#'ObjectSet'{set=ObjectsInSet} =
839
check_object(S,ObjSetDef,ObjSetDef#typedef.typespec),
840
AccList = transform_set_to_object_list(ObjectsInSet,[]),
841
check_object_list(S,ClassRef,Objs,AccList++Acc);
843
check_object_list(S,ClassRef,Objs,Acc);
845
exit({error,{'unknown object',Other},S})
847
%% Finally reverse the accumulated list and if there are any extension
848
%% marks in the object set put one indicator of that in the end of the
850
check_object_list(_,_,[],Acc) ->
852
%% case lists:member('EXTENSIONMARK',RevAcc) of
854
%% ExclRevAcc = lists:filter(fun(X)->X /= 'EXTENSIONMARK' end,
856
%% ExclRevAcc ++ ['EXTENSIONMARK'];
862
%% get_fieldname_element/3
863
%% gets the type/value/object/... of the referenced element in FieldName
864
%% FieldName is a list and may have more than one element.
865
%% Each element in FieldName can be either {typefieldreference,AnyFieldName}
866
%% or {valuefieldreference,AnyFieldName}
867
%% Def is the def of the first object referenced by FieldName
868
get_fieldname_element(S,Def,[{_RefType,FieldName}]) when record(Def,typedef) ->
869
{_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def,
870
case lists:keysearch(FieldName,1,ObjComps) of
871
{value,{_,TDef}} when record(TDef,typedef) ->
872
%% ORec = TDef#typedef.typespec, %% XXX This must be made general
873
% case TDef#typedef.typespec of
874
% ObjSetRec when record(ObjSetRec,'ObjectSet') ->
875
% ObjSet = ObjSetRec#'ObjectSet'.set;
876
% ObjRec when record(ObjRec,'Object') ->
877
% %% now get the field in ObjRec that RestFName points out
882
{value,{_,VDef}} when record(VDef,valuedef) ->
885
throw({assigned_object_error,"not_assigned_object",S})
887
get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName])
888
when record(Def,typedef) ->
891
transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) ->
892
transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]);
893
transform_set_to_object_list(['EXTENSIONMARK'|Objs],Acc) ->
894
%% transform_set_to_object_list(Objs,['EXTENSIONMARK'|Acc]);
895
transform_set_to_object_list(Objs,Acc);
896
transform_set_to_object_list([],Acc) ->
899
get_unique_valuelist(_S,ObjSet,{unique,undefined}) -> % no unique field in object
900
lists:map(fun({N,{_,_,F}})->{N,F};
901
(V={_,_,_}) ->V end, ObjSet);
902
get_unique_valuelist(S,ObjSet,UFN) ->
903
get_unique_vlist(S,ObjSet,UFN,[]).
905
get_unique_vlist(S,[],_,Acc) ->
906
case catch check_uniqueness(Acc) of
908
% exit({error,Reason,S});
909
error({'ObjectSet',"not unique objects in object set",S});
913
get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Acc) ->
915
VDef = get_unique_value(S,Fields,UniqueFieldName),
916
get_unique_vlist(S,Rest,UniqueFieldName,
917
[{ObjName,VDef#valuedef.value,Fields}|Acc]);
918
get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Acc) ->
919
get_unique_vlist(S,Rest,UniqueFieldName,[V|Acc]).
921
get_unique_value(S,Fields,UniqueFieldName) ->
922
Module = S#state.mname,
923
case lists:keysearch(UniqueFieldName,1,Fields) of
925
case element(2,Field) of
926
VDef when record(VDef,valuedef) ->
928
{definedvalue,ValName} ->
929
ValueDef = asn1_db:dbget(Module,ValName),
931
VDef when record(VDef,valuedef) ->
934
#valuedef{value=ValName}
936
{'ValueFromObject',Object,Name} ->
938
{object,Ext} when record(Ext,'Externaltypereference') ->
939
OtherModule = Ext#'Externaltypereference'.module,
940
ExtObjName = Ext#'Externaltypereference'.type,
941
ObjDef = asn1_db:dbget(OtherModule,ExtObjName),
942
ObjSpec = ObjDef#typedef.typespec,
943
get_unique_value(OtherModule,element(3,ObjSpec),Name);
944
{object,{_,_,ObjName}} ->
945
ObjDef = asn1_db:dbget(Module,ObjName),
946
ObjSpec = ObjDef#typedef.typespec,
947
get_unique_value(Module,element(3,ObjSpec),Name);
948
{po,Object,_Params} ->
949
exit({error,{'parameterized object not implemented yet',
952
Value when atom(Value);number(Value) ->
953
#valuedef{value=Value};
954
{'CHOICE',{_,Value}} when atom(Value);number(Value) ->
955
#valuedef{value=Value}
958
exit({error,{'no unique value',Fields,UniqueFieldName},S})
959
%% io:format("WARNING: no unique value in object"),
960
%% exit(uniqueFieldName)
963
check_uniqueness(NameValueList) ->
964
check_uniqueness1(lists:keysort(2,NameValueList)).
966
check_uniqueness1([]) ->
968
check_uniqueness1([_]) ->
970
check_uniqueness1([{_,N,_},{_,N,_}|_Rest]) ->
971
throw({asn1_error,{'objects in set must have unique values in UNIQUE fields',N}});
972
check_uniqueness1([_|Rest]) ->
973
check_uniqueness1(Rest).
976
%% ClassDef is the class of Object,
977
%% Object is the Parameterized object, which is referenced,
978
%% ArgsList is the list of actual parameters
979
%% returns an #'Object' record.
980
instantiate_po(S,_ClassDef,Object,ArgsList) when record(Object,pobjectdef) ->
981
FormalParams = get_pt_args(Object),
982
MatchedArgs = match_args(FormalParams,ArgsList,[]),
983
NewS = S#state{type=Object,parameters=MatchedArgs},
984
check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class,
985
def=Object#pobjectdef.def}).
988
%% ClassDef is the class of ObjectSetDef,
989
%% ObjectSetDef is the Parameterized object set, which is referenced
990
%% on the right side of the assignment,
991
%% ArgsList is the list of actual parameters, i.e. real objects
992
instantiate_pos(S,ClassDef,ObjectSetDef,ArgsList) ->
993
ClassName = ClassDef#classdef.name,
994
FormalParams = get_pt_args(ObjectSetDef),
995
Set = case get_pt_spec(ObjectSetDef) of
996
{valueset,_Set} -> _Set;
999
MatchedArgs = match_args(FormalParams,ArgsList,[]),
1000
NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs},
1001
check_object(NewS,ObjectSetDef,
1002
#'ObjectSet'{class=name2Extref(S#state.mname,ClassName),
1006
%% gen_incl -> boolean()
1007
%% If object with Fields has any of the corresponding class' typefields
1008
%% then return value is true otherwise it is false.
1009
%% If an object lacks a typefield but the class has a type field that
1010
%% is OPTIONAL then we want gen to be true
1011
gen_incl(S,{_,_,Fields},CFields)->
1012
gen_incl1(S,Fields,CFields).
1014
gen_incl1(_,_,[]) ->
1016
gen_incl1(S,Fields,[C|CFields]) ->
1017
case element(1,C) of
1019
% case lists:keymember(element(2,C),1,Fields) of
1023
% gen_incl1(S,Fields,CFields)
1025
true; %% should check that field is OPTIONAL or DEFUALT if
1026
%% the object lacks this field
1028
case lists:keysearch(element(2,C),1,Fields) of
1030
Type = element(3,C),
1031
{_,ClassDef} = get_referenced_type(S,Type#type.def),
1032
% {_,ClassFields,_} = ClassDef#classdef.typespec,
1033
#objectclass{fields=ClassFields} =
1034
ClassDef#classdef.typespec,
1035
ObjTDef = element(2,Field),
1036
case gen_incl(S,(ObjTDef#typedef.typespec)#'Object'.def,
1041
gen_incl1(S,Fields,CFields)
1044
gen_incl1(S,Fields,CFields)
1047
gen_incl1(S,Fields,CFields)
1050
%% first if no unique field in the class return false.(don't generate code)
1051
gen_incl_set(S,Fields,ClassDef) ->
1052
case catch get_unique_fieldname(ClassDef) of
1053
Tuple when tuple(Tuple) ->
1056
gen_incl_set1(S,Fields,
1057
(ClassDef#classdef.typespec)#objectclass.fields)
1060
%% if any of the existing or potentially existing objects has a typefield
1061
%% then return true.
1062
gen_incl_set1(_,[],_CFields)->
1064
gen_incl_set1(_,['EXTENSIONMARK'],_) ->
1066
%% Fields are the fields of an object in the object set.
1067
%% CFields are the fields of the class of the object set.
1068
gen_incl_set1(S,[Object|Rest],CFields)->
1069
Fields = element(size(Object),Object),
1070
case gen_incl1(S,Fields,CFields) of
1074
gen_incl_set1(S,Rest,CFields)
1077
check_objectdefn(S,Def,CDef) when record(CDef,classdef) ->
1078
WithSyntax = (CDef#classdef.typespec)#objectclass.syntax,
1079
ClassFields = (CDef#classdef.typespec)#objectclass.fields,
1081
{object,defaultsyntax,Fields} ->
1082
check_defaultfields(S,Fields,ClassFields);
1083
{object,definedsyntax,Fields} ->
1084
{_,WSSpec} = WithSyntax,
1086
case catch( convert_definedsyntax(S,Fields,WSSpec,
1088
{asn1,{_ErrorType,ObjToken,ClassToken}} ->
1089
throw({asn1,{'match error in object',ObjToken,
1090
'found in object',ClassToken,'found in class'}});
1091
Err={asn1,_} -> throw(Err);
1092
Err={'EXIT',_} -> throw(Err);
1093
DefaultFields when list(DefaultFields) ->
1096
{object,defaultsyntax,NewFields};
1097
{object,_ObjectId} -> % This is a DefinedObject
1100
exit({error,{objectdefn,Other}})
1103
check_defaultfields(S,Fields,ClassFields) ->
1104
check_defaultfields(S,Fields,ClassFields,[]).
1106
check_defaultfields(_S,[],_ClassFields,Acc) ->
1107
{object,defaultsyntax,lists:reverse(Acc)};
1108
check_defaultfields(S,[{FName,Spec}|Fields],ClassFields,Acc) ->
1109
case lists:keysearch(FName,2,ClassFields) of
1111
NewField = convert_to_defaultfield(S,FName,Spec,CField),
1112
check_defaultfields(S,Fields,ClassFields,[NewField|Acc]);
1114
throw({error,{asn1,{'unvalid field in object',FName}}})
1116
%% {object,defaultsyntax,Fields}.
1118
convert_definedsyntax(_S,[],[],_ClassFields,Acc) ->
1120
convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) ->
1121
case match_field(S,Fields,WithSyntax,ClassFields) of
1122
{MatchedField,RestFields,RestWS} ->
1124
list(MatchedField) ->
1125
convert_definedsyntax(S,RestFields,RestWS,ClassFields,
1126
lists:append(MatchedField,Acc));
1128
convert_definedsyntax(S,RestFields,RestWS,ClassFields,
1131
%% throw({error,{asn1,{'unvalid syntax in object',WorS}}})
1134
match_field(S,Fields,WithSyntax,ClassFields) ->
1135
match_field(S,Fields,WithSyntax,ClassFields,[]).
1137
match_field(S,Fields,[W|Ws],ClassFields,Acc) when list(W) ->
1138
case catch(match_optional_field(S,Fields,W,ClassFields,[])) of
1140
match_field(Fields,Ws,ClassFields,Acc); %% add S
1141
%% {[Result],RestFields} ->
1142
%% {Result,RestFields,Ws};
1143
{Result,RestFields} when list(Result) ->
1144
{Result,RestFields,Ws};
1146
match_field(S,Fields,Ws,ClassFields,Acc)
1148
match_field(S,Fields,WithSyntax,ClassFields,_Acc) ->
1149
match_mandatory_field(S,Fields,WithSyntax,ClassFields,[]).
1151
match_optional_field(_S,RestFields,[],_,Ret) ->
1153
%% An additional optional field within an optional field
1154
match_optional_field(S,Fields,[W|Ws],ClassFields,Ret) when list(W) ->
1155
case catch match_optional_field(S,Fields,W,ClassFields,[]) of
1158
{asn1,{optional_matcherror,_,_}} ->
1160
{OptionalField,RestFields} ->
1161
match_optional_field(S,RestFields,Ws,ClassFields,
1162
lists:append(OptionalField,Ret))
1164
%% identify and skip word
1165
%match_optional_field(S,[#'Externaltypereference'{type=WorS}|Rest],
1166
match_optional_field(S,[{_,_,WorS}|Rest],
1167
[WorS|Ws],ClassFields,Ret) ->
1168
match_optional_field(S,Rest,Ws,ClassFields,Ret);
1169
match_optional_field(S,[],_,ClassFields,Ret) ->
1170
match_optional_field(S,[],[],ClassFields,Ret);
1171
%% identify and skip comma
1172
match_optional_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) ->
1173
match_optional_field(S,Rest,Ws,ClassFields,Ret);
1174
%% identify and save field data
1175
match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) ->
1178
Type when record(Type,type) -> Type;
1179
%% #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting;
1180
{'ValueFromObject',_,_} -> Setting;
1181
{object,_,_} -> Setting;
1182
{_,_,WordOrSetting} -> WordOrSetting;
1183
%% Atom when atom(Atom) -> Atom
1186
case lists:keysearch(W,2,ClassFields) of
1188
throw({asn1,{optional_matcherror,WorS,W}});
1190
NewField = convert_to_defaultfield(S,W,WorS,CField),
1191
match_optional_field(S,Rest,Ws,ClassFields,[NewField|Ret])
1193
match_optional_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Ret) ->
1194
throw({asn1,{optional_matcherror,WorS,W}}).
1196
match_mandatory_field(_S,[],[],_,[Acc]) ->
1198
match_mandatory_field(_S,[],[],_,Acc) ->
1200
match_mandatory_field(S,[],[H|T],CF,Acc) when list(H) ->
1201
match_mandatory_field(S,[],T,CF,Acc);
1202
match_mandatory_field(_S,[],WithSyntax,_,_Acc) ->
1203
throw({asn1,{mandatory_matcherror,[],WithSyntax}});
1204
%match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,[Acc]) when list(W) ->
1205
match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when list(W), length(Acc) >= 1 ->
1206
{Acc,Fields,WithSyntax};
1207
%% identify and skip word
1208
match_mandatory_field(S,[{_,_,WorS}|Rest],
1209
[WorS|Ws],ClassFields,Acc) ->
1210
match_mandatory_field(S,Rest,Ws,ClassFields,Acc);
1211
%% identify and skip comma
1212
match_mandatory_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) ->
1213
match_mandatory_field(S,Rest,Ws,ClassFields,Ret);
1214
%% identify and save field data
1215
match_mandatory_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Acc) ->
1218
%% Atom when atom(Atom) -> Atom;
1219
%% #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting;
1220
{object,_,_} -> Setting;
1221
{_,_,WordOrSetting} -> WordOrSetting;
1222
Type when record(Type,type) -> Type;
1225
case lists:keysearch(W,2,ClassFields) of
1227
throw({asn1,{mandatory_matcherror,WorS,W}});
1229
NewField = convert_to_defaultfield(S,W,WorS,CField),
1230
match_mandatory_field(S,Rest,Ws,ClassFields,[NewField|Acc])
1233
match_mandatory_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Acc) ->
1234
throw({asn1,{mandatory_matcherror,WorS,W}}).
1236
%% Converts a field of an object from defined syntax to default syntax
1237
convert_to_defaultfield(S,ObjFieldName,ObjFieldSetting,CField)->
1238
CurrMod = S#state.mname,
1239
case element(1,CField) of
1242
case ObjFieldSetting of
1243
TypeRec when record(TypeRec,type) -> TypeRec#type.def;
1244
TDef when record(TDef,typedef) ->
1245
TDef#typedef{typespec=check_type(S,TDef,
1246
TDef#typedef.typespec)};
1247
_ -> ObjFieldSetting
1251
record(TypeDef,typedef) -> TypeDef;
1253
case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of
1254
ERef = #'Externaltypereference'{module=CurrMod} ->
1255
{_,T} = get_referenced_type(S,ERef),
1256
T#typedef{checked=true,
1257
typespec=check_type(S,T,
1258
T#typedef.typespec)};
1259
ERef = #'Externaltypereference'{module=ExtMod} ->
1260
{_,T} = get_referenced_type(S,ERef),
1261
#typedef{name=Name} = T,
1262
check_type(S,T,T#typedef.typespec),
1263
#typedef{checked=true,
1266
Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
1267
T = check_type(S,#typedef{typespec=ObjFieldSetting},
1269
#typedef{checked=true,name=Bif,typespec=T};
1272
%% get_referenced_type(S,#typereference{val=ObjFieldSetting}),
1273
get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}),
1278
#typedef{name=Name} = T,
1279
T#typedef{name={ExtMod,Name}}
1283
{ObjFieldName,Type};
1284
fixedtypevaluefield ->
1285
case ObjFieldName of
1286
Val when atom(Val) ->
1287
%% ObjFieldSetting can be a value,an objectidentifiervalue,
1288
%% an element in an enumeration or namednumberlist etc.
1290
case ObjFieldSetting of
1291
#'Externalvaluereference'{} -> ObjFieldSetting;
1292
{'ValueFromObject',{_,ObjRef},FieldName} ->
1293
{_,Object} = get_referenced_type(S,ObjRef),
1294
ChObject = check_object(S,Object,
1295
Object#typedef.typespec),
1296
get_fieldname_element(S,Object#typedef{typespec=ChObject},
1301
#identifier{val=ObjFieldSetting}
1305
{ObjFieldName,check_value(S,ValRef)};
1308
case catch get_referenced_type(S,ValRef) of
1310
check_value(S,#valuedef{name=Val,
1311
type=element(3,CField),
1312
value=ObjFieldSetting});
1313
{_,VDef} when record(VDef,valuedef) ->
1314
check_value(S,VDef);%% XXX
1316
check_value(S,#valuedef{name=Val,
1317
type=element(3,CField),
1320
{ObjFieldName,ValDef}
1325
fixedtypevaluesetfield ->
1326
{ObjFieldName,ObjFieldSetting};
1329
case ObjFieldSetting of
1330
Ref when record(Ref,typereference);record(Ref,identifier);
1331
record(Ref,'Externaltypereference');
1332
record(Ref,'Externalvaluereference') ->
1333
{_,R} = get_referenced_type(S,ObjFieldSetting),
1335
{'ValueFromObject',{_,ObjRef},FieldName} ->
1336
%% This is an ObjectFromObject
1337
{_,Object} = get_referenced_type(S,ObjRef),
1338
ChObject = check_object(S,Object,
1339
Object#typedef.typespec),
1341
get_fieldname_element(S,Object#typedef{
1344
%%ClassName = ObjFromObj#'Object'.classname,
1347
%% ObjFromObj#'Object'{classname=
1348
%% {objectclassname,ClassName}}};
1350
%% An object defined inlined in another object
1351
#type{def=Ref} = element(3,CField),
1352
% CRef = case Ref of
1353
% #'Externaltypereference'{module=CurrMod,
1356
% #'Externaltypereference'{module=ExtMod,
1361
list_to_atom(lists:concat([S#state.tname]++
1362
['_',ObjFieldName])),
1363
% ObjSpec = #'Object'{classname={objectclassname,CRef},
1364
ObjSpec = #'Object'{classname=Ref,
1365
def=ObjFieldSetting},
1367
check_object(S,#typedef{typespec=ObjSpec},ObjSpec),
1368
InlObj = #typedef{checked=true,name=InlinedObjName,
1369
typespec=CheckedObj},
1370
asn1ct_gen:insert_once(inlined_objects,{InlinedObjName,
1372
asn1_db:dbput(S#state.mname,InlinedObjName,InlObj),
1374
#type{def=Eref} when record(Eref,'Externaltypereference') ->
1375
{_,R} = get_referenced_type(S,Eref),
1378
%% {_,R} = get_referenced_type(S,#typereference{val=ObjFieldSetting}),
1379
{_,R} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}),
1383
ObjectSpec#typedef{checked=true,
1384
typespec=check_object(S,ObjectSpec,
1385
ObjectSpec#typedef.typespec)}};
1386
variabletypevaluefield ->
1387
{ObjFieldName,ObjFieldSetting};
1388
variabletypevaluesetfield ->
1389
{ObjFieldName,ObjFieldSetting};
1392
case ObjFieldSetting of
1393
Ref when record(Ref,'Externaltypereference');
1394
record(Ref,'Externalvaluereference') ->
1395
get_referenced_type(S,ObjFieldSetting);
1396
ObjectList when list(ObjectList) ->
1397
%% an objctset defined in the object,though maybe
1398
%% parsed as a SequenceOfValue
1399
%% The ObjectList may be a list of references to
1400
%% objects, a ValueFromObject
1401
{_,_,Type,_} = CField,
1402
ClassDef = Type#type.def,
1403
case ClassDef#'Externaltypereference'.module of
1405
ClassDef#'Externaltypereference'.type;
1408
ClassDef#'Externaltypereference'.type}
1413
% {objectclassname,ClassRef},
1416
ObjectSet={'SingleValue',_} ->
1417
%% a Union of defined objects
1418
{_,_,Type,_} = CField,
1419
ClassDef = Type#type.def,
1421
% case ClassDef#'Externaltypereference'.module of
1423
% ClassDef#'Externaltypereference'.type;
1426
% ClassDef#'Externaltypereference'.type}
1429
% #typedef{typespec=#'ObjectSet'{class={objectclassname,ClassRef},
1430
#typedef{typespec=#'ObjectSet'{class=ClassDef,
1432
{object,_,[#type{def={'TypeFromObject',
1435
%% This case occurs when an ObjectSetFromObjects
1436
%% production is used
1437
{M,Def} = get_referenced_type(S,RefedObj),
1438
{M,get_fieldname_element(S,Def,FieldName)};
1439
#type{def=Eref} when
1440
record(Eref,'Externaltypereference') ->
1441
get_referenced_type(S,Eref);
1443
%% get_referenced_type(S,#typereference{val=ObjFieldSetting})
1444
get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting})
1447
ObjSetSpec#typedef{checked=true,
1448
typespec=check_object(S,ObjSetSpec,
1449
ObjSetSpec#typedef.typespec)}}
1452
check_value(OldS,V) when record(V,pvaluesetdef) ->
1453
#pvaluesetdef{checked=Checked,type=Type} = V,
1458
case get_referenced_type(OldS,Type#type.def) of
1459
{_,Class} when record(Class,classdef) ->
1460
throw({pobjectsetdef});
1464
check_value(_OldS,V) when record(V,pvaluedef) ->
1465
%% Fix this case later
1467
check_value(OldS,V) when record(V,typedef) ->
1468
%% This case when a value set has been parsed as an object set.
1469
%% It may be a value set
1470
#typedef{typespec=TS} = V,
1472
#'ObjectSet'{class=ClassRef} ->
1473
{_,TSDef} = get_referenced_type(OldS,ClassRef),
1474
%%IsObjectSet(TSDef);
1476
#classdef{} -> throw({objectsetdef});
1477
#typedef{typespec=#type{def=Eref}} when
1478
record(Eref,'Externaltypereference') ->
1479
%% This case if the class reference is a defined
1480
%% reference to class
1481
check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}});
1483
% an ordinary value set with a type in #typedef.typespec
1484
ValueSet = TS#'ObjectSet'.set,
1485
Type=check_type(OldS,TSDef,TSDef#typedef.typespec),
1486
Value = check_value(OldS,#valuedef{type=Type,
1488
{valueset,Type#type{constraint=Value#valuedef.value}}
1491
throw({objectsetdef})
1493
check_value(S,#valuedef{pos=Pos,name=Name,type=Type,
1494
value={valueset,Constr}}) ->
1495
NewType = Type#type{constraint=[Constr]},
1497
check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)};
1498
check_value(OldS=#state{recordtopname=TopName},V) when record(V,valuedef) ->
1499
#valuedef{name=Name,checked=Checked,type=Vtype,value=Value} = V,
1506
Def = Vtype#type.def,
1507
Constr = Vtype#type.constraint,
1508
S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name},
1511
Ext when record(Ext,'Externaltypereference') ->
1512
RecName = Ext#'Externaltypereference'.type,
1513
{_,Type} = get_referenced_type(S,Ext),
1514
%% If V isn't a value but an object Type is a #classdef{}
1519
case is_contextswitchtype(Type) of
1521
#valuedef{value=CheckedVal}=
1522
check_value(S,V#valuedef{type=Type#typedef.typespec}),
1523
#newv{value=CheckedVal};
1525
#valuedef{value=CheckedVal}=
1526
check_value(S#state{recordtopname=[RecName|TopName]},
1527
V#valuedef{type=Type#typedef.typespec}),
1528
#newv{value=CheckedVal}
1532
throw({error,{asn1,{'cant check value of type',Def}}});
1534
validate_integer(S,Value,[],Constr),
1535
#newv{value=normalize_value(S,Vtype,Value,[])};
1536
{'INTEGER',NamedNumberList} ->
1537
validate_integer(S,Value,NamedNumberList,Constr),
1538
#newv{value=normalize_value(S,Vtype,Value,[])};
1539
{'BIT STRING',NamedNumberList} ->
1540
validate_bitstring(S,Value,NamedNumberList,Constr),
1541
#newv{value=normalize_value(S,Vtype,Value,[])};
1543
validate_null(S,Value,Constr),
1545
'OBJECT IDENTIFIER' ->
1546
validate_objectidentifier(S,Value,Constr),
1547
#newv{value = normalize_value(S,Vtype,Value,[])};
1548
'ObjectDescriptor' ->
1549
validate_objectdescriptor(S,Value,Constr),
1550
#newv{value=normalize_value(S,Vtype,Value,[])};
1551
{'ENUMERATED',NamedNumberList} ->
1552
validate_enumerated(S,Value,NamedNumberList,Constr),
1553
#newv{value=normalize_value(S,Vtype,Value,[])};
1555
validate_boolean(S,Value,Constr),
1556
#newv{value=normalize_value(S,Vtype,Value,[])};
1558
validate_octetstring(S,Value,Constr),
1559
#newv{value=normalize_value(S,Vtype,Value,[])};
1561
validate_restrictedstring(S,Value,Def,Constr),
1562
#newv{value=normalize_value(S,Vtype,Value,[])};
1564
validate_restrictedstring(S,Value,Def,Constr),
1565
#newv{value=normalize_value(S,Vtype,Value,[])};
1567
validate_restrictedstring(S,Value,Def,Constr),
1568
#newv{value=normalize_value(S,Vtype,Value,[])};
1570
#newv{value=normalize_value(S,Vtype,Value,[])};
1571
% exit({'cant check value of type' ,Def});
1572
'GeneralizedTime' ->
1573
#newv{value=normalize_value(S,Vtype,Value,[])};
1574
% exit({'cant check value of type' ,Def});
1576
validate_restrictedstring(S,Value,Def,Constr),
1577
#newv{value=normalize_value(S,Vtype,Value,[])};
1579
validate_restrictedstring(S,Value,Def,Constr),
1580
#newv{value=normalize_value(S,Vtype,Value,[])};
1582
validate_restrictedstring(S,Value,Def,Constr),
1583
#newv{value=normalize_value(S,Vtype,Value,[])};
1584
'PrintableString' ->
1585
validate_restrictedstring(S,Value,Def,Constr),
1586
#newv{value=normalize_value(S,Vtype,Value,[])};
1588
validate_restrictedstring(S,Value,Def,Constr),
1589
#newv{value=normalize_value(S,Vtype,Value,[])};
1591
validate_restrictedstring(S,Value,Def,Constr),
1592
#newv{value=normalize_value(S,Vtype,Value,[])};
1593
%% 'UniversalString' -> %added 6/12 -00
1594
%% #newv{value=validate_restrictedstring(S,Value,Def,Constr)};
1595
Seq when record(Seq,'SEQUENCE') ->
1596
SeqVal = validate_sequence(S,Value,
1597
Seq#'SEQUENCE'.components,
1599
#newv{value=normalize_value(S,Vtype,SeqVal,TopName)};
1600
{'SEQUENCE OF',Components} ->
1601
validate_sequenceof(S,Value,Components,Constr),
1602
#newv{value=normalize_value(S,Vtype,Value,TopName)};
1603
{'CHOICE',Components} ->
1604
validate_choice(S,Value,Components,Constr),
1605
#newv{value=normalize_value(S,Vtype,Value,TopName)};
1606
Set when record(Set,'SET') ->
1607
validate_set(S,Value,Set#'SET'.components,
1609
#newv{value=normalize_value(S,Vtype,Value,TopName)};
1610
{'SET OF',Components} ->
1611
validate_setof(S,Value,Components,Constr),
1612
#newv{value=normalize_value(S,Vtype,Value,TopName)};
1614
exit({'cant check value of type' ,Other})
1616
case NewDef#newv.value of
1618
V#valuedef{checked=true,value=Value};
1620
V#valuedef{checked=true,value=Value};
1622
V#valuedef{checked={error,Reason},value=Value};
1624
V#valuedef{checked=true,value=_V}
1628
is_contextswitchtype(#typedef{name='EXTERNAL'})->
1630
is_contextswitchtype(#typedef{name='EMBEDDED PDV'}) ->
1632
is_contextswitchtype(#typedef{name='CHARACTER STRING'}) ->
1634
is_contextswitchtype(_) ->
1637
% validate_integer(S,{identifier,Pos,Id},NamedNumberList,Constr) ->
1638
% case lists:keysearch(Id,1,NamedNumberList) of
1640
% false -> error({value,"unknown NamedNumber",S})
1642
%% This case occurs when there is a valuereference
1643
validate_integer(S=#state{mname=M},
1644
#'Externalvaluereference'{module=M,value=Id},
1645
NamedNumberList,_Constr) ->
1646
case lists:keysearch(Id,1,NamedNumberList) of
1648
false -> error({value,"unknown NamedNumber",S})
1650
validate_integer(S,Id,NamedNumberList,_Constr) when atom(Id) ->
1651
case lists:keysearch(Id,1,NamedNumberList) of
1653
false -> error({value,"unknown NamedNumber",S})
1655
validate_integer(_S,Value,_NamedNumberList,Constr) when integer(Value) ->
1656
check_integer_range(Value,Constr).
1658
check_integer_range(Int,Constr) when list(Constr) ->
1659
NewConstr = [X || #constraint{c=X} <- Constr],
1660
check_constr(Int,NewConstr);
1662
check_integer_range(_Int,_Constr) ->
1663
%%io:format("~p~n",[Constr]),
1666
check_constr(Int,[{'ValueRange',Lb,Ub}|T]) when Int >= Lb, Int =< Ub ->
1667
check_constr(Int,T);
1668
check_constr(_Int,[]) ->
1671
validate_bitstring(_S,_Value,_NamedNumberList,_Constr) ->
1674
validate_null(_S,'NULL',_Constr) ->
1678
%% This can be removed when the old parser is removed
1679
%% The function removes 'space' atoms from the list
1681
is_space_list([H],Acc) ->
1682
lists:reverse([H|Acc]);
1683
is_space_list([H,space|T],Acc) ->
1684
is_space_list(T,[H|Acc]);
1685
is_space_list([],Acc) ->
1687
is_space_list([H|T],Acc) ->
1688
is_space_list(T,[H|Acc]).
1690
validate_objectidentifier(S,L,_) ->
1691
case is_space_list(L,[]) of
1692
NewL when list(NewL) ->
1693
case validate_objectidentifier1(S,NewL) of
1694
NewL2 when list(NewL2) ->
1695
list_to_tuple(NewL2);
1699
error({value, "illegal OBJECT IDENTIFIER", S})
1702
validate_objectidentifier1(S, [Id|T]) when record(Id,'Externalvaluereference') ->
1703
case catch get_referenced_type(S,Id) of
1704
{_,V} when record(V,valuedef) ->
1705
case check_value(S,V) of
1706
#valuedef{type=#type{def='OBJECT IDENTIFIER'},
1707
checked=true,value=Value} when tuple(Value) ->
1708
validate_objectid(S, T, lists:reverse(tuple_to_list(Value)));
1710
error({value, "illegal OBJECT IDENTIFIER", S})
1713
validate_objectid(S, [Id|T], [])
1715
validate_objectidentifier1(S,V) ->
1716
validate_objectid(S,V,[]).
1718
validate_objectid(_, [], Acc) ->
1720
validate_objectid(S, [Value|Vrest], Acc) when integer(Value) ->
1721
validate_objectid(S, Vrest, [Value|Acc]);
1722
validate_objectid(S, [{'NamedNumber',_Name,Value}|Vrest], Acc)
1723
when integer(Value) ->
1724
validate_objectid(S, Vrest, [Value|Acc]);
1725
validate_objectid(S, [Id|Vrest], Acc)
1726
when record(Id,'Externalvaluereference') ->
1727
case catch get_referenced_type(S, Id) of
1728
{_,V} when record(V,valuedef) ->
1729
case check_value(S, V) of
1730
#valuedef{checked=true,value=Value} when integer(Value) ->
1731
validate_objectid(S, Vrest, [Value|Acc]);
1733
error({value, "illegal OBJECT IDENTIFIER", S})
1736
case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of
1737
Value when integer(Value) ->
1738
validate_objectid(S, Vrest, [Value|Acc]);
1740
error({value, "illegal OBJECT IDENTIFIER", S})
1743
validate_objectid(S, [{Atom,Value}],[]) when atom(Atom),integer(Value) ->
1744
%% this case when an OBJECT IDENTIFIER value has been parsed as a
1746
Rec = #'Externalvaluereference'{module=S#state.mname,
1748
validate_objectidentifier1(S,[Rec,Value]);
1749
validate_objectid(S, [{Atom,EVRef}],[])
1750
when atom(Atom),record(EVRef,'Externalvaluereference') ->
1751
%% this case when an OBJECT IDENTIFIER value has been parsed as a
1752
%% SEQUENCE value OTP-4354
1753
Rec = #'Externalvaluereference'{module=S#state.mname,
1755
validate_objectidentifier1(S,[Rec,EVRef]);
1756
validate_objectid(S, _V, _Acc) ->
1757
error({value, "illegal OBJECT IDENTIFIER",S}).
1760
%% ITU-T Rec. X.680 Annex B - D
1761
reserved_objectid('itu-t',[]) -> 0;
1762
reserved_objectid('ccitt',[]) -> 0;
1763
%% arcs below "itu-t"
1764
reserved_objectid('recommendation',[0]) -> 0;
1765
reserved_objectid('question',[0]) -> 1;
1766
reserved_objectid('administration',[0]) -> 2;
1767
reserved_objectid('network-operator',[0]) -> 3;
1768
reserved_objectid('identified-organization',[0]) -> 4;
1769
%% arcs below "recommendation"
1770
reserved_objectid('a',[0,0]) -> 1;
1771
reserved_objectid('b',[0,0]) -> 2;
1772
reserved_objectid('c',[0,0]) -> 3;
1773
reserved_objectid('d',[0,0]) -> 4;
1774
reserved_objectid('e',[0,0]) -> 5;
1775
reserved_objectid('f',[0,0]) -> 6;
1776
reserved_objectid('g',[0,0]) -> 7;
1777
reserved_objectid('h',[0,0]) -> 8;
1778
reserved_objectid('i',[0,0]) -> 9;
1779
reserved_objectid('j',[0,0]) -> 10;
1780
reserved_objectid('k',[0,0]) -> 11;
1781
reserved_objectid('l',[0,0]) -> 12;
1782
reserved_objectid('m',[0,0]) -> 13;
1783
reserved_objectid('n',[0,0]) -> 14;
1784
reserved_objectid('o',[0,0]) -> 15;
1785
reserved_objectid('p',[0,0]) -> 16;
1786
reserved_objectid('q',[0,0]) -> 17;
1787
reserved_objectid('r',[0,0]) -> 18;
1788
reserved_objectid('s',[0,0]) -> 19;
1789
reserved_objectid('t',[0,0]) -> 20;
1790
reserved_objectid('u',[0,0]) -> 21;
1791
reserved_objectid('v',[0,0]) -> 22;
1792
reserved_objectid('w',[0,0]) -> 23;
1793
reserved_objectid('x',[0,0]) -> 24;
1794
reserved_objectid('y',[0,0]) -> 25;
1795
reserved_objectid('z',[0,0]) -> 26;
1798
reserved_objectid(iso,[]) -> 1;
1799
%% arcs below "iso", note that number 1 is not used
1800
reserved_objectid('standard',[1]) -> 0;
1801
reserved_objectid('member-body',[1]) -> 2;
1802
reserved_objectid('identified-organization',[1]) -> 3;
1804
reserved_objectid('joint-iso-itu-t',[]) -> 2;
1805
reserved_objectid('joint-iso-ccitt',[]) -> 2;
1807
reserved_objectid(_,_) -> false.
1813
validate_objectdescriptor(_S,_Value,_Constr) ->
1816
validate_enumerated(S,Id,NamedNumberList,_Constr) when atom(Id) ->
1817
case lists:keysearch(Id,1,NamedNumberList) of
1819
false -> error({value,"unknown ENUMERATED",S})
1821
validate_enumerated(S,{identifier,_Pos,Id},NamedNumberList,_Constr) ->
1822
case lists:keysearch(Id,1,NamedNumberList) of
1824
false -> error({value,"unknown ENUMERATED",S})
1826
validate_enumerated(S,#'Externalvaluereference'{value=Id},
1827
NamedNumberList,_Constr) ->
1828
case lists:keysearch(Id,1,NamedNumberList) of
1830
false -> error({value,"unknown ENUMERATED",S})
1833
validate_boolean(_S,_Value,_Constr) ->
1836
validate_octetstring(_S,_Value,_Constr) ->
1839
validate_restrictedstring(_S,_Value,_Def,_Constr) ->
1842
validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
1844
#type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} ->
1845
%% this is an 'EXTERNAL' (or INSTANCE OF)
1847
[{identification,_}|_RestVal] ->
1848
to_EXTERNAL1990(S,Value);
1856
validate_sequenceof(_S,_Value,_Components,_Constr) ->
1859
validate_choice(_S,_Value,_Components,_Constr) ->
1862
validate_set(_S,_Value,_Components,_Constr) ->
1865
validate_setof(_S,_Value,_Components,_Constr) ->
1868
to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) ->
1869
to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]);
1870
to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) ->
1871
to_EXTERNAL1990(S,Rest,[{'indirect-reference',I}]);
1872
to_EXTERNAL1990(S,[{identification,{'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) ->
1873
to_EXTERNAL1990(S,Rest,[{'indirect-reference',PCid},{'direct-reference',TrStx}]);
1874
to_EXTERNAL1990(S,_) ->
1875
error({value,"illegal value in EXTERNAL type",S}).
1877
to_EXTERNAL1990(S,[V={'data-value-descriptor',_}|Rest],Acc) ->
1878
to_EXTERNAL1990(S,Rest,[V|Acc]);
1879
to_EXTERNAL1990(_S,[{'data-value',Val}],Acc) ->
1880
Encoding = {encoding,{'CHOICE',{'octet-aligned',Val}}},
1881
lists:reverse([Encoding|Acc]);
1882
to_EXTERNAL1990(S,_,_) ->
1883
error({value,"illegal value in EXTERNAL type",S}).
1885
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1886
%% Functions to normalize the default values of SEQUENCE
1887
%% and SET components into Erlang valid format
1888
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1889
normalize_value(_,_,mandatory,_) ->
1891
normalize_value(_,_,'OPTIONAL',_) ->
1893
normalize_value(S,Type,{'DEFAULT',Value},NameList) ->
1894
case catch get_canonic_type(S,Type,NameList) of
1895
{'BOOLEAN',CType,_} ->
1896
normalize_boolean(S,Value,CType);
1897
{'INTEGER',CType,_} ->
1898
normalize_integer(S,Value,CType);
1899
{'BIT STRING',CType,_} ->
1900
normalize_bitstring(S,Value,CType);
1901
{'OCTET STRING',CType,_} ->
1902
normalize_octetstring(S,Value,CType);
1903
{'NULL',_CType,_} ->
1904
%%normalize_null(Value);
1906
{'OBJECT IDENTIFIER',_,_} ->
1907
normalize_objectidentifier(S,Value);
1908
{'ObjectDescriptor',_,_} ->
1909
normalize_objectdescriptor(Value);
1911
normalize_real(Value);
1912
{'ENUMERATED',CType,_} ->
1913
normalize_enumerated(Value,CType);
1914
{'CHOICE',CType,NewNameList} ->
1915
normalize_choice(S,Value,CType,NewNameList);
1916
{'SEQUENCE',CType,NewNameList} ->
1917
normalize_sequence(S,Value,CType,NewNameList);
1918
{'SEQUENCE OF',CType,NewNameList} ->
1919
normalize_seqof(S,Value,CType,NewNameList);
1920
{'SET',CType,NewNameList} ->
1921
normalize_set(S,Value,CType,NewNameList);
1922
{'SET OF',CType,NewNameList} ->
1923
normalize_setof(S,Value,CType,NewNameList);
1924
{restrictedstring,CType,_} ->
1925
normalize_restrictedstring(S,Value,CType);
1927
io:format("WARNING: could not check default value ~p~n",[Value]),
1930
normalize_value(S,Type,Val,NameList) ->
1931
normalize_value(S,Type,{'DEFAULT',Val},NameList).
1933
normalize_boolean(S,{Name,Bool},CType) when atom(Name) ->
1934
normalize_boolean(S,Bool,CType);
1935
normalize_boolean(_,true,_) ->
1937
normalize_boolean(_,false,_) ->
1939
normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) ->
1940
get_normalized_value(S,Bool,CType,fun normalize_boolean/3,[]);
1941
normalize_boolean(_,Other,_) ->
1942
throw({error,{asn1,{'invalid default value',Other}}}).
1944
normalize_integer(_S,Int,_) when integer(Int) ->
1946
normalize_integer(_S,{Name,Int},_) when atom(Name),integer(Int) ->
1948
normalize_integer(S,{Name,Int=#'Externalvaluereference'{}},
1949
Type) when atom(Name) ->
1950
normalize_integer(S,Int,Type);
1951
normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) ->
1953
NNL when list(NNL) ->
1954
case lists:keysearch(Name,1,NNL) of
1955
{value,{Name,Val}} ->
1958
get_normalized_value(S,Int,Type,
1959
fun normalize_integer/3,[])
1962
get_normalized_value(S,Int,Type,fun normalize_integer/3,[])
1964
normalize_integer(_,Int,_) ->
1965
exit({'Unknown INTEGER value',Int}).
1967
normalize_bitstring(S,Value,Type)->
1968
%% There are four different Erlang formats of BIT STRING:
1969
%% 1 - a list of ones and zeros.
1970
%% 2 - a list of atoms.
1971
%% 3 - as an integer, for instance in hexadecimal form.
1972
%% 4 - as a tuple {Unused, Binary} where Unused is an integer
1973
%% and tells how many bits of Binary are unused.
1975
%% normalize_bitstring/3 transforms Value according to:
1980
%% Value can be on format:
1981
%% A - {hstring, String}, where String is a hexadecimal string.
1982
%% B - {bstring, String}, where String is a string on bit format
1983
%% C - #'Externalvaluereference'{value=V}, where V is a defined value
1984
%% D - list of #'Externalvaluereference', where each value component
1985
%% is an identifier corresponing to NamedBits in Type.
1987
{hstring,String} when list(String) ->
1988
hstring_to_int(String);
1989
{bstring,String} when list(String) ->
1990
bstring_to_bitlist(String);
1991
Rec when record(Rec,'Externalvaluereference') ->
1992
get_normalized_value(S,Value,Type,
1993
fun normalize_bitstring/3,[]);
1994
RecList when list(RecList) ->
1996
NBL when list(NBL) ->
1997
F = fun(#'Externalvaluereference'{value=Name}) ->
1998
case lists:keysearch(Name,1,NBL) of
2002
throw({error,Other})
2005
throw({error,Other})
2007
case catch lists:map(F,RecList) of
2009
io:format("WARNING: default value not "
2010
"compatible with type definition ~p~n",
2017
io:format("WARNING: default value not "
2018
"compatible with type definition ~p~n",
2022
{Name,String} when atom(Name) ->
2023
normalize_bitstring(S,String,Type);
2025
io:format("WARNING: illegal default value ~p~n",[Other]),
2029
hstring_to_int(L) when list(L) ->
2030
hstring_to_int(L,0).
2031
hstring_to_int([H|T],Acc) when H >= $A, H =< $F ->
2032
hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ;
2033
hstring_to_int([H|T],Acc) when H >= $0, H =< $9 ->
2034
hstring_to_int(T,(Acc bsl 4) + (H - $0));
2035
hstring_to_int([],Acc) ->
2038
bstring_to_bitlist([H|T]) when H == $0; H == $1 ->
2039
[H - $0 | bstring_to_bitlist(T)];
2040
bstring_to_bitlist([]) ->
2043
%% normalize_octetstring/1 changes representation of input Value to a
2045
%% Format of Value is one of:
2046
%% {bstring,String} each element in String corresponds to one bit in an octet
2047
%% {hstring,String} each element in String corresponds to one byte in an octet
2048
%% #'Externalvaluereference'
2049
normalize_octetstring(S,Value,CType) ->
2052
bstring_to_octetlist(String);
2054
hstring_to_octetlist(String);
2055
Rec when record(Rec,'Externalvaluereference') ->
2056
get_normalized_value(S,Value,CType,
2057
fun normalize_octetstring/3,[]);
2058
{Name,String} when atom(Name) ->
2059
normalize_octetstring(S,String,CType);
2060
List when list(List) ->
2061
%% check if list elements are valid octet values
2062
lists:map(fun([])-> ok;
2064
io:format("WARNING: not legal octet value ~p in OCTET STRING, ~p~n",[H,List]);
2069
io:format("WARNING: unknown default value ~p~n",[Other]),
2074
bstring_to_octetlist([]) ->
2076
bstring_to_octetlist([H|T]) when H == $0 ; H == $1 ->
2077
bstring_to_octetlist(T,6,[(H - $0) bsl 7]).
2078
bstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H == $0; H == $1 ->
2079
bstring_to_octetlist(T, 7, [0,Hacc + (H -$0)| Tacc]);
2080
bstring_to_octetlist([H|T],BSL,[Hacc|Tacc]) when H == $0; H == $1 ->
2081
bstring_to_octetlist(T, BSL-1, [Hacc + ((H - $0) bsl BSL)| Tacc]);
2082
bstring_to_octetlist([],7,[0|Acc]) ->
2084
bstring_to_octetlist([],_,Acc) ->
2087
hstring_to_octetlist([]) ->
2089
hstring_to_octetlist(L) ->
2090
hstring_to_octetlist(L,4,[]).
2091
hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $A, H =< $F ->
2092
hstring_to_octetlist(T,4,[Hacc + (H - $A + 10)|Tacc]);
2093
hstring_to_octetlist([H|T],BSL,Acc) when H >= $A, H =< $F ->
2094
hstring_to_octetlist(T,0,[(H - $A + 10) bsl BSL|Acc]);
2095
hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $0; H =< $9 ->
2096
hstring_to_octetlist(T,4,[Hacc + (H - $0)|Tacc]);
2097
hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 ->
2098
hstring_to_octetlist(T,0,[(H - $0) bsl BSL|Acc]);
2099
hstring_to_octetlist([],_,Acc) ->
2102
normalize_objectidentifier(S,Value) ->
2103
validate_objectidentifier(S,Value,[]).
2105
normalize_objectdescriptor(Value) ->
2108
normalize_real(Value) ->
2111
normalize_enumerated(#'Externalvaluereference'{value=V},CType)
2113
normalize_enumerated2(V,CType);
2114
normalize_enumerated(Value,CType) when atom(Value),list(CType) ->
2115
normalize_enumerated2(Value,CType);
2116
normalize_enumerated({Name,EnumV},CType) when atom(Name) ->
2117
normalize_enumerated(EnumV,CType);
2118
normalize_enumerated(Value,{CType1,CType2}) when list(CType1), list(CType2)->
2119
normalize_enumerated(Value,CType1++CType2);
2120
normalize_enumerated(V,CType) ->
2121
io:format("WARNING: Enumerated unknown type ~p~n",[CType]),
2123
normalize_enumerated2(V,Enum) ->
2124
case lists:keysearch(V,1,Enum) of
2125
{value,{Val,_}} -> Val;
2127
io:format("WARNING: Enumerated value is not correct ~p~n",[V]),
2131
normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when atom(C) ->
2134
Rec when record(Rec,'Externalvaluereference') ->
2135
get_normalized_value(S,V,CType,
2136
fun normalize_choice/4,
2140
case catch lists:keysearch(C,#'ComponentType'.name,CType) of
2141
{value,#'ComponentType'{typespec=CT,name=Name}} ->
2142
{C,normalize_value(S,CT,{'DEFAULT',Value},
2145
io:format("WARNING: Wrong format of type/value ~p/~p~n",
2149
normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) ->
2150
lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList);
2151
normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) ->
2152
{_,#valuedef{value=V}}=get_referenced_type(S,Val),
2153
normalize_choice(S,{'CHOICE',V},CType,NameList);
2154
% get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]);
2155
normalize_choice(S,{Name,ChoiceVal},CType,NameList)
2157
normalize_choice(S,ChoiceVal,CType,NameList).
2159
normalize_sequence(S,{Name,Value},Components,NameList)
2160
when atom(Name),list(Value) ->
2161
normalize_sequence(S,Value,Components,NameList);
2162
normalize_sequence(S,Value,Components,NameList) ->
2163
normalized_record('SEQUENCE',S,Value,Components,NameList).
2165
normalize_set(S,{Name,Value},Components,NameList)
2166
when atom(Name),list(Value) ->
2167
normalized_record('SET',S,Value,Components,NameList);
2168
normalize_set(S,Value,Components,NameList) ->
2169
normalized_record('SET',S,Value,Components,NameList).
2171
normalized_record(SorS,S,Value,Components,NameList) ->
2172
NewName = list_to_atom(asn1ct_gen:list2name(NameList)),
2173
NoComps = length(Components),
2174
case normalize_seq_or_set(SorS,S,Value,Components,NameList,[]) of
2175
ListOfVals when length(ListOfVals) == NoComps ->
2176
list_to_tuple([NewName|ListOfVals]);
2178
error({type,{illegal,default,value,Value},S})
2181
normalize_seq_or_set(SorS,S,[{Cname,V}|Vs],
2182
[#'ComponentType'{name=Cname,typespec=TS}|Cs],
2186
#'Externaltypereference'{type=TName} ->
2188
_ -> [Cname|NameList]
2190
NVal = normalize_value(S,TS,{'DEFAULT',V},NewNameList),
2191
normalize_seq_or_set(SorS,S,Vs,Cs,NameList,[NVal|Acc]);
2192
normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs],
2193
[#'ComponentType'{prop='OPTIONAL'}|Cs],
2195
normalize_seq_or_set(SorS,S,Values,Cs,NameList,[asn1_NOVALUE|Acc]);
2196
normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs],
2197
[#'ComponentType'{name=Cname2,typespec=TS,
2198
prop={'DEFAULT',Value}}|Cs],
2202
#'Externaltypereference'{type=TName} ->
2204
_ -> [Cname2|NameList]
2206
NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList),
2207
normalize_seq_or_set(SorS,S,Values,Cs,NameList,[NVal|Acc]);
2208
normalize_seq_or_set(_SorS,_S,[],[],_,Acc) ->
2210
%% If default value is {} ComponentTypes in SEQUENCE are marked DEFAULT
2211
%% or OPTIONAL (or the type is defined SEQUENCE{}, which is handled by
2212
%% the previous case).
2213
normalize_seq_or_set(SorS,S,[],
2214
[#'ComponentType'{name=Name,typespec=TS,
2215
prop={'DEFAULT',Value}}|Cs],
2219
#'Externaltypereference'{type=TName} ->
2221
_ -> [Name|NameList]
2223
NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList),
2224
normalize_seq_or_set(SorS,S,[],Cs,NameList,[NVal|Acc]);
2225
normalize_seq_or_set(SorS,S,[],[#'ComponentType'{prop='OPTIONAL'}|Cs],
2227
normalize_seq_or_set(SorS,S,[],Cs,NameList,[asn1_NOVALUE|Acc]);
2228
normalize_seq_or_set(SorS,S,Value=#'Externalvaluereference'{},
2230
get_normalized_value(S,Value,Cs,fun normalize_seq_or_set/6,
2231
[SorS,NameList,Acc]);
2232
normalize_seq_or_set(_SorS,S,V,_,_,_) ->
2233
error({type,{illegal,default,value,V},S}).
2235
normalize_seqof(S,Value,Type,NameList) ->
2236
normalize_s_of('SEQUENCE OF',S,Value,Type,NameList).
2238
normalize_setof(S,Value,Type,NameList) ->
2239
normalize_s_of('SET OF',S,Value,Type,NameList).
2241
normalize_s_of(SorS,S,Value,Type,NameList) when list(Value) ->
2242
DefValueList = lists:map(fun(X) -> {'DEFAULT',X} end,Value),
2243
Suffix = asn1ct_gen:constructed_suffix(SorS,Type),
2244
Def = Type#type.def,
2245
InnerType = asn1ct_gen:get_inner(Def),
2246
WhatKind = asn1ct_gen:type(InnerType),
2249
{constructed,bif} ->
2251
#'Externaltypereference'{type=Name} ->
2255
NormFun = fun (X) -> normalize_value(S,Type,X,
2257
case catch lists:map(NormFun, DefValueList) of
2258
List when list(List) ->
2261
io:format("WARNING: ~p could not handle value ~p~n",
2265
normalize_s_of(SorS,S,Value,Type,NameList)
2266
when record(Value,'Externalvaluereference') ->
2267
get_normalized_value(S,Value,Type,fun normalize_s_of/5,
2269
% case catch get_referenced_type(S,Value) of
2270
% {_,#valuedef{value=V}} ->
2271
% normalize_s_of(SorS,S,V,Type);
2273
% io:format("WARNING: ~p could not handle value ~p~n",
2277
% normalize_s_of(SorS,S,NewVal,Type);
2279
% io:format("WARNING: ~p could not handle value ~p~n",
2285
%% normalize_restrictedstring handles all format of restricted strings.
2287
normalize_restrictedstring(_S,[Int1,Int2],_) when integer(Int1),integer(Int2) ->
2290
normalize_restrictedstring(_S,[Int1,Int2,Int3,Int4],_) when integer(Int1),
2294
{Int1,Int2,Int3,Int4};
2295
%% character string list case
2296
normalize_restrictedstring(S,[H|T],CType) when list(H);tuple(H) ->
2297
[normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)];
2298
%% character sting case
2299
normalize_restrictedstring(_S,CString,_) when list(CString) ->
2303
$X =< 255, $X >= 0 ->
2306
io:format("WARNING: illegal character in string"
2310
lists:foreach(Fun,CString),
2312
%% definedvalue case or argument in a parameterized type
2313
normalize_restrictedstring(S,ERef,CType) when record(ERef,'Externalvaluereference') ->
2314
get_normalized_value(S,ERef,CType,
2315
fun normalize_restrictedstring/3,[]);
2317
normalize_restrictedstring(S,{Name,Val},CType) when atom(Name) ->
2318
normalize_restrictedstring(S,Val,CType).
2321
get_normalized_value(S,Val,Type,Func,AddArg) ->
2322
case catch get_referenced_type(S,Val) of
2323
{_,#valuedef{type=_T,value=V}} ->
2324
%% should check that Type and T equals
2325
call_Func(S,V,Type,Func,AddArg);
2327
io:format("WARNING: default value not "
2328
"comparable ~p~n",[Val]),
2331
call_Func(S,NewVal,Type,Func,AddArg);
2333
io:format("WARNING: default value not "
2334
"comparable ~p~n",[Val]),
2338
call_Func(S,Val,Type,Func,ArgList) ->
2343
Func(S,Val,Type,LastArg);
2345
Func(Arg1,S,Val,Type,LastArg1);
2346
[Arg1,LastArg1,LastArg2] ->
2347
Func(Arg1,S,Val,Type,LastArg1,LastArg2)
2351
get_canonic_type(S,Type,NameList) ->
2352
{InnerType,NewType,NewNameList} =
2353
case Type#type.def of
2354
Name when atom(Name) ->
2355
{Name,Type,NameList};
2356
Ref when record(Ref,'Externaltypereference') ->
2357
{_,#typedef{name=Name,typespec=RefedType}} =
2358
get_referenced_type(S,Ref),
2359
get_canonic_type(S,RefedType,[Name]);
2360
{Name,T} when atom(Name) ->
2362
Seq when record(Seq,'SEQUENCE') ->
2363
{'SEQUENCE',Seq#'SEQUENCE'.components,NameList};
2364
Set when record(Set,'SET') ->
2365
{'SET',Set#'SET'.components,NameList}
2367
{asn1ct_gen:unify_if_string(InnerType),NewType,NewNameList}.
2371
check_ptype(_S,Type,Ts) when record(Ts,type) ->
2373
%Constr = Ts#type.constraint,
2377
Seq when record(Seq,'SEQUENCE') ->
2378
#newt{type=Seq#'SEQUENCE'{pname=Type#ptypedef.name}};
2379
Set when record(Set,'SET') ->
2380
#newt{type=Set#'SET'{pname=Type#ptypedef.name}};
2384
Ts2 = case NewDef of
2385
#newt{type=unchanged} ->
2393
% check_type(S,Type,ObjSpec={{objectclassname,_},_}) ->
2394
% check_class(S,ObjSpec);
2395
check_type(_S,Type,Ts) when record(Type,typedef),
2396
(Type#typedef.checked==true) ->
2398
check_type(_S,Type,Ts) when record(Type,typedef),
2399
(Type#typedef.checked==idle) -> % the check is going on
2401
check_type(S=#state{recordtopname=TopName},Type,Ts) when record(Ts,type) ->
2403
case match_parameters(Ts#type.def,S#state.parameters) of
2404
#type{constraint=_Ctmp,def=Dtmp} ->
2405
{Dtmp,Ts#type.tag,Ts#type.constraint};
2407
{Dtmp,Ts#type.tag,Ts#type.constraint}
2409
TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr},
2412
{_,MaybeChoice} = get_referenced_type(S,Tref),
2413
case catch((MaybeChoice#typedef.typespec)#type.def) of
2415
maybe_illicit_implicit_tag(choice,Tag);
2417
maybe_illicit_implicit_tag(open_type,Tag);
2419
maybe_illicit_implicit_tag(open_type,Tag);
2421
maybe_illicit_implicit_tag(open_type,Tag);
2428
Ext when record(Ext,'Externaltypereference') ->
2429
{_,RefTypeDef} = get_referenced_type(S,Ext),
2430
% case RefTypeDef of
2431
% Class when record(Class,classdef) ->
2432
% throw({asn1_class,Class});
2435
case is_class(S,RefTypeDef) of
2436
true -> throw({asn1_class,RefTypeDef});
2441
%case S#state.erule of
2443
case RefTypeDef#typedef.checked of
2445
RefTypeDef#typedef.typespec;
2447
NewRefTypeDef1 = RefTypeDef#typedef{checked=idle},
2448
asn1_db:dbput(S#state.mname,
2449
NewRefTypeDef1#typedef.name,NewRefTypeDef1),
2451
check_type(S,RefTypeDef,RefTypeDef#typedef.typespec),
2453
RefTypeDef#typedef{checked=true,typespec = RefType1},
2454
asn1_db:dbput(S#state.mname,
2455
NewRefTypeDef2#typedef.name,NewRefTypeDef2),
2456
%% update the type and mark as checked
2459
% _ -> RefTypeDef#typedef.typespec
2462
case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of
2464
%% Here we expand to a built in type and inline it
2469
merge_tags(Ct,RefType#type.tag),
2471
merge_constraints(check_constraints(S,Constr),
2472
RefType#type.constraint)};
2474
%% Here we only expand the tags and keep the ext ref
2478
check_externaltypereference(S,Ext),
2480
case S#state.erule of
2482
merge_tags(Ct,RefType#type.tag);
2489
Ct=maybe_illicit_implicit_tag(open_type,Tag),
2490
TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
2491
{'ANY_DEFINED_BY',_} ->
2492
Ct=maybe_illicit_implicit_tag(open_type,Tag),
2493
TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
2495
check_integer(S,[],Constr),
2496
TempNewDef#newt{tag=
2497
merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))};
2499
{'INTEGER',NamedNumberList} ->
2500
TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList,Constr)},
2502
merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))};
2503
{'BIT STRING',NamedNumberList} ->
2504
NewL = check_bitstring(S,NamedNumberList,Constr),
2505
%% erlang:display({asn1ct_check,NamedNumberList,NewL}),
2506
TempNewDef#newt{type={'BIT STRING',NewL},
2508
merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))};
2510
TempNewDef#newt{tag=
2511
merge_tags(Tag,?TAG_PRIMITIVE(?N_NULL))};
2512
'OBJECT IDENTIFIER' ->
2513
check_objectidentifier(S,Constr),
2514
TempNewDef#newt{tag=
2515
merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER))};
2516
'ObjectDescriptor' ->
2517
TempNewDef#newt{tag=
2518
merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_DESCRIPTOR))};
2520
%% AssociatedType = asn1_db:dbget(S#state.mname,'EXTERNAL'),
2521
%% #newt{type=check_type(S,Type,AssociatedType)};
2522
put(external,unchecked),
2523
TempNewDef#newt{type=
2524
#'Externaltypereference'{module=S#state.mname,
2527
merge_tags(Tag,?TAG_CONSTRUCTED(?N_EXTERNAL))};
2528
{'INSTANCE OF',DefinedObjectClass,Constraint} ->
2529
%% check that DefinedObjectClass is of TYPE-IDENTIFIER class
2530
%% If Constraint is empty make it the general INSTANCE OF type
2531
%% If Constraint is not empty make an inlined type
2532
%% convert INSTANCE OF to the associated type
2533
IOFDef=check_instance_of(S,DefinedObjectClass,Constraint),
2534
TempNewDef#newt{type=IOFDef,
2535
tag=merge_tags(Tag,?TAG_CONSTRUCTED(?N_INSTANCE_OF))};
2536
{'ENUMERATED',NamedNumberList} ->
2537
TempNewDef#newt{type=
2539
check_enumerated(S,NamedNumberList,Constr)},
2541
merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED))};
2543
% AssociatedType = asn1_db:dbget(S#state.mname,'EMBEDDED PDV'),
2544
% CheckedType = check_type(S,Type,
2545
% AssociatedType#typedef.typespec),
2546
put(embedded_pdv,unchecked),
2547
TempNewDef#newt{type=
2548
#'Externaltypereference'{module=S#state.mname,
2549
type='EMBEDDED PDV'},
2551
merge_tags(Tag,?TAG_CONSTRUCTED(?N_EMBEDDED_PDV))};
2553
check_boolean(S,Constr),
2554
TempNewDef#newt{tag=
2555
merge_tags(Tag,?TAG_PRIMITIVE(?N_BOOLEAN))};
2557
check_octetstring(S,Constr),
2558
TempNewDef#newt{tag=
2559
merge_tags(Tag,?TAG_PRIMITIVE(?N_OCTET_STRING))};
2561
check_restrictedstring(S,Def,Constr),
2562
TempNewDef#newt{tag=
2563
merge_tags(Tag,?TAG_PRIMITIVE(?N_NumericString))};
2565
check_restrictedstring(S,Def,Constr),
2566
TempNewDef#newt{tag=
2567
merge_tags(Tag,?TAG_PRIMITIVE(?N_TeletexString))};
2569
check_restrictedstring(S,Def,Constr),
2570
TempNewDef#newt{tag=
2571
merge_tags(Tag,?TAG_PRIMITIVE(?N_VideotexString))};
2573
TempNewDef#newt{tag=
2574
merge_tags(Tag,?TAG_PRIMITIVE(?N_UTCTime))};
2575
'GeneralizedTime' ->
2576
TempNewDef#newt{tag=
2577
merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralizedTime))};
2579
check_restrictedstring(S,Def,Constr),
2580
TempNewDef#newt{tag=
2581
merge_tags(Tag,?TAG_PRIMITIVE(?N_GraphicString))};
2583
check_restrictedstring(S,Def,Constr),
2584
TempNewDef#newt{tag=
2585
merge_tags(Tag,?TAG_PRIMITIVE(?N_VisibleString))};
2587
check_restrictedstring(S,Def,Constr),
2588
TempNewDef#newt{tag=
2589
merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralString))};
2590
'PrintableString' ->
2591
check_restrictedstring(S,Def,Constr),
2592
TempNewDef#newt{tag=
2593
merge_tags(Tag,?TAG_PRIMITIVE(?N_PrintableString))};
2595
check_restrictedstring(S,Def,Constr),
2596
TempNewDef#newt{tag=
2597
merge_tags(Tag,?TAG_PRIMITIVE(?N_IA5String))};
2599
check_restrictedstring(S,Def,Constr),
2600
TempNewDef#newt{tag=
2601
merge_tags(Tag,?TAG_PRIMITIVE(?N_BMPString))};
2602
'UniversalString' ->
2603
check_restrictedstring(S,Def,Constr),
2604
TempNewDef#newt{tag=
2605
merge_tags(Tag,?TAG_PRIMITIVE(?N_UniversalString))};
2606
'CHARACTER STRING' ->
2607
% AssociatedType = asn1_db:dbget(S#state.mname,
2608
% 'CHARACTER STRING'),
2609
% CheckedType = check_type(S,Type,
2610
% AssociatedType#typedef.typespec),
2611
put(character_string,unchecked),
2612
TempNewDef#newt{type=
2613
#'Externaltypereference'{module=S#state.mname,
2614
type='CHARACTER STRING'},
2616
merge_tags(Tag,?TAG_CONSTRUCTED(?N_CHARACTER_STRING))};
2617
Seq when record(Seq,'SEQUENCE') ->
2621
[Type#typedef.name];
2625
{TableCInf,Components} =
2626
check_sequence(S#state{recordtopname=
2628
Type,Seq#'SEQUENCE'.components),
2629
TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=TableCInf,
2630
components=Components},
2632
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))};
2633
{'SEQUENCE OF',Components} ->
2634
TempNewDef#newt{type={'SEQUENCE OF',check_sequenceof(S,Type,Components)},
2636
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))};
2637
{'CHOICE',Components} ->
2638
Ct = maybe_illicit_implicit_tag(choice,Tag),
2639
TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct};
2640
Set when record(Set,'SET') ->
2644
[Type#typedef.name];
2648
{Sorted,TableCInf,Components} =
2649
check_set(S#state{recordtopname=RecordName},
2650
Type,Set#'SET'.components),
2651
TempNewDef#newt{type=Set#'SET'{sorted=Sorted,
2652
tablecinf=TableCInf,
2653
components=Components},
2655
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
2656
{'SET OF',Components} ->
2657
TempNewDef#newt{type={'SET OF',check_setof(S,Type,Components)},
2659
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
2660
%% This is a temporary hack until the full Information Obj Spec
2661
%% in X.681 is supported
2662
{{typereference,_,'TYPE-IDENTIFIER'},[{typefieldreference,_,'Type'}]} ->
2663
Ct=maybe_illicit_implicit_tag(open_type,Tag),
2664
TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
2666
{#'Externaltypereference'{type='TYPE-IDENTIFIER'},
2667
[{typefieldreference,_,'Type'}]} ->
2668
Ct=maybe_illicit_implicit_tag(open_type,Tag),
2669
TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
2671
{pt,Ptype,ParaList} ->
2672
%% Ptype might be a parameterized - type, object set or
2673
%% value set. If it isn't a parameterized type notify the
2674
%% calling function.
2675
{_,Ptypedef} = get_referenced_type(S,Ptype),
2676
notify_if_not_ptype(S,Ptypedef),
2677
NewParaList = [match_parameters(TmpParam,S#state.parameters)||
2678
TmpParam <- ParaList],
2679
Instance = instantiate_ptype(S,Ptypedef,NewParaList),
2680
TempNewDef#newt{type=Instance#type.def,
2681
tag=merge_tags(Tag,Instance#type.tag),
2682
constraint=Instance#type.constraint,
2685
% {ClRef,FieldRefList} when record(ClRef,'Externaltypereference') ->
2686
OCFT=#'ObjectClassFieldType'{class=ClRef} ->
2687
%% this case occures in a SEQUENCE when
2688
%% the type of the component is a ObjectClassFieldType
2689
ClassSpec = check_class(S,ClRef),
2690
NewTypeDef = maybe_open_type(S,ClassSpec,OCFT,Constr),
2691
InnerTag = get_innertag(S,NewTypeDef),
2692
MergedTag = merge_tags(Tag,InnerTag),
2694
case is_open_type(NewTypeDef) of
2696
maybe_illicit_implicit_tag(open_type,MergedTag);
2700
TempNewDef#newt{type=NewTypeDef,tag=Ct};
2702
TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}};
2704
exit({'cant check' ,Other})
2706
Ts2 = case NewDef of
2707
#newt{type=unchanged} ->
2712
NewTag = case NewDef of
2713
#newt{tag=unchanged} ->
2718
T3 = Ts2#type{tag = lists:map(fun(TempTag = #tag{type={default,TTx}}) ->
2719
TempTag#tag{type=TTx};
2720
(Else) -> Else end, NewTag)},
2722
#newt{constraint=unchanged} ->
2723
T3#type{constraint=Constr};
2724
#newt{constraint=NewConstr} ->
2725
T3#type{constraint=NewConstr}
2727
T5 = T4#type{inlined=NewDef#newt.inlined},
2728
T5#type{constraint=check_constraints(S,T5#type.constraint)}.
2731
get_innertag(_S,#'ObjectClassFieldType'{type=Type}) ->
2733
#type{tag=Tag} -> Tag;
2734
{fixedtypevaluefield,_,#type{tag=Tag}} -> Tag;
2735
{TypeFieldName,_} when atom(TypeFieldName) -> [];
2738
get_innertag(_S,_) ->
2741
is_class(_S,#classdef{}) ->
2743
is_class(S,#typedef{typespec=#type{def=Eref}})
2744
when record(Eref,'Externaltypereference')->
2745
{_,NextDef} = get_referenced_type(S,Eref),
2746
is_class(S,NextDef);
2750
get_class_def(_S,CD=#classdef{}) ->
2752
get_class_def(S,#typedef{typespec=#type{def=Eref}})
2753
when record(Eref,'Externaltypereference') ->
2754
{_,NextDef} = get_referenced_type(S,Eref),
2755
get_class_def(S,NextDef).
2757
maybe_illicit_implicit_tag(Kind,Tag) ->
2759
[#tag{type='IMPLICIT'}|_T] ->
2760
throw({error,{asn1,{implicit_tag_before,Kind}}});
2761
[ChTag = #tag{type={default,_}}|T] ->
2764
[ChTag#tag{type='EXPLICIT',form=32}|T]; %X.680 30.6c, X.690 8.14.2
2766
[ChTag#tag{type='EXPLICIT',form=32}|T] % X.680 28.6 c, 30.6c
2772
%% maybe_open_type/2 -> {ClassSpec,FieldRefList} | 'ASN1_OPEN_TYPE'
2773
%% if the FieldRefList points out a typefield and the class don't have
2774
%% any UNIQUE field, so that a component relation constraint cannot specify
2775
%% the type of a typefield, return 'ASN1_OPEN_TYPE', otherwise return
2776
%% {ClassSpec,FieldRefList}.
2777
maybe_open_type(S,ClassSpec=#objectclass{fields=Fs},
2778
OCFT=#'ObjectClassFieldType'{fieldname=FieldRefList},
2780
Type = get_ObjectClassFieldType(S,Fs,FieldRefList),
2781
FieldNames=get_referenced_fieldname(FieldRefList),
2782
case lists:last(FieldRefList) of
2783
{valuefieldreference,_} ->
2784
OCFT#'ObjectClassFieldType'{class=ClassSpec,
2785
fieldname=FieldNames,
2787
{typefieldreference,_} ->
2788
case {catch get_unique_fieldname(#classdef{typespec=ClassSpec}),
2789
asn1ct_gen:get_constraint(Constr,componentrelation)}of
2790
{Tuple,_} when tuple(Tuple) ->
2791
OCFT#'ObjectClassFieldType'{class=ClassSpec,
2792
fieldname=FieldNames,
2793
type='ASN1_OPEN_TYPE'};
2795
OCFT#'ObjectClassFieldType'{class=ClassSpec,
2796
fieldname=FieldNames,
2797
type='ASN1_OPEN_TYPE'};
2799
OCFT#'ObjectClassFieldType'{class=ClassSpec,
2800
fieldname=FieldNames,
2805
is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) ->
2807
is_open_type(#'ObjectClassFieldType'{}) ->
2811
notify_if_not_ptype(S,#pvaluesetdef{type=Type}) ->
2812
case Type#type.def of
2813
Ref when record(Ref,'Externaltypereference') ->
2814
case get_referenced_type(S,Ref) of
2816
throw(pobjectsetdef);
2820
T when record(T,type) -> % this must be a value set
2823
notify_if_not_ptype(_S,#ptypedef{}) ->
2827
instantiate_ptype(S,Ptypedef,ParaList) ->
2828
#ptypedef{args=Args,typespec=Type} = Ptypedef,
2829
% Args = get_pt_args(Ptypedef),
2830
% Type = get_pt_spec(Ptypedef),
2831
MatchedArgs = match_args(Args, ParaList, []),
2832
NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]},
2833
%The abscomppath must be empty since a table constraint in a
2834
%parameterized type only can refer to components within the type
2835
check_type(NewS, Ptypedef, Type).
2837
get_pt_args(#ptypedef{args=Args}) ->
2839
get_pt_args(#pvaluesetdef{args=Args}) ->
2841
get_pt_args(#pvaluedef{args=Args}) ->
2843
get_pt_args(#pobjectdef{args=Args}) ->
2845
get_pt_args(#pobjectsetdef{args=Args}) ->
2848
get_pt_spec(#ptypedef{typespec=Type}) ->
2850
get_pt_spec(#pvaluedef{value=Value}) ->
2852
get_pt_spec(#pvaluesetdef{valueset=VS}) ->
2854
get_pt_spec(#pobjectdef{def=Def}) ->
2856
get_pt_spec(#pobjectsetdef{def=Def}) ->
2861
match_args([FormArg|Ft], [ActArg|At], Acc) ->
2862
match_args(Ft, At, [{FormArg,ActArg}|Acc]);
2863
match_args([], [], Acc) ->
2865
match_args(_, _, _) ->
2866
throw({error,{asn1,{wrong_number_of_arguments}}}).
2868
check_constraints(S,C) when list(C) ->
2869
check_constraints(S, C, []);
2870
check_constraints(S,C) when record(C,constraint) ->
2871
check_constraints(S, C#constraint.c, []).
2874
resolv_tuple_or_list(S,List) when list(List) ->
2875
lists:map(fun(X)->resolv_value(S,X) end, List);
2876
resolv_tuple_or_list(S,{Lb,Ub}) ->
2877
{resolv_value(S,Lb),resolv_value(S,Ub)}.
2879
%%%-----------------------------------------
2880
%% If the constraint value is a defined value the valuename
2881
%% is replaced by the actual value
2883
resolv_value(S,Val) ->
2884
case match_parameters(Val, S#state.parameters) of
2886
resolv_value1(S,Id);
2888
resolv_value(S,Other)
2891
resolv_value1(S = #state{mname=M,inputmodules=InpMods},
2892
V=#'Externalvaluereference'{pos=Pos,module=ExtM,value=Name}) ->
2894
M -> resolv_value2(S,M,Name,Pos);
2896
case lists:member(ExtM,InpMods) of
2898
resolv_value2(S,M,Name,Pos);
2903
resolv_value1(S,{gt,V}) ->
2905
Int when integer(Int) ->
2907
#valuedef{value=Int} ->
2908
1 + resolv_value(S,Int);
2910
throw({error,{asn1,{undefined_type_or_value,Other}}})
2912
resolv_value1(S,{lt,V}) ->
2914
Int when integer(Int) ->
2916
#valuedef{value=Int} ->
2917
resolv_value(S,Int) - 1;
2919
throw({error,{asn1,{undefined_type_or_value,Other}}})
2921
resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference,
2923
%% FieldName can hold either a fixed-type value or a variable-type value
2924
%% Object is a DefinedObject, i.e. a #'Externaltypereference'
2925
{_,ObjTDef} = get_referenced_type(S,Object),
2926
TS = check_object(S,ObjTDef,ObjTDef#typedef.typespec),
2927
{_,_,Components} = TS#'Object'.def,
2928
case lists:keysearch(FieldName,1,Components) of
2929
{value,{_,#valuedef{value=Val}}} ->
2932
error({value,"illegal value in constraint",S})
2934
% resolv_value1(S,{'ValueFromObject',{po,Object,Params},FieldName}) ->
2935
% %% FieldName can hold either a fixed-type value or a variable-type value
2936
% %% Object is a ParameterizedObject
2937
resolv_value1(_,V) ->
2940
resolv_value2(S,ModuleName,Name,Pos) ->
2941
case asn1_db:dbget(ModuleName,Name) of
2943
case imported(S,Name) of
2945
{_,V2} = get_referenced(S,Imodule,Name,Pos),
2948
throw({error,{asn1,{undefined_type_or_value,Name}}})
2954
check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) ->
2955
{_,CTDef} = get_referenced_type(S,Type#type.def),
2956
CType = check_type(S,S#state.tname,CTDef#typedef.typespec),
2957
check_constraints(S,Rest,CType#type.constraint ++ Acc);
2958
check_constraints(S,[C | Rest], Acc) ->
2959
check_constraints(S,Rest,[check_constraint(S,C) | Acc]);
2960
check_constraints(S,[],Acc) ->
2961
% io:format("Acc: ~p~n",[Acc]),
2962
C = constraint_merge(S,lists:reverse(Acc)),
2963
% io:format("C: ~p~n",[C]),
2967
range_check(F={FixV,FixV}) ->
2970
range_check(VR={Lb,Ub}) when Lb < Ub ->
2972
range_check(Err={_,_}) ->
2973
throw({error,{asn1,{illegal_size_constraint,Err}}});
2974
range_check(Value) ->
2977
check_constraint(S,Ext) when record(Ext,'Externaltypereference') ->
2978
check_externaltypereference(S,Ext);
2981
check_constraint(S,{'SizeConstraint',{Lb,Ub}})
2982
when list(Lb);tuple(Lb),size(Lb)==2 ->
2984
#'Externalvaluereference'{} ->
2985
check_constraint(S,{'SizeConstraint',{resolv_value(S,Lb),Ub}});
2987
NewLb = range_check(resolv_tuple_or_list(S,Lb)),
2988
NewUb = range_check(resolv_tuple_or_list(S,Ub)),
2989
{'SizeConstraint',{NewLb,NewUb}}
2991
check_constraint(S,{'SizeConstraint',{Lb,Ub}}) ->
2992
case {resolv_value(S,Lb),resolv_value(S,Ub)} of
2994
{'SizeConstraint',FixV};
2995
{Low,High} when Low < High ->
2996
{'SizeConstraint',{Low,High}};
2998
throw({error,{asn1,{illegal_size_constraint,Err}}})
3000
check_constraint(S,{'SizeConstraint',Lb}) ->
3001
{'SizeConstraint',resolv_value(S,Lb)};
3003
check_constraint(S,{'SingleValue', L}) when list(L) ->
3004
F = fun(A) -> resolv_value(S,A) end,
3005
{'SingleValue',lists:map(F,L)};
3007
check_constraint(S,{'SingleValue', V}) when integer(V) ->
3008
Val = resolv_value(S,V),
3009
%% [{'SingleValue',Val},{'ValueRange',{Val,Val}}]; % Why adding value range?
3010
{'SingleValue',Val};
3011
check_constraint(S,{'SingleValue', V}) ->
3012
{'SingleValue',resolv_value(S,V)};
3014
check_constraint(S,{'ValueRange', {Lb, Ub}}) ->
3015
{'ValueRange',{resolv_value(S,Lb),resolv_value(S,Ub)}};
3017
%%check_constraint(S,{'ContainedSubtype',Type}) ->
3018
%% #typedef{typespec=TSpec} =
3019
%% check_type(S,S#state.tname,get_referenced_type(S,Type#type.def)),
3020
%% [C] = TSpec#type.constraint,
3023
check_constraint(S,{valueset,Type}) ->
3024
{valueset,check_type(S,S#state.tname,Type)};
3026
check_constraint(S,{simpletable,Type}) ->
3027
OSName = (Type#type.def)#'Externaltypereference'.type,
3028
C = match_parameters(Type#type.def,S#state.parameters),
3030
#'Externaltypereference'{} ->
3031
Type#type{def=check_externaltypereference(S,C)},
3032
{simpletable,OSName};
3034
check_type(S,S#state.tname,Type),
3035
{simpletable,OSName}
3038
check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) ->
3039
%% Objset is an 'Externaltypereference' record, since Objset is
3040
%% a DefinedObjectSet.
3041
RealObjset = match_parameters(Objset,S#state.parameters),
3042
Ext = check_externaltypereference(S,RealObjset),
3043
{componentrelation,{objectset,Opos,Ext},Id};
3045
check_constraint(S,Type) when record(Type,type) ->
3046
#type{def=Def} = check_type(S,S#state.tname,Type),
3049
check_constraint(S,C) when list(C) ->
3050
lists:map(fun(X)->check_constraint(S,X) end,C);
3051
% else keep the constraint unchanged
3052
check_constraint(_S,Any) ->
3053
% io:format("Constraint = ~p~n",[Any]),
3056
%% constraint_merge/2
3057
%% Compute the intersection of the outermost level of the constraint list.
3058
%% See Dubuisson second paragraph and fotnote on page 285.
3059
%% If constraints with extension are included in combined constraints. The
3060
%% resulting combination will have the extension of the last constraint. Thus,
3061
%% there will be no extension if the last constraint is without extension.
3062
%% The rootset of all constraints are considered in the "outermoust
3063
%% intersection". See section 13.1.2 in Dubuisson.
3064
constraint_merge(_S,C=[H])when tuple(H) ->
3066
constraint_merge(_S,[]) ->
3068
constraint_merge(S,C) ->
3069
%% skip all extension but the last
3070
C1 = filter_extensions(C),
3071
%% perform all internal level intersections, intersections first
3072
%% since they have precedence over unions
3073
C2 = lists:map(fun(X)when list(X)->constraint_intersection(S,X);
3076
%% perform all internal level unions
3077
C3 = lists:map(fun(X)when list(X)->constraint_union(S,X);
3081
%% now get intersection of the outermost level
3082
%% get the least common single value constraint
3083
SVs = get_constraints(C3,'SingleValue'),
3084
CombSV = intersection_of_sv(S,SVs),
3085
%% get the least common value range constraint
3086
VRs = get_constraints(C3,'ValueRange'),
3087
CombVR = intersection_of_vr(S,VRs),
3088
%% get the least common size constraint
3089
SZs = get_constraints(C3,'SizeConstraint'),
3090
CombSZ = intersection_of_size(S,SZs),
3091
CminusSVs=ordsets:subtract(ordsets:from_list(C3),ordsets:from_list(SVs)),
3092
% CminusSVsVRs = ordsets:subtract(ordsets:from_list(CminusSVs),
3093
% ordsets:from_list(VRs)),
3094
RestC = ordsets:subtract(ordsets:from_list(CminusSVs),
3095
ordsets:from_list(SZs)),
3096
%% get the least common combined constraint. That is the union of each
3097
%% deep costraint and merge of single value and value range constraints
3098
combine_constraints(S,CombSV,CombVR,CombSZ++RestC).
3100
%% constraint_union(S,C) takes a list of constraints as input and
3101
%% merge them to a union. Unions are performed when two
3102
%% constraints is found with an atom union between.
3103
%% The list may be nested. Fix that later !!!
3104
constraint_union(_S,[]) ->
3106
constraint_union(_S,C=[_E]) ->
3108
constraint_union(S,C) when list(C) ->
3109
case lists:member(union,C) of
3111
constraint_union1(S,C,[]);
3115
% SV = get_constraints(C,'SingleValue'),
3116
% SV1 = constraint_union_sv(S,SV),
3117
% VR = get_constraints(C,'ValueRange'),
3118
% VR1 = constraint_union_vr(VR),
3119
% RestC = ordsets:filter(fun({'SingleValue',_})->false;
3120
% ({'ValueRange',_})->false;
3121
% (_) -> true end,ordsets:from_list(C)),
3123
constraint_union(_S,C) ->
3126
constraint_union1(S,[A={'ValueRange',_},union,B={'ValueRange',_}|Rest],Acc) ->
3127
AunionB = constraint_union_vr([A,B]),
3128
constraint_union1(S,Rest,AunionB++Acc);
3129
constraint_union1(S,[A={'SingleValue',_},union,B={'SingleValue',_}|Rest],Acc) ->
3130
AunionB = constraint_union_sv(S,[A,B]),
3131
constraint_union1(S,Rest,AunionB++Acc);
3132
constraint_union1(S,[A={'SingleValue',_},union,B={'ValueRange',_}|Rest],Acc) ->
3133
AunionB = union_sv_vr(S,A,B),
3134
constraint_union1(S,Rest,AunionB++Acc);
3135
constraint_union1(S,[A={'ValueRange',_},union,B={'SingleValue',_}|Rest],Acc) ->
3136
AunionB = union_sv_vr(S,B,A),
3137
constraint_union1(S,Rest,AunionB++Acc);
3138
constraint_union1(S,[union|Rest],Acc) -> %skip when unsupported constraints
3139
constraint_union1(S,Rest,Acc);
3140
constraint_union1(S,[A|Rest],Acc) ->
3141
constraint_union1(S,Rest,[A|Acc]);
3142
constraint_union1(_S,[],Acc) ->
3145
constraint_union_sv(_S,SV) ->
3146
Values=lists:map(fun({_,V})->V end,SV),
3147
case ordsets:from_list(Values) of
3149
[N] -> [{'SingleValue',N}];
3150
L -> [{'SingleValue',L}]
3154
%%constraint_union(S,VR,'ValueRange') ->
3155
%% constraint_union_vr(VR).
3157
%% constraint_union_vr(VR)
3158
%% VR = [{'ValueRange',{Lb,Ub}},...]
3159
%% Lb = 'MIN' | integer()
3160
%% Ub = 'MAX' | integer()
3161
%% Returns if possible only one ValueRange tuple with a range that
3162
%% is a union of all ranges in VR.
3163
constraint_union_vr(VR) ->
3164
%% Sort VR by Lb in first hand and by Ub in second hand
3165
Fun=fun({_,{'MIN',_B1}},{_,{A2,_B2}}) when integer(A2)->true;
3166
({_,{A1,_B1}},{_,{'MAX',_B2}}) when integer(A1) -> true;
3167
({_,{A1,_B1}},{_,{A2,_B2}}) when integer(A1),integer(A2),A1<A2 -> true;
3168
({_,{A,B1}},{_,{A,B2}}) when B1=<B2->true;
3170
constraint_union_vr(lists:usort(Fun,VR),[]).
3172
constraint_union_vr([],Acc) ->
3174
constraint_union_vr([C|Rest],[]) ->
3175
constraint_union_vr(Rest,[C]);
3176
constraint_union_vr([{_,{Lb,Ub2}}|Rest],[{_,{Lb,_Ub1}}|Acc]) -> %Ub2 > Ub1
3177
constraint_union_vr(Rest,[{'ValueRange',{Lb,Ub2}}|Acc]);
3178
constraint_union_vr([{_,{_,Ub}}|Rest],A=[{_,{_,Ub}}|_Acc]) ->
3179
constraint_union_vr(Rest,A);
3180
constraint_union_vr([{_,{Lb2,Ub2}}|Rest],[{_,{Lb1,Ub1}}|Acc]) when Lb2=<Ub1,
3182
constraint_union_vr(Rest,[{'ValueRange',{Lb1,Ub2}}|Acc]);
3183
constraint_union_vr([{_,{_,Ub2}}|Rest],A=[{_,{_,Ub1}}|_Acc]) when Ub2=<Ub1->
3184
constraint_union_vr(Rest,A);
3185
constraint_union_vr([VR|Rest],Acc) ->
3186
constraint_union_vr(Rest,[VR|Acc]).
3188
union_sv_vr(_S,[],B) ->
3190
union_sv_vr(_S,A,[]) ->
3192
union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',VR={Lb,Ub}})
3194
case is_int_in_vr(SV,C2) of
3198
{'MIN',Ub} when SV==Ub+1 -> [{'ValueRange',{'MIN',SV}}];
3199
{Lb,'MAX'} when SV==Lb-1 -> [{'ValueRange',{SV,'MAX'}}];
3200
{Lb,Ub} when SV==Ub+1 -> [{'ValueRange',{Lb,SV}}];
3201
{Lb,Ub} when SV==Lb-1 -> [{'ValueRange',{SV,Ub}}];
3206
union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',{_Lb,_Ub}})
3208
case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of
3211
case expand_vr(L,C2) of
3214
{[Val],C3} -> [{'SingleValue',Val},C3];
3215
{L2,C3} -> [{'SingleValue',L2},C3]
3219
expand_vr(L,VR={_,{Lb,Ub}}) ->
3220
case lower_Lb(L,Lb) of
3222
case higher_Ub(L,Ub) of
3226
expand_vr(L1,{'ValueRange',{Lb,UbNew}})
3229
expand_vr(L1,{'ValueRange',{LbNew,Ub}})
3232
lower_Lb(_,'MIN') ->
3235
remove_val_from_list(Lb - 1,L).
3237
higher_Ub(_,'MAX') ->
3240
remove_val_from_list(Ub + 1,L).
3242
remove_val_from_list(List,Val) ->
3243
case lists:member(Val,List) of
3245
{lists:delete(Val,List),Val};
3250
%% get_constraints/2
3251
%% Arguments are a list of constraints, which has the format {key,value},
3252
%% and a constraint type
3253
%% Returns a list of constraints only of the requested type or the atom
3254
%% 'no' if no such constraints were found
3255
get_constraints(L=[{CType,_}],CType) ->
3257
get_constraints(C,CType) ->
3258
keysearch_allwithkey(CType,1,C).
3260
%% keysearch_allwithkey(Key,Ix,L)
3265
%% TwoTuple = [{atom(),term()}|...]
3266
%% Returns a List that contains all
3267
%% elements from L that has a key Key as element Ix
3268
keysearch_allwithkey(Key,Ix,L) ->
3269
lists:filter(fun(X) when tuple(X) ->
3270
case element(Ix,X) of
3278
%% filter_extensions(C)
3279
%% takes a list of constraints as input and
3280
%% returns a list with the intersection of all extension roots
3281
%% and only the extension of the last constraint kept if any
3282
%% extension in the last constraint
3283
filter_extensions([]) ->
3285
filter_extensions(C=[_H]) ->
3287
filter_extensions(C) when list(C) ->
3288
filter_extensions(C,[]).
3290
filter_extensions([C],Acc) ->
3291
lists:reverse([C|Acc]);
3292
filter_extensions([{C,_E},H2|T],Acc) when tuple(C) ->
3293
filter_extensions([H2|T],[C|Acc]);
3294
filter_extensions([{'SizeConstraint',{A,_B}},H2|T],Acc)
3295
when list(A);tuple(A) ->
3296
filter_extensions([H2|T],[{'SizeConstraint',A}|Acc]);
3297
filter_extensions([H1,H2|T],Acc) ->
3298
filter_extensions([H2|T],[H1|Acc]).
3300
%% constraint_intersection(S,C) takes a list of constraints as input and
3301
%% performs intersections. Intersecions are performed when an
3302
%% atom intersection is found between two constraints.
3303
%% The list may be nested. Fix that later !!!
3304
constraint_intersection(_S,[]) ->
3306
constraint_intersection(_S,C=[_E]) ->
3308
constraint_intersection(S,C) when list(C) ->
3309
% io:format("constraint_intersection: ~p~n",[C]),
3310
case lists:member(intersection,C) of
3312
constraint_intersection1(S,C,[]);
3316
constraint_intersection(_S,C) ->
3319
constraint_intersection1(S,[A,intersection,B|Rest],Acc) ->
3320
AisecB = c_intersect(S,A,B),
3321
constraint_intersection1(S,Rest,AisecB++Acc);
3322
constraint_intersection1(S,[A|Rest],Acc) ->
3323
constraint_intersection1(S,Rest,[A|Acc]);
3324
constraint_intersection1(_,[],Acc) ->
3327
c_intersect(S,C1={'SingleValue',_},C2={'SingleValue',_}) ->
3328
intersection_of_sv(S,[C1,C2]);
3329
c_intersect(S,C1={'ValueRange',_},C2={'ValueRange',_}) ->
3330
intersection_of_vr(S,[C1,C2]);
3331
c_intersect(S,C1={'ValueRange',_},C2={'SingleValue',_}) ->
3332
intersection_sv_vr(S,[C2],[C1]);
3333
c_intersect(S,C1={'SingleValue',_},C2={'ValueRange',_}) ->
3334
intersection_sv_vr(S,[C1],[C2]);
3335
c_intersect(_S,C1,C2) ->
3338
%% combine_constraints(S,SV,VR,CComb)
3340
%% S = record(state,S)
3343
%% CComb = [] | [Lists]
3344
%% SVC = {'SingleValue',integer()} | {'SingleValue',[integer(),...]}
3345
%% VRC = {'ValueRange',{Lb,Ub}}
3346
%% Lists = List of lists containing any constraint combination
3347
%% Lb = 'MIN' | integer()
3348
%% Ub = 'MAX' | integer()
3349
%% Returns a combination of the least common constraint among SV,VR and all
3350
%% elements in CComb
3351
combine_constraints(_S,[],VR,CComb) ->
3353
% combine_combined_cnstr(S,VR,CComb);
3354
combine_constraints(_S,SV,[],CComb) ->
3356
% combine_combined_cnstr(S,SV,CComb);
3357
combine_constraints(S,SV,VR,CComb) ->
3358
C=intersection_sv_vr(S,SV,VR),
3360
% combine_combined_cnstr(S,C,CComb).
3362
intersection_sv_vr(_,[],_VR) ->
3364
intersection_sv_vr(_,_SV,[]) ->
3366
intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}])
3368
case is_int_in_vr(SV,C2) of
3370
_ -> %%error({type,{"asn1 illegal constraint",C1,C2},S})
3371
throw({error,{"asn1 illegal constraint",C1,C2}})
3373
intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2])
3375
case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of
3377
%%error({type,{"asn1 illegal constraint",C1,C2},S});
3378
throw({error,{"asn1 illegal constraint",C1,C2}});
3379
[V] -> [{'SingleValue',V}];
3380
L -> [{'SingleValue',L}]
3385
intersection_of_size(_,[]) ->
3387
intersection_of_size(_,C=[_SZ]) ->
3389
intersection_of_size(S,[SZ,SZ|Rest]) ->
3390
intersection_of_size(S,[SZ|Rest]);
3391
intersection_of_size(S,C=[C1={_,Int},{_,Range}|Rest])
3392
when integer(Int),tuple(Range) ->
3394
{Lb,Ub} when Int >= Lb,
3396
intersection_of_size(S,[C1|Rest]);
3398
throw({error,{asn1,{illegal_size_constraint,C}}})
3400
intersection_of_size(S,[C1={_,Range},C2={_,Int}|Rest])
3401
when integer(Int),tuple(Range) ->
3402
intersection_of_size(S,[C2,C1|Rest]);
3403
intersection_of_size(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) ->
3404
Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])),
3405
Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])),
3406
intersection_of_size(S,[{'SizeConstraint',{Lb,Ub}}|Rest]);
3407
intersection_of_size(_,SZ) ->
3408
throw({error,{asn1,{illegal_size_constraint,SZ}}}).
3410
intersection_of_vr(_,[]) ->
3412
intersection_of_vr(_,VR=[_C]) ->
3414
intersection_of_vr(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) ->
3415
Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])),
3416
Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])),
3417
intersection_of_vr(S,[{'ValueRange',{Lb,Ub}}|Rest]);
3418
intersection_of_vr(_S,VR) ->
3419
%%error({type,{asn1,{illegal_value_range_constraint,VR}},S});
3420
throw({error,{asn1,{illegal_value_range_constraint,VR}}}).
3422
intersection_of_sv(_,[]) ->
3424
intersection_of_sv(_,SV=[_C]) ->
3426
intersection_of_sv(S,[SV,SV|Rest]) ->
3427
intersection_of_sv(S,[SV|Rest]);
3428
intersection_of_sv(S,[{_,Int},{_,SV}|Rest]) when integer(Int),
3430
SV2=intersection_of_sv1(S,Int,SV),
3431
intersection_of_sv(S,[SV2|Rest]);
3432
intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when integer(Int),
3434
SV2=intersection_of_sv1(S,Int,SV),
3435
intersection_of_sv(S,[SV2|Rest]);
3436
intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when list(SV1),
3438
SV3=common_set(SV1,SV2),
3439
intersection_of_sv(S,[SV3|Rest]);
3440
intersection_of_sv(_S,SV) ->
3441
%%error({type,{asn1,{illegal_single_value_constraint,SV}},S}).
3442
throw({error,{asn1,{illegal_single_value_constraint,SV}}}).
3444
intersection_of_sv1(_S,Int,SV) when integer(Int),list(SV) ->
3445
case lists:member(Int,SV) of
3446
true -> {'SingleValue',Int};
3448
%%error({type,{asn1,{illegal_single_value_constraint,Int,SV}},S})
3449
throw({error,{asn1,{illegal_single_value_constraint,Int,SV}}})
3451
intersection_of_sv1(_S,SV1,SV2) ->
3452
%%error({type,{asn1,{illegal_single_value_constraint,SV1,SV2}},S}).
3453
throw({error,{asn1,{illegal_single_value_constraint,SV1,SV2}}}).
3458
greatest_LB1(lists:reverse(L)).
3459
greatest_LB1(['MIN',H2|_T])->
3461
greatest_LB1([H|_T]) ->
3466
common_set(SV1,SV2) ->
3467
lists:filter(fun(X)->lists:member(X,SV1) end,SV2).
3469
is_int_in_vr(Int,{_,{'MIN','MAX'}}) when integer(Int) ->
3471
is_int_in_vr(Int,{_,{'MIN',Ub}}) when integer(Int),Int =< Ub ->
3473
is_int_in_vr(Int,{_,{Lb,'MAX'}}) when integer(Int),Int >= Lb ->
3475
is_int_in_vr(Int,{_,{Lb,Ub}}) when integer(Int),Int >= Lb,Int =< Ub ->
3477
is_int_in_vr(_,_) ->
3482
check_imported(_S,Imodule,Name) ->
3483
case asn1_db:dbget(Imodule,'MODULE') of
3485
io:format("~s.asn1db not found~n",[Imodule]),
3486
io:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]);
3487
Im when record(Im,module) ->
3488
case is_exported(Im,Name) of
3490
io:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]);
3497
is_exported(Module,Name) when record(Module,module) ->
3498
{exports,Exports} = Module#module.exports,
3505
case lists:keysearch(Name,#'Externaltypereference'.type,Exports) of
3513
check_externaltypereference(S,Etref=#'Externaltypereference'{module=Emod})->
3514
Currmod = S#state.mname,
3515
MergedMods = S#state.inputmodules,
3518
%% reference to current module or to imported reference
3519
check_reference(S,Etref);
3521
%% io:format("Type ~s IMPORTED FROM ~s~n",[Etype,Emod]),
3522
case lists:member(Emod,MergedMods) of
3524
check_reference(S,Etref);
3530
check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) ->
3531
ModName = S#state.mname,
3532
case asn1_db:dbget(ModName,Name) of
3534
case imported(S,Name) of
3536
check_imported(S,Imodule,Name),
3537
#'Externaltypereference'{module=Imodule,type=Name};
3539
%may be a renamed type in multi file compiling!
3540
{_,T}=renamed_reference(S,Name,Emod),
3541
NewName = asn1ct:get_name_of_def(T),
3542
NewPos = asn1ct:get_pos_of_def(T),
3543
#'Externaltypereference'{pos=NewPos,
3548
%% cannot do check_type here due to recursive definitions, like
3549
%% S ::= SEQUENCE {a INTEGER, b S}. This implies that references
3550
%% that appear before the definition will be an
3551
%% Externaltypereference in the abstract syntax tree
3552
#'Externaltypereference'{pos=Pos,module=ModName,type=Name}
3556
name2Extref(_Mod,Name) when record(Name,'Externaltypereference') ->
3558
name2Extref(Mod,Name) ->
3559
#'Externaltypereference'{module=Mod,type=Name}.
3561
get_referenced_type(S,Ext) when record(Ext,'Externaltypereference') ->
3562
case match_parameters(Ext, S#state.parameters) of
3564
#'Externaltypereference'{pos=Pos,module=Emod,type=Etype} = Ext,
3565
case S#state.mname of
3566
Emod -> % a local reference in this module
3567
get_referenced1(S,Emod,Etype,Pos);
3568
_ ->% always when multi file compiling
3569
case lists:member(Emod,S#state.inputmodules) of
3571
get_referenced1(S,Emod,Etype,Pos);
3573
get_referenced(S,Emod,Etype,Pos)
3579
get_referenced_type(S=#state{mname=Emod},
3580
ERef=#'Externalvaluereference'{pos=P,module=Emod,
3582
case match_parameters(ERef,S#state.parameters) of
3584
get_referenced1(S,Emod,Eval,P);
3585
OtherERef when record(OtherERef,'Externalvaluereference') ->
3586
get_referenced_type(S,OtherERef);
3590
get_referenced_type(S,ERef=#'Externalvaluereference'{pos=Pos,module=Emod,
3592
case match_parameters(ERef,S#state.parameters) of
3594
case lists:member(Emod,S#state.inputmodules) of
3596
get_referenced1(S,Emod,Eval,Pos);
3598
get_referenced(S,Emod,Eval,Pos)
3601
get_referenced_type(S,OtherERef)
3603
get_referenced_type(S,#identifier{val=Name,pos=Pos}) ->
3604
get_referenced1(S,undefined,Name,Pos);
3605
get_referenced_type(_S,Type) ->
3609
%% The referenced entity Ename may in case of an imported parameterized
3610
%% type reference imported entities in the other module, which implies that
3611
%% asn1_db:dbget will fail even though the referenced entity exists. Thus
3612
%% Emod may be the module that imports the entity Ename and not holds the
3613
%% data about Ename.
3614
get_referenced(S,Emod,Ename,Pos) ->
3615
case asn1_db:dbget(Emod,Ename) of
3617
%% May be an imported entity in module Emod
3618
% throw({error,{asn1,{undefined_type_or_value,{Emod,Ename}}}});
3619
NewS = S#state{module=asn1_db:dbget(Emod,'MODULE')},
3620
get_imported(NewS,Ename,Emod,Pos);
3621
T when record(T,typedef) ->
3622
Spec = T#typedef.typespec,
3623
case Spec#type.def of
3624
Tref when record(Tref,typereference) ->
3625
Def = #'Externaltypereference'{module=Emod,
3626
type=Tref#typereference.val,
3627
pos=Tref#typereference.pos},
3630
{Emod,T#typedef{typespec=Spec#type{def=Def}}};
3632
{Emod,T} % should add check that T is exported here
3637
get_referenced1(S,ModuleName,Name,Pos) ->
3638
case asn1_db:dbget(S#state.mname,Name) of
3640
%% ModuleName may be other than S#state.mname when
3641
%% multi file compiling is used.
3642
get_imported(S,Name,ModuleName,Pos);
3647
get_imported(S,Name,Module,Pos) ->
3648
case imported(S,Name) of
3650
case asn1_db:dbget(Imodule,'MODULE') of
3652
throw({error,{asn1,{module_not_found,Imodule}}});
3653
Im when record(Im,module) ->
3654
case is_exported(Im,Name) of
3657
{asn1,{not_exported,{Im,Name}}}});
3659
get_referenced_type(S,
3660
#'Externaltypereference'
3666
renamed_reference(S,Name,Module)
3669
renamed_reference(S,Name,Module) ->
3670
%% first check if there is a renamed type in this module
3671
%% second check if any type was imported with this name
3672
case ets:info(renamed_defs) of
3673
undefined -> throw({error,{asn1,{undefined_type,Name}}});
3675
case ets:match(renamed_defs,{'$1',Name,Module}) of
3677
case ets:info(original_imports) of
3679
throw({error,{asn1,{undefined_type,Name}}});
3681
case ets:match(original_imports,{Module,'$1'}) of
3683
throw({error,{asn1,{undefined_type,Name}}});
3685
case get_importmoduleoftype(ImportsList,Name) of
3687
throw({error,{asn1,{undefined_type,Name}}});
3689
renamed_reference(S,Name,NextMod)
3694
get_referenced1(S,Module,NewTypeName,undefined)
3698
get_importmoduleoftype([I|Is],Name) ->
3699
Index = #'Externaltypereference'.type,
3700
case lists:keysearch(Name,Index,I#'SymbolsFromModule'.symbols) of
3702
(I#'SymbolsFromModule'.module)#'Externaltypereference'.type;
3704
get_importmoduleoftype(Is,Name)
3706
get_importmoduleoftype([],_) ->
3710
match_parameters(Name,[]) ->
3713
match_parameters(#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) ->
3715
match_parameters(#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
3717
% match_parameters(#'Externaltypereference'{type=Name},[{#typereference{val=Name},NewName}|T]) ->
3719
% match_parameters(#'Externaltypereference'{type=Name},[{{_,#typereference{val=Name}},NewName}|T]) ->
3721
%match_parameters(#typereference{val=Name},[{#typereference{val=Name},NewName}|T]) ->
3723
match_parameters(#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) ->
3725
match_parameters(#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) ->
3727
% match_parameters(#identifier{val=Name},[{#identifier{val=Name},NewName}|T]) ->
3729
% match_parameters(#identifier{val=Name},[{{_,#identifier{val=Name}},NewName}|T]) ->
3731
match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}},
3732
[{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) ->
3734
match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}},
3735
[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
3737
% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}},
3738
% [{{_,#typereference{val=Name}},{valueset,#type{def=NewName}}}|T]) ->
3740
% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}},
3741
% [{{_,#typereference{val=Name}},NewName}|T]) ->
3744
match_parameters(Name, [_H|T]) ->
3745
%%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]),
3746
match_parameters(Name,T).
3749
{imports,Ilist} = (S#state.module)#module.imports,
3750
imported1(Name,Ilist).
3753
[#'SymbolsFromModule'{symbols=Symlist,
3754
module=#'Externaltypereference'{type=ModuleName}}|T]) ->
3755
case lists:keysearch(Name,#'Externaltypereference'.type,Symlist) of
3761
imported1(_Name,[]) ->
3765
check_integer(_S,[],_C) ->
3767
check_integer(S,NamedNumberList,_C) ->
3768
case check_unique(NamedNumberList,2) of
3770
check_int(S,NamedNumberList,[]);
3772
error({type,{duplicates,L},S}),
3777
check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when integer(Num) ->
3778
check_int(S,T,[{Id,Num}|Acc]);
3779
check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) ->
3780
Val = dbget_ex(S,S#state.mname,Name),
3781
check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc);
3782
check_int(_S,[],Acc) ->
3783
lists:keysort(2,Acc).
3787
check_bitstring(_S,[],_Constr) ->
3789
check_bitstring(S,NamedNumberList,_Constr) ->
3790
case check_unique(NamedNumberList,2) of
3792
check_bitstr(S,NamedNumberList,[]);
3794
error({type,{duplicates,L},S}),
3798
check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when integer(Num) ->
3799
check_bitstr(S,T,[{Id,Num}|Acc]);
3800
check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when atom(Name) ->
3801
%%check_bitstr(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) ->
3802
%% io:format("asn1ct_check:check_bitstr/3 hej hop ~w~n",[Name]),
3803
Val = dbget_ex(S,S#state.mname,Name),
3804
%% io:format("asn1ct_check:check_bitstr/3: ~w~n",[Val]),
3805
check_bitstr(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc);
3806
check_bitstr(S,[],Acc) ->
3807
case check_unique(Acc,2) of
3809
lists:keysort(2,Acc);
3811
error({type,{duplicate_values,L},S}),
3815
%%check_bitstring(S,NamedNumberList,Constr) ->
3818
%% Check INSTANCE OF
3819
%% check that DefinedObjectClass is of TYPE-IDENTIFIER class
3820
%% If Constraint is empty make it the general INSTANCE OF type
3821
%% If Constraint is not empty make an inlined type
3822
%% convert INSTANCE OF to the associated type
3823
check_instance_of(S,DefinedObjectClass,Constraint) ->
3824
check_type_identifier(S,DefinedObjectClass),
3825
iof_associated_type(S,Constraint).
3828
check_type_identifier(_S,'TYPE-IDENTIFIER') ->
3830
check_type_identifier(S,Eref=#'Externaltypereference'{}) ->
3831
case get_referenced_type(S,Eref) of
3832
{_,#classdef{name='TYPE-IDENTIFIER'}} -> ok;
3833
{_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} ->
3834
check_type_identifier(S,(TD#typedef.typespec)#type.def);
3836
error({type,{"object set in type INSTANCE OF "
3837
"not of class TYPE-IDENTIFIER",Eref},S})
3840
iof_associated_type(S,[]) ->
3841
%% in this case encode/decode functions for INSTANCE OF must be
3843
case get(instance_of) of
3845
AssociateSeq = iof_associated_type1(S,[]),
3847
case S#state.erule of
3849
[?TAG_CONSTRUCTED(?N_INSTANCE_OF)];
3852
TypeDef=#typedef{checked=true,
3854
typespec=#type{tag=Tag,
3856
asn1_db:dbput(S#state.mname,'INSTANCE OF',TypeDef),
3857
put(instance_of,generate);
3861
#'Externaltypereference'{module=S#state.mname,type='INSTANCE OF'};
3862
iof_associated_type(S,C) ->
3863
iof_associated_type1(S,C).
3865
iof_associated_type1(S,C) ->
3866
{TableCInf,Comp1Cnstr,Comp2Cnstr,Comp2tablecinf}=
3867
instance_of_constraints(S,C),
3869
ModuleName = S#state.mname,
3872
[] -> 'ASN1_OPEN_TYPE';
3873
_ -> {typefield,'Type'}
3875
{ObjIdTag,C1TypeTag}=
3876
case S#state.erule of
3879
[#tag{class='UNIVERSAL',
3883
_ -> {[{'UNIVERSAL','INTEGER'}],[]}
3885
TypeIdentifierRef=#'Externaltypereference'{module=ModuleName,
3886
type='TYPE-IDENTIFIER'},
3888
#'ObjectClassFieldType'{classname=TypeIdentifierRef,
3891
type={fixedtypevaluefield,id,
3892
#type{def='OBJECT IDENTIFIER'}}},
3894
#'ObjectClassFieldType'{classname=TypeIdentifierRef,
3896
fieldname={'Type',[]},
3897
type=Typefield_type},
3899
[#'ComponentType'{name='type-id',
3900
typespec=#type{tag=C1TypeTag,
3901
def=ObjectIdentifier,
3902
constraint=Comp1Cnstr},
3905
#'ComponentType'{name=value,
3906
typespec=#type{tag=[#tag{class='CONTEXT',
3911
constraint=Comp2Cnstr,
3912
tablecinf=Comp2tablecinf},
3914
tags=[{'CONTEXT',0}]}],
3915
#'SEQUENCE'{tablecinf=TableCInf,
3916
components=IOFComponents}.
3919
%% returns the leading attribute, the constraint of the components and
3920
%% the tablecinf value for the second component.
3921
instance_of_constraints(_,[]) ->
3923
instance_of_constraints(S,#constraint{c={simpletable,Type}}) ->
3924
#type{def=#'Externaltypereference'{type=Name}} = Type,
3925
ModuleName = S#state.mname,
3926
ObjectSetRef=#'Externaltypereference'{module=ModuleName,
3928
CRel=[{componentrelation,{objectset,
3932
[#'Externalvaluereference'{module=ModuleName,
3934
TableCInf=#simpletableattributes{objectsetname=Name,
3938
uniqueclassfield=id,
3940
{TableCInf,[{simpletable,Name}],CRel,[{objfun,ObjectSetRef}]}.
3943
%% ****************************************
3944
%% Check that all values are unique
3945
%% assign values to un-numbered identifiers
3946
%% check that the constraints are allowed and correct
3947
%% put the updated info back into database
3948
check_enumerated(_S,[{Name,Number}|Rest],_Constr) when atom(Name), integer(Number)->
3949
%% already checked , just return the same list
3950
[{Name,Number}|Rest];
3951
check_enumerated(S,NamedNumberList,_Constr) ->
3952
check_enum(S,NamedNumberList,[],[]).
3954
%% identifiers are put in Acc2
3955
%% returns either [{Name,Number}] or {[{Name,Number}],[{ExtName,ExtNumber}]}
3956
%% the latter is returned if the ENUMERATION contains EXTENSIONMARK
3957
check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2) when integer(Num) ->
3958
check_enum(S,T,[{Id,Num}|Acc1],Acc2);
3959
check_enum(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2) ->
3960
Val = dbget_ex(S,S#state.mname,Name),
3961
check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc1,Acc2);
3962
check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2) ->
3963
NewAcc2 = lists:keysort(2,Acc1),
3964
NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[]),
3965
{ NewList, check_enum(S,T,[],[])};
3966
check_enum(S,[Id|T],Acc1,Acc2) when atom(Id) ->
3967
check_enum(S,T,Acc1,[Id|Acc2]);
3968
check_enum(_S,[],Acc1,Acc2) ->
3969
NewAcc2 = lists:keysort(2,Acc1),
3970
enum_number(lists:reverse(Acc2),NewAcc2,0,[]).
3973
% assign numbers to identifiers , numbers from 0 ... but must not
3974
% be the same as already assigned to NamedNumbers
3975
enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num > Cnt ->
3976
enum_number(T,[{Id,Num}|T2],Cnt+1,[{H,Cnt}|Acc]);
3977
enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num < Cnt -> % negative Num
3978
enum_number(T,T2,Cnt+1,[{H,Cnt},{Id,Num}|Acc]);
3979
enum_number([],L2,_Cnt,Acc) ->
3980
lists:concat([lists:reverse(Acc),L2]);
3981
enum_number(L,[{Id,Num}|T2],Cnt,Acc) -> % Num == Cnt
3982
enum_number(L,T2,Cnt+1,[{Id,Num}|Acc]);
3983
enum_number([H|T],[],Cnt,Acc) ->
3984
enum_number(T,[],Cnt+1,[{H,Cnt}|Acc]).
3987
check_boolean(_S,_Constr) ->
3990
check_octetstring(_S,_Constr) ->
3993
% check all aspects of a SEQUENCE
3994
% - that all component names are unique
3995
% - that all TAGS are ok (when TAG default is applied)
3996
% - that each component is of a valid type
3997
% - that the extension marks are valid
3999
check_sequence(S,Type,Comps) ->
4000
Components = expand_components(S,Comps),
4001
case check_unique([C||C <- Components ,record(C,'ComponentType')]
4002
,#'ComponentType'.name) of
4004
%% sort_canonical(Components),
4005
Components2 = maybe_automatic_tags(S,Components),
4006
%% check the table constraints from here. The outermost type
4007
%% is Type, the innermost is Comps (the list of components)
4009
case check_each_component(S,Type,Components2) of
4010
NewComponents when list(NewComponents) ->
4011
check_unique_sequence_tags(S,NewComponents),
4013
Ret = {NewComponents,NewEcomps} ->
4014
TagComps = NewComponents ++
4015
[Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewEcomps],
4016
%% extension components are like optionals when it comes to tagging
4017
check_unique_sequence_tags(S,TagComps),
4020
%% CRelInf is the "leading attribute" information
4021
%% necessary for code generating of the look up in the
4022
%% object set table,
4023
%% i.e. getenc_ObjectSet/getdec_ObjectSet.
4024
%% {objfun,ERef} tuple added in NewComps2 in tablecinf
4025
%% field in type record of component relation constrained
4027
% io:format("NewComps: ~p~n",[NewComps]),
4028
{CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps),
4029
% io:format("CRelInf: ~p~n",[CRelInf]),
4030
% io:format("NewComps2: ~p~n",[NewComps2]),
4031
%% CompListWithTblInf has got a lot unecessary info about
4032
%% the involved class removed, as the class of the object
4034
CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2),
4035
% io:format("CompListWithTblInf: ~p~n",[CompListWithTblInf]),
4036
{CRelInf,CompListWithTblInf};
4038
throw({error,{asn1,{duplicate_components,Dupl}}})
4041
expand_components(S, [{'COMPONENTS OF',Type}|T]) ->
4043
case get_referenced_type(S,Type#type.def) of
4044
{_,#typedef{typespec=#type{def=Seq}}} when record(Seq,'SEQUENCE') ->
4045
case Seq#'SEQUENCE'.components of
4046
{Root,_Ext} -> Root;
4049
Err -> throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}})
4051
expand_components(S,CompList) ++ expand_components(S,T);
4052
expand_components(S,[H|T]) ->
4053
[H|expand_components(S,T)];
4054
expand_components(_,[]) ->
4057
check_unique_sequence_tags(S,[#'ComponentType'{prop=mandatory}|Rest]) ->
4058
check_unique_sequence_tags(S,Rest);
4059
check_unique_sequence_tags(S,[C|Rest]) when record(C,'ComponentType') ->
4060
check_unique_sequence_tags1(S,Rest,[C]);% optional or default
4061
check_unique_sequence_tags(S,[_ExtensionMarker|Rest]) ->
4062
check_unique_sequence_tags(S,Rest);
4063
check_unique_sequence_tags(_S,[]) ->
4066
check_unique_sequence_tags1(S,[C|Rest],Acc) when record(C,'ComponentType') ->
4067
case C#'ComponentType'.prop of
4069
check_unique_tags(S,lists:reverse([C|Acc])),
4070
check_unique_sequence_tags(S,Rest);
4072
check_unique_sequence_tags1(S,Rest,[C|Acc]) % default or optional
4074
check_unique_sequence_tags1(S,[H|Rest],Acc) ->
4075
check_unique_sequence_tags1(S,Rest,[H|Acc]);
4076
check_unique_sequence_tags1(S,[],Acc) ->
4077
check_unique_tags(S,lists:reverse(Acc)).
4079
check_sequenceof(S,Type,Component) when record(Component,type) ->
4080
check_type(S,Type,Component).
4082
check_set(S,Type,Components) ->
4083
{TableCInf,NewComponents} = check_sequence(S,Type,Components),
4084
case lists:member(der,S#state.options) of
4085
true when S#state.erule == ber;
4086
S#state.erule == ber_bin ->
4087
{Sorted,SortedComponents} =
4088
sort_components(S#state.tname,
4089
(S#state.module)#module.tagdefault,
4091
{Sorted,TableCInf,SortedComponents};
4093
{false,TableCInf,NewComponents}
4096
sort_components(_TypeName,'AUTOMATIC',Components) ->
4098
sort_components(TypeName,_TagDefault,Components) ->
4099
case untagged_choice(Components) of
4101
{true,sort_components1(TypeName,Components,[],[],[],[])};
4103
{dynamic,Components} % sort in run-time
4106
sort_components1(TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs],
4107
UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4108
sort_components1(TypeName,Cs,[C|UnivAcc],ApplAcc,ContAcc,PrivAcc);
4109
sort_components1(TypeName,[C=#'ComponentType'{tags=[{'APPLICATION',_}|_R]}|Cs],
4110
UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4111
sort_components1(TypeName,Cs,UnivAcc,[C|ApplAcc],ContAcc,PrivAcc);
4112
sort_components1(TypeName,[C=#'ComponentType'{tags=[{'CONTEXT',_}|_R]}|Cs],
4113
UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4114
sort_components1(TypeName,Cs,UnivAcc,ApplAcc,[C|ContAcc],PrivAcc);
4115
sort_components1(TypeName,[C=#'ComponentType'{tags=[{'PRIVATE',_}|_R]}|Cs],
4116
UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4117
sort_components1(TypeName,Cs,UnivAcc,ApplAcc,ContAcc,[C|PrivAcc]);
4118
sort_components1(TypeName,[],UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4119
I = #'ComponentType'.tags,
4120
ascending_order_check(TypeName,sort_universal_type(UnivAcc)) ++
4121
ascending_order_check(TypeName,lists:keysort(I,ApplAcc)) ++
4122
ascending_order_check(TypeName,lists:keysort(I,ContAcc)) ++
4123
ascending_order_check(TypeName,lists:keysort(I,PrivAcc)).
4125
ascending_order_check(TypeName,Components) ->
4126
ascending_order_check1(TypeName,Components),
4129
ascending_order_check1(TypeName,
4130
[C1 = #'ComponentType'{tags=[{_,T}|_]},
4131
C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) ->
4132
io:format("WARNING: Indistinct tag ~p in SET ~p, components ~p and ~p~n",
4133
[T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name]),
4134
ascending_order_check1(TypeName,[C2|Rest]);
4135
ascending_order_check1(TypeName,
4136
[C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]},
4137
C2 = #'ComponentType'{tags=[{'UNIVERSAL',T2}|_]}|Rest]) ->
4138
case (asn1ct_gen_ber:decode_type(T1) == asn1ct_gen_ber:decode_type(T2)) of
4140
io:format("WARNING: Indistinct tags ~p and ~p in"
4141
" SET ~p, components ~p and ~p~n",
4142
[T1,T2,TypeName,C1#'ComponentType'.name,
4143
C2#'ComponentType'.name]),
4144
ascending_order_check1(TypeName,[C2|Rest]);
4146
ascending_order_check1(TypeName,[C2|Rest])
4148
ascending_order_check1(N,[_|Rest]) ->
4149
ascending_order_check1(N,Rest);
4150
ascending_order_check1(_,[_]) ->
4152
ascending_order_check1(_,[]) ->
4155
sort_universal_type(Components) ->
4156
List = lists:map(fun(C) ->
4157
#'ComponentType'{tags=[{_,T}|_]} = C,
4158
{asn1ct_gen_ber:decode_type(T),C}
4161
SortedList = lists:keysort(1,List),
4162
lists:map(fun(X)->element(2,X) end,SortedList).
4164
untagged_choice([#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) ->
4166
untagged_choice([_|Rest]) ->
4167
untagged_choice(Rest);
4168
untagged_choice([]) ->
4171
check_setof(S,Type,Component) when record(Component,type) ->
4172
check_type(S,Type,Component).
4174
check_restrictedstring(_S,_Def,_Constr) ->
4177
check_objectidentifier(_S,_Constr) ->
4180
% check all aspects of a CHOICE
4181
% - that all alternative names are unique
4182
% - that all TAGS are ok (when TAG default is applied)
4183
% - that each alternative is of a valid type
4184
% - that the extension marks are valid
4185
check_choice(S,Type,Components) when list(Components) ->
4186
case check_unique([C||C <- Components,
4187
record(C,'ComponentType')],#'ComponentType'.name) of
4189
%% sort_canonical(Components),
4190
Components2 = maybe_automatic_tags(S,Components),
4192
case check_each_alternative(S,Type,Components2) of
4193
{NewComponents,NewEcomps} ->
4194
check_unique_tags(S,NewComponents ++ NewEcomps),
4195
{NewComponents,NewEcomps};
4197
check_unique_tags(S,NewComponents),
4200
%% CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps);
4202
throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}})
4204
check_choice(_S,_,[]) ->
4207
%% probably dead code that should be removed
4208
%%maybe_automatic_tags(S,{Rc,Ec}) ->
4209
%% {maybe_automatic_tags1(S,Rc,0),maybe_automatic_tags1(S,Ec,length(Rc))};
4210
maybe_automatic_tags(#state{erule=per},C) ->
4212
maybe_automatic_tags(#state{erule=per_bin},C) ->
4214
maybe_automatic_tags(S,C) ->
4215
maybe_automatic_tags1(S,C,0).
4217
maybe_automatic_tags1(S,C,TagNo) ->
4218
case (S#state.module)#module.tagdefault of
4220
generate_automatic_tags(S,C,TagNo);
4222
%% maybe is the module a multi file module were only some of
4223
%% the modules have defaulttag AUTOMATIC TAGS then the names
4224
%% of those types are saved in the table automatic_tags
4225
Name= S#state.tname,
4226
case is_automatic_tagged_in_multi_file(Name) of
4228
generate_automatic_tags(S,C,TagNo);
4234
is_automatic_tagged_in_multi_file(Name) ->
4235
case ets:info(automatic_tags) of
4237
%% this case when not multifile compilation
4240
case ets:member(automatic_tags,Name) of
4248
generate_automatic_tags(_S,C,TagNo) ->
4249
case any_manual_tag(C) of
4253
generate_automatic_tags1(C,TagNo)
4256
generate_automatic_tags1([H|T],TagNo) when record(H,'ComponentType') ->
4257
#'ComponentType'{typespec=Ts} = H,
4258
NewTs = Ts#type{tag=[#tag{class='CONTEXT',
4260
type={default,'IMPLICIT'},
4261
form= 0 }]}, % PRIMITIVE
4262
[H#'ComponentType'{typespec=NewTs}|generate_automatic_tags1(T,TagNo+1)];
4263
generate_automatic_tags1([ExtMark|T],TagNo) -> % EXTENSIONMARK
4264
[ExtMark | generate_automatic_tags1(T,TagNo)];
4265
generate_automatic_tags1([],_) ->
4268
any_manual_tag([#'ComponentType'{typespec=#type{tag=[]}}|Rest]) ->
4269
any_manual_tag(Rest);
4270
any_manual_tag([{'EXTENSIONMARK',_,_}|Rest]) ->
4271
any_manual_tag(Rest);
4272
any_manual_tag([_|_Rest]) ->
4274
any_manual_tag([]) ->
4278
check_unique_tags(S,C) ->
4279
case (S#state.module)#module.tagdefault of
4281
case any_manual_tag(C) of
4283
_ -> collect_and_sort_tags(C,[])
4286
collect_and_sort_tags(C,[])
4289
collect_and_sort_tags([C|Rest],Acc) when record(C,'ComponentType') ->
4290
collect_and_sort_tags(Rest,C#'ComponentType'.tags ++ Acc);
4291
collect_and_sort_tags([_|Rest],Acc) ->
4292
collect_and_sort_tags(Rest,Acc);
4293
collect_and_sort_tags([],Acc) ->
4294
{Dupl,_}= lists:mapfoldl(fun(El,El)->{{dup,El},El};(El,_Prev)-> {El,El} end,notag,lists:sort(Acc)),
4295
Dupl2 = [Dup|| {dup,Dup} <- Dupl],
4297
length(Dupl2) > 0 ->
4298
throw({error,{asn1,{duplicates_of_the_tags,Dupl2}}});
4303
check_unique(L,Pos) ->
4304
Slist = lists:keysort(Pos,L),
4305
check_unique2(Slist,Pos,[]).
4307
check_unique2([A,B|T],Pos,Acc) when element(Pos,A) == element(Pos,B) ->
4308
check_unique2([B|T],Pos,[element(Pos,B)|Acc]);
4309
check_unique2([_|T],Pos,Acc) ->
4310
check_unique2(T,Pos,Acc);
4311
check_unique2([],_,Acc) ->
4314
check_each_component(S,Type,{Rlist,ExtList}) ->
4315
{check_each_component(S,Type,Rlist),
4316
check_each_component(S,Type,ExtList)};
4317
check_each_component(S,Type,Components) ->
4318
check_each_component(S,Type,Components,[],[],noext).
4320
check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type,
4321
[C|Ct],Acc,Extacc,Ext) when record(C,'ComponentType') ->
4322
#'ComponentType'{name=Cname,typespec=Ts,prop=Prop} = C,
4325
#'Externaltypereference'{} -> [];
4328
CheckedTs = check_type(S#state{abscomppath=NewAbsCPath,
4329
recordtopname=[Cname|TopName]},Type,Ts),
4330
NewTags = get_taglist(S,CheckedTs),
4333
% case lists:member(der,S#state.options) of
4336
case normalize_value(S,CheckedTs,Prop,[Cname|TopName]) of
4337
mandatory -> mandatory;
4338
'OPTIONAL' -> 'OPTIONAL';
4339
DefaultValue -> {'DEFAULT',DefaultValue}
4344
NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags},
4347
check_each_component(S,Type,Ct,[NewC|Acc],Extacc,Ext);
4349
check_each_component(S,Type,Ct,Acc,[NewC|Extacc],Ext)
4351
check_each_component(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK'
4352
check_each_component(S,Type,Ct,Acc,Extacc,ext);
4353
check_each_component(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK'
4354
throw({error,{asn1,{too_many_extension_marks}}});
4355
check_each_component(_S,_,[],Acc,Extacc,ext) ->
4356
{lists:reverse(Acc),lists:reverse(Extacc)};
4357
check_each_component(_S,_,[],Acc,_,noext) ->
4360
check_each_alternative(S,Type,{Rlist,ExtList}) ->
4361
{check_each_alternative(S,Type,Rlist),
4362
check_each_alternative(S,Type,ExtList)};
4363
check_each_alternative(S,Type,[C|Ct]) ->
4364
check_each_alternative(S,Type,[C|Ct],[],[],noext).
4366
check_each_alternative(S=#state{abscomppath=Path,recordtopname=TopName},Type,[C|Ct],
4367
Acc,Extacc,Ext) when record(C,'ComponentType') ->
4368
#'ComponentType'{name=Cname,typespec=Ts,prop=_Prop} = C,
4371
#'Externaltypereference'{} -> [];
4375
S#state{abscomppath=NewAbsCPath,recordtopname=[Cname|TopName]},
4376
CheckedTs = check_type(NewState,Type,Ts),
4377
NewTags = get_taglist(S,CheckedTs),
4378
NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags},
4381
check_each_alternative(S,Type,Ct,[NewC|Acc],Extacc,Ext);
4383
check_each_alternative(S,Type,Ct,Acc,[NewC|Extacc],Ext)
4386
check_each_alternative(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK'
4387
check_each_alternative(S,Type,Ct,Acc,Extacc,ext);
4388
check_each_alternative(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK'
4389
throw({error,{asn1,{too_many_extension_marks}}});
4390
check_each_alternative(_S,_,[],Acc,Extacc,ext) ->
4391
{lists:reverse(Acc),lists:reverse(Extacc)};
4392
check_each_alternative(_S,_,[],Acc,_,noext) ->
4395
%% componentrelation_leadingattr/2 searches the structure for table
4396
%% constraints, if any is found componentrelation_leadingattr/5 is
4398
componentrelation_leadingattr(S,CompList) ->
4402
{Components,EComponents} when list(Components) ->
4403
% {Components,Components};
4404
Components ++ EComponents;
4405
CompList when list(CompList) ->
4406
% {CompList,CompList}
4409
% case any_simple_table(S,Cs1,[]) of
4411
%% get_simple_table_if_used/2 should find out whether there are any
4412
%% component relation constraints in the entire tree of Cs1 that
4413
%% relates to this level. It returns information about the simple
4414
%% table constraint necessary for the the call to
4415
%% componentrelation_leadingattr/6. The step when the leading
4416
%% attribute and the syntax tree is modified to support the code
4418
case get_simple_table_if_used(S,Cs) of
4419
[] -> {false,CompList};
4421
% componentrelation_leadingattr(S,Cs1,Cs2,STList,[],[])
4422
componentrelation_leadingattr(S,Cs,Cs,STList,[],[])
4425
%% componentrelation_leadingattr/6 when all components are searched
4426
%% the new modified components are returned together with the "leading
4427
%% attribute" information, which later is stored in the tablecinf
4428
%% field in the SEQUENCE/SET record. The "leading attribute"
4429
%% information is used to generate the lookup in the object set
4430
%% table. The other information gathered in the #type.tablecinf field
4431
%% is used in code generating phase too, to recognice the proper
4432
%% components for "open type" encoding and to propagate the result of
4433
%% the object set lookup when needed.
4434
componentrelation_leadingattr(_,[],_CompList,_,[],NewCompList) ->
4435
{false,lists:reverse(NewCompList)};
4436
componentrelation_leadingattr(_,[],_CompList,_,LeadingAttr,NewCompList) ->
4437
{lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later
4438
componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) ->
4440
case catch componentrelation1(S,C#'ComponentType'.typespec,
4441
[C#'ComponentType'.name]) of
4444
{CRI=[{_A1,_B1,_C1,_D1}|_Rest],NewTSpec} ->
4445
%% {ObjectSet,AtPath,ClassDef,Path}
4446
%% _A1 is a reference to the object set of the
4447
%% component relation constraint.
4448
%% _B1 is the path of names in the at-list of the
4449
%% component relation constraint.
4450
%% _C1 is the class definition of the
4451
%% ObjectClassFieldType.
4452
%% _D1 is the path of components that was traversed to
4453
%% find this constraint.
4454
case leading_attr_index(S,CompList,CRI,
4455
lists:reverse(S#state.abscomppath),[]) of
4458
[{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] ->
4459
OS = object_set_mod_name(S,ObjSet),
4461
case (catch get_unique_fieldname(#classdef{typespec=ClassDef})) of
4462
{error,'__undefined_'} ->
4465
error({type,Msg,S});
4468
% UsedFieldName = get_used_fieldname(S,Attr,STList),
4469
%% Res should be done differently: even though
4470
%% a unique field name exists it is not
4471
%% certain that the ObjectClassFieldType of
4472
%% the simple table constraint picks that
4474
Res = #simpletableattributes{objectsetname=OS,
4475
%% c_name=asn1ct_gen:un_hyphen_var(Attr),
4478
usedclassfield=UniqueFieldName,
4479
uniqueclassfield=UniqueFieldName,
4480
valueindex=ValueIndex},
4481
{[Res],C#'ComponentType'{typespec=NewTSpec}}
4484
%% no constraint was found
4487
componentrelation_leadingattr(S,Cs,CompList,STList,LAAcc++Acc,
4490
object_set_mod_name(_S,ObjSet) when atom(ObjSet) ->
4492
object_set_mod_name(#state{mname=M},
4493
#'Externaltypereference'{module=M,type=T}) ->
4495
object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) ->
4496
case lists:member(M,S#state.inputmodules) of
4503
%% get_used_fieldname gets the used field of the class referenced by
4504
%% the ObjectClassFieldType construct in the simple table constraint
4505
%% corresponding to the component relation constraint that depends on
4507
% get_used_fieldname(_S,CName,[{[CName|_Rest],_,ClFieldName}|_RestSimpleT]) ->
4509
% get_used_fieldname(S,CName,[_SimpleTC|Rest]) ->
4510
% get_used_fieldname(S,CName,Rest);
4511
% get_used_fieldname(S,_,[]) ->
4512
% error({type,"Error in Simple table constraint",S}).
4514
%% any_simple_table/3 checks if any of the components on this level is
4515
%% constrained by a simple table constraint. It returns a list of
4516
%% tuples with three elements. It is a name path to the place in the
4517
%% type structure where the constraint is, and the name of the object
4518
%% set and the referenced field in the class.
4519
% any_simple_table(S = #state{mname=M,abscomppath=Path},
4520
% [#'ComponentType'{name=Name,typespec=Type}|Cs],Acc) ->
4521
% Constraint = Type#type.constraint,
4522
% case lists:keysearch(simpletable,1,Constraint) of
4523
% {value,{_,#type{def=Ref}}} ->
4524
% %% This ObjectClassFieldType, which has a simple table
4525
% %% constraint, must pick a fixed type value, mustn't it ?
4526
% {ClassDef,[{_,ClassFieldName}]} = Type#type.def,
4529
% #'Externaltypereference'{module=M,type=ObjSetName} ->
4530
% {[Name|Path],ObjSetName,ClassFieldName};
4532
% {[Name|Path],Ref,ClassFieldName}
4534
% any_simple_table(S,Cs,[ST|Acc]);
4536
% any_simple_table(S,Cs,Acc)
4538
% any_simple_table(_,[],Acc) ->
4539
% lists:reverse(Acc);
4540
% any_simple_table(S,[_|Cs],Acc) ->
4541
% any_simple_table(S,Cs,Acc).
4543
%% get_simple_table_if_used/2 searches the structure of Cs for any
4544
%% component relation constraints due to the present level of the
4545
%% structure. If there are any, the necessary information for code
4546
%% generation of the look up functionality in the object set table are
4548
get_simple_table_if_used(S,Cs) ->
4549
CNames = lists:map(fun(#'ComponentType'{name=Name}) -> Name;
4550
(_) -> [] %% in case of extension marks
4553
RefedSimpleTable=any_component_relation(S,Cs,CNames,[],[]),
4554
get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)).
4556
remove_doubles(L) ->
4557
remove_doubles(L,[]).
4558
remove_doubles([H|T],Acc) ->
4559
NewT = remove_doubles1(H,T),
4560
remove_doubles(NewT,[H|Acc]);
4561
remove_doubles([],Acc) ->
4564
remove_doubles1(El,L) ->
4565
case lists:delete(El,L) of
4567
NewL -> remove_doubles1(El,NewL)
4570
%% get_simple_table_info searches the commponents Cs by the path from
4571
%% an at-list (third argument), and follows into a component of it if
4572
%% necessary, to get information needed for code generating.
4574
%% Returns a list of tuples with three elements. It holds a list of
4575
%% atoms that is the path, the name of the field of the class that are
4576
%% referred to in the ObjectClassFieldType, and the name of the unique
4577
%% field of the class of the ObjectClassFieldType.
4579
% %% The level information outermost/innermost must be kept. There are
4580
% %% at least two possibilities to cover here for an outermost case: 1)
4581
% %% Both the simple table and the component relation have a common path
4582
% %% at least one step below the outermost level, i.e. the leading
4583
% %% information shall be on a sub level. 2) They don't have any common
4585
get_simple_table_info(S,Cs,[AtList|Rest]) ->
4586
%% [get_simple_table_info1(S,Cs,AtList,S#state.abscomppath)|get_simple_table_info(S,Cs,Rest)];
4587
[get_simple_table_info1(S,Cs,AtList,[])|get_simple_table_info(S,Cs,Rest)];
4588
get_simple_table_info(_,_,[]) ->
4590
get_simple_table_info1(S,Cs,[Cname|Cnames],Path) when list(Cs) ->
4591
case lists:keysearch(Cname,#'ComponentType'.name,Cs) of
4593
get_simple_table_info1(S,C,Cnames,[Cname|Path]);
4595
error({type,"Missing expected simple table constraint",S})
4597
get_simple_table_info1(S,#'ComponentType'{typespec=TS},[],Path) ->
4598
%% In this component there must be a simple table constraint
4599
%% o.w. the asn1 code is wrong.
4600
#type{def=OCFT,constraint=Cnstr} = TS,
4602
[{simpletable,_OSRef}]�->
4603
#'ObjectClassFieldType'{classname=ClRef,
4605
fieldname=FieldName} = OCFT,
4606
% #'ObjectClassFieldType'{ObjectClass,FieldType} = ObjectClassFieldType,
4607
ObjectClassFieldName =
4609
{LastFieldName,[]} -> LastFieldName;
4610
{_FirstFieldName,FieldNames} ->
4611
lists:last(FieldNames)
4613
%%ObjectClassFieldName is the last element in the dotted
4614
%%list of the ObjectClassFieldType. The last element may
4615
%%be of another class, that is referenced from the class
4616
%%of the ObjectClassFieldType
4620
{_,CDef}=get_referenced_type(S,ClRef),
4622
_ -> #classdef{typespec=ObjectClass}
4625
case (catch get_unique_fieldname(ClassDef)) of
4626
{error,'__undefined_'} -> no_unique;
4628
error({type,Msg,S});
4631
{lists:reverse(Path),ObjectClassFieldName,UniqueName};
4633
error({type,{asn1,"missing expected simple table constraint",
4636
get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) ->
4637
Components = get_atlist_components(TS#type.def),
4638
get_simple_table_info1(S,Components,Cnames,Path).
4640
%% any_component_relation searches for all component relation
4641
%% constraints that refers to the actual level and returns a list of
4642
%% the "name path" in the at-list to the component relation constraint
4643
%% that must refer to a simple table constraint. The list is empty if
4644
%% no component relation constraints were found.
4646
%% NamePath has the names of all components that are followed from the
4647
%% beginning of the search. CNames holds the names of all components
4648
%% of the start level, this info is used if an outermost at-notation
4649
%% is found to check the validity of the at-list.
4650
any_component_relation(S,[C|Cs],CNames,NamePath,Acc) ->
4651
CName = C#'ComponentType'.name,
4652
Type = C#'ComponentType'.typespec,
4654
case Type#type.constraint of
4655
[{componentrelation,_,AtNotation}] ->
4656
%% Found component relation constraint, now check
4657
%% whether this constraint is relevant for the level
4658
%% where the search started
4659
AtNot = extract_at_notation(AtNotation),
4660
%% evaluate_atpath returns the relative path to the
4661
%% simple table constraint from where the component
4662
%% relation is found.
4663
evaluate_atpath(S#state.abscomppath,NamePath,CNames,AtNot);
4668
case {Type#type.inlined,
4669
asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of
4670
{no,{constructed,bif}} ->
4672
case get_components(Type#type.def) of
4673
{IC1,_IC2} -> IC1 ++ IC1;
4676
%% here we are interested in components of an
4677
%% SEQUENCE/SET OF as well as SEQUENCE, SET and CHOICE
4678
any_component_relation(S,InnerCs,CNames,[CName|NamePath],[]);
4682
any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc);
4683
any_component_relation(_,[],_,_,Acc) ->
4686
%% evaluate_atpath/4 finds out whether the at notation refers to the
4687
%% search level. The list of referenced names in the AtNot list shall
4688
%% begin with a name that exists on the level it refers to. If the
4689
%% found AtPath is refering to the same sub-branch as the simple table
4690
%% has, then there shall not be any leading attribute info on this
4692
evaluate_atpath(_,[],Cnames,{innermost,AtPath=[Ref|_Refs]}) ->
4693
%% any innermost constraint found deeper in the structure is
4695
case lists:member(Ref,Cnames) of
4699
%% In this case must check that the AtPath doesn't step any step of
4700
%% the NamePath, in that case the constraint will be handled in an
4702
evaluate_atpath(TopPath,NamePath,Cnames,{outermost,AtPath=[_Ref|_Refs]}) ->
4707
case lists:prefix(TopPath,AtPath) of
4709
lists:subtract(AtPath,TopPath);
4713
case {NamePath,AtPathBelowTop} of
4714
{[H|_T1],[H|_T2]} -> []; % this must be handled in lower level
4715
{_,[]} -> [];% this must be handled in an above level
4717
case lists:member(H,Cnames) of
4718
true -> [AtPathBelowTop];
4719
_ -> error({type,{asn1,"failed to analyze at-path",AtPath}})
4722
evaluate_atpath(_,_,_,_) ->
4725
%% Type may be any of SEQUENCE, SET, CHOICE, SEQUENCE OF, SET OF but
4726
%% only the three first have valid components.
4727
get_atlist_components(Def) ->
4728
get_components(atlist,Def).
4730
get_components(Def) ->
4731
get_components(any,Def).
4733
get_components(_,#'SEQUENCE'{components=Cs}) ->
4735
get_components(_,#'SET'{components=Cs}) ->
4737
get_components(_,{'CHOICE',Cs}) ->
4739
get_components(any,{'SEQUENCE OF',#type{def=Def}}) ->
4740
get_components(any,Def);
4741
get_components(any,{'SET OF',#type{def=Def}}) ->
4742
get_components(any,Def);
4743
get_components(_,_) ->
4747
extract_at_notation([{Level,[#'Externalvaluereference'{value=Name}|Rest]}]) ->
4748
{Level,[Name|extract_at_notation1(Rest)]};
4749
extract_at_notation(At) ->
4750
exit({error,{asn1,{at_notation,At}}}).
4751
extract_at_notation1([#'Externalvaluereference'{value=Name}|Rest]) ->
4752
[Name|extract_at_notation1(Rest)];
4753
extract_at_notation1([]) ->
4756
%% componentrelation1/1 identifies all componentrelation constraints
4757
%% that exist in C or in the substructure of C. Info about the found
4758
%% constraints are returned in a list. It is ObjectSet, the reference
4759
%% to the object set, AttrPath, the name atoms extracted from the
4760
%% at-list in the component relation constraint, ClassDef, the
4761
%% objectclass record of the class of the ObjectClassFieldType, Path,
4762
%% that is the component name "path" from the searched level to this
4765
%% The function is called with one component of the type in turn and
4766
%% with the component name in Path at the first call. When called from
4767
%% within, the name of the inner component is added to Path.
4768
componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI},
4772
[{componentrelation,{_,_,ObjectSet},AtList}|_Rest] ->
4773
[{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList,
4774
%% Note: if Path is longer than one,i.e. it is within
4775
%% an inner type of the actual level, then the only
4776
%% relevant at-list is of "outermost" type.
4777
%% #'ObjectClassFieldType'{class=ClassDef} = Def,
4778
ClassDef = get_ObjectClassFieldType_classdef(S,Def),
4780
lists:map(fun(#'Externalvaluereference'{value=V})->V end,
4782
{[{ObjectSet,AtPath,ClassDef,Path}],Def};
4784
%% check the inner type of component
4785
innertype_comprel(S,Def,Path)
4789
nofunobj; %% ignored by caller
4790
{CRelI=[{ObjSet,_,_,_}],NewDef} -> %%
4791
TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]),
4792
{CRelI,C#type{tablecinf=[{objfun,ObjSet}|TCItmp],def=NewDef}};
4793
{CompRelInf,NewDef} -> %% more than one tuple in CompRelInf
4794
TCItmp = lists:subtract(TCI,[{objfun,anyset}]),
4795
{CompRelInf,C#type{tablecinf=[{objfun,anyset}|TCItmp],def=NewDef}}
4798
innertype_comprel(S,{'SEQUENCE OF',Type},Path) ->
4799
case innertype_comprel1(S,Type,Path) of
4802
{CompRelInf,NewType} ->
4803
{CompRelInf,{'SEQUENCE OF',NewType}}
4805
innertype_comprel(S,{'SET OF',Type},Path) ->
4806
case innertype_comprel1(S,Type,Path) of
4809
{CompRelInf,NewType} ->
4810
{CompRelInf,{'SET OF',NewType}}
4812
innertype_comprel(S,{'CHOICE',CTypeList},Path) ->
4813
case componentlist_comprel(S,CTypeList,[],Path,[]) of
4816
{CompRelInf,NewCs} ->
4817
{CompRelInf,{'CHOICE',NewCs}}
4819
innertype_comprel(S,Seq = #'SEQUENCE'{components=Cs},Path) ->
4820
case componentlist_comprel(S,Cs,[],Path,[]) of
4823
{CompRelInf,NewCs} ->
4824
{CompRelInf,Seq#'SEQUENCE'{components=NewCs}}
4826
innertype_comprel(S,Set = #'SET'{components=Cs},Path) ->
4827
case componentlist_comprel(S,Cs,[],Path,[]) of
4830
{CompRelInf,NewCs} ->
4831
{CompRelInf,Set#'SET'{components=NewCs}}
4833
innertype_comprel(_,_,_) ->
4836
componentlist_comprel(S,[C = #'ComponentType'{name=Name,typespec=Type}|Cs],
4838
case catch componentrelation1(S,Type,Path++[Name]) of
4840
componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]);
4842
componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]);
4843
{CRelInf,NewType} ->
4844
componentlist_comprel(S,Cs,CRelInf++Acc,Path,
4845
[C#'ComponentType'{typespec=NewType}|NewCL])
4847
componentlist_comprel(_,[],Acc,_,NewCL) ->
4852
{Acc,lists:reverse(NewCL)}
4855
innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) ->
4858
[{componentrelation,{_,_,ObjectSet},AtList}|_Rest] ->
4859
%% This AtList must have an "outermost" at sign to be
4861
[{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2]
4863
%% #'ObjectClassFieldType'{class=ClassDef} = Def,
4864
ClassDef = get_ObjectClassFieldType_classdef(S,Def),
4866
lists:map(fun(#'Externalvaluereference'{value=V})->V end,
4868
[{ObjectSet,AtPath,ClassDef,Path}];
4870
innertype_comprel(S,Def,Path)
4873
nofunobj -> nofunobj;
4874
L = [{ObjSet,_,_,_}] ->
4875
TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]),
4876
{L,T#type{tablecinf=[{objfun,ObjSet}|TCItmp]}};
4878
TCItmp = lists:subtract(TCI,[{objfun,anyset}]),
4879
{CRelInf,T#type{def=NewDef,tablecinf=[{objfun,anyset}|TCItmp]}}
4883
%% leading_attr_index counts the index and picks the name of the
4884
%% component that is at the actual level in the at-list of the
4885
%% component relation constraint (AttrP). AbsP is the path of
4886
%% component names from the top type level to the actual level. AttrP
4887
%% is a list with the atoms from the at-list.
4888
leading_attr_index(S,Cs,[H={_,AttrP,_,_}|T],AbsP,Acc) ->
4890
case lists:prefix(AbsP,AttrP) of
4891
%% why this ?? It is necessary when in same situation as
4892
%% TConstrChoice, there is an inner structure with an
4893
%% outermost at-list and the "leading attribute" code gen
4894
%% may be at a level some steps below the outermost level.
4896
RelativAttrP = lists:subtract(AttrP,AbsP),
4897
%% The header is used to calculate the index of the
4898
%% component and to give the fun, received from the
4899
%% object set look up, an unique name. The tail is
4900
%% used to match the proper value input to the fun.
4901
{hd(RelativAttrP),tl(RelativAttrP)};
4903
{hd(AttrP),tl(AttrP)}
4905
case leading_attr_index1(S,Cs,H,AttrInfo,1) of
4907
leading_attr_index(S,Cs,T,AbsP,Acc);
4909
leading_attr_index(S,Cs,T,AbsP,[Res|Acc])
4911
leading_attr_index(_,_Cs,[],_,Acc) ->
4914
leading_attr_index1(_,[],_,_,_) ->
4916
leading_attr_index1(S,[C|Cs],Arg={ObjectSet,_,CDef,P},
4917
AttrInfo={Attr,SubAttr},N) ->
4918
case C#'ComponentType'.name of
4920
ValueMatch = value_match(S,C,Attr,SubAttr),
4921
{ObjectSet,Attr,N,CDef,P,ValueMatch};
4923
leading_attr_index1(S,Cs,Arg,AttrInfo,N+1)
4926
%% value_math gathers information for a proper value match in the
4927
%% generated encode function. For a SEQUENCE or a SET the index of the
4928
%% component is counted. For a CHOICE the index is 2.
4929
value_match(S,C,Name,SubAttr) ->
4930
value_match(S,C,Name,SubAttr,[]). % C has name Name
4931
value_match(_S,#'ComponentType'{},_Name,[],Acc) ->
4932
Acc;% do not reverse, indexes in reverse order
4933
value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) ->
4934
InnerType = asn1ct_gen:get_inner(Type#type.def),
4936
case get_atlist_components(Type#type.def) of
4937
[] -> error({type,{asn1,"element in at list must be a "
4938
"SEQUENCE, SET or CHOICE.",Name},S});
4941
{Index,ValueIndex} = component_value_index(S,InnerType,At,Components),
4942
value_match(S,lists:nth(Index,Components),At,Ats,[ValueIndex|Acc]).
4944
component_value_index(S,'CHOICE',At,Components) ->
4945
{component_index(S,At,Components),2};
4946
component_value_index(S,_,At,Components) ->
4948
Index = component_index(S,At,Components),
4949
{Index,{Index+1,At}}.
4951
component_index(S,Name,Components) ->
4952
component_index1(S,Name,Components,1).
4953
component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) ->
4955
component_index1(S,Name,[_C|Cs],N) ->
4956
component_index1(S,Name,Cs,N+1);
4957
component_index1(S,Name,[],_) ->
4958
error({type,{asn1,"component of at-list was not"
4959
" found in substructure",Name},S}).
4961
get_unique_fieldname(ClassDef) ->
4962
%% {_,Fields,_} = ClassDef#classdef.typespec,
4963
Fields = (ClassDef#classdef.typespec)#objectclass.fields,
4964
get_unique_fieldname(Fields,[]).
4966
get_unique_fieldname([],[]) ->
4967
throw({error,'__undefined_'});
4968
get_unique_fieldname([],[Name]) ->
4970
get_unique_fieldname([],Acc) ->
4971
throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc});
4972
get_unique_fieldname([{fixedtypevaluefield,Name,_,'UNIQUE',_}|Rest],Acc) ->
4973
get_unique_fieldname(Rest,[Name|Acc]);
4974
get_unique_fieldname([_H|T],Acc) ->
4975
get_unique_fieldname(T,Acc).
4977
get_tableconstraint_info(S,Type,{CheckedTs,EComps}) ->
4978
{get_tableconstraint_info(S,Type,CheckedTs,[]),
4979
get_tableconstraint_info(S,Type,EComps,[])};
4980
get_tableconstraint_info(S,Type,CheckedTs) ->
4981
get_tableconstraint_info(S,Type,CheckedTs,[]).
4983
get_tableconstraint_info(_S,_Type,[],Acc) ->
4985
get_tableconstraint_info(S,Type,[C|Cs],Acc) ->
4986
CheckedTs = C#'ComponentType'.typespec,
4988
case CheckedTs#type.def of
4989
%% ObjectClassFieldType
4990
OCFT=#'ObjectClassFieldType'{class=#objectclass{},
4992
% AType = get_ObjectClassFieldType(S,Fields,FieldRef),
4994
% get_referencedclassfield(CheckedTs#type.def),%is probably obsolete
4996
OCFT#'ObjectClassFieldType'{class=[]},
4997
C#'ComponentType'{typespec=
5002
% constraint=[{tableconstraint_info,
5004
{'SEQUENCE OF',SOType} when record(SOType,type),
5005
(element(1,SOType#type.def)=='CHOICE') ->
5006
CTypeList = element(2,SOType#type.def),
5008
get_tableconstraint_info(S,Type,CTypeList,[]),
5009
C#'ComponentType'{typespec=
5012
SOType#type{def={'CHOICE',
5014
{'SET OF',SOType} when record(SOType,type),
5015
(element(1,SOType#type.def)=='CHOICE') ->
5016
CTypeList = element(2,SOType#type.def),
5018
get_tableconstraint_info(S,Type,CTypeList,[]),
5019
C#'ComponentType'{typespec=
5022
SOType#type{def={'CHOICE',
5027
get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]).
5029
get_referenced_fieldname([{_,FirstFieldname}]) ->
5030
{FirstFieldname,[]};
5031
get_referenced_fieldname([{_,FirstFieldname}|Rest]) ->
5032
{FirstFieldname,lists:map(fun(X)->element(2,X) end,Rest)};
5033
get_referenced_fieldname(Def) ->
5036
%% get_ObjectClassFieldType extracts the type from the chain of
5037
%% objects that leads to a final type.
5038
get_ObjectClassFieldType(S,ERef,PrimFieldNameList) when
5039
record(ERef,'Externaltypereference') ->
5040
{_,Type} = get_referenced_type(S,ERef),
5041
ClassSpec = check_class(S,Type),
5042
Fields = ClassSpec#objectclass.fields,
5043
get_ObjectClassFieldType(S,Fields,PrimFieldNameList);
5044
get_ObjectClassFieldType(S,Fields,L=[_PrimFieldName1|_Rest]) ->
5045
check_PrimitiveFieldNames(S,Fields,L),
5046
get_OCFType(S,Fields,L).
5048
check_PrimitiveFieldNames(_S,_Fields,_) ->
5051
%% get_ObjectClassFieldType_classdef gets the def of the class of the
5052
%% ObjectClassFieldType, i.e. the objectclass record. If the type has
5053
%% been checked (it may be a field type of an internal SEQUENCE) the
5054
%% class field = [], then the classdef has to be fetched by help of
5055
%% the class reference in the classname field.
5056
get_ObjectClassFieldType_classdef(S,#'ObjectClassFieldType'{classname=Name,
5058
{_,#classdef{typespec=TS}} = get_referenced_type(S,Name),
5060
get_ObjectClassFieldType_classdef(_,#'ObjectClassFieldType'{class=Cl}) ->
5063
get_OCFType(S,Fields,[{_FieldType,PrimFieldName}|Rest]) ->
5064
case lists:keysearch(PrimFieldName,2,Fields) of
5065
{value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} ->
5066
{fixedtypevaluefield,PrimFieldName,Type};
5067
{value,{objectfield,_,Type,_Unique,_OptSpec}} ->
5068
{_,ClassDef} = get_referenced_type(S,Type#type.def),
5069
CheckedCDef = check_class(S#state{type=ClassDef,
5070
tname=ClassDef#classdef.name},
5071
ClassDef#classdef.typespec),
5072
get_OCFType(S,CheckedCDef#objectclass.fields,Rest);
5073
{value,{objectsetfield,_,Type,_OptSpec}} ->
5074
{_,ClassDef} = get_referenced_type(S,Type#type.def),
5075
CheckedCDef = check_class(S#state{type=ClassDef,
5076
tname=ClassDef#classdef.name},
5077
ClassDef#classdef.typespec),
5078
get_OCFType(S,CheckedCDef#objectclass.fields,Rest);
5081
{element(1,Other),PrimFieldName};
5083
error({type,"undefined FieldName in ObjectClassFieldType",S})
5086
get_taglist(#state{erule=per},_) ->
5088
get_taglist(#state{erule=per_bin},_) ->
5090
get_taglist(S,Ext) when record(Ext,'Externaltypereference') ->
5091
{_,T} = get_referenced_type(S,Ext),
5092
get_taglist(S,T#typedef.typespec);
5093
get_taglist(S,Tref) when record(Tref,typereference) ->
5094
{_,T} = get_referenced_type(S,Tref),
5095
get_taglist(S,T#typedef.typespec);
5096
get_taglist(S,Type) when record(Type,type) ->
5097
case Type#type.tag of
5099
get_taglist(S,Type#type.def);
5101
% case lists:member(S#state.erule,[ber,ber_bin]) of
5103
% lists:map(fun(Tx) -> asn1ct_gen:def_to_tag(Tx) end,Type#type.tag);
5105
[asn1ct_gen:def_to_tag(Tag)]
5108
get_taglist(S,{'CHOICE',{Rc,Ec}}) ->
5109
get_taglist(S,{'CHOICE',Rc ++ Ec});
5110
get_taglist(S,{'CHOICE',Components}) ->
5111
get_taglist1(S,Components);
5112
%% ObjectClassFieldType OTP-4390
5113
get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) ->
5115
get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) ->
5116
get_taglist(S,Type);
5117
get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList})
5118
when list(FieldNameList) ->
5119
case get_ObjectClassFieldType(S,ERef,FieldNameList) of
5120
Type when record(Type,type) ->
5121
get_taglist(S,Type);
5122
{fixedtypevaluefield,_,Type} -> get_taglist(S,Type);
5123
{TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed
5125
get_taglist(S,{ObjCl,FieldNameList}) when record(ObjCl,objectclass),
5126
list(FieldNameList) ->
5127
case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of
5128
Type when record(Type,type) ->
5129
get_taglist(S,Type);
5130
{fixedtypevaluefield,_,Type} -> get_taglist(S,Type);
5131
{TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed
5133
get_taglist(S,Def) ->
5134
case lists:member(S#state.erule,[ber_bin_v2]) of
5137
'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such
5140
[asn1ct_gen:def_to_tag(Def)]
5146
get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when list(TagL) ->
5147
%% tag_list has been here , just return TagL and continue with next alternative
5148
TagL ++ get_taglist1(S,Rest);
5149
get_taglist1(S,[#'ComponentType'{typespec=Ts,tags=undefined}|Rest]) ->
5150
get_taglist(S,Ts) ++ get_taglist1(S,Rest);
5151
get_taglist1(S,[_H|Rest]) -> % skip EXTENSIONMARK
5152
get_taglist1(S,Rest);
5153
get_taglist1(_S,[]) ->
5156
dbget_ex(_S,Module,Key) ->
5157
case asn1_db:dbget(Module,Key) of
5160
throw({error,{asn1,{undefined,{Module,Key}}}}); % this is catched on toplevel type or value
5164
merge_tags(T1, T2) when list(T2) ->
5165
merge_tags2(T1 ++ T2, []);
5166
merge_tags(T1, T2) ->
5167
merge_tags2(T1 ++ [T2], []).
5169
merge_tags2([T1= #tag{type='IMPLICIT'}, T2 |Rest], Acc) ->
5170
merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc);
5171
merge_tags2([T1= #tag{type={default,'IMPLICIT'}}, T2 |Rest], Acc) ->
5172
merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc);
5173
merge_tags2([H|T],Acc) ->
5174
merge_tags2(T, [H|Acc]);
5175
merge_tags2([], Acc) ->
5178
merge_constraints(C1, []) ->
5180
merge_constraints([], C2) ->
5182
merge_constraints(C1, C2) ->
5183
{SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]),
5184
SizeC = merge_constraints(SList),
5185
ValueC = merge_constraints(VList),
5186
PermAlphaC = merge_constraints(PAList),
5189
SizeC ++ ValueC ++ PermAlphaC;
5191
throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}})
5194
merge_constraints([]) -> [];
5195
merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2,
5197
merge_constraints([C1|Rest]);
5198
merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) ->
5199
[C1|merge_constraints([C2|Rest])];
5200
merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) ->
5201
throw({error,asn1,{conflicting_constraints,{C1,C2}}});
5202
merge_constraints([C]) ->
5205
splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
5206
splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc);
5207
splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
5208
splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc);
5209
splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
5210
splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc);
5211
splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) ->
5212
splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]);
5213
splitlist([],Sacc,Vacc,PAacc,Restacc) ->
5214
{lists:reverse(Sacc),
5215
lists:reverse(Vacc),
5216
lists:reverse(PAacc),
5217
lists:reverse(Restacc)}.
5221
storeindb(M) when record(M,module) ->
5222
TVlist = M#module.typeorval,
5223
NewM = M#module{typeorval=findtypes_and_values(TVlist)},
5224
asn1_db:dbnew(NewM#module.name),
5225
asn1_db:dbput(NewM#module.name,'MODULE', NewM),
5226
Res = storeindb(NewM#module.name,TVlist,[]),
5227
include_default_class(NewM#module.name),
5228
include_default_type(NewM#module.name),
5231
storeindb(Module,[H|T],ErrAcc) when record(H,typedef) ->
5232
storeindb(Module,H#typedef.name,H,T,ErrAcc);
5233
storeindb(Module,[H|T],ErrAcc) when record(H,valuedef) ->
5234
storeindb(Module,H#valuedef.name,H,T,ErrAcc);
5235
storeindb(Module,[H|T],ErrAcc) when record(H,ptypedef) ->
5236
storeindb(Module,H#ptypedef.name,H,T,ErrAcc);
5237
storeindb(Module,[H|T],ErrAcc) when record(H,classdef) ->
5238
storeindb(Module,H#classdef.name,H,T,ErrAcc);
5239
storeindb(Module,[H|T],ErrAcc) when record(H,pvaluesetdef) ->
5240
storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc);
5241
storeindb(Module,[H|T],ErrAcc) when record(H,pobjectdef) ->
5242
storeindb(Module,H#pobjectdef.name,H,T,ErrAcc);
5243
storeindb(Module,[H|T],ErrAcc) when record(H,pvaluedef) ->
5244
storeindb(Module,H#pvaluedef.name,H,T,ErrAcc);
5245
storeindb(_,[],[]) -> ok;
5246
storeindb(_,[],ErrAcc) ->
5249
storeindb(Module,Name,H,T,ErrAcc) ->
5250
case asn1_db:dbget(Module,Name) of
5252
asn1_db:dbput(Module,Name,H),
5253
storeindb(Module,T,ErrAcc);
5256
_Type when record(H,typedef) ->
5257
error({type,"already defined",
5258
#state{mname=Module,type=H,tname=Name}});
5259
_Type when record(H,valuedef) ->
5260
error({value,"already defined",
5261
#state{mname=Module,value=H,vname=Name}});
5262
_Type when record(H,ptypedef) ->
5263
error({ptype,"already defined",
5264
#state{mname=Module,type=H,tname=Name}});
5265
_Type when record(H,pobjectdef) ->
5266
error({ptype,"already defined",
5267
#state{mname=Module,type=H,tname=Name}});
5268
_Type when record(H,pvaluesetdef) ->
5269
error({ptype,"already defined",
5270
#state{mname=Module,type=H,tname=Name}});
5271
_Type when record(H,pvaluedef) ->
5272
error({ptype,"already defined",
5273
#state{mname=Module,type=H,tname=Name}});
5274
_Type when record(H,classdef) ->
5275
error({class,"already defined",
5276
#state{mname=Module,value=H,vname=Name}})
5278
storeindb(Module,T,[H|ErrAcc])
5281
findtypes_and_values(TVList) ->
5282
findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values,
5283
%% Parameterizedtypes,Classes,Objects and ObjectSets
5285
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5286
when record(H,typedef),record(H#typedef.typespec,'Object') ->
5287
findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#typedef.name|Oacc],OSacc);
5288
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5289
when record(H,typedef),record(H#typedef.typespec,'ObjectSet') ->
5290
findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#typedef.name|OSacc]);
5291
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5292
when record(H,typedef) ->
5293
findtypes_and_values(T,[H#typedef.name|Tacc],Vacc,Pacc,Cacc,Oacc,OSacc);
5294
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5295
when record(H,valuedef) ->
5296
findtypes_and_values(T,Tacc,[H#valuedef.name|Vacc],Pacc,Cacc,Oacc,OSacc);
5297
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5298
when record(H,ptypedef) ->
5299
findtypes_and_values(T,Tacc,Vacc,[H#ptypedef.name|Pacc],Cacc,Oacc,OSacc);
5300
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5301
when record(H,classdef) ->
5302
findtypes_and_values(T,Tacc,Vacc,Pacc,[H#classdef.name|Cacc],Oacc,OSacc);
5303
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5304
when record(H,pvaluedef) ->
5305
findtypes_and_values(T,Tacc,[H#pvaluedef.name|Vacc],Pacc,Cacc,Oacc,OSacc);
5306
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5307
when record(H,pvaluesetdef) ->
5308
findtypes_and_values(T,Tacc,[H#pvaluesetdef.name|Vacc],Pacc,Cacc,Oacc,OSacc);
5309
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5310
when record(H,pobjectdef) ->
5311
findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#pobjectdef.name|Oacc],OSacc);
5312
findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5313
when record(H,pobjectsetdef) ->
5314
findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#pobjectsetdef.name|OSacc]);
5315
findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) ->
5316
{lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc),
5317
lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}.
5321
error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) ->
5322
Pos = Ref#'Externaltypereference'.pos,
5323
io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]),
5324
{error,{export,Pos,Mname,Typename,Msg}};
5325
error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
5326
when record(Type,typedef) ->
5327
io:format("asn1error:~p:~p:~p ~p~n",
5328
[Type#typedef.pos,Mname,Typename,Msg]),
5329
{error,{type,Type#typedef.pos,Mname,Typename,Msg}};
5330
error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
5331
when record(Type,ptypedef) ->
5332
io:format("asn1error:~p:~p:~p ~p~n",
5333
[Type#ptypedef.pos,Mname,Typename,Msg]),
5334
{error,{type,Type#ptypedef.pos,Mname,Typename,Msg}};
5335
error({type,Msg,#state{mname=Mname,value=Value,vname=Valuename}})
5336
when record(Value,valuedef) ->
5337
io:format("asn1error:~p:~p:~p ~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]),
5338
{error,{type,Value#valuedef.pos,Mname,Valuename,Msg}};
5339
error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
5340
when record(Type,pobjectdef) ->
5341
io:format("asn1error:~p:~p:~p ~p~n",
5342
[Type#pobjectdef.pos,Mname,Typename,Msg]),
5343
{error,{type,Type#pobjectdef.pos,Mname,Typename,Msg}};
5344
error({value,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) ->
5345
io:format("asn1error:~p:~p:~p ~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]),
5346
{error,{value,Value#valuedef.pos,Mname,Valuename,Msg}};
5347
error({Other,Msg,#state{mname=Mname,value=#valuedef{pos=Pos},vname=Valuename}}) ->
5348
io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Valuename,Msg]),
5349
{error,{Other,Pos,Mname,Valuename,Msg}};
5350
error({Other,Msg,#state{mname=Mname,type=#typedef{pos=Pos},tname=Typename}}) ->
5351
io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]),
5352
{error,{Other,Pos,Mname,Typename,Msg}};
5353
error({Other,Msg,#state{mname=Mname,type=#classdef{pos=Pos},tname=Typename}}) ->
5354
io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]),
5355
{error,{Other,Pos,Mname,Typename,Msg}}.
5357
include_default_type(Module) ->
5358
NameAbsList = default_type_list(),
5359
include_default_type1(Module,NameAbsList).
5361
include_default_type1(_,[]) ->
5363
include_default_type1(Module,[{Name,TS}|Rest]) ->
5364
case asn1_db:dbget(Module,Name) of
5366
T = #typedef{name=Name,
5368
asn1_db:dbput(Module,Name,T);
5371
include_default_type1(Module,Rest).
5373
default_type_list() ->
5374
%% The EXTERNAL type is represented, according to ASN.1 1997,
5375
%% as a SEQUENCE with components: identification, data-value-descriptor
5378
#'ComponentType'{name=syntax,
5379
typespec=#type{def='OBJECT IDENTIFIER'},
5382
#'ComponentType'{name='presentation-context-id',
5383
typespec=#type{def='INTEGER'},
5386
#'ComponentType'{name='transfer-syntax',
5387
typespec=#type{def='OBJECT IDENTIFIER'},
5391
#'SEQUENCE'{components=
5393
Transfer_syntax#'ComponentType'{prop=mandatory}]}},
5395
#'ComponentType'{name='context-negotiation',
5396
typespec=Negotiation_items,
5399
Data_value_descriptor =
5400
#'ComponentType'{name='data-value-descriptor',
5401
typespec=#type{def='ObjectDescriptor'},
5404
#'ComponentType'{name='data-value',
5405
typespec=#type{def='OCTET STRING'},
5408
%% The EXTERNAL type is represented, according to ASN.1 1990,
5409
%% as a SEQUENCE with components: direct-reference, indirect-reference,
5410
%% data-value-descriptor and encoding.
5413
#'ComponentType'{name='direct-reference',
5414
typespec=#type{def='OBJECT IDENTIFIER'},
5417
Indirect_reference =
5418
#'ComponentType'{name='indirect-reference',
5419
typespec=#type{def='INTEGER'},
5423
#'ComponentType'{name='single-ASN1-type',
5424
typespec=#type{tag=[{tag,'CONTEXT',0,
5430
#'ComponentType'{name='octet-aligned',
5431
typespec=#type{tag=[{tag,'CONTEXT',1,
5433
def='OCTET STRING'},
5437
#'ComponentType'{name=arbitrary,
5438
typespec=#type{tag=[{tag,'CONTEXT',2,
5440
def={'BIT STRING',[]}},
5444
#'ComponentType'{name=encoding,
5445
typespec=#type{def={'CHOICE',
5446
[Single_ASN1_type,Octet_aligned,
5450
EXTERNAL_components1990 =
5451
[Direct_reference,Indirect_reference,Data_value_descriptor,Encoding],
5453
%% The EMBEDDED PDV type is represented by a SEQUENCE type
5454
%% with components: identification and data-value
5456
#'ComponentType'{name=abstract,
5457
typespec=#type{def='OBJECT IDENTIFIER'},
5460
#'ComponentType'{name=transfer,
5461
typespec=#type{def='OBJECT IDENTIFIER'},
5464
#'SEQUENCE'{components=[Abstract,Transfer]},
5466
#'ComponentType'{name=syntaxes,
5467
typespec=#type{def=AbstractTrSeq},
5469
Fixed = #'ComponentType'{name=fixed,
5470
typespec=#type{def='NULL'},
5473
[Syntaxes,Syntax,Presentation_Cid,Context_negot,
5474
Transfer_syntax,Fixed],
5476
#'ComponentType'{name=identification,
5477
typespec=#type{def={'CHOICE',Negotiations}},
5479
EmbeddedPdv_components =
5480
[Identification2,Data_value],
5482
%% The CHARACTER STRING type is represented by a SEQUENCE type
5483
%% with components: identification and string-value
5485
#'ComponentType'{name='string-value',
5486
typespec=#type{def='OCTET STRING'},
5488
CharacterString_components =
5489
[Identification2,String_value],
5492
#type{tag=[#tag{class='UNIVERSAL',
5496
def=#'SEQUENCE'{components=
5497
EXTERNAL_components1990}}},
5499
#type{tag=[#tag{class='UNIVERSAL',
5503
def=#'SEQUENCE'{components=EmbeddedPdv_components}}},
5504
{'CHARACTER STRING',
5505
#type{tag=[#tag{class='UNIVERSAL',
5509
def=#'SEQUENCE'{components=CharacterString_components}}}
5513
include_default_class(Module) ->
5514
NameAbsList = default_class_list(),
5515
include_default_class1(Module,NameAbsList).
5517
include_default_class1(_,[]) ->
5519
include_default_class1(Module,[{Name,TS}|_Rest]) ->
5520
case asn1_db:dbget(Module,Name) of
5522
C = #classdef{checked=true,name=Name,
5524
asn1_db:dbput(Module,Name,C);
5528
default_class_list() ->
5529
[{'TYPE-IDENTIFIER',
5531
[{fixedtypevaluefield,
5533
{type,[],'OBJECT IDENTIFIER',[]},
5536
{typefield,'Type','MANDATORY'}],
5538
[{typefieldreference,'Type'},
5541
{valuefieldreference,id}]}}},
5544
[{fixedtypevaluefield,
5546
{type,[],'OBJECT IDENTIFIER',[]},
5549
{typefield,'Type','MANDATORY'},
5550
{fixedtypevaluefield,
5560
[{typefieldreference,'Type'},
5563
{valuefieldreference,id},
5566
{valuefieldreference,property}]]}}}].
added
removed
lib/dialyzer/test/r9c_SUITE_data/src/asn1/asn1ct_check.erl
