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_gen_ber.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ 18-module(asn1ct_gen_ber). 19 20%% Generate erlang module which handles (PER) encode and decode for 21%% all types in an ASN.1 module 22 23-include("asn1_records.hrl"). 24 25-export([pgen/4]). 26-export([decode_class/1, decode_type/1]). 27-export([add_removed_bytes/0]). 28-export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]). 29-export([gen_encode_prim/4]). 30-export([gen_dec_prim/8]). 31-export([gen_objectset_code/2, gen_obj_code/3]). 32-export([re_wrap_erule/1]). 33-export([unused_var/2]). 34 35-import(asn1ct_gen, [emit/1,demit/1]). 36 37 % the encoding of class of tag bits 8 and 7 38-define(UNIVERSAL, 0). 39-define(APPLICATION, 16#40). 40-define(CONTEXT, 16#80). 41-define(PRIVATE, 16#C0). 42 43 % primitive or constructed encoding % bit 6 44-define(PRIMITIVE, 0). 45-define(CONSTRUCTED, 2#00100000). 46 47 48-define(T_ObjectDescriptor, ?UNIVERSAL bor ?PRIMITIVE bor 7). 49 % restricted character string types 50-define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed 51-define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed 52-define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed 53-define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed 54-define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed 55-define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed 56-define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed 57-define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed 58 59%% pgen(Erules, Module, TypeOrVal) 60%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module 61%% .hrl file is only generated if necessary 62%% Erules = per | ber 63%% Module = atom() 64%% TypeOrVal = {TypeList,ValueList,PTypeList} 65%% TypeList = ValueList = [atom()] 66 67pgen(OutFile,Erules,Module,TypeOrVal) -> 68 asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). 69 70 71%%=============================================================================== 72%%=============================================================================== 73%%=============================================================================== 74%% Generate ENCODING 75%%=============================================================================== 76%%=============================================================================== 77%%=============================================================================== 78 79%%=============================================================================== 80%% encode #{typedef, {pos, name, typespec}} 81%%=============================================================================== 82 83gen_encode(Erules,Type) when record(Type,typedef) -> 84 gen_encode_user(Erules,Type). 85 86%%=============================================================================== 87%% encode #{type, {tag, def, constraint}} 88%%=============================================================================== 89 90gen_encode(Erules,Typename,Type) when record(Type,type) -> 91 InnerType = asn1ct_gen:get_inner(Type#type.def), 92 ObjFun = 93 case lists:keysearch(objfun,1,Type#type.tablecinf) of 94 {value,{_,_Name}} -> 95 ", ObjFun"; 96 false -> 97 "" 98 end, 99 case asn1ct_gen:type(InnerType) of 100 {constructed,bif} -> 101 emit([nl,nl,nl,"%%================================"]), 102 emit([nl,"%% ",asn1ct_gen:list2name(Typename)]), 103 emit([nl,"%%================================",nl]), 104 case lists:member(InnerType,['SET','SEQUENCE']) of 105 true -> 106 case get(asn_keyed_list) of 107 true -> 108 CompList = 109 case Type#type.def of 110 #'SEQUENCE'{components=Cl} -> Cl; 111 #'SET'{components=Cl} -> Cl 112 end, 113 emit([nl,"'enc_",asn1ct_gen:list2name(Typename), 114 "'(Val, TagIn",ObjFun, 115 ") when list(Val) ->",nl]), 116 emit([" 'enc_",asn1ct_gen:list2name(Typename), 117 "'(?RT_BER:fixoptionals(", 118 {asis,optionals(CompList)}, 119 ",Val), TagIn",ObjFun,");",nl,nl]); 120 _ -> true 121 end; 122 _ -> 123 emit([nl,"'enc_",asn1ct_gen:list2name(Typename), 124 "'({'",asn1ct_gen:list2name(Typename), 125 "',Val}, TagIn",ObjFun,") ->",nl]), 126 emit([" 'enc_",asn1ct_gen:list2name(Typename), 127 "'(Val, TagIn",ObjFun,");",nl,nl]) 128 end, 129 emit(["'enc_",asn1ct_gen:list2name(Typename), 130 "'(Val, TagIn",ObjFun,") ->",nl," "]), 131 asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); 132 _ -> 133 true 134 end; 135 136%%=============================================================================== 137%% encode ComponentType 138%%=============================================================================== 139 140gen_encode(Erules,Tname,{'ComponentType',_Pos,Cname,Type,_,_}) -> 141 NewTname = [Cname|Tname], 142 %% The tag is set to [] to avoid that it is 143 %% taken into account twice, both as a component/alternative (passed as 144 %% argument to the encode decode function and within the encode decode 145 %% function it self. 146 NewType = Type#type{tag=[]}, 147 gen_encode(Erules,NewTname,NewType). 148 149gen_encode_user(Erules,D) when record(D,typedef) -> 150 Typename = [D#typedef.name], 151 Type = D#typedef.typespec, 152 InnerType = asn1ct_gen:get_inner(Type#type.def), 153 OTag = Type#type.tag, 154 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 155 emit([nl,nl,"%%================================"]), 156 emit([nl,"%% ",Typename]), 157 emit([nl,"%%================================",nl]), 158 case lists:member(InnerType,['SET','SEQUENCE']) of 159 true -> 160 case get(asn_keyed_list) of 161 true -> 162 CompList = 163 case Type#type.def of 164 #'SEQUENCE'{components=Cl} -> Cl; 165 #'SET'{components=Cl} -> Cl 166 end, 167 168 emit([nl,"'enc_",asn1ct_gen:list2name(Typename), 169 "'(Val, TagIn) when list(Val) ->",nl]), 170 emit([" 'enc_",asn1ct_gen:list2name(Typename), 171 "'(?RT_BER:fixoptionals(", 172 {asis,optionals(CompList)}, 173 ",Val), TagIn);",nl,nl]); 174 _ -> true 175 end; 176 _ -> 177 emit({nl,"'enc_",asn1ct_gen:list2name(Typename), 178 "'({'",asn1ct_gen:list2name(Typename),"',Val}, TagIn) ->",nl}), 179 emit({" 'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn);",nl,nl}) 180 end, 181 emit({"'enc_",asn1ct_gen:list2name(Typename),"'(", 182 unused_var("Val",Type#type.def),", TagIn) ->",nl}), 183 CurrentMod = get(currmod), 184 case asn1ct_gen:type(InnerType) of 185 {constructed,bif} -> 186 asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D); 187 {primitive,bif} -> 188 asn1ct_gen_ber:gen_encode_prim(ber,Type,["TagIn ++ ", 189 {asis,Tag}],"Val"), 190 emit([".",nl]); 191 #typereference{val=Ename} -> 192 emit([" 'enc_",Ename,"'(Val, TagIn ++ ",{asis,Tag},").",nl]); 193 #'Externaltypereference'{module=CurrentMod,type=Etype} -> 194 emit([" 'enc_",Etype,"'(Val, TagIn ++ ", 195 {asis,Tag},").",nl]); 196 #'Externaltypereference'{module=Emod,type=Etype} -> 197 emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn ++ ", 198 {asis,Tag},").",nl]); 199 'ASN1_OPEN_TYPE' -> 200 emit(["%% OPEN TYPE",nl]), 201 asn1ct_gen_ber:gen_encode_prim(ber, 202 Type#type{def='ASN1_OPEN_TYPE'}, 203 ["TagIn ++ ", 204 {asis,Tag}],"Val"), 205 emit([".",nl]) 206 end. 207 208unused_var(Var,#'SEQUENCE'{components=Cl}) -> 209 unused_var1(Var,Cl); 210unused_var(Var,#'SET'{components=Cl}) -> 211 unused_var1(Var,Cl); 212unused_var(Var,_) -> 213 Var. 214unused_var1(Var,Cs) when Cs == []; Cs == {[],[]} -> 215 lists:concat(["_",Var]); 216unused_var1(Var,_) -> 217 Var. 218 219unused_optormand_var(Var,Def) -> 220 case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of 221 'ASN1_OPEN_TYPE' -> 222 lists:concat(["_",Var]); 223 _ -> 224 Var 225 end. 226 227 228gen_encode_prim(_Erules,D,DoTag,Value) when record(D,type) -> 229 230%%% Currently not used for BER (except for BitString) and therefore replaced 231%%% with [] as a placeholder 232 BitStringConstraint = D#type.constraint, 233 Constraint = [], 234 asn1ct_name:new(enumval), 235 case D#type.def of 236 'BOOLEAN' -> 237 emit_encode_func('boolean',Value,DoTag); 238 'INTEGER' -> 239 emit_encode_func('integer',Constraint,Value,DoTag); 240 {'INTEGER',NamedNumberList} -> 241 emit_encode_func('integer',Constraint,Value, 242 NamedNumberList,DoTag); 243 {'ENUMERATED',NamedNumberList={_,_}} -> 244 245 emit(["case (case ",Value," of {asn1_enum,_}->",Value,";{_,_}->element(2,",Value,");_->", 246 Value," end) of",nl]), 247 emit_enc_enumerated_cases(NamedNumberList,DoTag); 248 {'ENUMERATED',NamedNumberList} -> 249 250 emit(["case (case ",Value," of {_,_}->element(2,",Value,");_->", 251 Value," end) of",nl]), 252 emit_enc_enumerated_cases(NamedNumberList,DoTag); 253 254 {'BIT STRING',NamedNumberList} -> 255 emit_encode_func('bit_string',BitStringConstraint,Value, 256 NamedNumberList,DoTag); 257 'ANY' -> 258 emit_encode_func('open_type', Value,DoTag); 259 'NULL' -> 260 emit_encode_func('null',Value,DoTag); 261 'OBJECT IDENTIFIER' -> 262 emit_encode_func("object_identifier",Value,DoTag); 263 'ObjectDescriptor' -> 264 emit_encode_func('restricted_string',Constraint,Value, 265 ?T_ObjectDescriptor,DoTag); 266 'OCTET STRING' -> 267 emit_encode_func('octet_string',Constraint,Value,DoTag); 268 'NumericString' -> 269 emit_encode_func('restricted_string',Constraint,Value, 270 ?T_NumericString,DoTag); 271 'TeletexString' -> 272 emit_encode_func('restricted_string',Constraint,Value, 273 ?T_TeletexString,DoTag); 274 'VideotexString' -> 275 emit_encode_func('restricted_string',Constraint,Value, 276 ?T_VideotexString,DoTag); 277 'GraphicString' -> 278 emit_encode_func('restricted_string',Constraint,Value, 279 ?T_GraphicString,DoTag); 280 'VisibleString' -> 281 emit_encode_func('restricted_string',Constraint,Value, 282 ?T_VisibleString,DoTag); 283 'GeneralString' -> 284 emit_encode_func('restricted_string',Constraint,Value, 285 ?T_GeneralString,DoTag); 286 'PrintableString' -> 287 emit_encode_func('restricted_string',Constraint,Value, 288 ?T_PrintableString,DoTag); 289 'IA5String' -> 290 emit_encode_func('restricted_string',Constraint,Value, 291 ?T_IA5String,DoTag); 292 'UniversalString' -> 293 emit_encode_func('universal_string',Constraint,Value,DoTag); 294 'BMPString' -> 295 emit_encode_func('BMP_string',Constraint,Value,DoTag); 296 'UTCTime' -> 297 emit_encode_func('utc_time',Constraint,Value,DoTag); 298 'GeneralizedTime' -> 299 emit_encode_func('generalized_time',Constraint,Value,DoTag); 300 'ASN1_OPEN_TYPE' -> 301 emit_encode_func('open_type', Value,DoTag); 302 XX -> 303 exit({'cannot encode' ,XX}) 304 end. 305 306 307emit_encode_func(Name,Value,Tags) when atom(Name) -> 308 emit_encode_func(atom_to_list(Name),Value,Tags); 309emit_encode_func(Name,Value,Tags) -> 310 Fname = "?RT_BER:encode_" ++ Name, 311 emit([Fname,"(",Value,", ",Tags,")"]). 312 313emit_encode_func(Name,Constraint,Value,Tags) when atom(Name) -> 314 emit_encode_func(atom_to_list(Name),Constraint,Value,Tags); 315emit_encode_func(Name,Constraint,Value,Tags) -> 316 Fname = "?RT_BER:encode_" ++ Name, 317 emit([Fname,"(",{asis,Constraint},", ",Value,", ",Tags,")"]). 318 319emit_encode_func(Name,Constraint,Value,Asis,Tags) when atom(Name) -> 320 emit_encode_func(atom_to_list(Name),Constraint,Value,Asis,Tags); 321emit_encode_func(Name,Constraint,Value,Asis,Tags) -> 322 Fname = "?RT_BER:encode_" ++ Name, 323 emit([Fname,"(",{asis,Constraint},", ",Value, 324 ", ",{asis,Asis}, 325 ", ",Tags,")"]). 326 327emit_enc_enumerated_cases({L1,L2}, Tags) -> 328 emit_enc_enumerated_cases(L1++L2, Tags, ext); 329emit_enc_enumerated_cases(L, Tags) -> 330 emit_enc_enumerated_cases(L, Tags, noext). 331 332emit_enc_enumerated_cases([{EnumName,EnumVal},H2|T], Tags, Ext) -> 333 emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), 334%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), 335 emit_enc_enumerated_cases([H2|T], Tags, Ext); 336emit_enc_enumerated_cases([{EnumName,EnumVal}], Tags, Ext) -> 337 emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), 338%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), 339 case Ext of 340 noext -> emit([";",nl]); 341 ext -> 342 emit([";",nl,"{asn1_enum,",{curr,enumval},"} -> ", 343 "?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]), 344 asn1ct_name:new(enumval) 345 end, 346 emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]), 347 emit([nl,"end"]). 348 349 350%%=============================================================================== 351%%=============================================================================== 352%%=============================================================================== 353%% Generate DECODING 354%%=============================================================================== 355%%=============================================================================== 356%%=============================================================================== 357 358%%=============================================================================== 359%% decode #{typedef, {pos, name, typespec}} 360%%=============================================================================== 361 362gen_decode(Erules,Type) when record(Type,typedef) -> 363 D = Type, 364 emit({nl,nl}), 365 emit({"'dec_",Type#typedef.name,"'(Bytes, OptOrMand) ->",nl}), 366 emit({" 'dec_",Type#typedef.name,"'(Bytes, OptOrMand, []).",nl,nl}), 367 emit({"'dec_",Type#typedef.name,"'(Bytes, ", 368 unused_optormand_var("OptOrMand",(Type#typedef.typespec)#type.def),", TagIn) ->",nl}), 369 dbdec(Type#typedef.name), 370 gen_decode_user(Erules,D). 371 372 373%%=============================================================================== 374%% decode #{type, {tag, def, constraint}} 375%%=============================================================================== 376 377gen_decode(Erules,Tname,Type) when record(Type,type) -> 378 Typename = Tname, 379 InnerType = asn1ct_gen:get_inner(Type#type.def), 380 case asn1ct_gen:type(InnerType) of 381 {constructed,bif} -> 382 ObjFun = 383 case Type#type.tablecinf of 384 [{objfun,_}|_R] -> 385 ", ObjFun"; 386 _ -> 387 "" 388 end, 389 emit({"'dec_",asn1ct_gen:list2name(Typename),"'(Bytes, OptOrMand, TagIn",ObjFun,") ->",nl}), 390 dbdec(Typename), 391 asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); 392 _ -> 393 true 394 end; 395 396 397%%=============================================================================== 398%% decode ComponentType 399%%=============================================================================== 400 401gen_decode(Erules,Tname,{'ComponentType',_Pos,Cname,Type,_,_}) -> 402 NewTname = [Cname|Tname], 403 %% The tag is set to [] to avoid that it is 404 %% taken into account twice, both as a component/alternative (passed as 405 %% argument to the encode decode function and within the encode decode 406 %% function it self. 407 NewType = Type#type{tag=[]}, 408 gen_decode(Erules,NewTname,NewType). 409 410 411gen_decode_user(Erules,D) when record(D,typedef) -> 412 Typename = [D#typedef.name], 413 Def = D#typedef.typespec, 414 InnerType = asn1ct_gen:get_inner(Def#type.def), 415 InnerTag = Def#type.tag , 416 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- InnerTag], 417 case asn1ct_gen:type(InnerType) of 418 'ASN1_OPEN_TYPE' -> 419 BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), 420 asn1ct_name:new(len), 421 gen_dec_prim(Erules, Def#type{def='ASN1_OPEN_TYPE'}, 422 BytesVar, Tag, "TagIn",no_length, 423 ?PRIMITIVE,"OptOrMand"), 424 emit({".",nl,nl}); 425 {primitive,bif} -> 426 BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), 427 asn1ct_name:new(len), 428 gen_dec_prim(Erules, Def, BytesVar, Tag, "TagIn",no_length, 429 ?PRIMITIVE,"OptOrMand"), 430 emit({".",nl,nl}); 431 {constructed,bif} -> 432 asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D); 433 TheType -> 434 DecFunName = mkfuncname(TheType,dec), 435 emit({DecFunName,"(",{curr,bytes}, 436 ", OptOrMand, TagIn++",{asis,Tag},")"}), 437 emit({".",nl,nl}) 438 end. 439 440 441gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Length,_Form,OptOrMand) -> 442 Typename = Att#type.def, 443%% Currently not used for BER replaced with [] as place holder 444%% Constraint = Att#type.constraint, 445%% Constraint = [], 446 Constraint = 447 case get_constraint(Att#type.constraint,'SizeConstraint') of 448 no -> []; 449 Tc -> Tc 450 end, 451 ValueRange = 452 case get_constraint(Att#type.constraint,'ValueRange') of 453 no -> []; 454 Tv -> Tv 455 end, 456 SingleValue = 457 case get_constraint(Att#type.constraint,'SingleValue') of 458 no -> []; 459 Sv -> Sv 460 end, 461 AsBin = case get(binary_strings) of 462 true -> "_as_bin"; 463 _ -> "" 464 end, 465 NewTypeName = case Typename of 466 'ANY' -> 'ASN1_OPEN_TYPE'; 467 _ -> Typename 468 end, 469 DoLength = 470 case NewTypeName of 471 'BOOLEAN'-> 472 emit({"?RT_BER:decode_boolean(",BytesVar,","}), 473 false; 474 'INTEGER' -> 475 emit({"?RT_BER:decode_integer(",BytesVar,",", 476 {asis,int_constr(SingleValue,ValueRange)},","}), 477 false; 478 {'INTEGER',NamedNumberList} -> 479 emit({"?RT_BER:decode_integer(",BytesVar,",", 480 {asis,int_constr(SingleValue,ValueRange)},",", 481 {asis,NamedNumberList},","}), 482 false; 483 {'ENUMERATED',NamedNumberList} -> 484 emit({"?RT_BER:decode_enumerated(",BytesVar,",", 485 {asis,Constraint},",", 486 {asis,NamedNumberList},","}), 487 false; 488 {'BIT STRING',NamedNumberList} -> 489 case get(compact_bit_string) of 490 true -> 491 emit({"?RT_BER:decode_compact_bit_string(", 492 BytesVar,",",{asis,Constraint},",", 493 {asis,NamedNumberList},","}); 494 _ -> 495 emit({"?RT_BER:decode_bit_string(",BytesVar,",", 496 {asis,Constraint},",", 497 {asis,NamedNumberList},","}) 498 end, 499 true; 500 'NULL' -> 501 emit({"?RT_BER:decode_null(",BytesVar,","}), 502 false; 503 'OBJECT IDENTIFIER' -> 504 emit({"?RT_BER:decode_object_identifier(",BytesVar,","}), 505 false; 506 'ObjectDescriptor' -> 507 emit({"?RT_BER:decode_restricted_string(", 508 BytesVar,",",{asis,Constraint},",",{asis,?T_ObjectDescriptor},","}), 509 true; 510 'OCTET STRING' -> 511 emit({"?RT_BER:decode_octet_string",AsBin,"(",BytesVar,",",{asis,Constraint},","}), 512 true; 513 'NumericString' -> 514 emit({"?RT_BER:decode_restricted_string",AsBin,"(", 515 BytesVar,",",{asis,Constraint},",",{asis,?T_NumericString},","}),true; 516 'TeletexString' -> 517 emit({"?RT_BER:decode_restricted_string",AsBin,"(", 518 BytesVar,",",{asis,Constraint},",",{asis,?T_TeletexString},","}), 519 true; 520 'VideotexString' -> 521 emit({"?RT_BER:decode_restricted_string",AsBin,"(", 522 BytesVar,",",{asis,Constraint},",",{asis,?T_VideotexString},","}), 523 true; 524 'GraphicString' -> 525 emit({"?RT_BER:decode_restricted_string",AsBin,"(", 526 BytesVar,",",{asis,Constraint},",",{asis,?T_GraphicString},","}) 527 ,true; 528 'VisibleString' -> 529 emit({"?RT_BER:decode_restricted_string",AsBin,"(", 530 BytesVar,",",{asis,Constraint},",",{asis,?T_VisibleString},","}), 531 true; 532 'GeneralString' -> 533 emit({"?RT_BER:decode_restricted_string",AsBin,"(", 534 BytesVar,",",{asis,Constraint},",",{asis,?T_GeneralString},","}), 535 true; 536 'PrintableString' -> 537 emit({"?RT_BER:decode_restricted_string",AsBin,"(", 538 BytesVar,",",{asis,Constraint},",",{asis,?T_PrintableString},","}), 539 true; 540 'IA5String' -> 541 emit({"?RT_BER:decode_restricted_string",AsBin,"(", 542 BytesVar,",",{asis,Constraint},",",{asis,?T_IA5String},","}), 543 true; 544 'UniversalString' -> 545 emit({"?RT_BER:decode_universal_string",AsBin,"(", 546 BytesVar,",",{asis,Constraint},","}), 547 true; 548 'BMPString' -> 549 emit({"?RT_BER:decode_BMP_string",AsBin,"(", 550 BytesVar,",",{asis,Constraint},","}), 551 true; 552 'UTCTime' -> 553 emit({"?RT_BER:decode_utc_time",AsBin,"(", 554 BytesVar,",",{asis,Constraint},","}), 555 true; 556 'GeneralizedTime' -> 557 emit({"?RT_BER:decode_generalized_time",AsBin,"(", 558 BytesVar,",",{asis,Constraint},","}), 559 true; 560 'ASN1_OPEN_TYPE' -> 561 emit(["?RT_BER:decode_open_type(",re_wrap_erule(Erules),",", 562 BytesVar,","]), 563 false; 564 Other -> 565 exit({'cannot decode' ,Other}) 566 end, 567 568 NewLength = case DoLength of 569 true -> [", ", Length]; 570 false -> "" 571 end, 572 NewOptOrMand = case OptOrMand of 573 _ when list(OptOrMand) -> OptOrMand; 574 mandatory -> {asis,mandatory}; 575 _ -> {asis,opt_or_default} 576 end, 577 case {TagIn,NewTypeName} of 578 {[],'ASN1_OPEN_TYPE'} -> 579 emit([{asis,DoTag},")"]); 580 {_,'ASN1_OPEN_TYPE'} -> 581 emit([TagIn,"++",{asis,DoTag},")"]); 582 {[],_} -> 583 emit([{asis,DoTag},NewLength,", ",NewOptOrMand,")"]); 584 _ when list(TagIn) -> 585 emit([TagIn,"++",{asis,DoTag},NewLength,", ",NewOptOrMand,")"]) 586 end. 587 588 589int_constr([],[]) -> 590 []; 591int_constr([],ValueRange) -> 592 ValueRange; 593int_constr(SingleValue,[]) -> 594 SingleValue; 595int_constr(SV,VR) -> 596 [SV,VR]. 597 598%% Object code generating for encoding and decoding 599%% ------------------------------------------------ 600 601gen_obj_code(Erules,_Module,Obj) when record(Obj,typedef) -> 602 ObjName = Obj#typedef.name, 603 Def = Obj#typedef.typespec, 604 #'Externaltypereference'{module=M,type=ClName} = Def#'Object'.classname, 605 Class = asn1_db:dbget(M,ClName), 606 607 {object,_,Fields} = Def#'Object'.def, 608 emit({nl,nl,nl,"%%================================"}), 609 emit({nl,"%% ",ObjName}), 610 emit({nl,"%%================================",nl}), 611 EncConstructed = 612 gen_encode_objectfields(ClName,get_class_fields(Class), 613 ObjName,Fields,[]), 614 emit(nl), 615 gen_encode_constr_type(Erules,EncConstructed), 616 emit(nl), 617 DecConstructed = 618 gen_decode_objectfields(ClName,get_class_fields(Class), 619 ObjName,Fields,[]), 620 emit(nl), 621 gen_decode_constr_type(Erules,DecConstructed); 622gen_obj_code(_Erules,_Module,Obj) when record(Obj,pobjectdef) -> 623 ok. 624 625 626gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], 627 ObjName,ObjectFields,ConstrAcc) -> 628 EmitFuncClause = 629 fun(Args) -> 630 emit(["'enc_",ObjName,"'(",{asis,Name}, 631 ", ",Args,", _RestPrimFieldName) ->",nl]) 632 end, 633% emit(["'enc_",ObjName,"'(",{asis,Name}, 634% ", Val, TagIn, _RestPrimFieldName) ->",nl]), 635 MaybeConstr= 636 case {get_object_field(Name,ObjectFields),OptOrMand} of 637 {false,'MANDATORY'} -> %% this case is illegal 638 exit({error,{asn1,{"missing mandatory field in object", 639 ObjName}}}); 640 {false,'OPTIONAL'} -> 641 EmitFuncClause("_, _"), 642 emit([" {[],0}"]), 643 []; 644 {false,{'DEFAULT',DefaultType}} -> 645 EmitFuncClause("Val, TagIn"), 646 gen_encode_default_call(ClassName,Name,DefaultType); 647 {{Name,TypeSpec},_} -> 648 %% A specified field owerwrites any 'DEFAULT' or 649 %% 'OPTIONAL' field in the class 650 EmitFuncClause("Val, TagIn"), 651 gen_encode_field_call(ObjName,Name,TypeSpec) 652 end, 653 case more_genfields(Rest) of 654 true -> 655 emit([";",nl]); 656 false -> 657 emit([".",nl]) 658 end, 659 gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields, 660 MaybeConstr++ConstrAcc); 661gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], 662 ObjName,ObjectFields,ConstrAcc) -> 663 EmitFuncClause = 664 fun(Args) -> 665 emit(["'enc_",ObjName,"'(",{asis,Name}, 666 ", ",Args,") ->",nl]) 667 end, 668% emit(["'enc_",ObjName,"'(",{asis,Name}, 669% ", Val, TagIn, [H|T]) ->",nl]), 670 case {get_object_field(Name,ObjectFields),OptOrMand} of 671 {false,'MANDATORY'} -> 672 exit({error,{asn1,{"missing mandatory field in object", 673 ObjName}}}); 674 {false,'OPTIONAL'} -> 675 EmitFuncClause("_,_,_"), 676 emit([" exit({error,{'use of missing field in object', ",Name, 677 "}})"]); 678 {false,{'DEFAULT',_DefaultObject}} -> 679 exit({error,{asn1,{"not implemented yet",Name}}}); 680 {{Name,TypeSpec},_} -> 681 EmitFuncClause(" Val, TagIn, [H|T]"), 682 case TypeSpec#typedef.name of 683 {ExtMod,TypeName} -> 684 emit({indent(3),"'",ExtMod,"':'enc_",TypeName, 685 "'(H, Val, TagIn, T)"}); 686 TypeName -> 687 emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"}) 688 end 689 end, 690 case more_genfields(Rest) of 691 true -> 692 emit([";",nl]); 693 false -> 694 emit([".",nl]) 695 end, 696 gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); 697gen_encode_objectfields(ClassName,[_|Cs],O,OF,Acc) -> 698 gen_encode_objectfields(ClassName,Cs,O,OF,Acc); 699gen_encode_objectfields(_,[],_,_,Acc) -> 700 Acc. 701 702 703% gen_encode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> 704% Fields = Class#objectclass.fields, 705% MaybeConstr= 706% case is_typefield(Fields,FieldName) of 707% true -> 708% Def = Type#typedef.typespec, 709% OTag = Def#type.tag, 710% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 711% emit({"'enc_",ObjName,"'(",{asis,FieldName}, 712% ", Val, TagIn, RestPrimFieldName) ->",nl}), 713% CAcc= 714% case Type#typedef.name of 715% {primitive,bif} -> 716% gen_encode_prim(ber,Def,["TagIn ++ ",{asis,Tag}], 717% "Val"), 718% []; 719% {constructed,bif} -> 720% %%InnerType = asn1ct_gen:get_inner(Def#type.def), 721% %%asn1ct_gen:gen_encode_constructed(ber,[ObjName], 722% %% InnerType,Def); 723% emit({" 'enc_",ObjName,'_',FieldName, 724% "'(Val, TagIn ++ ",{asis,Tag},")"}), 725% [{['enc_',ObjName,'_',FieldName],Def}]; 726% {ExtMod,TypeName} -> 727% emit({" '",ExtMod,"':'enc_",TypeName, 728% "'(Val, TagIn ++ ",{asis,Tag},")"}), 729% []; 730% TypeName -> 731% emit({" 'enc_",TypeName,"'(Val, TagIn ++ ", 732% {asis,Tag},")"}), 733% [] 734% end, 735% case more_genfields(Fields,Rest) of 736% true -> 737% emit({";",nl}); 738% false -> 739% emit({".",nl}) 740% end, 741% CAcc; 742% {false,objectfield} -> 743% emit({"'enc_",ObjName,"'(",{asis,FieldName}, 744% ", Val, TagIn, [H|T]) ->",nl}), 745% case Type#typedef.name of 746% {ExtMod,TypeName} -> 747% emit({indent(3),"'",ExtMod,"':'enc_",TypeName, 748% "'(H, Val, TagIn, T)"}); 749% TypeName -> 750% emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"}) 751% end, 752% case more_genfields(Fields,Rest) of 753% true -> 754% emit({";",nl}); 755% false -> 756% emit({".",nl}) 757% end, 758% []; 759% {false,_} -> [] 760% end, 761% gen_encode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); 762% gen_encode_objectfields(C,O,[H|T],Acc) -> 763% gen_encode_objectfields(C,O,T,Acc); 764% gen_encode_objectfields(_,_,[],Acc) -> 765% Acc. 766 767% gen_encode_constr_type([{Name,Def}|Rest]) -> 768% emit({Name,"(Val,TagIn) ->",nl}), 769% InnerType = asn1ct_gen:get_inner(Def#type.def), 770% asn1ct_gen:gen_encode_constructed(ber,Name,InnerType,Def), 771% gen_encode_constr_type(Rest); 772gen_encode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> 773 case is_already_generated(enc,TypeDef#typedef.name) of 774 true -> ok; 775 _ -> gen_encode_user(Erules,TypeDef) 776 end, 777 gen_encode_constr_type(Erules,Rest); 778gen_encode_constr_type(_,[]) -> 779 ok. 780 781gen_encode_field_call(ObjName,FieldName,Type) -> 782 Def = Type#typedef.typespec, 783 OTag = Def#type.tag, 784 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 785 case Type#typedef.name of 786 {primitive,bif} -> %%tag should be the primitive tag 787 gen_encode_prim(ber,Def,["TagIn ++ ",{asis,Tag}], 788 "Val"), 789 []; 790 {constructed,bif} -> 791 emit({" 'enc_",ObjName,'_',FieldName, 792 "'(Val, TagIn ++",{asis,Tag},")"}), 793 [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; 794 {ExtMod,TypeName} -> 795 emit({" '",ExtMod,"':'enc_",TypeName, 796 "'(Val, TagIn ++ ",{asis,Tag},")"}), 797 []; 798 TypeName -> 799 emit({" 'enc_",TypeName,"'(Val, TagIn ++ ",{asis,Tag},")"}), 800 [] 801 end. 802 803gen_encode_default_call(ClassName,FieldName,Type) -> 804 CurrentMod = get(currmod), 805 InnerType = asn1ct_gen:get_inner(Type#type.def), 806 OTag = Type#type.tag, 807 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 808 case asn1ct_gen:type(InnerType) of 809 {constructed,bif} -> 810%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); 811 emit([" 'enc_",ClassName,'_',FieldName,"'(Bytes, TagIn ++ ", 812 {asis,Tag},")"]), 813 [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), 814 typespec=Type}]; 815 {primitive,bif} -> 816 gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"), 817 []; 818 #'Externaltypereference'{module=CurrentMod,type=Etype} -> 819 emit([" 'enc_",Etype,"'(Val, TagIn ++ ",{asis,Tag},")",nl]), 820 []; 821 #'Externaltypereference'{module=Emod,type=Etype} -> 822 emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn ++ ",{asis,Tag},")",nl]), 823 [] 824 end. 825 826 827 828gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], 829 ObjName,ObjectFields,ConstrAcc) -> 830 EmitFuncClause = 831 fun(Args) -> 832 emit(["'dec_",ObjName,"'(",{asis,Name}, 833 ", ",Args,"_) ->",nl]) 834 end, 835% emit(["'dec_",ObjName,"'(",{asis,Name}, 836% ", Bytes, TagIn, RestPrimFieldName) ->",nl]), 837 MaybeConstr= 838 case {get_object_field(Name,ObjectFields),OptOrMand} of 839 {false,'MANDATORY'} -> %% this case is illegal 840 exit({error,{asn1,{"missing mandatory field in object", 841 ObjName}}}); 842 {false,'OPTIONAL'} -> 843 EmitFuncClause("_, _,"), 844 emit([" asn1_NOVALUE"]), 845 []; 846 {false,{'DEFAULT',DefaultType}} -> 847 EmitFuncClause("Bytes, TagIn,"), 848 gen_decode_default_call(ClassName,Name,"Bytes",DefaultType); 849 {{Name,TypeSpec},_} -> 850 %% A specified field owerwrites any 'DEFAULT' or 851 %% 'OPTIONAL' field in the class 852 EmitFuncClause("Bytes, TagIn,"), 853 gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec) 854 end, 855 case more_genfields(Rest) of 856 true -> 857 emit([";",nl]); 858 false -> 859 emit([".",nl]) 860 end, 861 gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc); 862gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], 863 ObjName,ObjectFields,ConstrAcc) -> 864 EmitFuncClause = 865 fun(Args) -> 866 emit(["'dec_",ObjName,"'(",{asis,Name}, 867 ", ",Args,") ->",nl]) 868 end, 869% emit(["'dec_",ObjName,"'(",{asis,Name}, 870% ", Bytes,TagIn,[H|T]) ->",nl]), 871 case {get_object_field(Name,ObjectFields),OptOrMand} of 872 {false,'MANDATORY'} -> 873 exit({error,{asn1,{"missing mandatory field in object", 874 ObjName}}}); 875 {false,'OPTIONAL'} -> 876 EmitFuncClause("_,_,_"), 877 emit([" exit({error,{'illegal use of missing field in object', ",Name, 878 "}})"]); 879 {false,{'DEFAULT',_DefaultObject}} -> 880 exit({error,{asn1,{"not implemented yet",Name}}}); 881 {{Name,TypeSpec},_} -> 882 EmitFuncClause("Bytes,TagIn,[H|T]"), 883 case TypeSpec#typedef.name of 884 {ExtMod,TypeName} -> 885 emit({indent(3),"'",ExtMod,"':'dec_",TypeName, 886 "'(H, Bytes, TagIn, T)"}); 887 TypeName -> 888 emit({indent(3),"'dec_",TypeName,"'(H, Bytes, TagIn, T)"}) 889 end 890 end, 891 case more_genfields(Rest) of 892 true -> 893 emit([";",nl]); 894 false -> 895 emit([".",nl]) 896 end, 897 gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); 898gen_decode_objectfields(CN,[_|Cs],O,OF,CAcc) -> 899 gen_decode_objectfields(CN,Cs,O,OF,CAcc); 900gen_decode_objectfields(_,[],_,_,CAcc) -> 901 CAcc. 902 903 904 905% gen_decode_objectfields(Erules,Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> 906% Fields = Class#objectclass.fields, 907% MaybeConstr = 908% case is_typefield(Fields,FieldName) of 909% true -> 910% Def = Type#typedef.typespec, 911% emit({"'dec_",ObjName,"'(",{asis,FieldName}, 912% ", Bytes, TagIn, RestPrimFieldName) ->",nl}), 913% OTag = Def#type.tag, 914% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 915% Prop = 916% case get_optionalityspec(Fields,FieldName) of 917% 'OPTIONAL' -> opt_or_default; 918% {'DEFAULT',_} -> opt_or_default; 919% _ -> mandatory 920% end, 921% CAcc = 922% case Type#typedef.name of 923% {primitive,bif} -> 924% gen_dec_prim(Erules,Def,"Bytes",Tag,"TagIn",no_length, 925% ?PRIMITIVE,Prop), 926% []; 927% {constructed,bif} -> 928% emit({" 'dec_",ObjName,'_',FieldName,"'(Bytes,", 929% {asis,Prop},", TagIn ++ ",{asis,Tag},")"}), 930% [{['dec_',ObjName,'_',FieldName],Def}]; 931% {ExtMod,TypeName} -> 932% emit({" '",ExtMod,"':'dec_",TypeName,"'(Bytes, ", 933% {asis,Prop},", TagIn ++ ",{asis,Tag},")"}), 934% []; 935% TypeName -> 936% emit({" 'dec_",TypeName,"'(Bytes, ",{asis,Prop}, 937% ", TagIn ++ ",{asis,Tag},")"}), 938% [] 939% end, 940% case more_genfields(Fields,Rest) of 941% true -> 942% emit({";",nl}); 943% false -> 944% emit({".",nl}) 945% end, 946% CAcc; 947% {false,objectfield} -> 948% emit({"'dec_",ObjName,"'(",{asis,FieldName}, 949% ", Bytes, TagIn, [H|T]) ->",nl}), 950% case Type#typedef.name of 951% {ExtMod,TypeName} -> 952% emit({indent(3),"'",ExtMod,"':'dec_",TypeName, 953% "'(H, Bytes, TagIn, T)"}); 954% TypeName -> 955% emit({indent(3),"'dec_",TypeName, 956% "'(H, Bytes, TagIn, T)"}) 957% end, 958% case more_genfields(Fields,Rest) of 959% true -> 960% emit({";",nl}); 961% false -> 962% emit({".",nl}) 963% end, 964% []; 965% {false,_} -> 966% [] 967% end, 968% gen_decode_objectfields(Erules,Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); 969% gen_decode_objectfields(Erules,C,O,[H|T],CAcc) -> 970% gen_decode_objectfields(Erules,C,O,T,CAcc); 971% gen_decode_objectfields(_,_,_,[],CAcc) -> 972% CAcc. 973 974gen_decode_constr_type(Erules,[{Name,Def}|Rest]) -> 975%% emit({Name,"(Bytes, OptOrMand) ->",nl}), 976%% emit({" ",Name,"(Bytes, OptOrMand, []).",nl,nl}), 977 emit({Name,"(Bytes, OptOrMand, TagIn) ->",nl}), 978 InnerType = asn1ct_gen:get_inner(Def#type.def), 979 asn1ct_gen:gen_decode_constructed(ber,Name,InnerType,Def), 980 gen_decode_constr_type(Erules,Rest); 981gen_decode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> 982 case is_already_generated(dec,TypeDef#typedef.name) of 983 true -> ok; 984 _ -> 985 gen_decode(Erules,TypeDef) 986 end, 987 gen_decode_constr_type(Erules,Rest); 988gen_decode_constr_type(_,[]) -> 989 ok. 990 991gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> 992 Def = Type#typedef.typespec, 993 OTag = Def#type.tag, 994 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 995 case Type#typedef.name of 996 {primitive,bif} -> %%tag should be the primitive tag 997 gen_dec_prim(ber,Def,Bytes,Tag,"TagIn",no_length, 998 ?PRIMITIVE,opt_or_default), 999 []; 1000 {constructed,bif} -> 1001 emit({" 'dec_",ObjName,'_',FieldName, 1002 "'(",Bytes,",opt_or_default, TagIn ++ ",{asis,Tag},")"}), 1003 [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; 1004 {ExtMod,TypeName} -> 1005 emit({" '",ExtMod,"':'dec_",TypeName, 1006 "'(",Bytes,", opt_or_default,TagIn ++ ",{asis,Tag},")"}), 1007 []; 1008 TypeName -> 1009 emit({" 'dec_",TypeName,"'(",Bytes, 1010 ", opt_or_default,TagIn ++ ",{asis,Tag},")"}), 1011 [] 1012 end. 1013 1014gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> 1015 CurrentMod = get(currmod), 1016 InnerType = asn1ct_gen:get_inner(Type#type.def), 1017 OTag = Type#type.tag, 1018 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 1019 case asn1ct_gen:type(InnerType) of 1020 {constructed,bif} -> 1021 emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes, 1022 ",opt_or_default, TagIn ++ ",{asis,Tag},")"]), 1023 [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), 1024 typespec=Type}]; 1025 {primitive,bif} -> 1026 gen_dec_prim(ber,Type,Bytes,Tag,"TagIn",no_length, 1027 ?PRIMITIVE,opt_or_default), 1028 []; 1029 #'Externaltypereference'{module=CurrentMod,type=Etype} -> 1030 emit([" 'dec_",Etype,"'(",Bytes, 1031 " ,opt_or_default, TagIn ++ ",{asis,Tag},")",nl]), 1032 []; 1033 #'Externaltypereference'{module=Emod,type=Etype} -> 1034 emit([" '",Emod,"':'dec_",Etype,"'(",Bytes, 1035 ", opt_or_defualt, TagIn ++ ",{asis,Tag},")",nl]), 1036 [] 1037 end. 1038 1039 1040more_genfields([]) -> 1041 false; 1042more_genfields([Field|Fields]) -> 1043 case element(1,Field) of 1044 typefield -> 1045 true; 1046 objectfield -> 1047 true; 1048 _ -> 1049 more_genfields(Fields) 1050 end. 1051 1052 1053 1054%% Object Set code generating for encoding and decoding 1055%% ---------------------------------------------------- 1056gen_objectset_code(Erules,ObjSet) -> 1057 ObjSetName = ObjSet#typedef.name, 1058 Def = ObjSet#typedef.typespec, 1059% {ClassName,ClassDef} = Def#'ObjectSet'.class, 1060 #'Externaltypereference'{module=ClassModule, 1061 type=ClassName} = Def#'ObjectSet'.class, 1062 ClassDef = asn1_db:dbget(ClassModule,ClassName), 1063 UniqueFName = Def#'ObjectSet'.uniquefname, 1064 Set = Def#'ObjectSet'.set, 1065 emit({nl,nl,nl,"%%================================"}), 1066 emit({nl,"%% ",ObjSetName}), 1067 emit({nl,"%%================================",nl}), 1068 case ClassName of 1069 {_Module,ExtClassName} -> 1070 gen_objset_code(Erules,ObjSetName,UniqueFName,Set, 1071 ExtClassName,ClassDef); 1072 _ -> 1073 gen_objset_code(Erules,ObjSetName,UniqueFName,Set, 1074 ClassName,ClassDef) 1075 end, 1076 emit(nl). 1077 1078gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> 1079 ClassFields = (ClassDef#classdef.typespec)#objectclass.fields, 1080 InternalFuncs=gen_objset_enc(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]), 1081 gen_objset_dec(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), 1082 gen_internal_funcs(Erules,InternalFuncs). 1083 1084%% gen_objset_enc iterates over the objects of the object set 1085gen_objset_enc(_,{unique,undefined},_,_,_,_,_) -> 1086 %% There is no unique field in the class of this object set 1087 %% don't bother about the constraint 1088 []; 1089gen_objset_enc(ObjSName,UniqueName, 1090 [{ObjName,Val,Fields},T|Rest],ClName,ClFields,NthObj,Acc)-> 1091 emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), 1092 {InternalFunc,NewNthObj}= 1093 case ObjName of 1094 no_name -> 1095 gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj); 1096 _Other -> 1097 emit({" fun 'enc_",ObjName,"'/4"}), 1098 {[],NthObj} 1099 end, 1100 emit({";",nl}), 1101 gen_objset_enc(ObjSName,UniqueName,[T|Rest],ClName,ClFields, 1102 NewNthObj,InternalFunc ++ Acc); 1103gen_objset_enc(ObjSetName,UniqueName, 1104 [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) -> 1105 emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), 1106 {InternalFunc,_}= 1107 case ObjName of 1108 no_name -> 1109 gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); 1110 _Other -> 1111 emit({" fun 'enc_",ObjName,"'/4"}), 1112 {[],NthObj} 1113 end, 1114 emit({".",nl,nl}), 1115 InternalFunc ++ Acc; 1116%% See X.681 Annex E for the following case 1117gen_objset_enc(ObjSetName,_UniqueName,['EXTENSIONMARK'], 1118 _ClName,_ClFields,_NthObj,Acc) -> 1119 emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), 1120 emit({indent(3),"fun(_Attr, Val, _TagIn, _RestPrimFieldName) ->",nl}), 1121 emit({indent(6),"Len = case Val of",nl,indent(9), 1122 "Bin when binary(Bin) -> size(Bin);",nl,indent(9), 1123 "_ -> length(Val)",nl,indent(6),"end,"}), 1124 emit({indent(6),"{Val,Len}",nl}), 1125 emit({indent(3),"end.",nl,nl}), 1126 Acc; 1127gen_objset_enc(_,_,[],_,_,_,Acc) -> 1128 Acc. 1129 1130%% gen_inlined_enc_funs for each object iterates over all fields of a 1131%% class, and for each typefield it checks if the object has that 1132%% field and emits the proper code. 1133gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest],ObjSetName, 1134 NthObj) -> 1135 InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), 1136 case lists:keysearch(Name,1,Fields) of 1137 {value,{_,Type}} when record(Type,type) -> 1138 emit({indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, 1139 indent(6),"case Type of",nl}), 1140 {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), 1141 gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); 1142 {value,{_,Type}} when record(Type,typedef) -> 1143 emit({indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, 1144 indent(6),"case Type of",nl}), 1145 emit({indent(9),{asis,Name}," ->",nl}), 1146 {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), 1147 gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); 1148 false -> 1149 gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj) 1150 end; 1151gen_inlined_enc_funs(Fields,[_H|Rest],ObjSetName,NthObj) -> 1152 gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj); 1153gen_inlined_enc_funs(_,[],_,NthObj) -> 1154 {[],NthObj}. 1155 1156gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, 1157 NthObj,Acc) -> 1158 InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), 1159 {Acc2,NAdd}= 1160 case lists:keysearch(Name,1,Fields) of 1161 {value,{_,Type}} when record(Type,type) -> 1162 emit({";",nl}), 1163 {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), 1164 {Ret++Acc,N}; 1165 {value,{_,Type}} when record(Type,typedef) -> 1166 emit({";",nl,indent(9),{asis,Name}," ->",nl}), 1167 {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), 1168 {Ret++Acc,N}; 1169 false -> 1170 {Acc,0} 1171 end, 1172 gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2); 1173gen_inlined_enc_funs1(Fields,[_H|Rest],ObjSetName,NthObj,Acc)-> 1174 gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc); 1175gen_inlined_enc_funs1(_,[],_,NthObj,Acc) -> 1176 emit({nl,indent(6),"end",nl}), 1177 emit({indent(3),"end"}), 1178 {Acc,NthObj}. 1179 1180 1181emit_inner_of_fun(TDef = #typedef{name={ExtMod,Name},typespec=Type}, 1182 InternalDefFunName) -> 1183 OTag = Type#type.tag, 1184 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 1185 case {ExtMod,Name} of 1186 {primitive,bif} -> 1187 emit(indent(12)), 1188 gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"), 1189 {[],0}; 1190 {constructed,bif} -> 1191 emit([indent(12),"'enc_", 1192 InternalDefFunName,"'(Val,TagIn ++ ", 1193 {asis,Tag},")"]), 1194 {[TDef#typedef{name=InternalDefFunName}],1}; 1195 _ -> 1196 emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val, TagIn ++ ", 1197 {asis,Tag},")"}), 1198 {[],0} 1199 end; 1200emit_inner_of_fun(#typedef{name=Name,typespec=Type},_) -> 1201 OTag = Type#type.tag, 1202 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 1203 emit({indent(12),"'enc_",Name,"'(Val, TagIn ++ ",{asis,Tag},")"}), 1204 {[],0}; 1205emit_inner_of_fun(Type,_) when record(Type,type) -> 1206 CurrMod = get(currmod), 1207 OTag = Type#type.tag, 1208 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 1209 case Type#type.def of 1210 Def when atom(Def) -> 1211 emit({indent(9),Def," ->",nl,indent(12)}), 1212 gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"); 1213 TRef when record(TRef,typereference) -> 1214 T = TRef#typereference.val, 1215 emit({indent(9),T," ->",nl,indent(12),"'enc_",T, 1216 "'(Val, TagIn ++ ",{asis,Tag},")"}); 1217 #'Externaltypereference'{module=CurrMod,type=T} -> 1218 emit({indent(9),T," ->",nl,indent(12),"'enc_",T, 1219 "'(Val, TagIn ++ ",{asis,Tag},")"}); 1220 #'Externaltypereference'{module=ExtMod,type=T} -> 1221 emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", 1222 T,"'(Val, TagIn ++ ",{asis,Tag},")"}) 1223 end, 1224 {[],0}. 1225 1226indent(N) -> 1227 lists:duplicate(N,32). % 32 = space 1228 1229 1230gen_objset_dec(_,_,{unique,undefined},_,_,_,_) -> 1231 %% There is no unique field in the class of this object set 1232 %% don't bother about the constraint 1233 ok; 1234gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], 1235 ClName,ClFields,NthObj)-> 1236 emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, 1237 ") ->",nl}), 1238 NewNthObj= 1239 case ObjName of 1240 no_name -> 1241 gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSName, 1242 NthObj); 1243 _Other -> 1244 emit({" fun 'dec_",ObjName,"'/4"}), 1245 NthObj 1246 end, 1247 emit({";",nl}), 1248 gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields, 1249 NewNthObj); 1250gen_objset_dec(Erules,ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName, 1251 ClFields,NthObj) -> 1252 emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), 1253 case ObjName of 1254 no_name -> 1255 gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSetName, 1256 NthObj); 1257 _Other -> 1258 emit({" fun 'dec_",ObjName,"'/4"}) 1259 end, 1260 emit({".",nl,nl}); 1261gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,_ClFields, 1262 _NthObj) -> 1263 emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}), 1264 emit({indent(3),"fun(_, Bytes, _, _) ->",nl}), 1265 emit({indent(6),"Len = case Bytes of",nl,indent(9), 1266 "Bin when binary(Bin) -> size(Bin);",nl,indent(9), 1267 "_ -> length(Bytes)",nl,indent(6),"end,"}), 1268 emit({indent(6),"{Bytes,[],Len}",nl}), 1269 emit({indent(3),"end.",nl,nl}), 1270 ok; 1271gen_objset_dec(_,_,_,[],_,_,_) -> 1272 ok. 1273 1274gen_inlined_dec_funs(Erules,Fields,[{typefield,Name,Prop}|Rest], 1275 ObjSetName,NthObj) -> 1276 DecProp = case Prop of 1277 'OPTIONAL' -> opt_or_default; 1278 {'DEFAULT',_} -> opt_or_default; 1279 _ -> mandatory 1280 end, 1281 InternalDefFunName = [NthObj,Name,ObjSetName], 1282 case lists:keysearch(Name,1,Fields) of 1283 {value,{_,Type}} when record(Type,type) -> 1284 emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", 1285 nl,indent(6),"case Type of",nl}), 1286 N=emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName), 1287 gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); 1288 {value,{_,Type}} when record(Type,typedef) -> 1289 emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", 1290 nl,indent(6),"case Type of",nl}), 1291 emit({indent(9),{asis,Name}," ->",nl}), 1292 N=emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName), 1293 gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); 1294 false -> 1295 gen_inlined_dec_funs(Erules,Fields,Rest,ObjSetName,NthObj) 1296 end; 1297gen_inlined_dec_funs(Erules,Fields,[_H|Rest],ObjSetName,NthObj) -> 1298 gen_inlined_dec_funs(Erules,Fields,Rest,ObjSetName,NthObj); 1299gen_inlined_dec_funs(_,_,[],_,NthObj) -> 1300 NthObj. 1301 1302gen_inlined_dec_funs1(Erules,Fields,[{typefield,Name,Prop}|Rest], 1303 ObjSetName,NthObj) -> 1304 DecProp = case Prop of 1305 'OPTIONAL' -> opt_or_default; 1306 {'DEFAULT',_} -> opt_or_default; 1307 _ -> mandatory 1308 end, 1309 InternalDefFunName = [NthObj,Name,ObjSetName], 1310 N= 1311 case lists:keysearch(Name,1,Fields) of 1312 {value,{_,Type}} when record(Type,type) -> 1313 emit({";",nl}), 1314 emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName); 1315 {value,{_,Type}} when record(Type,typedef) -> 1316 emit({";",nl,indent(9),{asis,Name}," ->",nl}), 1317 emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName); 1318 false -> 1319 0 1320 end, 1321 gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); 1322gen_inlined_dec_funs1(Erules,Fields,[_H|Rest],ObjSetName,NthObj)-> 1323 gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj); 1324gen_inlined_dec_funs1(_,_,[],_,NthObj) -> 1325 emit({nl,indent(6),"end",nl}), 1326 emit({indent(3),"end"}), 1327 NthObj. 1328 1329emit_inner_of_decfun(Erules,#typedef{name={ExtName,Name},typespec=Type}, 1330 Prop,InternalDefFunName) -> 1331 OTag = Type#type.tag, 1332 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 1333 case {ExtName,Name} of 1334 {primitive,bif} -> 1335 emit(indent(12)), 1336 gen_dec_prim(Erules,Type,"Bytes",Tag,"TagIn",no_length, 1337 ?PRIMITIVE,Prop), 1338 0; 1339 {constructed,bif} -> 1340 emit({indent(12),"'dec_", 1341 asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ",Prop, 1342 ", TagIn ++ ",{asis,Tag},")"}), 1343 1; 1344 _ -> 1345 emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Bytes, ",Prop, 1346 ", TagIn ++ ",{asis,Tag},")"}), 1347 0 1348 end; 1349emit_inner_of_decfun(_,#typedef{name=Name,typespec=Type},Prop,_) -> 1350 OTag = Type#type.tag, 1351 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 1352 emit({indent(12),"'dec_",Name,"'(Bytes, ",Prop,", TagIn ++ ", 1353 {asis,Tag},")"}), 1354 0; 1355emit_inner_of_decfun(Erules,Type,Prop,_) when record(Type,type) -> 1356 OTag = Type#type.tag, 1357 Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], 1358 CurrMod = get(currmod), 1359 Def = Type#type.def, 1360 InnerType = asn1ct_gen:get_inner(Def), 1361 WhatKind = asn1ct_gen:type(InnerType), 1362 case WhatKind of 1363 {primitive,bif} -> 1364 emit({indent(9),Def," ->",nl,indent(12)}), 1365 gen_dec_prim(Erules,Type,"Bytes",Tag,"TagIn",no_length, 1366 ?PRIMITIVE,Prop); 1367% TRef when record(TRef,typereference) -> 1368% T = TRef#typereference.val, 1369% emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); 1370 #'Externaltypereference'{module=CurrMod,type=T} -> 1371 emit({indent(9),T," ->",nl,indent(12),"'dec_",T, 1372 "'(Bytes, ",Prop,", TagIn ++ ",{asis,Tag},")"}); 1373 #'Externaltypereference'{module=ExtMod,type=T} -> 1374 emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", 1375 T,"'(Bytes, ",Prop,", TagIn ++ ",{asis,Tag},")"}) 1376 end, 1377 0. 1378 1379 1380gen_internal_funcs(_,[]) -> 1381 ok; 1382gen_internal_funcs(Erules,[TypeDef|Rest]) -> 1383 gen_encode_user(Erules,TypeDef), 1384 emit({"'dec_",TypeDef#typedef.name,"'(Bytes, ", 1385 unused_optormand_var("OptOrMand",(TypeDef#typedef.typespec)#type.def),", TagIn) ->",nl}), 1386 gen_decode_user(Erules,TypeDef), 1387 gen_internal_funcs(Erules,Rest). 1388 1389 1390dbdec(Type) -> 1391 demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}). 1392 1393 1394decode_class('UNIVERSAL') -> 1395 ?UNIVERSAL; 1396decode_class('APPLICATION') -> 1397 ?APPLICATION; 1398decode_class('CONTEXT') -> 1399 ?CONTEXT; 1400decode_class('PRIVATE') -> 1401 ?PRIVATE. 1402 1403decode_type('BOOLEAN') -> 1; 1404decode_type('INTEGER') -> 2; 1405decode_type('BIT STRING') -> 3; 1406decode_type('OCTET STRING') -> 4; 1407decode_type('NULL') -> 5; 1408decode_type('OBJECT IDENTIFIER') -> 6; 1409decode_type('OBJECT DESCRIPTOR') -> 7; 1410decode_type('EXTERNAL') -> 8; 1411decode_type('REAL') -> 9; 1412decode_type('ENUMERATED') -> 10; 1413decode_type('EMBEDDED_PDV') -> 11; 1414decode_type('SEQUENCE') -> 16; 1415decode_type('SEQUENCE OF') -> 16; 1416decode_type('SET') -> 17; 1417decode_type('SET OF') -> 17; 1418decode_type('NumericString') -> 18; 1419decode_type('PrintableString') -> 19; 1420decode_type('TeletexString') -> 20; 1421decode_type('VideotexString') -> 21; 1422decode_type('IA5String') -> 22; 1423decode_type('UTCTime') -> 23; 1424decode_type('GeneralizedTime') -> 24; 1425decode_type('GraphicString') -> 25; 1426decode_type('VisibleString') -> 26; 1427decode_type('GeneralString') -> 27; 1428decode_type('UniversalString') -> 28; 1429decode_type('BMPString') -> 30; 1430decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative 1431decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}). 1432 1433add_removed_bytes() -> 1434 asn1ct_name:delete(rb), 1435 add_removed_bytes(asn1ct_name:all(rb)). 1436 1437add_removed_bytes([H,T1|T]) -> 1438 emit({{var,H},"+"}), 1439 add_removed_bytes([T1|T]); 1440add_removed_bytes([H|T]) -> 1441 emit({{var,H}}), 1442 add_removed_bytes(T); 1443add_removed_bytes([]) -> 1444 true. 1445 1446mkfuncname(WhatKind,DecOrEnc) -> 1447 case WhatKind of 1448 #'Externaltypereference'{module=Mod,type=EType} -> 1449 CurrMod = get(currmod), 1450 case CurrMod of 1451 Mod -> 1452 lists:concat(["'",DecOrEnc,"_",EType,"'"]); 1453 _ -> 1454% io:format("CurrMod: ~p, Mod: ~p~n",[CurrMod,Mod]), 1455 lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"]) 1456 end; 1457 #'typereference'{val=EType} -> 1458 lists:concat(["'",DecOrEnc,"_",EType,"'"]); 1459 'ASN1_OPEN_TYPE' -> 1460 lists:concat(["'",DecOrEnc,"_",WhatKind,"'"]) 1461 1462 end. 1463 1464optionals(L) -> optionals(L,[],1). 1465 1466optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) -> 1467 optionals(Rest,Acc,Pos); % optionals in extension are currently not handled 1468optionals([#'ComponentType'{name=Name,prop='OPTIONAL'}|Rest],Acc,Pos) -> 1469 optionals(Rest,[{Name,Pos}|Acc],Pos+1); 1470optionals([#'ComponentType'{name=Name,prop={'DEFAULT',_}}|Rest],Acc,Pos) -> 1471 optionals(Rest,[{Name,Pos}|Acc],Pos+1); 1472optionals([#'ComponentType'{}|Rest],Acc,Pos) -> 1473 optionals(Rest,Acc,Pos+1); 1474optionals([],Acc,_) -> 1475 lists:reverse(Acc). 1476 1477get_constraint(C,Key) -> 1478 case lists:keysearch(Key,1,C) of 1479 false -> 1480 no; 1481 {value,{_,V}} -> 1482 V 1483 end. 1484 1485%% if the original option was ber and it has been wrapped to ber_bin 1486%% turn it back to ber 1487re_wrap_erule(ber_bin) -> 1488 case get(encoding_options) of 1489 Options when list(Options) -> 1490 case lists:member(ber,Options) of 1491 true -> ber; 1492 _ -> ber_bin 1493 end; 1494 _ -> ber_bin 1495 end; 1496re_wrap_erule(Erule) -> 1497 Erule. 1498 1499is_already_generated(Operation,Name) -> 1500 case get(class_default_type) of 1501 undefined -> 1502 put(class_default_type,[{Operation,Name}]), 1503 false; 1504 GeneratedList -> 1505 case lists:member({Operation,Name},GeneratedList) of 1506 true -> 1507 true; 1508 false -> 1509 put(class_default_type,[{Operation,Name}|GeneratedList]), 1510 false 1511 end 1512 end. 1513 1514get_class_fields(#classdef{typespec=ObjClass}) -> 1515 ObjClass#objectclass.fields; 1516get_class_fields(#objectclass{fields=Fields}) -> 1517 Fields; 1518get_class_fields(_) -> 1519 []. 1520 1521get_object_field(Name,ObjectFields) -> 1522 case lists:keysearch(Name,1,ObjectFields) of 1523 {value,Field} -> Field; 1524 false -> false 1525 end. 1526