1%% vim: tabstop=8:shiftwidth=4 2%% 3%% %CopyrightBegin% 4%% 5%% Copyright Ericsson AB 1997-2020. All Rights Reserved. 6%% 7%% Licensed under the Apache License, Version 2.0 (the "License"); 8%% you may not use this file except in compliance with the License. 9%% You may obtain a copy of the License at 10%% 11%% http://www.apache.org/licenses/LICENSE-2.0 12%% 13%% Unless required by applicable law or agreed to in writing, software 14%% distributed under the License is distributed on an "AS IS" BASIS, 15%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 16%% See the License for the specific language governing permissions and 17%% limitations under the License. 18%% 19%% %CopyrightEnd% 20%% 21%% 22-module(asn1ct_check). 23 24%% Main Module for ASN.1 compile time functions 25 26-export([check/2,storeindb/2,format_error/1]). 27-include("asn1_records.hrl"). 28 29%%% The tag-number for universal types 30-define(N_BOOLEAN, 1). 31-define(N_INTEGER, 2). 32-define(N_BIT_STRING, 3). 33-define(N_OCTET_STRING, 4). 34-define(N_NULL, 5). 35-define(N_OBJECT_IDENTIFIER, 6). 36-define(N_OBJECT_DESCRIPTOR, 7). 37-define(N_EXTERNAL, 8). % constructed 38-define(N_INSTANCE_OF,8). 39-define(N_REAL, 9). 40-define(N_ENUMERATED, 10). 41-define(N_EMBEDDED_PDV, 11). % constructed 42-define(N_UTF8String, 12). 43-define('N_RELATIVE-OID',13). 44-define(N_SEQUENCE, 16). 45-define(N_SET, 17). 46-define(N_NumericString, 18). 47-define(N_PrintableString, 19). 48-define(N_TeletexString, 20). 49-define(N_VideotexString, 21). 50-define(N_IA5String, 22). 51-define(N_UTCTime, 23). 52-define(N_GeneralizedTime, 24). 53-define(N_GraphicString, 25). 54-define(N_VisibleString, 26). 55-define(N_GeneralString, 27). 56-define(N_UniversalString, 28). 57-define(N_CHARACTER_STRING, 29). % constructed 58-define(N_BMPString, 30). 59 60-define(TAG_PRIMITIVE(Num), 61 #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}). 62-define(TAG_CONSTRUCTED(Num), 63 #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}). 64 65%% used in check_type to update type and tag 66-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). 67 68check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> 69 %%Predicates used to filter errors 70 TupleIs = fun({T,_},T) -> true; 71 (_,_) -> false 72 end, 73 IsClass = fun(X) -> TupleIs(X,asn1_class) end, 74 IsObjSet = fun(X) -> TupleIs(X,objectsetdef) end, 75 IsPObjSet = fun(X) -> TupleIs(X,pobjectsetdef) end, 76 IsObject = fun(X) -> TupleIs(X,objectdef) end, 77 IsValueSet = fun(X) -> TupleIs(X,valueset) end, 78 Element2 = fun(X) -> element(2,X) end, 79 Element1 = fun(X) -> element(1,X) end, 80 81 %% initialize internal book keeping 82 save_asn1db_uptodate(S,S#state.erule,S#state.mname), 83 put(top_module,S#state.mname), 84 85 ParamError = checkp(S, ParameterizedTypes), %must do this before the templates are used 86 87 %% table to save instances of parameterized objects,object sets 88 asn1ct_table:new(parameterized_objects), 89 asn1ct_table:new(inlined_objects), 90 91 92 Terror = checkt(S, Types), 93 ?dbg("checkt finished with errors:~n~p~n~n",[Terror]), 94 95 %% get parameterized object sets sent to checkt/3 96 %% and update Terror 97 98 {PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror), 99 100 Verror = checkv(S, Values ++ ObjectSets), %value sets may be parsed as object sets 101 ?dbg("checkv finished with errors:~n~p~n~n",[Verror]), 102 %% get information object classes wrongly sent to checkt/3 103 %% and update Terror2 104 105 {AddClasses,Terror3} = filter_errors(IsClass,Terror2), 106 107 NewClasses = Classes++AddClasses, 108 109 Cerror = checkc(S, NewClasses), 110 ?dbg("checkc finished with errors:~n~p~n~n",[Cerror]), 111 %% get object sets incorrectly sent to checkv/3 112 %% and update Verror 113 114 {ObjSetNames,Verror2} = filter_errors(IsObjSet,Verror), 115 116 %% get parameterized object sets incorrectly sent to checkv/3 117 %% and update Verror2 118 119 {PObjSetNames,Verror3} = filter_errors(IsPObjSet,Verror2), 120 121 %% get objects incorrectly sent to checkv/3 122 %% and update Verror3 123 124 {ObjectNames,Verror4} = filter_errors(IsObject,Verror3), 125 126 NewObjects = Objects++ObjectNames, 127 NewObjectSets = ObjSetNames ++ PObjSetNames ++ PObjSetNames1, 128 129 %% get value sets 130 %% and update Verror4 131 132 {ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4), 133 134 {Oerror,ExclO,ExclOS} = checko(S,NewObjects ++ 135 NewObjectSets, 136 [],[],[]), 137 ?dbg("checko finished with errors:~n~p~n~n",[Oerror]), 138 InlinedObjTuples = asn1ct_table:to_list(inlined_objects), 139 InlinedObjects = lists:map(Element2,InlinedObjTuples), 140 asn1ct_table:delete(inlined_objects), 141 ParameterizedElems = asn1ct_table:to_list(parameterized_objects), 142 ParObjectSets = lists:filter(fun({_OSName,objectset,_}) -> true; 143 (_)-> false end,ParameterizedElems), 144 ParObjectSetNames = lists:map(Element1,ParObjectSets), 145 ParTypes = lists:filter(fun({_TypeName,type,_}) -> true; 146 (_) -> false end, ParameterizedElems), 147 ParTypesNames = lists:map(Element1,ParTypes), 148 asn1ct_table:delete(parameterized_objects), 149 put(asn1_reference,undefined), 150 151 Exporterror = check_exports(S,S#state.module), 152 ImportError = check_imports(S,S#state.module), 153 154 AllErrors = lists:flatten([ParamError,Terror3,Verror5,Cerror, 155 Oerror,Exporterror,ImportError]), 156 case AllErrors of 157 [] -> 158 ContextSwitchTs = context_switch_in_spec(), 159 InstanceOf = instance_of_in_spec(S#state.mname), 160 NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs 161 ++ InstanceOf ++ ParTypesNames, 162 NewValues = lists:subtract(Values,PObjSetNames++ObjectNames++ 163 ValueSetNames), 164 {ok, 165 {NewTypes,NewValues,ParameterizedTypes, 166 NewClasses,NewObjects,NewObjectSets}, 167 {NewTypes,NewValues,ParameterizedTypes,NewClasses, 168 lists:subtract(NewObjects,ExclO)++InlinedObjects, 169 lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}}; 170 _ -> 171 {error,AllErrors} 172 end. 173 174context_switch_in_spec() -> 175 L = [{external,'EXTERNAL'}, 176 {embedded_pdv,'EMBEDDED PDV'}, 177 {character_string,'CHARACTER STRING'}], 178 F = fun({T,TName},Acc) -> 179 case get(T) of 180 generate -> erase(T), 181 [TName|Acc]; 182 _ -> Acc 183 end 184 end, 185 lists:foldl(F,[],L). 186 187instance_of_in_spec(ModName) -> 188 case get(instance_of) of 189 L when is_list(L) -> 190 case lists:member(ModName,L) of 191 true -> 192 erase(instance_of), 193 ['INSTANCE OF']; 194 _ -> 195 erase(instance_of), 196 [] 197 end; 198 _ -> 199 [] 200 end. 201instance_of_decl(ModName) -> 202 Mods = get_instance_of(), 203 case lists:member(ModName,Mods) of 204 true -> 205 ok; 206 _ -> 207 put(instance_of,[ModName|Mods]) 208 end. 209get_instance_of() -> 210 case get(instance_of) of 211 undefined -> 212 []; 213 L -> 214 L 215 end. 216 217put_once(T,State) -> 218 %% state is one of undefined, unchecked, generate 219 %% undefined > unchecked > generate 220 case get(T) of 221 PrevS when PrevS > State -> 222 put(T,State); 223 _ -> 224 ok 225 end. 226 227filter_errors(Pred,ErrorList) -> 228 Element2 = fun(X) -> element(2,X) end, 229 RemovedTupleElements = lists:filter(Pred,ErrorList), 230 RemovedNames = lists:map(Element2,RemovedTupleElements), 231 %% remove value set name tuples from Verror 232 RestErrors = lists:subtract(ErrorList,RemovedTupleElements), 233 {RemovedNames,RestErrors}. 234 235 236check_exports(S,Module = #module{}) -> 237 case Module#module.exports of 238 {exports,[]} -> 239 []; 240 {exports,all} -> 241 []; 242 {exports,ExportList} when is_list(ExportList) -> 243 IsNotDefined = 244 fun(X) -> 245 try 246 _ = get_referenced_type(S,X), 247 false 248 catch {error,_} -> 249 true 250 end 251 end, 252 [return_asn1_error(S, Ext, {undefined_export, Undef}) || 253 Ext = #'Externaltypereference'{type=Undef} <- ExportList, 254 IsNotDefined(Ext)] 255 end. 256 257check_imports(S, #module{imports={imports,Imports}}) -> 258 check_imports_1(S, Imports, []). 259 260check_imports_1(_S, [], Acc) -> 261 Acc; 262check_imports_1(S, [#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs], Acc) -> 263 Module = name_of_def(ModuleRef), 264 Refs = [{try get_referenced_type(S, Ref) 265 catch throw:Error -> Error end, 266 Ref} 267 || Ref <- Imports], 268 CreateError = fun(Ref) -> 269 Error = {undefined_import,name_of_def(Ref),Module}, 270 return_asn1_error(S, Ref, Error) 271 end, 272 Errors = [CreateError(Ref) || {{error, _}, Ref} <- Refs], 273 check_imports_1(S, SFMs, Errors ++ Acc). 274 275checkt(S0, Names) -> 276 Check = fun do_checkt/3, 277 278 %% NOTE: check_type/3 will store information in the process 279 %% dictionary if context switching types are encountered; 280 %% therefore we must force the evaluation order. 281 Types = check_fold(S0, Names, Check), 282 CtxtSwitch = check_contextswitchingtypes(S0, []), 283 check_fold(S0, lists:reverse(CtxtSwitch), Check) ++ Types. 284 285do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) -> 286 NewS = S#state{tname=Name}, 287 try check_type(NewS, Type0, TypeSpec) of 288 #type{}=Ts -> 289 case Type0#typedef.checked of 290 true -> %already checked and updated 291 ok; 292 _ -> 293 Type = Type0#typedef{checked=true, 294 typespec=Ts}, 295 asn1_db:dbput(NewS#state.mname, 296 Name, Type), 297 ok 298 end 299 catch 300 {error,Reason} -> 301 Reason; 302 {asn1_class,_ClassDef} -> 303 {asn1_class,Name}; 304 pobjectsetdef -> 305 {pobjectsetdef,Name}; 306 pvalueset -> 307 {pvalueset,Name} 308 end. 309 310check_contextswitchingtypes(S,Acc) -> 311 CSTList=[{external,'EXTERNAL'}, 312 {embedded_pdv,'EMBEDDED PDV'}, 313 {character_string,'CHARACTER STRING'}], 314 check_contextswitchingtypes(S,CSTList,Acc). 315 316check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) -> 317 case get(T) of 318 unchecked -> 319 put(T,generate), 320 check_contextswitchingtypes(S,Ts,[TName|Acc]); 321 _ -> 322 check_contextswitchingtypes(S,Ts,Acc) 323 end; 324check_contextswitchingtypes(_,[],Acc) -> 325 Acc. 326 327checkv(S, Names) -> 328 check_fold(S, Names, fun do_checkv/3). 329 330do_checkv(S, Name, Value) 331 when is_record(Value, valuedef); 332 is_record(Value, typedef); %Value set may be parsed as object set. 333 is_record(Value, pvaluedef); 334 is_record(Value, pvaluesetdef) -> 335 try check_value(S, Value) of 336 {valueset,VSet} -> 337 Pos = asn1ct:get_pos_of_def(Value), 338 CheckedVSDef = #typedef{checked=true,pos=Pos, 339 name=Name,typespec=VSet}, 340 asn1_db:dbput(S#state.mname, Name, CheckedVSDef), 341 {valueset,Name}; 342 V -> 343 %% update the valuedef 344 asn1_db:dbput(S#state.mname, Name, V), 345 ok 346 catch 347 {error,Reason} -> 348 Reason; 349 {pobjectsetdef} -> 350 {pobjectsetdef,Name}; 351 {objectsetdef} -> 352 {objectsetdef,Name}; 353 {asn1_class, _} -> 354 %% this is an object, save as typedef 355 #valuedef{checked=C,pos=Pos,name=N,type=Type, 356 value=Def} = Value, 357 ClassName = Type#type.def, 358 NewSpec = #'Object'{classname=ClassName,def=Def}, 359 NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, 360 asn1_db:dbput(S#state.mname, Name, NewDef), 361 {objectdef,Name} 362 end. 363 364%% Check parameterized types. 365checkp(S, Names) -> 366 check_fold(S, Names, fun do_checkp/3). 367 368do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) -> 369 S = S0#state{tname=Name}, 370 try check_ptype(S, Type0, TypeSpec) of 371 #type{}=Ts -> 372 Type = Type0#ptypedef{checked=true,typespec=Ts}, 373 asn1_db:dbput(S#state.mname, Name, Type), 374 ok 375 catch 376 {error,Reason} -> 377 Reason; 378 {asn1_class,_ClassDef} -> 379 {asn1_class,Name}; 380 {asn1_param_class,_} -> 381 ok 382 end. 383 384%% Check class definitions. 385checkc(S, Names) -> 386 check_fold(S, Names, fun do_checkc/3). 387 388do_checkc(S, Name, Class) -> 389 try 390 case is_classname(Name) of 391 false -> 392 asn1_error(S, {illegal_class_name,Name}); 393 true -> 394 do_checkc_1(S, Name, Class) 395 end 396 catch {error,Reason} -> Reason 397 end. 398 399do_checkc_1(S, Name, #classdef{}=Class) -> 400 C = check_class(S, Class), 401 store_class(S, true, Class#classdef{typespec=C}, Name), 402 ok; 403do_checkc_1(S, Name, #typedef{typespec=#type{def=Def}=TS}) -> 404 C = check_class(S, TS), 405 {Mod,Pos} = case Def of 406 #'Externaltypereference'{module=M, pos=P} -> 407 {M,P}; 408 {pt, #'Externaltypereference'{module=M, pos=P}, _} -> 409 {M,P} 410 end, 411 Class = #classdef{name=Name, typespec=C, pos=Pos, module=Mod}, 412 store_class(S, true, Class, Name), 413 ok. 414 415%% is_classname(Atom) -> true|false. 416is_classname(Name) when is_atom(Name) -> 417 lists:all(fun($-) -> true; 418 (D) when $0 =< D, D =< $9 -> true; 419 (UC) when $A =< UC, UC =< $Z -> true; 420 (_) -> false 421 end, atom_to_list(Name)). 422 423checko(S0,[Name|Os],Acc,ExclO,ExclOS) -> 424 Item = asn1_db:dbget(S0#state.mname, Name), 425 S = S0#state{error_context=Item}, 426 try checko_1(S, Item, Name, ExclO, ExclOS) of 427 {NewExclO,NewExclOS} -> 428 checko(S, Os, Acc, NewExclO, NewExclOS) 429 catch 430 throw:{error, Error} -> 431 checko(S, Os, [Error|Acc], ExclO, ExclOS) 432 end; 433checko(_S,[],Acc,ExclO,ExclOS) -> 434 {lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}. 435 436checko_1(S, #typedef{typespec=TS}=Object, Name, ExclO, ExclOS) -> 437 NewS = S#state{tname=Name}, 438 O = check_object(NewS, Object, TS), 439 NewObj = Object#typedef{checked=true,typespec=O}, 440 asn1_db:dbput(NewS#state.mname, Name, NewObj), 441 case O of 442 #'Object'{gen=true} -> 443 {ExclO,ExclOS}; 444 #'Object'{gen=false} -> 445 {[Name|ExclO],ExclOS}; 446 #'ObjectSet'{gen=true} -> 447 {ExclO,ExclOS}; 448 #'ObjectSet'{gen=false} -> 449 {ExclO,[Name|ExclOS]} 450 end; 451checko_1(S, #pobjectdef{}=PObject, Name, ExclO, ExclOS) -> 452 NewS = S#state{tname=Name}, 453 PO = check_pobject(NewS, PObject), 454 NewPObj = PObject#pobjectdef{def=PO}, 455 asn1_db:dbput(NewS#state.mname, Name, NewPObj), 456 {[Name|ExclO],ExclOS}; 457checko_1(S, #pvaluesetdef{}=PObjSet, Name, ExclO, ExclOS) -> 458 NewS = S#state{tname=Name}, 459 POS = check_pobjectset(NewS, PObjSet), 460 asn1_db:dbput(NewS#state.mname, Name, POS), 461 {ExclO,[Name|ExclOS]}. 462 463check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) -> 464 case Ch of 465 true -> TS; 466 idle -> TS; 467 _ -> 468 store_class(S,idle,CDef,Name), 469 CheckedTS = check_class(S,TS), 470 store_class(S,true,CDef#classdef{typespec=CheckedTS},Name), 471 CheckedTS 472 end; 473check_class(S = #state{mname=M,tname=T},ClassSpec) 474 when is_record(ClassSpec,type) -> 475 Def = ClassSpec#type.def, 476 case Def of 477 #'Externaltypereference'{module=M,type=T} -> 478 #objectclass{fields=Def}; % in case of recursive definitions 479 Tref = #'Externaltypereference'{type=TName} -> 480 {MName,RefType} = get_referenced_type(S,Tref), 481 #classdef{} = CD = get_class_def(S, RefType), 482 NewState = update_state(S#state{tname=TName}, MName), 483 check_class(NewState, CD); 484 {pt,ClassRef,Params} -> 485 %% parameterized class 486 {_,PClassDef} = get_referenced_type(S,ClassRef), 487 NewParaList = match_parameters(S, Params), 488 instantiate_pclass(S,PClassDef,NewParaList) 489 end; 490check_class(S, #objectclass{}=C) -> 491 check_objectclass(S, C); 492check_class(S,ClassName) -> 493 {RefMod,Def} = get_referenced_type(S,ClassName), 494 case Def of 495 ClassDef when is_record(ClassDef,classdef) -> 496 case ClassDef#classdef.checked of 497 true -> 498 ClassDef#classdef.typespec; 499 idle -> 500 ClassDef#classdef.typespec; 501 false -> 502 Name=ClassName#'Externaltypereference'.type, 503 store_class(S,idle,ClassDef,Name), 504 NewS = update_state(S#state{tname=Name}, RefMod), 505 CheckedTS = check_class(NewS,ClassDef#classdef.typespec), 506 store_class(S,true,ClassDef#classdef{typespec=CheckedTS},Name), 507 CheckedTS 508 end; 509 TypeDef when is_record(TypeDef,typedef) -> 510 %% this case may occur when a definition is a reference 511 %% to a class definition. 512 case TypeDef#typedef.typespec of 513 #type{def=Ext} when is_record(Ext,'Externaltypereference') -> 514 check_class(S,Ext) 515 end 516 end. 517 518check_objectclass(S, #objectclass{fields=Fs0,syntax=Syntax0}=C) -> 519 Fs = check_class_fields(S, Fs0), 520 case Syntax0 of 521 {'WITH SYNTAX',Syntax1} -> 522 Syntax = preprocess_syntax(S, Syntax1, Fs), 523 C#objectclass{fields=Fs,syntax={preprocessed_syntax,Syntax}}; 524 _ -> 525 C#objectclass{fields=Fs} 526 end. 527 528instantiate_pclass(S=#state{parameters=_OldArgs},PClassDef,Params) -> 529 #ptypedef{args=Args,typespec=Type} = PClassDef, 530 MatchedArgs = match_args(S,Args, Params, []), 531 NewS = S#state{parameters=MatchedArgs,abscomppath=[]}, 532 check_class(NewS,#classdef{name=S#state.tname,typespec=Type}). 533 534store_class(S,Mode,ClassDef,ClassName) -> 535 NewCDef = ClassDef#classdef{checked=Mode}, 536 asn1_db:dbput(S#state.mname,ClassName,NewCDef). 537 538check_class_fields(S,Fields) -> 539 check_class_fields(S,Fields,[]). 540 541check_class_fields(S,[F|Fields],Acc) -> 542 NewField = 543 case element(1,F) of 544 fixedtypevaluefield -> 545 {_,Name,Type,Unique,OSpec} = F, 546 case {Unique,OSpec} of 547 {'UNIQUE',{'DEFAULT',_}} -> 548 asn1_error(S, {unique_and_default,Name}); 549 {_,_} -> 550 ok 551 end, 552 RefType = check_type(S,#typedef{typespec=Type},Type), 553 {fixedtypevaluefield,Name,RefType,Unique,OSpec}; 554 object_or_fixedtypevalue_field -> 555 {_,Name,Type,Unique,OSpec} = F, 556 Type2 = maybe_unchecked_OCFT(S,Type), 557 Cat = 558 case asn1ct_gen:type(asn1ct_gen:get_inner(Type2#type.def)) of 559 Def when is_record(Def,'Externaltypereference') -> 560 {_,D} = get_referenced_type(S, Def, true), 561 D; 562 {undefined,user} -> 563 %% neither of {primitive,bif} or {constructed,bif} 564 {_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}), 565 D; 566 _ -> 567 Type 568 end, 569 case Cat of 570 Class when is_record(Class,classdef) -> 571 %% Type must be a referenced type => change it 572 %% to an external reference. 573 ToExt = fun(#type{def= CE = #'Externaltypereference'{}}) -> CE; (T) -> T end, 574 {objectfield,Name,ToExt(Type),Unique,OSpec}; 575 _ -> 576 RefType = check_type(S,#typedef{typespec=Type},Type), 577 {fixedtypevaluefield,Name,RefType,Unique,OSpec} 578 end; 579 objectset_or_fixedtypevalueset_field -> 580 {_,Name,Type,OSpec} = F, 581 RefType = 582 try check_type(S,#typedef{typespec=Type},Type) of 583 #type{} = CheckedType -> 584 CheckedType 585 catch {asn1_class,_ClassDef} -> 586 case if_current_checked_type(S,Type) of 587 true -> Type#type.def; 588 _ -> check_class(S,Type) 589 end 590 end, 591 if 592 is_record(RefType,'Externaltypereference') -> 593 {objectsetfield,Name,Type,OSpec}; 594 is_record(RefType,classdef) -> 595 {objectsetfield,Name,Type,OSpec}; 596 is_record(RefType,objectclass) -> 597 {objectsetfield,Name,Type,OSpec}; 598 true -> 599 {fixedtypevaluesetfield,Name,RefType,OSpec} 600 end; 601 typefield -> 602 case F of 603 {TF,Name,{'DEFAULT',Type}} -> 604 {TF,Name,{'DEFAULT',check_type(S,#typedef{typespec=Type},Type)}}; 605 _ -> F 606 end; 607 _ -> F 608 end, 609 check_class_fields(S,Fields,[NewField|Acc]); 610check_class_fields(_S,[],Acc) -> 611 lists:reverse(Acc). 612 613maybe_unchecked_OCFT(S,Type) -> 614 case Type#type.def of 615 #'ObjectClassFieldType'{type=undefined} -> 616 check_type(S,#typedef{typespec=Type},Type); 617 _ -> 618 Type 619 end. 620 621if_current_checked_type(S,#type{def=Def}) -> 622 CurrentModule = S#state.mname, 623 CurrentCheckedName = S#state.tname, 624 MergedModules = S#state.inputmodules, 625 case Def of 626 #'Externaltypereference'{module=CurrentModule, 627 type=CurrentCheckedName} -> 628 true; 629 #'Externaltypereference'{module=ModuleName, 630 type=CurrentCheckedName} -> 631 case MergedModules of 632 undefined -> 633 false; 634 _ -> 635 lists:member(ModuleName,MergedModules) 636 end; 637 _ -> 638 false 639 end. 640 641 642 643check_pobject(_S,PObject) when is_record(PObject,pobjectdef) -> 644 Def = PObject#pobjectdef.def, 645 Def. 646 647 648check_pobjectset(S,PObjSet) -> 649 #pvaluesetdef{pos=Pos,name=Name,args=Args,type=Type, 650 valueset=ValueSet}=PObjSet, 651 {Mod,Def} = get_referenced_type(S,Type#type.def), 652 case Def of 653 #classdef{} -> 654 ClassName = #'Externaltypereference'{module=Mod, 655 type=get_datastr_name(Def)}, 656 {valueset,Set} = ValueSet, 657 ObjectSet = #'ObjectSet'{class=ClassName, 658 set=Set}, 659 #pobjectsetdef{pos=Pos,name=Name,args=Args,class=Type#type.def, 660 def=ObjectSet}; 661 _ -> 662 PObjSet 663 end. 664 665-record(osi, %Object set information. 666 {st, 667 classref, 668 uniq, 669 ext 670 }). 671 672check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) -> 673 ObjSpec; 674check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> 675 ?dbg("check_object ~p~n",[ObjectDef]), 676 _ = check_externaltypereference(S,ClassRef), 677 {ClassDef, NewClassRef} = 678 case get_referenced_type(S, ClassRef, true) of 679 {MName,#classdef{checked=false, name=CLName}=ClDef} -> 680 Type = ClassRef#'Externaltypereference'.type, 681 NewState = update_state(S#state{tname=Type}, MName), 682 ObjClass = check_class(NewState, ClDef), 683 {ClDef#classdef{checked=true, typespec=ObjClass}, 684 #'Externaltypereference'{module=MName, type=CLName}}; 685 {MName,#classdef{name=CLName}=ClDef} -> 686 {ClDef, #'Externaltypereference'{module=MName, type=CLName}}; 687 _ -> 688 asn1_error(S, illegal_object) 689 end, 690 NewObj = 691 case ObjectDef of 692 {object,_,_}=Def -> 693 NewSettingList = check_objectdefn(S,Def,ClassDef), 694 #'Object'{def=NewSettingList}; 695 {po,{object,DefObj},ArgsList} -> 696 {_,Object} = get_referenced_type(S,DefObj),%DefObj is a 697 %%#'Externalvaluereference' or a #'Externaltypereference' 698 %% Maybe this call should be catched and in case of an exception 699 %% a not initialized parameterized object should be returned. 700 instantiate_po(S,ClassDef,Object,ArgsList); 701 {pv,{simpledefinedvalue,ObjRef},ArgList} -> 702 {_,Object} = get_referenced_type(S,ObjRef), 703 instantiate_po(S,ClassDef,Object,ArgList); 704 #'Externalvaluereference'{} -> 705 {_,Object} = get_referenced_type(S,ObjectDef), 706 check_object(S, Object, object_to_check(S, Object)); 707 [] -> 708 %% An object with no fields (parsed as a value). 709 Def = {object,defaultsyntax,[]}, 710 NewSettingList = check_objectdefn(S, Def, ClassDef), 711 #'Object'{def=NewSettingList}; 712 _ -> 713 asn1_error(S, illegal_object) 714 end, 715 Fields = (ClassDef#classdef.typespec)#objectclass.fields, 716 Gen = gen_incl(S,NewObj#'Object'.def, Fields), 717 NewObj#'Object'{classname=NewClassRef,gen=Gen}; 718check_object(S, _, #'ObjectSet'{class=ClassRef0,set=Set0}=ObjSet0) -> 719 {_,ClassDef} = get_referenced_type(S, ClassRef0), 720 ClassRef = check_externaltypereference(S, ClassRef0), 721 {UniqueFieldName,UniqueInfo} = 722 case get_unique_fieldname(S, ClassDef) of 723 no_unique -> {{unique,undefined},{unique,undefined}}; 724 Other -> {element(1,Other),Other} 725 end, 726 OSI0 = #osi{st=S,classref=ClassRef,uniq=UniqueInfo,ext=false}, 727 {Set1,OSI1} = if 728 is_list(Set0) -> 729 check_object_set_list(Set0, OSI0); 730 true -> 731 check_object_set(Set0, OSI0) 732 end, 733 Ext = case Set1 of 734 [] -> 735 %% FIXME: X420 does not compile unless we force 736 %% empty sets to be extensible. There should be 737 %% a better way. 738 true; 739 [_|_] -> 740 OSI1#osi.ext 741 end, 742 Set2 = remove_duplicate_objects(S, Set1), 743 Set = case Ext of 744 false -> Set2; 745 true -> Set2 ++ ['EXTENSIONMARK'] 746 end, 747 ObjSet = ObjSet0#'ObjectSet'{uniquefname=UniqueFieldName,set=Set}, 748 Gen = gen_incl_set(S, Set, ClassDef), 749 ObjSet#'ObjectSet'{class=ClassRef,gen=Gen}. 750 751check_object_set({element_set,Root0,Ext0}, OSI0) -> 752 OSI = case Ext0 of 753 none -> OSI0; 754 _ -> OSI0#osi{ext=true} 755 end, 756 case {Root0,Ext0} of 757 {empty,empty} -> {[],OSI}; 758 {empty,Ext} -> check_object_set(Ext, OSI); 759 {Root,none} -> check_object_set(Root, OSI); 760 {Root,empty} -> check_object_set(Root, OSI); 761 {Root,Ext} -> check_object_set_list([Root,Ext], OSI) 762 end; 763check_object_set(#'Externaltypereference'{}=Ref, #osi{st=S}=OSI) -> 764 {_,#typedef{typespec=OSdef}=OS} = get_referenced_type(S, Ref), 765 ObjectSet = check_object(S, OS, OSdef), 766 check_object_set_objset(ObjectSet, OSI); 767check_object_set(#'Externalvaluereference'{}=Ref, #osi{st=S}=OSI) -> 768 {RefedMod,ObjName,#'Object'{def=Def}} = check_referenced_object(S, Ref), 769 ObjList = check_object_set_mk(RefedMod, ObjName, Def, OSI), 770 {ObjList,OSI}; 771check_object_set({'EXCEPT',Incl0,Excl0}, OSI) -> 772 {Incl1,_} = check_object_set(Incl0, OSI), 773 {Excl1,_} = check_object_set(Excl0, OSI), 774 Exclude = sofs:set([N || {N,_} <- Excl1], [name]), 775 Incl2 = [{Name,Obj} || {Name,_,_}=Obj <- Incl1], 776 Incl3 = sofs:relation(Incl2, [{name,object}]), 777 Incl4 = sofs:drestriction(Incl3, Exclude), 778 Incl5 = sofs:to_external(Incl4), 779 Incl = [Obj || {_,Obj} <- Incl5], 780 {Incl,OSI}; 781check_object_set({object,_,_}=Obj0, OSI) -> 782 #osi{st=S,classref=ClassRef} = OSI, 783 #'Object'{def=Def} = 784 check_object(S, #typedef{typespec=Obj0}, 785 #'Object'{classname=ClassRef,def=Obj0}), 786 ObjList = check_object_set_mk(Def, OSI), 787 {ObjList,OSI}; 788check_object_set(#'ObjectClassFieldType'{classname=ObjName, 789 fieldname=FieldNames}, 790 #osi{st=S}=OSI) -> 791 Set = check_ObjectSetFromObjects(S, ObjName, FieldNames), 792 check_object_set_objset_list(Set, OSI); 793check_object_set({'ObjectSetFromObjects',Obj,FieldNames}, #osi{st=S}=OSI) -> 794 ObjName = element(tuple_size(Obj), Obj), 795 Set = check_ObjectSetFromObjects(S, ObjName, FieldNames), 796 check_object_set_objset_list(Set, OSI); 797check_object_set({pt,DefinedObjSet,ParamList0}, OSI) -> 798 #osi{st=S,classref=ClassRef} = OSI, 799 {_,PObjSetDef} = get_referenced_type(S, DefinedObjSet), 800 ParamList = match_parameters(S, ParamList0), 801 ObjectSet = instantiate_pos(S, ClassRef, PObjSetDef, ParamList), 802 check_object_set_objset(ObjectSet, OSI); 803check_object_set({pos,{objectset,_,DefinedObjSet},Params0}, OSI) -> 804 #osi{st=S,classref=ClassRef} = OSI, 805 {_,PObjSetDef} = get_referenced_type(S, DefinedObjSet), 806 Params = match_parameters(S, Params0), 807 ObjectSet = instantiate_pos(S, ClassRef, PObjSetDef, Params), 808 check_object_set_objset(ObjectSet, OSI); 809check_object_set({pv,{simpledefinedvalue,DefinedObject},Params}=PV, OSI) -> 810 #osi{st=S,classref=ClassRef} = OSI, 811 Args = match_parameters(S, Params), 812 #'Object'{def=Def} = 813 check_object(S, PV, 814 #'Object'{classname=ClassRef , 815 def={po,{object,DefinedObject},Args}}), 816 ObjList = check_object_set_mk(Def, OSI), 817 {ObjList,OSI}; 818check_object_set({'SingleValue',Val}, OSI) -> 819 check_object_set(Val, OSI); 820check_object_set({'ValueFromObject',{object,Object},FieldNames}, OSI) -> 821 #osi{st=S} = OSI, 822 case extract_field(S, Object, FieldNames) of 823 #'Object'{def=Def} -> 824 ObjList = check_object_set_mk(Def, OSI), 825 {ObjList,OSI}; 826 _ -> 827 asn1_error(S, illegal_object) 828 end; 829check_object_set(#type{def=Def}, OSI) -> 830 check_object_set(Def, OSI); 831check_object_set({union,A0,B0}, OSI0) -> 832 {A,OSI1} = check_object_set(A0, OSI0), 833 {B,OSI} = check_object_set(B0, OSI1), 834 {A++B,OSI}. 835 836check_object_set_list([H|T], OSI0) -> 837 {Set0,OSI1} = check_object_set(H, OSI0), 838 {Set1,OSI2} = check_object_set_list(T, OSI1), 839 {Set0++Set1,OSI2}; 840check_object_set_list([], OSI) -> 841 {[],OSI}. 842 843check_object_set_objset(#'ObjectSet'{set=Set}, OSI) -> 844 check_object_set_objset_list(Set, OSI). 845 846check_object_set_objset_list(Set, OSI) -> 847 check_object_set_objset_list_1(Set, OSI, []). 848 849check_object_set_objset_list_1(['EXTENSIONMARK'|T], OSI, Acc) -> 850 check_object_set_objset_list_1(T, OSI#osi{ext=true}, Acc); 851check_object_set_objset_list_1([H|T], OSI, Acc) -> 852 check_object_set_objset_list_1(T, OSI, [H|Acc]); 853check_object_set_objset_list_1([], OSI, Acc) -> 854 {Acc,OSI}. 855 856check_object_set_mk(Fields, OSI) -> 857 check_object_set_mk(no_mod, no_name, Fields, OSI). 858 859check_object_set_mk(M, N, Def, #osi{uniq={unique,undefined}}) -> 860 {_,_,Fields} = Def, 861 [{{M,N},no_unique_value,Fields}]; 862check_object_set_mk(M, N, Def, #osi{uniq={UniqField,_}}) -> 863 {_,_,Fields} = Def, 864 case lists:keyfind(UniqField, 1, Fields) of 865 {UniqField,#valuedef{value=Val}} -> 866 [{{M,N},Val,Fields}]; 867 false -> 868 case Fields of 869 [{_,#typedef{typespec=#'ObjectSet'{set=['EXTENSIONMARK']}}}] -> 870 %% FIXME: If object is missing the unique field and 871 %% only contains a reference to an empty object set, 872 %% we will remove the entire object as a workaround 873 %% to get X420 to compile. There should be a better 874 %% way. 875 []; 876 _ -> 877 [{{M,N},no_unique_value,Fields}] 878 end 879 end. 880 881%% remove_duplicate_objects/1 remove duplicates of objects. 882%% For instance may Set contain objects of same class from 883%% different object sets that in fact might be duplicates. 884remove_duplicate_objects(S, Set0) when is_list(Set0) -> 885 Set1 = [{Id,Orig} || {_,Id,_}=Orig <- Set0], 886 Set2 = sofs:relation(Set1), 887 Set3 = sofs:relation_to_family(Set2), 888 Set = sofs:to_external(Set3), 889 remove_duplicate_objects_1(S, Set). 890 891remove_duplicate_objects_1(S, [{no_unique_value,Objs}|T]) -> 892 Objs ++ remove_duplicate_objects_1(S, T); 893remove_duplicate_objects_1(S, [{_,[_]=Objs}|T]) -> 894 Objs ++ remove_duplicate_objects_1(S, T); 895remove_duplicate_objects_1(S, [{Id,[_|_]=Objs}|T]) -> 896 MakeSortable = fun(What) -> sortable_type(S, What) end, 897 Tagged = order_tag_set(Objs, MakeSortable), 898 case lists:ukeysort(1, Tagged) of 899 [{_,Obj}] -> 900 [Obj|remove_duplicate_objects_1(S, T)]; 901 [_|_] -> 902 asn1_error(S, {non_unique_object,Id}) 903 end; 904remove_duplicate_objects_1(_, []) -> 905 []. 906 907order_tag_set([{_, _, Fields}=Orig|Fs], Fun) -> 908 Pair = {[{FId, traverse(F, Fun)} || {FId, F} <- Fields], Orig}, 909 [Pair|order_tag_set(Fs, Fun)]; 910order_tag_set([], _) -> []. 911 912sortable_type(S, #'Externaltypereference'{}=ERef) -> 913 try get_referenced_type(S, ERef) of 914 {_,#typedef{}=OI} -> 915 OI#typedef{pos=undefined,name=undefined} 916 catch 917 _:_ -> 918 ERef 919 end; 920sortable_type(_, #typedef{}=TD) -> 921 asn1ct:unset_pos_mod(TD#typedef{name=undefined}); 922sortable_type(_, Type) -> 923 asn1ct:unset_pos_mod(Type). 924 925traverse(Structure0, Fun) -> 926 Structure = Fun(Structure0), 927 traverse_1(Structure, Fun). 928 929traverse_1(#typedef{typespec=TS0} = TD, Fun) -> 930 TS = traverse(TS0, Fun), 931 TD#typedef{typespec=TS}; 932traverse_1(#valuedef{type=TS0} = VD, Fun) -> 933 TS = traverse(TS0, Fun), 934 VD#valuedef{type=TS}; 935traverse_1(#type{def=TS0} = TD, Fun) -> 936 TS = traverse(TS0, Fun), 937 TD#type{def=TS}; 938traverse_1(#'SEQUENCE'{components=Cs0} = Seq, Fun) -> 939 Cs = traverse_seq_set(Cs0, Fun), 940 Seq#'SEQUENCE'{components=Cs}; 941traverse_1({'SEQUENCE OF',Type0}, Fun) -> 942 Type = traverse(Type0, Fun), 943 {'SEQUENCE OF',Type}; 944traverse_1({'SET OF',Type0}, Fun) -> 945 Type = traverse(Type0, Fun), 946 {'SET OF',Type}; 947traverse_1(#'SET'{components=Cs0} = Set, Fun) -> 948 Cs = traverse_seq_set(Cs0, Fun), 949 Set#'SET'{components=Cs}; 950traverse_1({'CHOICE', Cs0}, Fun) -> 951 Cs = traverse_seq_set(Cs0, Fun), 952 {'CHOICE', Cs}; 953traverse_1(Leaf, _) -> 954 Leaf. 955 956traverse_seq_set(List, Fun) when is_list(List) -> 957 traverse_seq_set_1(List, Fun); 958traverse_seq_set({Set, Ext}, Fun) -> 959 {traverse_seq_set_1(Set, Fun), traverse_seq_set_1(Ext, Fun)}; 960traverse_seq_set({Set1, Set2, Set3}, Fun) -> 961 {traverse_seq_set_1(Set1, Fun), 962 traverse_seq_set_1(Set2, Fun), 963 traverse_seq_set_1(Set3, Fun)}. 964 965traverse_seq_set_1([#'ComponentType'{} = CT0|Cs], Fun) -> 966 CT = #'ComponentType'{typespec=TS0} = Fun(CT0), 967 TS = traverse(TS0, Fun), 968 [CT#'ComponentType'{typespec=TS}|traverse_seq_set_1(Cs, Fun)]; 969traverse_seq_set_1([{'COMPONENTS OF', _} = CO0|Cs], Fun) -> 970 {'COMPONENTS OF', TS0} = Fun(CO0), 971 TS = traverse(TS0, Fun), 972 [{'COMPONENTS OF', TS}|traverse_seq_set_1(Cs, Fun)]; 973traverse_seq_set_1([], _) -> 974 []. 975 976object_to_check(_, #typedef{typespec=ObjDef}) -> 977 ObjDef; 978object_to_check(S, #valuedef{type=Class,value=ObjectRef}) -> 979 %% If the object definition is parsed as an object the ClassName 980 %% is parsed as a type. 981 case Class of 982 #type{def=#'Externaltypereference'{}=Def} -> 983 #'Object'{classname=Def,def=ObjectRef}; 984 _ -> 985 asn1_error(S, illegal_object) 986 end. 987 988check_referenced_object(S,ObjRef) 989 when is_record(ObjRef,'Externalvaluereference')-> 990 case get_referenced_type(S,ObjRef) of 991 {RefedMod,ObjectDef} when is_record(ObjectDef,valuedef) -> 992 ?dbg("Externalvaluereference, ObjectDef: ~p~n",[ObjectDef]), 993 #type{def=ClassRef} = ObjectDef#valuedef.type, 994 Def = ObjectDef#valuedef.value, 995 {RefedMod,get_datastr_name(ObjectDef), 996 check_object(update_state(S,RefedMod),ObjectDef,#'Object'{classname=ClassRef, 997 def=Def})}; 998 {RefedMod,ObjectDef} when is_record(ObjectDef,typedef) -> 999 {RefedMod,get_datastr_name(ObjectDef), 1000 check_object(update_state(S,RefedMod),ObjectDef,ObjectDef#typedef.typespec)} 1001 end. 1002 1003check_ObjectSetFromObjects(S, ObjName, Fields) -> 1004 {_,Obj0} = get_referenced_type(S, ObjName), 1005 case check_object(S, Obj0, Obj0#typedef.typespec) of 1006 #'ObjectSet'{}=Obj1 -> 1007 get_fieldname_set(S, Obj1, Fields); 1008 #'Object'{classname=Class, 1009 def={object,_,ObjFs}} -> 1010 ObjSet = #'ObjectSet'{class=Class, 1011 set=[{'_','_',ObjFs}]}, 1012 get_fieldname_set(S, ObjSet, Fields) 1013 end. 1014 1015%% get_type_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) -> 1016%% Type 1017get_type_from_object(S, Object, FieldNames) 1018 when is_record(Object, 'Externaltypereference'); 1019 is_record(Object, 'Externalvaluereference') -> 1020 extract_field(S, Object, FieldNames). 1021 1022%% get_value_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) -> 1023%% UntaggedValue 1024get_value_from_object(S, Def, FieldNames) -> 1025 case extract_field(S, Def, FieldNames) of 1026 #valuedef{value=Val} -> 1027 Val; 1028 {valueset,_}=Val -> 1029 Val; 1030 _ -> 1031 asn1_error(S, illegal_value) 1032 end. 1033 1034%% extract_field(State, ObjectOrObjectSet, [{RefType,FieldName}]) 1035%% RefType = typefieldreference | valuefieldreference 1036%% 1037%% Get the type, value, object, object set, or value set from the 1038%% referenced object or object set. The list of field name tuples 1039%% may have more than one element. All field names but the last 1040%% refers to either an object or object set. 1041 1042extract_field(S, Def0, FieldNames) -> 1043 {_,Def1} = get_referenced_type(S, Def0), 1044 Def2 = check_object(S, Def1, Def1#typedef.typespec), 1045 Def = Def1#typedef{typespec=Def2}, 1046 get_fieldname_element(S, Def, FieldNames). 1047 1048%% get_fieldname_element(State, Element, [{RefType,FieldName}] 1049%% RefType = typefieldreference | valuefieldreference 1050%% 1051%% Get the type, value, object, object set, or value set from the referenced 1052%% element. The list of field name tuples may have more than one element. 1053%% All field names but the last refers to either an object or object set. 1054 1055get_fieldname_element(S, Object0, [{_RefType,FieldName}|Fields]) -> 1056 Object = case Object0 of 1057 #typedef{typespec=#'Object'{def=Obj}} -> Obj; 1058 {_,_,_}=Obj -> Obj 1059 end, 1060 case check_fieldname_element(S, FieldName, Object) of 1061 #'Object'{def=D} when Fields =/= [] -> 1062 get_fieldname_element(S, D, Fields); 1063 #'ObjectSet'{}=Set -> 1064 get_fieldname_set(S, Set, Fields); 1065 Result when Fields =:= [] -> 1066 Result 1067 end; 1068get_fieldname_element(_S, Def, []) -> 1069 Def. 1070 1071get_fieldname_set(S, #'ObjectSet'{set=Set0}, T) -> 1072 get_fieldname_set_1(S, Set0, T, []). 1073 1074get_fieldname_set_1(S, ['EXTENSIONMARK'=Ext|T], Fields, Acc) -> 1075 get_fieldname_set_1(S, T, Fields, [Ext|Acc]); 1076get_fieldname_set_1(S, [H|T], Fields, Acc) -> 1077 try get_fieldname_element(S, H, Fields) of 1078 L when is_list(L) -> 1079 get_fieldname_set_1(S, T, Fields, L++Acc); 1080 {valueset,L} -> 1081 get_fieldname_set_1(S, T, Fields, L++Acc); 1082 Other -> 1083 get_fieldname_set_1(S, T, Fields, [Other|Acc]) 1084 catch 1085 throw:{error,_} -> 1086 get_fieldname_set_1(S, T, Fields, Acc) 1087 end; 1088get_fieldname_set_1(_, [], _Fields, Acc) -> 1089 case Acc of 1090 [#valuedef{}|_] -> 1091 {valueset,Acc}; 1092 _ -> 1093 Acc 1094 end. 1095 1096check_fieldname_element(S, Name, {_,_,Fields}) -> 1097 case lists:keyfind(Name, 1, Fields) of 1098 {Name,Def} -> 1099 check_fieldname_element_1(S, Def); 1100 false -> 1101 asn1_error(S, {undefined_field,Name}) 1102 end. 1103 1104check_fieldname_element_1(S, #typedef{typespec=Ts}=TDef) -> 1105 case Ts of 1106 #'Object'{} -> 1107 check_object(S, TDef, Ts); 1108 _ -> 1109 check_type(S, TDef, Ts) 1110 end; 1111check_fieldname_element_1(S, #valuedef{}=VDef) -> 1112 try 1113 check_value(S, VDef) 1114 catch 1115 throw:{asn1_class, _} -> 1116 #valuedef{checked=C,pos=Pos,name=N,type=Type, 1117 value=Def} = VDef, 1118 ClassName = Type#type.def, 1119 NewSpec = #'Object'{classname=ClassName,def=Def}, 1120 NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, 1121 check_fieldname_element_1(S, NewDef) 1122 end; 1123check_fieldname_element_1(_S, {value_tag,Val}) -> 1124 #valuedef{value=Val}; 1125check_fieldname_element_1(S, Eref) 1126 when is_record(Eref, 'Externaltypereference'); 1127 is_record(Eref, 'Externalvaluereference') -> 1128 {_,TDef} = get_referenced_type(S, Eref), 1129 check_fieldname_element_1(S, TDef). 1130 1131%% instantiate_po/4 1132%% ClassDef is the class of Object, 1133%% Object is the Parameterized object, which is referenced, 1134%% ArgsList is the list of actual parameters 1135%% returns an #'Object' record. 1136instantiate_po(S=#state{parameters=_OldArgs},_ClassDef,Object,ArgsList) when is_record(Object,pobjectdef) -> 1137 FormalParams = get_pt_args(Object), 1138 MatchedArgs = match_args(S,FormalParams,ArgsList,[]), 1139 NewS = S#state{parameters=MatchedArgs}, 1140 check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class, 1141 def=Object#pobjectdef.def}). 1142 1143%% instantiate_pos/4 1144%% ClassDef is the class of ObjectSetDef, 1145%% ObjectSetDef is the Parameterized object set, which is referenced 1146%% on the right side of the assignment, 1147%% ArgsList is the list of actual parameters, i.e. real objects 1148instantiate_pos(S=#state{parameters=_OldArgs},ClassRef,ObjectSetDef,ArgsList) -> 1149 FormalParams = get_pt_args(ObjectSetDef), 1150 OSet = case get_pt_spec(ObjectSetDef) of 1151 {valueset,Set} -> #'ObjectSet'{class=ClassRef,set=Set}; 1152 Set when is_record(Set,'ObjectSet') -> Set; 1153 _ -> asn1_error(S, invalid_objectset) 1154 end, 1155 MatchedArgs = match_args(S,FormalParams,ArgsList,[]), 1156 NewS = S#state{parameters=MatchedArgs}, 1157 check_object(NewS,ObjectSetDef,OSet). 1158 1159 1160%% gen_incl -> boolean() 1161%% If object with Fields has any of the corresponding class' typefields 1162%% then return value is true otherwise it is false. 1163%% If an object lacks a typefield but the class has a type field that 1164%% is OPTIONAL then we want gen to be true 1165gen_incl(S,{_,_,Fields},CFields)-> 1166 gen_incl1(S,Fields,CFields). 1167 1168gen_incl1(_,_,[]) -> 1169 false; 1170gen_incl1(S,Fields,[C|CFields]) -> 1171 case element(1,C) of 1172 typefield -> 1173 true; %% should check that field is OPTIONAL or DEFUALT if 1174 %% the object lacks this field 1175 objectfield -> 1176 case lists:keysearch(element(2,C),1,Fields) of 1177 {value,Field} -> 1178 ClassRef = case element(3,C) of 1179 #type{def=Ref} -> Ref; 1180 Eref when is_record(Eref,'Externaltypereference') -> 1181 Eref 1182 end, 1183 ClassFields = get_objclass_fields(S,ClassRef), 1184 ObjDef = 1185 case element(2,Field) of 1186 TDef when is_record(TDef,typedef) -> 1187 check_object(S,TDef,TDef#typedef.typespec); 1188 ERef -> 1189 {_,T} = get_referenced_type(S,ERef), 1190 check_object(S, T, object_to_check(S, T)) 1191 end, 1192 case gen_incl(S,ObjDef#'Object'.def, 1193 ClassFields) of 1194 true -> 1195 true; 1196 _ -> 1197 gen_incl1(S,Fields,CFields) 1198 end; 1199 _ -> 1200 gen_incl1(S,Fields,CFields) 1201 end; 1202 _ -> 1203 gen_incl1(S,Fields,CFields) 1204 end. 1205 1206get_objclass_fields(S,Eref=#'Externaltypereference'{}) -> 1207 {_,ClassDef} = get_referenced_type(S,Eref, true), 1208 get_objclass_fields(S,ClassDef); 1209get_objclass_fields(S,CD=#classdef{typespec=#'Externaltypereference'{}}) -> 1210 get_objclass_fields(S,CD#classdef.typespec); 1211get_objclass_fields(_,#classdef{typespec=CDef}) 1212 when is_record(CDef,objectclass) -> 1213 CDef#objectclass.fields. 1214 1215 1216%% first if no unique field in the class return false.(don't generate code) 1217gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) 1218 when is_record(Eref,'Externaltypereference') -> 1219 %% When a Defined class is a reference toanother class definition 1220 {_,CDef} = get_referenced_type(S,Eref), 1221 gen_incl_set(S,Fields,CDef); 1222gen_incl_set(S,Fields,ClassDef) -> 1223 case get_unique_fieldname(S, ClassDef) of 1224 no_unique -> 1225 false; 1226 {_, _} -> 1227 gen_incl_set1(S,Fields, 1228 (ClassDef#classdef.typespec)#objectclass.fields) 1229 end. 1230 1231 1232%% if any of the existing or potentially existing objects has a typefield 1233%% then return true. 1234gen_incl_set1(_,[],_CFields)-> 1235 false; 1236gen_incl_set1(_,['EXTENSIONMARK'],_) -> 1237 true; 1238%% Fields are the fields of an object in the object set. 1239%% CFields are the fields of the class of the object set. 1240gen_incl_set1(_,['EXTENSIONMARK'|_],_) -> 1241 true; 1242gen_incl_set1(S,[Object|Rest],CFields)-> 1243 Fields = element(tuple_size(Object), Object), 1244 case gen_incl1(S,Fields,CFields) of 1245 true -> 1246 true; 1247 false -> 1248 gen_incl_set1(S,Rest,CFields) 1249 end. 1250 1251 1252%%% 1253%%% Check an object definition. 1254%%% 1255 1256check_objectdefn(S, Def, #classdef{typespec=ObjClass}) -> 1257 #objectclass{syntax=Syntax0,fields=ClassFields} = ObjClass, 1258 case Def of 1259 {object,defaultsyntax,Fields} -> 1260 check_defaultfields(S, Fields, ClassFields); 1261 {object,definedsyntax,Fields} -> 1262 Syntax = get_syntax(S, Syntax0, ClassFields), 1263 case match_syntax(S, Syntax, Fields, []) of 1264 {match,NewFields,[]} -> 1265 {object,defaultsyntax,NewFields}; 1266 {match,_,[What|_]} -> 1267 syntax_match_error(S, What); 1268 {nomatch,[What|_]} -> 1269 syntax_match_error(S, What); 1270 {nomatch,[]} -> 1271 syntax_match_error(S) 1272 end 1273 end. 1274 1275 1276%%% 1277%%% Pre-process the simplified syntax so that it can be more 1278%%% easily matched. 1279%%% 1280 1281get_syntax(_, {preprocessed_syntax,Syntax}, _) -> 1282 Syntax; 1283get_syntax(S, {'WITH SYNTAX',Syntax}, ClassFields) -> 1284 preprocess_syntax(S, Syntax, ClassFields). 1285 1286preprocess_syntax(S, Syntax0, Cs) -> 1287 Syntax = preprocess_syntax_1(S, Syntax0, Cs, true), 1288 Present0 = preprocess_get_fields(Syntax, []), 1289 Present1 = lists:sort(Present0), 1290 Present = ordsets:from_list(Present1), 1291 case Present =:= Present1 of 1292 false -> 1293 Dupl = Present1 -- Present, 1294 asn1_error(S, {syntax_duplicated_fields,Dupl}); 1295 true -> 1296 ok 1297 end, 1298 Mandatory0 = get_mandatory_class_fields(Cs), 1299 Mandatory = ordsets:from_list(Mandatory0), 1300 case ordsets:subtract(Mandatory, Present) of 1301 [] -> 1302 Syntax; 1303 [_|_]=Missing -> 1304 asn1_error(S, {syntax_missing_mandatory_fields,Missing}) 1305 end. 1306 1307preprocess_syntax_1(S, [H|T], Cs, Mandatory) when is_list(H) -> 1308 [{optional,preprocess_syntax_1(S, H, Cs, false)}| 1309 preprocess_syntax_1(S, T, Cs, Mandatory)]; 1310preprocess_syntax_1(S, [{valuefieldreference,Name}|T], Cs, Mandatory) -> 1311 F = preprocess_check_field(S, Name, Cs, Mandatory), 1312 [F|preprocess_syntax_1(S, T, Cs, Mandatory)]; 1313preprocess_syntax_1(S, [{typefieldreference,Name}|T], Cs, Mandatory) -> 1314 F = preprocess_check_field(S, Name, Cs, Mandatory), 1315 [F|preprocess_syntax_1(S, T, Cs, Mandatory)]; 1316preprocess_syntax_1(S,[{Token,_}|T], Cs, Mandatory) when is_atom(Token) -> 1317 [{token,Token}|preprocess_syntax_1(S, T, Cs, Mandatory)]; 1318preprocess_syntax_1(S, [Token|T], Cs, Mandatory) when is_atom(Token) -> 1319 [{token,Token}|preprocess_syntax_1(S, T, Cs, Mandatory)]; 1320preprocess_syntax_1(_, [], _, _) -> []. 1321 1322preprocess_check_field(S, Name, Cs, Mandatory) -> 1323 case lists:keyfind(Name, 2, Cs) of 1324 Tuple when is_tuple(Tuple) -> 1325 case not Mandatory andalso is_mandatory_class_field(Tuple) of 1326 true -> 1327 asn1_error(S, {syntax_mandatory_in_optional_group,Name}); 1328 false -> 1329 {field,Tuple} 1330 end; 1331 false -> 1332 asn1_error(S, {syntax_undefined_field,Name}) 1333 end. 1334 1335preprocess_get_fields([{field,F}|T], Acc) -> 1336 Name = element(2, F), 1337 preprocess_get_fields(T, [Name|Acc]); 1338preprocess_get_fields([{optional,L}|T], Acc) -> 1339 preprocess_get_fields(T, preprocess_get_fields(L, Acc)); 1340preprocess_get_fields([_|T], Acc) -> 1341 preprocess_get_fields(T, Acc); 1342preprocess_get_fields([], Acc) -> 1343 Acc. 1344 1345%%% 1346%%% Match the actual fields in the object definition to 1347%%% the pre-processed simplified syntax. 1348%%% 1349 1350match_syntax(S, [{token,Token}|T], [A|As]=Args, Acc) -> 1351 case A of 1352 {word_or_setting,_,#'Externaltypereference'{type=Token}} -> 1353 match_syntax(S, T, As, Acc); 1354 {Token,Line} when is_integer(Line) -> 1355 match_syntax(S, T, As, Acc); 1356 _ -> 1357 {nomatch,Args} 1358 end; 1359match_syntax(S, [{field,Field}|T]=Fs, [A|As0]=Args0, Acc) -> 1360 try match_syntax_type(S, Field, A) of 1361 {match,Match} -> 1362 match_syntax(S, T, As0, lists:reverse(Match)++Acc); 1363 {params,_Name,#ptypedef{args=Params}=P,Ref} -> 1364 {Args,As} = lists:split(length(Params), As0), 1365 Val = match_syntax_params(S, P, Ref, Args), 1366 match_syntax(S, Fs, [Val|As], Acc) 1367 catch 1368 _:_ -> 1369 {nomatch,Args0} 1370 end; 1371match_syntax(S, [{optional,L}|T], As0, Acc) -> 1372 case match_syntax(S, L, As0, []) of 1373 {match,Match,As} -> 1374 match_syntax(S, T, As, lists:reverse(Match)++Acc); 1375 {nomatch,As0} -> 1376 match_syntax(S, T, As0, Acc); 1377 {nomatch,_}=NoMatch -> 1378 NoMatch 1379 end; 1380match_syntax(_, [_|_], [], _Acc) -> 1381 {nomatch,[]}; 1382match_syntax(_, [], As, Acc) -> 1383 {match,Acc,As}. 1384 1385match_syntax_type(S, Type, {value_tag,Val}) -> 1386 match_syntax_type(S, Type, Val); 1387match_syntax_type(S, Type, {setting,_,Val}) -> 1388 match_syntax_type(S, Type, Val); 1389match_syntax_type(S, Type, {word_or_setting,_,Val}) -> 1390 match_syntax_type(S, Type, Val); 1391match_syntax_type(_S, _Type, {Atom,Line}) 1392 when is_atom(Atom), is_integer(Line) -> 1393 throw(nomatch); 1394match_syntax_type(S, {fixedtypevaluefield,Name,#type{}=T,_,_}=Type, 1395 #'Externalvaluereference'{}=ValRef0) -> 1396 try get_referenced_type(S, ValRef0) of 1397 {M,#valuedef{}=ValDef} -> 1398 match_syntax_type(update_state(S, M), Type, ValDef) 1399 catch 1400 throw:{error,_} -> 1401 ValRef = #valuedef{name=Name, 1402 type=T, 1403 value=ValRef0, 1404 module=S#state.mname}, 1405 match_syntax_type(S, Type, ValRef) 1406 end; 1407match_syntax_type(S, {fixedtypevaluefield,Name,#type{},_,_}, #valuedef{}=Val0) -> 1408 Val = check_value(S, Val0), 1409 {match,[{Name,Val}]}; 1410match_syntax_type(S, {fixedtypevaluefield,Name,#type{},_,_}, 1411 {'ValueFromObject',{object,Object},FieldNames}) -> 1412 Val = extract_field(S, Object, FieldNames), 1413 {match,[{Name,Val}]}; 1414match_syntax_type(S, {fixedtypevaluefield,Name,#type{}=T,_,_}=Type, Any) -> 1415 ValDef = #valuedef{name=Name,type=T,value=Any,module=S#state.mname}, 1416 match_syntax_type(S, Type, ValDef); 1417match_syntax_type(_S, {fixedtypevaluesetfield,Name,#type{},_}, Any) -> 1418 {match,[{Name,Any}]}; 1419match_syntax_type(S, {objectfield,Name,_,_,_}, #'Externalvaluereference'{}=Ref) -> 1420 {M,Obj} = get_referenced_type(S, Ref), 1421 check_object(S, Obj, object_to_check(S, Obj)), 1422 {match,[{Name,Ref#'Externalvaluereference'{module=M}}]}; 1423match_syntax_type(S, {objectfield,Name,Class,_,_}, {object,_,_}=ObjDef) -> 1424 InlinedObjName = list_to_atom(lists:concat([S#state.tname, 1425 '_',Name])), 1426 ObjSpec = #'Object'{classname=Class,def=ObjDef}, 1427 CheckedObj = check_object(S, #typedef{typespec=ObjSpec}, ObjSpec), 1428 InlObj = #typedef{checked=true,name=InlinedObjName,typespec=CheckedObj}, 1429 ObjKey = {InlinedObjName, InlinedObjName}, 1430 insert_once(S, inlined_objects, ObjKey), 1431 %% Which module to use here? Could it be other than top_module? 1432 asn1_db:dbput(get(top_module), InlinedObjName, InlObj), 1433 {match,[{Name,InlObj}]}; 1434match_syntax_type(_S, {objectfield,Name,_,_,_}, Any) -> 1435 {match,[{Name,Any}]}; 1436match_syntax_type(S, {objectsetfield,Name,CDef0,_}, Any) -> 1437 CDef = case CDef0 of 1438 #type{def=CDef1} -> CDef1; 1439 CDef1 -> CDef1 1440 end, 1441 case match_syntax_objset(S, Any, CDef) of 1442 #typedef{typespec=#'ObjectSet'{}=Ts0}=Def -> 1443 Ts = check_object(S, Def, Ts0), 1444 {match,[{Name,Def#typedef{checked=true,typespec=Ts}}]}; 1445 _ -> 1446 syntax_match_error(S, Any) 1447 end; 1448match_syntax_type(S, {typefield,Name0,_}, #type{def={pt,_,_}=Def}=Actual) -> 1449 %% This is an inlined type. If constructed type, save in data base. 1450 T = check_type(S, #typedef{typespec=Actual}, Actual), 1451 #'Externaltypereference'{type=PtName} = element(2, Def), 1452 NameList = [PtName,S#state.tname], 1453 Name = list_to_atom(asn1ct_gen:list2name(NameList)), 1454 NewTDef = #typedef{checked=true,name=Name,typespec=T}, 1455 asn1_db:dbput(S#state.mname, Name, NewTDef), 1456 insert_once(S, parameterized_objects, {Name,type,NewTDef}), 1457 {match,[{Name0,NewTDef}]}; 1458match_syntax_type(S, {typefield,Name,_}, #type{def=#'ObjectClassFieldType'{}}=Actual) -> 1459 T = check_type(S, #typedef{typespec=Actual}, Actual), 1460 {match,[{Name,ocft_def(T)}]}; 1461match_syntax_type(S, {typefield,Name,_}, #type{def=#'Externaltypereference'{}=Ref}) -> 1462 match_syntax_external(S, Name, Ref); 1463match_syntax_type(S, {typefield,Name,_}, #type{def=Def}=Actual) -> 1464 T = check_type(S, #typedef{typespec=Actual}, Actual), 1465 TypeName = asn1ct_gen:type(asn1ct_gen:get_inner(Def)), 1466 {match,[{Name,#typedef{checked=true,name=TypeName,typespec=T}}]}; 1467match_syntax_type(S, {typefield,Name,_}, #'Externaltypereference'{}=Ref) -> 1468 match_syntax_external(S, Name, Ref); 1469match_syntax_type(_S, {variabletypevaluefield,Name,_,_}, Any) -> 1470 {match,[{Name,Any}]}; 1471match_syntax_type(_S, {variabletypevaluesetfield,Name,_,_}, Any) -> 1472 {match,[{Name,Any}]}; 1473match_syntax_type(_S, _Type, _Actual) -> 1474 throw(nomatch). 1475 1476match_syntax_params(S0, #ptypedef{name=Name}=PtDef, 1477 #'Externaltypereference'{module=M,type=N}=ERef0, Args) -> 1478 S = S0#state{mname=M,module=load_asn1_module(S0, M),tname=Name}, 1479 Type = check_type(S, PtDef, #type{def={pt,ERef0,Args}}), 1480 ERefName = new_reference_name(N), 1481 ERef = #'Externaltypereference'{type=ERefName,module=S0#state.mname}, 1482 TDef = #typedef{checked=true,name=ERefName,typespec=Type}, 1483 insert_once(S0, parameterized_objects, {ERefName,type,TDef}), 1484 asn1_db:dbput(S0#state.mname, ERef#'Externaltypereference'.type, TDef), 1485 ERef. 1486 1487match_syntax_external(#state{mname=Mname}=S0, Name, Ref0) -> 1488 {M,T0} = get_referenced_type(S0, Ref0), 1489 Ref1 = Ref0#'Externaltypereference'{module=M}, 1490 case T0 of 1491 #ptypedef{} -> 1492 {params,Name,T0,Ref1}; 1493 #typedef{checked=false}=TDef0 when Mname =/= M -> 1494 %% This typedef is an imported type (or maybe a set.asn 1495 %% compilation). 1496 S = S0#state{mname=M,module=load_asn1_module(S0, M), 1497 tname=get_datastr_name(TDef0)}, 1498 Type = check_type(S, TDef0, TDef0#typedef.typespec), 1499 TDef = TDef0#typedef{checked=true,typespec=Type}, 1500 asn1_db:dbput(M, get_datastr_name(TDef), TDef), 1501 {match,[{Name,merged_name(S, Ref1)}]}; 1502 TDef -> 1503 %% This might be a renamed type in a set of specs, 1504 %% so rename the ref. 1505 Type = asn1ct:get_name_of_def(TDef), 1506 Ref = Ref1#'Externaltypereference'{type=Type}, 1507 {match,[{Name,Ref}]} 1508 end. 1509 1510match_syntax_objset(_S, {element_set,_,_}=Set, ClassDef) -> 1511 make_objset(ClassDef, Set); 1512match_syntax_objset(S, #'Externaltypereference'{}=Ref, _) -> 1513 {_,T} = get_referenced_type(S, Ref), 1514 T; 1515match_syntax_objset(S, #'Externalvaluereference'{}=Ref, _) -> 1516 {_,T} = get_referenced_type(S, Ref), 1517 T; 1518match_syntax_objset(_, [_|_]=Set, ClassDef) -> 1519 make_objset(ClassDef, Set); 1520match_syntax_objset(S, {object,definedsyntax,Words}, ClassDef) -> 1521 case Words of 1522 [Word] -> 1523 match_syntax_objset_1(S, Word, ClassDef); 1524 [_|_] -> 1525 %% More than one word does not make sense. 1526 none 1527 end; 1528match_syntax_objset(S, #type{def=#'Externaltypereference'{}=Set}, ClassDef) -> 1529 match_syntax_objset(S, Set, ClassDef); 1530match_syntax_objset(_, #type{}, _) -> 1531 none. 1532 1533match_syntax_objset_1(S, {setting,_,Set}, ClassDef) -> 1534 %% Word that starts with an uppercase letter. 1535 match_syntax_objset(S, Set, ClassDef); 1536match_syntax_objset_1(S, {word_or_setting,_,Set}, ClassDef) -> 1537 %% Word in uppercase/hyphens only. 1538 match_syntax_objset(S, Set, ClassDef); 1539match_syntax_objset_1(S, #type{def={'TypeFromObject', {object,Object}, FNs}}, 1540 ClassDef) -> 1541 Set = extract_field(S, Object, FNs), 1542 [_|_] = Set, 1543 #typedef{checked=true,typespec=#'ObjectSet'{class=ClassDef,set=Set}}; 1544match_syntax_objset_1(_, #type{def=#'ObjectClassFieldType'{}}=Set, ClassDef) -> 1545 make_objset(ClassDef, Set); 1546match_syntax_objset_1(_, {object,_,_}=Object, ClassDef) -> 1547 make_objset(ClassDef, [Object]). 1548 1549make_objset(ClassDef, Set) -> 1550 #typedef{typespec=#'ObjectSet'{class=ClassDef,set=Set}}. 1551 1552-spec syntax_match_error(_) -> no_return(). 1553syntax_match_error(S) -> 1554 asn1_error(S, syntax_nomatch). 1555 1556-spec syntax_match_error(_, _) -> no_return(). 1557syntax_match_error(S, What0) -> 1558 What = printable_string(What0), 1559 asn1_error(S, {syntax_nomatch,What}). 1560 1561printable_string(Def) -> 1562 printable_string_1(Def). 1563 1564printable_string_1({word_or_setting,_,Def}) -> 1565 printable_string_1(Def); 1566printable_string_1({value_tag,V}) -> 1567 printable_string_1(V); 1568printable_string_1({#seqtag{val=Val1},Val2}) -> 1569 atom_to_list(Val1) ++ " " ++ printable_string_1(Val2); 1570printable_string_1(#type{def=Def}) -> 1571 atom_to_list(asn1ct_gen:get_inner(Def)); 1572printable_string_1(#'Externaltypereference'{type=Type}) -> 1573 atom_to_list(Type); 1574printable_string_1(#'Externalvaluereference'{value=Type}) -> 1575 atom_to_list(Type); 1576printable_string_1({Atom,Line}) when is_atom(Atom), is_integer(Line) -> 1577 q(Atom); 1578printable_string_1({object,definedsyntax,L}) -> 1579 Str = lists:join($\s, [printable_string_1(Item) || Item <- L]), 1580 q(lists:flatten(Str)); 1581printable_string_1([_|_]=Def) -> 1582 case lists:all(fun is_integer/1, Def) of 1583 true -> 1584 lists:flatten(io_lib:format("~p", [Def])); 1585 false -> 1586 Str = lists:join($\s, [printable_string_1(Item) || Item <- Def]), 1587 q(lists:flatten(Str)) 1588 end; 1589printable_string_1(Def) -> 1590 lists:flatten(io_lib:format("~p", [Def])). 1591 1592q(S) -> 1593 lists:concat(["\"",S,"\""]). 1594 1595check_defaultfields(S, Fields, ClassFields) -> 1596 Present = ordsets:from_list([F || {F,_} <- Fields]), 1597 Mandatory0 = get_mandatory_class_fields(ClassFields), 1598 Mandatory = ordsets:from_list(Mandatory0), 1599 All = ordsets:from_list([element(2, F) || F <- ClassFields]), 1600 #state{tname=Obj} = S, 1601 case ordsets:subtract(Present, All) of 1602 [] -> 1603 ok; 1604 [_|_]=Invalid -> 1605 asn1_error(S, {invalid_fields,Invalid,Obj}) 1606 end, 1607 case ordsets:subtract(Mandatory, Present) of 1608 [] -> 1609 check_defaultfields_1(S, Fields, ClassFields, []); 1610 [_|_]=Missing -> 1611 asn1_error(S, {missing_mandatory_fields,Missing,Obj}) 1612 end. 1613 1614check_defaultfields_1(_S, [], _ClassFields, Acc) -> 1615 {object,defaultsyntax,lists:reverse(Acc)}; 1616check_defaultfields_1(S, [{FName,Spec}|Fields], ClassFields, Acc) -> 1617 CField = lists:keyfind(FName, 2, ClassFields), 1618 {match,Match} = match_syntax_type(S, CField, Spec), 1619 check_defaultfields_1(S, Fields, ClassFields, Match++Acc). 1620 1621get_mandatory_class_fields(ClassFields) -> 1622 [element(2, F) || F <- ClassFields, 1623 is_mandatory_class_field(F)]. 1624 1625is_mandatory_class_field({fixedtypevaluefield,_,_,_,'MANDATORY'}) -> 1626 true; 1627is_mandatory_class_field({objectfield,_,_,_,'MANDATORY'}) -> 1628 true; 1629is_mandatory_class_field({objectsetfield,_,_,'MANDATORY'}) -> 1630 true; 1631is_mandatory_class_field({typefield,_,'MANDATORY'}) -> 1632 true; 1633is_mandatory_class_field({variabletypevaluefield,_,_,'MANDATORY'}) -> 1634 true; 1635is_mandatory_class_field({variabletypevaluesetfield,_,_,'MANDATORY'}) -> 1636 true; 1637is_mandatory_class_field(_) -> 1638 false. 1639 1640merged_name(#state{inputmodules=[]},ERef) -> 1641 ERef; 1642merged_name(S,ERef=#'Externaltypereference'{module=M}) -> 1643 case {S#state.mname,lists:member(M,S#state.inputmodules)} of 1644 {M,_} -> 1645 ERef; 1646 {MergeM,true} -> 1647 %% maybe the reference is renamed 1648 NewName = renamed_reference(S,ERef), 1649 ERef#'Externaltypereference'{module=MergeM,type=NewName}; 1650 {_,_} -> % i.e. M /= MergeM, not an inputmodule 1651 ERef 1652 end. 1653 1654ocft_def(#type{def=#'ObjectClassFieldType'{type=OCFT}}=T) -> 1655 case OCFT of 1656 {fixedtypevaluefield,_,InnerType} -> 1657 case asn1ct_gen:type(asn1ct_gen:get_inner(InnerType#type.def)) of 1658 Bif when Bif =:= {primitive,bif}; Bif =:= {constructed,bif} -> 1659 #typedef{checked=true,name=Bif,typespec=InnerType}; 1660 #'Externaltypereference'{}=Ref -> 1661 Ref 1662 end; 1663 'ASN1_OPEN_TYPE' -> 1664 #typedef{checked=true,typespec=T#type{def='ASN1_OPEN_TYPE'}} 1665 end. 1666 1667check_value(OldS,V) when is_record(V,pvaluesetdef) -> 1668 #pvaluesetdef{checked=Checked,type=Type} = V, 1669 case Checked of 1670 true -> V; 1671 {error,_} -> V; 1672 false -> 1673 case get_referenced_type(OldS,Type#type.def) of 1674 {_,Class} when is_record(Class,classdef) -> 1675 throw({pobjectsetdef}); 1676 _ -> continue 1677 end 1678 end; 1679check_value(_OldS,V) when is_record(V,pvaluedef) -> 1680 %% Fix this case later 1681 V; 1682check_value(OldS,V) when is_record(V,typedef) -> 1683 %% This case when a value set has been parsed as an object set. 1684 %% It may be a value set 1685 ?dbg("check_value, V: ~p~n",[V]), 1686 #typedef{typespec=TS} = V, 1687 case TS of 1688 #'ObjectSet'{class=ClassRef} -> 1689 {_RefM,TSDef} = get_referenced_type(OldS, ClassRef), 1690 case TSDef of 1691 #classdef{} -> throw({objectsetdef}); 1692 #typedef{typespec=#type{def=Eref}} when 1693 is_record(Eref,'Externaltypereference') -> 1694 %% This case if the class reference is a defined 1695 %% reference to class 1696 check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}}); 1697 #typedef{typespec=HostType} -> 1698 %% an ordinary value set with a type in #typedef.typespec 1699 ValueSet0 = TS#'ObjectSet'.set, 1700 Constr = check_constraints(OldS, HostType, [ValueSet0]), 1701 Type = check_type(OldS,TSDef,TSDef#typedef.typespec), 1702 {valueset,Type#type{constraint=Constr}} 1703 end; 1704 _ -> 1705 throw({objectsetdef}) 1706 end; 1707check_value(S,#valuedef{pos=Pos,name=Name,type=Type, 1708 value={valueset,Constr}}) -> 1709 NewType = Type#type{constraint=[Constr]}, 1710 {valueset, 1711 check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)}; 1712check_value(S, #valuedef{}=V) -> 1713 ?dbg("check_value, V: ~p~n",[V]), 1714 case V of 1715 #valuedef{checked=true} -> 1716 V; 1717 #valuedef{checked=false} -> 1718 check_valuedef(S, V) 1719 end. 1720 1721check_valuedef(#state{recordtopname=TopName}=S0, V0) -> 1722 #valuedef{name=Name,type=Vtype0,value=Value,module=ModName} = V0, 1723 V = V0#valuedef{checked=true}, 1724 Vtype1 = expand_valuedef_type(Vtype0), 1725 Vtype = check_type(S0, #typedef{name=Name,typespec=Vtype1},Vtype1), 1726 Def = Vtype#type.def, 1727 S1 = S0#state{tname=Def}, 1728 SVal = update_state(S1, ModName), 1729 case Def of 1730 #'Externaltypereference'{type=RecName}=Ext -> 1731 {RefM,Type} = get_referenced_type(S1, Ext), 1732 %% If V isn't a value but an object Type is a #classdef{} 1733 S2 = update_state(S1, RefM), 1734 case Type of 1735 #typedef{typespec=TypeSpec0}=TypeDef -> 1736 TypeSpec = check_type(S2, TypeDef, TypeSpec0), 1737 S3 = case is_contextswitchtype(Type) of 1738 true -> 1739 S2; 1740 false -> 1741 S2#state{recordtopname=[RecName|TopName]} 1742 end, 1743 #valuedef{value=CheckedVal} = 1744 check_value(S3, V0#valuedef{type=TypeSpec}), 1745 V#valuedef{value=CheckedVal}; 1746 #type{} -> 1747 %% A parameter that couldn't be categorized. 1748 #valuedef{value=CheckedVal} = 1749 check_value(S2#state{recordtopname=[RecName|TopName]}, 1750 V#valuedef{type=Type}), 1751 V#valuedef{value=CheckedVal} 1752 end; 1753 'ASN1_OPEN_TYPE' -> 1754 {opentypefieldvalue,ANYType,ANYValue} = Value, 1755 CheckedV = check_value(SVal,#valuedef{name=Name, 1756 type=ANYType, 1757 value=ANYValue, 1758 module=ModName}), 1759 V#valuedef{value=CheckedV#valuedef.value}; 1760 'INTEGER' -> 1761 V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; 1762 {'INTEGER',_NamedNumberList} -> 1763 V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; 1764 #'SEQUENCE'{} -> 1765 {ok,SeqVal} = convert_external(SVal, Vtype, Value), 1766 V#valuedef{value=normalize_value(SVal, Vtype, SeqVal, TopName)}; 1767 _ -> 1768 V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)} 1769 end. 1770 1771expand_valuedef_type(#type{def=Seq}=Type) 1772 when is_record(Seq,'SEQUENCE') -> 1773 NewComponents = case Seq#'SEQUENCE'.components of 1774 {R1,_Ext,R2} -> R1 ++ R2; 1775 {Root,_Ext} -> Root; 1776 Root -> take_only_rootset(Root) 1777 end, 1778 NewSeq = Seq#'SEQUENCE'{components = NewComponents}, 1779 Type#type{def=NewSeq}; 1780expand_valuedef_type(#type{def=Set}=Type) 1781 when is_record(Set,'SET') -> 1782 NewComponents = case Set#'SET'.components of 1783 {R1,_Ext,R2} -> R1 ++ R2; 1784 {Root,_Ext} -> Root; 1785 Root -> take_only_rootset(Root) 1786 end, 1787 NewSet = Set#'SET'{components = NewComponents}, 1788 Type#type{def=NewSet}; 1789expand_valuedef_type(Type) -> 1790 Type. 1791 1792is_contextswitchtype(#typedef{name='EXTERNAL'})-> 1793 true; 1794is_contextswitchtype(#typedef{name='EMBEDDED PDV'}) -> 1795 true; 1796is_contextswitchtype(#typedef{name='CHARACTER STRING'}) -> 1797 true; 1798is_contextswitchtype(_) -> 1799 false. 1800 1801%%% 1802%%% Start of OBJECT IDENTFIER/RELATIVE-OID validation. 1803%%% 1804 1805validate_objectidentifier(S, OidType, #'Externalvaluereference'{}=Id) -> 1806 %% Must be an OBJECT IDENTIFIER or RELATIVE-OID depending on OidType. 1807 get_oid_value(S, OidType, false, Id); 1808validate_objectidentifier(S, OidType, {'ValueFromObject',{object,Obj},Fields}) -> 1809 %% Must be an OBJECT IDENTIFIER/RELATIVE-OID depending on OidType. 1810 case extract_field(S, Obj, Fields) of 1811 #valuedef{checked=true,value=Value,type=Type} when is_tuple(Value) -> 1812 _ = get_oid_type(S, OidType, Type), 1813 Value; 1814 _ -> 1815 asn1_error(S, {illegal_oid,OidType}) 1816 end; 1817validate_objectidentifier(S, OidType, 1818 [{#seqtag{module=Mod,pos=Pos,val=Atom},Val}]) -> 1819 %% This case is when an OBJECT IDENTIFIER value has been parsed as a 1820 %% SEQUENCE value. 1821 Rec = #'Externalvaluereference'{pos=Pos, 1822 module=Mod, 1823 value=Atom}, 1824 validate_oid(S, OidType, [Rec,Val], []); 1825validate_objectidentifier(S, OidType, [_|_]=L0) -> 1826 validate_oid(S, OidType, L0, []); 1827validate_objectidentifier(S, OidType, _) -> 1828 asn1_error(S, {illegal_oid,OidType}). 1829 1830get_oid_value(S, OidType, AllowInteger, #'Externalvaluereference'{}=Id) -> 1831 case get_referenced_type(S, Id) of 1832 {_,#valuedef{checked=Checked,type=Type,value=V}} -> 1833 case get_oid_type(S, OidType, Type) of 1834 'INTEGER' when not AllowInteger -> 1835 asn1_error(S, {illegal_oid,OidType}); 1836 _ when Checked -> 1837 V; 1838 'INTEGER' -> 1839 V; 1840 _ -> 1841 validate_objectidentifier(S, OidType, V) 1842 end; 1843 _ -> 1844 asn1_error(S, {illegal_oid,OidType}) 1845 end. 1846 1847validate_oid(S, OidType, [], Acc) -> 1848 Oid = lists:reverse(Acc), 1849 validate_oid_path(S, OidType, Oid), 1850 list_to_tuple(Oid); 1851validate_oid(S, OidType, [Value|Vrest], Acc) when is_integer(Value) -> 1852 validate_oid(S, OidType, Vrest, [Value|Acc]); 1853validate_oid(S, OidType, [{'NamedNumber',_Name,Value}|Vrest], Acc) 1854 when is_integer(Value) -> 1855 validate_oid(S, OidType, Vrest, [Value|Acc]); 1856validate_oid(S, OidType, [#'Externalvaluereference'{}=Id|Vrest], Acc) -> 1857 NeededOidType = case Acc of 1858 [] -> o_id; 1859 [_|_] -> rel_oid 1860 end, 1861 try get_oid_value(S, NeededOidType, true, Id) of 1862 Val when is_integer(Val) -> 1863 validate_oid(S, OidType, Vrest, [Val|Acc]); 1864 Val when is_tuple(Val) -> 1865 L = tuple_to_list(Val), 1866 validate_oid(S, OidType, Vrest, lists:reverse(L, Acc)) 1867 catch 1868 _:_ -> 1869 case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of 1870 Value when is_integer(Value) -> 1871 validate_oid(S, OidType,Vrest, [Value|Acc]); 1872 false -> 1873 asn1_error(S, {illegal_oid,OidType}) 1874 end 1875 end; 1876validate_oid(S, OidType, _V, _Acc) -> 1877 asn1_error(S, {illegal_oid,OidType}). 1878 1879get_oid_type(S, OidType, #type{def=Def}) -> 1880 get_oid_type(S, OidType, Def); 1881get_oid_type(S, OidType, #'Externaltypereference'{}=Id) -> 1882 {_,OI} = get_referenced_type(S, Id), 1883 get_oid_type(S, OidType, OI#typedef.typespec); 1884get_oid_type(_S, o_id, 'OBJECT IDENTIFIER'=T) -> 1885 T; 1886get_oid_type(_S, rel_oid, 'RELATIVE-OID'=T) -> 1887 T; 1888get_oid_type(_S, _, 'INTEGER'=T) -> 1889 T; 1890get_oid_type(S, OidType, _) -> 1891 asn1_error(S, {illegal_oid,OidType}). 1892 1893%% ITU-T Rec. X.680 Annex B - D 1894reserved_objectid('itu-t',[]) -> 0; 1895reserved_objectid('ccitt',[]) -> 0; 1896%% arcs below "itu-t" 1897reserved_objectid('recommendation',[0]) -> 0; 1898reserved_objectid('question',[0]) -> 1; 1899reserved_objectid('administration',[0]) -> 2; 1900reserved_objectid('network-operator',[0]) -> 3; 1901reserved_objectid('identified-organization',[0]) -> 4; 1902%% arcs below "recommendation" 1903reserved_objectid('a',[0,0]) -> 1; 1904reserved_objectid('b',[0,0]) -> 2; 1905reserved_objectid('c',[0,0]) -> 3; 1906reserved_objectid('d',[0,0]) -> 4; 1907reserved_objectid('e',[0,0]) -> 5; 1908reserved_objectid('f',[0,0]) -> 6; 1909reserved_objectid('g',[0,0]) -> 7; 1910reserved_objectid('h',[0,0]) -> 8; 1911reserved_objectid('i',[0,0]) -> 9; 1912reserved_objectid('j',[0,0]) -> 10; 1913reserved_objectid('k',[0,0]) -> 11; 1914reserved_objectid('l',[0,0]) -> 12; 1915reserved_objectid('m',[0,0]) -> 13; 1916reserved_objectid('n',[0,0]) -> 14; 1917reserved_objectid('o',[0,0]) -> 15; 1918reserved_objectid('p',[0,0]) -> 16; 1919reserved_objectid('q',[0,0]) -> 17; 1920reserved_objectid('r',[0,0]) -> 18; 1921reserved_objectid('s',[0,0]) -> 19; 1922reserved_objectid('t',[0,0]) -> 20; 1923reserved_objectid('u',[0,0]) -> 21; 1924reserved_objectid('v',[0,0]) -> 22; 1925reserved_objectid('w',[0,0]) -> 23; 1926reserved_objectid('x',[0,0]) -> 24; 1927reserved_objectid('y',[0,0]) -> 25; 1928reserved_objectid('z',[0,0]) -> 26; 1929 1930reserved_objectid(iso,[]) -> 1; 1931%% arcs below "iso", note that number 1 is not used 1932reserved_objectid('standard',[1]) -> 0; 1933reserved_objectid('member-body',[1]) -> 2; 1934reserved_objectid('identified-organization',[1]) -> 3; 1935 1936reserved_objectid('joint-iso-itu-t',[]) -> 2; 1937reserved_objectid('joint-iso-ccitt',[]) -> 2; 1938 1939reserved_objectid(_,_) -> false. 1940 1941validate_oid_path(_, rel_oid, _) -> 1942 ok; 1943validate_oid_path(_, o_id, [0,I|_]) when 0 =< I, I =< 9 -> 1944 ok; 1945validate_oid_path(_, o_id, [1,I|_]) when 0 =< I, I =< 3 -> 1946 ok; 1947validate_oid_path(_, o_id, [2|_]) -> 1948 ok; 1949validate_oid_path(S, o_id=OidType, _) -> 1950 asn1_error(S, {illegal_oid,OidType}). 1951 1952%%% 1953%%% End of OBJECT IDENTFIER/RELATIVE-OID validation. 1954%%% 1955 1956convert_external(S, Vtype, Value) -> 1957 case Vtype of 1958 #type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} -> 1959 %% this is an 'EXTERNAL' (or INSTANCE OF) 1960 case Value of 1961 [{#seqtag{val=identification},_}|_] -> 1962 {ok,to_EXTERNAL1990(S, Value)}; 1963 _ -> 1964 {ok,Value} 1965 end; 1966 _ -> 1967 {ok,Value} 1968 end. 1969 1970to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, 1971 {'CHOICE',{syntax,Stx}}}|Rest]) -> 1972 to_EXTERNAL1990(S, Rest, [{T#seqtag{val='direct-reference'},Stx}]); 1973to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, 1974 {'CHOICE',{'presentation-context-id',I}}}|Rest]) -> 1975 to_EXTERNAL1990(S, Rest, [{T#seqtag{val='indirect-reference'},I}]); 1976to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, 1977 {'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) -> 1978 to_EXTERNAL1990(S, Rest, [{T#seqtag{val='indirect-reference'},PCid}, 1979 {T#seqtag{val='direct-reference'},TrStx}]); 1980to_EXTERNAL1990(S, _) -> 1981 asn1_error(S, illegal_external_value). 1982 1983to_EXTERNAL1990(S, [V={#seqtag{val='data-value-descriptor'},_}|Rest], Acc) -> 1984 to_EXTERNAL1990(S, Rest, [V|Acc]); 1985to_EXTERNAL1990(_S, [{#seqtag{val='data-value'}=T,Val}], Acc) -> 1986 Encoding = {T#seqtag{val=encoding},{'CHOICE',{'octet-aligned',Val}}}, 1987 lists:reverse([Encoding|Acc]); 1988to_EXTERNAL1990(S, _, _) -> 1989 asn1_error(S, illegal_external_value). 1990 1991%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1992%% Functions to normalize the default values of SEQUENCE 1993%% and SET components into Erlang valid format 1994%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1995normalize_value(_,_,mandatory,_) -> 1996 mandatory; 1997normalize_value(_,_,'OPTIONAL',_) -> 1998 'OPTIONAL'; 1999normalize_value(S, Type, {'DEFAULT',Value}, NameList) -> 2000 case catch get_canonic_type(S,Type,NameList) of 2001 {'BOOLEAN',CType,_} -> 2002 normalize_boolean(S,Value,CType); 2003 {'INTEGER',CType,_} -> 2004 normalize_integer(S, Value, CType); 2005 {'BIT STRING',CType,_} -> 2006 normalize_bitstring(S,Value,CType); 2007 {'OCTET STRING',_,_} -> 2008 normalize_octetstring(S, Value); 2009 {'NULL',_CType,_} -> 2010 %%normalize_null(Value); 2011 'NULL'; 2012 {'RELATIVE-OID',_,_} -> 2013 normalize_relative_oid(S,Value); 2014 {'OBJECT IDENTIFIER',_,_} -> 2015 normalize_objectidentifier(S,Value); 2016 {'ObjectDescriptor',_,_} -> 2017 normalize_objectdescriptor(Value); 2018 {'REAL',_,_} -> 2019 normalize_real(Value); 2020 {'ENUMERATED',CType,_} -> 2021 normalize_enumerated(S,Value,CType); 2022 {'CHOICE',CType,NewNameList} -> 2023 ChoiceComponents = get_choice_components(S, {'CHOICE',CType}), 2024 normalize_choice(S,Value,ChoiceComponents,NewNameList); 2025 {'SEQUENCE',CType,NewNameList} -> 2026 normalize_sequence(S,Value,CType,NewNameList); 2027 {'SEQUENCE OF',CType,NewNameList} -> 2028 normalize_seqof(S,Value,CType,NewNameList); 2029 {'SET',CType,NewNameList} -> 2030 normalize_set(S,Value,CType,NewNameList); 2031 {'SET OF',CType,NewNameList} -> 2032 normalize_setof(S,Value,CType,NewNameList); 2033 {restrictedstring,CType,_} -> 2034 normalize_restrictedstring(S,Value,CType); 2035 {'ASN1_OPEN_TYPE',{typefield,_TF},NL} -> %an open type 2036 normalize_objectclassfieldvalue(S,Value,NL); 2037 Err -> 2038 asn1ct:warning("could not check default value ~p~nType:~n~p~nNameList:~n~p~n", 2039 [Value,Type,Err],S,"could not check default value"), 2040 Value 2041 end; 2042normalize_value(S,Type,Val,NameList) -> 2043 normalize_value(S,Type,{'DEFAULT',Val},NameList). 2044 2045normalize_boolean(_,true,_) -> 2046 true; 2047normalize_boolean(_,false,_) -> 2048 false; 2049normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) -> 2050 get_normalized_value(S,Bool,CType,fun normalize_boolean/3,[]); 2051normalize_boolean(S, _, _) -> 2052 asn1_error(S, {illegal_value, "BOOLEAN"}). 2053 2054normalize_integer(_S, Int, _) when is_integer(Int) -> 2055 Int; 2056normalize_integer(S, #'Externalvaluereference'{value=Name}=Ref, NNL) -> 2057 case lists:keyfind(Name, 1, NNL) of 2058 {Name,Val} -> 2059 Val; 2060 false -> 2061 try get_referenced_value(S, Ref) of 2062 Val when is_integer(Val) -> 2063 Val; 2064 _ -> 2065 asn1_error(S, illegal_integer_value) 2066 catch 2067 throw:_ -> 2068 asn1_error(S, illegal_integer_value) 2069 end 2070 end; 2071normalize_integer(S, {'ValueFromObject',{object,Obj},FieldNames}, _) -> 2072 case extract_field(S, Obj, FieldNames) of 2073 #valuedef{value=Val} when is_integer(Val) -> 2074 Val; 2075 _ -> 2076 asn1_error(S, illegal_integer_value) 2077 end; 2078normalize_integer(S, _, _) -> 2079 asn1_error(S, illegal_integer_value). 2080 2081%% normalize_bitstring(S, Value, Type) -> bitstring() 2082%% Convert a literal value for a BIT STRING to an Erlang bit string. 2083%% 2084normalize_bitstring(S, Value, Type)-> 2085 case Value of 2086 {hstring,String} when is_list(String) -> 2087 hstring_to_bitstring(String); 2088 {bstring,String} when is_list(String) -> 2089 bstring_to_bitstring(String); 2090 #'Externalvaluereference'{} -> 2091 Val = get_referenced_value(S, Value), 2092 normalize_bitstring(S, Val, Type); 2093 {'ValueFromObject',{object,Obj},FieldNames} -> 2094 case extract_field(S, Obj, FieldNames) of 2095 #valuedef{value=Val} -> 2096 normalize_bitstring(S, Val, Type); 2097 _ -> 2098 asn1_error(S, {illegal_value, "BIT STRING"}) 2099 end; 2100 RecList when is_list(RecList) -> 2101 [normalize_bs_item(S, Item, Type) || Item <- RecList]; 2102 Bs when is_bitstring(Bs) -> 2103 %% Already normalized. 2104 Bs; 2105 _ -> 2106 asn1_error(S, {illegal_value, "BIT STRING"}) 2107 end. 2108 2109normalize_bs_item(S, #'Externalvaluereference'{value=Name}, Type) -> 2110 case lists:keymember(Name, 1, Type) of 2111 true -> Name; 2112 false -> asn1_error(S, {illegal_value, "BIT STRING"}) 2113 end; 2114normalize_bs_item(_, Atom, _) when is_atom(Atom) -> 2115 Atom; 2116normalize_bs_item(S, _, _) -> 2117 asn1_error(S, {illegal_value, "BIT STRING"}). 2118 2119hstring_to_binary(L) -> 2120 byte_align(hstring_to_bitstring(L)). 2121 2122bstring_to_binary(L) -> 2123 byte_align(bstring_to_bitstring(L)). 2124 2125byte_align(Bs) -> 2126 case bit_size(Bs) rem 8 of 2127 0 -> Bs; 2128 N -> <<Bs/bitstring,0:(8-N)>> 2129 end. 2130 2131hstring_to_bitstring(L) -> 2132 << <<(hex_to_int(D)):4>> || D <- L >>. 2133 2134bstring_to_bitstring(L) -> 2135 << <<(D-$0):1>> || D <- L >>. 2136 2137hex_to_int(D) when $0 =< D, D =< $9 -> D - $0; 2138hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10). 2139 2140%% normalize_octetstring/1 changes representation of input Value to a 2141%% list of octets. 2142%% Format of Value is one of: 2143%% {bstring,String} each element in String corresponds to one bit in an octet 2144%% {hstring,String} each element in String corresponds to one byte in an octet 2145%% #'Externalvaluereference' 2146normalize_octetstring(S, Value) -> 2147 case Value of 2148 {bstring,String} -> 2149 bstring_to_binary(String); 2150 {hstring,String} -> 2151 hstring_to_binary(String); 2152 #'Externalvaluereference'{} -> 2153 case get_referenced_value(S, Value) of 2154 String when is_binary(String) -> 2155 String; 2156 Other -> 2157 normalize_octetstring(S, Other) 2158 end; 2159 {'ValueFromObject',{object,Obj},FieldNames} -> 2160 case extract_field(S, Obj, FieldNames) of 2161 #valuedef{value=Val} when is_binary(Val) -> 2162 Val; 2163 _ -> 2164 asn1_error(S, illegal_octet_string_value) 2165 end; 2166 Val when is_binary(Val) -> 2167 %% constant default value 2168 Val; 2169 _ -> 2170 asn1_error(S, illegal_octet_string_value) 2171 end. 2172 2173normalize_objectidentifier(S, Value) -> 2174 validate_objectidentifier(S, o_id, Value). 2175 2176normalize_relative_oid(S, Value) -> 2177 validate_objectidentifier(S, rel_oid, Value). 2178 2179normalize_objectdescriptor(Value) -> 2180 Value. 2181 2182normalize_real(Value) -> 2183 Value. 2184 2185normalize_enumerated(S, Id0, NNL) -> 2186 {Id,_} = lookup_enum_value(S, Id0, NNL), 2187 Id. 2188 2189lookup_enum_value(S, Id, {Base,Ext}) -> 2190 %% Extensible ENUMERATED. 2191 lookup_enum_value(S, Id, Base++Ext); 2192lookup_enum_value(S, #'Externalvaluereference'{value=Id}, NNL) -> 2193 lookup_enum_value(S, Id, NNL); 2194lookup_enum_value(S, Id, NNL) when is_atom(Id) -> 2195 case lists:keyfind(Id, 1, NNL) of 2196 {_,_}=Ret -> 2197 Ret; 2198 false -> 2199 asn1_error(S, {undefined,Id}) 2200 end. 2201 2202normalize_choice(S, {'CHOICE',{C,V}}, CType, NameList) 2203 when is_atom(C) -> 2204 case lists:keyfind(C, #'ComponentType'.name, CType) of 2205 #'ComponentType'{typespec=CT,name=Name} -> 2206 {C,normalize_value(S, CT, {'DEFAULT',V}, [Name|NameList])}; 2207 false -> 2208 asn1_error(S, {illegal_id,C}) 2209 end; 2210normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList) 2211 when is_atom(Name) -> 2212 normalize_choice(S,{'CHOICE',CV},CType,NameList); 2213normalize_choice(S, V, _CType, _NameList) -> 2214 asn1_error(S, {illegal_id, error_value(V)}). 2215 2216normalize_sequence(S,Value,Components,NameList) 2217 when is_tuple(Components) -> 2218 normalize_sequence(S,Value,lists:flatten(tuple_to_list(Components)), 2219 NameList); 2220normalize_sequence(S,{Name,Value},Components,NameList) 2221 when is_atom(Name),is_list(Value) -> 2222 normalize_sequence(S,Value,Components,NameList); 2223normalize_sequence(S,Value,Components,NameList) -> 2224 normalized_record('SEQUENCE',S,Value,Components,NameList). 2225 2226normalize_set(S,Value,Components,NameList) when is_tuple(Components) -> 2227 normalize_set(S,Value,lists:flatten(tuple_to_list(Components)),NameList); 2228normalize_set(S,{Name,Value},Components,NameList) 2229 when is_atom(Name),is_list(Value) -> 2230 normalized_record('SET',S,Value,Components,NameList); 2231normalize_set(S,Value,Components,NameList) -> 2232 NewName = list_to_atom(asn1ct_gen:list2name(NameList)), 2233 case is_record_normalized(S,NewName,Value,length(Components)) of 2234 true -> 2235 Value; 2236 _ -> 2237 SortedVal = sort_value(Components,Value), 2238 normalized_record('SET',S,SortedVal,Components,NameList) 2239 end. 2240 2241sort_value(Components, Value0) when is_list(Value0) -> 2242 {Keys0,_} = lists:mapfoldl(fun(#'ComponentType'{name=N}, I) -> 2243 {{N,I},I+1} 2244 end, 0, Components), 2245 Keys = gb_trees:from_orddict(orddict:from_list(Keys0)), 2246 Value1 = [{case gb_trees:lookup(N, Keys) of 2247 {value,K} -> K; 2248 none -> 'end' 2249 end,Pair} || {#seqtag{val=N},_}=Pair <- Value0], 2250 Value = lists:sort(Value1), 2251 [Pair || {_,Pair} <- Value]; 2252sort_value(_Components, #'Externalvaluereference'{}=Value) -> 2253 %% Sort later. 2254 Value. 2255 2256sort_val_if_set(['SET'|_],Val,Type) -> 2257 sort_value(Type,Val); 2258sort_val_if_set(_,Val,_) -> 2259 Val. 2260 2261normalized_record(SorS,S,Value,Components,NameList) -> 2262 NewName = list_to_atom(lists:concat([get_record_prefix_name(S), 2263 asn1ct_gen:list2name(NameList)])), 2264 case is_record_normalized(S,NewName,Value,length(Components)) of 2265 true -> 2266 Value; 2267 false -> 2268 NoComps = length(Components), 2269 ListOfVals = normalize_seq_or_set(SorS,S,Value,Components,NameList,[]), 2270 NoComps = length(ListOfVals), %Assertion. 2271 case use_maps(S) of 2272 false -> 2273 list_to_tuple([NewName|ListOfVals]); 2274 true -> 2275 create_map_value(Components, ListOfVals) 2276 end 2277 end. 2278 2279is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> 2280 case get_referenced_type(S,V) of 2281 {_M,#valuedef{type=_T1,value=V2}} -> 2282 is_record_normalized(S,Name,V2,NumComps); 2283 _ -> false 2284 end; 2285is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> 2286 (tuple_size(Value) =:= (NumComps + 1)) andalso (element(1, Value) =:= Name); 2287is_record_normalized(_S, _Name, Value, _NumComps) when is_map(Value) -> 2288 true; 2289is_record_normalized(_,_,_,_) -> 2290 false. 2291 2292use_maps(#state{options=Opts}) -> 2293 lists:member(maps, Opts). 2294 2295create_map_value(Components, ListOfVals) -> 2296 Zipped = lists:zip(Components, ListOfVals), 2297 L = [{Name,V} || {#'ComponentType'{name=Name},V} <- Zipped, 2298 V =/= asn1_NOVALUE], 2299 maps:from_list(L). 2300 2301normalize_seq_or_set(SorS, S, 2302 [{#seqtag{val=Cname},V}|Vs], 2303 [#'ComponentType'{name=Cname,typespec=TS}|Cs], 2304 NameList, Acc) -> 2305 NewNameList = 2306 case TS#type.def of 2307 #'Externaltypereference'{type=TName} -> 2308 [TName]; 2309 _ -> [Cname|NameList] 2310 end, 2311 NVal = normalize_value(S,TS,{'DEFAULT',V},NewNameList), 2312 normalize_seq_or_set(SorS,S,Vs,Cs,NameList,[NVal|Acc]); 2313normalize_seq_or_set(SorS, S, 2314 Values=[{#seqtag{val=Cname0},_V}|_Vs], 2315 [#'ComponentType'{prop='OPTIONAL'}|Cs], 2316 NameList, Acc) -> 2317 verify_valid_component(S, Cname0, Cs), 2318 normalize_seq_or_set(SorS,S,Values,Cs,NameList,[asn1_NOVALUE|Acc]); 2319normalize_seq_or_set(SorS, S, 2320 Values=[{#seqtag{val=Cname0},_V}|_Vs], 2321 [#'ComponentType'{name=Cname,typespec=TS, 2322 prop={'DEFAULT',Value}}|Cs], 2323 NameList, Acc) -> 2324 verify_valid_component(S, Cname0, Cs), 2325 NewNameList = 2326 case TS#type.def of 2327 #'Externaltypereference'{type=TName} -> 2328 [TName]; 2329 _ -> [Cname|NameList] 2330 end, 2331 NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), 2332 normalize_seq_or_set(SorS,S,Values,Cs,NameList,[NVal|Acc]); 2333%% If default value is {} ComponentTypes in SEQUENCE are marked DEFAULT 2334%% or OPTIONAL (or the type is defined SEQUENCE{}, which is handled by 2335%% the previous case). 2336normalize_seq_or_set(SorS,S,[], 2337 [#'ComponentType'{name=Name,typespec=TS, 2338 prop={'DEFAULT',Value}}|Cs], 2339 NameList,Acc) -> 2340 NewNameList = 2341 case TS#type.def of 2342 #'Externaltypereference'{type=TName} -> 2343 [TName]; 2344 _ -> [Name|NameList] 2345 end, 2346 NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), 2347 normalize_seq_or_set(SorS,S,[],Cs,NameList,[NVal|Acc]); 2348normalize_seq_or_set(SorS,S,[],[#'ComponentType'{prop='OPTIONAL'}|Cs], 2349 NameList,Acc) -> 2350 normalize_seq_or_set(SorS,S,[],Cs,NameList,[asn1_NOVALUE|Acc]); 2351normalize_seq_or_set(SorS,S,Value=#'Externalvaluereference'{}, 2352 Cs,NameList,Acc) -> 2353 get_normalized_value(S,Value,Cs,fun normalize_seq_or_set/6, 2354 [SorS,NameList,Acc]); 2355normalize_seq_or_set(_SorS, _S, [], [], _, Acc) -> 2356 lists:reverse(Acc); 2357normalize_seq_or_set(_SorS, S, V, Cs, _, _) -> 2358 case V of 2359 [{#seqtag{val=Name},_}|_] -> 2360 asn1_error(S, {illegal_id,error_value(Name)}); 2361 [] -> 2362 [#'ComponentType'{name=Name}|_] = Cs, 2363 asn1_error(S, {missing_id,error_value(Name)}) 2364 end. 2365 2366verify_valid_component(S, Name, Cs) -> 2367 case lists:keyfind(Name, #'ComponentType'.name, Cs) of 2368 false -> asn1_error(S, {illegal_id,error_value(Name)}); 2369 #'ComponentType'{} -> ok 2370 end. 2371 2372normalize_seqof(S,Value,Type,NameList) -> 2373 normalize_s_of('SEQUENCE OF',S,Value,Type,NameList). 2374 2375normalize_setof(S,Value,Type,NameList) -> 2376 normalize_s_of('SET OF',S,Value,Type,NameList). 2377 2378normalize_s_of(SorS,S,Value,Type,NameList) when is_list(Value) -> 2379 DefValueList = lists:map(fun(X) -> {'DEFAULT',X} end,Value), 2380 Suffix = asn1ct_gen:constructed_suffix(SorS,Type), 2381 Def = Type#type.def, 2382 InnerType = asn1ct_gen:get_inner(Def), 2383 WhatKind = asn1ct_gen:type(InnerType), 2384 NewNameList = 2385 case WhatKind of 2386 {constructed,bif} -> 2387 [Suffix|NameList]; 2388 #'Externaltypereference'{type=Name} -> 2389 [Name]; 2390 _ -> [] 2391 end, 2392 NormFun = fun (X) -> normalize_value(S,Type,X, 2393 NewNameList) end, 2394 case catch lists:map(NormFun, DefValueList) of 2395 List when is_list(List) -> 2396 List; 2397 _ -> 2398 asn1ct:warning("~p could not handle value ~p~n",[SorS,Value],S, 2399 "could not handle value"), 2400 Value 2401 end; 2402normalize_s_of(SorS,S,Value,Type,NameList) 2403 when is_record(Value,'Externalvaluereference') -> 2404 get_normalized_value(S,Value,Type,fun normalize_s_of/5, 2405 [SorS,NameList]). 2406 2407 2408%% normalize_restrictedstring handles all format of restricted strings. 2409%% character string list case 2410normalize_restrictedstring(S,[H|T],CType) when is_list(H);is_tuple(H) -> 2411 [normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)]; 2412%% character sting case 2413normalize_restrictedstring(_S,CString,_) when is_list(CString) -> 2414 CString; 2415%% definedvalue case or argument in a parameterized type 2416normalize_restrictedstring(S,ERef,CType) when is_record(ERef,'Externalvaluereference') -> 2417 get_normalized_value(S,ERef,CType, 2418 fun normalize_restrictedstring/3,[]). 2419 2420normalize_objectclassfieldvalue(S,{opentypefieldvalue,Type,Value},NameList) -> 2421 %% An open type has per definition no type. Thus should the type 2422 %% information of the default type be available at 2423 %% encode/decode. But as encoding the default value causes special 2424 %% treatment (no encoding) whatever type is used the type 2425 %% information is not necessary in encode/decode. 2426 normalize_value(S,Type,Value,NameList); 2427normalize_objectclassfieldvalue(_S,Other,_NameList) -> 2428 %% If the type info was thrown away in an earlier step the value 2429 %% is already normalized. 2430 Other. 2431 2432get_normalized_value(S,Val,Type,Func,AddArg) -> 2433 case catch get_referenced_type(S,Val) of 2434 {ExtM,_VDef = #valuedef{type=_T1,value=V}} -> 2435 %% should check that Type and T equals 2436 V2 = sort_val_if_set(AddArg,V,Type), 2437 call_Func(update_state(S,ExtM),V2,Type,Func,AddArg); 2438 {error,_} -> 2439 asn1ct:warning("default value not comparable ~p~n",[Val],S), 2440 Val; 2441 {ExtM,NewVal} -> 2442 V2 = sort_val_if_set(AddArg,NewVal,Type), 2443 call_Func(update_state(S,ExtM),V2,Type,Func,AddArg); 2444 _ -> 2445 asn1ct:warning("default value not comparable ~p~n",[Val],S, 2446 "default value not comparable"), 2447 Val 2448 end. 2449 2450call_Func(S,Val,Type,Func,ArgList) -> 2451 case ArgList of 2452 [] -> 2453 Func(S,Val,Type); 2454 [LastArg] -> 2455 Func(S,Val,Type,LastArg); 2456 [Arg1,LastArg1] -> 2457 Func(Arg1,S,Val,Type,LastArg1); 2458 [Arg1,LastArg1,LastArg2] -> 2459 Func(Arg1,S,Val,Type,LastArg1,LastArg2) 2460 end. 2461 2462 2463get_canonic_type(S,Type,NameList) -> 2464 {InnerType,NewType,NewNameList} = 2465 case Type#type.def of 2466 'INTEGER'=Name -> 2467 {Name,[],NameList}; 2468 Name when is_atom(Name) -> 2469 {Name,Type,NameList}; 2470 Ref when is_record(Ref,'Externaltypereference') -> 2471 {_,#typedef{name=Name,typespec=RefedType}} = 2472 get_referenced_type(S,Ref), 2473 get_canonic_type(S,RefedType,[Name]); 2474 {Name,T} when is_atom(Name) -> 2475 {Name,T,NameList}; 2476 Seq when is_record(Seq,'SEQUENCE') -> 2477 {'SEQUENCE',Seq#'SEQUENCE'.components,NameList}; 2478 Set when is_record(Set,'SET') -> 2479 {'SET',Set#'SET'.components,NameList}; 2480 #'ObjectClassFieldType'{type=T} -> 2481 {'ASN1_OPEN_TYPE',T,NameList} 2482 end, 2483 {asn1ct_gen:unify_if_string(InnerType),NewType,NewNameList}. 2484 2485 2486 2487check_ptype(S,Type,Ts) when is_record(Ts,type) -> 2488 check_formal_parameters(S, Type#ptypedef.args), 2489 Def = Ts#type.def, 2490 NewDef= 2491 case Def of 2492 Seq when is_record(Seq,'SEQUENCE') -> 2493 Components = expand_components(S,Seq#'SEQUENCE'.components), 2494 #newt{type=Seq#'SEQUENCE'{pname=get_datastr_name(Type), 2495 components = Components}}; 2496 Set when is_record(Set,'SET') -> 2497 Components = expand_components(S,Set#'SET'.components), 2498 #newt{type=Set#'SET'{pname=get_datastr_name(Type), 2499 components = Components}}; 2500 _Other -> 2501 #newt{} 2502 end, 2503 Ts2 = case NewDef of 2504 #newt{type=unchanged} -> 2505 Ts; 2506 #newt{type=TDef}-> 2507 Ts#type{def=TDef} 2508 end, 2509 Ts2; 2510%% parameterized class 2511check_ptype(_S,_PTDef,Ts) when is_record(Ts,objectclass) -> 2512 throw({asn1_param_class,Ts}). 2513 2514check_formal_parameters(S, Args) -> 2515 _ = [check_formal_parameter(S, A) || A <- Args], 2516 ok. 2517 2518check_formal_parameter(_, {_,_}) -> 2519 ok; 2520check_formal_parameter(_, #'Externaltypereference'{}) -> 2521 ok; 2522check_formal_parameter(S, #'Externalvaluereference'{value=Name}) -> 2523 asn1_error(S, {illegal_typereference,Name}). 2524 2525check_type(_S,Type,Ts) when is_record(Type,typedef), 2526 (Type#typedef.checked==true) -> 2527 Ts; 2528check_type(_S,Type,Ts) when is_record(Type,typedef), 2529 (Type#typedef.checked==idle) -> % the check is going on 2530 Ts; 2531check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> 2532 {Def,Tag,Constr,IsInlined} = 2533 case match_parameter(S, Ts#type.def) of 2534 #type{tag=PTag,constraint=_Ctmp,def=Dtmp,inlined=Inl} -> 2535 {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl}; 2536 #typedef{typespec=#type{tag=PTag,def=Dtmp,inlined=Inl}} -> 2537 {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl}; 2538 Dtmp -> 2539 {Dtmp,Ts#type.tag,Ts#type.constraint,Ts#type.inlined} 2540 end, 2541 TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr, 2542 inlined=IsInlined}, 2543 TestFun = 2544 fun(Tref) -> 2545 {_, MaybeChoice} = get_referenced_type(S, Tref, true), 2546 case catch((MaybeChoice#typedef.typespec)#type.def) of 2547 {'CHOICE',_} -> 2548 maybe_illicit_implicit_tag(S, choice, Tag); 2549 'ANY' -> 2550 maybe_illicit_implicit_tag(S, open_type, Tag); 2551 'ANY DEFINED BY' -> 2552 maybe_illicit_implicit_tag(S, open_type, Tag); 2553 'ASN1_OPEN_TYPE' -> 2554 maybe_illicit_implicit_tag(S, open_type, Tag); 2555 _ -> 2556 Tag 2557 end 2558 end, 2559 NewDef= 2560 case Def of 2561 Ext when is_record(Ext,'Externaltypereference') -> 2562 {RefMod,RefTypeDef,IsParamDef} = 2563 case get_referenced_type(S, Ext) of 2564 {undefined,TmpTDef} -> %% A parameter 2565 {get(top_module),TmpTDef,true}; 2566 {TmpRefMod,TmpRefDef} -> 2567 {TmpRefMod,TmpRefDef,false} 2568 end, 2569 case get_class_def(S, RefTypeDef) of 2570 none -> ok; 2571 #classdef{} -> throw({asn1_class,RefTypeDef}) 2572 end, 2573 Ct = TestFun(Ext), 2574 {RefType,ExtRef} = 2575 case RefTypeDef#typedef.checked of 2576 true -> 2577 {RefTypeDef#typedef.typespec,Ext}; 2578 _ -> 2579 %% Put as idle to prevent recursive loops 2580 NewRefTypeDef1 = RefTypeDef#typedef{checked=idle}, 2581 asn1_db:dbput(RefMod, 2582 get_datastr_name(NewRefTypeDef1), 2583 NewRefTypeDef1), 2584 NewS = S#state{mname=RefMod, 2585 module=load_asn1_module(S,RefMod), 2586 tname=get_datastr_name(NewRefTypeDef1), 2587 abscomppath=[],recordtopname=[]}, 2588 RefType1 = 2589 check_type(NewS,RefTypeDef,RefTypeDef#typedef.typespec), 2590 %% update the type and mark as checked 2591 NewRefTypeDef2 = 2592 RefTypeDef#typedef{checked=true,typespec = RefType1}, 2593 TmpName = get_datastr_name(NewRefTypeDef2), 2594 asn1_db:dbput(RefMod, 2595 TmpName, 2596 NewRefTypeDef2), 2597 case {RefMod == get(top_module),IsParamDef} of 2598 {true,true} -> 2599 Key = {TmpName, 2600 type, 2601 NewRefTypeDef2}, 2602 asn1ct_gen:insert_once(parameterized_objects, 2603 Key); 2604 _ -> ok 2605 end, 2606 Pos = Ext#'Externaltypereference'.pos, 2607 {RefType1,#'Externaltypereference'{module=RefMod, 2608 pos=Pos, 2609 type=TmpName}} 2610 end, 2611 2612 case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of 2613 true -> 2614 %% Here we expand to a built in type and inline it 2615 NewC = check_constraints(S, RefType, Constr ++ 2616 RefType#type.constraint), 2617 TempNewDef#newt{ 2618 type = RefType#type.def, 2619 tag = merge_tags(Ct,RefType#type.tag), 2620 constraint = NewC}; 2621 _ -> 2622 %% Here we only expand the tags and keep the ext ref. 2623 NewExt = ExtRef#'Externaltypereference'{module=merged_mod(S,RefMod,Ext)}, 2624 TempNewDef#newt{ 2625 type = check_externaltypereference(S,NewExt), 2626 tag = merge_tags(Ct,RefType#type.tag)} 2627 end; 2628 'ANY' -> 2629 Ct = maybe_illicit_implicit_tag(S, open_type, Tag), 2630 TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 2631 {'ANY_DEFINED_BY',_} -> 2632 Ct = maybe_illicit_implicit_tag(S, open_type, Tag), 2633 TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 2634 'INTEGER' -> 2635 TempNewDef#newt{tag= 2636 merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; 2637 2638 {'INTEGER',NamedNumberList} -> 2639 TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList)}, 2640 tag= 2641 merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; 2642 'REAL' -> 2643 check_real(S,Constr), 2644 2645 TempNewDef#newt{tag=merge_tags(Tag,?TAG_PRIMITIVE(?N_REAL))}; 2646 {'BIT STRING',NamedNumberList} -> 2647 NewL = check_bitstring(S, NamedNumberList), 2648 TempNewDef#newt{type={'BIT STRING',NewL}, 2649 tag= 2650 merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))}; 2651 'NULL' -> 2652 TempNewDef#newt{tag= 2653 merge_tags(Tag,?TAG_PRIMITIVE(?N_NULL))}; 2654 'OBJECT IDENTIFIER' -> 2655 check_objectidentifier(S,Constr), 2656 TempNewDef#newt{tag= 2657 merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER))}; 2658 'ObjectDescriptor' -> 2659 TempNewDef#newt{tag= 2660 merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_DESCRIPTOR))}; 2661 'EXTERNAL' -> 2662 put_once(external,unchecked), 2663 TempNewDef#newt{type= 2664 #'Externaltypereference'{module=S#state.mname, 2665 type='EXTERNAL'}, 2666 tag= 2667 merge_tags(Tag,?TAG_CONSTRUCTED(?N_EXTERNAL))}; 2668 {'INSTANCE OF',DefinedObjectClass,Constraint} -> 2669 %% check that DefinedObjectClass is of TYPE-IDENTIFIER class 2670 %% If Constraint is empty make it the general INSTANCE OF type 2671 %% If Constraint is not empty make an inlined type 2672 %% convert INSTANCE OF to the associated type 2673 IOFDef=check_instance_of(S,DefinedObjectClass,Constraint), 2674 TempNewDef#newt{type=IOFDef, 2675 tag=merge_tags(Tag,?TAG_CONSTRUCTED(?N_INSTANCE_OF))}; 2676 {'ENUMERATED',NamedNumberList} -> 2677 TempNewDef#newt{type= 2678 {'ENUMERATED', 2679 check_enumerated(S, NamedNumberList)}, 2680 tag= 2681 merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED)), 2682 constraint=[]}; 2683 'EMBEDDED PDV' -> 2684 put_once(embedded_pdv,unchecked), 2685 TempNewDef#newt{type= 2686 #'Externaltypereference'{module=S#state.mname, 2687 type='EMBEDDED PDV'}, 2688 tag= 2689 merge_tags(Tag,?TAG_CONSTRUCTED(?N_EMBEDDED_PDV))}; 2690 'BOOLEAN'-> 2691 check_boolean(S,Constr), 2692 TempNewDef#newt{tag= 2693 merge_tags(Tag,?TAG_PRIMITIVE(?N_BOOLEAN))}; 2694 'OCTET STRING' -> 2695 check_octetstring(S,Constr), 2696 TempNewDef#newt{tag= 2697 merge_tags(Tag,?TAG_PRIMITIVE(?N_OCTET_STRING))}; 2698 'NumericString' -> 2699 check_restrictedstring(S,Def,Constr), 2700 TempNewDef#newt{tag= 2701 merge_tags(Tag,?TAG_PRIMITIVE(?N_NumericString))}; 2702 TString when TString =:= 'TeletexString'; 2703 TString =:= 'T61String' -> 2704 check_restrictedstring(S,Def,Constr), 2705 TempNewDef#newt{tag= 2706 merge_tags(Tag,?TAG_PRIMITIVE(?N_TeletexString))}; 2707 'VideotexString' -> 2708 check_restrictedstring(S,Def,Constr), 2709 TempNewDef#newt{tag= 2710 merge_tags(Tag,?TAG_PRIMITIVE(?N_VideotexString))}; 2711 'UTCTime' -> 2712 TempNewDef#newt{tag= 2713 merge_tags(Tag,?TAG_PRIMITIVE(?N_UTCTime))}; 2714 'GeneralizedTime' -> 2715 TempNewDef#newt{tag= 2716 merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralizedTime))}; 2717 'GraphicString' -> 2718 check_restrictedstring(S,Def,Constr), 2719 TempNewDef#newt{tag= 2720 merge_tags(Tag,?TAG_PRIMITIVE(?N_GraphicString))}; 2721 'VisibleString' -> 2722 check_restrictedstring(S,Def,Constr), 2723 TempNewDef#newt{tag= 2724 merge_tags(Tag,?TAG_PRIMITIVE(?N_VisibleString))}; 2725 'GeneralString' -> 2726 check_restrictedstring(S,Def,Constr), 2727 TempNewDef#newt{tag= 2728 merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralString))}; 2729 'PrintableString' -> 2730 check_restrictedstring(S,Def,Constr), 2731 TempNewDef#newt{tag= 2732 merge_tags(Tag,?TAG_PRIMITIVE(?N_PrintableString))}; 2733 'IA5String' -> 2734 check_restrictedstring(S,Def,Constr), 2735 TempNewDef#newt{tag= 2736 merge_tags(Tag,?TAG_PRIMITIVE(?N_IA5String))}; 2737 'BMPString' -> 2738 check_restrictedstring(S,Def,Constr), 2739 TempNewDef#newt{tag= 2740 merge_tags(Tag,?TAG_PRIMITIVE(?N_BMPString))}; 2741 'UniversalString' -> 2742 check_restrictedstring(S,Def,Constr), 2743 TempNewDef#newt{tag= 2744 merge_tags(Tag,?TAG_PRIMITIVE(?N_UniversalString))}; 2745 'UTF8String' -> 2746 check_restrictedstring(S,Def,Constr), 2747 TempNewDef#newt{tag= 2748 merge_tags(Tag,?TAG_PRIMITIVE(?N_UTF8String))}; 2749 'RELATIVE-OID' -> 2750 check_relative_oid(S,Constr), 2751 TempNewDef#newt{tag= 2752 merge_tags(Tag,?TAG_PRIMITIVE(?'N_RELATIVE-OID'))}; 2753 'CHARACTER STRING' -> 2754 put_once(character_string,unchecked), 2755 TempNewDef#newt{type= 2756 #'Externaltypereference'{module=S#state.mname, 2757 type='CHARACTER STRING'}, 2758 tag= 2759 merge_tags(Tag,?TAG_CONSTRUCTED(?N_CHARACTER_STRING))}; 2760 Seq when is_record(Seq,'SEQUENCE') -> 2761 RecordName = 2762 case TopName of 2763 [] -> 2764 [get_datastr_name(Type)]; 2765 _ -> 2766 TopName 2767 end, 2768 {TableCInf,Components} = 2769 check_sequence(S#state{recordtopname= 2770 RecordName}, 2771 Type,Seq#'SEQUENCE'.components), 2772 TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=tablecinf_choose(Seq,TableCInf), 2773 components=Components}, 2774 tag= 2775 merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; 2776 {'SEQUENCE OF',Components} -> 2777 TempNewDef#newt{type={'SEQUENCE OF',check_sequenceof(S,Type,Components)}, 2778 tag= 2779 merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; 2780 {'CHOICE',_} = Choice-> 2781 Ct = maybe_illicit_implicit_tag(S, choice, Tag), 2782 Components = get_choice_components(S, Choice), 2783 TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct}; 2784 Set when is_record(Set,'SET') -> 2785 RecordName= 2786 case TopName of 2787 [] -> 2788 [get_datastr_name(Type)]; 2789 _ -> 2790 TopName 2791 end, 2792 {Sorted,TableCInf,Components} = 2793 check_set(S#state{recordtopname=RecordName}, 2794 Type,Set#'SET'.components), 2795 TempNewDef#newt{type=Set#'SET'{sorted=Sorted, 2796 tablecinf=tablecinf_choose(Set,TableCInf), 2797 components=Components}, 2798 tag= 2799 merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; 2800 {'SET OF',Components} -> 2801 TempNewDef#newt{type={'SET OF',check_setof(S,Type,Components)}, 2802 tag= 2803 merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; 2804 2805 {pt,Ptype,ParaList} -> 2806 %% Ptype might be a parameterized - type, object set or 2807 %% value set. If it isn't a parameterized type notify the 2808 %% calling function. 2809 {_RefMod,Ptypedef} = get_referenced_type(S,Ptype), 2810 notify_if_not_ptype(S,Ptypedef), 2811 NewParaList = match_parameters(S, ParaList), 2812 Instance = instantiate_ptype(S,Ptypedef,NewParaList), 2813 TempNewDef#newt{type=Instance#type.def, 2814 tag=merge_tags(Tag,Instance#type.tag), 2815 constraint=Instance#type.constraint, 2816 inlined=yes}; 2817 2818 #'ObjectClassFieldType'{classname=ClRef0}=OCFT0 -> 2819 %% this case occures in a SEQUENCE when 2820 %% the type of the component is a ObjectClassFieldType 2821 ClRef = match_parameter(S, ClRef0), 2822 OCFT = OCFT0#'ObjectClassFieldType'{classname=ClRef}, 2823 ClassSpec = check_class(S,ClRef), 2824 NewTypeDef = 2825 maybe_open_type(S,ClassSpec, 2826 OCFT#'ObjectClassFieldType'{class=ClassSpec},Constr), 2827 InnerTag = get_innertag(S,NewTypeDef), 2828 MergedTag = merge_tags(Tag,InnerTag), 2829 Ct = 2830 case is_open_type(NewTypeDef) of 2831 true -> 2832 maybe_illicit_implicit_tag(S, open_type, MergedTag); 2833 _ -> 2834 MergedTag 2835 end, 2836 case TopName of 2837 [] when Type#typedef.name =/= undefined -> 2838 %% This is a top-level type. 2839 #type{constraint=C,def=Simplified} = 2840 simplify_type(#type{def=NewTypeDef, 2841 constraint=Constr}), 2842 TempNewDef#newt{type=Simplified,tag=Ct, 2843 constraint=C}; 2844 _ -> 2845 TempNewDef#newt{type=NewTypeDef,tag=Ct} 2846 end; 2847 2848 {'TypeFromObject',{object,Object},TypeField} -> 2849 CheckedT = get_type_from_object(S,Object,TypeField), 2850 TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), 2851 type=CheckedT#type.def}; 2852 2853 {'SelectionType',Name,T} -> 2854 CheckedT = check_selectiontype(S,Name,T), 2855 TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), 2856 type=CheckedT#type.def}; 2857 'ASN1_OPEN_TYPE' -> 2858 TempNewDef 2859 end, 2860 #newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef, 2861 Ts#type{def=TDef, 2862 inlined=Inlined, 2863 constraint=check_constraints(S, #type{def=TDef}, NewConstr), 2864 tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) -> 2865 TempTag#tag{type=TTx}; 2866 (Other) -> Other 2867 end, NewTags)}. 2868 2869 2870%% 2871%% Simplify the backends by getting rid of an #'ObjectClassFieldType'{} 2872%% with a type known at compile time. 2873%% 2874 2875simplify_comps(Comps) -> 2876 [simplify_comp(Comp) || Comp <- Comps]. 2877 2878simplify_comp(#'ComponentType'{typespec=Type0}=C) -> 2879 Type = simplify_type(Type0), 2880 C#'ComponentType'{typespec=Type}; 2881simplify_comp(Other) -> Other. 2882 2883simplify_type(#type{tag=Tag,def=Inner,constraint=Constr0}=T) -> 2884 case Inner of 2885 #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}=OCFT -> 2886 Constr = [{ocft,OCFT}|Type#type.constraint++Constr0], 2887 Type#type{tag=Tag,constraint=Constr}; 2888 _ -> 2889 T 2890 end. 2891 2892%% tablecinf_choose. A SEQUENCE or SET may be inserted in another 2893%% SEQUENCE or SET by the COMPONENTS OF directive. If this inserted 2894%% type is a referenced type that already has been checked it already 2895%% has its tableconstraint information. Furthermore this information 2896%% may be lost in the analysis in the new environment. Assume this 2897%% SEQUENCE/SET has a simpletable constraint and a componentrelation 2898%% constraint whose atlist points to the outermost component of its 2899%% "standalone" definition. This will cause the analysis to fail as it 2900%% will not find the right atlist component in the outermost 2901%% environment in the new inlined environment. 2902tablecinf_choose(SetOrSeq,false) -> 2903 tablecinf_choose(SetOrSeq); 2904tablecinf_choose(_, TableCInf) -> 2905 TableCInf. 2906tablecinf_choose(#'SET'{tablecinf=TCI}) -> 2907 TCI; 2908tablecinf_choose(#'SEQUENCE'{tablecinf=TCI}) -> 2909 TCI. 2910 2911get_innertag(_S,#'ObjectClassFieldType'{type=Type}) -> 2912 case Type of 2913 {fixedtypevaluefield,_,#type{tag=Tag}} -> Tag; 2914 {TypeFieldName,_} when is_atom(TypeFieldName) -> []; 2915 _ -> [] 2916 end. 2917 2918%% get_class_def(S, Type) -> #classdef{} | 'none'. 2919get_class_def(S, #typedef{typespec=#type{def=#'Externaltypereference'{}=Eref}}) -> 2920 {_,NextDef} = get_referenced_type(S, Eref, true), 2921 get_class_def(S, NextDef); 2922get_class_def(S, #'Externaltypereference'{}=Eref) -> 2923 {_,NextDef} = get_referenced_type(S, Eref, true), 2924 get_class_def(S, NextDef); 2925get_class_def(_S, #classdef{}=CD) -> 2926 CD; 2927get_class_def(_S, _) -> 2928 none. 2929 2930maybe_illicit_implicit_tag(S, Kind, Tag) -> 2931 case Tag of 2932 [#tag{type='IMPLICIT'}|_T] -> 2933 asn1_error(S, {implicit_tag_before,Kind}); 2934 [ChTag = #tag{type={default,_}}|T] -> 2935 case Kind of 2936 open_type -> 2937 [ChTag#tag{type='EXPLICIT',form=32}|T]; %X.680 30.6c, X.690 8.14.2 2938 choice -> 2939 [ChTag#tag{type='EXPLICIT',form=32}|T] % X.680 28.6 c, 30.6c 2940 end; 2941 _ -> 2942 Tag % unchanged 2943 end. 2944 2945 2946merged_mod(S,RefMod,Ext) -> 2947 case S of 2948 #state{inputmodules=[]} -> 2949 RefMod; 2950 _ -> 2951 Ext#'Externaltypereference'.module 2952 end. 2953 2954%% maybe_open_type/2 -> #ObjectClassFieldType with updated fieldname and 2955%% type 2956%% if the FieldRefList points out a typefield and the class don't have 2957%% any UNIQUE field, so that a component relation constraint cannot specify 2958%% the type of a typefield, return 'ASN1_OPEN_TYPE'. 2959%% 2960maybe_open_type(_, _, #'ObjectClassFieldType'{fieldname={_,_}}=OCFT, _) -> 2961 %% Already converted. 2962 OCFT; 2963maybe_open_type(S, #objectclass{fields=Fs}=ClassSpec, 2964 #'ObjectClassFieldType'{fieldname=FieldRefList}=OCFT, 2965 Constr) -> 2966 Type = get_OCFType(S, Fs, FieldRefList), 2967 FieldNames = get_referenced_fieldname(FieldRefList), 2968 case lists:last(FieldRefList) of 2969 {valuefieldreference,_} -> 2970 OCFT#'ObjectClassFieldType'{fieldname=FieldNames, 2971 type=Type}; 2972 {typefieldreference,_} -> 2973 %% Note: The constraints have not been checked yet, 2974 %% so we must use a special lookup routine. 2975 case {get_unique_fieldname(S, #classdef{typespec=ClassSpec}), 2976 get_componentrelation(Constr)} of 2977 {no_unique,_} -> 2978 OCFT#'ObjectClassFieldType'{fieldname=FieldNames, 2979 type='ASN1_OPEN_TYPE'}; 2980 {_,no} -> 2981 OCFT#'ObjectClassFieldType'{fieldname=FieldNames, 2982 type='ASN1_OPEN_TYPE'}; 2983 _ -> 2984 OCFT#'ObjectClassFieldType'{fieldname=FieldNames, 2985 type=Type} 2986 end 2987 end. 2988 2989get_componentrelation([{element_set,{componentrelation,_,_}=Cr,none}|_]) -> 2990 Cr; 2991get_componentrelation([_|T]) -> 2992 get_componentrelation(T); 2993get_componentrelation([]) -> 2994 no. 2995 2996is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) -> 2997 true; 2998is_open_type(#'ObjectClassFieldType'{}) -> 2999 false. 3000 3001 3002notify_if_not_ptype(S,#pvaluesetdef{type=Type}) -> 3003 case Type#type.def of 3004 Ref when is_record(Ref,'Externaltypereference') -> 3005 case get_referenced_type(S,Ref) of 3006 {_,#classdef{}} -> 3007 throw(pobjectsetdef); 3008 {_,#typedef{}} -> 3009 throw(pvalueset) 3010 end; 3011 T when is_record(T,type) -> % this must be a value set 3012 throw(pvalueset) 3013 end; 3014notify_if_not_ptype(_S,PT=#ptypedef{}) -> 3015 %% this may be a parameterized CLASS, in that case throw an 3016 %% asn1_class exception 3017 case PT#ptypedef.typespec of 3018 #objectclass{} -> throw({asn1_class,PT}); 3019 _ -> ok 3020 end; 3021notify_if_not_ptype(S,#pobjectsetdef{class=Cl}) -> 3022 case Cl of 3023 #'Externaltypereference'{} -> 3024 case get_referenced_type(S,Cl) of 3025 {_,#classdef{}} -> 3026 throw(pobjectsetdef); 3027 {_,#typedef{}} -> 3028 throw(pvalueset) 3029 end; 3030 _ -> 3031 throw(pobjectsetdef) 3032 end; 3033notify_if_not_ptype(S, PT) -> 3034 asn1_error(S, {param_bad_type, error_value(PT)}). 3035 3036instantiate_ptype(S,Ptypedef,ParaList) -> 3037 #ptypedef{args=Args,typespec=Type} = Ptypedef, 3038 NewType = check_ptype(S,Ptypedef,Type#type{inlined=yes}), 3039 MatchedArgs = match_args(S,Args, ParaList, []), 3040 OldArgs = S#state.parameters, 3041 NewS = S#state{parameters=MatchedArgs++OldArgs,abscomppath=[]}, 3042 check_type(NewS, Ptypedef#ptypedef{typespec=NewType}, NewType). 3043 3044get_datastr_name(Type) -> 3045 asn1ct:get_name_of_def(Type). 3046 3047get_pt_args(#ptypedef{args=Args}) -> 3048 Args; 3049get_pt_args(#pvaluesetdef{args=Args}) -> 3050 Args; 3051get_pt_args(#pvaluedef{args=Args}) -> 3052 Args; 3053get_pt_args(#pobjectdef{args=Args}) -> 3054 Args; 3055get_pt_args(#pobjectsetdef{args=Args}) -> 3056 Args. 3057 3058get_pt_spec(#ptypedef{typespec=Type}) -> 3059 Type; 3060get_pt_spec(#pvaluedef{value=Value}) -> 3061 Value; 3062get_pt_spec(#pvaluesetdef{valueset=VS}) -> 3063 VS; 3064get_pt_spec(#pobjectdef{def=Def}) -> 3065 Def; 3066get_pt_spec(#pobjectsetdef{def=Def}) -> 3067 Def. 3068 3069%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 3070%% match_args(S,FormalArgs, ActualArgs, Accumulator) -> Result 3071%% S = #state{} 3072%% FormalArgs = [term()] | [{Governor,Parameter}] 3073%% ActualArgs = [term()] 3074%% Accumulator = [term()] 3075%% Result = [{term(),term()}] | throw() 3076%% Governor = #type{} | Reference | 'TYPE-IDENTIFIER' | 'ABSTRACT-SYNTAX' 3077%% Parameter = Reference | {Governor,Reference} 3078%% Reference = #'Externaltypereference'{} | #'Externalvaluerference'{} 3079%% 3080%% Different categories of parameters and governors (Dubuisson p.382) 3081%% +----------------+-------------------------------+----------------------+ 3082%% |Governor is | Parameter name style | Parameter is | 3083%% +----------------+-------------------------------+----------------------+ 3084%% | absent | begins with uppercase,(bu) | a type | 3085%% | | | | 3086%% | a type | begins with a lowercase,(bl)| a value | 3087%% | | | | 3088%% | a type | begins with an uppercase | a value set | 3089%% | | | | 3090%% | absent | entirely in uppercase, (eu) | a class (or type) | 3091%% | | | | 3092%% | a class name | begins with a lowercase | an object | 3093%% | | | | 3094%% | a class name | begins with an uppercase | an object set | 3095%% +----------------+-------------------------------+----------------------+ 3096%% 3097%% Matches each of the formal parameters to corresponding actual 3098%% parameter, and changes format of the actual parameter according to 3099%% above table if necessary. 3100match_args(S,FA = [FormArg|Ft], AA = [ActArg|At], Acc) -> 3101 OldParams = S#state.parameters, 3102 case categorize_arg(S,FormArg,ActArg) of 3103 [CategorizedArg] -> 3104 match_args(S#state{parameters= 3105 [{FormArg,CategorizedArg}|OldParams]}, 3106 Ft, At, [{FormArg,CategorizedArg}|Acc]); 3107 CategorizedArgs -> 3108 match_args(S#state{parameters=CategorizedArgs++OldParams}, 3109 FA, CategorizedArgs ++ AA, Acc) 3110 end; 3111match_args(_S,[], [], Acc) -> 3112 lists:reverse(Acc); 3113match_args(S, _, _, _) -> 3114 asn1_error(S, param_wrong_number_of_arguments). 3115 3116%%%%%%%%%%%%%%%%% 3117%% categorize_arg(S,FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg} 3118%% 3119categorize_arg(S,{Governor,Param},ActArg) -> 3120 case {governor_category(S, Governor),parameter_name_style(Param)} of 3121 {type,beginning_lowercase} -> %a value 3122 categorize(S, value, Governor, ActArg); 3123 {type,beginning_uppercase} -> %a value set 3124 categorize(ActArg); 3125 {{class,ClassRef},beginning_lowercase} -> 3126 categorize(S, object, ActArg, ClassRef); 3127 {{class,ClassRef},beginning_uppercase} -> 3128 categorize(S, object_set, ActArg, ClassRef) 3129 end; 3130categorize_arg(_S, _FormalArg, ActualArg) -> 3131 %% Governor is absent -- must be a type or a class. We have already 3132 %% checked that the FormalArg begins with an uppercase letter. 3133 categorize(ActualArg). 3134 3135%% governor_category(S, Item) -> type | {class,#'Externaltypereference'{}} 3136%% Determine whether Item is a type or a class. 3137governor_category(S, #type{def=#'Externaltypereference'{}=Eref}) -> 3138 governor_category(S, Eref); 3139governor_category(_S, #type{}) -> 3140 type; 3141governor_category(S, #'Externaltypereference'{}=Ref) -> 3142 case get_class_def(S, Ref) of 3143 #classdef{pos=Pos,module=Mod,name=Name} -> 3144 {class,#'Externaltypereference'{pos=Pos,module=Mod,type=Name}}; 3145 none -> 3146 type 3147 end. 3148 3149%% parameter_name_style(Param,Data) -> Result 3150%% gets the Parameter and the name of the Data and if it exists tells 3151%% whether it begins with a lowercase letter or is partly or entirely 3152%% spelled with uppercase letters. Otherwise returns undefined 3153%% 3154parameter_name_style(#'Externaltypereference'{}) -> 3155 beginning_uppercase; 3156parameter_name_style(#'Externalvaluereference'{}) -> 3157 beginning_lowercase. 3158 3159%% categorize(Parameter) -> CategorizedParameter 3160%% If Parameter has an abstract syntax of another category than 3161%% Category, transform it to a known syntax. 3162categorize({object,_,Type}) -> 3163 %% One example of this case is an object with a parameterized type 3164 %% having a locally defined type as parameter. 3165 Def = fun(D = #type{}) -> 3166 #typedef{name = new_reference_name("type_argument"), 3167 typespec = D#type{inlined=yes}}; 3168 ({setting,_,Eref}) when is_record(Eref,'Externaltypereference') -> 3169 Eref; 3170 (D) -> 3171 D 3172 end, 3173 [Def(X)||X<-Type]; 3174categorize(#type{}=Def) -> 3175 [#typedef{name = new_reference_name("type_argument"), 3176 typespec = Def#type{inlined=yes}}]; 3177categorize(Def) -> 3178 [Def]. 3179 3180categorize(S,object_set,Def,ClassRef) -> 3181 NewObjSetSpec = 3182 check_object(S,Def,#'ObjectSet'{class = ClassRef, 3183 set = parse_objectset(Def)}), 3184 Name = new_reference_name("object_set_argument"), 3185 [save_object_set_instance(S,Name,NewObjSetSpec)]; 3186categorize(_S,object,Def,_ClassRef) -> 3187 %% should be handled 3188 [Def]; 3189categorize(_S,value,_Type,Value) when is_record(Value,valuedef) -> 3190 [Value]; 3191categorize(S,value,Type,Value) -> 3192%% [check_value(S,#valuedef{type=Type,value=Value})]. 3193 [#valuedef{type=Type,value=Value,module=S#state.mname}]. 3194 3195 3196parse_objectset({valueset,#type{def=#'Externaltypereference'{}=Ref}}) -> 3197 Ref; 3198parse_objectset({valueset,Set}) -> 3199 Set; 3200parse_objectset(#type{def=Ref}) when is_record(Ref,'Externaltypereference') -> 3201 Ref; 3202parse_objectset(Set) -> 3203 %% extend this later 3204 Set. 3205 3206%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 3207%% 3208%% Check and simplify constraints. 3209%% 3210%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 3211 3212check_constraints(_S, _HostType, []) -> 3213 []; 3214check_constraints(S, HostType0, [_|_]=Cs0) -> 3215 HostType = get_real_host_type(HostType0, Cs0), 3216 Cs1 = top_level_intersections(Cs0), 3217 Cs2 = [coalesce_constraints(C) || C <- Cs1], 3218 {_,Cs3} = filter_extensions(Cs2), 3219 Cs = simplify_element_sets(S, HostType, Cs3), 3220 finish_constraints(Cs). 3221 3222get_real_host_type(HostType, Cs) -> 3223 case lists:keyfind(ocft, 1, Cs) of 3224 false -> HostType; 3225 {_,OCFT} -> HostType#type{def=OCFT} 3226 end. 3227 3228top_level_intersections([{element_set,{intersection,_,_}=C,none}]) -> 3229 top_level_intersections_1(C); 3230top_level_intersections(Cs) -> 3231 Cs. 3232 3233top_level_intersections_1({intersection,A,B}) -> 3234 [{element_set,A,none}|top_level_intersections_1(B)]; 3235top_level_intersections_1(Other) -> 3236 [{element_set,Other,none}]. 3237 3238coalesce_constraints({element_set, 3239 {Tag,{element_set,A,_}}, 3240 {Tag,{element_set,B,_}}}) -> 3241 %% (SIZE (C1), ..., (SIZE (C2)) => (SIZE (C1, ..., C2)) 3242 {element_set,{Tag,{element_set,A,B}},none}; 3243coalesce_constraints(Other) -> 3244 Other. 3245 3246%% Remove all outermost extensions except the last. 3247 3248filter_extensions([H0|T0]) -> 3249 case filter_extensions(T0) of 3250 {true,T} -> 3251 H = remove_extension(H0), 3252 {true,[H|T]}; 3253 {false,T} -> 3254 {any_extension(H0),[H0|T]} 3255 end; 3256filter_extensions([]) -> 3257 {false,[]}. 3258 3259remove_extension({element_set,Root,_}) -> 3260 {element_set,remove_extension(Root),none}; 3261remove_extension(Tuple) when is_tuple(Tuple) -> 3262 L = [remove_extension(El) || El <- tuple_to_list(Tuple)], 3263 list_to_tuple(L); 3264remove_extension(Other) -> Other. 3265 3266any_extension({element_set,_,Ext}) when Ext =/= none -> 3267 true; 3268any_extension(Tuple) when is_tuple(Tuple) -> 3269 any_extension_tuple(1, Tuple); 3270any_extension(_) -> false. 3271 3272any_extension_tuple(I, T) when I =< tuple_size(T) -> 3273 any_extension(element(I, T)) orelse any_extension_tuple(I+1, T); 3274any_extension_tuple(_, _) -> false. 3275 3276simplify_element_sets(S, HostType, [{element_set,R0,E0}|T0]) -> 3277 R1 = simplify_element_set(S, HostType, R0), 3278 E1 = simplify_element_set(S, HostType, E0), 3279 case simplify_element_sets(S, HostType, T0) of 3280 [{element_set,R2,E2}] -> 3281 [{element_set,cs_intersection(S, R1, R2), 3282 cs_intersection(S, E1, E2)}]; 3283 L when is_list(L) -> 3284 [{element_set,R1,E1}|L] 3285 end; 3286simplify_element_sets(S, HostType, [H|T]) -> 3287 [H|simplify_element_sets(S, HostType, T)]; 3288simplify_element_sets(_, _, []) -> 3289 []. 3290 3291simplify_element_set(_S, _HostType, empty) -> 3292 {set,[]}; 3293simplify_element_set(S, HostType, {'SingleValue',Vs0}) when is_list(Vs0) -> 3294 Vs1 = [resolve_value(S, HostType, V) || V <- Vs0], 3295 Vs = make_constr_set_vs(Vs1), 3296 simplify_element_set(S, HostType, Vs); 3297simplify_element_set(S, HostType, {'SingleValue',V0}) -> 3298 V1 = resolve_value(S, HostType, V0), 3299 V = {set,[{range,V1,V1}]}, 3300 simplify_element_set(S, HostType, V); 3301simplify_element_set(S, HostType, {'ValueRange',{Lb0,Ub0}}) -> 3302 Lb = resolve_value(S, HostType, Lb0), 3303 Ub = resolve_value(S, HostType, Ub0), 3304 V = make_constr_set(S, Lb, Ub), 3305 simplify_element_set(S, HostType, V); 3306simplify_element_set(S, HostType, {'ALL-EXCEPT',Set0}) -> 3307 Set = simplify_element_set(S, HostType, Set0), 3308 {'ALL-EXCEPT',Set}; 3309simplify_element_set(S, HostType, {intersection,A0,B0}) -> 3310 A = simplify_element_set(S, HostType, A0), 3311 B = simplify_element_set(S, HostType, B0), 3312 cs_intersection(S, A, B); 3313simplify_element_set(S, HostType, {union,A0,B0}) -> 3314 A = simplify_element_set(S, HostType, A0), 3315 B = simplify_element_set(S, HostType, B0), 3316 cs_union(S, A, B); 3317simplify_element_set(S, HostType, {simpletable,{element_set,Type,_}}) -> 3318 check_simpletable(S, HostType, Type); 3319simplify_element_set(S, _, {componentrelation,R,Id}) -> 3320 check_componentrelation(S, R, Id); 3321simplify_element_set(S, HostType, {Tag,{element_set,_,_}=El0}) -> 3322 [El1] = simplify_element_sets(S, HostType, [El0]), 3323 {Tag,El1}; 3324simplify_element_set(S, HostType, #type{}=Type) -> 3325 simplify_element_set_type(S, HostType, Type); 3326simplify_element_set(_, _, C) -> 3327 C. 3328 3329simplify_element_set_type(S, HostType, #type{def=Def0}=Type0) -> 3330 #'Externaltypereference'{} = Def0, %Assertion. 3331 case get_referenced_type(S, Def0) of 3332 {_,#valuedef{checked=false,value={valueset,Vs0}}} -> 3333 [Vs1] = simplify_element_sets(S, HostType, [Vs0]), 3334 case Vs1 of 3335 {element_set,Set,none} -> 3336 Set; 3337 {element_set,Set,{set,[]}} -> 3338 Set 3339 end; 3340 {_,{valueset,#type{def=#'Externaltypereference'{}}=Type}} -> 3341 simplify_element_set_type(S, HostType, Type); 3342 _ -> 3343 case HostType of 3344 #type{def=#'ObjectClassFieldType'{}} -> 3345 %% Open type. 3346 #type{def=Def} = check_type(S, HostType, Type0), 3347 Def; 3348 _ -> 3349 #type{constraint=Cs} = check_type(S, HostType, Type0), 3350 C = convert_back(Cs), 3351 simplify_element_set(S, HostType, C) 3352 end 3353 end. 3354 3355convert_back([H1,H2|T]) -> 3356 {intersection,H1,convert_back([H2|T])}; 3357convert_back([H]) -> 3358 H; 3359convert_back([]) -> 3360 none. 3361 3362check_simpletable(S, HostType, Type) -> 3363 case HostType of 3364 #type{def=#'ObjectClassFieldType'{}} -> 3365 ok; 3366 _ -> 3367 %% Table constraints may only be applied to 3368 %% CLASS.&field constructs. 3369 asn1_error(S, illegal_table_constraint) 3370 end, 3371 Def = case Type of 3372 #type{def=D} -> D; 3373 {'SingleValue',#'Externalvaluereference'{}=ObjRef} -> 3374 ObjRef; 3375 _ -> 3376 asn1_error(S, invalid_table_constraint) 3377 end, 3378 C = match_parameter(S, Def), 3379 case C of 3380 #'Externaltypereference'{} -> 3381 ERef = check_externaltypereference(S, C), 3382 {simpletable,ERef#'Externaltypereference'.type}; 3383 #'Externalvaluereference'{} -> 3384 %% This is an object set with a referenced object 3385 {_,TorVDef} = get_referenced_type(S, C), 3386 Set = case TorVDef of 3387 #typedef{typespec=#'Object'{classname=ClassName}} -> 3388 #'ObjectSet'{class=ClassName, 3389 set={'SingleValue',C}}; 3390 #valuedef{type=#type{def=ClassDef}, 3391 value=#'Externalvaluereference'{}=Obj} -> 3392 %% an object might reference another object 3393 #'ObjectSet'{class=ClassDef, 3394 set={'SingleValue',Obj}} 3395 end, 3396 {simpletable,check_object(S, Type, Set)}; 3397 {'ValueFromObject',{_,Object},FieldNames} -> 3398 %% This is an ObjectFromObject. 3399 {simpletable,extract_field(S, Object, FieldNames)} 3400 end. 3401 3402check_componentrelation(S, {objectset,Opos,Objset0}, Id) -> 3403 %% Objset is an 'Externaltypereference' record, since Objset is 3404 %% a DefinedObjectSet. 3405 ObjSet = match_parameter(S, Objset0), 3406 Ext = check_externaltypereference(S, ObjSet), 3407 {componentrelation,{objectset,Opos,Ext},Id}. 3408 3409%%% 3410%%% Internal set representation. 3411%%% 3412%%% We represent sets as a union of strictly disjoint ranges: 3413%%% 3414%%% {set,[Range]} 3415%%% 3416%%% A range is represented as: 3417%%% 3418%%% Range = {a_range,UpperBound} | {range,LowerBound,UpperBound} 3419%%% 3420%%% We don't use the atom 'MIN' to represent MIN, because atoms 3421%%% compare higher than integer. Instead we use {a_range,UpperBound} 3422%%% to represent MIN..UpperBound. We represent MAX as 'MAX' because 3423%%% 'MAX' compares higher than any integer. 3424%%% 3425%%% The ranges are sorted in term order. The ranges must not overlap 3426%%% or be adjacent to each other. This invariant is established when 3427%%% creating sets, and maintained by the intersection and union 3428%%% operators. 3429%%% 3430%%% Example of invalid set representaions: 3431%%% 3432%%% [{range,0,10},{range,5,10}] %Overlapping ranges 3433%%% [{range,0,5},{range,6,10}] %Adjancent ranges 3434%%% [{range,10,20},{a_range,100}] %Not sorted 3435%%% 3436 3437make_constr_set(_, 'MIN', Ub) -> 3438 {set,[{a_range,make_constr_set_val(Ub)}]}; 3439make_constr_set(_, Lb, Ub) when Lb =< Ub -> 3440 {set,[{range,make_constr_set_val(Lb), 3441 make_constr_set_val(Ub)}]}; 3442make_constr_set(S, _, _) -> 3443 asn1_error(S, reversed_range). 3444 3445make_constr_set_val([C]) when is_integer(C) -> C; 3446make_constr_set_val(Val) -> Val. 3447 3448make_constr_set_vs(Vs) -> 3449 {set,make_constr_set_vs_1(Vs)}. 3450 3451make_constr_set_vs_1([]) -> 3452 []; 3453make_constr_set_vs_1([V]) -> 3454 [{range,V,V}]; 3455make_constr_set_vs_1([V0|Vs]) -> 3456 V1 = make_constr_set_vs_1(Vs), 3457 range_union([{range,V0,V0}], V1). 3458 3459%%% 3460%%% Set operators. 3461%%% 3462 3463cs_intersection(_S, Other, none) -> 3464 Other; 3465cs_intersection(_S, none, Other) -> 3466 Other; 3467cs_intersection(_S, {set,SetA}, {set,SetB}) -> 3468 {set,range_intersection(SetA, SetB)}; 3469cs_intersection(_S, A, B) -> 3470 {intersection,A,B}. 3471 3472range_intersection([], []) -> 3473 []; 3474range_intersection([_|_], []) -> 3475 []; 3476range_intersection([], [_|_]) -> 3477 []; 3478range_intersection([H1|_]=A, [H2|_]=B) when H1 > H2 -> 3479 range_intersection(B, A); 3480range_intersection([H1|T1], [H2|T2]=B) -> 3481 %% Now H1 =< H2. 3482 case {H1,H2} of 3483 {{a_range,Ub0},{a_range,Ub1}} when Ub0 < Ub1 -> 3484 %% Ub0 =/= 'MAX' 3485 [H1|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])]; 3486 {{a_range,_},{a_range,_}} -> 3487 %% Must be equal. 3488 [H1|range_intersection(T1, T2)]; 3489 {{a_range,Ub0},{range,Lb1,_Ub1}} when Ub0 < Lb1 -> 3490 %% No intersection. 3491 range_intersection(T1, B); 3492 {{a_range,Ub0},{range,Lb1,Ub1}} when Ub0 < Ub1 -> 3493 %% Ub0 =/= 'MAX' 3494 [{range,Lb1,Ub0}|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])]; 3495 {{a_range,Ub},{range,_Lb1,Ub}} -> 3496 %% The first range covers the second range, but does not 3497 %% go beyond. We handle this case specially because Ub may 3498 %% be 'MAX', and evaluating 'MAX'+1 will fail. 3499 [H2|range_intersection(T1, T2)]; 3500 {{a_range,Ub0},{range,_Lb1,Ub1}} -> 3501 %% Ub0 > Ub1, Ub1 =/= 'MAX'. The first range completely 3502 %% covers and extends beyond the second range. 3503 [H2|range_intersection([{range,Ub1+1,Ub0}|T1], T2)]; 3504 {{range,_Lb0,Ub0},{range,Lb1,_Ub1}} when Ub0 < Lb1 -> 3505 %% Lb0 < Lb1. No intersection. 3506 range_intersection(T1, B); 3507 {{range,_Lb0,Ub0},{range,Lb1,Ub1}} when Ub0 < Ub1 -> 3508 %% Ub0 >= Lb1, Ub0 =/= 'MAX'. Partial overlap. 3509 [{range,Lb1,Ub0}|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])]; 3510 {{range,_Lb0,Ub},{range,_Lb1,Ub}} -> 3511 %% The first range covers the second range, but does not 3512 %% go beyond. We handle this case specially because Ub may 3513 %% be 'MAX', and evaluating 'MAX'+1 will fail. 3514 [H2|range_intersection(T1, T2)]; 3515 {{range,_Lb0,Ub0},{range,_Lb1,Ub1}} -> 3516 %% Ub1 =/= MAX. The first range completely covers and 3517 %% extends beyond the second. 3518 [H2|range_intersection([{range,Ub1+1,Ub0}|T1], T2)] 3519 end. 3520 3521cs_union(_S, {set,SetA}, {set,SetB}) -> 3522 {set,range_union(SetA, SetB)}; 3523cs_union(_S, A, B) -> 3524 {union,A,B}. 3525 3526range_union(A, B) -> 3527 range_union_1(lists:merge(A, B)). 3528 3529range_union_1([{a_range,Ub0},{a_range,Ub1}|T]) -> 3530 range_union_1([{a_range,max(Ub0, Ub1)}|T]); 3531range_union_1([{a_range,Ub0},{range,Lb1,Ub1}|T]) when Lb1-1 =< Ub0 -> 3532 range_union_1([{a_range,max(Ub0, Ub1)}|T]); 3533range_union_1([{a_range,_}=H|T]) -> 3534 %% Ranges are disjoint. 3535 [H|range_union_1(T)]; 3536range_union_1([{range,Lb0,Ub0},{range,Lb1,Ub1}|T]) when Lb1-1 =< Ub0 -> 3537 range_union_1([{range,Lb0,max(Ub0, Ub1)}|T]); 3538range_union_1([{range,_,_}=H|T]) -> 3539 %% Ranges are disjoint. 3540 [H|range_union_1(T)]; 3541range_union_1([]) -> 3542 []. 3543 3544%%% 3545%%% Finish up constrains, making them suitable for the back-ends. 3546%%% 3547%%% A 'PermittedAlphabet' (FROM) constraint will be reduced to: 3548%%% 3549%%% {'SingleValue',[integer()]} 3550%%% 3551%%% A 'SizeConstraint' (SIZE) constraint will be reduced to: 3552%%% 3553%%% {Lb,Ub} 3554%%% 3555%%% All other constraints will be reduced to: 3556%%% 3557%%% {'SingleValue',[integer()]} | {'ValueRange',Lb,Ub} 3558%%% 3559 3560finish_constraints(Cs) -> 3561 finish_constraints_1(Cs, fun smart_collapse/1). 3562 3563finish_constraints_1([{element_set,{Tag,{element_set,_,_}=Set0},none}|T], 3564 Collapse0) -> 3565 Collapse = collapse_fun(Tag), 3566 case finish_constraints_1([Set0], Collapse) of 3567 [] -> 3568 finish_constraints_1(T, Collapse0); 3569 [Set] -> 3570 [{Tag,Set}|finish_constraints_1(T, Collapse0)] 3571 end; 3572finish_constraints_1([{element_set,{set,[{a_range,'MAX'}]},_}|T], Collapse) -> 3573 finish_constraints_1(T, Collapse); 3574finish_constraints_1([{element_set,{intersection,A0,B0},none}|T], Collapse) -> 3575 A = {element_set,A0,none}, 3576 B = {element_set,B0,none}, 3577 finish_constraints_1([A,B|T], Collapse); 3578finish_constraints_1([{element_set,Root,Ext}|T], Collapse) -> 3579 case finish_constraint(Root, Ext, Collapse) of 3580 none -> 3581 finish_constraints_1(T, Collapse); 3582 Constr -> 3583 [Constr|finish_constraints_1(T, Collapse)] 3584 end; 3585finish_constraints_1([H|T], Collapse) -> 3586 [H|finish_constraints_1(T, Collapse)]; 3587finish_constraints_1([], _) -> 3588 []. 3589 3590finish_constraint({set,Root0}, Ext, Collapse) -> 3591 case Collapse(Root0) of 3592 none -> none; 3593 Root -> finish_constraint(Root, Ext, Collapse) 3594 end; 3595finish_constraint(Root, Ext, _Collapse) -> 3596 case Ext of 3597 none -> Root; 3598 _ -> {Root,[]} 3599 end. 3600 3601collapse_fun('SizeConstraint') -> 3602 fun size_constraint_collapse/1; 3603collapse_fun('PermittedAlphabet') -> 3604 fun single_value_collapse/1. 3605 3606single_value_collapse(V) -> 3607 {'SingleValue',ordsets:from_list(single_value_collapse_1(V))}. 3608 3609single_value_collapse_1([{range,Lb,Ub}|T]) when is_integer(Lb), 3610 is_integer(Ub) -> 3611 lists:seq(Lb, Ub) ++ single_value_collapse_1(T); 3612single_value_collapse_1([]) -> 3613 []. 3614 3615smart_collapse([{a_range,Ub}]) -> 3616 {'ValueRange',{'MIN',Ub}}; 3617smart_collapse([{a_range,_}|T]) -> 3618 {range,_,Ub} = lists:last(T), 3619 {'ValueRange',{'MIN',Ub}}; 3620smart_collapse([{range,Lb,Ub}]) -> 3621 {'ValueRange',{Lb,Ub}}; 3622smart_collapse([_|_]=L) -> 3623 V = lists:foldr(fun({range,Lb,Ub}, A) -> 3624 seq(Lb, Ub) ++ A 3625 end, [], L), 3626 {'SingleValue',V}. 3627 3628size_constraint_collapse([{range,0,'MAX'}]) -> 3629 none; 3630size_constraint_collapse(Root) -> 3631 [{range,Lb,_}|_] = Root, 3632 {range,_,Ub} = lists:last(Root), 3633 {Lb,Ub}. 3634 3635seq(Same, Same) -> 3636 [Same]; 3637seq(Lb, Ub) when is_integer(Lb), is_integer(Ub) -> 3638 lists:seq(Lb, Ub). 3639 3640%%%----------------------------------------- 3641%% If the constraint value is a defined value the valuename 3642%% is replaced by the actual value 3643%% 3644resolve_value(S, HostType, Val) -> 3645 Id = match_parameter(S, Val), 3646 resolve_value1(S, HostType, Id). 3647 3648resolve_value1(S, HostType, #'Externalvaluereference'{value=Name}=ERef) -> 3649 case resolve_namednumber(S, HostType, Name) of 3650 V when is_integer(V) -> 3651 V; 3652 not_named -> 3653 resolve_value1(S, HostType, get_referenced_value(S, ERef)) 3654 end; 3655resolve_value1(S, HostType, {gt,V}) -> 3656 case resolve_value1(S, HostType, V) of 3657 Int when is_integer(Int) -> 3658 Int + 1; 3659 _Other -> 3660 asn1_error(S, illegal_integer_value) 3661 end; 3662resolve_value1(S, HostType, {lt,V}) -> 3663 case resolve_value1(S, HostType, V) of 3664 Int when is_integer(Int) -> 3665 Int - 1; 3666 _Other -> 3667 asn1_error(S, illegal_integer_value) 3668 end; 3669resolve_value1(S, _HostType, {'ValueFromObject',{object,Object},FieldName}) -> 3670 get_value_from_object(S, Object, FieldName); 3671resolve_value1(_, _, #valuedef{checked=true,value=V}) -> 3672 V; 3673resolve_value1(S, _, #valuedef{value={'ValueFromObject', 3674 {object,Object},FieldName}}) -> 3675 get_value_from_object(S, Object, FieldName); 3676resolve_value1(S, _HostType, #valuedef{}=VDef) -> 3677 #valuedef{value=Val} = check_value(S,VDef), 3678 Val; 3679resolve_value1(_, _, V) -> 3680 V. 3681 3682resolve_namednumber(S, #type{def=Def}, Name) -> 3683 case Def of 3684 {'ENUMERATED',NameList} -> 3685 resolve_namednumber_1(S, Name, NameList); 3686 {'INTEGER',NameList} -> 3687 resolve_namednumber_1(S, Name, NameList); 3688 _ -> 3689 not_named 3690 end. 3691 3692resolve_namednumber_1(S, Name, NameList) -> 3693 try 3694 NamedNumberList = check_enumerated(S, NameList), 3695 {_,N} = lookup_enum_value(S, Name, NamedNumberList), 3696 N 3697 catch _:_ -> 3698 not_named 3699 end. 3700 3701%%% 3702%%% End of constraint handling. 3703%%% 3704 3705check_imported(S,Imodule,Name) -> 3706 check_imported(S,Imodule,Name,false). 3707check_imported(S,Imodule,Name,IsParsed) -> 3708 case asn1_db:dbget(Imodule,'MODULE') of 3709 undefined when IsParsed == true -> 3710 ErrStr = io_lib:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]), 3711 error({imported,ErrStr,S}); 3712 undefined -> 3713 parse_and_save(S,Imodule), 3714 check_imported(S,Imodule,Name,true); 3715 Im when is_record(Im,module) -> 3716 case is_exported(Im,Name) of 3717 false -> 3718 ErrStr = io_lib:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]), 3719 error({imported,ErrStr,S}); 3720 _ -> 3721 ok 3722 end 3723 end, 3724 ok. 3725 3726is_exported(Module,Name) when is_record(Module,module) -> 3727 {exports,Exports} = Module#module.exports, 3728 case Exports of 3729 all -> 3730 true; 3731 [] -> 3732 false; 3733 L when is_list(L) -> 3734 case lists:keysearch(Name,#'Externaltypereference'.type,Exports) of 3735 false -> false; 3736 _ -> true 3737 end 3738 end. 3739 3740 3741check_externaltypereference(S,Etref=#'Externaltypereference'{module=Emod})-> 3742 Currmod = S#state.mname, 3743 MergedMods = S#state.inputmodules, 3744 case Emod of 3745 Currmod -> 3746 %% reference to current module or to imported reference 3747 check_reference(S,Etref); 3748 _ -> 3749 %% io:format("Type ~s IMPORTED FROM ~s~n",[Etype,Emod]), 3750 case lists:member(Emod,MergedMods) of 3751 true -> 3752 check_reference(S,Etref); 3753 false -> 3754 {NewMod,_} = get_referenced_type(S,Etref), 3755 Etref#'Externaltypereference'{module=NewMod} 3756 end 3757 end. 3758 3759check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) -> 3760 ModName = S#state.mname, 3761 case asn1_db:dbget(ModName,Name) of 3762 undefined -> 3763 case imported(S,Name) of 3764 {ok,Imodule} -> 3765 check_imported(S,Imodule,Name), 3766 #'Externaltypereference'{module=Imodule,type=Name}; 3767 _ -> 3768 %% may be a renamed type in multi file compiling! 3769 {M,T}=get_renamed_reference(S,Name,Emod), 3770 NewName = asn1ct:get_name_of_def(T), 3771 NewPos = asn1ct:get_pos_of_def(T), 3772 #'Externaltypereference'{pos=NewPos, 3773 module=M, 3774 type=NewName} 3775 end; 3776 _ -> 3777 %% cannot do check_type here due to recursive definitions, like 3778 %% S ::= SEQUENCE {a INTEGER, b S}. This implies that references 3779 %% that appear before the definition will be an 3780 %% Externaltypereference in the abstract syntax tree 3781 #'Externaltypereference'{pos=Pos,module=ModName,type=Name} 3782 end. 3783 3784get_referenced_value(S, T) -> 3785 case get_referenced_type(S, T) of 3786 {ExtMod,#valuedef{value=#'Externalvaluereference'{}=Ref}} -> 3787 get_referenced_value(update_state(S, ExtMod), Ref); 3788 {_,#valuedef{value=Val}} -> 3789 Val 3790 end. 3791 3792get_referenced_type(S, T) -> 3793 get_referenced_type(S, T, false). 3794 3795get_referenced_type(S, T, Recurse) -> 3796 case do_get_referenced_type(S, T) of 3797 {_,#typedef{typespec=#type{def=#'Externaltypereference'{}=ERef}}} 3798 when Recurse -> 3799 get_referenced_type(S, ERef, Recurse); 3800 {_,_}=Res -> 3801 Res 3802 end. 3803 3804do_get_referenced_type(S, T0) -> 3805 case match_parameter(S, T0) of 3806 T0 -> 3807 do_get_ref_type_1(S, T0); 3808 T -> 3809 do_get_referenced_type(S, T) 3810 end. 3811 3812do_get_ref_type_1(S, #'Externaltypereference'{pos=P, 3813 module=M, 3814 type=T}) -> 3815 do_get_ref_type_2(S, P, M, T); 3816do_get_ref_type_1(S, #'Externalvaluereference'{pos=P, 3817 module=M, 3818 value=V}) -> 3819 do_get_ref_type_2(S, P, M, V); 3820do_get_ref_type_1(_, T) -> 3821 {undefined,T}. 3822 3823do_get_ref_type_2(#state{mname=Current,inputmodules=Modules}=S, 3824 Pos, M, T) -> 3825 case M =:= Current orelse lists:member(M, Modules) of 3826 true -> 3827 get_referenced1(S, M, T, Pos); 3828 false -> 3829 get_referenced(S, M, T, Pos) 3830 end. 3831 3832%% get_referenced/3 3833%% The referenced entity Ename may in case of an imported parameterized 3834%% type reference imported entities in the other module, which implies that 3835%% asn1_db:dbget will fail even though the referenced entity exists. Thus 3836%% Emod may be the module that imports the entity Ename and not holds the 3837%% data about Ename. 3838get_referenced(S,Emod,Ename,Pos) -> 3839 ?dbg("get_referenced: ~p~n",[Ename]), 3840 parse_and_save(S,Emod), 3841 ?dbg("get_referenced,parse_and_save ~n",[]), 3842 case asn1_db:dbget(Emod,Ename) of 3843 undefined -> 3844 %% May be an imported entity in module Emod or Emod may not exist 3845 case asn1_db:dbget(Emod,'MODULE') of 3846 undefined -> 3847 asn1_error(S, {undefined_import, Ename, Emod}); 3848 _ -> 3849 NewS = update_state(S,Emod), 3850 get_imported(NewS,Ename,Emod,Pos) 3851 end; 3852 T when is_record(T,typedef) -> 3853 ?dbg("get_referenced T: ~p~n",[T]), 3854 {Emod,T}; % should add check that T is exported here 3855 V -> 3856 ?dbg("get_referenced V: ~p~n",[V]), 3857 {Emod,V} 3858 end. 3859 3860get_referenced1(S,ModuleName,Name,Pos) -> 3861 case asn1_db:dbget(S#state.mname,Name) of 3862 undefined -> 3863 %% ModuleName may be other than S#state.mname when 3864 %% multi file compiling is used. 3865 get_imported(S,Name,ModuleName,Pos); 3866 T -> 3867 {S#state.mname,T} 3868 end. 3869 3870get_imported(S,Name,Module,Pos) -> 3871 ?dbg("get_imported, Module: ~p, Name: ~p~n",[Module,Name]), 3872 case imported(S,Name) of 3873 {ok,Imodule} -> 3874 parse_and_save(S,Imodule), 3875 case asn1_db:dbget(Imodule,'MODULE') of 3876 undefined -> 3877 asn1_error(S, {undefined_import, Name, Module}); 3878 Im when is_record(Im,module) -> 3879 case is_exported(Im,Name) of 3880 false -> 3881 asn1_error(S, {undefined_export, Name}); 3882 _ -> 3883 ?dbg("get_imported, is_exported ~p, ~p~n",[Imodule,Name]), 3884 get_referenced_type(S, 3885 #'Externaltypereference' 3886 {module=Imodule, 3887 type=Name,pos=Pos}) 3888 end 3889 end; 3890 _ -> 3891 get_renamed_reference(S,Name,Module) 3892 end. 3893 3894save_object_set_instance(S,Name,ObjSetSpec) 3895 when is_record(ObjSetSpec,'ObjectSet') -> 3896 NewObjSet = #typedef{checked=true,name=Name,typespec=ObjSetSpec}, 3897 asn1_db:dbput(S#state.mname,Name,NewObjSet), 3898 case ObjSetSpec of 3899 #'ObjectSet'{uniquefname={unique,undefined}} -> 3900 ok; 3901 _ -> 3902 %% Should be generated iff 3903 %% ObjSpec#'ObjectSet'.uniquefname /= {unique,undefined} 3904 ObjSetKey = {Name,objectset,NewObjSet}, 3905 %% asn1ct_gen:insert_once(parameterized_objects,ObjSetKey) 3906 insert_once(S,parameterized_objects,ObjSetKey) 3907 end, 3908 #'Externaltypereference'{module=S#state.mname,type=Name}. 3909 3910%% load_asn1_module do not check that the module is saved. 3911%% If get_referenced_type is called before the module must 3912%% be saved. 3913load_asn1_module(#state{mname=M,module=Mod},M)-> 3914 Mod; 3915load_asn1_module(_,M) -> 3916 asn1_db:dbget(M,'MODULE'). 3917 3918parse_and_save(S,Module) when is_record(S,state) -> 3919 Erule = S#state.erule, 3920 case asn1db_member(S,Erule,Module) of 3921 true -> 3922 ok; 3923 _ -> 3924 case asn1ct:parse_and_save(Module,S) of 3925 ok -> 3926 save_asn1db_uptodate(S,Erule,Module); 3927 Err -> 3928 Err 3929 end 3930 end. 3931 3932asn1db_member(S,Erule,Module) -> 3933 Asn1dbUTL = get_asn1db_uptodate(S), 3934 lists:member({Erule,Module},Asn1dbUTL). 3935 3936save_asn1db_uptodate(S,Erule,Module) -> 3937 Asn1dbUTL = get_asn1db_uptodate(S), 3938 Asn1dbUTL2 = lists:keydelete(Module,2,Asn1dbUTL), 3939 put_asn1db_uptodate([{Erule,Module}|Asn1dbUTL2]). 3940 3941get_asn1db_uptodate(S) -> 3942 case get(asn1db_uptodate) of 3943 undefined -> [{S#state.erule,S#state.mname}]; %initialize 3944 L -> L 3945 end. 3946 3947put_asn1db_uptodate(L) -> 3948 put(asn1db_uptodate,L). 3949 3950update_state(S,undefined) -> 3951 S; 3952update_state(S=#state{mname=ModuleName},ModuleName) -> 3953 S; 3954update_state(S,ModuleName) -> 3955 case lists:member(ModuleName,S#state.inputmodules) of 3956 true -> 3957 S; 3958 _ -> 3959 parse_and_save(S,ModuleName), 3960 Mod = #module{} = asn1_db:dbget(ModuleName,'MODULE'), 3961 S#state{mname=ModuleName,module=Mod} 3962 end. 3963 3964get_renamed_reference(S,Name,Module) -> 3965 case renamed_reference(S,Name,Module) of 3966 undefined -> 3967 asn1_error(S, {undefined, Name}); 3968 NewTypeName when NewTypeName =/= Name -> 3969 get_referenced1(S,Module,NewTypeName,undefined) 3970 end. 3971renamed_reference(S,#'Externaltypereference'{type=Name,module=Module}) -> 3972 case renamed_reference(S,Name,Module) of 3973 undefined -> 3974 Name; 3975 Other -> 3976 Other 3977 end. 3978renamed_reference(S,Name,Module) -> 3979 %% first check if there is a renamed type in this module 3980 %% second check if any type was imported with this name 3981 case asn1ct_table:exists(renamed_defs) of 3982 false -> undefined; 3983 true -> 3984 case asn1ct_table:match(renamed_defs, {'$1',Name,Module}) of 3985 [] -> 3986 case asn1ct_table:exists(original_imports) of 3987 false -> 3988 undefined; 3989 true -> 3990 case asn1ct_table:match(original_imports, {Module,'$1'}) of 3991 [] -> 3992 undefined; 3993 [[ImportsList]] -> 3994 case get_importmoduleoftype(ImportsList,Name) of 3995 undefined -> 3996 undefined; 3997 NextMod -> 3998 renamed_reference(S,Name,NextMod) 3999 end 4000 end 4001 end; 4002 [[NewTypeName]] -> 4003 NewTypeName 4004 end 4005 end. 4006 4007get_importmoduleoftype([I|Is],Name) -> 4008 Index = #'Externaltypereference'.type, 4009 case lists:keysearch(Name,Index,I#'SymbolsFromModule'.symbols) of 4010 {value,_Ref} -> 4011 (I#'SymbolsFromModule'.module)#'Externaltypereference'.type; 4012 _ -> 4013 get_importmoduleoftype(Is,Name) 4014 end; 4015get_importmoduleoftype([],_) -> 4016 undefined. 4017 4018match_parameters(S, Names) -> 4019 [match_parameter(S, Name) || Name <- Names]. 4020 4021match_parameter(#state{parameters=Ps}=S, Name) -> 4022 match_parameter(S, Name, Ps). 4023 4024match_parameter(_S, Name, []) -> 4025 Name; 4026match_parameter(S, {valueset,{element_set,#type{}=Ts,none}}, Ps) -> 4027 match_parameter(S, {valueset,Ts}, Ps); 4028match_parameter(_S, #'Externaltypereference'{type=Name}, 4029 [{#'Externaltypereference'{type=Name},NewName}|_T]) -> 4030 NewName; 4031match_parameter(_S, #'Externaltypereference'{type=Name}, 4032 [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> 4033 NewName; 4034match_parameter(_S, #'Externalvaluereference'{value=Name}, 4035 [{#'Externalvaluereference'{value=Name},NewName}|_T]) -> 4036 NewName; 4037match_parameter(_S, #'Externalvaluereference'{value=Name}, 4038 [{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) -> 4039 NewName; 4040match_parameter(_S, #type{def=#'Externaltypereference'{module=M,type=Name}}, 4041 [{#'Externaltypereference'{module=M,type=Name},Type}]) -> 4042 Type; 4043match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, 4044 [{{_,#'Externaltypereference'{type=Name}}, 4045 {valueset,#type{def=NewName}}}|_T]) -> 4046 NewName; 4047match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, 4048 [{{_,#'Externaltypereference'{type=Name}}, 4049 NewName=#type{def=#'Externaltypereference'{}}}|_T]) -> 4050 NewName#type.def; 4051match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, 4052 [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> 4053 NewName; 4054%% When a parameter is a parameterized element it has to be 4055%% instantiated now! 4056match_parameter(S, {valueset,T=#type{def={pt,_,_Args}}}, _Ps) -> 4057 try check_type(S,#typedef{name=S#state.tname,typespec=T},T) of 4058 #type{def=Ts} -> 4059 Ts 4060 catch pobjectsetdef -> 4061 {_,ObjRef,_Params} = T#type.def, 4062 {_,ObjDef}=get_referenced_type(S,ObjRef), 4063 %%ObjDef is a pvaluesetdef where the type field holds the class 4064 ClassRef = 4065 case ObjDef of 4066 #pvaluesetdef{type=TDef} -> 4067 TDef#type.def; 4068 #pobjectsetdef{class=ClRef} -> ClRef 4069 end, 4070 %% The reference may not have the home module of the class 4071 {HomeMod,_} = get_referenced_type(S,ClassRef), 4072 RightClassRef = 4073 ClassRef#'Externaltypereference'{module=HomeMod}, 4074 4075 ObjectSet = #'ObjectSet'{class=RightClassRef,set=T}, 4076 ObjSpec = check_object(S,#typedef{typespec=ObjectSet},ObjectSet), 4077 Name = list_to_atom(asn1ct_gen:list2name([get_datastr_name(ObjDef)|S#state.recordtopname])), 4078 save_object_set_instance(S,Name,ObjSpec) 4079 end; 4080 4081%% same as previous, only depends on order of parsing 4082match_parameter(S, {valueset,{pos,{objectset,_,POSref},Args}}, Ps) -> 4083 match_parameter(S, {valueset,#type{def={pt,POSref,Args}}}, Ps); 4084match_parameter(S, Name, [_H|T]) -> 4085 %%io:format("match_parameter(~p,~p)~n",[Name,[H|T]]), 4086 match_parameter(S, Name, T). 4087 4088imported(S,Name) -> 4089 {imports,Ilist} = (S#state.module)#module.imports, 4090 imported1(Name,Ilist). 4091 4092imported1(Name, 4093 [#'SymbolsFromModule'{symbols=Symlist, 4094 module=#'Externaltypereference'{type=ModuleName}}|T]) -> 4095 case lists:keysearch(Name,#'Externaltypereference'.type,Symlist) of 4096 {value,_V} -> 4097 {ok,ModuleName}; 4098 _ -> 4099 imported1(Name,T) 4100 end; 4101imported1(_Name,[]) -> 4102 false. 4103 4104%% Check the named number list for an INTEGER or a BIT STRING. 4105check_named_number_list(_S, []) -> 4106 []; 4107check_named_number_list(_S, [{_,_}|_]=NNL) -> 4108 %% The named number list has already been checked. 4109 NNL; 4110check_named_number_list(S, NNL0) -> 4111 %% Check that the names are unique. 4112 case check_unique(NNL0, 2) of 4113 [] -> 4114 NNL1 = [{Id,resolve_valueref(S, Val)} || {'NamedNumber',Id,Val} <- NNL0], 4115 NNL = lists:keysort(2, NNL1), 4116 case check_unique(NNL, 2) of 4117 [] -> 4118 NNL; 4119 [Val|_] -> 4120 asn1_error(S, {value_reused,Val}) 4121 end; 4122 [H|_] -> 4123 asn1_error(S, {namelist_redefinition,H}) 4124 end. 4125 4126resolve_valueref(S, #'Externalvaluereference'{} = T) -> 4127 get_referenced_value(S, T); 4128resolve_valueref(_, Val) when is_integer(Val) -> 4129 Val. 4130 4131check_integer(S, NNL) -> 4132 check_named_number_list(S, NNL). 4133 4134check_bitstring(S, NNL0) -> 4135 NNL = check_named_number_list(S, NNL0), 4136 _ = [asn1_error(S, {invalid_bit_number,Bit}) || 4137 {_,Bit} <- NNL, Bit < 0], 4138 NNL. 4139 4140check_real(_S,_Constr) -> 4141 ok. 4142 4143%% Check INSTANCE OF 4144%% check that DefinedObjectClass is of TYPE-IDENTIFIER class 4145%% If Constraint is empty make it the general INSTANCE OF type 4146%% If Constraint is not empty make an inlined type 4147%% convert INSTANCE OF to the associated type 4148check_instance_of(S,DefinedObjectClass,Constraint) -> 4149 check_type_identifier(S,DefinedObjectClass), 4150 iof_associated_type(S,Constraint). 4151 4152check_type_identifier(S, Eref=#'Externaltypereference'{type=Class}) -> 4153 case get_referenced_type(S, Eref) of 4154 {_,#classdef{name='TYPE-IDENTIFIER'}} -> 4155 ok; 4156 {_,#classdef{typespec=#'Externaltypereference'{}=NextEref}} -> 4157 check_type_identifier(S, NextEref); 4158 {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> 4159 check_type_identifier(S, (TD#typedef.typespec)#type.def); 4160 _ -> 4161 asn1_error(S, {illegal_instance_of,Class}) 4162 end. 4163 4164iof_associated_type(S,[]) -> 4165 %% in this case encode/decode functions for INSTANCE OF must be 4166 %% generated 4167 case get(instance_of) of 4168 undefined -> 4169 AssociateSeq = iof_associated_type1(S,[]), 4170 Tag = [?TAG_CONSTRUCTED(?N_INSTANCE_OF)], 4171 TypeDef=#typedef{checked=true, 4172 name='INSTANCE OF', 4173 typespec=#type{tag=Tag, 4174 def=AssociateSeq}}, 4175 asn1_db:dbput(S#state.mname,'INSTANCE OF',TypeDef), 4176 instance_of_decl(S#state.mname); 4177 _ -> 4178 instance_of_decl(S#state.mname), 4179 ok 4180 end, 4181 #'Externaltypereference'{module=S#state.mname,type='INSTANCE OF'}; 4182iof_associated_type(S,C) -> 4183 iof_associated_type1(S,C). 4184 4185iof_associated_type1(S,C) -> 4186 {TableCInf,Comp1Cnstr,Comp2Cnstr,Comp2tablecinf}= 4187 instance_of_constraints(S,C), 4188 4189 ModuleName = S#state.mname, 4190 Typefield_type= 4191 case C of 4192 [] -> 'ASN1_OPEN_TYPE'; 4193 _ -> {typefield,'Type'} 4194 end, 4195 ObjIdTag = [{'UNIVERSAL',8}], 4196 C1TypeTag = [#tag{class='UNIVERSAL', 4197 number=6, 4198 type='IMPLICIT', 4199 form=0}], 4200 TypeIdentifierRef=#'Externaltypereference'{module=ModuleName, 4201 type='TYPE-IDENTIFIER'}, 4202 ObjectIdentifier = 4203 #'ObjectClassFieldType'{classname=TypeIdentifierRef, 4204 class=[], 4205 fieldname={id,[]}, 4206 type={fixedtypevaluefield,id, 4207 #type{def='OBJECT IDENTIFIER'}}}, 4208 Typefield = 4209 #'ObjectClassFieldType'{classname=TypeIdentifierRef, 4210 class=[], 4211 fieldname={'Type',[]}, 4212 type=Typefield_type}, 4213 IOFComponents0 = 4214 [#'ComponentType'{name='type-id', 4215 typespec=#type{tag=C1TypeTag, 4216 def=ObjectIdentifier, 4217 constraint=Comp1Cnstr}, 4218 prop=mandatory, 4219 tags=ObjIdTag}, 4220 #'ComponentType'{name=value, 4221 typespec=#type{tag=[#tag{class='CONTEXT', 4222 number=0, 4223 type='EXPLICIT', 4224 form=32}], 4225 def=Typefield, 4226 constraint=Comp2Cnstr, 4227 tablecinf=Comp2tablecinf}, 4228 prop=mandatory, 4229 tags=[{'CONTEXT',0}]}], 4230 IOFComponents = textual_order(IOFComponents0), 4231 #'SEQUENCE'{tablecinf=TableCInf, 4232 components=simplify_comps(IOFComponents)}. 4233 4234 4235%% returns the leading attribute, the constraint of the components and 4236%% the tablecinf value for the second component. 4237instance_of_constraints(_, []) -> 4238 {false,[],[],[]}; 4239instance_of_constraints(S, [{element_set,{simpletable,C},none}]) -> 4240 {element_set,Type,none} = C, 4241 instance_of_constraints_1(S, Type). 4242 4243instance_of_constraints_1(S, Type) -> 4244 #type{def=#'Externaltypereference'{type=Name}} = Type, 4245 ModuleName = S#state.mname, 4246 ObjectSetRef=#'Externaltypereference'{module=ModuleName, 4247 type=Name}, 4248 CRel=[{componentrelation,{objectset, 4249 undefined, %% pos 4250 ObjectSetRef}, 4251 [{innermost, 4252 [#'Externalvaluereference'{module=ModuleName, 4253 value=type}]}]}], 4254 Mod = S#state.mname, 4255 TableCInf=#simpletableattributes{objectsetname={Mod,Name}, 4256 c_name='type-id', 4257 c_index=1, 4258 usedclassfield=id, 4259 uniqueclassfield=id, 4260 valueindex=[]}, 4261 {TableCInf,[{simpletable,Name}],CRel,[{objfun,ObjectSetRef}]}. 4262 4263%%% 4264%%% Check ENUMERATED. 4265%%% 4266 4267check_enumerated(_S, [{Name,Number}|_]=NNL) 4268 when is_atom(Name), is_integer(Number) -> 4269 %% Already checked. 4270 NNL; 4271check_enumerated(_S, {[{Name,Number}|_],L}=NNL) 4272 when is_atom(Name), is_integer(Number), is_list(L) -> 4273 %% Already checked (with extension). 4274 NNL; 4275check_enumerated(S, NNL) -> 4276 check_enum_ids(S, NNL, gb_sets:empty()), 4277 check_enum(S, NNL, gb_sets:empty(), []). 4278 4279check_enum_ids(S, [{'NamedNumber',Id,_}|T], Ids0) -> 4280 Ids = check_enum_update_ids(S, Id, Ids0), 4281 check_enum_ids(S, T, Ids); 4282check_enum_ids(S, ['EXTENSIONMARK'|T], Ids) -> 4283 check_enum_ids(S, T, Ids); 4284check_enum_ids(S, [Id|T], Ids0) when is_atom(Id) -> 4285 Ids = check_enum_update_ids(S, Id, Ids0), 4286 check_enum_ids(S, T, Ids); 4287check_enum_ids(_, [], _) -> 4288 ok. 4289 4290check_enum(S, [{'NamedNumber',Id,N}|T], Used0, Acc) -> 4291 Used = check_enum_update_used(S, Id, N, Used0), 4292 check_enum(S, T, Used, [{Id,N}|Acc]); 4293check_enum(S, ['EXTENSIONMARK'|Ext0], Used0, Acc0) -> 4294 Acc = lists:reverse(Acc0), 4295 {Root,Used,Cnt} = check_enum_number_root(Acc, Used0, 0, []), 4296 Ext = check_enum_ext(S, Ext0, Used, Cnt, []), 4297 {Root,Ext}; 4298check_enum(S, [Id|T], Used, Acc) when is_atom(Id) -> 4299 check_enum(S, T, Used, [Id|Acc]); 4300check_enum(_, [], Used, Acc0) -> 4301 Acc = lists:reverse(Acc0), 4302 {Root,_,_} = check_enum_number_root(Acc, Used, 0, []), 4303 lists:keysort(2, Root). 4304 4305check_enum_number_root([Id|T]=T0, Used0, Cnt, Acc) when is_atom(Id) -> 4306 case gb_sets:is_element(Cnt, Used0) of 4307 false -> 4308 Used = gb_sets:insert(Cnt, Used0), 4309 check_enum_number_root(T, Used, Cnt+1, [{Id,Cnt}|Acc]); 4310 true -> 4311 check_enum_number_root(T0, Used0, Cnt+1, Acc) 4312 end; 4313check_enum_number_root([H|T], Used, Cnt, Acc) -> 4314 check_enum_number_root(T, Used, Cnt, [H|Acc]); 4315check_enum_number_root([], Used, Cnt, Acc) -> 4316 {lists:keysort(2, Acc),Used,Cnt}. 4317 4318check_enum_ext(S, [{'NamedNumber',Id,N}|T], Used0, C, Acc) -> 4319 Used = check_enum_update_used(S, Id, N, Used0), 4320 if 4321 N < C -> 4322 asn1_error(S, {enum_not_ascending,Id,N,C-1}); 4323 true -> 4324 ok 4325 end, 4326 check_enum_ext(S, T, Used, N+1, [{Id,N}|Acc]); 4327check_enum_ext(S, [Id|T]=T0, Used0, C, Acc) when is_atom(Id) -> 4328 case gb_sets:is_element(C, Used0) of 4329 true -> 4330 check_enum_ext(S, T0, Used0, C+1, Acc); 4331 false -> 4332 Used = gb_sets:insert(C, Used0), 4333 check_enum_ext(S, T, Used, C+1, [{Id,C}|Acc]) 4334 end; 4335check_enum_ext(_, [], _, _, Acc) -> 4336 lists:keysort(2, Acc). 4337 4338check_enum_update_ids(S, Id, Ids) -> 4339 case gb_sets:is_element(Id, Ids) of 4340 false -> 4341 gb_sets:insert(Id, Ids); 4342 true -> 4343 asn1_error(S, {enum_illegal_redefinition,Id}) 4344 end. 4345 4346check_enum_update_used(S, Id, N, Used) -> 4347 case gb_sets:is_element(N, Used) of 4348 false -> 4349 gb_sets:insert(N, Used); 4350 true -> 4351 asn1_error(S, {enum_reused_value,Id,N}) 4352 end. 4353 4354%%% 4355%%% End of ENUMERATED checking. 4356%%% 4357 4358check_boolean(_S,_Constr) -> 4359 ok. 4360 4361check_octetstring(_S,_Constr) -> 4362 ok. 4363 4364%% check all aspects of a SEQUENCE 4365%% - that all component names are unique 4366%% - that all TAGS are ok (when TAG default is applied) 4367%% - that each component is of a valid type 4368%% - that the extension marks are valid 4369 4370check_sequence(S,Type,Comps) -> 4371 Components = expand_components(S,Comps), 4372 case check_unique([C||C <- Components ,is_record(C,'ComponentType')] 4373 ,#'ComponentType'.name) of 4374 [] -> 4375 %% sort_canonical(Components), 4376 Components2 = maybe_automatic_tags(S,Components), 4377 %% check the table constraints from here. The outermost type 4378 %% is Type, the innermost is Comps (the list of components) 4379 NewComps = check_each_component2(S,Type,Components2), 4380 check_unique_sequence_tags(S,NewComps), 4381 4382 %% CRelInf is the "leading attribute" information 4383 %% necessary for code generating of the look up in the 4384 %% object set table, 4385 %% i.e. getenc_ObjectSet/getdec_ObjectSet. 4386 %% {objfun,ERef} tuple added in NewComps2 in tablecinf 4387 %% field in type record of component relation constrained 4388 %% type 4389 {CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps), 4390 4391 %% CompListWithTblInf has got a lot unecessary info about 4392 %% the involved class removed, as the class of the object 4393 %% set. 4394 CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2), 4395 4396 NewComps3 = textual_order(CompListWithTblInf), 4397 NewComps4 = simplify_comps(NewComps3), 4398 CompListTuple = asn1ct_gen:complist_as_tuple(NewComps4), 4399 {CRelInf,CompListTuple}; 4400 Dupl -> 4401 asn1_error(S, {duplicate_identifier, error_value(hd(Dupl))}) 4402 end. 4403 4404expand_components(S, [{'COMPONENTS OF',Type}|T]) -> 4405 CompList = expand_components2(S,get_referenced_type(S,Type#type.def)), 4406 expand_components(S,CompList) ++ expand_components(S,T); 4407expand_components(S,[H|T]) -> 4408 [H|expand_components(S,T)]; 4409expand_components(_,[]) -> 4410 []; 4411expand_components(S, {Acc,Ext,Acc2}) -> 4412 expand_components(S,Acc ++ Ext ++ Acc2); 4413expand_components(S, {Acc,Ext}) -> 4414 expand_components(S, Acc ++ Ext). 4415 4416expand_components2(_S,{_,#typedef{typespec=#type{def=Seq}}}) 4417 when is_record(Seq,'SEQUENCE') -> 4418 case Seq#'SEQUENCE'.components of 4419 {R1,_Ext,R2} -> R1 ++ R2; 4420 {Root,_Ext} -> Root; 4421 Root -> take_only_rootset(Root) 4422 end; 4423expand_components2(_S,{_,#typedef{typespec=#type{def=Set}}}) 4424 when is_record(Set,'SET') -> 4425 case Set#'SET'.components of 4426 {R1,_Ext,R2} -> R1 ++ R2; 4427 {Root,_Ext} -> Root; 4428 Root -> take_only_rootset(Root) 4429 end; 4430expand_components2(_S,{_,#typedef{typespec=RefType=#type{def=#'Externaltypereference'{}}}}) -> 4431 [{'COMPONENTS OF',RefType}]; 4432expand_components2(S,{_,PT={pt,_,_}}) -> 4433 PTType = check_type(S,PT,#type{def=PT}), 4434 expand_components2(S,{dummy,#typedef{typespec=PTType}}); 4435expand_components2(S,{_,OCFT = #'ObjectClassFieldType'{}}) -> 4436 UncheckedType = #type{def=OCFT}, 4437 Type = check_type(S,#typedef{typespec=UncheckedType},UncheckedType), 4438 expand_components2(S, {undefined,ocft_def(Type)}); 4439expand_components2(S,{_,ERef}) when is_record(ERef,'Externaltypereference') -> 4440 expand_components2(S,get_referenced_type(S,ERef)); 4441expand_components2(S,{_, What}) -> 4442 asn1_error(S, {illegal_COMPONENTS_OF, error_value(What)}). 4443 4444take_only_rootset([])-> 4445 []; 4446take_only_rootset([#'EXTENSIONMARK'{}|_T])-> 4447 []; 4448take_only_rootset([H|T]) -> 4449 [H|take_only_rootset(T)]. 4450 4451check_unique_sequence_tags(S,CompList) -> 4452 TagComps = case asn1ct_gen:complist_as_tuple(CompList) of 4453 {R1,Ext,R2} -> 4454 R1 ++ [C#'ComponentType'{prop='OPTIONAL'}|| 4455 C = #'ComponentType'{} <- Ext]++R2; 4456 {R1,Ext} -> 4457 R1 ++ [C#'ComponentType'{prop='OPTIONAL'}|| 4458 C = #'ComponentType'{} <- Ext]; 4459 _ -> 4460 CompList 4461 end, 4462 check_unique_sequence_tags0(S,TagComps). 4463 4464check_unique_sequence_tags0(S,[#'ComponentType'{prop=mandatory}|Rest]) -> 4465 check_unique_sequence_tags0(S,Rest); 4466check_unique_sequence_tags0(S,[C=#'ComponentType'{}|Rest]) -> 4467 check_unique_sequence_tags1(S,Rest,[C]);% optional or default 4468check_unique_sequence_tags0(S,[_ExtensionMarker|Rest]) -> 4469 check_unique_sequence_tags0(S,Rest); 4470check_unique_sequence_tags0(_S,[]) -> 4471 true. 4472 4473check_unique_sequence_tags1(S,[C|Rest],Acc) when is_record(C,'ComponentType') -> 4474 case C#'ComponentType'.prop of 4475 mandatory -> 4476 check_unique_tags(S,lists:reverse([C|Acc])), 4477 check_unique_sequence_tags(S,Rest); 4478 _ -> 4479 check_unique_sequence_tags1(S,Rest,[C|Acc]) % default or optional 4480 end; 4481check_unique_sequence_tags1(S,[H|Rest],Acc) -> 4482 check_unique_sequence_tags1(S,Rest,[H|Acc]); 4483check_unique_sequence_tags1(S,[],Acc) -> 4484 check_unique_tags(S,lists:reverse(Acc)). 4485 4486check_sequenceof(S,Type,Component) when is_record(Component,type) -> 4487 simplify_type(check_type(S, Type, Component)). 4488 4489check_set(S,Type,Components) -> 4490 {TableCInf,NewComponents} = check_sequence(S,Type,Components), 4491 check_unique_tags(S, collect_components(NewComponents), []), 4492 case {lists:member(der,S#state.options),S#state.erule} of 4493 {true,_} -> 4494 {Sorted,SortedComponents} = sort_components(der,S,NewComponents), 4495 {Sorted,TableCInf,SortedComponents}; 4496 {_,PER} when PER =:= per; PER =:= uper -> 4497 {Sorted,SortedComponents} = sort_components(per,S,NewComponents), 4498 {Sorted,TableCInf,SortedComponents}; 4499 _ -> 4500 {false,TableCInf,NewComponents} 4501 end. 4502 4503collect_components({C1,C2,C3}) -> 4504 collect_components(C1++C2++C3); 4505collect_components({C1,C2}) -> 4506 collect_components(C1++C2); 4507collect_components(Cs) -> 4508 %% Assert that tags are not empty 4509 [] = [EmptyTag || EmptyTag = #'ComponentType'{tags=[]} <- Cs], 4510 Cs. 4511 4512%% sorting in canonical order according to X.680 8.6, X.691 9.2 4513%% DER: all components shall be sorted in canonical order. 4514%% PER: only root components shall be sorted in canonical order. The 4515%% extension components shall remain in textual order. 4516%% 4517sort_components(der, S, Components) -> 4518 {R1,Ext,R2} = extension(textual_order(Components)), 4519 CompsList = case Ext of 4520 noext -> R1; 4521 _ -> R1 ++ Ext ++ R2 4522 end, 4523 case {untagged_choice(S,CompsList),Ext} of 4524 {false,noext} -> 4525 {true,sort_components1(CompsList)}; 4526 {false,_} -> 4527 {true,{sort_components1(CompsList),[]}}; 4528 {true,noext} -> 4529 %% sort in run-time 4530 {dynamic,R1}; 4531 _ -> 4532 {dynamic,{R1, Ext, R2}} 4533 end; 4534sort_components(per, S, Components) -> 4535 {R1,Ext,R2} = extension(textual_order(Components)), 4536 Root = tag_untagged_choice(S,R1++R2), 4537 case Ext of 4538 noext -> 4539 {true,sort_components1(Root)}; 4540 _ -> 4541 {true,{sort_components1(Root),Ext}} 4542 end. 4543 4544sort_components1(Cs0) -> 4545 Cs1 = [{tag_key(Tag),C} || #'ComponentType'{tags=[Tag|_]}=C <- Cs0], 4546 Cs = lists:sort(Cs1), 4547 [C || {_,C} <- Cs]. 4548 4549tag_key({'UNIVERSAL',Tag}) -> {0,Tag}; 4550tag_key({'APPLICATION',Tag}) -> {1,Tag}; 4551tag_key({'CONTEXT',Tag}) -> {2,Tag}; 4552tag_key({'PRIVATE',Tag}) -> {3,Tag}. 4553 4554untagged_choice(_S,[#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) -> 4555 true; 4556untagged_choice(S,[#'ComponentType'{typespec=#type{tag=[],def=ExRef}}|Rest]) 4557 when is_record(ExRef,'Externaltypereference')-> 4558 case get_referenced_type(S,ExRef) of 4559 {_,#typedef{typespec=#type{tag=[], 4560 def={'CHOICE',_}}}} -> true; 4561 _ -> untagged_choice(S,Rest) 4562 end; 4563untagged_choice(S,[_|Rest]) -> 4564 untagged_choice(S,Rest); 4565untagged_choice(_,[]) -> 4566 false. 4567 4568 4569tag_untagged_choice(S,Cs) -> 4570 tag_untagged_choice(S,Cs,[]). 4571tag_untagged_choice(S,[C = #'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|Rest],Acc) -> 4572 TagList = C#'ComponentType'.tags, 4573 TaggedC = C#'ComponentType'{tags=get_least_tag(TagList)}, 4574 tag_untagged_choice(S,Rest,[TaggedC|Acc]); 4575tag_untagged_choice(S,[C = #'ComponentType'{typespec=#type{tag=[],def=ExRef}}|Rest],Acc) when is_record(ExRef,'Externaltypereference') -> 4576 case get_referenced_type(S,ExRef) of 4577 {_,#typedef{typespec=#type{tag=[], 4578 def={'CHOICE',_}}}} -> 4579 TagList = C#'ComponentType'.tags, 4580 TaggedC = C#'ComponentType'{tags = get_least_tag(TagList)}, 4581 tag_untagged_choice(S,Rest,[TaggedC|Acc]); 4582 _ -> 4583 tag_untagged_choice(S,Rest,[C|Acc]) 4584 end; 4585tag_untagged_choice(S,[C|Rest],Acc) -> 4586 tag_untagged_choice(S,Rest,[C|Acc]); 4587tag_untagged_choice(_S,[],Acc) -> 4588 Acc. 4589get_least_tag([]) -> 4590 []; 4591get_least_tag(TagList) -> 4592 %% The smallest tag 'PRIVATE' < 'CONTEXT' < 'APPLICATION' < 'UNIVERSAL' 4593 Pred = fun({'PRIVATE',_},{'CONTEXT',_}) -> true; 4594 ({'CONTEXT',_},{'APPLICATION',_}) -> true; 4595 ({'APPLICATION',_},{'UNIVERSAL',_}) -> true; 4596 ({A,T1},{A,T2}) when T1 =< T2 -> true; (_,_) -> false 4597 end, 4598 [T|_] = lists:sort(Pred,TagList), 4599 [T]. 4600 4601%% adds the textual order to the components to keep right order of 4602%% components in the asn1-value. 4603textual_order(Cs) -> 4604 Fun = fun(C=#'ComponentType'{},Index) -> 4605 {C#'ComponentType'{textual_order=Index},Index+1}; 4606 (Other,Index) -> 4607 {Other,Index} 4608 end, 4609 {NewCs,_} = textual_order(Cs,Fun,1), 4610 NewCs. 4611textual_order(Cs,Fun,IxIn) when is_list(Cs) -> 4612 lists:mapfoldl(Fun,IxIn,Cs); 4613textual_order({Root,Ext},Fun,IxIn) -> 4614 {NewRoot,IxR} = textual_order(Root,Fun,IxIn), 4615 {NewExt,_} = textual_order(Ext,Fun,IxR), 4616 {{NewRoot,NewExt},dummy}; 4617textual_order({Root1,Ext,Root2},Fun,IxIn) -> 4618 {NewRoot1,IxR} = textual_order(Root1,Fun,IxIn), 4619 {NewExt,IxE} = textual_order(Ext,Fun,IxR), 4620 {NewRoot2,_} = textual_order(Root2,Fun,IxE), 4621 {{NewRoot1,NewExt,NewRoot2},dummy}. 4622 4623extension(Components) when is_list(Components) -> 4624 {Components,noext,[]}; 4625extension({Root,ExtList}) -> 4626 ToOpt = fun(mandatory) -> 4627 'OPTIONAL'; 4628 (X) -> X 4629 end, 4630 {Root, [X#'ComponentType'{prop=ToOpt(Y)}|| 4631 X = #'ComponentType'{prop=Y}<-ExtList],[]}; 4632extension({Root1,ExtList,Root2}) -> 4633 ToOpt = fun(mandatory) -> 4634 'OPTIONAL'; 4635 (X) -> X 4636 end, 4637 {Root1, [X#'ComponentType'{prop=ToOpt(Y)}|| 4638 X = #'ComponentType'{prop=Y}<-ExtList], Root2}. 4639 4640check_setof(S,Type,Component) when is_record(Component,type) -> 4641 simplify_type(check_type(S, Type, Component)). 4642 4643check_selectiontype(S,Name,#type{def=Eref}) 4644 when is_record(Eref,'Externaltypereference') -> 4645 {RefMod,TypeDef} = get_referenced_type(S,Eref), 4646 NewS = S#state{module=load_asn1_module(S,RefMod), 4647 mname=RefMod, 4648 tname=get_datastr_name(TypeDef)}, 4649 check_selectiontype2(NewS,Name,TypeDef); 4650check_selectiontype(S,Name,Type=#type{def={pt,_,_}}) -> 4651 TName = case S#state.recordtopname of 4652 [] -> S#state.tname; 4653 N -> N 4654 end, 4655 TDef = #typedef{name=TName,typespec=Type}, 4656 check_selectiontype2(S,Name,TDef); 4657check_selectiontype(S, _Name, Type) -> 4658 asn1_error(S, {illegal_choice_type, error_value(Type)}). 4659 4660check_selectiontype2(S,Name,TypeDef) -> 4661 NewS = S#state{recordtopname=get_datastr_name(TypeDef)}, 4662 Components = 4663 try 4664 CheckedType = check_type(NewS,TypeDef,TypeDef#typedef.typespec), 4665 get_choice_components(S,CheckedType#type.def) 4666 catch error:_ -> 4667 asn1_error(S, {illegal_choice_type, error_value(TypeDef)}) 4668 end, 4669 case lists:keyfind(Name, #'ComponentType'.name, Components) of 4670 #'ComponentType'{typespec=TS} -> TS; 4671 false -> asn1_error(S, {illegal_id, error_value(Name)}) 4672 end. 4673 4674 4675get_choice_components(_S,{'CHOICE',Components}) when is_list(Components)-> 4676 Components; 4677get_choice_components(_S,{'CHOICE',{C1,C2}}) when is_list(C1),is_list(C2) -> 4678 C1++C2; 4679get_choice_components(S,ERef=#'Externaltypereference'{}) -> 4680 {_RefMod,TypeDef}=get_referenced_type(S,ERef), 4681 #typedef{typespec=TS} = TypeDef, 4682 get_choice_components(S,TS#type.def). 4683 4684 4685 4686check_restrictedstring(_S,_Def,_Constr) -> 4687 ok. 4688 4689check_objectidentifier(_S,_Constr) -> 4690 ok. 4691 4692check_relative_oid(_S,_Constr) -> 4693 ok. 4694%% check all aspects of a CHOICE 4695%% - that all alternative names are unique 4696%% - that all TAGS are ok (when TAG default is applied) 4697%% - that each alternative is of a valid type 4698%% - that the extension marks are valid 4699check_choice(S,Type,Components) when is_list(Components) -> 4700 Components1 = [C||C = #'ComponentType'{} <- Components], 4701 case check_unique(Components1,#'ComponentType'.name) of 4702 [] -> 4703 %% sort_canonical(Components), 4704 Components2 = maybe_automatic_tags(S,Components), 4705 NewComps = check_each_alternative2(S,Type,Components2), 4706 %% ExtensionAdditionGroup markers i.e '[[' ']]' are not 4707 %% significant for encoding/decoding a choice 4708 %% therefore we remove them here 4709 NewComps2 = lists:filter(fun(#'ExtensionAdditionGroup'{}) -> false; 4710 ('ExtensionAdditionGroupEnd') -> false; 4711 (_) -> true 4712 end,NewComps), 4713 NewComps3 = simplify_comps(NewComps2), 4714 check_unique_tags(S, NewComps3), 4715 asn1ct_gen:complist_as_tuple(NewComps3); 4716 Dupl -> 4717 asn1_error(S, {duplicate_identifier,error_value(hd(Dupl))}) 4718 end; 4719check_choice(_S,_,[]) -> 4720 []. 4721 4722maybe_automatic_tags(S,C) -> 4723 TagNos = tag_nums(C), 4724 case (S#state.module)#module.tagdefault of 4725 'AUTOMATIC' -> 4726 generate_automatic_tags(S,C,TagNos); 4727 _ -> 4728 %% maybe is the module a multi file module were only some of 4729 %% the modules have defaulttag AUTOMATIC TAGS then the names 4730 %% of those types are saved in the table automatic_tags 4731 Name= S#state.tname, 4732 case is_automatic_tagged_in_multi_file(Name) of 4733 true -> 4734 generate_automatic_tags(S,C,TagNos); 4735 false -> 4736 C 4737 end 4738 end. 4739 4740%% Pos == 1 for Root1, 2 for Ext, 3 for Root2 4741tag_nums(Cl) -> 4742 tag_nums(Cl,0,0). 4743tag_nums([#'EXTENSIONMARK'{}|Rest],Ext,Root2) -> 4744 tag_nums_ext(Rest,Ext,Root2); 4745tag_nums([_|Rest],Ext,Root2) -> 4746 tag_nums(Rest,Ext+1,Root2+1); 4747tag_nums([],Ext,Root2) -> 4748 [0,Ext,Root2]. 4749tag_nums_ext([#'EXTENSIONMARK'{}|Rest],Ext,Root2) -> 4750 tag_nums_root2(Rest,Ext,Root2); 4751tag_nums_ext([_|Rest],Ext,Root2) -> 4752 tag_nums_ext(Rest,Ext,Root2); 4753tag_nums_ext([],Ext,_Root2) -> 4754 [0,Ext,0]. 4755tag_nums_root2([_|Rest],Ext,Root2) -> 4756 tag_nums_root2(Rest,Ext+1,Root2); 4757tag_nums_root2([],Ext,Root2) -> 4758 [0,Ext,Root2]. 4759 4760is_automatic_tagged_in_multi_file(Name) -> 4761 case asn1ct_table:exists(automatic_tags) of 4762 false -> 4763 %% this case when not multifile compilation 4764 false; 4765 true -> 4766 case asn1ct_table:lookup(automatic_tags, Name) of 4767 [] -> false; 4768 _ -> true 4769 end 4770 end. 4771 4772generate_automatic_tags(_S,C,TagNo) -> 4773 case any_manual_tag(C) of 4774 true -> 4775 C; 4776 false -> 4777 generate_automatic_tags1(C,TagNo) 4778 end. 4779 4780generate_automatic_tags1([H|T],[TagNo|TagNos]) when is_record(H,'ComponentType') -> 4781 #'ComponentType'{typespec=Ts} = H, 4782 NewTs = Ts#type{tag=[#tag{class='CONTEXT', 4783 number=TagNo, 4784 type={default,'IMPLICIT'}, 4785 form= 0 }]}, % PRIMITIVE 4786 [H#'ComponentType'{typespec=NewTs}|generate_automatic_tags1(T,[TagNo+1|TagNos])]; 4787generate_automatic_tags1([ExtMark = #'EXTENSIONMARK'{}|T],[_TagNo|TagNos]) -> 4788 [ExtMark | generate_automatic_tags1(T,TagNos)]; 4789generate_automatic_tags1([H|T],TagList) -> % ExtensionAdditionGroup etc are just ignored 4790 [H | generate_automatic_tags1(T,TagList)]; 4791generate_automatic_tags1([],_) -> 4792 []. 4793 4794%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 4795%% Returns true if there is at least one ComponentType with a manually 4796%% specified tag. No manual tag is indicated by typespec=#type{tag=[]} 4797%% so we check if we find a tag =/= [] and return true in that case 4798%% all other things in the componentlist like (EXTENSIONMARK, 4799%% ExtensionAdditionGroup,...) except ComponentType is simply 4800%% ignored/skipped 4801any_manual_tag([#'ComponentType'{typespec=#type{tag=Tag}}|_Rest]) 4802 when Tag =/= []-> 4803 true; 4804any_manual_tag([_|Rest]) -> 4805 any_manual_tag(Rest); 4806any_manual_tag([]) -> 4807 false. 4808 4809 4810check_unique_tags(S,C) -> 4811 case (S#state.module)#module.tagdefault of 4812 'AUTOMATIC' -> 4813 case any_manual_tag(C) of 4814 false -> 4815 true; 4816 true -> 4817 check_unique_tags(S, C, []) 4818 end; 4819 _ -> 4820 check_unique_tags(S, C, []) 4821 end. 4822 4823check_unique_tags(S, [#'ComponentType'{name=Name,tags=Tags0}|T], Acc) -> 4824 Tags = [{Tag,Name} || Tag <- Tags0], 4825 check_unique_tags(S, T, Tags ++ Acc); 4826check_unique_tags(S, [_|T], Acc) -> 4827 check_unique_tags(S, T, Acc); 4828check_unique_tags(S, [], Acc) -> 4829 R0 = sofs:relation(Acc), 4830 R1 = sofs:relation_to_family(R0), 4831 R2 = sofs:to_external(R1), 4832 Dup = [Els || {_,[_,_|_]=Els} <- R2], 4833 case Dup of 4834 [] -> 4835 ok; 4836 [FirstDupl|_] -> 4837 asn1_error(S, {duplicate_tags,FirstDupl}) 4838 end. 4839 4840check_unique(L,Pos) -> 4841 Slist = lists:keysort(Pos,L), 4842 check_unique2(Slist,Pos,[]). 4843 4844check_unique2([A,B|T],Pos,Acc) when element(Pos,A) == element(Pos,B) -> 4845 check_unique2([B|T],Pos,[element(Pos,B)|Acc]); 4846check_unique2([_|T],Pos,Acc) -> 4847 check_unique2(T,Pos,Acc); 4848check_unique2([],_,Acc) -> 4849 lists:reverse(Acc). 4850 4851 4852%% Replaces check_each_component and does the same work except that 4853%% it keeps the complist as a flat list and does not create a tuple with root and 4854%% extensions separated 4855check_each_component2(S,Type,Components) -> 4856 check_each_component2(S,Type,Components,[]). 4857 4858check_each_component2(S = #state{abscomppath=Path,recordtopname=TopName}, 4859 Type, 4860 [C = #'ComponentType'{name=Cname,typespec=Ts,prop=Prop}|Ct], 4861 Acc) -> 4862 NewAbsCPath = 4863 case Ts#type.def of 4864 #'Externaltypereference'{} -> []; 4865 _ -> [Cname|Path] 4866 end,%%XXX Cname = 'per-message-indicators' 4867 CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, 4868 recordtopname=[Cname|TopName]},Type,Ts), 4869 NewTags = get_taglist(S,CheckedTs), 4870 4871 NewProp = 4872 case normalize_value(S,CheckedTs,Prop,[Cname|TopName]) of 4873 mandatory -> mandatory; 4874 'OPTIONAL' -> 'OPTIONAL'; 4875 DefaultValue -> {'DEFAULT',DefaultValue} 4876 end, 4877 NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags}, 4878 check_each_component2(S,Type,Ct,[NewC|Acc]); 4879 4880check_each_component2(S,Type,[OtherMarker|Ct],Acc) -> 4881 %% let 'EXTENSIONMARK' and 'ExtensionAdditionGroup' markers pass through as is 4882 check_each_component2(S,Type,Ct,[OtherMarker|Acc]); 4883check_each_component2(_S,_,[],Acc) -> 4884 lists:reverse(Acc). 4885 4886 4887%% check_each_alternative2(S,Type,{Rlist,ExtList}) -> 4888%% {check_each_alternative(S,Type,Rlist), 4889%% check_each_alternative(S,Type,ExtList)}; 4890check_each_alternative2(S,Type,[C|Ct]) -> 4891 check_each_alternative2(S,Type,[C|Ct],[]). 4892 4893check_each_alternative2(S=#state{abscomppath=Path,recordtopname=TopName}, 4894 Type, 4895 [C = #'ComponentType'{name=Cname,typespec=Ts}|Ct], 4896 Acc) -> 4897 NewAbsCPath = 4898 case Ts#type.def of 4899 #'Externaltypereference'{} -> []; 4900 _ -> [Cname|Path] 4901 end, 4902 CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, 4903 recordtopname=[Cname|TopName]},Type,Ts), 4904 NewTags = get_taglist(S,CheckedTs), 4905 4906 NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags}, 4907 check_each_alternative2(S,Type,Ct,[NewC|Acc]); 4908 4909check_each_alternative2(S,Type,[OtherMarker|Ct],Acc) -> 4910 %% let 'EXTENSIONMARK' and 'ExtensionAdditionGroup' markers pass through as is 4911 check_each_alternative2(S,Type,Ct,[OtherMarker|Acc]); 4912check_each_alternative2(_S,_,[],Acc) -> 4913 lists:reverse(Acc). 4914 4915 4916%% componentrelation_leadingattr/2 searches the structure for table 4917%% constraints, if any is found componentrelation_leadingattr/5 is 4918%% called. 4919componentrelation_leadingattr(S,CompList) -> 4920 4921 %% get_simple_table_if_used/2 should find out whether there are any 4922 %% component relation constraints in the entire tree of Cs1 that 4923 %% relates to this level. It returns information about the simple 4924 %% table constraint necessary for the the call to 4925 %% componentrelation_leadingattr/6. The step when the leading 4926 %% attribute and the syntax tree is modified to support the code 4927 %% generating. 4928 case get_simple_table_if_used(S,CompList) of 4929 [] -> {false,CompList}; 4930 _ -> 4931 componentrelation_leadingattr(S,CompList,CompList,[],[]) 4932 end. 4933 4934 4935%%FIXME expand_ExtAddGroups([C#'ExtensionAdditionGroup'{components=ExtAdds}|T], 4936%% CurrPos,PosAcc,CompAcc) -> 4937%% expand_ExtAddGroups(T,CurrPos+ L = length(ExtAdds),[{CurrPos,L}|PosAcc],ExtAdds++CompAcc); 4938%% expand_ExtAddGroups([C|T],CurrPos,PosAcc,CompAcc) -> 4939%% expand_ExtAddGroups(T,CurrPos+ 1,PosAcc,[C|CompAcc]); 4940%% expand_ExtAddGroups([],_CurrPos,PosAcc,CompAcc) -> 4941%% {lists:reverse(PosAcc),lists:reverse(CompAcc)}. 4942 4943 4944%% componentrelation_leadingattr/6 when all components are searched 4945%% the new modified components are returned together with the "leading 4946%% attribute" information, which later is stored in the tablecinf 4947%% field in the SEQUENCE/SET record. The "leading attribute" 4948%% information is used to generate the lookup in the object set 4949%% table. The other information gathered in the #type.tablecinf field 4950%% is used in code generating phase too, to recognice the proper 4951%% components for "open type" encoding and to propagate the result of 4952%% the object set lookup when needed. 4953componentrelation_leadingattr(_,[],_CompList,[],NewCompList) -> 4954 {false,lists:reverse(NewCompList)}; 4955componentrelation_leadingattr(_,[],_CompList,LeadingAttr,NewCompList) -> 4956 {lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later 4957componentrelation_leadingattr(S,[C= #'ComponentType'{}|Cs],CompList,Acc,CompAcc) -> 4958 {LAAcc,NewC} = 4959 case catch componentrelation1(S,C#'ComponentType'.typespec, 4960 [C#'ComponentType'.name]) of 4961 {'EXIT',_} -> 4962 {[],C}; 4963 {CRI=[{_A1,_B1,_C1,_D1}|_Rest],NewTSpec} -> 4964 %% {ObjectSet,AtPath,ClassDef,Path} 4965 %% _A1 is a reference to the object set of the 4966 %% component relation constraint. 4967 %% _B1 is the path of names in the at-list of the 4968 %% component relation constraint. 4969 %% _C1 is the class definition of the 4970 %% ObjectClassFieldType. 4971 %% _D1 is the path of components that was traversed to 4972 %% find this constraint. 4973 case leading_attr_index(S,CompList,CRI, 4974 lists:reverse(S#state.abscomppath),[]) of 4975 [] -> 4976 {[],C}; 4977 [{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] -> 4978 OS = object_set_mod_name(S,ObjSet), 4979 UniqFN = get_unique_fieldname(S, 4980 #classdef{typespec=ClassDef}), 4981 %% Res should be done differently: even though 4982 %% a unique field name exists it is not 4983 %% certain that the ObjectClassFieldType of 4984 %% the simple table constraint picks that 4985 %% class field. 4986 Res = #simpletableattributes{objectsetname=OS, 4987 c_name=Attr, 4988 c_index=N, 4989 usedclassfield=UniqFN, 4990 uniqueclassfield=UniqFN, 4991 valueindex=ValueIndex}, 4992 {[Res],C#'ComponentType'{typespec=NewTSpec}} 4993 end; 4994 _ -> 4995 %% no constraint was found 4996 {[],C} 4997 end, 4998 componentrelation_leadingattr(S,Cs,CompList,LAAcc++Acc, 4999 [NewC|CompAcc]); 5000componentrelation_leadingattr(S,[NotComponentType|Cs],CompList,LeadingAttr,NewCompList) -> 5001 componentrelation_leadingattr(S,Cs,CompList,LeadingAttr,[NotComponentType|NewCompList]). 5002 5003 5004object_set_mod_name(_S,ObjSet) when is_atom(ObjSet) -> 5005 ObjSet; 5006object_set_mod_name(#state{mname=M}, 5007 #'Externaltypereference'{module=M,type=T}) -> 5008 {M,T}; 5009object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) -> 5010 case lists:member(M,S#state.inputmodules) of 5011 true -> 5012 T; 5013 false -> 5014 {M,T} 5015 end. 5016 5017 5018%% get_simple_table_if_used/2 searches the structure of Cs for any 5019%% component relation constraints due to the present level of the 5020%% structure. If there are any, the necessary information for code 5021%% generation of the look up functionality in the object set table are 5022%% returned. 5023get_simple_table_if_used(S,Cs) -> 5024 CNames = [Name||#'ComponentType'{name=Name}<-Cs], 5025 JustComponents = [C || C = #'ComponentType'{}<-Cs], 5026 RefedSimpleTable=any_component_relation(S,JustComponents,CNames,[],[]), 5027 get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)). 5028 5029remove_doubles(L) -> 5030 remove_doubles(L,[]). 5031remove_doubles([H|T],Acc) -> 5032 NewT = remove_doubles1(H,T), 5033 remove_doubles(NewT,[H|Acc]); 5034remove_doubles([],Acc) -> 5035 Acc. 5036 5037remove_doubles1(El,L) -> 5038 case lists:delete(El,L) of 5039 L -> L; 5040 NewL -> remove_doubles1(El,NewL) 5041 end. 5042 5043%% get_simple_table_info searches the components Cs by the path from 5044%% an at-list (third argument), and follows into a component of it if 5045%% necessary, to get information needed for code generating. 5046%% 5047%% Returns a list of tuples with three elements. It holds a list of 5048%% atoms that is the path, the name of the field of the class that are 5049%% referred to in the ObjectClassFieldType, and the name of the unique 5050%% field of the class of the ObjectClassFieldType. 5051%% 5052%% The level information outermost/innermost must be kept. There are 5053%% at least two possibilities to cover here for an outermost case: 1) 5054%% Both the simple table and the component relation have a common path 5055%% at least one step below the outermost level, i.e. the leading 5056%% information shall be on a sub level. 2) They don't have any common 5057%% path. 5058get_simple_table_info(S, Cs, AtLists) -> 5059 [get_simple_table_info1(S, Cs, AtList, []) || AtList <- AtLists]. 5060 5061get_simple_table_info1(S, Cs, [Cname|Cnames], Path) -> 5062 #'ComponentType'{} = C = 5063 lists:keyfind(Cname, #'ComponentType'.name, Cs), 5064 get_simple_table_info2(S, C, Cnames, [Cname|Path]). 5065 5066get_simple_table_info2(S, #'ComponentType'{name=Name,typespec=TS}, [], Path) -> 5067 OCFT = simple_table_get_ocft(S, Name, TS), 5068 case lists:keymember(simpletable, 1, TS#type.constraint) of 5069 true -> 5070 simple_table_info(S, OCFT, Path); 5071 false -> 5072 asn1_error(S, {missing_table_constraint,Name}) 5073 end; 5074get_simple_table_info2(S, #'ComponentType'{typespec=TS}, Cnames, Path) -> 5075 Components = get_atlist_components(TS#type.def), 5076 get_simple_table_info1(S, Components, Cnames, Path). 5077 5078simple_table_get_ocft(_, _, #type{def=#'ObjectClassFieldType'{}=OCFT}) -> 5079 OCFT; 5080simple_table_get_ocft(S, Component, #type{constraint=Constr}) -> 5081 case lists:keyfind(ocft, 1, Constr) of 5082 {ocft,OCFT} -> 5083 OCFT; 5084 false -> 5085 asn1_error(S, {missing_ocft,Component}) 5086 end. 5087 5088simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef, 5089 class=ObjectClass, 5090 fieldname=FieldName},Path) -> 5091 5092 ObjectClassFieldName = 5093 case FieldName of 5094 {LastFieldName,[]} -> LastFieldName; 5095 {_FirstFieldName,FieldNames} -> 5096 lists:last(FieldNames) 5097 end, 5098 %% ObjectClassFieldName is the last element in the dotted list of 5099 %% the ObjectClassFieldType. The last element may be of another 5100 %% class, that is referenced from the class of the 5101 %% ObjectClassFieldType 5102 ClassDef = 5103 case ObjectClass of 5104 [] -> 5105 {_,CDef}=get_referenced_type(S,ClRef), 5106 CDef; 5107 _ -> #classdef{typespec=ObjectClass} 5108 end, 5109 UniqueName = get_unique_fieldname(S, ClassDef), 5110 {lists:reverse(Path),ObjectClassFieldName,UniqueName}. 5111 5112%% any_component_relation searches for all component relation 5113%% constraints that refers to the actual level and returns a list of 5114%% the "name path" in the at-list to the component relation constraint 5115%% that must refer to a simple table constraint. The list is empty if 5116%% no component relation constraints were found. 5117%% 5118%% NamePath has the names of all components that are followed from the 5119%% beginning of the search. CNames holds the names of all components 5120%% of the start level, this info is used if an outermost at-notation 5121%% is found to check the validity of the at-list. 5122any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,NamePath,Acc) -> 5123 CRelPath = 5124 case lists:keyfind(componentrelation, 1, Type#type.constraint) of 5125 {_,_,AtNotation} -> 5126 %% Found component relation constraint, now check 5127 %% whether this constraint is relevant for the level 5128 %% where the search started 5129 AtNot = extract_at_notation(AtNotation), 5130 5131 %% evaluate_atpath returns the relative path to the 5132 %% simple table constraint from where the component 5133 %% relation is found. 5134 evaluate_atpath(S,NamePath,CNames,AtNot); 5135 false -> 5136 [] 5137 end, 5138 InnerAcc = 5139 case {Type#type.inlined, 5140 asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of 5141 {no,{constructed,bif}} -> 5142 5143 {InnerCs,NewNamePath} = 5144 case get_components(Type#type.def) of 5145 T when is_record(T,type) -> {T,NamePath}; 5146 IC -> {IC,[CName|NamePath]} 5147 end, 5148 %% here we are interested in components of an 5149 %% SEQUENCE/SET OF as well as SEQUENCE, SET and CHOICE 5150 any_component_relation(S,InnerCs,CNames,NewNamePath,[]); 5151 _ -> 5152 [] 5153 end, 5154 any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc); 5155any_component_relation(S,Type,CNames,NamePath,Acc) when is_record(Type,type) -> 5156 CRelPath = 5157 case lists:keyfind(componentrelation, 1, Type#type.constraint) of 5158 {_,_,AtNotation} -> 5159 AtNot = extract_at_notation(AtNotation), 5160 evaluate_atpath(S,NamePath,CNames,AtNot); 5161 false -> 5162 [] 5163 end, 5164 InnerAcc = 5165 case {Type#type.inlined, 5166 asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of 5167 {no,{constructed,bif}} -> 5168 InnerCs = get_components(Type#type.def), 5169 any_component_relation(S,InnerCs,CNames,NamePath,[]); 5170 _ -> 5171 [] 5172 end, 5173 InnerAcc ++ CRelPath ++ Acc; 5174%% Just skip the markers for ExtensionAdditionGroup start and end 5175%% in this function 5176any_component_relation(S,[#'ExtensionAdditionGroup'{}|Cs],CNames,NamePath,Acc) -> 5177 any_component_relation(S,Cs,CNames,NamePath,Acc); 5178any_component_relation(S,['ExtensionAdditionGroupEnd'|Cs],CNames,NamePath,Acc) -> 5179 any_component_relation(S,Cs,CNames,NamePath,Acc); 5180any_component_relation(_,[],_,_,Acc) -> 5181 Acc. 5182 5183%% evaluate_atpath/4 finds out whether the at notation refers to the 5184%% search level. The list of referenced names in the AtNot list shall 5185%% begin with a name that exists on the level it refers to. If the 5186%% found AtPath is refering to the same sub-branch as the simple table 5187%% has, then there shall not be any leading attribute info on this 5188%% level. 5189evaluate_atpath(_,[],Cnames,{innermost,AtPath=[Ref|_Refs]}) -> 5190 %% any innermost constraint found deeper in the structure is 5191 %% ignored. 5192 case lists:member(Ref,Cnames) of 5193 true -> [AtPath]; 5194 false -> [] 5195 end; 5196%% In this case must check that the AtPath doesn't step any step of 5197%% the NamePath, in that case the constraint will be handled in an 5198%% inner level. 5199evaluate_atpath(S=#state{abscomppath=TopPath},NamePath,Cnames,{outermost,AtPath=[_Ref|_Refs]}) -> 5200 AtPathBelowTop = 5201 case TopPath of 5202 [] -> AtPath; 5203 _ -> 5204 case lists:prefix(TopPath,AtPath) of 5205 true -> 5206 lists:subtract(AtPath,TopPath); 5207 _ -> [] 5208 end 5209 end, 5210 case {NamePath,AtPathBelowTop} of 5211 {[H|_T1],[H|_T2]} -> []; % this must be handled in lower level 5212 {_,[]} -> [];% this must be handled in an above level 5213 {_,[H|_T]} -> 5214 case lists:member(H,Cnames) of 5215 true -> [AtPathBelowTop]; 5216 _ -> asn1_error(S, {invalid_at_path, AtPath}) 5217 end 5218 end; 5219evaluate_atpath(_,_,_,_) -> 5220 []. 5221 5222%% Type may be any of SEQUENCE, SET, CHOICE, SEQUENCE OF, SET OF but 5223%% only the three first have valid components. 5224get_atlist_components(Def) -> 5225 get_components(atlist,Def). 5226 5227get_components(Def) -> 5228 get_components(any,Def). 5229 5230get_components(_,#'SEQUENCE'{components=Cs}) -> 5231 tuple2complist(Cs); 5232get_components(_,#'SET'{components=Cs}) -> 5233 tuple2complist(Cs); 5234get_components(_,{'CHOICE',Cs}) -> 5235 tuple2complist(Cs); 5236%%do not step in inlined structures 5237get_components(any,{'SEQUENCE OF',T = #type{def=_Def,inlined=no}}) -> 5238 T; 5239get_components(any,{'SET OF',T = #type{def=_Def,inlined=no}}) -> 5240 T; 5241get_components(_,_) -> 5242 []. 5243 5244tuple2complist({R,E}) -> 5245 R ++ E; 5246tuple2complist({R1,E,R2}) -> 5247 R1 ++ E ++ R2; 5248tuple2complist(List) when is_list(List) -> 5249 List. 5250 5251extract_at_notation([{Level,ValueRefs}]) -> 5252 {Level,[Name || #'Externalvaluereference'{value=Name} <- ValueRefs]}. 5253 5254%% componentrelation1/1 identifies all componentrelation constraints 5255%% that exist in C or in the substructure of C. Info about the found 5256%% constraints are returned in a list. It is ObjectSet, the reference 5257%% to the object set, AttrPath, the name atoms extracted from the 5258%% at-list in the component relation constraint, ClassDef, the 5259%% objectclass record of the class of the ObjectClassFieldType, Path, 5260%% that is the component name "path" from the searched level to this 5261%% constraint. 5262%% 5263%% The function is called with one component of the type in turn and 5264%% with the component name in Path at the first call. When called from 5265%% within, the name of the inner component is added to Path. 5266componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI}, 5267 Path) -> 5268 Ret = 5269 case lists:keyfind(componentrelation, 1, Constraint) of 5270 {_,{_,_,ObjectSet},AtList} -> 5271 [{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList, 5272 %% Note: if Path is longer than one,i.e. it is within 5273 %% an inner type of the actual level, then the only 5274 %% relevant at-list is of "outermost" type. 5275 ClassDef = get_ObjectClassFieldType_classdef(S,Def), 5276 AtPath = 5277 lists:map(fun(#'Externalvaluereference'{value=V})->V end, 5278 AL), 5279 {[{ObjectSet,AtPath,ClassDef,Path}],Def}; 5280 false -> 5281 %% check the inner type of component 5282 innertype_comprel(S,Def,Path) 5283 end, 5284 case Ret of 5285 nofunobj -> 5286 nofunobj; %% ignored by caller 5287 {CRelI=[{ObjSet,_,_,_}],NewDef} -> %% 5288 TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), 5289 {CRelI,C#type{tablecinf=[{objfun,ObjSet}|TCItmp],def=NewDef}}; 5290 {CompRelInf,NewDef} -> %% more than one tuple in CompRelInf 5291 TCItmp = lists:subtract(TCI,[{objfun,anyset}]), 5292 {CompRelInf,C#type{tablecinf=[{objfun,anyset}|TCItmp],def=NewDef}} 5293 end. 5294 5295innertype_comprel(S,{'SEQUENCE OF',Type},Path) -> 5296 case innertype_comprel1(S,Type,Path) of 5297 nofunobj -> 5298 nofunobj; 5299 {CompRelInf,NewType} -> 5300 {CompRelInf,{'SEQUENCE OF',NewType}} 5301 end; 5302innertype_comprel(S,{'SET OF',Type},Path) -> 5303 case innertype_comprel1(S,Type,Path) of 5304 nofunobj -> 5305 nofunobj; 5306 {CompRelInf,NewType} -> 5307 {CompRelInf,{'SET OF',NewType}} 5308 end; 5309innertype_comprel(S,{'CHOICE',CTypeList},Path) -> 5310 case componentlist_comprel(S,CTypeList,[],Path,[]) of 5311 nofunobj -> 5312 nofunobj; 5313 {CompRelInf,NewCs} -> 5314 {CompRelInf,{'CHOICE',NewCs}} 5315 end; 5316innertype_comprel(S,Seq = #'SEQUENCE'{components=Cs},Path) -> 5317 case componentlist_comprel(S,Cs,[],Path,[]) of 5318 nofunobj -> 5319 nofunobj; 5320 {CompRelInf,NewCs} -> 5321 {CompRelInf,Seq#'SEQUENCE'{components=NewCs}} 5322 end; 5323innertype_comprel(S,Set = #'SET'{components=Cs},Path) -> 5324 case componentlist_comprel(S,Cs,[],Path,[]) of 5325 nofunobj -> 5326 nofunobj; 5327 {CompRelInf,NewCs} -> 5328 {CompRelInf,Set#'SET'{components=NewCs}} 5329 end; 5330innertype_comprel(_,_,_) -> 5331 nofunobj. 5332 5333componentlist_comprel(S,[C = #'ComponentType'{name=Name,typespec=Type}|Cs], 5334 Acc,Path,NewCL) -> 5335 case catch componentrelation1(S,Type,Path++[Name]) of 5336 {'EXIT',_} -> 5337 componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); 5338 nofunobj -> 5339 componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); 5340 {CRelInf,NewType} -> 5341 componentlist_comprel(S,Cs,CRelInf++Acc,Path, 5342 [C#'ComponentType'{typespec=NewType}|NewCL]) 5343 end; 5344componentlist_comprel(_,[],Acc,_,NewCL) -> 5345 case Acc of 5346 [] -> 5347 nofunobj; 5348 _ -> 5349 {Acc,lists:reverse(NewCL)} 5350 end. 5351 5352innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) -> 5353 Ret = 5354 case lists:keyfind(componentrelation, 1, Cons) of 5355 {_,{_,_,ObjectSet},AtList} -> 5356 %% This AtList must have an "outermost" at sign to be 5357 %% relevent here. 5358 [{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2] 5359 = AtList, 5360 ClassDef = get_ObjectClassFieldType_classdef(S,Def), 5361 AtPath = 5362 lists:map(fun(#'Externalvaluereference'{value=V})->V end, 5363 AL), 5364 [{ObjectSet,AtPath,ClassDef,Path}]; 5365 false -> 5366 innertype_comprel(S,Def,Path) 5367 end, 5368 case Ret of 5369 nofunobj -> nofunobj; 5370 L = [{ObjSet,_,_,_}] -> 5371 TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), 5372 {L,T#type{tablecinf=[{objfun,ObjSet}|TCItmp]}}; 5373 {CRelInf,NewDef} -> 5374 TCItmp = lists:subtract(TCI,[{objfun,anyset}]), 5375 {CRelInf,T#type{def=NewDef,tablecinf=[{objfun,anyset}|TCItmp]}} 5376 end. 5377 5378 5379%% leading_attr_index counts the index and picks the name of the 5380%% component that is at the actual level in the at-list of the 5381%% component relation constraint (AttrP). AbsP is the path of 5382%% component names from the top type level to the actual level. AttrP 5383%% is a list with the atoms from the at-list. 5384leading_attr_index(S,Cs,[H={_,AttrP,_,_}|T],AbsP,Acc) -> 5385 AttrInfo = 5386 case lists:prefix(AbsP,AttrP) of 5387 %% why this ?? It is necessary when in same situation as 5388 %% TConstrChoice, there is an inner structure with an 5389 %% outermost at-list and the "leading attribute" code gen 5390 %% may be at a level some steps below the outermost level. 5391 true -> 5392 RelativAttrP = lists:subtract(AttrP,AbsP), 5393 %% The header is used to calculate the index of the 5394 %% component and to give the fun, received from the 5395 %% object set look up, an unique name. The tail is 5396 %% used to match the proper value input to the fun. 5397 {hd(RelativAttrP),tl(RelativAttrP)}; 5398 false -> 5399 {hd(AttrP),tl(AttrP)} 5400 end, 5401 case leading_attr_index1(S,Cs,H,AttrInfo,1) of 5402 0 -> 5403 leading_attr_index(S,Cs,T,AbsP,Acc); 5404 Res -> 5405 leading_attr_index(S,Cs,T,AbsP,[Res|Acc]) 5406 end; 5407leading_attr_index(_,_Cs,[],_,Acc) -> 5408 lists:reverse(Acc). 5409 5410leading_attr_index1(_,[],_,_,_) -> 5411 0; 5412leading_attr_index1(S,[C|Cs],Arg={ObjectSet,_,CDef,P}, 5413 AttrInfo={Attr,SubAttr},N) -> 5414 case C#'ComponentType'.name of 5415 Attr -> 5416 ValueMatch = value_match(S,C,Attr,SubAttr), 5417 {ObjectSet,Attr,N,CDef,P,ValueMatch}; 5418 _ -> 5419 leading_attr_index1(S,Cs,Arg,AttrInfo,N+1) 5420 end. 5421 5422%% value_math gathers information for a proper value match in the 5423%% generated encode function. For a SEQUENCE or a SET the index of the 5424%% component is counted. For a CHOICE the index is 2. 5425value_match(S,C,Name,SubAttr) -> 5426 value_match(S,C,Name,SubAttr,[]). % C has name Name 5427value_match(_S,#'ComponentType'{},_Name,[],Acc) -> 5428 Acc; % do not reverse, indexes in reverse order 5429value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) -> 5430 InnerType = asn1ct_gen:get_inner(Type#type.def), 5431 Components = 5432 case get_atlist_components(Type#type.def) of 5433 [] -> asn1_error(S, {invalid_element, Name}); 5434 Comps -> Comps 5435 end, 5436 {Index,ValueIndex} = component_value_index(S,InnerType,At,Components), 5437 value_match(S,lists:nth(Index,Components),At,Ats,[ValueIndex|Acc]). 5438 5439component_value_index(S,'CHOICE',At,Components) -> 5440 {component_index(S,At,Components),2}; 5441component_value_index(S,_,At,Components) -> 5442 %% SEQUENCE or SET 5443 Index = component_index(S,At,Components), 5444 {Index,{Index+1,At}}. 5445 5446component_index(S,Name,Components) -> 5447 component_index1(S,Name,Components,1). 5448component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) -> 5449 N; 5450component_index1(S,Name,[_C|Cs],N) -> 5451 component_index1(S,Name,Cs,N+1); 5452component_index1(S,Name,[],_) -> 5453 asn1_error(S, {invalid_at_list, Name}). 5454 5455get_unique_fieldname(S, #classdef{typespec=TS}) -> 5456 Fields = TS#objectclass.fields, 5457 get_unique_fieldname1(S, Fields, []); 5458get_unique_fieldname(S,#typedef{typespec=#type{def=ClassRef}}) -> 5459 %% A class definition may be referenced as 5460 %% REFED-CLASS ::= DEFINED-CLASS and then REFED-CLASS is a typedef 5461 {_M,ClassDef} = get_referenced_type(S,ClassRef), 5462 get_unique_fieldname(S,ClassDef). 5463 5464get_unique_fieldname1(S, [{fixedtypevaluefield,Name,_,'UNIQUE',Opt}|T], Acc) -> 5465 get_unique_fieldname1(S, T, [{Name,Opt}|Acc]); 5466get_unique_fieldname1(S, [_|T], Acc) -> 5467 get_unique_fieldname1(S, T, Acc); 5468get_unique_fieldname1(S, [], Acc) -> 5469 case Acc of 5470 [] -> no_unique; 5471 [Name] -> Name; 5472 [_|_] -> asn1_error(S, multiple_uniqs) 5473 end. 5474 5475get_tableconstraint_info(S,Type,{CheckedTs,EComps,CheckedTs2}) -> 5476 {get_tableconstraint_info(S,Type,CheckedTs,[]), 5477 get_tableconstraint_info(S,Type,EComps,[]), 5478 get_tableconstraint_info(S,Type,CheckedTs2,[])}; 5479get_tableconstraint_info(S,Type,{CheckedTs,EComps}) -> 5480 {get_tableconstraint_info(S,Type,CheckedTs,[]), 5481 get_tableconstraint_info(S,Type,EComps,[])}; 5482get_tableconstraint_info(S,Type,CheckedTs) -> 5483 get_tableconstraint_info(S,Type,CheckedTs,[]). 5484 5485get_tableconstraint_info(_S,_Type,[],Acc) -> 5486 lists:reverse(Acc); 5487get_tableconstraint_info(S,Type,[C=#'ComponentType'{typespec=CheckedTs}|Cs],Acc) -> 5488 AccComp = 5489 case CheckedTs#type.def of 5490 %% ObjectClassFieldType 5491 OCFT=#'ObjectClassFieldType'{} -> 5492 NewOCFT = 5493 OCFT#'ObjectClassFieldType'{class=[]}, 5494 C#'ComponentType'{typespec= 5495 CheckedTs#type{ 5496 def=NewOCFT 5497 }}; 5498 {'SEQUENCE OF',SOType} when is_record(SOType,type), 5499 (element(1,SOType#type.def)=='CHOICE') -> 5500 CTypeList = element(2,SOType#type.def), 5501 NewInnerCList = 5502 get_tableconstraint_info(S,Type,CTypeList), 5503 C#'ComponentType'{typespec= 5504 CheckedTs#type{ 5505 def={'SEQUENCE OF', 5506 SOType#type{def={'CHOICE', 5507 NewInnerCList}}}}}; 5508 {'SET OF',SOType} when is_record(SOType,type), 5509 (element(1,SOType#type.def)=='CHOICE') -> 5510 CTypeList = element(2,SOType#type.def), 5511 NewInnerCList = 5512 get_tableconstraint_info(S,Type,CTypeList), 5513 C#'ComponentType'{typespec= 5514 CheckedTs#type{ 5515 def={'SET OF', 5516 SOType#type{def={'CHOICE', 5517 NewInnerCList}}}}}; 5518 _ -> 5519 C 5520 end, 5521 get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]); 5522get_tableconstraint_info(S,Type,[C|Cs],Acc) -> 5523 get_tableconstraint_info(S,Type,Cs,[C|Acc]). 5524 5525get_referenced_fieldname([{_,FirstFieldname}]) -> 5526 {FirstFieldname,[]}; 5527get_referenced_fieldname([{_,FirstFieldname}|T]) -> 5528 {FirstFieldname,[element(2, X) || X <- T]}. 5529 5530%% get_ObjectClassFieldType_classdef gets the def of the class of the 5531%% ObjectClassFieldType, i.e. the objectclass record. If the type has 5532%% been checked (it may be a field type of an internal SEQUENCE) the 5533%% class field = [], then the classdef has to be fetched by help of 5534%% the class reference in the classname field. 5535get_ObjectClassFieldType_classdef(S,#'ObjectClassFieldType'{classname=Name,class=[]}) -> 5536 {_,#classdef{typespec=TS}} = get_referenced_type(S,Name), 5537 TS; 5538get_ObjectClassFieldType_classdef(_,#'ObjectClassFieldType'{class=Cl}) -> 5539 Cl. 5540 5541get_OCFType(S,Fields,FieldnameList=[{_FieldType,_PrimFieldName}|_]) -> 5542 get_OCFType(S,Fields,[PFN||{_,PFN} <- FieldnameList]); 5543get_OCFType(S,Fields,[PrimFieldName|Rest]) -> 5544 case lists:keysearch(PrimFieldName,2,Fields) of 5545 {value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} -> 5546 {fixedtypevaluefield,PrimFieldName,Type}; 5547 {value,{objectfield,_,ClassRef,_Unique,_OptSpec}} -> 5548 {MName,ClassDef} = get_referenced_type(S,ClassRef), 5549 NewS = update_state(S#state{tname=get_datastr_name(ClassDef)}, 5550 MName), 5551 CheckedCDef = check_class(NewS,ClassDef), 5552 get_OCFType(S,CheckedCDef#objectclass.fields,Rest); 5553 {value,{objectsetfield,_,Type,_OptSpec}} -> 5554 {MName,ClassDef} = get_referenced_type(S,Type#type.def), 5555 NewS = update_state(S#state{tname=get_datastr_name(ClassDef)}, 5556 MName), 5557 CheckedCDef = check_class(NewS,ClassDef), 5558 get_OCFType(S,CheckedCDef#objectclass.fields,Rest); 5559 5560 {value,Other} -> 5561 {element(1,Other),PrimFieldName}; 5562 _ -> 5563 asn1_error(S, {illegal_object_field, PrimFieldName}) 5564 end. 5565 5566get_taglist(S,Ext) when is_record(Ext,'Externaltypereference') -> 5567 {_,T} = get_referenced_type(S,Ext), 5568 get_taglist(S,T#typedef.typespec); 5569get_taglist(S,Type) when is_record(Type,type) -> 5570 case Type#type.tag of 5571 [] -> 5572 get_taglist(S,Type#type.def); 5573 [Tag|_] -> 5574 [asn1ct_gen:def_to_tag(Tag)] 5575 end; 5576get_taglist(S,{'CHOICE',{Rc,Ec}}) -> 5577 get_taglist1(S,Rc ++ Ec); 5578get_taglist(S,{'CHOICE',{R1,E,R2}}) -> 5579 get_taglist1(S,R1 ++ E ++ R2); 5580get_taglist(S,{'CHOICE',Components}) -> 5581 get_taglist1(S,Components); 5582%% ObjectClassFieldType OTP-4390 5583get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) -> 5584 []; 5585get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) -> 5586 get_taglist(S,Type); 5587get_taglist(_, _) -> 5588 []. 5589 5590get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when is_list(TagL) -> 5591 %% tag_list has been here , just return TagL and continue with next alternative 5592 TagL ++ get_taglist1(S,Rest); 5593get_taglist1(S,[#'ComponentType'{typespec=Ts,tags=undefined}|Rest]) -> 5594 get_taglist(S,Ts) ++ get_taglist1(S,Rest); 5595get_taglist1(S,[_H|Rest]) -> % skip EXTENSIONMARK 5596 get_taglist1(S,Rest); 5597get_taglist1(_S,[]) -> 5598 []. 5599 5600merge_tags(T1, T2) when is_list(T2) -> 5601 merge_tags2(T1 ++ T2, []); 5602merge_tags(T1, T2) -> 5603 merge_tags2(T1 ++ [T2], []). 5604 5605merge_tags2([T1= #tag{type='IMPLICIT'}, T2 |Rest], Acc) -> 5606 merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); 5607merge_tags2([T1= #tag{type={default,'IMPLICIT'}}, T2 |Rest], Acc) -> 5608 merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); 5609merge_tags2([T1= #tag{type={default,'AUTOMATIC'}}, T2 |Rest], Acc) -> 5610 merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); 5611merge_tags2([H|T],Acc) -> 5612 merge_tags2(T, [H|Acc]); 5613merge_tags2([], Acc) -> 5614 lists:reverse(Acc). 5615 5616storeindb(S0, #module{name=ModName,typeorval=TVlist0}=M) -> 5617 S = S0#state{mname=ModName}, 5618 TVlist1 = [{asn1ct:get_name_of_def(Def),Def} || Def <- TVlist0], 5619 case check_duplicate_defs(S, TVlist1) of 5620 ok -> 5621 storeindb_1(S, M, TVlist0, TVlist1); 5622 {error,_}=Error -> 5623 Error 5624 end. 5625 5626storeindb_1(S, #module{name=ModName}=M, TVlist0, TVlist) -> 5627 NewM = M#module{typeorval=findtypes_and_values(TVlist0)}, 5628 Maps = lists:member(maps, S#state.options), 5629 asn1_db:dbnew(ModName, S#state.erule, Maps), 5630 asn1_db:dbput(ModName, 'MODULE', NewM), 5631 asn1_db:dbput(ModName, TVlist), 5632 include_default_class(S, NewM#module.name), 5633 include_default_type(NewM#module.name), 5634 ok. 5635 5636check_duplicate_defs(S, Defs) -> 5637 Set0 = sofs:relation(Defs), 5638 Set1 = sofs:relation_to_family(Set0), 5639 Set = sofs:to_external(Set1), 5640 case [duplicate_def(S, N, Dup) || {N,[_,_|_]=Dup} <- Set] of 5641 [] -> 5642 ok; 5643 [_|_]=E -> 5644 {error,lists:append(E)} 5645 end. 5646 5647duplicate_def(S, Name, Dups0) -> 5648 Dups1 = [{asn1ct:get_pos_of_def(Def),Def} || Def <- Dups0], 5649 [{Prev,_}|Dups] = lists:sort(Dups1), 5650 duplicate_def_1(S, Dups, Name, Prev). 5651 5652duplicate_def_1(S, [{_,Def}|T], Name, Prev) -> 5653 E = return_asn1_error(S, Def, {already_defined,Name,Prev}), 5654 [E|duplicate_def_1(S, T, Name, Prev)]; 5655duplicate_def_1(_, [], _, _) -> 5656 []. 5657 5658findtypes_and_values(TVList) -> 5659 findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values, 5660%% Parameterizedtypes,Classes,Objects and ObjectSets 5661 5662findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5663 when is_record(H,typedef),is_record(H#typedef.typespec,'Object') -> 5664 findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#typedef.name|Oacc],OSacc); 5665findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5666 when is_record(H,typedef),is_record(H#typedef.typespec,'ObjectSet') -> 5667 findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#typedef.name|OSacc]); 5668findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5669 when is_record(H,typedef) -> 5670 findtypes_and_values(T,[H#typedef.name|Tacc],Vacc,Pacc,Cacc,Oacc,OSacc); 5671findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5672 when is_record(H,valuedef) -> 5673 findtypes_and_values(T,Tacc,[H#valuedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); 5674findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5675 when is_record(H,ptypedef) -> 5676 findtypes_and_values(T,Tacc,Vacc,[H#ptypedef.name|Pacc],Cacc,Oacc,OSacc); 5677findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5678 when is_record(H,classdef) -> 5679 findtypes_and_values(T,Tacc,Vacc,Pacc,[H#classdef.name|Cacc],Oacc,OSacc); 5680findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5681 when is_record(H,pvaluedef) -> 5682 findtypes_and_values(T,Tacc,[H#pvaluedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); 5683findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5684 when is_record(H,pvaluesetdef) -> 5685 findtypes_and_values(T,Tacc,[H#pvaluesetdef.name|Vacc],Pacc,Cacc,Oacc,OSacc); 5686findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5687 when is_record(H,pobjectdef) -> 5688 findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#pobjectdef.name|Oacc],OSacc); 5689findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5690 when is_record(H,pobjectsetdef) -> 5691 findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#pobjectsetdef.name|OSacc]); 5692findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) -> 5693 {lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc), 5694 lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}. 5695 5696return_asn1_error(#state{error_context=Context}=S, Error) -> 5697 return_asn1_error(S, Context, Error). 5698 5699return_asn1_error(#state{mname=Where}, Item, Error) -> 5700 Pos = asn1ct:get_pos_of_def(Item), 5701 {structured_error,{Where,Pos},?MODULE,Error}. 5702 5703-spec asn1_error(_, _) -> no_return(). 5704asn1_error(S, Error) -> 5705 throw({error,return_asn1_error(S, Error)}). 5706 5707format_error({already_defined,Name,PrevLine}) -> 5708 io_lib:format("the name ~p has already been defined at line ~p", 5709 [Name,PrevLine]); 5710format_error({duplicate_identifier,Ids}) -> 5711 io_lib:format("the identifier '~p' has already been used", [Ids]); 5712format_error({duplicate_tags,Elements}) -> 5713 io_lib:format("duplicate tags in the elements: ~s", 5714 [format_elements(Elements)]); 5715format_error({enum_illegal_redefinition,Id}) -> 5716 io_lib:format("'~s' must not be redefined", [Id]); 5717format_error({enum_not_ascending,Id,N,Prev}) -> 5718 io_lib:format("the values for enumerations which follow '...' must " 5719 "be in ascending order, but '~p(~p)' is less than the " 5720 "previous value '~p'", [Id,N,Prev]); 5721format_error({enum_reused_value,Id,Val}) -> 5722 io_lib:format("'~s' has the value '~p' which is used more than once", 5723 [Id,Val]); 5724format_error({illegal_id, Id}) -> 5725 io_lib:format("illegal identifier: ~p", [Id]); 5726format_error({illegal_choice_type, Ref}) -> 5727 io_lib:format("expecting a CHOICE type: ~p", [Ref]); 5728format_error({illegal_class_name,Class}) -> 5729 io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]); 5730format_error({illegal_COMPONENTS_OF, Ref}) -> 5731 io_lib:format("expected a SEQUENCE or SET got: ~p", [Ref]); 5732format_error(illegal_external_value) -> 5733 "illegal value in EXTERNAL type"; 5734format_error({illegal_instance_of,Class}) -> 5735 io_lib:format("using INSTANCE OF on class '~s' is illegal, " 5736 "because INSTANCE OF may only be used on the class TYPE-IDENTIFIER", 5737 [Class]); 5738format_error(illegal_integer_value) -> 5739 "expecting an integer value"; 5740format_error(illegal_object) -> 5741 "expecting an object"; 5742format_error({illegal_object_field, Id}) -> 5743 io_lib:format("expecting a class field: ~p",[Id]); 5744format_error({illegal_oid,o_id}) -> 5745 "illegal OBJECT IDENTIFIER"; 5746format_error({illegal_oid,rel_oid}) -> 5747 "illegal RELATIVE-OID"; 5748format_error(illegal_octet_string_value) -> 5749 "expecting a bstring or an hstring as value for an OCTET STRING"; 5750format_error({illegal_typereference,Name}) -> 5751 io_lib:format("'~p' is used as a typereference, but does not start with an uppercase letter", [Name]); 5752format_error(illegal_table_constraint) -> 5753 "table constraints may only be applied to CLASS.&field constructs"; 5754format_error(illegal_value) -> 5755 "expecting a value"; 5756format_error({illegal_value, TYPE}) -> 5757 io_lib:format("expecting a ~s value", [TYPE]); 5758format_error({invalid_fields,Fields,Obj}) -> 5759 io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); 5760format_error({invalid_bit_number,Bit}) -> 5761 io_lib:format("the bit number '~p' is invalid", [Bit]); 5762format_error(invalid_table_constraint) -> 5763 "the table constraint is not an object set"; 5764format_error(invalid_objectset) -> 5765 "expecting an object set"; 5766format_error({implicit_tag_before,Kind}) -> 5767 "illegal implicit tag before " ++ 5768 case Kind of 5769 choice -> "'CHOICE'"; 5770 open_type -> "open type" 5771 end; 5772format_error({missing_mandatory_fields,Fields,Obj}) -> 5773 io_lib:format("missing mandatory ~s in ~p", 5774 [format_fields(Fields),Obj]); 5775format_error({missing_table_constraint,Component}) -> 5776 io_lib:format("the component '~s' is referenced by a component relation constraint using the '@field-name' notation, but does not have a table constraint", 5777 [Component]); 5778format_error({missing_id,Id}) -> 5779 io_lib:format("expected the mandatory component '~p'", [Id]); 5780format_error({missing_ocft,Component}) -> 5781 io_lib:format("the component '~s' must be an ObjectClassFieldType (CLASSNAME.&field-name)", [Component]); 5782format_error(multiple_uniqs) -> 5783 "implementation limitation: only one UNIQUE field is allowed in CLASS"; 5784format_error({namelist_redefinition,Name}) -> 5785 io_lib:format("the name '~s' cannot be redefined", [Name]); 5786format_error({param_bad_type, Ref}) -> 5787 io_lib:format("'~p' is not a parameterized type", [Ref]); 5788format_error(param_wrong_number_of_arguments) -> 5789 "wrong number of arguments"; 5790format_error(reversed_range) -> 5791 "ranges must be given in increasing order"; 5792format_error({syntax_duplicated_fields,Fields}) -> 5793 io_lib:format("~s must only occur once in the syntax list", 5794 [format_fields(Fields)]); 5795format_error(syntax_nomatch) -> 5796 "unexpected end of object definition"; 5797format_error({syntax_mandatory_in_optional_group,Name}) -> 5798 io_lib:format("the field '&~s' must not be within an optional group since it is not optional", 5799 [Name]); 5800format_error({syntax_missing_mandatory_fields,Fields}) -> 5801 io_lib:format("missing mandatory ~s in the syntax list", 5802 [format_fields(Fields)]); 5803format_error({syntax_nomatch,Actual}) -> 5804 io_lib:format("~s is not the next item allowed according to the defined syntax", 5805 [Actual]); 5806format_error({syntax_undefined_field,Field}) -> 5807 io_lib:format("'&~s' is not a field of the class being defined", 5808 [Field]); 5809format_error({undefined,Name}) -> 5810 io_lib:format("'~s' is referenced, but is not defined", [Name]); 5811format_error({undefined_export,Ref}) -> 5812 io_lib:format("'~s' is exported but is not defined", [Ref]); 5813format_error({undefined_field,FieldName}) -> 5814 io_lib:format("the field '&~s' is undefined", [FieldName]); 5815format_error({undefined_import,Ref,Module}) -> 5816 io_lib:format("'~s' is not exported from ~s", [Ref,Module]); 5817format_error({unique_and_default,Field}) -> 5818 io_lib:format("the field '&~s' must not have both 'UNIQUE' and 'DEFAULT'", 5819 [Field]); 5820format_error({value_reused,Val}) -> 5821 io_lib:format("the value '~p' is used more than once", [Val]); 5822format_error({non_unique_object,Id}) -> 5823 io_lib:format("object set with a UNIQUE field value of '~p' is used more than once", [Id]); 5824format_error(Other) -> 5825 io_lib:format("~p", [Other]). 5826 5827format_fields([F]) -> 5828 io_lib:format("field '&~s'", [F]); 5829format_fields([H|T]) -> 5830 [io_lib:format("fields '&~s'", [H])| 5831 [io_lib:format(", '&~s'", [F]) || F <- T]]. 5832 5833format_elements([H1,H2|T]) -> 5834 [io_lib:format("~p, ", [H1])|format_elements([H2|T])]; 5835format_elements([H]) -> 5836 io_lib:format("~p", [H]). 5837 5838include_default_type(Module) -> 5839 NameAbsList = default_type_list(), 5840 include_default_type1(Module,NameAbsList). 5841 5842include_default_type1(_,[]) -> 5843 ok; 5844include_default_type1(Module,[{Name,TS}|Rest]) -> 5845 case asn1_db:dbget(Module,Name) of 5846 undefined -> 5847 T = #typedef{name=Name, 5848 typespec=TS}, 5849 asn1_db:dbput(Module,Name,T); 5850 _ -> ok 5851 end, 5852 include_default_type1(Module,Rest). 5853 5854default_type_list() -> 5855 %% The EXTERNAL type is represented, according to ASN.1 1997, 5856 %% as a SEQUENCE with components: identification, data-value-descriptor 5857 %% and data-value. 5858 Syntax = 5859 #'ComponentType'{name=syntax, 5860 typespec=#type{def='OBJECT IDENTIFIER'}, 5861 prop=mandatory}, 5862 Presentation_Cid = 5863 #'ComponentType'{name='presentation-context-id', 5864 typespec=#type{def='INTEGER'}, 5865 prop=mandatory}, 5866 Transfer_syntax = 5867 #'ComponentType'{name='transfer-syntax', 5868 typespec=#type{def='OBJECT IDENTIFIER'}, 5869 prop=mandatory}, 5870 Negotiation_items = 5871 #type{def= 5872 #'SEQUENCE'{components= 5873 [Presentation_Cid, 5874 Transfer_syntax#'ComponentType'{prop=mandatory}]}}, 5875 Context_negot = 5876 #'ComponentType'{name='context-negotiation', 5877 typespec=Negotiation_items, 5878 prop=mandatory}, 5879 5880 Data_value_descriptor = 5881 #'ComponentType'{name='data-value-descriptor', 5882 typespec=#type{def='ObjectDescriptor'}, 5883 prop='OPTIONAL'}, 5884 Data_value = 5885 #'ComponentType'{name='data-value', 5886 typespec=#type{def='OCTET STRING'}, 5887 prop=mandatory}, 5888 5889 %% The EXTERNAL type is represented, according to ASN.1 1990, 5890 %% as a SEQUENCE with components: direct-reference, indirect-reference, 5891 %% data-value-descriptor and encoding. 5892 5893 Direct_reference = 5894 #'ComponentType'{name='direct-reference', 5895 typespec=#type{def='OBJECT IDENTIFIER'}, 5896 prop='OPTIONAL', 5897 tags=[{'UNIVERSAL',6}]}, 5898 5899 Indirect_reference = 5900 #'ComponentType'{name='indirect-reference', 5901 typespec=#type{def='INTEGER'}, 5902 prop='OPTIONAL', 5903 tags=[{'UNIVERSAL',2}]}, 5904 5905 Single_ASN1_type = 5906 #'ComponentType'{name='single-ASN1-type', 5907 typespec=#type{tag=[{tag,'CONTEXT',0, 5908 'EXPLICIT',32}], 5909 def='ANY'}, 5910 prop=mandatory, 5911 tags=[{'CONTEXT',0}]}, 5912 5913 Octet_aligned = 5914 #'ComponentType'{name='octet-aligned', 5915 typespec=#type{tag=[{tag,'CONTEXT',1, 5916 'IMPLICIT',0}], 5917 def='OCTET STRING'}, 5918 prop=mandatory, 5919 tags=[{'CONTEXT',1}]}, 5920 5921 Arbitrary = 5922 #'ComponentType'{name=arbitrary, 5923 typespec=#type{tag=[{tag,'CONTEXT',2, 5924 'IMPLICIT',0}], 5925 def={'BIT STRING',[]}}, 5926 prop=mandatory, 5927 tags=[{'CONTEXT',2}]}, 5928 5929 Encoding = 5930 #'ComponentType'{name=encoding, 5931 typespec=#type{def={'CHOICE', 5932 [Single_ASN1_type,Octet_aligned, 5933 Arbitrary]}}, 5934 prop=mandatory}, 5935 5936 EXTERNAL_components1990 = 5937 [Direct_reference,Indirect_reference,Data_value_descriptor,Encoding], 5938 5939 %% The EMBEDDED PDV type is represented by a SEQUENCE type 5940 %% with components: identification and data-value 5941 Abstract = 5942 #'ComponentType'{name=abstract, 5943 typespec=#type{def='OBJECT IDENTIFIER'}, 5944 prop=mandatory}, 5945 Transfer = 5946 #'ComponentType'{name=transfer, 5947 typespec=#type{def='OBJECT IDENTIFIER'}, 5948 prop=mandatory}, 5949 AbstractTrSeq = 5950 #'SEQUENCE'{components=[Abstract,Transfer]}, 5951 Syntaxes = 5952 #'ComponentType'{name=syntaxes, 5953 typespec=#type{def=AbstractTrSeq}, 5954 prop=mandatory}, 5955 Fixed = #'ComponentType'{name=fixed, 5956 typespec=#type{def='NULL'}, 5957 prop=mandatory}, 5958 Negotiations = 5959 [Syntaxes,Syntax,Presentation_Cid,Context_negot, 5960 Transfer_syntax,Fixed], 5961 Identification2 = 5962 #'ComponentType'{name=identification, 5963 typespec=#type{def={'CHOICE',Negotiations}}, 5964 prop=mandatory}, 5965 EmbeddedPdv_components = 5966 [Identification2,Data_value], 5967 5968 %% The CHARACTER STRING type is represented by a SEQUENCE type 5969 %% with components: identification and string-value 5970 String_value = 5971 #'ComponentType'{name='string-value', 5972 typespec=#type{def='OCTET STRING'}, 5973 prop=mandatory}, 5974 CharacterString_components = 5975 [Identification2,String_value], 5976 5977 [{'EXTERNAL', 5978 #type{tag=[#tag{class='UNIVERSAL', 5979 number=8, 5980 type='IMPLICIT', 5981 form=32}], 5982 def=#'SEQUENCE'{components= 5983 EXTERNAL_components1990}}}, 5984 {'EMBEDDED PDV', 5985 #type{tag=[#tag{class='UNIVERSAL', 5986 number=11, 5987 type='IMPLICIT', 5988 form=32}], 5989 def=#'SEQUENCE'{components=EmbeddedPdv_components}}}, 5990 {'CHARACTER STRING', 5991 #type{tag=[#tag{class='UNIVERSAL', 5992 number=29, 5993 type='IMPLICIT', 5994 form=32}], 5995 def=#'SEQUENCE'{components=CharacterString_components}}} 5996 ]. 5997 5998 5999include_default_class(S, Module) -> 6000 _ = [include_default_class1(S, Module, ClassDef) || 6001 ClassDef <- default_class_list()], 6002 ok. 6003 6004include_default_class1(S, Module, {Name,Ts0}) -> 6005 case asn1_db:dbget(Module, Name) of 6006 undefined -> 6007 #objectclass{fields=Fields, 6008 syntax={'WITH SYNTAX',Syntax0}} = Ts0, 6009 Syntax = preprocess_syntax(S, Syntax0, Fields), 6010 Ts = Ts0#objectclass{syntax={preprocessed_syntax,Syntax}}, 6011 C = #classdef{checked=true,module=Module, 6012 name=Name,typespec=Ts}, 6013 asn1_db:dbput(Module, Name, C); 6014 _ -> 6015 ok 6016 end. 6017 6018default_class_list() -> 6019 [{'TYPE-IDENTIFIER', 6020 #objectclass{fields=[{fixedtypevaluefield, 6021 id, 6022 #type{tag=[?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER)], 6023 def='OBJECT IDENTIFIER'}, 6024 'UNIQUE', 6025 'MANDATORY'}, 6026 {typefield,'Type','MANDATORY'}], 6027 syntax={'WITH SYNTAX', 6028 [{typefieldreference,'Type'}, 6029 'IDENTIFIED', 6030 'BY', 6031 {valuefieldreference,id}]}}}, 6032 {'ABSTRACT-SYNTAX', 6033 #objectclass{fields=[{fixedtypevaluefield, 6034 id, 6035 #type{tag=[?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER)], 6036 def='OBJECT IDENTIFIER'}, 6037 'UNIQUE', 6038 'MANDATORY'}, 6039 {typefield,'Type','MANDATORY'}, 6040 {fixedtypevaluefield, 6041 property, 6042 #type{tag=[?TAG_PRIMITIVE(?N_BIT_STRING)], 6043 def={'BIT STRING',[]}}, 6044 undefined, 6045 {'DEFAULT', 6046 [0,1,0]}}], 6047 syntax={'WITH SYNTAX', 6048 [{typefieldreference,'Type'}, 6049 'IDENTIFIED', 6050 'BY', 6051 {valuefieldreference,id}, 6052 ['HAS', 6053 'PROPERTY', 6054 {valuefieldreference,property}]]}}}]. 6055 6056new_reference_name(Name) -> 6057 case get(asn1_reference) of 6058 undefined -> 6059 put(asn1_reference,1), 6060 list_to_atom(lists:concat([internal_,Name,"_",1])); 6061 Num when is_integer(Num) -> 6062 put(asn1_reference,Num+1), 6063 list_to_atom(lists:concat([internal_,Name,"_",Num+1])) 6064 end. 6065 6066get_record_prefix_name(S) -> 6067 case lists:keysearch(record_name_prefix,1,S#state.options) of 6068 {value,{_,Prefix}} -> 6069 Prefix; 6070 _ -> 6071 "" 6072 end. 6073 6074insert_once(S,Tab,Key) -> 6075 case get(top_module) of 6076 M when M == S#state.mname -> 6077 asn1ct_gen:insert_once(Tab,Key), 6078 ok; 6079 _ -> 6080 skipped 6081 end. 6082 6083check_fold(S0, [H|T], Check) -> 6084 Type = asn1_db:dbget(S0#state.mname, H), 6085 S = S0#state{error_context=Type}, 6086 case Check(S, H, Type) of 6087 ok -> 6088 check_fold(S, T, Check); 6089 Error -> 6090 [Error|check_fold(S, T, Check)] 6091 end; 6092check_fold(_, [], Check) when is_function(Check, 3) -> []. 6093 6094error_value(Value) when is_integer(Value) -> Value; 6095error_value(Value) when is_atom(Value) -> Value; 6096error_value(#type{def=Value}) when is_atom(Value) -> Value; 6097error_value(#type{def=Value}) -> error_value(Value); 6098error_value(RefOrType) -> 6099 try name_of_def(RefOrType) of 6100 Name -> Name 6101 catch _:_ -> 6102 case get_datastr_name(RefOrType) of 6103 undefined -> RefOrType; 6104 Name -> Name 6105 end 6106 end. 6107 6108name_of_def(#'Externaltypereference'{type=N}) -> N; 6109name_of_def(#'Externalvaluereference'{value=N}) -> N. 6110