1%% ``Licensed under the Apache License, Version 2.0 (the "License"); 2%% you may not use this file except in compliance with the License. 3%% You may obtain a copy of the License at 4%% 5%% http://www.apache.org/licenses/LICENSE-2.0 6%% 7%% Unless required by applicable law or agreed to in writing, software 8%% distributed under the License is distributed on an "AS IS" BASIS, 9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 10%% See the License for the specific language governing permissions and 11%% limitations under the License. 12%% 13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 15%% AB. All Rights Reserved.'' 16%% 17%% $Id: asn1ct_check.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ 18-module(asn1ct_check). 19 20%% Main Module for ASN.1 compile time functions 21 22%-compile(export_all). 23-export([check/2,storeindb/1]). 24-include("asn1_records.hrl"). 25%%% The tag-number for universal types 26-define(N_BOOLEAN, 1). 27-define(N_INTEGER, 2). 28-define(N_BIT_STRING, 3). 29-define(N_OCTET_STRING, 4). 30-define(N_NULL, 5). 31-define(N_OBJECT_IDENTIFIER, 6). 32-define(N_OBJECT_DESCRIPTOR, 7). 33-define(N_EXTERNAL, 8). % constructed 34-define(N_INSTANCE_OF,8). 35-define(N_REAL, 9). 36-define(N_ENUMERATED, 10). 37-define(N_EMBEDDED_PDV, 11). % constructed 38-define(N_SEQUENCE, 16). 39-define(N_SET, 17). 40-define(N_NumericString, 18). 41-define(N_PrintableString, 19). 42-define(N_TeletexString, 20). 43-define(N_VideotexString, 21). 44-define(N_IA5String, 22). 45-define(N_UTCTime, 23). 46-define(N_GeneralizedTime, 24). 47-define(N_GraphicString, 25). 48-define(N_VisibleString, 26). 49-define(N_GeneralString, 27). 50-define(N_UniversalString, 28). 51-define(N_CHARACTER_STRING, 29). % constructed 52-define(N_BMPString, 30). 53 54-define(TAG_PRIMITIVE(Num), 55 case S#state.erule of 56 ber_bin_v2 -> 57 #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}; 58 _ -> [] 59 end). 60-define(TAG_CONSTRUCTED(Num), 61 case S#state.erule of 62 ber_bin_v2 -> 63 #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}; 64 _ -> [] 65 end). 66 67-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag 68-record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value 69 70check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> 71 %%Predicates used to filter errors 72 TupleIs = fun({T,_},T) -> true; 73 (_,_) -> false 74 end, 75 IsClass = fun(X) -> TupleIs(X,asn1_class) end, 76 IsObjSet = fun(X) -> TupleIs(X,objectsetdef) end, 77 IsPObjSet = fun(X) -> TupleIs(X,pobjectsetdef) end, 78 IsObject = fun(X) -> TupleIs(X,objectdef) end, 79 IsValueSet = fun(X) -> TupleIs(X,valueset) end, 80 Element2 = fun(X) -> element(2,X) end, 81 82 _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used 83 Terror = checkt(S,Types,[]), 84 85 %% get parameterized object sets sent to checkt/3 86 %% and update Terror 87 88 {PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror), 89 90 Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets 91 92 %% get information object classes wrongly sent to checkt/3 93 %% and update Terror2 94 95 {AddClasses,Terror3} = filter_errors(IsClass,Terror2), 96 97 NewClasses = Classes++AddClasses, 98 99 Cerror = checkc(S,NewClasses,[]), 100 101 %% get object sets incorrectly sent to checkv/3 102 %% and update Verror 103 104 {ObjSetNames,Verror2} = filter_errors(IsObjSet,Verror), 105 106 %% get parameterized object sets incorrectly sent to checkv/3 107 %% and update Verror2 108 109 {PObjSetNames,Verror3} = filter_errors(IsPObjSet,Verror2), 110 111 %% get objects incorrectly sent to checkv/3 112 %% and update Verror3 113 114 {ObjectNames,Verror4} = filter_errors(IsObject,Verror3), 115 116 NewObjects = Objects++ObjectNames, 117 NewObjectSets = ObjSetNames ++ PObjSetNames ++ PObjSetNames1, 118 119 %% get value sets 120 %% and update Verror4 121 122 {ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4), 123 124 asn1ct:create_ets_table(inlined_objects,[named_table]), 125 {Oerror,ExclO,ExclOS} = checko(S,NewObjects ++ 126 NewObjectSets, 127 [],[],[]), 128 InlinedObjTuples = ets:tab2list(inlined_objects), 129 InlinedObjects = lists:map(Element2,InlinedObjTuples), 130 ets:delete(inlined_objects), 131 132 Exporterror = check_exports(S,S#state.module), 133 case {Terror3,Verror5,Cerror,Oerror,Exporterror} of 134 {[],[],[],[],[]} -> 135 ContextSwitchTs = context_switch_in_spec(), 136 InstanceOf = instance_of_in_spec(), 137 NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs 138 ++ InstanceOf, 139 NewValues = lists:subtract(Values,PObjSetNames++ObjectNames++ 140 ValueSetNames), 141 {ok, 142 {NewTypes,NewValues,ParameterizedTypes, 143 NewClasses,NewObjects,NewObjectSets}, 144 {NewTypes,NewValues,ParameterizedTypes,NewClasses, 145 lists:subtract(NewObjects,ExclO)++InlinedObjects, 146 lists:subtract(NewObjectSets,ExclOS)}}; 147 _ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror, 148 Oerror,Exporterror])}} 149 end. 150 151context_switch_in_spec() -> 152 L = [{external,'EXTERNAL'}, 153 {embedded_pdv,'EMBEDDED PDV'}, 154 {character_string,'CHARACTER STRING'}], 155 F = fun({T,TName},Acc) -> 156 case get(T) of 157 generate -> erase(T), 158 [TName|Acc]; 159 _ -> Acc 160 end 161 end, 162 lists:foldl(F,[],L). 163 164instance_of_in_spec() -> 165 case get(instance_of) of 166 generate -> 167 erase(instance_of), 168 ['INSTANCE OF']; 169 _ -> 170 [] 171 end. 172 173filter_errors(Pred,ErrorList) -> 174 Element2 = fun(X) -> element(2,X) end, 175 RemovedTupleElements = lists:filter(Pred,ErrorList), 176 RemovedNames = lists:map(Element2,RemovedTupleElements), 177 %% remove value set name tuples from Verror 178 RestErrors = lists:subtract(ErrorList,RemovedTupleElements), 179 {RemovedNames,RestErrors}. 180 181 182check_exports(S,Module = #module{}) -> 183 case Module#module.exports of 184 {exports,[]} -> 185 []; 186 {exports,all} -> 187 []; 188 {exports,ExportList} when list(ExportList) -> 189 IsNotDefined = 190 fun(X) -> 191 case catch get_referenced_type(S,X) of 192 {error,{asn1,_}} -> 193 true; 194 _ -> false 195 end 196 end, 197 case lists:filter(IsNotDefined,ExportList) of 198 [] -> 199 []; 200 NoDefExp -> 201 GetName = 202 fun(T = #'Externaltypereference'{type=N})-> 203 %%{exported,undefined,entity,N} 204 NewS=S#state{type=T,tname=N}, 205 error({export,"exported undefined entity",NewS}) 206 end, 207 lists:map(GetName,NoDefExp) 208 end 209 end. 210 211checkt(S,[Name|T],Acc) -> 212 %%io:format("check_typedef:~p~n",[Name]), 213 Result = 214 case asn1_db:dbget(S#state.mname,Name) of 215 undefined -> 216 error({type,{internal_error,'???'},S}); 217 Type when record(Type,typedef) -> 218 NewS = S#state{type=Type,tname=Name}, 219 case catch(check_type(NewS,Type,Type#typedef.typespec)) of 220 {error,Reason} -> 221 error({type,Reason,NewS}); 222 {'EXIT',Reason} -> 223 error({type,{internal_error,Reason},NewS}); 224 {asn1_class,_ClassDef} -> 225 {asn1_class,Name}; 226 pobjectsetdef -> 227 {pobjectsetdef,Name}; 228 pvalueset -> 229 {pvalueset,Name}; 230 Ts -> 231 case Type#typedef.checked of 232 true -> % already checked and updated 233 ok; 234 _ -> 235 NewTypeDef = Type#typedef{checked=true,typespec = Ts}, 236 %io:format("checkt:dbput:~p, ~p~n",[S#state.mname,NewTypeDef#typedef.name]), 237 asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type 238 ok 239 end 240 end 241 end, 242 case Result of 243 ok -> 244 checkt(S,T,Acc); 245 _ -> 246 checkt(S,T,[Result|Acc]) 247 end; 248checkt(S,[],Acc) -> 249 case check_contextswitchingtypes(S,[]) of 250 [] -> 251 lists:reverse(Acc); 252 L -> 253 checkt(S,L,Acc) 254 end. 255 256check_contextswitchingtypes(S,Acc) -> 257 CSTList=[{external,'EXTERNAL'}, 258 {embedded_pdv,'EMBEDDED PDV'}, 259 {character_string,'CHARACTER STRING'}], 260 check_contextswitchingtypes(S,CSTList,Acc). 261 262check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) -> 263 case get(T) of 264 unchecked -> 265 put(T,generate), 266 check_contextswitchingtypes(S,Ts,[TName|Acc]); 267 _ -> 268 check_contextswitchingtypes(S,Ts,Acc) 269 end; 270check_contextswitchingtypes(_,[],Acc) -> 271 Acc. 272 273checkv(S,[Name|T],Acc) -> 274 %%io:format("check_valuedef:~p~n",[Name]), 275 Result = case asn1_db:dbget(S#state.mname,Name) of 276 undefined -> error({value,{internal_error,'???'},S}); 277 Value when record(Value,valuedef); 278 record(Value,typedef); %Value set may be parsed as object set. 279 record(Value,pvaluedef); 280 record(Value,pvaluesetdef) -> 281 NewS = S#state{value=Value}, 282 case catch(check_value(NewS,Value)) of 283 {error,Reason} -> 284 error({value,Reason,NewS}); 285 {'EXIT',Reason} -> 286 error({value,{internal_error,Reason},NewS}); 287 {pobjectsetdef} -> 288 {pobjectsetdef,Name}; 289 {objectsetdef} -> 290 {objectsetdef,Name}; 291 {objectdef} -> 292 %% this is an object, save as typedef 293 #valuedef{checked=C,pos=Pos,name=N,type=Type, 294 value=Def}=Value, 295% Currmod = S#state.mname, 296% #type{def= 297% #'Externaltypereference'{module=Mod, 298% type=CName}} = Type, 299 ClassName = 300 Type#type.def, 301% case Mod of 302% Currmod -> 303% {objectclassname,CName}; 304% _ -> 305% {objectclassname,Mod,CName} 306% end, 307 NewSpec = #'Object'{classname=ClassName, 308 def=Def}, 309 NewDef = #typedef{checked=C,pos=Pos,name=N, 310 typespec=NewSpec}, 311 asn1_db:dbput(NewS#state.mname,Name,NewDef), 312 {objectdef,Name}; 313 {valueset,VSet} -> 314 Pos = asn1ct:get_pos_of_def(Value), 315 CheckedVSDef = #typedef{checked=true,pos=Pos, 316 name=Name,typespec=VSet}, 317 asn1_db:dbput(NewS#state.mname,Name,CheckedVSDef), 318 {valueset,Name}; 319 V -> 320 %% update the valuedef 321 asn1_db:dbput(NewS#state.mname,Name,V), 322 ok 323 end 324 end, 325 case Result of 326 ok -> 327 checkv(S,T,Acc); 328 _ -> 329 checkv(S,T,[Result|Acc]) 330 end; 331checkv(_S,[],Acc) -> 332 lists:reverse(Acc). 333 334 335checkp(S,[Name|T],Acc) -> 336 %io:format("check_ptypedef:~p~n",[Name]), 337 Result = case asn1_db:dbget(S#state.mname,Name) of 338 undefined -> 339 error({type,{internal_error,'???'},S}); 340 Type when record(Type,ptypedef) -> 341 NewS = S#state{type=Type,tname=Name}, 342 case catch(check_ptype(NewS,Type,Type#ptypedef.typespec)) of 343 {error,Reason} -> 344 error({type,Reason,NewS}); 345 {'EXIT',Reason} -> 346 error({type,{internal_error,Reason},NewS}); 347 {asn1_class,_ClassDef} -> 348 {asn1_class,Name}; 349 Ts -> 350 NewType = Type#ptypedef{checked=true,typespec = Ts}, 351 asn1_db:dbput(NewS#state.mname,Name,NewType), % update the type 352 ok 353 end 354 end, 355 case Result of 356 ok -> 357 checkp(S,T,Acc); 358 _ -> 359 checkp(S,T,[Result|Acc]) 360 end; 361checkp(_S,[],Acc) -> 362 lists:reverse(Acc). 363 364 365 366 367checkc(S,[Name|Cs],Acc) -> 368 Result = 369 case asn1_db:dbget(S#state.mname,Name) of 370 undefined -> 371 error({class,{internal_error,'???'},S}); 372 Class -> 373 ClassSpec = if 374 record(Class,classdef) -> 375 Class#classdef.typespec; 376 record(Class,typedef) -> 377 Class#typedef.typespec 378 end, 379 NewS = S#state{type=Class,tname=Name}, 380 case catch(check_class(NewS,ClassSpec)) of 381 {error,Reason} -> 382 error({class,Reason,NewS}); 383 {'EXIT',Reason} -> 384 error({class,{internal_error,Reason},NewS}); 385 C -> 386 %% update the classdef 387 NewClass = 388 if 389 record(Class,classdef) -> 390 Class#classdef{checked=true,typespec=C}; 391 record(Class,typedef) -> 392 #classdef{checked=true,name=Name,typespec=C} 393 end, 394 asn1_db:dbput(NewS#state.mname,Name,NewClass), 395 ok 396 end 397 end, 398 case Result of 399 ok -> 400 checkc(S,Cs,Acc); 401 _ -> 402 checkc(S,Cs,[Result|Acc]) 403 end; 404checkc(_S,[],Acc) -> 405%% include_default_class(S#state.mname), 406 lists:reverse(Acc). 407 408checko(S,[Name|Os],Acc,ExclO,ExclOS) -> 409 Result = 410 case asn1_db:dbget(S#state.mname,Name) of 411 undefined -> 412 error({type,{internal_error,'???'},S}); 413 Object when record(Object,typedef) -> 414 NewS = S#state{type=Object,tname=Name}, 415 case catch(check_object(NewS,Object,Object#typedef.typespec)) of 416 {error,Reason} -> 417 error({type,Reason,NewS}); 418 {'EXIT',Reason} -> 419 error({type,{internal_error,Reason},NewS}); 420 {asn1,Reason} -> 421 error({type,Reason,NewS}); 422 O -> 423 NewObj = Object#typedef{checked=true,typespec=O}, 424 asn1_db:dbput(NewS#state.mname,Name,NewObj), 425 if 426 record(O,'Object') -> 427 case O#'Object'.gen of 428 true -> 429 {ok,ExclO,ExclOS}; 430 false -> 431 {ok,[Name|ExclO],ExclOS} 432 end; 433 record(O,'ObjectSet') -> 434 case O#'ObjectSet'.gen of 435 true -> 436 {ok,ExclO,ExclOS}; 437 false -> 438 {ok,ExclO,[Name|ExclOS]} 439 end 440 end 441 end; 442 PObject when record(PObject,pobjectdef) -> 443 NewS = S#state{type=PObject,tname=Name}, 444 case (catch check_pobject(NewS,PObject)) of 445 {error,Reason} -> 446 error({type,Reason,NewS}); 447 {'EXIT',Reason} -> 448 error({type,{internal_error,Reason},NewS}); 449 {asn1,Reason} -> 450 error({type,Reason,NewS}); 451 PO -> 452 NewPObj = PObject#pobjectdef{def=PO}, 453 asn1_db:dbput(NewS#state.mname,Name,NewPObj), 454 {ok,[Name|ExclO],ExclOS} 455 end; 456 PObjSet when record(PObjSet,pvaluesetdef) -> 457 %% this is a parameterized object set. Might be a parameterized 458 %% value set, couldn't it? 459 NewS = S#state{type=PObjSet,tname=Name}, 460 case (catch check_pobjectset(NewS,PObjSet)) of 461 {error,Reason} -> 462 error({type,Reason,NewS}); 463 {'EXIT',Reason} -> 464 error({type,{internal_error,Reason},NewS}); 465 {asn1,Reason} -> 466 error({type,Reason,NewS}); 467 POS -> 468 %%NewPObjSet = PObjSet#pvaluesetdef{valueset=POS}, 469 asn1_db:dbput(NewS#state.mname,Name,POS), 470 {ok,ExclO,[Name|ExclOS]} 471 end 472 end, 473 case Result of 474 {ok,NewExclO,NewExclOS} -> 475 checko(S,Os,Acc,NewExclO,NewExclOS); 476 _ -> 477 checko(S,Os,[Result|Acc],ExclO,ExclOS) 478 end; 479checko(_S,[],Acc,ExclO,ExclOS) -> 480 {lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}. 481 482check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) -> 483 case Ch of 484 true -> TS; 485 idle -> TS; 486 _ -> 487 NewCDef = CDef#classdef{checked=idle}, 488 asn1_db:dbput(S#state.mname,Name,NewCDef), 489 CheckedTS = check_class(S,TS), 490 asn1_db:dbput(S#state.mname,Name, 491 NewCDef#classdef{checked=true, 492 typespec=CheckedTS}), 493 CheckedTS 494 end; 495check_class(S = #state{mname=M,tname=T},ClassSpec) 496 when record(ClassSpec,type) -> 497 Def = ClassSpec#type.def, 498 case Def of 499 #'Externaltypereference'{module=M,type=T} -> 500 #objectclass{fields=Def}; % in case of recursive definitions 501 Tref when record(Tref,'Externaltypereference') -> 502 {_,RefType} = get_referenced_type(S,Tref), 503% case RefType of 504% RefClass when record(RefClass,classdef) -> 505% check_class(S,RefClass#classdef.typespec) 506% end 507 case is_class(S,RefType) of 508 true -> 509 check_class(S,get_class_def(S,RefType)); 510 _ -> 511 error({class,{internal_error,RefType},S}) 512 end 513 end; 514% check_class(S,{objectclassname,ModuleName,ClassName}) when atom(ModuleName),atom(ClassName) -> 515% 'fix this'; 516check_class(S,C) when record(C,objectclass) -> 517 NewFieldSpec = check_class_fields(S,C#objectclass.fields), 518 C#objectclass{fields=NewFieldSpec}; 519%check_class(S,{objectclassname,ClassName}) -> 520check_class(S,ClassName) -> 521 {_,Def} = get_referenced_type(S,ClassName), 522 case Def of 523 ClassDef when record(ClassDef,classdef) -> 524 case ClassDef#classdef.checked of 525 true -> 526 ClassDef#classdef.typespec; 527 idle -> 528 ClassDef#classdef.typespec; 529 false -> 530 check_class(S,ClassDef#classdef.typespec) 531 end; 532 TypeDef when record(TypeDef,typedef) -> 533 %% this case may occur when a definition is a reference 534 %% to a class definition. 535 case TypeDef#typedef.typespec of 536 #type{def=Ext} when record(Ext,'Externaltypereference') -> 537 check_class(S,Ext) 538 end 539 end; 540check_class(_S,{poc,_ObjSet,_Params}) -> 541 'fix this later'. 542 543check_class_fields(S,Fields) -> 544 check_class_fields(S,Fields,[]). 545 546check_class_fields(S,[F|Fields],Acc) -> 547 NewField = 548 case element(1,F) of 549 fixedtypevaluefield -> 550 {_,Name,Type,Unique,OSpec} = F, 551 RefType = check_type(S,#typedef{typespec=Type},Type), 552 {fixedtypevaluefield,Name,RefType,Unique,OSpec}; 553 object_or_fixedtypevalue_field -> 554 {_,Name,Type,Unique,OSpec} = F, 555 Cat = 556 case asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def)) of 557 Def when record(Def,typereference); 558 record(Def,'Externaltypereference') -> 559 {_,D} = get_referenced_type(S,Def), 560 D; 561 {undefined,user} -> 562 %% neither of {primitive,bif} or {constructed,bif} 563%% {_,D} = get_referenced_type(S,#typereference{val=Type#type.def}), 564 {_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}), 565 D; 566 _ -> 567 Type 568 end, 569 case Cat of 570 Class when record(Class,classdef) -> 571 {objectfield,Name,Type,Unique,OSpec}; 572 _ -> 573 RefType = check_type(S,#typedef{typespec=Type},Type), 574 {fixedtypevaluefield,Name,RefType,Unique,OSpec} 575 end; 576 objectset_or_fixedtypevalueset_field -> 577 {_,Name,Type,OSpec} = F, 578%% RefType = check_type(S,#typedef{typespec=Type},Type), 579 RefType = 580 case (catch check_type(S,#typedef{typespec=Type},Type)) of 581 {asn1_class,_ClassDef} -> 582 case if_current_checked_type(S,Type) of 583 true -> 584 Type#type.def; 585 _ -> 586 check_class(S,Type) 587 end; 588 CheckedType when record(CheckedType,type) -> 589 CheckedType; 590 _ -> 591 error({class,"internal error, check_class_fields",S}) 592 end, 593 if 594 record(RefType,'Externaltypereference') -> 595 {objectsetfield,Name,Type,OSpec}; 596 record(RefType,classdef) -> 597 {objectsetfield,Name,Type,OSpec}; 598 record(RefType,objectclass) -> 599 {objectsetfield,Name,Type,OSpec}; 600 true -> 601 {fixedtypevaluesetfield,Name,RefType,OSpec} 602 end; 603 typefield -> 604 case F of 605 {TF,Name,{'DEFAULT',Type}} -> 606 {TF,Name,{'DEFAULT',check_type(S,#typedef{typespec=Type},Type)}}; 607 _ -> F 608 end; 609 _ -> F 610 end, 611 check_class_fields(S,Fields,[NewField|Acc]); 612check_class_fields(_S,[],Acc) -> 613 lists:reverse(Acc). 614 615if_current_checked_type(S,#type{def=Def}) -> 616 CurrentCheckedName = S#state.tname, 617 MergedModules = S#state.inputmodules, 618 % CurrentCheckedModule = S#state.mname, 619 case Def of 620 #'Externaltypereference'{module=CurrentCheckedName, 621 type=CurrentCheckedName} -> 622 true; 623 #'Externaltypereference'{module=ModuleName, 624 type=CurrentCheckedName} -> 625 case MergedModules of 626 undefined -> 627 false; 628 _ -> 629 lists:member(ModuleName,MergedModules) 630 end; 631 _ -> 632 false 633 end. 634 635 636 637check_pobject(_S,PObject) when record(PObject,pobjectdef) -> 638 Def = PObject#pobjectdef.def, 639 Def. 640 641 642check_pobjectset(S,PObjSet) -> 643 #pvaluesetdef{pos=Pos,name=Name,args=Args,type=Type, 644 valueset=ValueSet}=PObjSet, 645 {Mod,Def} = get_referenced_type(S,Type#type.def), 646 case Def of 647 #classdef{} -> 648 ClassName = #'Externaltypereference'{module=Mod, 649 type=Def#classdef.name}, 650 {valueset,Set} = ValueSet, 651% ObjectSet = #'ObjectSet'{class={objectclassname,ClassName}, 652 ObjectSet = #'ObjectSet'{class=ClassName, 653 set=Set}, 654 #pobjectsetdef{pos=Pos,name=Name,args=Args,class=Type#type.def, 655 def=ObjectSet}; 656 _ -> 657 PObjSet 658 end. 659 660check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) -> 661 ObjSpec; 662check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> 663 {_,_ClassDef} = get_referenced_type(S,ClassRef), 664 NewClassRef = check_externaltypereference(S,ClassRef), 665 ClassDef = 666 case _ClassDef#classdef.checked of 667 false -> 668 #classdef{checked=true, 669 typespec=check_class(S,_ClassDef#classdef.typespec)}; 670 _ -> 671 _ClassDef 672 end, 673 NewObj = 674 case ObjectDef of 675 Def when tuple(Def), (element(1,Def)==object) -> 676 NewSettingList = check_objectdefn(S,Def,ClassDef), 677 #'Object'{def=NewSettingList}; 678% Def when tuple(Def), (element(1,Def)=='ObjectFromObject') -> 679% fixa; 680 {po,{object,DefObj},ArgsList} -> 681 {_,Object} = get_referenced_type(S,DefObj),%DefObj is a 682 %%#'Externalvaluereference' or a #'Externaltypereference' 683 %% Maybe this call should be catched and in case of an exception 684 %% an nonallocated parameterized object should be returned. 685 instantiate_po(S,ClassDef,Object,ArgsList); 686 #'Externalvaluereference'{} -> 687 {_,Object} = get_referenced_type(S,ObjectDef), 688 check_object(S,Object,Object#typedef.typespec); 689 _ -> 690 exit({error,{no_object,ObjectDef},S}) 691 end, 692 Gen = gen_incl(S,NewObj#'Object'.def, 693 (ClassDef#classdef.typespec)#objectclass.fields), 694 NewObj#'Object'{classname=NewClassRef,gen=Gen}; 695 696%%check_object(S,ObjSetDef,ObjSet=#type{def={pt,ObjSetRef,Args}}) -> 697 %% A parameterized 698 699check_object(S, 700 _ObjSetDef, 701 ObjSet=#'ObjectSet'{class=ClassRef}) -> 702 {_,ClassDef} = get_referenced_type(S,ClassRef), 703 NewClassRef = check_externaltypereference(S,ClassRef), 704 UniqueFieldName = 705 case (catch get_unique_fieldname(ClassDef)) of 706 {error,'__undefined_'} -> {unique,undefined}; 707 {asn1,Msg,_} -> error({class,Msg,S}); 708 Other -> Other 709 end, 710 NewObjSet= 711 case ObjSet#'ObjectSet'.set of 712 {'SingleValue',Set} when list(Set) -> 713 CheckedSet = check_object_list(S,NewClassRef,Set), 714 NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), 715 ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, 716 set=NewSet}; 717 {'SingleValue',{definedvalue,ObjName}} -> 718 {_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}), 719 #'Object'{def=CheckedObj} = 720 check_object(S,ObjDef,ObjDef#typedef.typespec), 721 NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name, 722 CheckedObj}], 723 UniqueFieldName), 724 ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, 725 set=NewSet}; 726 {'SingleValue',#'Externalvaluereference'{value=ObjName}} -> 727 {_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}), 728 #'Object'{def=CheckedObj} = 729 check_object(S,ObjDef,ObjDef#typedef.typespec), 730 NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name, 731 CheckedObj}], 732 UniqueFieldName), 733 ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, 734 set=NewSet}; 735 ['EXTENSIONMARK'] -> 736 ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, 737 set=['EXTENSIONMARK']}; 738 Set when list(Set) -> 739 CheckedSet = check_object_list(S,NewClassRef,Set), 740 NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), 741 ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, 742 set=NewSet}; 743 {Set,Ext} when list(Set) -> 744 CheckedSet = check_object_list(S,NewClassRef,Set++Ext), 745 NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), 746 ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, 747 set=NewSet++['EXTENSIONMARK']}; 748 {{'SingleValue',Set},Ext} -> 749 CheckedSet = check_object_list(S,NewClassRef, 750 merge_sets(Set,Ext)), 751 NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), 752 ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, 753 set=NewSet++['EXTENSIONMARK']}; 754 {Type,{'EXCEPT',Exclusion}} when record(Type,type) -> 755 {_,TDef} = get_referenced_type(S,Type#type.def), 756 OS = TDef#typedef.typespec, 757 NewSet = reduce_objectset(OS#'ObjectSet'.set,Exclusion), 758 NewOS = OS#'ObjectSet'{set=NewSet}, 759 check_object(S,TDef#typedef{typespec=NewOS}, 760 NewOS); 761 #type{def={pt,DefinedObjSet,ParamList}} -> 762 {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), 763 instantiate_pos(S,ClassDef,PObjSetDef,ParamList); 764 {ObjDef={object,definedsyntax,_ObjFields},_Ext} -> 765 CheckedSet = check_object_list(S,NewClassRef,[ObjDef]), 766 NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), 767 ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, 768 set=NewSet++['EXTENSIONMARK']} 769 end, 770 Gen = gen_incl_set(S,NewObjSet#'ObjectSet'.set, 771 ClassDef), 772 NewObjSet#'ObjectSet'{class=NewClassRef,gen=Gen}. 773 774 775merge_sets(Set,Ext) when list(Set),list(Ext) -> 776 Set ++ Ext; 777merge_sets(Set,Ext) when list(Ext) -> 778 [Set|Ext]; 779merge_sets(Set,{'SingleValue',Ext}) when list(Set) -> 780 Set ++ [Ext]; 781merge_sets(Set,{'SingleValue',Ext}) -> 782 [Set] ++ [Ext]. 783 784reduce_objectset(ObjectSet,Exclusion) -> 785 case Exclusion of 786 {'SingleValue',#'Externalvaluereference'{value=Name}} -> 787 case lists:keysearch(Name,1,ObjectSet) of 788 {value,El} -> 789 lists:subtract(ObjectSet,[El]); 790 _ -> 791 ObjectSet 792 end 793 end. 794 795%% Checks a list of objects or object sets and returns a list of selected 796%% information for the code generation. 797check_object_list(S,ClassRef,ObjectList) -> 798 check_object_list(S,ClassRef,ObjectList,[]). 799 800check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> 801 case ObjOrSet of 802 ObjDef when tuple(ObjDef),(element(1,ObjDef)==object) -> 803 Def = 804 check_object(S,#typedef{typespec=ObjDef}, 805% #'Object'{classname={objectclassname,ClassRef}, 806 #'Object'{classname=ClassRef, 807 def=ObjDef}), 808 check_object_list(S,ClassRef,Objs,[{no_name,Def#'Object'.def}|Acc]); 809 {'SingleValue',{definedvalue,ObjName}} -> 810 {_,ObjectDef} = get_referenced_type(S,#identifier{val=ObjName}), 811 #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), 812 check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]); 813 {'SingleValue',Ref = #'Externalvaluereference'{}} -> 814 {_,ObjectDef} = get_referenced_type(S,Ref), 815 #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), 816 check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]); 817 ObjRef when record(ObjRef,'Externalvaluereference') -> 818 {_,ObjectDef} = get_referenced_type(S,ObjRef), 819 #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), 820 check_object_list(S,ClassRef,Objs, 821%% [{ObjRef#'Externalvaluereference'.value,Def}|Acc]); 822 [{ObjectDef#typedef.name,Def}|Acc]); 823 {'ValueFromObject',{_,Object},FieldName} -> 824 {_,Def} = get_referenced_type(S,Object), 825%% TypeOrVal = get_fieldname_element(S,Def,FieldName);%% this must result in an object set 826 TypeDef = get_fieldname_element(S,Def,FieldName), 827 (TypeDef#typedef.typespec)#'ObjectSet'.set; 828 ObjSet when record(ObjSet,type) -> 829 ObjSetDef = 830 case ObjSet#type.def of 831 Ref when record(Ref,typereference); 832 record(Ref,'Externaltypereference') -> 833 {_,D} = get_referenced_type(S,ObjSet#type.def), 834 D; 835 Other -> 836 throw({asn1_error,{'unknown objecset',Other,S}}) 837 end, 838 #'ObjectSet'{set=ObjectsInSet} = 839 check_object(S,ObjSetDef,ObjSetDef#typedef.typespec), 840 AccList = transform_set_to_object_list(ObjectsInSet,[]), 841 check_object_list(S,ClassRef,Objs,AccList++Acc); 842 union -> 843 check_object_list(S,ClassRef,Objs,Acc); 844 Other -> 845 exit({error,{'unknown object',Other},S}) 846 end; 847%% Finally reverse the accumulated list and if there are any extension 848%% marks in the object set put one indicator of that in the end of the 849%% list. 850check_object_list(_,_,[],Acc) -> 851 lists:reverse(Acc). 852%% case lists:member('EXTENSIONMARK',RevAcc) of 853%% true -> 854%% ExclRevAcc = lists:filter(fun(X)->X /= 'EXTENSIONMARK' end, 855%% RevAcc), 856%% ExclRevAcc ++ ['EXTENSIONMARK']; 857%% false -> 858%% RevAcc 859%% end. 860 861 862%% get_fieldname_element/3 863%% gets the type/value/object/... of the referenced element in FieldName 864%% FieldName is a list and may have more than one element. 865%% Each element in FieldName can be either {typefieldreference,AnyFieldName} 866%% or {valuefieldreference,AnyFieldName} 867%% Def is the def of the first object referenced by FieldName 868get_fieldname_element(S,Def,[{_RefType,FieldName}]) when record(Def,typedef) -> 869 {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def, 870 case lists:keysearch(FieldName,1,ObjComps) of 871 {value,{_,TDef}} when record(TDef,typedef) -> 872 %% ORec = TDef#typedef.typespec, %% XXX This must be made general 873% case TDef#typedef.typespec of 874% ObjSetRec when record(ObjSetRec,'ObjectSet') -> 875% ObjSet = ObjSetRec#'ObjectSet'.set; 876% ObjRec when record(ObjRec,'Object') -> 877% %% now get the field in ObjRec that RestFName points out 878% %ObjRec 879% TDef 880% end; 881 TDef; 882 {value,{_,VDef}} when record(VDef,valuedef) -> 883 check_value(S,VDef); 884 _ -> 885 throw({assigned_object_error,"not_assigned_object",S}) 886 end; 887get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName]) 888 when record(Def,typedef) -> 889 ok. 890 891transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) -> 892 transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]); 893transform_set_to_object_list(['EXTENSIONMARK'|Objs],Acc) -> 894%% transform_set_to_object_list(Objs,['EXTENSIONMARK'|Acc]); 895 transform_set_to_object_list(Objs,Acc); 896transform_set_to_object_list([],Acc) -> 897 Acc. 898 899get_unique_valuelist(_S,ObjSet,{unique,undefined}) -> % no unique field in object 900 lists:map(fun({N,{_,_,F}})->{N,F}; 901 (V={_,_,_}) ->V end, ObjSet); 902get_unique_valuelist(S,ObjSet,UFN) -> 903 get_unique_vlist(S,ObjSet,UFN,[]). 904 905get_unique_vlist(S,[],_,Acc) -> 906 case catch check_uniqueness(Acc) of 907 {asn1_error,_} -> 908% exit({error,Reason,S}); 909 error({'ObjectSet',"not unique objects in object set",S}); 910 true -> 911 lists:reverse(Acc) 912 end; 913get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Acc) -> 914 {_,_,Fields} = Obj, 915 VDef = get_unique_value(S,Fields,UniqueFieldName), 916 get_unique_vlist(S,Rest,UniqueFieldName, 917 [{ObjName,VDef#valuedef.value,Fields}|Acc]); 918get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Acc) -> 919 get_unique_vlist(S,Rest,UniqueFieldName,[V|Acc]). 920 921get_unique_value(S,Fields,UniqueFieldName) -> 922 Module = S#state.mname, 923 case lists:keysearch(UniqueFieldName,1,Fields) of 924 {value,Field} -> 925 case element(2,Field) of 926 VDef when record(VDef,valuedef) -> 927 VDef; 928 {definedvalue,ValName} -> 929 ValueDef = asn1_db:dbget(Module,ValName), 930 case ValueDef of 931 VDef when record(VDef,valuedef) -> 932 ValueDef; 933 undefined -> 934 #valuedef{value=ValName} 935 end; 936 {'ValueFromObject',Object,Name} -> 937 case Object of 938 {object,Ext} when record(Ext,'Externaltypereference') -> 939 OtherModule = Ext#'Externaltypereference'.module, 940 ExtObjName = Ext#'Externaltypereference'.type, 941 ObjDef = asn1_db:dbget(OtherModule,ExtObjName), 942 ObjSpec = ObjDef#typedef.typespec, 943 get_unique_value(OtherModule,element(3,ObjSpec),Name); 944 {object,{_,_,ObjName}} -> 945 ObjDef = asn1_db:dbget(Module,ObjName), 946 ObjSpec = ObjDef#typedef.typespec, 947 get_unique_value(Module,element(3,ObjSpec),Name); 948 {po,Object,_Params} -> 949 exit({error,{'parameterized object not implemented yet', 950 Object},S}) 951 end; 952 Value when atom(Value);number(Value) -> 953 #valuedef{value=Value}; 954 {'CHOICE',{_,Value}} when atom(Value);number(Value) -> 955 #valuedef{value=Value} 956 end; 957 false -> 958 exit({error,{'no unique value',Fields,UniqueFieldName},S}) 959%% io:format("WARNING: no unique value in object"), 960%% exit(uniqueFieldName) 961 end. 962 963check_uniqueness(NameValueList) -> 964 check_uniqueness1(lists:keysort(2,NameValueList)). 965 966check_uniqueness1([]) -> 967 true; 968check_uniqueness1([_]) -> 969 true; 970check_uniqueness1([{_,N,_},{_,N,_}|_Rest]) -> 971 throw({asn1_error,{'objects in set must have unique values in UNIQUE fields',N}}); 972check_uniqueness1([_|Rest]) -> 973 check_uniqueness1(Rest). 974 975%% instantiate_po/4 976%% ClassDef is the class of Object, 977%% Object is the Parameterized object, which is referenced, 978%% ArgsList is the list of actual parameters 979%% returns an #'Object' record. 980instantiate_po(S,_ClassDef,Object,ArgsList) when record(Object,pobjectdef) -> 981 FormalParams = get_pt_args(Object), 982 MatchedArgs = match_args(FormalParams,ArgsList,[]), 983 NewS = S#state{type=Object,parameters=MatchedArgs}, 984 check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class, 985 def=Object#pobjectdef.def}). 986 987%% instantiate_pos/4 988%% ClassDef is the class of ObjectSetDef, 989%% ObjectSetDef is the Parameterized object set, which is referenced 990%% on the right side of the assignment, 991%% ArgsList is the list of actual parameters, i.e. real objects 992instantiate_pos(S,ClassDef,ObjectSetDef,ArgsList) -> 993 ClassName = ClassDef#classdef.name, 994 FormalParams = get_pt_args(ObjectSetDef), 995 Set = case get_pt_spec(ObjectSetDef) of 996 {valueset,_Set} -> _Set; 997 _Set -> _Set 998 end, 999 MatchedArgs = match_args(FormalParams,ArgsList,[]), 1000 NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs}, 1001 check_object(NewS,ObjectSetDef, 1002 #'ObjectSet'{class=name2Extref(S#state.mname,ClassName), 1003 set=Set}). 1004 1005 1006%% gen_incl -> boolean() 1007%% If object with Fields has any of the corresponding class' typefields 1008%% then return value is true otherwise it is false. 1009%% If an object lacks a typefield but the class has a type field that 1010%% is OPTIONAL then we want gen to be true 1011gen_incl(S,{_,_,Fields},CFields)-> 1012 gen_incl1(S,Fields,CFields). 1013 1014gen_incl1(_,_,[]) -> 1015 false; 1016gen_incl1(S,Fields,[C|CFields]) -> 1017 case element(1,C) of 1018 typefield -> 1019% case lists:keymember(element(2,C),1,Fields) of 1020% true -> 1021% true; 1022% false -> 1023% gen_incl1(S,Fields,CFields) 1024% end; 1025 true; %% should check that field is OPTIONAL or DEFUALT if 1026 %% the object lacks this field 1027 objectfield -> 1028 case lists:keysearch(element(2,C),1,Fields) of 1029 {value,Field} -> 1030 Type = element(3,C), 1031 {_,ClassDef} = get_referenced_type(S,Type#type.def), 1032% {_,ClassFields,_} = ClassDef#classdef.typespec, 1033 #objectclass{fields=ClassFields} = 1034 ClassDef#classdef.typespec, 1035 ObjTDef = element(2,Field), 1036 case gen_incl(S,(ObjTDef#typedef.typespec)#'Object'.def, 1037 ClassFields) of 1038 true -> 1039 true; 1040 _ -> 1041 gen_incl1(S,Fields,CFields) 1042 end; 1043 _ -> 1044 gen_incl1(S,Fields,CFields) 1045 end; 1046 _ -> 1047 gen_incl1(S,Fields,CFields) 1048 end. 1049 1050%% first if no unique field in the class return false.(don't generate code) 1051gen_incl_set(S,Fields,ClassDef) -> 1052 case catch get_unique_fieldname(ClassDef) of 1053 Tuple when tuple(Tuple) -> 1054 false; 1055 _ -> 1056 gen_incl_set1(S,Fields, 1057 (ClassDef#classdef.typespec)#objectclass.fields) 1058 end. 1059 1060%% if any of the existing or potentially existing objects has a typefield 1061%% then return true. 1062gen_incl_set1(_,[],_CFields)-> 1063 false; 1064gen_incl_set1(_,['EXTENSIONMARK'],_) -> 1065 true; 1066%% Fields are the fields of an object in the object set. 1067%% CFields are the fields of the class of the object set. 1068gen_incl_set1(S,[Object|Rest],CFields)-> 1069 Fields = element(size(Object),Object), 1070 case gen_incl1(S,Fields,CFields) of 1071 true -> 1072 true; 1073 false -> 1074 gen_incl_set1(S,Rest,CFields) 1075 end. 1076 1077check_objectdefn(S,Def,CDef) when record(CDef,classdef) -> 1078 WithSyntax = (CDef#classdef.typespec)#objectclass.syntax, 1079 ClassFields = (CDef#classdef.typespec)#objectclass.fields, 1080 case Def of 1081 {object,defaultsyntax,Fields} -> 1082 check_defaultfields(S,Fields,ClassFields); 1083 {object,definedsyntax,Fields} -> 1084 {_,WSSpec} = WithSyntax, 1085 NewFields = 1086 case catch( convert_definedsyntax(S,Fields,WSSpec, 1087 ClassFields,[])) of 1088 {asn1,{_ErrorType,ObjToken,ClassToken}} -> 1089 throw({asn1,{'match error in object',ObjToken, 1090 'found in object',ClassToken,'found in class'}}); 1091 Err={asn1,_} -> throw(Err); 1092 Err={'EXIT',_} -> throw(Err); 1093 DefaultFields when list(DefaultFields) -> 1094 DefaultFields 1095 end, 1096 {object,defaultsyntax,NewFields}; 1097 {object,_ObjectId} -> % This is a DefinedObject 1098 fixa; 1099 Other -> 1100 exit({error,{objectdefn,Other}}) 1101 end. 1102 1103check_defaultfields(S,Fields,ClassFields) -> 1104 check_defaultfields(S,Fields,ClassFields,[]). 1105 1106check_defaultfields(_S,[],_ClassFields,Acc) -> 1107 {object,defaultsyntax,lists:reverse(Acc)}; 1108check_defaultfields(S,[{FName,Spec}|Fields],ClassFields,Acc) -> 1109 case lists:keysearch(FName,2,ClassFields) of 1110 {value,CField} -> 1111 NewField = convert_to_defaultfield(S,FName,Spec,CField), 1112 check_defaultfields(S,Fields,ClassFields,[NewField|Acc]); 1113 _ -> 1114 throw({error,{asn1,{'unvalid field in object',FName}}}) 1115 end. 1116%% {object,defaultsyntax,Fields}. 1117 1118convert_definedsyntax(_S,[],[],_ClassFields,Acc) -> 1119 lists:reverse(Acc); 1120convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) -> 1121 case match_field(S,Fields,WithSyntax,ClassFields) of 1122 {MatchedField,RestFields,RestWS} -> 1123 if 1124 list(MatchedField) -> 1125 convert_definedsyntax(S,RestFields,RestWS,ClassFields, 1126 lists:append(MatchedField,Acc)); 1127 true -> 1128 convert_definedsyntax(S,RestFields,RestWS,ClassFields, 1129 [MatchedField|Acc]) 1130 end 1131%% throw({error,{asn1,{'unvalid syntax in object',WorS}}}) 1132 end. 1133 1134match_field(S,Fields,WithSyntax,ClassFields) -> 1135 match_field(S,Fields,WithSyntax,ClassFields,[]). 1136 1137match_field(S,Fields,[W|Ws],ClassFields,Acc) when list(W) -> 1138 case catch(match_optional_field(S,Fields,W,ClassFields,[])) of 1139 {'EXIT',_} -> 1140 match_field(Fields,Ws,ClassFields,Acc); %% add S 1141%% {[Result],RestFields} -> 1142%% {Result,RestFields,Ws}; 1143 {Result,RestFields} when list(Result) -> 1144 {Result,RestFields,Ws}; 1145 _ -> 1146 match_field(S,Fields,Ws,ClassFields,Acc) 1147 end; 1148match_field(S,Fields,WithSyntax,ClassFields,_Acc) -> 1149 match_mandatory_field(S,Fields,WithSyntax,ClassFields,[]). 1150 1151match_optional_field(_S,RestFields,[],_,Ret) -> 1152 {Ret,RestFields}; 1153%% An additional optional field within an optional field 1154match_optional_field(S,Fields,[W|Ws],ClassFields,Ret) when list(W) -> 1155 case catch match_optional_field(S,Fields,W,ClassFields,[]) of 1156 {'EXIT',_} -> 1157 {Ret,Fields}; 1158 {asn1,{optional_matcherror,_,_}} -> 1159 {Ret,Fields}; 1160 {OptionalField,RestFields} -> 1161 match_optional_field(S,RestFields,Ws,ClassFields, 1162 lists:append(OptionalField,Ret)) 1163 end; 1164%% identify and skip word 1165%match_optional_field(S,[#'Externaltypereference'{type=WorS}|Rest], 1166match_optional_field(S,[{_,_,WorS}|Rest], 1167 [WorS|Ws],ClassFields,Ret) -> 1168 match_optional_field(S,Rest,Ws,ClassFields,Ret); 1169match_optional_field(S,[],_,ClassFields,Ret) -> 1170 match_optional_field(S,[],[],ClassFields,Ret); 1171%% identify and skip comma 1172match_optional_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) -> 1173 match_optional_field(S,Rest,Ws,ClassFields,Ret); 1174%% identify and save field data 1175match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) -> 1176 WorS = 1177 case Setting of 1178 Type when record(Type,type) -> Type; 1179%% #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting; 1180 {'ValueFromObject',_,_} -> Setting; 1181 {object,_,_} -> Setting; 1182 {_,_,WordOrSetting} -> WordOrSetting; 1183%% Atom when atom(Atom) -> Atom 1184 Other -> Other 1185 end, 1186 case lists:keysearch(W,2,ClassFields) of 1187 false -> 1188 throw({asn1,{optional_matcherror,WorS,W}}); 1189 {value,CField} -> 1190 NewField = convert_to_defaultfield(S,W,WorS,CField), 1191 match_optional_field(S,Rest,Ws,ClassFields,[NewField|Ret]) 1192 end; 1193match_optional_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Ret) -> 1194 throw({asn1,{optional_matcherror,WorS,W}}). 1195 1196match_mandatory_field(_S,[],[],_,[Acc]) -> 1197 {Acc,[],[]}; 1198match_mandatory_field(_S,[],[],_,Acc) -> 1199 {Acc,[],[]}; 1200match_mandatory_field(S,[],[H|T],CF,Acc) when list(H) -> 1201 match_mandatory_field(S,[],T,CF,Acc); 1202match_mandatory_field(_S,[],WithSyntax,_,_Acc) -> 1203 throw({asn1,{mandatory_matcherror,[],WithSyntax}}); 1204%match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,[Acc]) when list(W) -> 1205match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when list(W), length(Acc) >= 1 -> 1206 {Acc,Fields,WithSyntax}; 1207%% identify and skip word 1208match_mandatory_field(S,[{_,_,WorS}|Rest], 1209 [WorS|Ws],ClassFields,Acc) -> 1210 match_mandatory_field(S,Rest,Ws,ClassFields,Acc); 1211%% identify and skip comma 1212match_mandatory_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) -> 1213 match_mandatory_field(S,Rest,Ws,ClassFields,Ret); 1214%% identify and save field data 1215match_mandatory_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Acc) -> 1216 WorS = 1217 case Setting of 1218%% Atom when atom(Atom) -> Atom; 1219%% #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting; 1220 {object,_,_} -> Setting; 1221 {_,_,WordOrSetting} -> WordOrSetting; 1222 Type when record(Type,type) -> Type; 1223 Other -> Other 1224 end, 1225 case lists:keysearch(W,2,ClassFields) of 1226 false -> 1227 throw({asn1,{mandatory_matcherror,WorS,W}}); 1228 {value,CField} -> 1229 NewField = convert_to_defaultfield(S,W,WorS,CField), 1230 match_mandatory_field(S,Rest,Ws,ClassFields,[NewField|Acc]) 1231 end; 1232 1233match_mandatory_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Acc) -> 1234 throw({asn1,{mandatory_matcherror,WorS,W}}). 1235 1236%% Converts a field of an object from defined syntax to default syntax 1237convert_to_defaultfield(S,ObjFieldName,ObjFieldSetting,CField)-> 1238 CurrMod = S#state.mname, 1239 case element(1,CField) of 1240 typefield -> 1241 TypeDef= 1242 case ObjFieldSetting of 1243 TypeRec when record(TypeRec,type) -> TypeRec#type.def; 1244 TDef when record(TDef,typedef) -> 1245 TDef#typedef{typespec=check_type(S,TDef, 1246 TDef#typedef.typespec)}; 1247 _ -> ObjFieldSetting 1248 end, 1249 Type = 1250 if 1251 record(TypeDef,typedef) -> TypeDef; 1252 true -> 1253 case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of 1254 ERef = #'Externaltypereference'{module=CurrMod} -> 1255 {_,T} = get_referenced_type(S,ERef), 1256 T#typedef{checked=true, 1257 typespec=check_type(S,T, 1258 T#typedef.typespec)}; 1259 ERef = #'Externaltypereference'{module=ExtMod} -> 1260 {_,T} = get_referenced_type(S,ERef), 1261 #typedef{name=Name} = T, 1262 check_type(S,T,T#typedef.typespec), 1263 #typedef{checked=true, 1264 name={ExtMod,Name}, 1265 typespec=ERef}; 1266 Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> 1267 T = check_type(S,#typedef{typespec=ObjFieldSetting}, 1268 ObjFieldSetting), 1269 #typedef{checked=true,name=Bif,typespec=T}; 1270 _ -> 1271 {Mod,T} = 1272 %% get_referenced_type(S,#typereference{val=ObjFieldSetting}), 1273 get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}), 1274 case Mod of 1275 CurrMod -> 1276 T; 1277 ExtMod -> 1278 #typedef{name=Name} = T, 1279 T#typedef{name={ExtMod,Name}} 1280 end 1281 end 1282 end, 1283 {ObjFieldName,Type}; 1284 fixedtypevaluefield -> 1285 case ObjFieldName of 1286 Val when atom(Val) -> 1287 %% ObjFieldSetting can be a value,an objectidentifiervalue, 1288 %% an element in an enumeration or namednumberlist etc. 1289 ValRef = 1290 case ObjFieldSetting of 1291 #'Externalvaluereference'{} -> ObjFieldSetting; 1292 {'ValueFromObject',{_,ObjRef},FieldName} -> 1293 {_,Object} = get_referenced_type(S,ObjRef), 1294 ChObject = check_object(S,Object, 1295 Object#typedef.typespec), 1296 get_fieldname_element(S,Object#typedef{typespec=ChObject}, 1297 FieldName); 1298 #valuedef{} -> 1299 ObjFieldSetting; 1300 _ -> 1301 #identifier{val=ObjFieldSetting} 1302 end, 1303 case ValRef of 1304 #valuedef{} -> 1305 {ObjFieldName,check_value(S,ValRef)}; 1306 _ -> 1307 ValDef = 1308 case catch get_referenced_type(S,ValRef) of 1309 {error,_} -> 1310 check_value(S,#valuedef{name=Val, 1311 type=element(3,CField), 1312 value=ObjFieldSetting}); 1313 {_,VDef} when record(VDef,valuedef) -> 1314 check_value(S,VDef);%% XXX 1315 {_,VDef} -> 1316 check_value(S,#valuedef{name=Val, 1317 type=element(3,CField), 1318 value=VDef}) 1319 end, 1320 {ObjFieldName,ValDef} 1321 end; 1322 Val -> 1323 {ObjFieldName,Val} 1324 end; 1325 fixedtypevaluesetfield -> 1326 {ObjFieldName,ObjFieldSetting}; 1327 objectfield -> 1328 ObjectSpec = 1329 case ObjFieldSetting of 1330 Ref when record(Ref,typereference);record(Ref,identifier); 1331 record(Ref,'Externaltypereference'); 1332 record(Ref,'Externalvaluereference') -> 1333 {_,R} = get_referenced_type(S,ObjFieldSetting), 1334 R; 1335 {'ValueFromObject',{_,ObjRef},FieldName} -> 1336 %% This is an ObjectFromObject 1337 {_,Object} = get_referenced_type(S,ObjRef), 1338 ChObject = check_object(S,Object, 1339 Object#typedef.typespec), 1340 _ObjFromObj= 1341 get_fieldname_element(S,Object#typedef{ 1342 typespec=ChObject}, 1343 FieldName); 1344 %%ClassName = ObjFromObj#'Object'.classname, 1345 %%#typedef{name=, 1346 %% typespec= 1347 %% ObjFromObj#'Object'{classname= 1348 %% {objectclassname,ClassName}}}; 1349 {object,_,_} -> 1350 %% An object defined inlined in another object 1351 #type{def=Ref} = element(3,CField), 1352% CRef = case Ref of 1353% #'Externaltypereference'{module=CurrMod, 1354% type=CName} -> 1355% CName; 1356% #'Externaltypereference'{module=ExtMod, 1357% type=CName} -> 1358% {ExtMod,CName} 1359% end, 1360 InlinedObjName= 1361 list_to_atom(lists:concat([S#state.tname]++ 1362 ['_',ObjFieldName])), 1363% ObjSpec = #'Object'{classname={objectclassname,CRef}, 1364 ObjSpec = #'Object'{classname=Ref, 1365 def=ObjFieldSetting}, 1366 CheckedObj= 1367 check_object(S,#typedef{typespec=ObjSpec},ObjSpec), 1368 InlObj = #typedef{checked=true,name=InlinedObjName, 1369 typespec=CheckedObj}, 1370 asn1ct_gen:insert_once(inlined_objects,{InlinedObjName, 1371 InlinedObjName}), 1372 asn1_db:dbput(S#state.mname,InlinedObjName,InlObj), 1373 InlObj; 1374 #type{def=Eref} when record(Eref,'Externaltypereference') -> 1375 {_,R} = get_referenced_type(S,Eref), 1376 R; 1377 _ -> 1378%% {_,R} = get_referenced_type(S,#typereference{val=ObjFieldSetting}), 1379 {_,R} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}), 1380 R 1381 end, 1382 {ObjFieldName, 1383 ObjectSpec#typedef{checked=true, 1384 typespec=check_object(S,ObjectSpec, 1385 ObjectSpec#typedef.typespec)}}; 1386 variabletypevaluefield -> 1387 {ObjFieldName,ObjFieldSetting}; 1388 variabletypevaluesetfield -> 1389 {ObjFieldName,ObjFieldSetting}; 1390 objectsetfield -> 1391 {_,ObjSetSpec} = 1392 case ObjFieldSetting of 1393 Ref when record(Ref,'Externaltypereference'); 1394 record(Ref,'Externalvaluereference') -> 1395 get_referenced_type(S,ObjFieldSetting); 1396 ObjectList when list(ObjectList) -> 1397 %% an objctset defined in the object,though maybe 1398 %% parsed as a SequenceOfValue 1399 %% The ObjectList may be a list of references to 1400 %% objects, a ValueFromObject 1401 {_,_,Type,_} = CField, 1402 ClassDef = Type#type.def, 1403 case ClassDef#'Externaltypereference'.module of 1404 CurrMod -> 1405 ClassDef#'Externaltypereference'.type; 1406 ExtMod -> 1407 {ExtMod, 1408 ClassDef#'Externaltypereference'.type} 1409 end, 1410 {no_name, 1411 #typedef{typespec= 1412 #'ObjectSet'{class= 1413% {objectclassname,ClassRef}, 1414 ClassDef, 1415 set=ObjectList}}}; 1416 ObjectSet={'SingleValue',_} -> 1417 %% a Union of defined objects 1418 {_,_,Type,_} = CField, 1419 ClassDef = Type#type.def, 1420% ClassRef = 1421% case ClassDef#'Externaltypereference'.module of 1422% CurrMod -> 1423% ClassDef#'Externaltypereference'.type; 1424% ExtMod -> 1425% {ExtMod, 1426% ClassDef#'Externaltypereference'.type} 1427% end, 1428 {no_name, 1429% #typedef{typespec=#'ObjectSet'{class={objectclassname,ClassRef}, 1430 #typedef{typespec=#'ObjectSet'{class=ClassDef, 1431 set=ObjectSet}}}; 1432 {object,_,[#type{def={'TypeFromObject', 1433 {object,RefedObj}, 1434 FieldName}}]} -> 1435 %% This case occurs when an ObjectSetFromObjects 1436 %% production is used 1437 {M,Def} = get_referenced_type(S,RefedObj), 1438 {M,get_fieldname_element(S,Def,FieldName)}; 1439 #type{def=Eref} when 1440 record(Eref,'Externaltypereference') -> 1441 get_referenced_type(S,Eref); 1442 _ -> 1443%% get_referenced_type(S,#typereference{val=ObjFieldSetting}) 1444 get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}) 1445 end, 1446 {ObjFieldName, 1447 ObjSetSpec#typedef{checked=true, 1448 typespec=check_object(S,ObjSetSpec, 1449 ObjSetSpec#typedef.typespec)}} 1450 end. 1451 1452check_value(OldS,V) when record(V,pvaluesetdef) -> 1453 #pvaluesetdef{checked=Checked,type=Type} = V, 1454 case Checked of 1455 true -> V; 1456 {error,_} -> V; 1457 false -> 1458 case get_referenced_type(OldS,Type#type.def) of 1459 {_,Class} when record(Class,classdef) -> 1460 throw({pobjectsetdef}); 1461 _ -> continue 1462 end 1463 end; 1464check_value(_OldS,V) when record(V,pvaluedef) -> 1465 %% Fix this case later 1466 V; 1467check_value(OldS,V) when record(V,typedef) -> 1468 %% This case when a value set has been parsed as an object set. 1469 %% It may be a value set 1470 #typedef{typespec=TS} = V, 1471 case TS of 1472 #'ObjectSet'{class=ClassRef} -> 1473 {_,TSDef} = get_referenced_type(OldS,ClassRef), 1474 %%IsObjectSet(TSDef); 1475 case TSDef of 1476 #classdef{} -> throw({objectsetdef}); 1477 #typedef{typespec=#type{def=Eref}} when 1478 record(Eref,'Externaltypereference') -> 1479 %% This case if the class reference is a defined 1480 %% reference to class 1481 check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}}); 1482 #typedef{} -> 1483 % an ordinary value set with a type in #typedef.typespec 1484 ValueSet = TS#'ObjectSet'.set, 1485 Type=check_type(OldS,TSDef,TSDef#typedef.typespec), 1486 Value = check_value(OldS,#valuedef{type=Type, 1487 value=ValueSet}), 1488 {valueset,Type#type{constraint=Value#valuedef.value}} 1489 end; 1490 _ -> 1491 throw({objectsetdef}) 1492 end; 1493check_value(S,#valuedef{pos=Pos,name=Name,type=Type, 1494 value={valueset,Constr}}) -> 1495 NewType = Type#type{constraint=[Constr]}, 1496 {valueset, 1497 check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)}; 1498check_value(OldS=#state{recordtopname=TopName},V) when record(V,valuedef) -> 1499 #valuedef{name=Name,checked=Checked,type=Vtype,value=Value} = V, 1500 case Checked of 1501 true -> 1502 V; 1503 {error,_} -> 1504 V; 1505 false -> 1506 Def = Vtype#type.def, 1507 Constr = Vtype#type.constraint, 1508 S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name}, 1509 NewDef = 1510 case Def of 1511 Ext when record(Ext,'Externaltypereference') -> 1512 RecName = Ext#'Externaltypereference'.type, 1513 {_,Type} = get_referenced_type(S,Ext), 1514 %% If V isn't a value but an object Type is a #classdef{} 1515 case Type of 1516 #classdef{} -> 1517 throw({objectdef}); 1518 #typedef{} -> 1519 case is_contextswitchtype(Type) of 1520 true -> 1521 #valuedef{value=CheckedVal}= 1522 check_value(S,V#valuedef{type=Type#typedef.typespec}), 1523 #newv{value=CheckedVal}; 1524 _ -> 1525 #valuedef{value=CheckedVal}= 1526 check_value(S#state{recordtopname=[RecName|TopName]}, 1527 V#valuedef{type=Type#typedef.typespec}), 1528 #newv{value=CheckedVal} 1529 end 1530 end; 1531 'ANY' -> 1532 throw({error,{asn1,{'cant check value of type',Def}}}); 1533 'INTEGER' -> 1534 validate_integer(S,Value,[],Constr), 1535 #newv{value=normalize_value(S,Vtype,Value,[])}; 1536 {'INTEGER',NamedNumberList} -> 1537 validate_integer(S,Value,NamedNumberList,Constr), 1538 #newv{value=normalize_value(S,Vtype,Value,[])}; 1539 {'BIT STRING',NamedNumberList} -> 1540 validate_bitstring(S,Value,NamedNumberList,Constr), 1541 #newv{value=normalize_value(S,Vtype,Value,[])}; 1542 'NULL' -> 1543 validate_null(S,Value,Constr), 1544 #newv{}; 1545 'OBJECT IDENTIFIER' -> 1546 validate_objectidentifier(S,Value,Constr), 1547 #newv{value = normalize_value(S,Vtype,Value,[])}; 1548 'ObjectDescriptor' -> 1549 validate_objectdescriptor(S,Value,Constr), 1550 #newv{value=normalize_value(S,Vtype,Value,[])}; 1551 {'ENUMERATED',NamedNumberList} -> 1552 validate_enumerated(S,Value,NamedNumberList,Constr), 1553 #newv{value=normalize_value(S,Vtype,Value,[])}; 1554 'BOOLEAN'-> 1555 validate_boolean(S,Value,Constr), 1556 #newv{value=normalize_value(S,Vtype,Value,[])}; 1557 'OCTET STRING' -> 1558 validate_octetstring(S,Value,Constr), 1559 #newv{value=normalize_value(S,Vtype,Value,[])}; 1560 'NumericString' -> 1561 validate_restrictedstring(S,Value,Def,Constr), 1562 #newv{value=normalize_value(S,Vtype,Value,[])}; 1563 'TeletexString' -> 1564 validate_restrictedstring(S,Value,Def,Constr), 1565 #newv{value=normalize_value(S,Vtype,Value,[])}; 1566 'VideotexString' -> 1567 validate_restrictedstring(S,Value,Def,Constr), 1568 #newv{value=normalize_value(S,Vtype,Value,[])}; 1569 'UTCTime' -> 1570 #newv{value=normalize_value(S,Vtype,Value,[])}; 1571% exit({'cant check value of type' ,Def}); 1572 'GeneralizedTime' -> 1573 #newv{value=normalize_value(S,Vtype,Value,[])}; 1574% exit({'cant check value of type' ,Def}); 1575 'GraphicString' -> 1576 validate_restrictedstring(S,Value,Def,Constr), 1577 #newv{value=normalize_value(S,Vtype,Value,[])}; 1578 'VisibleString' -> 1579 validate_restrictedstring(S,Value,Def,Constr), 1580 #newv{value=normalize_value(S,Vtype,Value,[])}; 1581 'GeneralString' -> 1582 validate_restrictedstring(S,Value,Def,Constr), 1583 #newv{value=normalize_value(S,Vtype,Value,[])}; 1584 'PrintableString' -> 1585 validate_restrictedstring(S,Value,Def,Constr), 1586 #newv{value=normalize_value(S,Vtype,Value,[])}; 1587 'IA5String' -> 1588 validate_restrictedstring(S,Value,Def,Constr), 1589 #newv{value=normalize_value(S,Vtype,Value,[])}; 1590 'BMPString' -> 1591 validate_restrictedstring(S,Value,Def,Constr), 1592 #newv{value=normalize_value(S,Vtype,Value,[])}; 1593%% 'UniversalString' -> %added 6/12 -00 1594%% #newv{value=validate_restrictedstring(S,Value,Def,Constr)}; 1595 Seq when record(Seq,'SEQUENCE') -> 1596 SeqVal = validate_sequence(S,Value, 1597 Seq#'SEQUENCE'.components, 1598 Constr), 1599 #newv{value=normalize_value(S,Vtype,SeqVal,TopName)}; 1600 {'SEQUENCE OF',Components} -> 1601 validate_sequenceof(S,Value,Components,Constr), 1602 #newv{value=normalize_value(S,Vtype,Value,TopName)}; 1603 {'CHOICE',Components} -> 1604 validate_choice(S,Value,Components,Constr), 1605 #newv{value=normalize_value(S,Vtype,Value,TopName)}; 1606 Set when record(Set,'SET') -> 1607 validate_set(S,Value,Set#'SET'.components, 1608 Constr), 1609 #newv{value=normalize_value(S,Vtype,Value,TopName)}; 1610 {'SET OF',Components} -> 1611 validate_setof(S,Value,Components,Constr), 1612 #newv{value=normalize_value(S,Vtype,Value,TopName)}; 1613 Other -> 1614 exit({'cant check value of type' ,Other}) 1615 end, 1616 case NewDef#newv.value of 1617 unchanged -> 1618 V#valuedef{checked=true,value=Value}; 1619 ok -> 1620 V#valuedef{checked=true,value=Value}; 1621 {error,Reason} -> 1622 V#valuedef{checked={error,Reason},value=Value}; 1623 _V -> 1624 V#valuedef{checked=true,value=_V} 1625 end 1626 end. 1627 1628is_contextswitchtype(#typedef{name='EXTERNAL'})-> 1629 true; 1630is_contextswitchtype(#typedef{name='EMBEDDED PDV'}) -> 1631 true; 1632is_contextswitchtype(#typedef{name='CHARACTER STRING'}) -> 1633 true; 1634is_contextswitchtype(_) -> 1635 false. 1636 1637% validate_integer(S,{identifier,Pos,Id},NamedNumberList,Constr) -> 1638% case lists:keysearch(Id,1,NamedNumberList) of 1639% {value,_} -> ok; 1640% false -> error({value,"unknown NamedNumber",S}) 1641% end; 1642%% This case occurs when there is a valuereference 1643validate_integer(S=#state{mname=M}, 1644 #'Externalvaluereference'{module=M,value=Id}, 1645 NamedNumberList,_Constr) -> 1646 case lists:keysearch(Id,1,NamedNumberList) of 1647 {value,_} -> ok; 1648 false -> error({value,"unknown NamedNumber",S}) 1649 end; 1650validate_integer(S,Id,NamedNumberList,_Constr) when atom(Id) -> 1651 case lists:keysearch(Id,1,NamedNumberList) of 1652 {value,_} -> ok; 1653 false -> error({value,"unknown NamedNumber",S}) 1654 end; 1655validate_integer(_S,Value,_NamedNumberList,Constr) when integer(Value) -> 1656 check_integer_range(Value,Constr). 1657 1658check_integer_range(Int,Constr) when list(Constr) -> 1659 NewConstr = [X || #constraint{c=X} <- Constr], 1660 check_constr(Int,NewConstr); 1661 1662check_integer_range(_Int,_Constr) -> 1663 %%io:format("~p~n",[Constr]), 1664 ok. 1665 1666check_constr(Int,[{'ValueRange',Lb,Ub}|T]) when Int >= Lb, Int =< Ub -> 1667 check_constr(Int,T); 1668check_constr(_Int,[]) -> 1669 ok. 1670 1671validate_bitstring(_S,_Value,_NamedNumberList,_Constr) -> 1672 ok. 1673 1674validate_null(_S,'NULL',_Constr) -> 1675 ok. 1676 1677%%------------ 1678%% This can be removed when the old parser is removed 1679%% The function removes 'space' atoms from the list 1680 1681is_space_list([H],Acc) -> 1682 lists:reverse([H|Acc]); 1683is_space_list([H,space|T],Acc) -> 1684 is_space_list(T,[H|Acc]); 1685is_space_list([],Acc) -> 1686 lists:reverse(Acc); 1687is_space_list([H|T],Acc) -> 1688 is_space_list(T,[H|Acc]). 1689 1690validate_objectidentifier(S,L,_) -> 1691 case is_space_list(L,[]) of 1692 NewL when list(NewL) -> 1693 case validate_objectidentifier1(S,NewL) of 1694 NewL2 when list(NewL2) -> 1695 list_to_tuple(NewL2); 1696 Other -> Other 1697 end; 1698 {error,_} -> 1699 error({value, "illegal OBJECT IDENTIFIER", S}) 1700 end. 1701 1702validate_objectidentifier1(S, [Id|T]) when record(Id,'Externalvaluereference') -> 1703 case catch get_referenced_type(S,Id) of 1704 {_,V} when record(V,valuedef) -> 1705 case check_value(S,V) of 1706 #valuedef{type=#type{def='OBJECT IDENTIFIER'}, 1707 checked=true,value=Value} when tuple(Value) -> 1708 validate_objectid(S, T, lists:reverse(tuple_to_list(Value))); 1709 _ -> 1710 error({value, "illegal OBJECT IDENTIFIER", S}) 1711 end; 1712 _ -> 1713 validate_objectid(S, [Id|T], []) 1714 end; 1715validate_objectidentifier1(S,V) -> 1716 validate_objectid(S,V,[]). 1717 1718validate_objectid(_, [], Acc) -> 1719 lists:reverse(Acc); 1720validate_objectid(S, [Value|Vrest], Acc) when integer(Value) -> 1721 validate_objectid(S, Vrest, [Value|Acc]); 1722validate_objectid(S, [{'NamedNumber',_Name,Value}|Vrest], Acc) 1723 when integer(Value) -> 1724 validate_objectid(S, Vrest, [Value|Acc]); 1725validate_objectid(S, [Id|Vrest], Acc) 1726 when record(Id,'Externalvaluereference') -> 1727 case catch get_referenced_type(S, Id) of 1728 {_,V} when record(V,valuedef) -> 1729 case check_value(S, V) of 1730 #valuedef{checked=true,value=Value} when integer(Value) -> 1731 validate_objectid(S, Vrest, [Value|Acc]); 1732 _ -> 1733 error({value, "illegal OBJECT IDENTIFIER", S}) 1734 end; 1735 _ -> 1736 case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of 1737 Value when integer(Value) -> 1738 validate_objectid(S, Vrest, [Value|Acc]); 1739 false -> 1740 error({value, "illegal OBJECT IDENTIFIER", S}) 1741 end 1742 end; 1743validate_objectid(S, [{Atom,Value}],[]) when atom(Atom),integer(Value) -> 1744 %% this case when an OBJECT IDENTIFIER value has been parsed as a 1745 %% SEQUENCE value 1746 Rec = #'Externalvaluereference'{module=S#state.mname, 1747 value=Atom}, 1748 validate_objectidentifier1(S,[Rec,Value]); 1749validate_objectid(S, [{Atom,EVRef}],[]) 1750 when atom(Atom),record(EVRef,'Externalvaluereference') -> 1751 %% this case when an OBJECT IDENTIFIER value has been parsed as a 1752 %% SEQUENCE value OTP-4354 1753 Rec = #'Externalvaluereference'{module=S#state.mname, 1754 value=Atom}, 1755 validate_objectidentifier1(S,[Rec,EVRef]); 1756validate_objectid(S, _V, _Acc) -> 1757 error({value, "illegal OBJECT IDENTIFIER",S}). 1758 1759 1760%% ITU-T Rec. X.680 Annex B - D 1761reserved_objectid('itu-t',[]) -> 0; 1762reserved_objectid('ccitt',[]) -> 0; 1763%% arcs below "itu-t" 1764reserved_objectid('recommendation',[0]) -> 0; 1765reserved_objectid('question',[0]) -> 1; 1766reserved_objectid('administration',[0]) -> 2; 1767reserved_objectid('network-operator',[0]) -> 3; 1768reserved_objectid('identified-organization',[0]) -> 4; 1769%% arcs below "recommendation" 1770reserved_objectid('a',[0,0]) -> 1; 1771reserved_objectid('b',[0,0]) -> 2; 1772reserved_objectid('c',[0,0]) -> 3; 1773reserved_objectid('d',[0,0]) -> 4; 1774reserved_objectid('e',[0,0]) -> 5; 1775reserved_objectid('f',[0,0]) -> 6; 1776reserved_objectid('g',[0,0]) -> 7; 1777reserved_objectid('h',[0,0]) -> 8; 1778reserved_objectid('i',[0,0]) -> 9; 1779reserved_objectid('j',[0,0]) -> 10; 1780reserved_objectid('k',[0,0]) -> 11; 1781reserved_objectid('l',[0,0]) -> 12; 1782reserved_objectid('m',[0,0]) -> 13; 1783reserved_objectid('n',[0,0]) -> 14; 1784reserved_objectid('o',[0,0]) -> 15; 1785reserved_objectid('p',[0,0]) -> 16; 1786reserved_objectid('q',[0,0]) -> 17; 1787reserved_objectid('r',[0,0]) -> 18; 1788reserved_objectid('s',[0,0]) -> 19; 1789reserved_objectid('t',[0,0]) -> 20; 1790reserved_objectid('u',[0,0]) -> 21; 1791reserved_objectid('v',[0,0]) -> 22; 1792reserved_objectid('w',[0,0]) -> 23; 1793reserved_objectid('x',[0,0]) -> 24; 1794reserved_objectid('y',[0,0]) -> 25; 1795reserved_objectid('z',[0,0]) -> 26; 1796 1797 1798reserved_objectid(iso,[]) -> 1; 1799%% arcs below "iso", note that number 1 is not used 1800reserved_objectid('standard',[1]) -> 0; 1801reserved_objectid('member-body',[1]) -> 2; 1802reserved_objectid('identified-organization',[1]) -> 3; 1803 1804reserved_objectid('joint-iso-itu-t',[]) -> 2; 1805reserved_objectid('joint-iso-ccitt',[]) -> 2; 1806 1807reserved_objectid(_,_) -> false. 1808 1809 1810 1811 1812 1813validate_objectdescriptor(_S,_Value,_Constr) -> 1814 ok. 1815 1816validate_enumerated(S,Id,NamedNumberList,_Constr) when atom(Id) -> 1817 case lists:keysearch(Id,1,NamedNumberList) of 1818 {value,_} -> ok; 1819 false -> error({value,"unknown ENUMERATED",S}) 1820 end; 1821validate_enumerated(S,{identifier,_Pos,Id},NamedNumberList,_Constr) -> 1822 case lists:keysearch(Id,1,NamedNumberList) of 1823 {value,_} -> ok; 1824 false -> error({value,"unknown ENUMERATED",S}) 1825 end; 1826validate_enumerated(S,#'Externalvaluereference'{value=Id}, 1827 NamedNumberList,_Constr) -> 1828 case lists:keysearch(Id,1,NamedNumberList) of 1829 {value,_} -> ok; 1830 false -> error({value,"unknown ENUMERATED",S}) 1831 end. 1832 1833validate_boolean(_S,_Value,_Constr) -> 1834 ok. 1835 1836validate_octetstring(_S,_Value,_Constr) -> 1837 ok. 1838 1839validate_restrictedstring(_S,_Value,_Def,_Constr) -> 1840 ok. 1841 1842validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) -> 1843 case Vtype of 1844 #type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} -> 1845 %% this is an 'EXTERNAL' (or INSTANCE OF) 1846 case Value of 1847 [{identification,_}|_RestVal] -> 1848 to_EXTERNAL1990(S,Value); 1849 _ -> 1850 Value 1851 end; 1852 _ -> 1853 Value 1854 end. 1855 1856validate_sequenceof(_S,_Value,_Components,_Constr) -> 1857 ok. 1858 1859validate_choice(_S,_Value,_Components,_Constr) -> 1860 ok. 1861 1862validate_set(_S,_Value,_Components,_Constr) -> 1863 ok. 1864 1865validate_setof(_S,_Value,_Components,_Constr) -> 1866 ok. 1867 1868to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) -> 1869 to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]); 1870to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) -> 1871 to_EXTERNAL1990(S,Rest,[{'indirect-reference',I}]); 1872to_EXTERNAL1990(S,[{identification,{'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) -> 1873 to_EXTERNAL1990(S,Rest,[{'indirect-reference',PCid},{'direct-reference',TrStx}]); 1874to_EXTERNAL1990(S,_) -> 1875 error({value,"illegal value in EXTERNAL type",S}). 1876 1877to_EXTERNAL1990(S,[V={'data-value-descriptor',_}|Rest],Acc) -> 1878 to_EXTERNAL1990(S,Rest,[V|Acc]); 1879to_EXTERNAL1990(_S,[{'data-value',Val}],Acc) -> 1880 Encoding = {encoding,{'CHOICE',{'octet-aligned',Val}}}, 1881 lists:reverse([Encoding|Acc]); 1882to_EXTERNAL1990(S,_,_) -> 1883 error({value,"illegal value in EXTERNAL type",S}). 1884 1885%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1886%% Functions to normalize the default values of SEQUENCE 1887%% and SET components into Erlang valid format 1888%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1889normalize_value(_,_,mandatory,_) -> 1890 mandatory; 1891normalize_value(_,_,'OPTIONAL',_) -> 1892 'OPTIONAL'; 1893normalize_value(S,Type,{'DEFAULT',Value},NameList) -> 1894 case catch get_canonic_type(S,Type,NameList) of 1895 {'BOOLEAN',CType,_} -> 1896 normalize_boolean(S,Value,CType); 1897 {'INTEGER',CType,_} -> 1898 normalize_integer(S,Value,CType); 1899 {'BIT STRING',CType,_} -> 1900 normalize_bitstring(S,Value,CType); 1901 {'OCTET STRING',CType,_} -> 1902 normalize_octetstring(S,Value,CType); 1903 {'NULL',_CType,_} -> 1904 %%normalize_null(Value); 1905 'NULL'; 1906 {'OBJECT IDENTIFIER',_,_} -> 1907 normalize_objectidentifier(S,Value); 1908 {'ObjectDescriptor',_,_} -> 1909 normalize_objectdescriptor(Value); 1910 {'REAL',_,_} -> 1911 normalize_real(Value); 1912 {'ENUMERATED',CType,_} -> 1913 normalize_enumerated(Value,CType); 1914 {'CHOICE',CType,NewNameList} -> 1915 normalize_choice(S,Value,CType,NewNameList); 1916 {'SEQUENCE',CType,NewNameList} -> 1917 normalize_sequence(S,Value,CType,NewNameList); 1918 {'SEQUENCE OF',CType,NewNameList} -> 1919 normalize_seqof(S,Value,CType,NewNameList); 1920 {'SET',CType,NewNameList} -> 1921 normalize_set(S,Value,CType,NewNameList); 1922 {'SET OF',CType,NewNameList} -> 1923 normalize_setof(S,Value,CType,NewNameList); 1924 {restrictedstring,CType,_} -> 1925 normalize_restrictedstring(S,Value,CType); 1926 _ -> 1927 io:format("WARNING: could not check default value ~p~n",[Value]), 1928 Value 1929 end; 1930normalize_value(S,Type,Val,NameList) -> 1931 normalize_value(S,Type,{'DEFAULT',Val},NameList). 1932 1933normalize_boolean(S,{Name,Bool},CType) when atom(Name) -> 1934 normalize_boolean(S,Bool,CType); 1935normalize_boolean(_,true,_) -> 1936 true; 1937normalize_boolean(_,false,_) -> 1938 false; 1939normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) -> 1940 get_normalized_value(S,Bool,CType,fun normalize_boolean/3,[]); 1941normalize_boolean(_,Other,_) -> 1942 throw({error,{asn1,{'invalid default value',Other}}}). 1943 1944normalize_integer(_S,Int,_) when integer(Int) -> 1945 Int; 1946normalize_integer(_S,{Name,Int},_) when atom(Name),integer(Int) -> 1947 Int; 1948normalize_integer(S,{Name,Int=#'Externalvaluereference'{}}, 1949 Type) when atom(Name) -> 1950 normalize_integer(S,Int,Type); 1951normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) -> 1952 case Type of 1953 NNL when list(NNL) -> 1954 case lists:keysearch(Name,1,NNL) of 1955 {value,{Name,Val}} -> 1956 Val; 1957 false -> 1958 get_normalized_value(S,Int,Type, 1959 fun normalize_integer/3,[]) 1960 end; 1961 _ -> 1962 get_normalized_value(S,Int,Type,fun normalize_integer/3,[]) 1963 end; 1964normalize_integer(_,Int,_) -> 1965 exit({'Unknown INTEGER value',Int}). 1966 1967normalize_bitstring(S,Value,Type)-> 1968 %% There are four different Erlang formats of BIT STRING: 1969 %% 1 - a list of ones and zeros. 1970 %% 2 - a list of atoms. 1971 %% 3 - as an integer, for instance in hexadecimal form. 1972 %% 4 - as a tuple {Unused, Binary} where Unused is an integer 1973 %% and tells how many bits of Binary are unused. 1974 %% 1975 %% normalize_bitstring/3 transforms Value according to: 1976 %% A to 3, 1977 %% B to 1, 1978 %% C to 1 or 3 1979 %% D to 2, 1980 %% Value can be on format: 1981 %% A - {hstring, String}, where String is a hexadecimal string. 1982 %% B - {bstring, String}, where String is a string on bit format 1983 %% C - #'Externalvaluereference'{value=V}, where V is a defined value 1984 %% D - list of #'Externalvaluereference', where each value component 1985 %% is an identifier corresponing to NamedBits in Type. 1986 case Value of 1987 {hstring,String} when list(String) -> 1988 hstring_to_int(String); 1989 {bstring,String} when list(String) -> 1990 bstring_to_bitlist(String); 1991 Rec when record(Rec,'Externalvaluereference') -> 1992 get_normalized_value(S,Value,Type, 1993 fun normalize_bitstring/3,[]); 1994 RecList when list(RecList) -> 1995 case Type of 1996 NBL when list(NBL) -> 1997 F = fun(#'Externalvaluereference'{value=Name}) -> 1998 case lists:keysearch(Name,1,NBL) of 1999 {value,{Name,_}} -> 2000 Name; 2001 Other -> 2002 throw({error,Other}) 2003 end; 2004 (Other) -> 2005 throw({error,Other}) 2006 end, 2007 case catch lists:map(F,RecList) of 2008 {error,Reason} -> 2009 io:format("WARNING: default value not " 2010 "compatible with type definition ~p~n", 2011 [Reason]), 2012 Value; 2013 NewList -> 2014 NewList 2015 end; 2016 _ -> 2017 io:format("WARNING: default value not " 2018 "compatible with type definition ~p~n", 2019 [RecList]), 2020 Value 2021 end; 2022 {Name,String} when atom(Name) -> 2023 normalize_bitstring(S,String,Type); 2024 Other -> 2025 io:format("WARNING: illegal default value ~p~n",[Other]), 2026 Value 2027 end. 2028 2029hstring_to_int(L) when list(L) -> 2030 hstring_to_int(L,0). 2031hstring_to_int([H|T],Acc) when H >= $A, H =< $F -> 2032 hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ; 2033hstring_to_int([H|T],Acc) when H >= $0, H =< $9 -> 2034 hstring_to_int(T,(Acc bsl 4) + (H - $0)); 2035hstring_to_int([],Acc) -> 2036 Acc. 2037 2038bstring_to_bitlist([H|T]) when H == $0; H == $1 -> 2039 [H - $0 | bstring_to_bitlist(T)]; 2040bstring_to_bitlist([]) -> 2041 []. 2042 2043%% normalize_octetstring/1 changes representation of input Value to a 2044%% list of octets. 2045%% Format of Value is one of: 2046%% {bstring,String} each element in String corresponds to one bit in an octet 2047%% {hstring,String} each element in String corresponds to one byte in an octet 2048%% #'Externalvaluereference' 2049normalize_octetstring(S,Value,CType) -> 2050 case Value of 2051 {bstring,String} -> 2052 bstring_to_octetlist(String); 2053 {hstring,String} -> 2054 hstring_to_octetlist(String); 2055 Rec when record(Rec,'Externalvaluereference') -> 2056 get_normalized_value(S,Value,CType, 2057 fun normalize_octetstring/3,[]); 2058 {Name,String} when atom(Name) -> 2059 normalize_octetstring(S,String,CType); 2060 List when list(List) -> 2061 %% check if list elements are valid octet values 2062 lists:map(fun([])-> ok; 2063 (H)when H > 255-> 2064 io:format("WARNING: not legal octet value ~p in OCTET STRING, ~p~n",[H,List]); 2065 (_)-> ok 2066 end, List), 2067 List; 2068 Other -> 2069 io:format("WARNING: unknown default value ~p~n",[Other]), 2070 Value 2071 end. 2072 2073 2074bstring_to_octetlist([]) -> 2075 []; 2076bstring_to_octetlist([H|T]) when H == $0 ; H == $1 -> 2077 bstring_to_octetlist(T,6,[(H - $0) bsl 7]). 2078bstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H == $0; H == $1 -> 2079 bstring_to_octetlist(T, 7, [0,Hacc + (H -$0)| Tacc]); 2080bstring_to_octetlist([H|T],BSL,[Hacc|Tacc]) when H == $0; H == $1 -> 2081 bstring_to_octetlist(T, BSL-1, [Hacc + ((H - $0) bsl BSL)| Tacc]); 2082bstring_to_octetlist([],7,[0|Acc]) -> 2083 lists:reverse(Acc); 2084bstring_to_octetlist([],_,Acc) -> 2085 lists:reverse(Acc). 2086 2087hstring_to_octetlist([]) -> 2088 []; 2089hstring_to_octetlist(L) -> 2090 hstring_to_octetlist(L,4,[]). 2091hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $A, H =< $F -> 2092 hstring_to_octetlist(T,4,[Hacc + (H - $A + 10)|Tacc]); 2093hstring_to_octetlist([H|T],BSL,Acc) when H >= $A, H =< $F -> 2094 hstring_to_octetlist(T,0,[(H - $A + 10) bsl BSL|Acc]); 2095hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $0; H =< $9 -> 2096 hstring_to_octetlist(T,4,[Hacc + (H - $0)|Tacc]); 2097hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 -> 2098 hstring_to_octetlist(T,0,[(H - $0) bsl BSL|Acc]); 2099hstring_to_octetlist([],_,Acc) -> 2100 lists:reverse(Acc). 2101 2102normalize_objectidentifier(S,Value) -> 2103 validate_objectidentifier(S,Value,[]). 2104 2105normalize_objectdescriptor(Value) -> 2106 Value. 2107 2108normalize_real(Value) -> 2109 Value. 2110 2111normalize_enumerated(#'Externalvaluereference'{value=V},CType) 2112 when list(CType) -> 2113 normalize_enumerated2(V,CType); 2114normalize_enumerated(Value,CType) when atom(Value),list(CType) -> 2115 normalize_enumerated2(Value,CType); 2116normalize_enumerated({Name,EnumV},CType) when atom(Name) -> 2117 normalize_enumerated(EnumV,CType); 2118normalize_enumerated(Value,{CType1,CType2}) when list(CType1), list(CType2)-> 2119 normalize_enumerated(Value,CType1++CType2); 2120normalize_enumerated(V,CType) -> 2121 io:format("WARNING: Enumerated unknown type ~p~n",[CType]), 2122 V. 2123normalize_enumerated2(V,Enum) -> 2124 case lists:keysearch(V,1,Enum) of 2125 {value,{Val,_}} -> Val; 2126 _ -> 2127 io:format("WARNING: Enumerated value is not correct ~p~n",[V]), 2128 V 2129 end. 2130 2131normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when atom(C) -> 2132 Value = 2133 case V of 2134 Rec when record(Rec,'Externalvaluereference') -> 2135 get_normalized_value(S,V,CType, 2136 fun normalize_choice/4, 2137 [NameList]); 2138 _ -> V 2139 end, 2140 case catch lists:keysearch(C,#'ComponentType'.name,CType) of 2141 {value,#'ComponentType'{typespec=CT,name=Name}} -> 2142 {C,normalize_value(S,CT,{'DEFAULT',Value}, 2143 [Name|NameList])}; 2144 Other -> 2145 io:format("WARNING: Wrong format of type/value ~p/~p~n", 2146 [Other,Value]), 2147 {C,Value} 2148 end; 2149normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) -> 2150 lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList); 2151normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) -> 2152 {_,#valuedef{value=V}}=get_referenced_type(S,Val), 2153 normalize_choice(S,{'CHOICE',V},CType,NameList); 2154% get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]); 2155normalize_choice(S,{Name,ChoiceVal},CType,NameList) 2156 when atom(Name) -> 2157 normalize_choice(S,ChoiceVal,CType,NameList). 2158 2159normalize_sequence(S,{Name,Value},Components,NameList) 2160 when atom(Name),list(Value) -> 2161 normalize_sequence(S,Value,Components,NameList); 2162normalize_sequence(S,Value,Components,NameList) -> 2163 normalized_record('SEQUENCE',S,Value,Components,NameList). 2164 2165normalize_set(S,{Name,Value},Components,NameList) 2166 when atom(Name),list(Value) -> 2167 normalized_record('SET',S,Value,Components,NameList); 2168normalize_set(S,Value,Components,NameList) -> 2169 normalized_record('SET',S,Value,Components,NameList). 2170 2171normalized_record(SorS,S,Value,Components,NameList) -> 2172 NewName = list_to_atom(asn1ct_gen:list2name(NameList)), 2173 NoComps = length(Components), 2174 case normalize_seq_or_set(SorS,S,Value,Components,NameList,[]) of 2175 ListOfVals when length(ListOfVals) == NoComps -> 2176 list_to_tuple([NewName|ListOfVals]); 2177 _ -> 2178 error({type,{illegal,default,value,Value},S}) 2179 end. 2180 2181normalize_seq_or_set(SorS,S,[{Cname,V}|Vs], 2182 [#'ComponentType'{name=Cname,typespec=TS}|Cs], 2183 NameList,Acc) -> 2184 NewNameList = 2185 case TS#type.def of 2186 #'Externaltypereference'{type=TName} -> 2187 [TName]; 2188 _ -> [Cname|NameList] 2189 end, 2190 NVal = normalize_value(S,TS,{'DEFAULT',V},NewNameList), 2191 normalize_seq_or_set(SorS,S,Vs,Cs,NameList,[NVal|Acc]); 2192normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs], 2193 [#'ComponentType'{prop='OPTIONAL'}|Cs], 2194 NameList,Acc) -> 2195 normalize_seq_or_set(SorS,S,Values,Cs,NameList,[asn1_NOVALUE|Acc]); 2196normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs], 2197 [#'ComponentType'{name=Cname2,typespec=TS, 2198 prop={'DEFAULT',Value}}|Cs], 2199 NameList,Acc) -> 2200 NewNameList = 2201 case TS#type.def of 2202 #'Externaltypereference'{type=TName} -> 2203 [TName]; 2204 _ -> [Cname2|NameList] 2205 end, 2206 NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), 2207 normalize_seq_or_set(SorS,S,Values,Cs,NameList,[NVal|Acc]); 2208normalize_seq_or_set(_SorS,_S,[],[],_,Acc) -> 2209 lists:reverse(Acc); 2210%% If default value is {} ComponentTypes in SEQUENCE are marked DEFAULT 2211%% or OPTIONAL (or the type is defined SEQUENCE{}, which is handled by 2212%% the previous case). 2213normalize_seq_or_set(SorS,S,[], 2214 [#'ComponentType'{name=Name,typespec=TS, 2215 prop={'DEFAULT',Value}}|Cs], 2216 NameList,Acc) -> 2217 NewNameList = 2218 case TS#type.def of 2219 #'Externaltypereference'{type=TName} -> 2220 [TName]; 2221 _ -> [Name|NameList] 2222 end, 2223 NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), 2224 normalize_seq_or_set(SorS,S,[],Cs,NameList,[NVal|Acc]); 2225normalize_seq_or_set(SorS,S,[],[#'ComponentType'{prop='OPTIONAL'}|Cs], 2226 NameList,Acc) -> 2227 normalize_seq_or_set(SorS,S,[],Cs,NameList,[asn1_NOVALUE|Acc]); 2228normalize_seq_or_set(SorS,S,Value=#'Externalvaluereference'{}, 2229 Cs,NameList,Acc) -> 2230 get_normalized_value(S,Value,Cs,fun normalize_seq_or_set/6, 2231 [SorS,NameList,Acc]); 2232normalize_seq_or_set(_SorS,S,V,_,_,_) -> 2233 error({type,{illegal,default,value,V},S}). 2234 2235normalize_seqof(S,Value,Type,NameList) -> 2236 normalize_s_of('SEQUENCE OF',S,Value,Type,NameList). 2237 2238normalize_setof(S,Value,Type,NameList) -> 2239 normalize_s_of('SET OF',S,Value,Type,NameList). 2240 2241normalize_s_of(SorS,S,Value,Type,NameList) when list(Value) -> 2242 DefValueList = lists:map(fun(X) -> {'DEFAULT',X} end,Value), 2243 Suffix = asn1ct_gen:constructed_suffix(SorS,Type), 2244 Def = Type#type.def, 2245 InnerType = asn1ct_gen:get_inner(Def), 2246 WhatKind = asn1ct_gen:type(InnerType), 2247 NewNameList = 2248 case WhatKind of 2249 {constructed,bif} -> 2250 [Suffix|NameList]; 2251 #'Externaltypereference'{type=Name} -> 2252 [Name]; 2253 _ -> [] 2254 end, 2255 NormFun = fun (X) -> normalize_value(S,Type,X, 2256 NewNameList) end, 2257 case catch lists:map(NormFun, DefValueList) of 2258 List when list(List) -> 2259 List; 2260 _ -> 2261 io:format("WARNING: ~p could not handle value ~p~n", 2262 [SorS,Value]), 2263 Value 2264 end; 2265normalize_s_of(SorS,S,Value,Type,NameList) 2266 when record(Value,'Externalvaluereference') -> 2267 get_normalized_value(S,Value,Type,fun normalize_s_of/5, 2268 [SorS,NameList]). 2269% case catch get_referenced_type(S,Value) of 2270% {_,#valuedef{value=V}} -> 2271% normalize_s_of(SorS,S,V,Type); 2272% {error,Reason} -> 2273% io:format("WARNING: ~p could not handle value ~p~n", 2274% [SorS,Value]), 2275% Value; 2276% {_,NewVal} -> 2277% normalize_s_of(SorS,S,NewVal,Type); 2278% _ -> 2279% io:format("WARNING: ~p could not handle value ~p~n", 2280% [SorS,Value]), 2281% Value 2282% end. 2283 2284 2285%% normalize_restrictedstring handles all format of restricted strings. 2286%% tuple case 2287normalize_restrictedstring(_S,[Int1,Int2],_) when integer(Int1),integer(Int2) -> 2288 {Int1,Int2}; 2289%% quadruple case 2290normalize_restrictedstring(_S,[Int1,Int2,Int3,Int4],_) when integer(Int1), 2291 integer(Int2), 2292 integer(Int3), 2293 integer(Int4) -> 2294 {Int1,Int2,Int3,Int4}; 2295%% character string list case 2296normalize_restrictedstring(S,[H|T],CType) when list(H);tuple(H) -> 2297 [normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)]; 2298%% character sting case 2299normalize_restrictedstring(_S,CString,_) when list(CString) -> 2300 Fun = 2301 fun(X) -> 2302 if 2303 $X =< 255, $X >= 0 -> 2304 ok; 2305 true -> 2306 io:format("WARNING: illegal character in string" 2307 " ~p~n",[X]) 2308 end 2309 end, 2310 lists:foreach(Fun,CString), 2311 CString; 2312%% definedvalue case or argument in a parameterized type 2313normalize_restrictedstring(S,ERef,CType) when record(ERef,'Externalvaluereference') -> 2314 get_normalized_value(S,ERef,CType, 2315 fun normalize_restrictedstring/3,[]); 2316%% 2317normalize_restrictedstring(S,{Name,Val},CType) when atom(Name) -> 2318 normalize_restrictedstring(S,Val,CType). 2319 2320 2321get_normalized_value(S,Val,Type,Func,AddArg) -> 2322 case catch get_referenced_type(S,Val) of 2323 {_,#valuedef{type=_T,value=V}} -> 2324 %% should check that Type and T equals 2325 call_Func(S,V,Type,Func,AddArg); 2326 {error,_} -> 2327 io:format("WARNING: default value not " 2328 "comparable ~p~n",[Val]), 2329 Val; 2330 {_,NewVal} -> 2331 call_Func(S,NewVal,Type,Func,AddArg); 2332 _ -> 2333 io:format("WARNING: default value not " 2334 "comparable ~p~n",[Val]), 2335 Val 2336 end. 2337 2338call_Func(S,Val,Type,Func,ArgList) -> 2339 case ArgList of 2340 [] -> 2341 Func(S,Val,Type); 2342 [LastArg] -> 2343 Func(S,Val,Type,LastArg); 2344 [Arg1,LastArg1] -> 2345 Func(Arg1,S,Val,Type,LastArg1); 2346 [Arg1,LastArg1,LastArg2] -> 2347 Func(Arg1,S,Val,Type,LastArg1,LastArg2) 2348 end. 2349 2350 2351get_canonic_type(S,Type,NameList) -> 2352 {InnerType,NewType,NewNameList} = 2353 case Type#type.def of 2354 Name when atom(Name) -> 2355 {Name,Type,NameList}; 2356 Ref when record(Ref,'Externaltypereference') -> 2357 {_,#typedef{name=Name,typespec=RefedType}} = 2358 get_referenced_type(S,Ref), 2359 get_canonic_type(S,RefedType,[Name]); 2360 {Name,T} when atom(Name) -> 2361 {Name,T,NameList}; 2362 Seq when record(Seq,'SEQUENCE') -> 2363 {'SEQUENCE',Seq#'SEQUENCE'.components,NameList}; 2364 Set when record(Set,'SET') -> 2365 {'SET',Set#'SET'.components,NameList} 2366 end, 2367 {asn1ct_gen:unify_if_string(InnerType),NewType,NewNameList}. 2368 2369 2370 2371check_ptype(_S,Type,Ts) when record(Ts,type) -> 2372 %Tag = Ts#type.tag, 2373 %Constr = Ts#type.constraint, 2374 Def = Ts#type.def, 2375 NewDef= 2376 case Def of 2377 Seq when record(Seq,'SEQUENCE') -> 2378 #newt{type=Seq#'SEQUENCE'{pname=Type#ptypedef.name}}; 2379 Set when record(Set,'SET') -> 2380 #newt{type=Set#'SET'{pname=Type#ptypedef.name}}; 2381 _Other -> 2382 #newt{} 2383 end, 2384 Ts2 = case NewDef of 2385 #newt{type=unchanged} -> 2386 Ts; 2387 #newt{type=TDef}-> 2388 Ts#type{def=TDef} 2389 end, 2390 Ts2. 2391 2392 2393% check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> 2394% check_class(S,ObjSpec); 2395check_type(_S,Type,Ts) when record(Type,typedef), 2396 (Type#typedef.checked==true) -> 2397 Ts; 2398check_type(_S,Type,Ts) when record(Type,typedef), 2399 (Type#typedef.checked==idle) -> % the check is going on 2400 Ts; 2401check_type(S=#state{recordtopname=TopName},Type,Ts) when record(Ts,type) -> 2402 {Def,Tag,Constr} = 2403 case match_parameters(Ts#type.def,S#state.parameters) of 2404 #type{constraint=_Ctmp,def=Dtmp} -> 2405 {Dtmp,Ts#type.tag,Ts#type.constraint}; 2406 Dtmp -> 2407 {Dtmp,Ts#type.tag,Ts#type.constraint} 2408 end, 2409 TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr}, 2410 TestFun = 2411 fun(Tref) -> 2412 {_,MaybeChoice} = get_referenced_type(S,Tref), 2413 case catch((MaybeChoice#typedef.typespec)#type.def) of 2414 {'CHOICE',_} -> 2415 maybe_illicit_implicit_tag(choice,Tag); 2416 'ANY' -> 2417 maybe_illicit_implicit_tag(open_type,Tag); 2418 'ANY DEFINED BY' -> 2419 maybe_illicit_implicit_tag(open_type,Tag); 2420 'ASN1_OPEN_TYPE' -> 2421 maybe_illicit_implicit_tag(open_type,Tag); 2422 _ -> 2423 Tag 2424 end 2425 end, 2426 NewDef= 2427 case Def of 2428 Ext when record(Ext,'Externaltypereference') -> 2429 {_,RefTypeDef} = get_referenced_type(S,Ext), 2430% case RefTypeDef of 2431% Class when record(Class,classdef) -> 2432% throw({asn1_class,Class}); 2433% _ -> ok 2434% end, 2435 case is_class(S,RefTypeDef) of 2436 true -> throw({asn1_class,RefTypeDef}); 2437 _ -> ok 2438 end, 2439 Ct = TestFun(Ext), 2440 RefType = 2441%case S#state.erule of 2442% ber_bin_v2 -> 2443 case RefTypeDef#typedef.checked of 2444 true -> 2445 RefTypeDef#typedef.typespec; 2446 _ -> 2447 NewRefTypeDef1 = RefTypeDef#typedef{checked=idle}, 2448 asn1_db:dbput(S#state.mname, 2449 NewRefTypeDef1#typedef.name,NewRefTypeDef1), 2450 RefType1 = 2451 check_type(S,RefTypeDef,RefTypeDef#typedef.typespec), 2452 NewRefTypeDef2 = 2453 RefTypeDef#typedef{checked=true,typespec = RefType1}, 2454 asn1_db:dbput(S#state.mname, 2455 NewRefTypeDef2#typedef.name,NewRefTypeDef2), 2456 %% update the type and mark as checked 2457 RefType1 2458 end, 2459% _ -> RefTypeDef#typedef.typespec 2460% end, 2461 2462 case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of 2463 true -> 2464 %% Here we expand to a built in type and inline it 2465 TempNewDef#newt{ 2466 type= 2467 RefType#type.def, 2468 tag= 2469 merge_tags(Ct,RefType#type.tag), 2470 constraint= 2471 merge_constraints(check_constraints(S,Constr), 2472 RefType#type.constraint)}; 2473 _ -> 2474 %% Here we only expand the tags and keep the ext ref 2475 2476 TempNewDef#newt{ 2477 type= 2478 check_externaltypereference(S,Ext), 2479 tag = 2480 case S#state.erule of 2481 ber_bin_v2 -> 2482 merge_tags(Ct,RefType#type.tag); 2483 _ -> 2484 Ct 2485 end 2486 } 2487 end; 2488 'ANY' -> 2489 Ct=maybe_illicit_implicit_tag(open_type,Tag), 2490 TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 2491 {'ANY_DEFINED_BY',_} -> 2492 Ct=maybe_illicit_implicit_tag(open_type,Tag), 2493 TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 2494 'INTEGER' -> 2495 check_integer(S,[],Constr), 2496 TempNewDef#newt{tag= 2497 merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; 2498 2499 {'INTEGER',NamedNumberList} -> 2500 TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList,Constr)}, 2501 tag= 2502 merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; 2503 {'BIT STRING',NamedNumberList} -> 2504 NewL = check_bitstring(S,NamedNumberList,Constr), 2505%% erlang:display({asn1ct_check,NamedNumberList,NewL}), 2506 TempNewDef#newt{type={'BIT STRING',NewL}, 2507 tag= 2508 merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))}; 2509 'NULL' -> 2510 TempNewDef#newt{tag= 2511 merge_tags(Tag,?TAG_PRIMITIVE(?N_NULL))}; 2512 'OBJECT IDENTIFIER' -> 2513 check_objectidentifier(S,Constr), 2514 TempNewDef#newt{tag= 2515 merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER))}; 2516 'ObjectDescriptor' -> 2517 TempNewDef#newt{tag= 2518 merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_DESCRIPTOR))}; 2519 'EXTERNAL' -> 2520%% AssociatedType = asn1_db:dbget(S#state.mname,'EXTERNAL'), 2521%% #newt{type=check_type(S,Type,AssociatedType)}; 2522 put(external,unchecked), 2523 TempNewDef#newt{type= 2524 #'Externaltypereference'{module=S#state.mname, 2525 type='EXTERNAL'}, 2526 tag= 2527 merge_tags(Tag,?TAG_CONSTRUCTED(?N_EXTERNAL))}; 2528 {'INSTANCE OF',DefinedObjectClass,Constraint} -> 2529 %% check that DefinedObjectClass is of TYPE-IDENTIFIER class 2530 %% If Constraint is empty make it the general INSTANCE OF type 2531 %% If Constraint is not empty make an inlined type 2532 %% convert INSTANCE OF to the associated type 2533 IOFDef=check_instance_of(S,DefinedObjectClass,Constraint), 2534 TempNewDef#newt{type=IOFDef, 2535 tag=merge_tags(Tag,?TAG_CONSTRUCTED(?N_INSTANCE_OF))}; 2536 {'ENUMERATED',NamedNumberList} -> 2537 TempNewDef#newt{type= 2538 {'ENUMERATED', 2539 check_enumerated(S,NamedNumberList,Constr)}, 2540 tag= 2541 merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED))}; 2542 'EMBEDDED PDV' -> 2543% AssociatedType = asn1_db:dbget(S#state.mname,'EMBEDDED PDV'), 2544% CheckedType = check_type(S,Type, 2545% AssociatedType#typedef.typespec), 2546 put(embedded_pdv,unchecked), 2547 TempNewDef#newt{type= 2548 #'Externaltypereference'{module=S#state.mname, 2549 type='EMBEDDED PDV'}, 2550 tag= 2551 merge_tags(Tag,?TAG_CONSTRUCTED(?N_EMBEDDED_PDV))}; 2552 'BOOLEAN'-> 2553 check_boolean(S,Constr), 2554 TempNewDef#newt{tag= 2555 merge_tags(Tag,?TAG_PRIMITIVE(?N_BOOLEAN))}; 2556 'OCTET STRING' -> 2557 check_octetstring(S,Constr), 2558 TempNewDef#newt{tag= 2559 merge_tags(Tag,?TAG_PRIMITIVE(?N_OCTET_STRING))}; 2560 'NumericString' -> 2561 check_restrictedstring(S,Def,Constr), 2562 TempNewDef#newt{tag= 2563 merge_tags(Tag,?TAG_PRIMITIVE(?N_NumericString))}; 2564 'TeletexString' -> 2565 check_restrictedstring(S,Def,Constr), 2566 TempNewDef#newt{tag= 2567 merge_tags(Tag,?TAG_PRIMITIVE(?N_TeletexString))}; 2568 'VideotexString' -> 2569 check_restrictedstring(S,Def,Constr), 2570 TempNewDef#newt{tag= 2571 merge_tags(Tag,?TAG_PRIMITIVE(?N_VideotexString))}; 2572 'UTCTime' -> 2573 TempNewDef#newt{tag= 2574 merge_tags(Tag,?TAG_PRIMITIVE(?N_UTCTime))}; 2575 'GeneralizedTime' -> 2576 TempNewDef#newt{tag= 2577 merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralizedTime))}; 2578 'GraphicString' -> 2579 check_restrictedstring(S,Def,Constr), 2580 TempNewDef#newt{tag= 2581 merge_tags(Tag,?TAG_PRIMITIVE(?N_GraphicString))}; 2582 'VisibleString' -> 2583 check_restrictedstring(S,Def,Constr), 2584 TempNewDef#newt{tag= 2585 merge_tags(Tag,?TAG_PRIMITIVE(?N_VisibleString))}; 2586 'GeneralString' -> 2587 check_restrictedstring(S,Def,Constr), 2588 TempNewDef#newt{tag= 2589 merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralString))}; 2590 'PrintableString' -> 2591 check_restrictedstring(S,Def,Constr), 2592 TempNewDef#newt{tag= 2593 merge_tags(Tag,?TAG_PRIMITIVE(?N_PrintableString))}; 2594 'IA5String' -> 2595 check_restrictedstring(S,Def,Constr), 2596 TempNewDef#newt{tag= 2597 merge_tags(Tag,?TAG_PRIMITIVE(?N_IA5String))}; 2598 'BMPString' -> 2599 check_restrictedstring(S,Def,Constr), 2600 TempNewDef#newt{tag= 2601 merge_tags(Tag,?TAG_PRIMITIVE(?N_BMPString))}; 2602 'UniversalString' -> 2603 check_restrictedstring(S,Def,Constr), 2604 TempNewDef#newt{tag= 2605 merge_tags(Tag,?TAG_PRIMITIVE(?N_UniversalString))}; 2606 'CHARACTER STRING' -> 2607% AssociatedType = asn1_db:dbget(S#state.mname, 2608% 'CHARACTER STRING'), 2609% CheckedType = check_type(S,Type, 2610% AssociatedType#typedef.typespec), 2611 put(character_string,unchecked), 2612 TempNewDef#newt{type= 2613 #'Externaltypereference'{module=S#state.mname, 2614 type='CHARACTER STRING'}, 2615 tag= 2616 merge_tags(Tag,?TAG_CONSTRUCTED(?N_CHARACTER_STRING))}; 2617 Seq when record(Seq,'SEQUENCE') -> 2618 RecordName = 2619 case TopName of 2620 [] -> 2621 [Type#typedef.name]; 2622 _ -> 2623 TopName 2624 end, 2625 {TableCInf,Components} = 2626 check_sequence(S#state{recordtopname= 2627 RecordName}, 2628 Type,Seq#'SEQUENCE'.components), 2629 TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=TableCInf, 2630 components=Components}, 2631 tag= 2632 merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; 2633 {'SEQUENCE OF',Components} -> 2634 TempNewDef#newt{type={'SEQUENCE OF',check_sequenceof(S,Type,Components)}, 2635 tag= 2636 merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; 2637 {'CHOICE',Components} -> 2638 Ct = maybe_illicit_implicit_tag(choice,Tag), 2639 TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct}; 2640 Set when record(Set,'SET') -> 2641 RecordName= 2642 case TopName of 2643 [] -> 2644 [Type#typedef.name]; 2645 _ -> 2646 TopName 2647 end, 2648 {Sorted,TableCInf,Components} = 2649 check_set(S#state{recordtopname=RecordName}, 2650 Type,Set#'SET'.components), 2651 TempNewDef#newt{type=Set#'SET'{sorted=Sorted, 2652 tablecinf=TableCInf, 2653 components=Components}, 2654 tag= 2655 merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; 2656 {'SET OF',Components} -> 2657 TempNewDef#newt{type={'SET OF',check_setof(S,Type,Components)}, 2658 tag= 2659 merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; 2660 %% This is a temporary hack until the full Information Obj Spec 2661 %% in X.681 is supported 2662 {{typereference,_,'TYPE-IDENTIFIER'},[{typefieldreference,_,'Type'}]} -> 2663 Ct=maybe_illicit_implicit_tag(open_type,Tag), 2664 TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 2665 2666 {#'Externaltypereference'{type='TYPE-IDENTIFIER'}, 2667 [{typefieldreference,_,'Type'}]} -> 2668 Ct=maybe_illicit_implicit_tag(open_type,Tag), 2669 TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 2670 2671 {pt,Ptype,ParaList} -> 2672 %% Ptype might be a parameterized - type, object set or 2673 %% value set. If it isn't a parameterized type notify the 2674 %% calling function. 2675 {_,Ptypedef} = get_referenced_type(S,Ptype), 2676 notify_if_not_ptype(S,Ptypedef), 2677 NewParaList = [match_parameters(TmpParam,S#state.parameters)|| 2678 TmpParam <- ParaList], 2679 Instance = instantiate_ptype(S,Ptypedef,NewParaList), 2680 TempNewDef#newt{type=Instance#type.def, 2681 tag=merge_tags(Tag,Instance#type.tag), 2682 constraint=Instance#type.constraint, 2683 inlined=yes}; 2684 2685% {ClRef,FieldRefList} when record(ClRef,'Externaltypereference') -> 2686 OCFT=#'ObjectClassFieldType'{class=ClRef} -> 2687 %% this case occures in a SEQUENCE when 2688 %% the type of the component is a ObjectClassFieldType 2689 ClassSpec = check_class(S,ClRef), 2690 NewTypeDef = maybe_open_type(S,ClassSpec,OCFT,Constr), 2691 InnerTag = get_innertag(S,NewTypeDef), 2692 MergedTag = merge_tags(Tag,InnerTag), 2693 Ct = 2694 case is_open_type(NewTypeDef) of 2695 true -> 2696 maybe_illicit_implicit_tag(open_type,MergedTag); 2697 _ -> 2698 MergedTag 2699 end, 2700 TempNewDef#newt{type=NewTypeDef,tag=Ct}; 2701 {valueset,Vtype} -> 2702 TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}}; 2703 Other -> 2704 exit({'cant check' ,Other}) 2705 end, 2706 Ts2 = case NewDef of 2707 #newt{type=unchanged} -> 2708 Ts#type{def=Def}; 2709 #newt{type=TDef}-> 2710 Ts#type{def=TDef} 2711 end, 2712 NewTag = case NewDef of 2713 #newt{tag=unchanged} -> 2714 Tag; 2715 #newt{tag=TT} -> 2716 TT 2717 end, 2718 T3 = Ts2#type{tag = lists:map(fun(TempTag = #tag{type={default,TTx}}) -> 2719 TempTag#tag{type=TTx}; 2720 (Else) -> Else end, NewTag)}, 2721 T4 = case NewDef of 2722 #newt{constraint=unchanged} -> 2723 T3#type{constraint=Constr}; 2724 #newt{constraint=NewConstr} -> 2725 T3#type{constraint=NewConstr} 2726 end, 2727 T5 = T4#type{inlined=NewDef#newt.inlined}, 2728 T5#type{constraint=check_constraints(S,T5#type.constraint)}. 2729 2730 2731get_innertag(_S,#'ObjectClassFieldType'{type=Type}) -> 2732 case Type of 2733 #type{tag=Tag} -> Tag; 2734 {fixedtypevaluefield,_,#type{tag=Tag}} -> Tag; 2735 {TypeFieldName,_} when atom(TypeFieldName) -> []; 2736 _ -> [] 2737 end; 2738get_innertag(_S,_) -> 2739 []. 2740 2741is_class(_S,#classdef{}) -> 2742 true; 2743is_class(S,#typedef{typespec=#type{def=Eref}}) 2744 when record(Eref,'Externaltypereference')-> 2745 {_,NextDef} = get_referenced_type(S,Eref), 2746 is_class(S,NextDef); 2747is_class(_,_) -> 2748 false. 2749 2750get_class_def(_S,CD=#classdef{}) -> 2751 CD; 2752get_class_def(S,#typedef{typespec=#type{def=Eref}}) 2753 when record(Eref,'Externaltypereference') -> 2754 {_,NextDef} = get_referenced_type(S,Eref), 2755 get_class_def(S,NextDef). 2756 2757maybe_illicit_implicit_tag(Kind,Tag) -> 2758 case Tag of 2759 [#tag{type='IMPLICIT'}|_T] -> 2760 throw({error,{asn1,{implicit_tag_before,Kind}}}); 2761 [ChTag = #tag{type={default,_}}|T] -> 2762 case Kind of 2763 open_type -> 2764 [ChTag#tag{type='EXPLICIT',form=32}|T]; %X.680 30.6c, X.690 8.14.2 2765 choice -> 2766 [ChTag#tag{type='EXPLICIT',form=32}|T] % X.680 28.6 c, 30.6c 2767 end; 2768 _ -> 2769 Tag % unchanged 2770 end. 2771 2772%% maybe_open_type/2 -> {ClassSpec,FieldRefList} | 'ASN1_OPEN_TYPE' 2773%% if the FieldRefList points out a typefield and the class don't have 2774%% any UNIQUE field, so that a component relation constraint cannot specify 2775%% the type of a typefield, return 'ASN1_OPEN_TYPE', otherwise return 2776%% {ClassSpec,FieldRefList}. 2777maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, 2778 OCFT=#'ObjectClassFieldType'{fieldname=FieldRefList}, 2779 Constr) -> 2780 Type = get_ObjectClassFieldType(S,Fs,FieldRefList), 2781 FieldNames=get_referenced_fieldname(FieldRefList), 2782 case lists:last(FieldRefList) of 2783 {valuefieldreference,_} -> 2784 OCFT#'ObjectClassFieldType'{class=ClassSpec, 2785 fieldname=FieldNames, 2786 type=Type}; 2787 {typefieldreference,_} -> 2788 case {catch get_unique_fieldname(#classdef{typespec=ClassSpec}), 2789 asn1ct_gen:get_constraint(Constr,componentrelation)}of 2790 {Tuple,_} when tuple(Tuple) -> 2791 OCFT#'ObjectClassFieldType'{class=ClassSpec, 2792 fieldname=FieldNames, 2793 type='ASN1_OPEN_TYPE'}; 2794 {_,no} -> 2795 OCFT#'ObjectClassFieldType'{class=ClassSpec, 2796 fieldname=FieldNames, 2797 type='ASN1_OPEN_TYPE'}; 2798 _ -> 2799 OCFT#'ObjectClassFieldType'{class=ClassSpec, 2800 fieldname=FieldNames, 2801 type=Type} 2802 end 2803 end. 2804 2805is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) -> 2806 true; 2807is_open_type(#'ObjectClassFieldType'{}) -> 2808 false. 2809 2810 2811notify_if_not_ptype(S,#pvaluesetdef{type=Type}) -> 2812 case Type#type.def of 2813 Ref when record(Ref,'Externaltypereference') -> 2814 case get_referenced_type(S,Ref) of 2815 {_,#classdef{}} -> 2816 throw(pobjectsetdef); 2817 {_,#typedef{}} -> 2818 throw(pvalueset) 2819 end; 2820 T when record(T,type) -> % this must be a value set 2821 throw(pvalueset) 2822 end; 2823notify_if_not_ptype(_S,#ptypedef{}) -> 2824 ok. 2825 2826% fix me 2827instantiate_ptype(S,Ptypedef,ParaList) -> 2828 #ptypedef{args=Args,typespec=Type} = Ptypedef, 2829% Args = get_pt_args(Ptypedef), 2830% Type = get_pt_spec(Ptypedef), 2831 MatchedArgs = match_args(Args, ParaList, []), 2832 NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]}, 2833 %The abscomppath must be empty since a table constraint in a 2834 %parameterized type only can refer to components within the type 2835 check_type(NewS, Ptypedef, Type). 2836 2837get_pt_args(#ptypedef{args=Args}) -> 2838 Args; 2839get_pt_args(#pvaluesetdef{args=Args}) -> 2840 Args; 2841get_pt_args(#pvaluedef{args=Args}) -> 2842 Args; 2843get_pt_args(#pobjectdef{args=Args}) -> 2844 Args; 2845get_pt_args(#pobjectsetdef{args=Args}) -> 2846 Args. 2847 2848get_pt_spec(#ptypedef{typespec=Type}) -> 2849 Type; 2850get_pt_spec(#pvaluedef{value=Value}) -> 2851 Value; 2852get_pt_spec(#pvaluesetdef{valueset=VS}) -> 2853 VS; 2854get_pt_spec(#pobjectdef{def=Def}) -> 2855 Def; 2856get_pt_spec(#pobjectsetdef{def=Def}) -> 2857 Def. 2858 2859 2860 2861match_args([FormArg|Ft], [ActArg|At], Acc) -> 2862 match_args(Ft, At, [{FormArg,ActArg}|Acc]); 2863match_args([], [], Acc) -> 2864 lists:reverse(Acc); 2865match_args(_, _, _) -> 2866 throw({error,{asn1,{wrong_number_of_arguments}}}). 2867 2868check_constraints(S,C) when list(C) -> 2869 check_constraints(S, C, []); 2870check_constraints(S,C) when record(C,constraint) -> 2871 check_constraints(S, C#constraint.c, []). 2872 2873 2874resolv_tuple_or_list(S,List) when list(List) -> 2875 lists:map(fun(X)->resolv_value(S,X) end, List); 2876resolv_tuple_or_list(S,{Lb,Ub}) -> 2877 {resolv_value(S,Lb),resolv_value(S,Ub)}. 2878 2879%%%----------------------------------------- 2880%% If the constraint value is a defined value the valuename 2881%% is replaced by the actual value 2882%% 2883resolv_value(S,Val) -> 2884 case match_parameters(Val, S#state.parameters) of 2885 Id -> % unchanged 2886 resolv_value1(S,Id); 2887 Other -> 2888 resolv_value(S,Other) 2889 end. 2890 2891resolv_value1(S = #state{mname=M,inputmodules=InpMods}, 2892 V=#'Externalvaluereference'{pos=Pos,module=ExtM,value=Name}) -> 2893 case ExtM of 2894 M -> resolv_value2(S,M,Name,Pos); 2895 _ -> 2896 case lists:member(ExtM,InpMods) of 2897 true -> 2898 resolv_value2(S,M,Name,Pos); 2899 false -> 2900 V 2901 end 2902 end; 2903resolv_value1(S,{gt,V}) -> 2904 case V of 2905 Int when integer(Int) -> 2906 V + 1; 2907 #valuedef{value=Int} -> 2908 1 + resolv_value(S,Int); 2909 Other -> 2910 throw({error,{asn1,{undefined_type_or_value,Other}}}) 2911 end; 2912resolv_value1(S,{lt,V}) -> 2913 case V of 2914 Int when integer(Int) -> 2915 V - 1; 2916 #valuedef{value=Int} -> 2917 resolv_value(S,Int) - 1; 2918 Other -> 2919 throw({error,{asn1,{undefined_type_or_value,Other}}}) 2920 end; 2921resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference, 2922 FieldName}]}) -> 2923 %% FieldName can hold either a fixed-type value or a variable-type value 2924 %% Object is a DefinedObject, i.e. a #'Externaltypereference' 2925 {_,ObjTDef} = get_referenced_type(S,Object), 2926 TS = check_object(S,ObjTDef,ObjTDef#typedef.typespec), 2927 {_,_,Components} = TS#'Object'.def, 2928 case lists:keysearch(FieldName,1,Components) of 2929 {value,{_,#valuedef{value=Val}}} -> 2930 Val; 2931 _ -> 2932 error({value,"illegal value in constraint",S}) 2933 end; 2934% resolv_value1(S,{'ValueFromObject',{po,Object,Params},FieldName}) -> 2935% %% FieldName can hold either a fixed-type value or a variable-type value 2936% %% Object is a ParameterizedObject 2937resolv_value1(_,V) -> 2938 V. 2939 2940resolv_value2(S,ModuleName,Name,Pos) -> 2941 case asn1_db:dbget(ModuleName,Name) of 2942 undefined -> 2943 case imported(S,Name) of 2944 {ok,Imodule} -> 2945 {_,V2} = get_referenced(S,Imodule,Name,Pos), 2946 V2#valuedef.value; 2947 _ -> 2948 throw({error,{asn1,{undefined_type_or_value,Name}}}) 2949 end; 2950 Val -> 2951 Val#valuedef.value 2952 end. 2953 2954check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) -> 2955 {_,CTDef} = get_referenced_type(S,Type#type.def), 2956 CType = check_type(S,S#state.tname,CTDef#typedef.typespec), 2957 check_constraints(S,Rest,CType#type.constraint ++ Acc); 2958check_constraints(S,[C | Rest], Acc) -> 2959 check_constraints(S,Rest,[check_constraint(S,C) | Acc]); 2960check_constraints(S,[],Acc) -> 2961% io:format("Acc: ~p~n",[Acc]), 2962 C = constraint_merge(S,lists:reverse(Acc)), 2963% io:format("C: ~p~n",[C]), 2964 lists:flatten(C). 2965 2966 2967range_check(F={FixV,FixV}) -> 2968% FixV; 2969 F; 2970range_check(VR={Lb,Ub}) when Lb < Ub -> 2971 VR; 2972range_check(Err={_,_}) -> 2973 throw({error,{asn1,{illegal_size_constraint,Err}}}); 2974range_check(Value) -> 2975 Value. 2976 2977check_constraint(S,Ext) when record(Ext,'Externaltypereference') -> 2978 check_externaltypereference(S,Ext); 2979 2980 2981check_constraint(S,{'SizeConstraint',{Lb,Ub}}) 2982 when list(Lb);tuple(Lb),size(Lb)==2 -> 2983 case Lb of 2984 #'Externalvaluereference'{} -> 2985 check_constraint(S,{'SizeConstraint',{resolv_value(S,Lb),Ub}}); 2986 _ -> 2987 NewLb = range_check(resolv_tuple_or_list(S,Lb)), 2988 NewUb = range_check(resolv_tuple_or_list(S,Ub)), 2989 {'SizeConstraint',{NewLb,NewUb}} 2990 end; 2991check_constraint(S,{'SizeConstraint',{Lb,Ub}}) -> 2992 case {resolv_value(S,Lb),resolv_value(S,Ub)} of 2993 {FixV,FixV} -> 2994 {'SizeConstraint',FixV}; 2995 {Low,High} when Low < High -> 2996 {'SizeConstraint',{Low,High}}; 2997 Err -> 2998 throw({error,{asn1,{illegal_size_constraint,Err}}}) 2999 end; 3000check_constraint(S,{'SizeConstraint',Lb}) -> 3001 {'SizeConstraint',resolv_value(S,Lb)}; 3002 3003check_constraint(S,{'SingleValue', L}) when list(L) -> 3004 F = fun(A) -> resolv_value(S,A) end, 3005 {'SingleValue',lists:map(F,L)}; 3006 3007check_constraint(S,{'SingleValue', V}) when integer(V) -> 3008 Val = resolv_value(S,V), 3009%% [{'SingleValue',Val},{'ValueRange',{Val,Val}}]; % Why adding value range? 3010 {'SingleValue',Val}; 3011check_constraint(S,{'SingleValue', V}) -> 3012 {'SingleValue',resolv_value(S,V)}; 3013 3014check_constraint(S,{'ValueRange', {Lb, Ub}}) -> 3015 {'ValueRange',{resolv_value(S,Lb),resolv_value(S,Ub)}}; 3016 3017%%check_constraint(S,{'ContainedSubtype',Type}) -> 3018%% #typedef{typespec=TSpec} = 3019%% check_type(S,S#state.tname,get_referenced_type(S,Type#type.def)), 3020%% [C] = TSpec#type.constraint, 3021%% C; 3022 3023check_constraint(S,{valueset,Type}) -> 3024 {valueset,check_type(S,S#state.tname,Type)}; 3025 3026check_constraint(S,{simpletable,Type}) -> 3027 OSName = (Type#type.def)#'Externaltypereference'.type, 3028 C = match_parameters(Type#type.def,S#state.parameters), 3029 case C of 3030 #'Externaltypereference'{} -> 3031 Type#type{def=check_externaltypereference(S,C)}, 3032 {simpletable,OSName}; 3033 _ -> 3034 check_type(S,S#state.tname,Type), 3035 {simpletable,OSName} 3036 end; 3037 3038check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) -> 3039 %% Objset is an 'Externaltypereference' record, since Objset is 3040 %% a DefinedObjectSet. 3041 RealObjset = match_parameters(Objset,S#state.parameters), 3042 Ext = check_externaltypereference(S,RealObjset), 3043 {componentrelation,{objectset,Opos,Ext},Id}; 3044 3045check_constraint(S,Type) when record(Type,type) -> 3046 #type{def=Def} = check_type(S,S#state.tname,Type), 3047 Def; 3048 3049check_constraint(S,C) when list(C) -> 3050 lists:map(fun(X)->check_constraint(S,X) end,C); 3051% else keep the constraint unchanged 3052check_constraint(_S,Any) -> 3053% io:format("Constraint = ~p~n",[Any]), 3054 Any. 3055 3056%% constraint_merge/2 3057%% Compute the intersection of the outermost level of the constraint list. 3058%% See Dubuisson second paragraph and fotnote on page 285. 3059%% If constraints with extension are included in combined constraints. The 3060%% resulting combination will have the extension of the last constraint. Thus, 3061%% there will be no extension if the last constraint is without extension. 3062%% The rootset of all constraints are considered in the "outermoust 3063%% intersection". See section 13.1.2 in Dubuisson. 3064constraint_merge(_S,C=[H])when tuple(H) -> 3065 C; 3066constraint_merge(_S,[]) -> 3067 []; 3068constraint_merge(S,C) -> 3069 %% skip all extension but the last 3070 C1 = filter_extensions(C), 3071 %% perform all internal level intersections, intersections first 3072 %% since they have precedence over unions 3073 C2 = lists:map(fun(X)when list(X)->constraint_intersection(S,X); 3074 (X) -> X end, 3075 C1), 3076 %% perform all internal level unions 3077 C3 = lists:map(fun(X)when list(X)->constraint_union(S,X); 3078 (X) -> X end, 3079 C2), 3080 3081 %% now get intersection of the outermost level 3082 %% get the least common single value constraint 3083 SVs = get_constraints(C3,'SingleValue'), 3084 CombSV = intersection_of_sv(S,SVs), 3085 %% get the least common value range constraint 3086 VRs = get_constraints(C3,'ValueRange'), 3087 CombVR = intersection_of_vr(S,VRs), 3088 %% get the least common size constraint 3089 SZs = get_constraints(C3,'SizeConstraint'), 3090 CombSZ = intersection_of_size(S,SZs), 3091 CminusSVs=ordsets:subtract(ordsets:from_list(C3),ordsets:from_list(SVs)), 3092 % CminusSVsVRs = ordsets:subtract(ordsets:from_list(CminusSVs), 3093% ordsets:from_list(VRs)), 3094 RestC = ordsets:subtract(ordsets:from_list(CminusSVs), 3095 ordsets:from_list(SZs)), 3096 %% get the least common combined constraint. That is the union of each 3097 %% deep costraint and merge of single value and value range constraints 3098 combine_constraints(S,CombSV,CombVR,CombSZ++RestC). 3099 3100%% constraint_union(S,C) takes a list of constraints as input and 3101%% merge them to a union. Unions are performed when two 3102%% constraints is found with an atom union between. 3103%% The list may be nested. Fix that later !!! 3104constraint_union(_S,[]) -> 3105 []; 3106constraint_union(_S,C=[_E]) -> 3107 C; 3108constraint_union(S,C) when list(C) -> 3109 case lists:member(union,C) of 3110 true -> 3111 constraint_union1(S,C,[]); 3112 _ -> 3113 C 3114 end; 3115% SV = get_constraints(C,'SingleValue'), 3116% SV1 = constraint_union_sv(S,SV), 3117% VR = get_constraints(C,'ValueRange'), 3118% VR1 = constraint_union_vr(VR), 3119% RestC = ordsets:filter(fun({'SingleValue',_})->false; 3120% ({'ValueRange',_})->false; 3121% (_) -> true end,ordsets:from_list(C)), 3122% SV1++VR1++RestC; 3123constraint_union(_S,C) -> 3124 [C]. 3125 3126constraint_union1(S,[A={'ValueRange',_},union,B={'ValueRange',_}|Rest],Acc) -> 3127 AunionB = constraint_union_vr([A,B]), 3128 constraint_union1(S,Rest,AunionB++Acc); 3129constraint_union1(S,[A={'SingleValue',_},union,B={'SingleValue',_}|Rest],Acc) -> 3130 AunionB = constraint_union_sv(S,[A,B]), 3131 constraint_union1(S,Rest,AunionB++Acc); 3132constraint_union1(S,[A={'SingleValue',_},union,B={'ValueRange',_}|Rest],Acc) -> 3133 AunionB = union_sv_vr(S,A,B), 3134 constraint_union1(S,Rest,AunionB++Acc); 3135constraint_union1(S,[A={'ValueRange',_},union,B={'SingleValue',_}|Rest],Acc) -> 3136 AunionB = union_sv_vr(S,B,A), 3137 constraint_union1(S,Rest,AunionB++Acc); 3138constraint_union1(S,[union|Rest],Acc) -> %skip when unsupported constraints 3139 constraint_union1(S,Rest,Acc); 3140constraint_union1(S,[A|Rest],Acc) -> 3141 constraint_union1(S,Rest,[A|Acc]); 3142constraint_union1(_S,[],Acc) -> 3143 lists:reverse(Acc). 3144 3145constraint_union_sv(_S,SV) -> 3146 Values=lists:map(fun({_,V})->V end,SV), 3147 case ordsets:from_list(Values) of 3148 [] -> []; 3149 [N] -> [{'SingleValue',N}]; 3150 L -> [{'SingleValue',L}] 3151 end. 3152 3153%% REMOVE???? 3154%%constraint_union(S,VR,'ValueRange') -> 3155%% constraint_union_vr(VR). 3156 3157%% constraint_union_vr(VR) 3158%% VR = [{'ValueRange',{Lb,Ub}},...] 3159%% Lb = 'MIN' | integer() 3160%% Ub = 'MAX' | integer() 3161%% Returns if possible only one ValueRange tuple with a range that 3162%% is a union of all ranges in VR. 3163constraint_union_vr(VR) -> 3164 %% Sort VR by Lb in first hand and by Ub in second hand 3165 Fun=fun({_,{'MIN',_B1}},{_,{A2,_B2}}) when integer(A2)->true; 3166 ({_,{A1,_B1}},{_,{'MAX',_B2}}) when integer(A1) -> true; 3167 ({_,{A1,_B1}},{_,{A2,_B2}}) when integer(A1),integer(A2),A1<A2 -> true; 3168 ({_,{A,B1}},{_,{A,B2}}) when B1=<B2->true; 3169 (_,_)->false end, 3170 constraint_union_vr(lists:usort(Fun,VR),[]). 3171 3172constraint_union_vr([],Acc) -> 3173 lists:reverse(Acc); 3174constraint_union_vr([C|Rest],[]) -> 3175 constraint_union_vr(Rest,[C]); 3176constraint_union_vr([{_,{Lb,Ub2}}|Rest],[{_,{Lb,_Ub1}}|Acc]) -> %Ub2 > Ub1 3177 constraint_union_vr(Rest,[{'ValueRange',{Lb,Ub2}}|Acc]); 3178constraint_union_vr([{_,{_,Ub}}|Rest],A=[{_,{_,Ub}}|_Acc]) -> 3179 constraint_union_vr(Rest,A); 3180constraint_union_vr([{_,{Lb2,Ub2}}|Rest],[{_,{Lb1,Ub1}}|Acc]) when Lb2=<Ub1, 3181 Ub2>Ub1-> 3182 constraint_union_vr(Rest,[{'ValueRange',{Lb1,Ub2}}|Acc]); 3183constraint_union_vr([{_,{_,Ub2}}|Rest],A=[{_,{_,Ub1}}|_Acc]) when Ub2=<Ub1-> 3184 constraint_union_vr(Rest,A); 3185constraint_union_vr([VR|Rest],Acc) -> 3186 constraint_union_vr(Rest,[VR|Acc]). 3187 3188union_sv_vr(_S,[],B) -> 3189 [B]; 3190union_sv_vr(_S,A,[]) -> 3191 [A]; 3192union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',VR={Lb,Ub}}) 3193 when integer(SV) -> 3194 case is_int_in_vr(SV,C2) of 3195 true -> [C2]; 3196 _ -> 3197 case VR of 3198 {'MIN',Ub} when SV==Ub+1 -> [{'ValueRange',{'MIN',SV}}]; 3199 {Lb,'MAX'} when SV==Lb-1 -> [{'ValueRange',{SV,'MAX'}}]; 3200 {Lb,Ub} when SV==Ub+1 -> [{'ValueRange',{Lb,SV}}]; 3201 {Lb,Ub} when SV==Lb-1 -> [{'ValueRange',{SV,Ub}}]; 3202 _ -> 3203 [C1,C2] 3204 end 3205 end; 3206union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',{_Lb,_Ub}}) 3207 when list(SV) -> 3208 case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of 3209 [] -> [C2]; 3210 L -> 3211 case expand_vr(L,C2) of 3212 {[],C3} -> [C3]; 3213 {L,C2} -> [C1,C2]; 3214 {[Val],C3} -> [{'SingleValue',Val},C3]; 3215 {L2,C3} -> [{'SingleValue',L2},C3] 3216 end 3217 end. 3218 3219expand_vr(L,VR={_,{Lb,Ub}}) -> 3220 case lower_Lb(L,Lb) of 3221 false -> 3222 case higher_Ub(L,Ub) of 3223 false -> 3224 {L,VR}; 3225 {L1,UbNew} -> 3226 expand_vr(L1,{'ValueRange',{Lb,UbNew}}) 3227 end; 3228 {L1,LbNew} -> 3229 expand_vr(L1,{'ValueRange',{LbNew,Ub}}) 3230 end. 3231 3232lower_Lb(_,'MIN') -> 3233 false; 3234lower_Lb(L,Lb) -> 3235 remove_val_from_list(Lb - 1,L). 3236 3237higher_Ub(_,'MAX') -> 3238 false; 3239higher_Ub(L,Ub) -> 3240 remove_val_from_list(Ub + 1,L). 3241 3242remove_val_from_list(List,Val) -> 3243 case lists:member(Val,List) of 3244 true -> 3245 {lists:delete(Val,List),Val}; 3246 false -> 3247 false 3248 end. 3249 3250%% get_constraints/2 3251%% Arguments are a list of constraints, which has the format {key,value}, 3252%% and a constraint type 3253%% Returns a list of constraints only of the requested type or the atom 3254%% 'no' if no such constraints were found 3255get_constraints(L=[{CType,_}],CType) -> 3256 L; 3257get_constraints(C,CType) -> 3258 keysearch_allwithkey(CType,1,C). 3259 3260%% keysearch_allwithkey(Key,Ix,L) 3261%% Types: 3262%% Key = atom() 3263%% Ix = integer() 3264%% L = [TwoTuple] 3265%% TwoTuple = [{atom(),term()}|...] 3266%% Returns a List that contains all 3267%% elements from L that has a key Key as element Ix 3268keysearch_allwithkey(Key,Ix,L) -> 3269 lists:filter(fun(X) when tuple(X) -> 3270 case element(Ix,X) of 3271 Key -> true; 3272 _ -> false 3273 end; 3274 (_) -> false 3275 end, L). 3276 3277 3278%% filter_extensions(C) 3279%% takes a list of constraints as input and 3280%% returns a list with the intersection of all extension roots 3281%% and only the extension of the last constraint kept if any 3282%% extension in the last constraint 3283filter_extensions([]) -> 3284 []; 3285filter_extensions(C=[_H]) -> 3286 C; 3287filter_extensions(C) when list(C) -> 3288 filter_extensions(C,[]). 3289 3290filter_extensions([C],Acc) -> 3291 lists:reverse([C|Acc]); 3292filter_extensions([{C,_E},H2|T],Acc) when tuple(C) -> 3293 filter_extensions([H2|T],[C|Acc]); 3294filter_extensions([{'SizeConstraint',{A,_B}},H2|T],Acc) 3295 when list(A);tuple(A) -> 3296 filter_extensions([H2|T],[{'SizeConstraint',A}|Acc]); 3297filter_extensions([H1,H2|T],Acc) -> 3298 filter_extensions([H2|T],[H1|Acc]). 3299 3300%% constraint_intersection(S,C) takes a list of constraints as input and 3301%% performs intersections. Intersecions are performed when an 3302%% atom intersection is found between two constraints. 3303%% The list may be nested. Fix that later !!! 3304constraint_intersection(_S,[]) -> 3305 []; 3306constraint_intersection(_S,C=[_E]) -> 3307 C; 3308constraint_intersection(S,C) when list(C) -> 3309% io:format("constraint_intersection: ~p~n",[C]), 3310 case lists:member(intersection,C) of 3311 true -> 3312 constraint_intersection1(S,C,[]); 3313 _ -> 3314 C 3315 end; 3316constraint_intersection(_S,C) -> 3317 [C]. 3318 3319constraint_intersection1(S,[A,intersection,B|Rest],Acc) -> 3320 AisecB = c_intersect(S,A,B), 3321 constraint_intersection1(S,Rest,AisecB++Acc); 3322constraint_intersection1(S,[A|Rest],Acc) -> 3323 constraint_intersection1(S,Rest,[A|Acc]); 3324constraint_intersection1(_,[],Acc) -> 3325 lists:reverse(Acc). 3326 3327c_intersect(S,C1={'SingleValue',_},C2={'SingleValue',_}) -> 3328 intersection_of_sv(S,[C1,C2]); 3329c_intersect(S,C1={'ValueRange',_},C2={'ValueRange',_}) -> 3330 intersection_of_vr(S,[C1,C2]); 3331c_intersect(S,C1={'ValueRange',_},C2={'SingleValue',_}) -> 3332 intersection_sv_vr(S,[C2],[C1]); 3333c_intersect(S,C1={'SingleValue',_},C2={'ValueRange',_}) -> 3334 intersection_sv_vr(S,[C1],[C2]); 3335c_intersect(_S,C1,C2) -> 3336 [C1,C2]. 3337 3338%% combine_constraints(S,SV,VR,CComb) 3339%% Types: 3340%% S = record(state,S) 3341%% SV = [] | [SVC] 3342%% VR = [] | [VRC] 3343%% CComb = [] | [Lists] 3344%% SVC = {'SingleValue',integer()} | {'SingleValue',[integer(),...]} 3345%% VRC = {'ValueRange',{Lb,Ub}} 3346%% Lists = List of lists containing any constraint combination 3347%% Lb = 'MIN' | integer() 3348%% Ub = 'MAX' | integer() 3349%% Returns a combination of the least common constraint among SV,VR and all 3350%% elements in CComb 3351combine_constraints(_S,[],VR,CComb) -> 3352 VR ++ CComb; 3353% combine_combined_cnstr(S,VR,CComb); 3354combine_constraints(_S,SV,[],CComb) -> 3355 SV ++ CComb; 3356% combine_combined_cnstr(S,SV,CComb); 3357combine_constraints(S,SV,VR,CComb) -> 3358 C=intersection_sv_vr(S,SV,VR), 3359 C ++ CComb. 3360% combine_combined_cnstr(S,C,CComb). 3361 3362intersection_sv_vr(_,[],_VR) -> 3363 []; 3364intersection_sv_vr(_,_SV,[]) -> 3365 []; 3366intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}]) 3367 when integer(SV) -> 3368 case is_int_in_vr(SV,C2) of 3369 true -> [C1]; 3370 _ -> %%error({type,{"asn1 illegal constraint",C1,C2},S}) 3371 throw({error,{"asn1 illegal constraint",C1,C2}}) 3372 end; 3373intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2]) 3374 when list(SV) -> 3375 case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of 3376 [] -> 3377 %%error({type,{"asn1 illegal constraint",C1,C2},S}); 3378 throw({error,{"asn1 illegal constraint",C1,C2}}); 3379 [V] -> [{'SingleValue',V}]; 3380 L -> [{'SingleValue',L}] 3381 end. 3382 3383 3384 3385intersection_of_size(_,[]) -> 3386 []; 3387intersection_of_size(_,C=[_SZ]) -> 3388 C; 3389intersection_of_size(S,[SZ,SZ|Rest]) -> 3390 intersection_of_size(S,[SZ|Rest]); 3391intersection_of_size(S,C=[C1={_,Int},{_,Range}|Rest]) 3392 when integer(Int),tuple(Range) -> 3393 case Range of 3394 {Lb,Ub} when Int >= Lb, 3395 Int =< Ub -> 3396 intersection_of_size(S,[C1|Rest]); 3397 _ -> 3398 throw({error,{asn1,{illegal_size_constraint,C}}}) 3399 end; 3400intersection_of_size(S,[C1={_,Range},C2={_,Int}|Rest]) 3401 when integer(Int),tuple(Range) -> 3402 intersection_of_size(S,[C2,C1|Rest]); 3403intersection_of_size(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) -> 3404 Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])), 3405 Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])), 3406 intersection_of_size(S,[{'SizeConstraint',{Lb,Ub}}|Rest]); 3407intersection_of_size(_,SZ) -> 3408 throw({error,{asn1,{illegal_size_constraint,SZ}}}). 3409 3410intersection_of_vr(_,[]) -> 3411 []; 3412intersection_of_vr(_,VR=[_C]) -> 3413 VR; 3414intersection_of_vr(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) -> 3415 Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])), 3416 Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])), 3417 intersection_of_vr(S,[{'ValueRange',{Lb,Ub}}|Rest]); 3418intersection_of_vr(_S,VR) -> 3419 %%error({type,{asn1,{illegal_value_range_constraint,VR}},S}); 3420 throw({error,{asn1,{illegal_value_range_constraint,VR}}}). 3421 3422intersection_of_sv(_,[]) -> 3423 []; 3424intersection_of_sv(_,SV=[_C]) -> 3425 SV; 3426intersection_of_sv(S,[SV,SV|Rest]) -> 3427 intersection_of_sv(S,[SV|Rest]); 3428intersection_of_sv(S,[{_,Int},{_,SV}|Rest]) when integer(Int), 3429 list(SV) -> 3430 SV2=intersection_of_sv1(S,Int,SV), 3431 intersection_of_sv(S,[SV2|Rest]); 3432intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when integer(Int), 3433 list(SV) -> 3434 SV2=intersection_of_sv1(S,Int,SV), 3435 intersection_of_sv(S,[SV2|Rest]); 3436intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when list(SV1), 3437 list(SV2) -> 3438 SV3=common_set(SV1,SV2), 3439 intersection_of_sv(S,[SV3|Rest]); 3440intersection_of_sv(_S,SV) -> 3441 %%error({type,{asn1,{illegal_single_value_constraint,SV}},S}). 3442 throw({error,{asn1,{illegal_single_value_constraint,SV}}}). 3443 3444intersection_of_sv1(_S,Int,SV) when integer(Int),list(SV) -> 3445 case lists:member(Int,SV) of 3446 true -> {'SingleValue',Int}; 3447 _ -> 3448 %%error({type,{asn1,{illegal_single_value_constraint,Int,SV}},S}) 3449 throw({error,{asn1,{illegal_single_value_constraint,Int,SV}}}) 3450 end; 3451intersection_of_sv1(_S,SV1,SV2) -> 3452 %%error({type,{asn1,{illegal_single_value_constraint,SV1,SV2}},S}). 3453 throw({error,{asn1,{illegal_single_value_constraint,SV1,SV2}}}). 3454 3455greatest_LB([H]) -> 3456 H; 3457greatest_LB(L) -> 3458 greatest_LB1(lists:reverse(L)). 3459greatest_LB1(['MIN',H2|_T])-> 3460 H2; 3461greatest_LB1([H|_T]) -> 3462 H. 3463smallest_UB(L) -> 3464 hd(L). 3465 3466common_set(SV1,SV2) -> 3467 lists:filter(fun(X)->lists:member(X,SV1) end,SV2). 3468 3469is_int_in_vr(Int,{_,{'MIN','MAX'}}) when integer(Int) -> 3470 true; 3471is_int_in_vr(Int,{_,{'MIN',Ub}}) when integer(Int),Int =< Ub -> 3472 true; 3473is_int_in_vr(Int,{_,{Lb,'MAX'}}) when integer(Int),Int >= Lb -> 3474 true; 3475is_int_in_vr(Int,{_,{Lb,Ub}}) when integer(Int),Int >= Lb,Int =< Ub -> 3476 true; 3477is_int_in_vr(_,_) -> 3478 false. 3479 3480 3481 3482check_imported(_S,Imodule,Name) -> 3483 case asn1_db:dbget(Imodule,'MODULE') of 3484 undefined -> 3485 io:format("~s.asn1db not found~n",[Imodule]), 3486 io:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]); 3487 Im when record(Im,module) -> 3488 case is_exported(Im,Name) of 3489 false -> 3490 io:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]); 3491 _ -> 3492 ok 3493 end 3494 end, 3495 ok. 3496 3497is_exported(Module,Name) when record(Module,module) -> 3498 {exports,Exports} = Module#module.exports, 3499 case Exports of 3500 all -> 3501 true; 3502 [] -> 3503 false; 3504 L when list(L) -> 3505 case lists:keysearch(Name,#'Externaltypereference'.type,Exports) of 3506 false -> false; 3507 _ -> true 3508 end 3509 end. 3510 3511 3512 3513check_externaltypereference(S,Etref=#'Externaltypereference'{module=Emod})-> 3514 Currmod = S#state.mname, 3515 MergedMods = S#state.inputmodules, 3516 case Emod of 3517 Currmod -> 3518 %% reference to current module or to imported reference 3519 check_reference(S,Etref); 3520 _ -> 3521 %% io:format("Type ~s IMPORTED FROM ~s~n",[Etype,Emod]), 3522 case lists:member(Emod,MergedMods) of 3523 true -> 3524 check_reference(S,Etref); 3525 false -> 3526 Etref 3527 end 3528 end. 3529 3530check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) -> 3531 ModName = S#state.mname, 3532 case asn1_db:dbget(ModName,Name) of 3533 undefined -> 3534 case imported(S,Name) of 3535 {ok,Imodule} -> 3536 check_imported(S,Imodule,Name), 3537 #'Externaltypereference'{module=Imodule,type=Name}; 3538 _ -> 3539 %may be a renamed type in multi file compiling! 3540 {_,T}=renamed_reference(S,Name,Emod), 3541 NewName = asn1ct:get_name_of_def(T), 3542 NewPos = asn1ct:get_pos_of_def(T), 3543 #'Externaltypereference'{pos=NewPos, 3544 module=ModName, 3545 type=NewName} 3546 end; 3547 _ -> 3548 %% cannot do check_type here due to recursive definitions, like 3549 %% S ::= SEQUENCE {a INTEGER, b S}. This implies that references 3550 %% that appear before the definition will be an 3551 %% Externaltypereference in the abstract syntax tree 3552 #'Externaltypereference'{pos=Pos,module=ModName,type=Name} 3553 end. 3554 3555 3556name2Extref(_Mod,Name) when record(Name,'Externaltypereference') -> 3557 Name; 3558name2Extref(Mod,Name) -> 3559 #'Externaltypereference'{module=Mod,type=Name}. 3560 3561get_referenced_type(S,Ext) when record(Ext,'Externaltypereference') -> 3562 case match_parameters(Ext, S#state.parameters) of 3563 Ext -> 3564 #'Externaltypereference'{pos=Pos,module=Emod,type=Etype} = Ext, 3565 case S#state.mname of 3566 Emod -> % a local reference in this module 3567 get_referenced1(S,Emod,Etype,Pos); 3568 _ ->% always when multi file compiling 3569 case lists:member(Emod,S#state.inputmodules) of 3570 true -> 3571 get_referenced1(S,Emod,Etype,Pos); 3572 false -> 3573 get_referenced(S,Emod,Etype,Pos) 3574 end 3575 end; 3576 Other -> 3577 {undefined,Other} 3578 end; 3579get_referenced_type(S=#state{mname=Emod}, 3580 ERef=#'Externalvaluereference'{pos=P,module=Emod, 3581 value=Eval}) -> 3582 case match_parameters(ERef,S#state.parameters) of 3583 ERef -> 3584 get_referenced1(S,Emod,Eval,P); 3585 OtherERef when record(OtherERef,'Externalvaluereference') -> 3586 get_referenced_type(S,OtherERef); 3587 Value -> 3588 {Emod,Value} 3589 end; 3590get_referenced_type(S,ERef=#'Externalvaluereference'{pos=Pos,module=Emod, 3591 value=Eval}) -> 3592 case match_parameters(ERef,S#state.parameters) of 3593 ERef -> 3594 case lists:member(Emod,S#state.inputmodules) of 3595 true -> 3596 get_referenced1(S,Emod,Eval,Pos); 3597 false -> 3598 get_referenced(S,Emod,Eval,Pos) 3599 end; 3600 OtherERef -> 3601 get_referenced_type(S,OtherERef) 3602 end; 3603get_referenced_type(S,#identifier{val=Name,pos=Pos}) -> 3604 get_referenced1(S,undefined,Name,Pos); 3605get_referenced_type(_S,Type) -> 3606 {undefined,Type}. 3607 3608%% get_referenced/3 3609%% The referenced entity Ename may in case of an imported parameterized 3610%% type reference imported entities in the other module, which implies that 3611%% asn1_db:dbget will fail even though the referenced entity exists. Thus 3612%% Emod may be the module that imports the entity Ename and not holds the 3613%% data about Ename. 3614get_referenced(S,Emod,Ename,Pos) -> 3615 case asn1_db:dbget(Emod,Ename) of 3616 undefined -> 3617 %% May be an imported entity in module Emod 3618% throw({error,{asn1,{undefined_type_or_value,{Emod,Ename}}}}); 3619 NewS = S#state{module=asn1_db:dbget(Emod,'MODULE')}, 3620 get_imported(NewS,Ename,Emod,Pos); 3621 T when record(T,typedef) -> 3622 Spec = T#typedef.typespec, 3623 case Spec#type.def of 3624 Tref when record(Tref,typereference) -> 3625 Def = #'Externaltypereference'{module=Emod, 3626 type=Tref#typereference.val, 3627 pos=Tref#typereference.pos}, 3628 3629 3630 {Emod,T#typedef{typespec=Spec#type{def=Def}}}; 3631 _ -> 3632 {Emod,T} % should add check that T is exported here 3633 end; 3634 V -> {Emod,V} 3635 end. 3636 3637get_referenced1(S,ModuleName,Name,Pos) -> 3638 case asn1_db:dbget(S#state.mname,Name) of 3639 undefined -> 3640 %% ModuleName may be other than S#state.mname when 3641 %% multi file compiling is used. 3642 get_imported(S,Name,ModuleName,Pos); 3643 T -> 3644 {S#state.mname,T} 3645 end. 3646 3647get_imported(S,Name,Module,Pos) -> 3648 case imported(S,Name) of 3649 {ok,Imodule} -> 3650 case asn1_db:dbget(Imodule,'MODULE') of 3651 undefined -> 3652 throw({error,{asn1,{module_not_found,Imodule}}}); 3653 Im when record(Im,module) -> 3654 case is_exported(Im,Name) of 3655 false -> 3656 throw({error, 3657 {asn1,{not_exported,{Im,Name}}}}); 3658 _ -> 3659 get_referenced_type(S, 3660 #'Externaltypereference' 3661 {module=Imodule, 3662 type=Name,pos=Pos}) 3663 end 3664 end; 3665 _ -> 3666 renamed_reference(S,Name,Module) 3667 end. 3668 3669renamed_reference(S,Name,Module) -> 3670 %% first check if there is a renamed type in this module 3671 %% second check if any type was imported with this name 3672 case ets:info(renamed_defs) of 3673 undefined -> throw({error,{asn1,{undefined_type,Name}}}); 3674 _ -> 3675 case ets:match(renamed_defs,{'$1',Name,Module}) of 3676 [] -> 3677 case ets:info(original_imports) of 3678 undefined -> 3679 throw({error,{asn1,{undefined_type,Name}}}); 3680 _ -> 3681 case ets:match(original_imports,{Module,'$1'}) of 3682 [] -> 3683 throw({error,{asn1,{undefined_type,Name}}}); 3684 [[ImportsList]] -> 3685 case get_importmoduleoftype(ImportsList,Name) of 3686 undefined -> 3687 throw({error,{asn1,{undefined_type,Name}}}); 3688 NextMod -> 3689 renamed_reference(S,Name,NextMod) 3690 end 3691 end 3692 end; 3693 [[NewTypeName]] -> 3694 get_referenced1(S,Module,NewTypeName,undefined) 3695 end 3696 end. 3697 3698get_importmoduleoftype([I|Is],Name) -> 3699 Index = #'Externaltypereference'.type, 3700 case lists:keysearch(Name,Index,I#'SymbolsFromModule'.symbols) of 3701 {value,_Ref} -> 3702 (I#'SymbolsFromModule'.module)#'Externaltypereference'.type; 3703 _ -> 3704 get_importmoduleoftype(Is,Name) 3705 end; 3706get_importmoduleoftype([],_) -> 3707 undefined. 3708 3709 3710match_parameters(Name,[]) -> 3711 Name; 3712 3713match_parameters(#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) -> 3714 NewName; 3715match_parameters(#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> 3716 NewName; 3717% match_parameters(#'Externaltypereference'{type=Name},[{#typereference{val=Name},NewName}|T]) -> 3718% NewName; 3719% match_parameters(#'Externaltypereference'{type=Name},[{{_,#typereference{val=Name}},NewName}|T]) -> 3720% NewName; 3721%match_parameters(#typereference{val=Name},[{#typereference{val=Name},NewName}|T]) -> 3722% NewName; 3723match_parameters(#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) -> 3724 NewName; 3725match_parameters(#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) -> 3726 NewName; 3727% match_parameters(#identifier{val=Name},[{#identifier{val=Name},NewName}|T]) -> 3728% NewName; 3729% match_parameters(#identifier{val=Name},[{{_,#identifier{val=Name}},NewName}|T]) -> 3730% NewName; 3731match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, 3732 [{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) -> 3733 NewName; 3734match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, 3735 [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> 3736 NewName; 3737% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, 3738% [{{_,#typereference{val=Name}},{valueset,#type{def=NewName}}}|T]) -> 3739% NewName; 3740% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, 3741% [{{_,#typereference{val=Name}},NewName}|T]) -> 3742% NewName; 3743 3744match_parameters(Name, [_H|T]) -> 3745 %%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]), 3746 match_parameters(Name,T). 3747 3748imported(S,Name) -> 3749 {imports,Ilist} = (S#state.module)#module.imports, 3750 imported1(Name,Ilist). 3751 3752imported1(Name, 3753 [#'SymbolsFromModule'{symbols=Symlist, 3754 module=#'Externaltypereference'{type=ModuleName}}|T]) -> 3755 case lists:keysearch(Name,#'Externaltypereference'.type,Symlist) of 3756 {value,_V} -> 3757 {ok,ModuleName}; 3758 _ -> 3759 imported1(Name,T) 3760 end; 3761imported1(_Name,[]) -> 3762 false. 3763 3764 3765check_integer(_S,[],_C) -> 3766 ok; 3767check_integer(S,NamedNumberList,_C) -> 3768 case check_unique(NamedNumberList,2) of 3769 [] -> 3770 check_int(S,NamedNumberList,[]); 3771 L when list(L) -> 3772 error({type,{duplicates,L},S}), 3773 unchanged 3774 3775 end. 3776 3777check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when integer(Num) -> 3778 check_int(S,T,[{Id,Num}|Acc]); 3779check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> 3780 Val = dbget_ex(S,S#state.mname,Name), 3781 check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); 3782check_int(_S,[],Acc) -> 3783 lists:keysort(2,Acc). 3784 3785 3786 3787check_bitstring(_S,[],_Constr) -> 3788 []; 3789check_bitstring(S,NamedNumberList,_Constr) -> 3790 case check_unique(NamedNumberList,2) of 3791 [] -> 3792 check_bitstr(S,NamedNumberList,[]); 3793 L when list(L) -> 3794 error({type,{duplicates,L},S}), 3795 unchanged 3796 end. 3797 3798check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when integer(Num) -> 3799 check_bitstr(S,T,[{Id,Num}|Acc]); 3800check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when atom(Name) -> 3801%%check_bitstr(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> 3802%% io:format("asn1ct_check:check_bitstr/3 hej hop ~w~n",[Name]), 3803 Val = dbget_ex(S,S#state.mname,Name), 3804%% io:format("asn1ct_check:check_bitstr/3: ~w~n",[Val]), 3805 check_bitstr(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); 3806check_bitstr(S,[],Acc) -> 3807 case check_unique(Acc,2) of 3808 [] -> 3809 lists:keysort(2,Acc); 3810 L when list(L) -> 3811 error({type,{duplicate_values,L},S}), 3812 unchanged 3813 end. 3814 3815%%check_bitstring(S,NamedNumberList,Constr) -> 3816%% NamedNumberList. 3817 3818%% Check INSTANCE OF 3819%% check that DefinedObjectClass is of TYPE-IDENTIFIER class 3820%% If Constraint is empty make it the general INSTANCE OF type 3821%% If Constraint is not empty make an inlined type 3822%% convert INSTANCE OF to the associated type 3823check_instance_of(S,DefinedObjectClass,Constraint) -> 3824 check_type_identifier(S,DefinedObjectClass), 3825 iof_associated_type(S,Constraint). 3826 3827 3828check_type_identifier(_S,'TYPE-IDENTIFIER') -> 3829 ok; 3830check_type_identifier(S,Eref=#'Externaltypereference'{}) -> 3831 case get_referenced_type(S,Eref) of 3832 {_,#classdef{name='TYPE-IDENTIFIER'}} -> ok; 3833 {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> 3834 check_type_identifier(S,(TD#typedef.typespec)#type.def); 3835 _ -> 3836 error({type,{"object set in type INSTANCE OF " 3837 "not of class TYPE-IDENTIFIER",Eref},S}) 3838 end. 3839 3840iof_associated_type(S,[]) -> 3841 %% in this case encode/decode functions for INSTANCE OF must be 3842 %% generated 3843 case get(instance_of) of 3844 undefined -> 3845 AssociateSeq = iof_associated_type1(S,[]), 3846 Tag = 3847 case S#state.erule of 3848 ber_bin_v2 -> 3849 [?TAG_CONSTRUCTED(?N_INSTANCE_OF)]; 3850 _ -> [] 3851 end, 3852 TypeDef=#typedef{checked=true, 3853 name='INSTANCE OF', 3854 typespec=#type{tag=Tag, 3855 def=AssociateSeq}}, 3856 asn1_db:dbput(S#state.mname,'INSTANCE OF',TypeDef), 3857 put(instance_of,generate); 3858 _ -> 3859 ok 3860 end, 3861 #'Externaltypereference'{module=S#state.mname,type='INSTANCE OF'}; 3862iof_associated_type(S,C) -> 3863 iof_associated_type1(S,C). 3864 3865iof_associated_type1(S,C) -> 3866 {TableCInf,Comp1Cnstr,Comp2Cnstr,Comp2tablecinf}= 3867 instance_of_constraints(S,C), 3868 3869 ModuleName = S#state.mname, 3870 Typefield_type= 3871 case C of 3872 [] -> 'ASN1_OPEN_TYPE'; 3873 _ -> {typefield,'Type'} 3874 end, 3875 {ObjIdTag,C1TypeTag}= 3876 case S#state.erule of 3877 ber_bin_v2 -> 3878 {[{'UNIVERSAL',8}], 3879 [#tag{class='UNIVERSAL', 3880 number=6, 3881 type='IMPLICIT', 3882 form=0}]}; 3883 _ -> {[{'UNIVERSAL','INTEGER'}],[]} 3884 end, 3885 TypeIdentifierRef=#'Externaltypereference'{module=ModuleName, 3886 type='TYPE-IDENTIFIER'}, 3887 ObjectIdentifier = 3888 #'ObjectClassFieldType'{classname=TypeIdentifierRef, 3889 class=[], 3890 fieldname={id,[]}, 3891 type={fixedtypevaluefield,id, 3892 #type{def='OBJECT IDENTIFIER'}}}, 3893 Typefield = 3894 #'ObjectClassFieldType'{classname=TypeIdentifierRef, 3895 class=[], 3896 fieldname={'Type',[]}, 3897 type=Typefield_type}, 3898 IOFComponents = 3899 [#'ComponentType'{name='type-id', 3900 typespec=#type{tag=C1TypeTag, 3901 def=ObjectIdentifier, 3902 constraint=Comp1Cnstr}, 3903 prop=mandatory, 3904 tags=ObjIdTag}, 3905 #'ComponentType'{name=value, 3906 typespec=#type{tag=[#tag{class='CONTEXT', 3907 number=0, 3908 type='EXPLICIT', 3909 form=32}], 3910 def=Typefield, 3911 constraint=Comp2Cnstr, 3912 tablecinf=Comp2tablecinf}, 3913 prop=mandatory, 3914 tags=[{'CONTEXT',0}]}], 3915 #'SEQUENCE'{tablecinf=TableCInf, 3916 components=IOFComponents}. 3917 3918 3919%% returns the leading attribute, the constraint of the components and 3920%% the tablecinf value for the second component. 3921instance_of_constraints(_,[]) -> 3922 {false,[],[],[]}; 3923instance_of_constraints(S,#constraint{c={simpletable,Type}}) -> 3924 #type{def=#'Externaltypereference'{type=Name}} = Type, 3925 ModuleName = S#state.mname, 3926 ObjectSetRef=#'Externaltypereference'{module=ModuleName, 3927 type=Name}, 3928 CRel=[{componentrelation,{objectset, 3929 undefined, %% pos 3930 ObjectSetRef}, 3931 [{innermost, 3932 [#'Externalvaluereference'{module=ModuleName, 3933 value=type}]}]}], 3934 TableCInf=#simpletableattributes{objectsetname=Name, 3935 c_name='type-id', 3936 c_index=1, 3937 usedclassfield=id, 3938 uniqueclassfield=id, 3939 valueindex=[]}, 3940 {TableCInf,[{simpletable,Name}],CRel,[{objfun,ObjectSetRef}]}. 3941 3942%% Check ENUMERATED 3943%% **************************************** 3944%% Check that all values are unique 3945%% assign values to un-numbered identifiers 3946%% check that the constraints are allowed and correct 3947%% put the updated info back into database 3948check_enumerated(_S,[{Name,Number}|Rest],_Constr) when atom(Name), integer(Number)-> 3949 %% already checked , just return the same list 3950 [{Name,Number}|Rest]; 3951check_enumerated(S,NamedNumberList,_Constr) -> 3952 check_enum(S,NamedNumberList,[],[]). 3953 3954%% identifiers are put in Acc2 3955%% returns either [{Name,Number}] or {[{Name,Number}],[{ExtName,ExtNumber}]} 3956%% the latter is returned if the ENUMERATION contains EXTENSIONMARK 3957check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2) when integer(Num) -> 3958 check_enum(S,T,[{Id,Num}|Acc1],Acc2); 3959check_enum(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2) -> 3960 Val = dbget_ex(S,S#state.mname,Name), 3961 check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc1,Acc2); 3962check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2) -> 3963 NewAcc2 = lists:keysort(2,Acc1), 3964 NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[]), 3965 { NewList, check_enum(S,T,[],[])}; 3966check_enum(S,[Id|T],Acc1,Acc2) when atom(Id) -> 3967 check_enum(S,T,Acc1,[Id|Acc2]); 3968check_enum(_S,[],Acc1,Acc2) -> 3969 NewAcc2 = lists:keysort(2,Acc1), 3970 enum_number(lists:reverse(Acc2),NewAcc2,0,[]). 3971 3972 3973% assign numbers to identifiers , numbers from 0 ... but must not 3974% be the same as already assigned to NamedNumbers 3975enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num > Cnt -> 3976 enum_number(T,[{Id,Num}|T2],Cnt+1,[{H,Cnt}|Acc]); 3977enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num < Cnt -> % negative Num 3978 enum_number(T,T2,Cnt+1,[{H,Cnt},{Id,Num}|Acc]); 3979enum_number([],L2,_Cnt,Acc) -> 3980 lists:concat([lists:reverse(Acc),L2]); 3981enum_number(L,[{Id,Num}|T2],Cnt,Acc) -> % Num == Cnt 3982 enum_number(L,T2,Cnt+1,[{Id,Num}|Acc]); 3983enum_number([H|T],[],Cnt,Acc) -> 3984 enum_number(T,[],Cnt+1,[{H,Cnt}|Acc]). 3985 3986 3987check_boolean(_S,_Constr) -> 3988 ok. 3989 3990check_octetstring(_S,_Constr) -> 3991 ok. 3992 3993% check all aspects of a SEQUENCE 3994% - that all component names are unique 3995% - that all TAGS are ok (when TAG default is applied) 3996% - that each component is of a valid type 3997% - that the extension marks are valid 3998 3999check_sequence(S,Type,Comps) -> 4000 Components = expand_components(S,Comps), 4001 case check_unique([C||C <- Components ,record(C,'ComponentType')] 4002 ,#'ComponentType'.name) of 4003 [] -> 4004 %% sort_canonical(Components), 4005 Components2 = maybe_automatic_tags(S,Components), 4006 %% check the table constraints from here. The outermost type 4007 %% is Type, the innermost is Comps (the list of components) 4008 NewComps = 4009 case check_each_component(S,Type,Components2) of 4010 NewComponents when list(NewComponents) -> 4011 check_unique_sequence_tags(S,NewComponents), 4012 NewComponents; 4013 Ret = {NewComponents,NewEcomps} -> 4014 TagComps = NewComponents ++ 4015 [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewEcomps], 4016 %% extension components are like optionals when it comes to tagging 4017 check_unique_sequence_tags(S,TagComps), 4018 Ret 4019 end, 4020 %% CRelInf is the "leading attribute" information 4021 %% necessary for code generating of the look up in the 4022 %% object set table, 4023 %% i.e. getenc_ObjectSet/getdec_ObjectSet. 4024 %% {objfun,ERef} tuple added in NewComps2 in tablecinf 4025 %% field in type record of component relation constrained 4026 %% type 4027% io:format("NewComps: ~p~n",[NewComps]), 4028 {CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps), 4029% io:format("CRelInf: ~p~n",[CRelInf]), 4030% io:format("NewComps2: ~p~n",[NewComps2]), 4031 %% CompListWithTblInf has got a lot unnecessary info about 4032 %% the involved class removed, as the class of the object 4033 %% set. 4034 CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2), 4035% io:format("CompListWithTblInf: ~p~n",[CompListWithTblInf]), 4036 {CRelInf,CompListWithTblInf}; 4037 Dupl -> 4038 throw({error,{asn1,{duplicate_components,Dupl}}}) 4039 end. 4040 4041expand_components(S, [{'COMPONENTS OF',Type}|T]) -> 4042 CompList = 4043 case get_referenced_type(S,Type#type.def) of 4044 {_,#typedef{typespec=#type{def=Seq}}} when record(Seq,'SEQUENCE') -> 4045 case Seq#'SEQUENCE'.components of 4046 {Root,_Ext} -> Root; 4047 Root -> Root 4048 end; 4049 Err -> throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}}) 4050 end, 4051 expand_components(S,CompList) ++ expand_components(S,T); 4052expand_components(S,[H|T]) -> 4053 [H|expand_components(S,T)]; 4054expand_components(_,[]) -> 4055 []. 4056 4057check_unique_sequence_tags(S,[#'ComponentType'{prop=mandatory}|Rest]) -> 4058 check_unique_sequence_tags(S,Rest); 4059check_unique_sequence_tags(S,[C|Rest]) when record(C,'ComponentType') -> 4060 check_unique_sequence_tags1(S,Rest,[C]);% optional or default 4061check_unique_sequence_tags(S,[_ExtensionMarker|Rest]) -> 4062 check_unique_sequence_tags(S,Rest); 4063check_unique_sequence_tags(_S,[]) -> 4064 true. 4065 4066check_unique_sequence_tags1(S,[C|Rest],Acc) when record(C,'ComponentType') -> 4067 case C#'ComponentType'.prop of 4068 mandatory -> 4069 check_unique_tags(S,lists:reverse([C|Acc])), 4070 check_unique_sequence_tags(S,Rest); 4071 _ -> 4072 check_unique_sequence_tags1(S,Rest,[C|Acc]) % default or optional 4073 end; 4074check_unique_sequence_tags1(S,[H|Rest],Acc) -> 4075 check_unique_sequence_tags1(S,Rest,[H|Acc]); 4076check_unique_sequence_tags1(S,[],Acc) -> 4077 check_unique_tags(S,lists:reverse(Acc)). 4078 4079check_sequenceof(S,Type,Component) when record(Component,type) -> 4080 check_type(S,Type,Component). 4081 4082check_set(S,Type,Components) -> 4083 {TableCInf,NewComponents} = check_sequence(S,Type,Components), 4084 case lists:member(der,S#state.options) of 4085 true when S#state.erule == ber; 4086 S#state.erule == ber_bin -> 4087 {Sorted,SortedComponents} = 4088 sort_components(S#state.tname, 4089 (S#state.module)#module.tagdefault, 4090 NewComponents), 4091 {Sorted,TableCInf,SortedComponents}; 4092 _ -> 4093 {false,TableCInf,NewComponents} 4094 end. 4095 4096sort_components(_TypeName,'AUTOMATIC',Components) -> 4097 {true,Components}; 4098sort_components(TypeName,_TagDefault,Components) -> 4099 case untagged_choice(Components) of 4100 false -> 4101 {true,sort_components1(TypeName,Components,[],[],[],[])}; 4102 true -> 4103 {dynamic,Components} % sort in run-time 4104 end. 4105 4106sort_components1(TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs], 4107 UnivAcc,ApplAcc,ContAcc,PrivAcc) -> 4108 sort_components1(TypeName,Cs,[C|UnivAcc],ApplAcc,ContAcc,PrivAcc); 4109sort_components1(TypeName,[C=#'ComponentType'{tags=[{'APPLICATION',_}|_R]}|Cs], 4110 UnivAcc,ApplAcc,ContAcc,PrivAcc) -> 4111 sort_components1(TypeName,Cs,UnivAcc,[C|ApplAcc],ContAcc,PrivAcc); 4112sort_components1(TypeName,[C=#'ComponentType'{tags=[{'CONTEXT',_}|_R]}|Cs], 4113 UnivAcc,ApplAcc,ContAcc,PrivAcc) -> 4114 sort_components1(TypeName,Cs,UnivAcc,ApplAcc,[C|ContAcc],PrivAcc); 4115sort_components1(TypeName,[C=#'ComponentType'{tags=[{'PRIVATE',_}|_R]}|Cs], 4116 UnivAcc,ApplAcc,ContAcc,PrivAcc) -> 4117 sort_components1(TypeName,Cs,UnivAcc,ApplAcc,ContAcc,[C|PrivAcc]); 4118sort_components1(TypeName,[],UnivAcc,ApplAcc,ContAcc,PrivAcc) -> 4119 I = #'ComponentType'.tags, 4120 ascending_order_check(TypeName,sort_universal_type(UnivAcc)) ++ 4121 ascending_order_check(TypeName,lists:keysort(I,ApplAcc)) ++ 4122 ascending_order_check(TypeName,lists:keysort(I,ContAcc)) ++ 4123 ascending_order_check(TypeName,lists:keysort(I,PrivAcc)). 4124 4125ascending_order_check(TypeName,Components) -> 4126 ascending_order_check1(TypeName,Components), 4127 Components. 4128 4129ascending_order_check1(TypeName, 4130 [C1 = #'ComponentType'{tags=[{_,T}|_]}, 4131 C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) -> 4132 io:format("WARNING: Indistinct tag ~p in SET ~p, components ~p and ~p~n", 4133 [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name]), 4134 ascending_order_check1(TypeName,[C2|Rest]); 4135ascending_order_check1(TypeName, 4136 [C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]}, 4137 C2 = #'ComponentType'{tags=[{'UNIVERSAL',T2}|_]}|Rest]) -> 4138 case (asn1ct_gen_ber:decode_type(T1) == asn1ct_gen_ber:decode_type(T2)) of 4139 true -> 4140 io:format("WARNING: Indistinct tags ~p and ~p in" 4141 " SET ~p, components ~p and ~p~n", 4142 [T1,T2,TypeName,C1#'ComponentType'.name, 4143 C2#'ComponentType'.name]), 4144 ascending_order_check1(TypeName,[C2|Rest]); 4145 _ -> 4146 ascending_order_check1(TypeName,[C2|Rest]) 4147 end; 4148ascending_order_check1(N,[_|Rest]) -> 4149 ascending_order_check1(N,Rest); 4150ascending_order_check1(_,[_]) -> 4151 ok; 4152ascending_order_check1(_,[]) -> 4153 ok. 4154 4155sort_universal_type(Components) -> 4156 List = lists:map(fun(C) -> 4157 #'ComponentType'{tags=[{_,T}|_]} = C, 4158 {asn1ct_gen_ber:decode_type(T),C} 4159 end, 4160 Components), 4161 SortedList = lists:keysort(1,List), 4162 lists:map(fun(X)->element(2,X) end,SortedList). 4163 4164untagged_choice([#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) -> 4165 true; 4166untagged_choice([_|Rest]) -> 4167 untagged_choice(Rest); 4168untagged_choice([]) -> 4169 false. 4170 4171check_setof(S,Type,Component) when record(Component,type) -> 4172 check_type(S,Type,Component). 4173 4174check_restrictedstring(_S,_Def,_Constr) -> 4175 ok. 4176 4177check_objectidentifier(_S,_Constr) -> 4178 ok. 4179 4180% check all aspects of a CHOICE 4181% - that all alternative names are unique 4182% - that all TAGS are ok (when TAG default is applied) 4183% - that each alternative is of a valid type 4184% - that the extension marks are valid 4185check_choice(S,Type,Components) when list(Components) -> 4186 case check_unique([C||C <- Components, 4187 record(C,'ComponentType')],#'ComponentType'.name) of 4188 [] -> 4189 %% sort_canonical(Components), 4190 Components2 = maybe_automatic_tags(S,Components), 4191 %NewComps = 4192 case check_each_alternative(S,Type,Components2) of 4193 {NewComponents,NewEcomps} -> 4194 check_unique_tags(S,NewComponents ++ NewEcomps), 4195 {NewComponents,NewEcomps}; 4196 NewComponents -> 4197 check_unique_tags(S,NewComponents), 4198 NewComponents 4199 end; 4200%% CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps); 4201 Dupl -> 4202 throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}}) 4203 end; 4204check_choice(_S,_,[]) -> 4205 []. 4206 4207%% probably dead code that should be removed 4208%%maybe_automatic_tags(S,{Rc,Ec}) -> 4209%% {maybe_automatic_tags1(S,Rc,0),maybe_automatic_tags1(S,Ec,length(Rc))}; 4210maybe_automatic_tags(#state{erule=per},C) -> 4211 C; 4212maybe_automatic_tags(#state{erule=per_bin},C) -> 4213 C; 4214maybe_automatic_tags(S,C) -> 4215 maybe_automatic_tags1(S,C,0). 4216 4217maybe_automatic_tags1(S,C,TagNo) -> 4218 case (S#state.module)#module.tagdefault of 4219 'AUTOMATIC' -> 4220 generate_automatic_tags(S,C,TagNo); 4221 _ -> 4222 %% maybe is the module a multi file module were only some of 4223 %% the modules have defaulttag AUTOMATIC TAGS then the names 4224 %% of those types are saved in the table automatic_tags 4225 Name= S#state.tname, 4226 case is_automatic_tagged_in_multi_file(Name) of 4227 true -> 4228 generate_automatic_tags(S,C,TagNo); 4229 false -> 4230 C 4231 end 4232 end. 4233 4234is_automatic_tagged_in_multi_file(Name) -> 4235 case ets:info(automatic_tags) of 4236 undefined -> 4237 %% this case when not multifile compilation 4238 false; 4239 _ -> 4240 case ets:member(automatic_tags,Name) of 4241 true -> 4242 true; 4243 _ -> 4244 false 4245 end 4246 end. 4247 4248generate_automatic_tags(_S,C,TagNo) -> 4249 case any_manual_tag(C) of 4250 true -> 4251 C; 4252 false -> 4253 generate_automatic_tags1(C,TagNo) 4254 end. 4255 4256generate_automatic_tags1([H|T],TagNo) when record(H,'ComponentType') -> 4257 #'ComponentType'{typespec=Ts} = H, 4258 NewTs = Ts#type{tag=[#tag{class='CONTEXT', 4259 number=TagNo, 4260 type={default,'IMPLICIT'}, 4261 form= 0 }]}, % PRIMITIVE 4262 [H#'ComponentType'{typespec=NewTs}|generate_automatic_tags1(T,TagNo+1)]; 4263generate_automatic_tags1([ExtMark|T],TagNo) -> % EXTENSIONMARK 4264 [ExtMark | generate_automatic_tags1(T,TagNo)]; 4265generate_automatic_tags1([],_) -> 4266 []. 4267 4268any_manual_tag([#'ComponentType'{typespec=#type{tag=[]}}|Rest]) -> 4269 any_manual_tag(Rest); 4270any_manual_tag([{'EXTENSIONMARK',_,_}|Rest]) -> 4271 any_manual_tag(Rest); 4272any_manual_tag([_|_Rest]) -> 4273 true; 4274any_manual_tag([]) -> 4275 false. 4276 4277 4278check_unique_tags(S,C) -> 4279 case (S#state.module)#module.tagdefault of 4280 'AUTOMATIC' -> 4281 case any_manual_tag(C) of 4282 false -> true; 4283 _ -> collect_and_sort_tags(C,[]) 4284 end; 4285 _ -> 4286 collect_and_sort_tags(C,[]) 4287 end. 4288 4289collect_and_sort_tags([C|Rest],Acc) when record(C,'ComponentType') -> 4290 collect_and_sort_tags(Rest,C#'ComponentType'.tags ++ Acc); 4291collect_and_sort_tags([_|Rest],Acc) -> 4292 collect_and_sort_tags(Rest,Acc); 4293collect_and_sort_tags([],Acc) -> 4294 {Dupl,_}= lists:mapfoldl(fun(El,El)->{{dup,El},El};(El,_Prev)-> {El,El} end,notag,lists:sort(Acc)), 4295 Dupl2 = [Dup|| {dup,Dup} <- Dupl], 4296 if 4297 length(Dupl2) > 0 -> 4298 throw({error,{asn1,{duplicates_of_the_tags,Dupl2}}}); 4299 true -> 4300 true 4301 end. 4302 4303check_unique(L,Pos) -> 4304 Slist = lists:keysort(Pos,L), 4305 check_unique2(Slist,Pos,[]). 4306 4307check_unique2([A,B|T],Pos,Acc) when element(Pos,A) == element(Pos,B) -> 4308 check_unique2([B|T],Pos,[element(Pos,B)|Acc]); 4309check_unique2([_|T],Pos,Acc) -> 4310 check_unique2(T,Pos,Acc); 4311check_unique2([],_,Acc) -> 4312 lists:reverse(Acc). 4313 4314check_each_component(S,Type,{Rlist,ExtList}) -> 4315 {check_each_component(S,Type,Rlist), 4316 check_each_component(S,Type,ExtList)}; 4317check_each_component(S,Type,Components) -> 4318 check_each_component(S,Type,Components,[],[],noext). 4319 4320check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type, 4321 [C|Ct],Acc,Extacc,Ext) when record(C,'ComponentType') -> 4322 #'ComponentType'{name=Cname,typespec=Ts,prop=Prop} = C, 4323 NewAbsCPath = 4324 case Ts#type.def of 4325 #'Externaltypereference'{} -> []; 4326 _ -> [Cname|Path] 4327 end, 4328 CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, 4329 recordtopname=[Cname|TopName]},Type,Ts), 4330 NewTags = get_taglist(S,CheckedTs), 4331 4332 NewProp = 4333% case lists:member(der,S#state.options) of 4334% true -> 4335% True -> 4336 case normalize_value(S,CheckedTs,Prop,[Cname|TopName]) of 4337 mandatory -> mandatory; 4338 'OPTIONAL' -> 'OPTIONAL'; 4339 DefaultValue -> {'DEFAULT',DefaultValue} 4340 end, 4341% _ -> 4342% Prop 4343% end, 4344 NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags}, 4345 case Ext of 4346 noext -> 4347 check_each_component(S,Type,Ct,[NewC|Acc],Extacc,Ext); 4348 ext -> 4349 check_each_component(S,Type,Ct,Acc,[NewC|Extacc],Ext) 4350 end; 4351check_each_component(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK' 4352 check_each_component(S,Type,Ct,Acc,Extacc,ext); 4353check_each_component(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK' 4354 throw({error,{asn1,{too_many_extension_marks}}}); 4355check_each_component(_S,_,[],Acc,Extacc,ext) -> 4356 {lists:reverse(Acc),lists:reverse(Extacc)}; 4357check_each_component(_S,_,[],Acc,_,noext) -> 4358 lists:reverse(Acc). 4359 4360check_each_alternative(S,Type,{Rlist,ExtList}) -> 4361 {check_each_alternative(S,Type,Rlist), 4362 check_each_alternative(S,Type,ExtList)}; 4363check_each_alternative(S,Type,[C|Ct]) -> 4364 check_each_alternative(S,Type,[C|Ct],[],[],noext). 4365 4366check_each_alternative(S=#state{abscomppath=Path,recordtopname=TopName},Type,[C|Ct], 4367 Acc,Extacc,Ext) when record(C,'ComponentType') -> 4368 #'ComponentType'{name=Cname,typespec=Ts,prop=_Prop} = C, 4369 NewAbsCPath = 4370 case Ts#type.def of 4371 #'Externaltypereference'{} -> []; 4372 _ -> [Cname|Path] 4373 end, 4374 NewState = 4375 S#state{abscomppath=NewAbsCPath,recordtopname=[Cname|TopName]}, 4376 CheckedTs = check_type(NewState,Type,Ts), 4377 NewTags = get_taglist(S,CheckedTs), 4378 NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags}, 4379 case Ext of 4380 noext -> 4381 check_each_alternative(S,Type,Ct,[NewC|Acc],Extacc,Ext); 4382 ext -> 4383 check_each_alternative(S,Type,Ct,Acc,[NewC|Extacc],Ext) 4384 end; 4385 4386check_each_alternative(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK' 4387 check_each_alternative(S,Type,Ct,Acc,Extacc,ext); 4388check_each_alternative(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK' 4389 throw({error,{asn1,{too_many_extension_marks}}}); 4390check_each_alternative(_S,_,[],Acc,Extacc,ext) -> 4391 {lists:reverse(Acc),lists:reverse(Extacc)}; 4392check_each_alternative(_S,_,[],Acc,_,noext) -> 4393 lists:reverse(Acc). 4394 4395%% componentrelation_leadingattr/2 searches the structure for table 4396%% constraints, if any is found componentrelation_leadingattr/5 is 4397%% called. 4398componentrelation_leadingattr(S,CompList) -> 4399% {Cs1,Cs2} = 4400 Cs = 4401 case CompList of 4402 {Components,EComponents} when list(Components) -> 4403% {Components,Components}; 4404 Components ++ EComponents; 4405 CompList when list(CompList) -> 4406% {CompList,CompList} 4407 CompList 4408 end, 4409% case any_simple_table(S,Cs1,[]) of 4410 4411 %% get_simple_table_if_used/2 should find out whether there are any 4412 %% component relation constraints in the entire tree of Cs1 that 4413 %% relates to this level. It returns information about the simple 4414 %% table constraint necessary for the the call to 4415 %% componentrelation_leadingattr/6. The step when the leading 4416 %% attribute and the syntax tree is modified to support the code 4417 %% generating. 4418 case get_simple_table_if_used(S,Cs) of 4419 [] -> {false,CompList}; 4420 STList -> 4421% componentrelation_leadingattr(S,Cs1,Cs2,STList,[],[]) 4422 componentrelation_leadingattr(S,Cs,Cs,STList,[],[]) 4423 end. 4424 4425%% componentrelation_leadingattr/6 when all components are searched 4426%% the new modified components are returned together with the "leading 4427%% attribute" information, which later is stored in the tablecinf 4428%% field in the SEQUENCE/SET record. The "leading attribute" 4429%% information is used to generate the lookup in the object set 4430%% table. The other information gathered in the #type.tablecinf field 4431%% is used in code generating phase too, to recognice the proper 4432%% components for "open type" encoding and to propagate the result of 4433%% the object set lookup when needed. 4434componentrelation_leadingattr(_,[],_CompList,_,[],NewCompList) -> 4435 {false,lists:reverse(NewCompList)}; 4436componentrelation_leadingattr(_,[],_CompList,_,LeadingAttr,NewCompList) -> 4437 {lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later 4438componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) -> 4439 {LAAcc,NewC} = 4440 case catch componentrelation1(S,C#'ComponentType'.typespec, 4441 [C#'ComponentType'.name]) of 4442 {'EXIT',_} -> 4443 {[],C}; 4444 {CRI=[{_A1,_B1,_C1,_D1}|_Rest],NewTSpec} -> 4445 %% {ObjectSet,AtPath,ClassDef,Path} 4446 %% _A1 is a reference to the object set of the 4447 %% component relation constraint. 4448 %% _B1 is the path of names in the at-list of the 4449 %% component relation constraint. 4450 %% _C1 is the class definition of the 4451 %% ObjectClassFieldType. 4452 %% _D1 is the path of components that was traversed to 4453 %% find this constraint. 4454 case leading_attr_index(S,CompList,CRI, 4455 lists:reverse(S#state.abscomppath),[]) of 4456 [] -> 4457 {[],C}; 4458 [{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] -> 4459 OS = object_set_mod_name(S,ObjSet), 4460 UniqueFieldName = 4461 case (catch get_unique_fieldname(#classdef{typespec=ClassDef})) of 4462 {error,'__undefined_'} -> 4463 no_unique; 4464 {asn1,Msg,_} -> 4465 error({type,Msg,S}); 4466 Other -> Other 4467 end, 4468% UsedFieldName = get_used_fieldname(S,Attr,STList), 4469 %% Res should be done differently: even though 4470 %% a unique field name exists it is not 4471 %% certain that the ObjectClassFieldType of 4472 %% the simple table constraint picks that 4473 %% class field. 4474 Res = #simpletableattributes{objectsetname=OS, 4475%% c_name=asn1ct_gen:un_hyphen_var(Attr), 4476 c_name=Attr, 4477 c_index=N, 4478 usedclassfield=UniqueFieldName, 4479 uniqueclassfield=UniqueFieldName, 4480 valueindex=ValueIndex}, 4481 {[Res],C#'ComponentType'{typespec=NewTSpec}} 4482 end; 4483 _ -> 4484 %% no constraint was found 4485 {[],C} 4486 end, 4487 componentrelation_leadingattr(S,Cs,CompList,STList,LAAcc++Acc, 4488 [NewC|CompAcc]). 4489 4490object_set_mod_name(_S,ObjSet) when atom(ObjSet) -> 4491 ObjSet; 4492object_set_mod_name(#state{mname=M}, 4493 #'Externaltypereference'{module=M,type=T}) -> 4494 T; 4495object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) -> 4496 case lists:member(M,S#state.inputmodules) of 4497 true -> 4498 T; 4499 false -> 4500 {M,T} 4501 end. 4502 4503%% get_used_fieldname gets the used field of the class referenced by 4504%% the ObjectClassFieldType construct in the simple table constraint 4505%% corresponding to the component relation constraint that depends on 4506%% it. 4507% get_used_fieldname(_S,CName,[{[CName|_Rest],_,ClFieldName}|_RestSimpleT]) -> 4508% ClFieldName; 4509% get_used_fieldname(S,CName,[_SimpleTC|Rest]) -> 4510% get_used_fieldname(S,CName,Rest); 4511% get_used_fieldname(S,_,[]) -> 4512% error({type,"Error in Simple table constraint",S}). 4513 4514%% any_simple_table/3 checks if any of the components on this level is 4515%% constrained by a simple table constraint. It returns a list of 4516%% tuples with three elements. It is a name path to the place in the 4517%% type structure where the constraint is, and the name of the object 4518%% set and the referenced field in the class. 4519% any_simple_table(S = #state{mname=M,abscomppath=Path}, 4520% [#'ComponentType'{name=Name,typespec=Type}|Cs],Acc) -> 4521% Constraint = Type#type.constraint, 4522% case lists:keysearch(simpletable,1,Constraint) of 4523% {value,{_,#type{def=Ref}}} -> 4524% %% This ObjectClassFieldType, which has a simple table 4525% %% constraint, must pick a fixed type value, mustn't it ? 4526% {ClassDef,[{_,ClassFieldName}]} = Type#type.def, 4527% ST = 4528% case Ref of 4529% #'Externaltypereference'{module=M,type=ObjSetName} -> 4530% {[Name|Path],ObjSetName,ClassFieldName}; 4531% _ -> 4532% {[Name|Path],Ref,ClassFieldName} 4533% end, 4534% any_simple_table(S,Cs,[ST|Acc]); 4535% false -> 4536% any_simple_table(S,Cs,Acc) 4537% end; 4538% any_simple_table(_,[],Acc) -> 4539% lists:reverse(Acc); 4540% any_simple_table(S,[_|Cs],Acc) -> 4541% any_simple_table(S,Cs,Acc). 4542 4543%% get_simple_table_if_used/2 searches the structure of Cs for any 4544%% component relation constraints due to the present level of the 4545%% structure. If there are any, the necessary information for code 4546%% generation of the look up functionality in the object set table are 4547%% returned. 4548get_simple_table_if_used(S,Cs) -> 4549 CNames = lists:map(fun(#'ComponentType'{name=Name}) -> Name; 4550 (_) -> [] %% in case of extension marks 4551 end, 4552 Cs), 4553 RefedSimpleTable=any_component_relation(S,Cs,CNames,[],[]), 4554 get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)). 4555 4556remove_doubles(L) -> 4557 remove_doubles(L,[]). 4558remove_doubles([H|T],Acc) -> 4559 NewT = remove_doubles1(H,T), 4560 remove_doubles(NewT,[H|Acc]); 4561remove_doubles([],Acc) -> 4562 Acc. 4563 4564remove_doubles1(El,L) -> 4565 case lists:delete(El,L) of 4566 L -> L; 4567 NewL -> remove_doubles1(El,NewL) 4568 end. 4569 4570%% get_simple_table_info searches the commponents Cs by the path from 4571%% an at-list (third argument), and follows into a component of it if 4572%% necessary, to get information needed for code generating. 4573%% 4574%% Returns a list of tuples with three elements. It holds a list of 4575%% atoms that is the path, the name of the field of the class that are 4576%% referred to in the ObjectClassFieldType, and the name of the unique 4577%% field of the class of the ObjectClassFieldType. 4578%% 4579% %% The level information outermost/innermost must be kept. There are 4580% %% at least two possibilities to cover here for an outermost case: 1) 4581% %% Both the simple table and the component relation have a common path 4582% %% at least one step below the outermost level, i.e. the leading 4583% %% information shall be on a sub level. 2) They don't have any common 4584% %% path. 4585get_simple_table_info(S,Cs,[AtList|Rest]) -> 4586%% [get_simple_table_info1(S,Cs,AtList,S#state.abscomppath)|get_simple_table_info(S,Cs,Rest)]; 4587 [get_simple_table_info1(S,Cs,AtList,[])|get_simple_table_info(S,Cs,Rest)]; 4588get_simple_table_info(_,_,[]) -> 4589 []. 4590get_simple_table_info1(S,Cs,[Cname|Cnames],Path) when list(Cs) -> 4591 case lists:keysearch(Cname,#'ComponentType'.name,Cs) of 4592 {value,C} -> 4593 get_simple_table_info1(S,C,Cnames,[Cname|Path]); 4594 _ -> 4595 error({type,"Missing expected simple table constraint",S}) 4596 end; 4597get_simple_table_info1(S,#'ComponentType'{typespec=TS},[],Path) -> 4598 %% In this component there must be a simple table constraint 4599 %% o.w. the asn1 code is wrong. 4600 #type{def=OCFT,constraint=Cnstr} = TS, 4601 case Cnstr of 4602 [{simpletable,_OSRef}] -> 4603 #'ObjectClassFieldType'{classname=ClRef, 4604 class=ObjectClass, 4605 fieldname=FieldName} = OCFT, 4606% #'ObjectClassFieldType'{ObjectClass,FieldType} = ObjectClassFieldType, 4607 ObjectClassFieldName = 4608 case FieldName of 4609 {LastFieldName,[]} -> LastFieldName; 4610 {_FirstFieldName,FieldNames} -> 4611 lists:last(FieldNames) 4612 end, 4613 %%ObjectClassFieldName is the last element in the dotted 4614 %%list of the ObjectClassFieldType. The last element may 4615 %%be of another class, that is referenced from the class 4616 %%of the ObjectClassFieldType 4617 ClassDef = 4618 case ObjectClass of 4619 [] -> 4620 {_,CDef}=get_referenced_type(S,ClRef), 4621 CDef; 4622 _ -> #classdef{typespec=ObjectClass} 4623 end, 4624 UniqueName = 4625 case (catch get_unique_fieldname(ClassDef)) of 4626 {error,'__undefined_'} -> no_unique; 4627 {asn1,Msg,_} -> 4628 error({type,Msg,S}); 4629 Other -> Other 4630 end, 4631 {lists:reverse(Path),ObjectClassFieldName,UniqueName}; 4632 _ -> 4633 error({type,{asn1,"missing expected simple table constraint", 4634 Cnstr},S}) 4635 end; 4636get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) -> 4637 Components = get_atlist_components(TS#type.def), 4638 get_simple_table_info1(S,Components,Cnames,Path). 4639 4640%% any_component_relation searches for all component relation 4641%% constraints that refers to the actual level and returns a list of 4642%% the "name path" in the at-list to the component relation constraint 4643%% that must refer to a simple table constraint. The list is empty if 4644%% no component relation constraints were found. 4645%% 4646%% NamePath has the names of all components that are followed from the 4647%% beginning of the search. CNames holds the names of all components 4648%% of the start level, this info is used if an outermost at-notation 4649%% is found to check the validity of the at-list. 4650any_component_relation(S,[C|Cs],CNames,NamePath,Acc) -> 4651 CName = C#'ComponentType'.name, 4652 Type = C#'ComponentType'.typespec, 4653 CRelPath = 4654 case Type#type.constraint of 4655 [{componentrelation,_,AtNotation}] -> 4656 %% Found component relation constraint, now check 4657 %% whether this constraint is relevant for the level 4658 %% where the search started 4659 AtNot = extract_at_notation(AtNotation), 4660 %% evaluate_atpath returns the relative path to the 4661 %% simple table constraint from where the component 4662 %% relation is found. 4663 evaluate_atpath(S#state.abscomppath,NamePath,CNames,AtNot); 4664 _ -> 4665 [] 4666 end, 4667 InnerAcc = 4668 case {Type#type.inlined, 4669 asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of 4670 {no,{constructed,bif}} -> 4671 InnerCs = 4672 case get_components(Type#type.def) of 4673 {IC1,_IC2} -> IC1 ++ IC1; 4674 IC -> IC 4675 end, 4676 %% here we are interested in components of an 4677 %% SEQUENCE/SET OF as well as SEQUENCE, SET and CHOICE 4678 any_component_relation(S,InnerCs,CNames,[CName|NamePath],[]); 4679 _ -> 4680 [] 4681 end, 4682 any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc); 4683any_component_relation(_,[],_,_,Acc) -> 4684 Acc. 4685 4686%% evaluate_atpath/4 finds out whether the at notation refers to the 4687%% search level. The list of referenced names in the AtNot list shall 4688%% begin with a name that exists on the level it refers to. If the 4689%% found AtPath is referring to the same sub-branch as the simple table 4690%% has, then there shall not be any leading attribute info on this 4691%% level. 4692evaluate_atpath(_,[],Cnames,{innermost,AtPath=[Ref|_Refs]}) -> 4693 %% any innermost constraint found deeper in the structure is 4694 %% ignored. 4695 case lists:member(Ref,Cnames) of 4696 true -> [AtPath]; 4697 false -> [] 4698 end; 4699%% In this case must check that the AtPath doesn't step any step of 4700%% the NamePath, in that case the constraint will be handled in an 4701%% inner level. 4702evaluate_atpath(TopPath,NamePath,Cnames,{outermost,AtPath=[_Ref|_Refs]}) -> 4703 AtPathBelowTop = 4704 case TopPath of 4705 [] -> AtPath; 4706 _ -> 4707 case lists:prefix(TopPath,AtPath) of 4708 true -> 4709 lists:subtract(AtPath,TopPath); 4710 _ -> [] 4711 end 4712 end, 4713 case {NamePath,AtPathBelowTop} of 4714 {[H|_T1],[H|_T2]} -> []; % this must be handled in lower level 4715 {_,[]} -> [];% this must be handled in an above level 4716 {_,[H|_T]} -> 4717 case lists:member(H,Cnames) of 4718 true -> [AtPathBelowTop]; 4719 _ -> error({type,{asn1,"failed to analyze at-path",AtPath}}) 4720 end 4721 end; 4722evaluate_atpath(_,_,_,_) -> 4723 []. 4724 4725%% Type may be any of SEQUENCE, SET, CHOICE, SEQUENCE OF, SET OF but 4726%% only the three first have valid components. 4727get_atlist_components(Def) -> 4728 get_components(atlist,Def). 4729 4730get_components(Def) -> 4731 get_components(any,Def). 4732 4733get_components(_,#'SEQUENCE'{components=Cs}) -> 4734 Cs; 4735get_components(_,#'SET'{components=Cs}) -> 4736 Cs; 4737get_components(_,{'CHOICE',Cs}) -> 4738 Cs; 4739get_components(any,{'SEQUENCE OF',#type{def=Def}}) -> 4740 get_components(any,Def); 4741get_components(any,{'SET OF',#type{def=Def}}) -> 4742 get_components(any,Def); 4743get_components(_,_) -> 4744 []. 4745 4746 4747extract_at_notation([{Level,[#'Externalvaluereference'{value=Name}|Rest]}]) -> 4748 {Level,[Name|extract_at_notation1(Rest)]}; 4749extract_at_notation(At) -> 4750 exit({error,{asn1,{at_notation,At}}}). 4751extract_at_notation1([#'Externalvaluereference'{value=Name}|Rest]) -> 4752 [Name|extract_at_notation1(Rest)]; 4753extract_at_notation1([]) -> 4754 []. 4755 4756%% componentrelation1/1 identifies all componentrelation constraints 4757%% that exist in C or in the substructure of C. Info about the found 4758%% constraints are returned in a list. It is ObjectSet, the reference 4759%% to the object set, AttrPath, the name atoms extracted from the 4760%% at-list in the component relation constraint, ClassDef, the 4761%% objectclass record of the class of the ObjectClassFieldType, Path, 4762%% that is the component name "path" from the searched level to this 4763%% constraint. 4764%% 4765%% The function is called with one component of the type in turn and 4766%% with the component name in Path at the first call. When called from 4767%% within, the name of the inner component is added to Path. 4768componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI}, 4769 Path) -> 4770 Ret = 4771 case Constraint of 4772 [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> 4773 [{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList, 4774 %% Note: if Path is longer than one,i.e. it is within 4775 %% an inner type of the actual level, then the only 4776 %% relevant at-list is of "outermost" type. 4777%% #'ObjectClassFieldType'{class=ClassDef} = Def, 4778 ClassDef = get_ObjectClassFieldType_classdef(S,Def), 4779 AtPath = 4780 lists:map(fun(#'Externalvaluereference'{value=V})->V end, 4781 AL), 4782 {[{ObjectSet,AtPath,ClassDef,Path}],Def}; 4783 _Other -> 4784 %% check the inner type of component 4785 innertype_comprel(S,Def,Path) 4786 end, 4787 case Ret of 4788 nofunobj -> 4789 nofunobj; %% ignored by caller 4790 {CRelI=[{ObjSet,_,_,_}],NewDef} -> %% 4791 TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), 4792 {CRelI,C#type{tablecinf=[{objfun,ObjSet}|TCItmp],def=NewDef}}; 4793 {CompRelInf,NewDef} -> %% more than one tuple in CompRelInf 4794 TCItmp = lists:subtract(TCI,[{objfun,anyset}]), 4795 {CompRelInf,C#type{tablecinf=[{objfun,anyset}|TCItmp],def=NewDef}} 4796 end. 4797 4798innertype_comprel(S,{'SEQUENCE OF',Type},Path) -> 4799 case innertype_comprel1(S,Type,Path) of 4800 nofunobj -> 4801 nofunobj; 4802 {CompRelInf,NewType} -> 4803 {CompRelInf,{'SEQUENCE OF',NewType}} 4804 end; 4805innertype_comprel(S,{'SET OF',Type},Path) -> 4806 case innertype_comprel1(S,Type,Path) of 4807 nofunobj -> 4808 nofunobj; 4809 {CompRelInf,NewType} -> 4810 {CompRelInf,{'SET OF',NewType}} 4811 end; 4812innertype_comprel(S,{'CHOICE',CTypeList},Path) -> 4813 case componentlist_comprel(S,CTypeList,[],Path,[]) of 4814 nofunobj -> 4815 nofunobj; 4816 {CompRelInf,NewCs} -> 4817 {CompRelInf,{'CHOICE',NewCs}} 4818 end; 4819innertype_comprel(S,Seq = #'SEQUENCE'{components=Cs},Path) -> 4820 case componentlist_comprel(S,Cs,[],Path,[]) of 4821 nofunobj -> 4822 nofunobj; 4823 {CompRelInf,NewCs} -> 4824 {CompRelInf,Seq#'SEQUENCE'{components=NewCs}} 4825 end; 4826innertype_comprel(S,Set = #'SET'{components=Cs},Path) -> 4827 case componentlist_comprel(S,Cs,[],Path,[]) of 4828 nofunobj -> 4829 nofunobj; 4830 {CompRelInf,NewCs} -> 4831 {CompRelInf,Set#'SET'{components=NewCs}} 4832 end; 4833innertype_comprel(_,_,_) -> 4834 nofunobj. 4835 4836componentlist_comprel(S,[C = #'ComponentType'{name=Name,typespec=Type}|Cs], 4837 Acc,Path,NewCL) -> 4838 case catch componentrelation1(S,Type,Path++[Name]) of 4839 {'EXIT',_} -> 4840 componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); 4841 nofunobj -> 4842 componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); 4843 {CRelInf,NewType} -> 4844 componentlist_comprel(S,Cs,CRelInf++Acc,Path, 4845 [C#'ComponentType'{typespec=NewType}|NewCL]) 4846 end; 4847componentlist_comprel(_,[],Acc,_,NewCL) -> 4848 case Acc of 4849 [] -> 4850 nofunobj; 4851 _ -> 4852 {Acc,lists:reverse(NewCL)} 4853 end. 4854 4855innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) -> 4856 Ret = 4857 case Cons of 4858 [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> 4859 %% This AtList must have an "outermost" at sign to be 4860 %% relevant here. 4861 [{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2] 4862 = AtList, 4863%% #'ObjectClassFieldType'{class=ClassDef} = Def, 4864 ClassDef = get_ObjectClassFieldType_classdef(S,Def), 4865 AtPath = 4866 lists:map(fun(#'Externalvaluereference'{value=V})->V end, 4867 AL), 4868 [{ObjectSet,AtPath,ClassDef,Path}]; 4869 _ -> 4870 innertype_comprel(S,Def,Path) 4871 end, 4872 case Ret of 4873 nofunobj -> nofunobj; 4874 L = [{ObjSet,_,_,_}] -> 4875 TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), 4876 {L,T#type{tablecinf=[{objfun,ObjSet}|TCItmp]}}; 4877 {CRelInf,NewDef} -> 4878 TCItmp = lists:subtract(TCI,[{objfun,anyset}]), 4879 {CRelInf,T#type{def=NewDef,tablecinf=[{objfun,anyset}|TCItmp]}} 4880 end. 4881 4882 4883%% leading_attr_index counts the index and picks the name of the 4884%% component that is at the actual level in the at-list of the 4885%% component relation constraint (AttrP). AbsP is the path of 4886%% component names from the top type level to the actual level. AttrP 4887%% is a list with the atoms from the at-list. 4888leading_attr_index(S,Cs,[H={_,AttrP,_,_}|T],AbsP,Acc) -> 4889 AttrInfo = 4890 case lists:prefix(AbsP,AttrP) of 4891 %% why this ?? It is necessary when in same situation as 4892 %% TConstrChoice, there is an inner structure with an 4893 %% outermost at-list and the "leading attribute" code gen 4894 %% may be at a level some steps below the outermost level. 4895 true -> 4896 RelativAttrP = lists:subtract(AttrP,AbsP), 4897 %% The header is used to calculate the index of the 4898 %% component and to give the fun, received from the 4899 %% object set look up, an unique name. The tail is 4900 %% used to match the proper value input to the fun. 4901 {hd(RelativAttrP),tl(RelativAttrP)}; 4902 false -> 4903 {hd(AttrP),tl(AttrP)} 4904 end, 4905 case leading_attr_index1(S,Cs,H,AttrInfo,1) of 4906 0 -> 4907 leading_attr_index(S,Cs,T,AbsP,Acc); 4908 Res -> 4909 leading_attr_index(S,Cs,T,AbsP,[Res|Acc]) 4910 end; 4911leading_attr_index(_,_Cs,[],_,Acc) -> 4912 lists:reverse(Acc). 4913 4914leading_attr_index1(_,[],_,_,_) -> 4915 0; 4916leading_attr_index1(S,[C|Cs],Arg={ObjectSet,_,CDef,P}, 4917 AttrInfo={Attr,SubAttr},N) -> 4918 case C#'ComponentType'.name of 4919 Attr -> 4920 ValueMatch = value_match(S,C,Attr,SubAttr), 4921 {ObjectSet,Attr,N,CDef,P,ValueMatch}; 4922 _ -> 4923 leading_attr_index1(S,Cs,Arg,AttrInfo,N+1) 4924 end. 4925 4926%% value_math gathers information for a proper value match in the 4927%% generated encode function. For a SEQUENCE or a SET the index of the 4928%% component is counted. For a CHOICE the index is 2. 4929value_match(S,C,Name,SubAttr) -> 4930 value_match(S,C,Name,SubAttr,[]). % C has name Name 4931value_match(_S,#'ComponentType'{},_Name,[],Acc) -> 4932 Acc;% do not reverse, indexes in reverse order 4933value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) -> 4934 InnerType = asn1ct_gen:get_inner(Type#type.def), 4935 Components = 4936 case get_atlist_components(Type#type.def) of 4937 [] -> error({type,{asn1,"element in at list must be a " 4938 "SEQUENCE, SET or CHOICE.",Name},S}); 4939 Comps -> Comps 4940 end, 4941 {Index,ValueIndex} = component_value_index(S,InnerType,At,Components), 4942 value_match(S,lists:nth(Index,Components),At,Ats,[ValueIndex|Acc]). 4943 4944component_value_index(S,'CHOICE',At,Components) -> 4945 {component_index(S,At,Components),2}; 4946component_value_index(S,_,At,Components) -> 4947 %% SEQUENCE or SET 4948 Index = component_index(S,At,Components), 4949 {Index,{Index+1,At}}. 4950 4951component_index(S,Name,Components) -> 4952 component_index1(S,Name,Components,1). 4953component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) -> 4954 N; 4955component_index1(S,Name,[_C|Cs],N) -> 4956 component_index1(S,Name,Cs,N+1); 4957component_index1(S,Name,[],_) -> 4958 error({type,{asn1,"component of at-list was not" 4959 " found in substructure",Name},S}). 4960 4961get_unique_fieldname(ClassDef) -> 4962%% {_,Fields,_} = ClassDef#classdef.typespec, 4963 Fields = (ClassDef#classdef.typespec)#objectclass.fields, 4964 get_unique_fieldname(Fields,[]). 4965 4966get_unique_fieldname([],[]) -> 4967 throw({error,'__undefined_'}); 4968get_unique_fieldname([],[Name]) -> 4969 Name; 4970get_unique_fieldname([],Acc) -> 4971 throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc}); 4972get_unique_fieldname([{fixedtypevaluefield,Name,_,'UNIQUE',_}|Rest],Acc) -> 4973 get_unique_fieldname(Rest,[Name|Acc]); 4974get_unique_fieldname([_H|T],Acc) -> 4975 get_unique_fieldname(T,Acc). 4976 4977get_tableconstraint_info(S,Type,{CheckedTs,EComps}) -> 4978 {get_tableconstraint_info(S,Type,CheckedTs,[]), 4979 get_tableconstraint_info(S,Type,EComps,[])}; 4980get_tableconstraint_info(S,Type,CheckedTs) -> 4981 get_tableconstraint_info(S,Type,CheckedTs,[]). 4982 4983get_tableconstraint_info(_S,_Type,[],Acc) -> 4984 lists:reverse(Acc); 4985get_tableconstraint_info(S,Type,[C|Cs],Acc) -> 4986 CheckedTs = C#'ComponentType'.typespec, 4987 AccComp = 4988 case CheckedTs#type.def of 4989 %% ObjectClassFieldType 4990 OCFT=#'ObjectClassFieldType'{class=#objectclass{}, 4991 type=_AType} -> 4992% AType = get_ObjectClassFieldType(S,Fields,FieldRef), 4993% RefedFieldName = 4994% get_referencedclassfield(CheckedTs#type.def),%is probably obsolete 4995 NewOCFT = 4996 OCFT#'ObjectClassFieldType'{class=[]}, 4997 C#'ComponentType'{typespec= 4998 CheckedTs#type{ 4999% def=AType, 5000 def=NewOCFT 5001 }}; 5002% constraint=[{tableconstraint_info, 5003% FieldRef}]}}; 5004 {'SEQUENCE OF',SOType} when record(SOType,type), 5005 (element(1,SOType#type.def)=='CHOICE') -> 5006 CTypeList = element(2,SOType#type.def), 5007 NewInnerCList = 5008 get_tableconstraint_info(S,Type,CTypeList,[]), 5009 C#'ComponentType'{typespec= 5010 CheckedTs#type{ 5011 def={'SEQUENCE OF', 5012 SOType#type{def={'CHOICE', 5013 NewInnerCList}}}}}; 5014 {'SET OF',SOType} when record(SOType,type), 5015 (element(1,SOType#type.def)=='CHOICE') -> 5016 CTypeList = element(2,SOType#type.def), 5017 NewInnerCList = 5018 get_tableconstraint_info(S,Type,CTypeList,[]), 5019 C#'ComponentType'{typespec= 5020 CheckedTs#type{ 5021 def={'SET OF', 5022 SOType#type{def={'CHOICE', 5023 NewInnerCList}}}}}; 5024 _ -> 5025 C 5026 end, 5027 get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]). 5028 5029get_referenced_fieldname([{_,FirstFieldname}]) -> 5030 {FirstFieldname,[]}; 5031get_referenced_fieldname([{_,FirstFieldname}|Rest]) -> 5032 {FirstFieldname,lists:map(fun(X)->element(2,X) end,Rest)}; 5033get_referenced_fieldname(Def) -> 5034 {no_type,Def}. 5035 5036%% get_ObjectClassFieldType extracts the type from the chain of 5037%% objects that leads to a final type. 5038get_ObjectClassFieldType(S,ERef,PrimFieldNameList) when 5039 record(ERef,'Externaltypereference') -> 5040 {_,Type} = get_referenced_type(S,ERef), 5041 ClassSpec = check_class(S,Type), 5042 Fields = ClassSpec#objectclass.fields, 5043 get_ObjectClassFieldType(S,Fields,PrimFieldNameList); 5044get_ObjectClassFieldType(S,Fields,L=[_PrimFieldName1|_Rest]) -> 5045 check_PrimitiveFieldNames(S,Fields,L), 5046 get_OCFType(S,Fields,L). 5047 5048check_PrimitiveFieldNames(_S,_Fields,_) -> 5049 ok. 5050 5051%% get_ObjectClassFieldType_classdef gets the def of the class of the 5052%% ObjectClassFieldType, i.e. the objectclass record. If the type has 5053%% been checked (it may be a field type of an internal SEQUENCE) the 5054%% class field = [], then the classdef has to be fetched by help of 5055%% the class reference in the classname field. 5056get_ObjectClassFieldType_classdef(S,#'ObjectClassFieldType'{classname=Name, 5057 class=[]}) -> 5058 {_,#classdef{typespec=TS}} = get_referenced_type(S,Name), 5059 TS; 5060get_ObjectClassFieldType_classdef(_,#'ObjectClassFieldType'{class=Cl}) -> 5061 Cl. 5062 5063get_OCFType(S,Fields,[{_FieldType,PrimFieldName}|Rest]) -> 5064 case lists:keysearch(PrimFieldName,2,Fields) of 5065 {value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} -> 5066 {fixedtypevaluefield,PrimFieldName,Type}; 5067 {value,{objectfield,_,Type,_Unique,_OptSpec}} -> 5068 {_,ClassDef} = get_referenced_type(S,Type#type.def), 5069 CheckedCDef = check_class(S#state{type=ClassDef, 5070 tname=ClassDef#classdef.name}, 5071 ClassDef#classdef.typespec), 5072 get_OCFType(S,CheckedCDef#objectclass.fields,Rest); 5073 {value,{objectsetfield,_,Type,_OptSpec}} -> 5074 {_,ClassDef} = get_referenced_type(S,Type#type.def), 5075 CheckedCDef = check_class(S#state{type=ClassDef, 5076 tname=ClassDef#classdef.name}, 5077 ClassDef#classdef.typespec), 5078 get_OCFType(S,CheckedCDef#objectclass.fields,Rest); 5079 5080 {value,Other} -> 5081 {element(1,Other),PrimFieldName}; 5082 _ -> 5083 error({type,"undefined FieldName in ObjectClassFieldType",S}) 5084 end. 5085 5086get_taglist(#state{erule=per},_) -> 5087 []; 5088get_taglist(#state{erule=per_bin},_) -> 5089 []; 5090get_taglist(S,Ext) when record(Ext,'Externaltypereference') -> 5091 {_,T} = get_referenced_type(S,Ext), 5092 get_taglist(S,T#typedef.typespec); 5093get_taglist(S,Tref) when record(Tref,typereference) -> 5094 {_,T} = get_referenced_type(S,Tref), 5095 get_taglist(S,T#typedef.typespec); 5096get_taglist(S,Type) when record(Type,type) -> 5097 case Type#type.tag of 5098 [] -> 5099 get_taglist(S,Type#type.def); 5100 [Tag|_] -> 5101% case lists:member(S#state.erule,[ber,ber_bin]) of 5102% true -> 5103% lists:map(fun(Tx) -> asn1ct_gen:def_to_tag(Tx) end,Type#type.tag); 5104% _ -> 5105 [asn1ct_gen:def_to_tag(Tag)] 5106% end 5107 end; 5108get_taglist(S,{'CHOICE',{Rc,Ec}}) -> 5109 get_taglist(S,{'CHOICE',Rc ++ Ec}); 5110get_taglist(S,{'CHOICE',Components}) -> 5111 get_taglist1(S,Components); 5112%% ObjectClassFieldType OTP-4390 5113get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) -> 5114 []; 5115get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) -> 5116 get_taglist(S,Type); 5117get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList}) 5118 when list(FieldNameList) -> 5119 case get_ObjectClassFieldType(S,ERef,FieldNameList) of 5120 Type when record(Type,type) -> 5121 get_taglist(S,Type); 5122 {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); 5123 {TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed 5124 end; 5125get_taglist(S,{ObjCl,FieldNameList}) when record(ObjCl,objectclass), 5126 list(FieldNameList) -> 5127 case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of 5128 Type when record(Type,type) -> 5129 get_taglist(S,Type); 5130 {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); 5131 {TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed 5132 end; 5133get_taglist(S,Def) -> 5134 case lists:member(S#state.erule,[ber_bin_v2]) of 5135 false -> 5136 case Def of 5137 'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such 5138 []; 5139 _ -> 5140 [asn1ct_gen:def_to_tag(Def)] 5141 end; 5142 _ -> 5143 [] 5144 end. 5145 5146get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when list(TagL) -> 5147 %% tag_list has been here , just return TagL and continue with next alternative 5148 TagL ++ get_taglist1(S,Rest); 5149get_taglist1(S,[#'ComponentType'{typespec=Ts,tags=undefined}|Rest]) -> 5150 get_taglist(S,Ts) ++ get_taglist1(S,Rest); 5151get_taglist1(S,[_H|Rest]) -> % skip EXTENSIONMARK 5152 get_taglist1(S,Rest); 5153get_taglist1(_S,[]) -> 5154 []. 5155 5156dbget_ex(_S,Module,Key) -> 5157 case asn1_db:dbget(Module,Key) of 5158 undefined -> 5159 5160 throw({error,{asn1,{undefined,{Module,Key}}}}); % this is catched on toplevel type or value 5161 T -> T 5162 end. 5163 5164merge_tags(T1, T2) when list(T2) -> 5165 merge_tags2(T1 ++ T2, []); 5166merge_tags(T1, T2) -> 5167 merge_tags2(T1 ++ [T2], []). 5168 5169merge_tags2([T1= #tag{type='IMPLICIT'}, T2 |Rest], Acc) -> 5170 merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); 5171merge_tags2([T1= #tag{type={default,'IMPLICIT'}}, T2 |Rest], Acc) -> 5172 merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); 5173merge_tags2([H|T],Acc) -> 5174 merge_tags2(T, [H|Acc]); 5175merge_tags2([], Acc) -> 5176 lists:reverse(Acc). 5177 5178merge_constraints(C1, []) -> 5179 C1; 5180merge_constraints([], C2) -> 5181 C2; 5182merge_constraints(C1, C2) -> 5183 {SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]), 5184 SizeC = merge_constraints(SList), 5185 ValueC = merge_constraints(VList), 5186 PermAlphaC = merge_constraints(PAList), 5187 case Rest of 5188 [] -> 5189 SizeC ++ ValueC ++ PermAlphaC; 5190 _ -> 5191 throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}}) 5192 end. 5193 5194merge_constraints([]) -> []; 5195merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2, 5196 High1 =< High2 -> 5197 merge_constraints([C1|Rest]); 5198merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) -> 5199 [C1|merge_constraints([C2|Rest])]; 5200merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) -> 5201 throw({error,asn1,{conflicting_constraints,{C1,C2}}}); 5202merge_constraints([C]) -> 5203 [C]. 5204 5205splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> 5206 splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc); 5207splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> 5208 splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc); 5209splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> 5210 splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc); 5211splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) -> 5212 splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]); 5213splitlist([],Sacc,Vacc,PAacc,Restacc) -> 5214 {lists:reverse(Sacc), 5215 lists:reverse(Vacc), 5216 lists:reverse(PAacc), 5217 lists:reverse(Restacc)}. 5218 5219 5220 5221storeindb(M) when record(M,module) -> 5222 TVlist = M#module.typeorval, 5223 NewM = M#module{typeorval=findtypes_and_values(TVlist)}, 5224 asn1_db:dbnew(NewM#module.name), 5225 asn1_db:dbput(NewM#module.name,'MODULE', NewM), 5226 Res = storeindb(NewM#module.name,TVlist,[]), 5227 include_default_class(NewM#module.name), 5228 include_default_type(NewM#module.name), 5229 Res. 5230 5231storeindb(Module,[H|T],ErrAcc) when record(H,typedef) -> 5232 storeindb(Module,H#typedef.name,H,T,ErrAcc); 5233storeindb(Module,[H|T],ErrAcc) when record(H,valuedef) -> 5234 storeindb(Module,H#valuedef.name,H,T,ErrAcc); 5235storeindb(Module,[H|T],ErrAcc) when record(H,ptypedef) -> 5236 storeindb(Module,H#ptypedef.name,H,T,ErrAcc); 5237storeindb(Module,[H|T],ErrAcc) when record(H,classdef) -> 5238 storeindb(Module,H#classdef.name,H,T,ErrAcc); 5239storeindb(Module,[H|T],ErrAcc) when record(H,pvaluesetdef) -> 5240 storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc); 5241storeindb(Module,[H|T],ErrAcc) when record(H,pobjectdef) -> 5242 storeindb(Module,H#pobjectdef.name,H,T,ErrAcc); 5243storeindb(Module,[H|T],ErrAcc) when record(H,pvaluedef) -> 5244 storeindb(Module,H#pvaluedef.name,H,T,ErrAcc); 5245storeindb(_,[],[]) -> ok; 5246storeindb(_,[],ErrAcc) -> 5247 {error,ErrAcc}. 5248 5249storeindb(Module,Name,H,T,ErrAcc) -> 5250 case asn1_db:dbget(Module,Name) of 5251 undefined -> 5252 asn1_db:dbput(Module,Name,H), 5253 storeindb(Module,T,ErrAcc); 5254 _ -> 5255 case H of 5256 _Type when record(H,typedef) -> 5257 error({type,"already defined", 5258 #state{mname=Module,type=H,tname=Name}}); 5259 _Type when record(H,valuedef) -> 5260 error({value,"already defined", 5261 #state{mname=Module,value=H,vname=Name}}); 5262 _Type when record(H,ptypedef) -> 5263 error({ptype,"already defined", 5264 #state{mname=Module,type=H,tname=Name}}); 5265 _Type when record(H,pobjectdef) -> 5266 error({ptype,"already defined", 5267 #state{mname=Module,type=H,tname=Name}}); 5268 _Type when record(H,pvaluesetdef) -> 5269 error({ptype,"already defined", 5270 #state{mname=Module,type=H,tname=Name}}); 5271 _Type when record(H,pvaluedef) -> 5272 error({ptype,"already defined", 5273 #state{mname=Module,type=H,tname=Name}}); 5274 _Type when record(H,classdef) -> 5275 error({class,"already defined", 5276 #state{mname=Module,value=H,vname=Name}}) 5277 end, 5278 storeindb(Module,T,[H|ErrAcc]) 5279 end. 5280 5281findtypes_and_values(TVList) -> 5282 findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values, 5283%% Parameterizedtypes,Classes,Objects and ObjectSets 5284 5285findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5286 when record(H,typedef),record(H#typedef.typespec,'Object') -> 5287 findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#typedef.name|Oacc],OSacc); 5288findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5289 when record(H,typedef),record(H#typedef.typespec,'ObjectSet') -> 5290 findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#typedef.name|OSacc]); 5291findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5292 when record(H,typedef) -> 5293 findtypes_and_values(T,[H#typedef.name|Tacc],Vacc,Pacc,Cacc,Oacc,OSacc); 5294findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5295 when record(H,valuedef) -> 5296 findtypes_and_values(T,Tacc,[H#valuedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); 5297findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5298 when record(H,ptypedef) -> 5299 findtypes_and_values(T,Tacc,Vacc,[H#ptypedef.name|Pacc],Cacc,Oacc,OSacc); 5300findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5301 when record(H,classdef) -> 5302 findtypes_and_values(T,Tacc,Vacc,Pacc,[H#classdef.name|Cacc],Oacc,OSacc); 5303findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5304 when record(H,pvaluedef) -> 5305 findtypes_and_values(T,Tacc,[H#pvaluedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); 5306findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5307 when record(H,pvaluesetdef) -> 5308 findtypes_and_values(T,Tacc,[H#pvaluesetdef.name|Vacc],Pacc,Cacc,Oacc,OSacc); 5309findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5310 when record(H,pobjectdef) -> 5311 findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#pobjectdef.name|Oacc],OSacc); 5312findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) 5313 when record(H,pobjectsetdef) -> 5314 findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#pobjectsetdef.name|OSacc]); 5315findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) -> 5316 {lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc), 5317 lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}. 5318 5319 5320 5321error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> 5322 Pos = Ref#'Externaltypereference'.pos, 5323 io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]), 5324 {error,{export,Pos,Mname,Typename,Msg}}; 5325error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) 5326 when record(Type,typedef) -> 5327 io:format("asn1error:~p:~p:~p ~p~n", 5328 [Type#typedef.pos,Mname,Typename,Msg]), 5329 {error,{type,Type#typedef.pos,Mname,Typename,Msg}}; 5330error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) 5331 when record(Type,ptypedef) -> 5332 io:format("asn1error:~p:~p:~p ~p~n", 5333 [Type#ptypedef.pos,Mname,Typename,Msg]), 5334 {error,{type,Type#ptypedef.pos,Mname,Typename,Msg}}; 5335error({type,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) 5336 when record(Value,valuedef) -> 5337 io:format("asn1error:~p:~p:~p ~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]), 5338 {error,{type,Value#valuedef.pos,Mname,Valuename,Msg}}; 5339error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) 5340 when record(Type,pobjectdef) -> 5341 io:format("asn1error:~p:~p:~p ~p~n", 5342 [Type#pobjectdef.pos,Mname,Typename,Msg]), 5343 {error,{type,Type#pobjectdef.pos,Mname,Typename,Msg}}; 5344error({value,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) -> 5345 io:format("asn1error:~p:~p:~p ~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]), 5346 {error,{value,Value#valuedef.pos,Mname,Valuename,Msg}}; 5347error({Other,Msg,#state{mname=Mname,value=#valuedef{pos=Pos},vname=Valuename}}) -> 5348 io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Valuename,Msg]), 5349 {error,{Other,Pos,Mname,Valuename,Msg}}; 5350error({Other,Msg,#state{mname=Mname,type=#typedef{pos=Pos},tname=Typename}}) -> 5351 io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]), 5352 {error,{Other,Pos,Mname,Typename,Msg}}; 5353error({Other,Msg,#state{mname=Mname,type=#classdef{pos=Pos},tname=Typename}}) -> 5354 io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]), 5355 {error,{Other,Pos,Mname,Typename,Msg}}. 5356 5357include_default_type(Module) -> 5358 NameAbsList = default_type_list(), 5359 include_default_type1(Module,NameAbsList). 5360 5361include_default_type1(_,[]) -> 5362 ok; 5363include_default_type1(Module,[{Name,TS}|Rest]) -> 5364 case asn1_db:dbget(Module,Name) of 5365 undefined -> 5366 T = #typedef{name=Name, 5367 typespec=TS}, 5368 asn1_db:dbput(Module,Name,T); 5369 _ -> ok 5370 end, 5371 include_default_type1(Module,Rest). 5372 5373default_type_list() -> 5374 %% The EXTERNAL type is represented, according to ASN.1 1997, 5375 %% as a SEQUENCE with components: identification, data-value-descriptor 5376 %% and data-value. 5377 Syntax = 5378 #'ComponentType'{name=syntax, 5379 typespec=#type{def='OBJECT IDENTIFIER'}, 5380 prop=mandatory}, 5381 Presentation_Cid = 5382 #'ComponentType'{name='presentation-context-id', 5383 typespec=#type{def='INTEGER'}, 5384 prop=mandatory}, 5385 Transfer_syntax = 5386 #'ComponentType'{name='transfer-syntax', 5387 typespec=#type{def='OBJECT IDENTIFIER'}, 5388 prop=mandatory}, 5389 Negotiation_items = 5390 #type{def= 5391 #'SEQUENCE'{components= 5392 [Presentation_Cid, 5393 Transfer_syntax#'ComponentType'{prop=mandatory}]}}, 5394 Context_negot = 5395 #'ComponentType'{name='context-negotiation', 5396 typespec=Negotiation_items, 5397 prop=mandatory}, 5398 5399 Data_value_descriptor = 5400 #'ComponentType'{name='data-value-descriptor', 5401 typespec=#type{def='ObjectDescriptor'}, 5402 prop='OPTIONAL'}, 5403 Data_value = 5404 #'ComponentType'{name='data-value', 5405 typespec=#type{def='OCTET STRING'}, 5406 prop=mandatory}, 5407 5408 %% The EXTERNAL type is represented, according to ASN.1 1990, 5409 %% as a SEQUENCE with components: direct-reference, indirect-reference, 5410 %% data-value-descriptor and encoding. 5411 5412 Direct_reference = 5413 #'ComponentType'{name='direct-reference', 5414 typespec=#type{def='OBJECT IDENTIFIER'}, 5415 prop='OPTIONAL'}, 5416 5417 Indirect_reference = 5418 #'ComponentType'{name='indirect-reference', 5419 typespec=#type{def='INTEGER'}, 5420 prop='OPTIONAL'}, 5421 5422 Single_ASN1_type = 5423 #'ComponentType'{name='single-ASN1-type', 5424 typespec=#type{tag=[{tag,'CONTEXT',0, 5425 'EXPLICIT',32}], 5426 def='ANY'}, 5427 prop=mandatory}, 5428 5429 Octet_aligned = 5430 #'ComponentType'{name='octet-aligned', 5431 typespec=#type{tag=[{tag,'CONTEXT',1, 5432 'IMPLICIT',32}], 5433 def='OCTET STRING'}, 5434 prop=mandatory}, 5435 5436 Arbitrary = 5437 #'ComponentType'{name=arbitrary, 5438 typespec=#type{tag=[{tag,'CONTEXT',2, 5439 'IMPLICIT',32}], 5440 def={'BIT STRING',[]}}, 5441 prop=mandatory}, 5442 5443 Encoding = 5444 #'ComponentType'{name=encoding, 5445 typespec=#type{def={'CHOICE', 5446 [Single_ASN1_type,Octet_aligned, 5447 Arbitrary]}}, 5448 prop=mandatory}, 5449 5450 EXTERNAL_components1990 = 5451 [Direct_reference,Indirect_reference,Data_value_descriptor,Encoding], 5452 5453 %% The EMBEDDED PDV type is represented by a SEQUENCE type 5454 %% with components: identification and data-value 5455 Abstract = 5456 #'ComponentType'{name=abstract, 5457 typespec=#type{def='OBJECT IDENTIFIER'}, 5458 prop=mandatory}, 5459 Transfer = 5460 #'ComponentType'{name=transfer, 5461 typespec=#type{def='OBJECT IDENTIFIER'}, 5462 prop=mandatory}, 5463 AbstractTrSeq = 5464 #'SEQUENCE'{components=[Abstract,Transfer]}, 5465 Syntaxes = 5466 #'ComponentType'{name=syntaxes, 5467 typespec=#type{def=AbstractTrSeq}, 5468 prop=mandatory}, 5469 Fixed = #'ComponentType'{name=fixed, 5470 typespec=#type{def='NULL'}, 5471 prop=mandatory}, 5472 Negotiations = 5473 [Syntaxes,Syntax,Presentation_Cid,Context_negot, 5474 Transfer_syntax,Fixed], 5475 Identification2 = 5476 #'ComponentType'{name=identification, 5477 typespec=#type{def={'CHOICE',Negotiations}}, 5478 prop=mandatory}, 5479 EmbeddedPdv_components = 5480 [Identification2,Data_value], 5481 5482 %% The CHARACTER STRING type is represented by a SEQUENCE type 5483 %% with components: identification and string-value 5484 String_value = 5485 #'ComponentType'{name='string-value', 5486 typespec=#type{def='OCTET STRING'}, 5487 prop=mandatory}, 5488 CharacterString_components = 5489 [Identification2,String_value], 5490 5491 [{'EXTERNAL', 5492 #type{tag=[#tag{class='UNIVERSAL', 5493 number=8, 5494 type='IMPLICIT', 5495 form=32}], 5496 def=#'SEQUENCE'{components= 5497 EXTERNAL_components1990}}}, 5498 {'EMBEDDED PDV', 5499 #type{tag=[#tag{class='UNIVERSAL', 5500 number=11, 5501 type='IMPLICIT', 5502 form=32}], 5503 def=#'SEQUENCE'{components=EmbeddedPdv_components}}}, 5504 {'CHARACTER STRING', 5505 #type{tag=[#tag{class='UNIVERSAL', 5506 number=29, 5507 type='IMPLICIT', 5508 form=32}], 5509 def=#'SEQUENCE'{components=CharacterString_components}}} 5510 ]. 5511 5512 5513include_default_class(Module) -> 5514 NameAbsList = default_class_list(), 5515 include_default_class1(Module,NameAbsList). 5516 5517include_default_class1(_,[]) -> 5518 ok; 5519include_default_class1(Module,[{Name,TS}|_Rest]) -> 5520 case asn1_db:dbget(Module,Name) of 5521 undefined -> 5522 C = #classdef{checked=true,name=Name, 5523 typespec=TS}, 5524 asn1_db:dbput(Module,Name,C); 5525 _ -> ok 5526 end. 5527 5528default_class_list() -> 5529 [{'TYPE-IDENTIFIER', 5530 {objectclass, 5531 [{fixedtypevaluefield, 5532 id, 5533 {type,[],'OBJECT IDENTIFIER',[]}, 5534 'UNIQUE', 5535 'MANDATORY'}, 5536 {typefield,'Type','MANDATORY'}], 5537 {'WITH SYNTAX', 5538 [{typefieldreference,'Type'}, 5539 'IDENTIFIED', 5540 'BY', 5541 {valuefieldreference,id}]}}}, 5542 {'ABSTRACT-SYNTAX', 5543 {objectclass, 5544 [{fixedtypevaluefield, 5545 id, 5546 {type,[],'OBJECT IDENTIFIER',[]}, 5547 'UNIQUE', 5548 'MANDATORY'}, 5549 {typefield,'Type','MANDATORY'}, 5550 {fixedtypevaluefield, 5551 property, 5552 {type, 5553 [], 5554 {'BIT STRING',[]}, 5555 []}, 5556 undefined, 5557 {'DEFAULT', 5558 [0,1,0]}}], 5559 {'WITH SYNTAX', 5560 [{typefieldreference,'Type'}, 5561 'IDENTIFIED', 5562 'BY', 5563 {valuefieldreference,id}, 5564 ['HAS', 5565 'PROPERTY', 5566 {valuefieldreference,property}]]}}}]. 5567