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