1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2002-2017. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19%% 20%% 21-module(asn1ct_gen_ber_bin_v2). 22 23%% Generate erlang module which handles (PER) encode and decode for 24%% all types in an ASN.1 module 25 26-include("asn1_records.hrl"). 27 28-export([decode_class/1]). 29-export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]). 30-export([gen_encode_prim/4]). 31-export([gen_dec_prim/3]). 32-export([gen_objectset_code/2, gen_obj_code/3]). 33-export([encode_tag_val/3]). 34-export([gen_inc_decode/2,gen_decode_selected/3]). 35-export([extaddgroup2sequence/1]). 36-export([dialyzer_suppressions/1]). 37 38-import(asn1ct_gen, [emit/1]). 39 40%% The encoding of class of tag bits 8 and 7 41-define(UNIVERSAL, 0). 42-define(APPLICATION, 16#40). 43-define(CONTEXT, 16#80). 44-define(PRIVATE, 16#C0). 45 46%% Primitive or constructed encoding % bit 6 47-define(PRIMITIVE, 0). 48-define(CONSTRUCTED, 2#00100000). 49 50 51-define(T_ObjectDescriptor, ?UNIVERSAL bor ?PRIMITIVE bor 7). 52%% Restricted character string types 53-define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed 54-define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed 55-define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed 56-define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed 57-define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed 58-define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed 59-define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed 60-define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed 61 62%%=============================================================================== 63%%=============================================================================== 64%%=============================================================================== 65%% Generate ENCODING 66%%=============================================================================== 67%%=============================================================================== 68%%=============================================================================== 69 70dialyzer_suppressions(_) -> 71 case asn1ct:use_legacy_types() of 72 false -> ok; 73 true -> suppress({ber,encode_bit_string,4}) 74 end, 75 suppress({ber,decode_selective,2}), 76 emit([" ok.",nl]). 77 78suppress({M,F,A}=MFA) -> 79 case asn1ct_func:is_used(MFA) of 80 false -> 81 ok; 82 true -> 83 Args = [lists:concat(["element(",I,", Arg)"]) || I <- lists:seq(1, A)], 84 emit([" ",{call,M,F,Args},com,nl]) 85 end. 86 87%%=============================================================================== 88%% encode #{typedef, {pos, name, typespec}} 89%%=============================================================================== 90 91gen_encode(Erules, #typedef{}=D) -> 92 gen_encode_user(Erules, #typedef{}=D, true). 93 94%%=============================================================================== 95%% encode #{type, {tag, def, constraint}} 96%%=============================================================================== 97 98gen_encode(Erules,Typename,Type) when is_record(Type,type) -> 99 InnerType = asn1ct_gen:get_inner(Type#type.def), 100 ObjFun = 101 case lists:keysearch(objfun,1,Type#type.tablecinf) of 102 {value,{_,_Name}} -> 103 ", ObjFun"; 104 false -> 105 "" 106 end, 107 108 case asn1ct_gen:type(InnerType) of 109 {constructed,bif} -> 110 Func = {asis,enc_func(asn1ct_gen:list2name(Typename))}, 111 emit([nl,nl,nl,"%%================================",nl, 112 "%% ",asn1ct_gen:list2name(Typename),nl, 113 "%%================================",nl, 114 Func,"(Val, TagIn",ObjFun,") ->",nl, 115 " "]), 116 asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); 117 _ -> 118 true 119 end; 120 121%%=============================================================================== 122%% encode ComponentType 123%%=============================================================================== 124 125gen_encode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> 126 NewTname = [Cname|Tname], 127 %% The tag is set to [] to avoid that it is 128 %% taken into account twice, both as a component/alternative (passed as 129 %% argument to the encode decode function and within the encode decode 130 %% function it self. 131 NewType = Type#type{tag=[]}, 132 gen_encode(Erules,NewTname,NewType). 133 134gen_encode_user(Erules, #typedef{}=D, Wrapper) -> 135 Typename = [D#typedef.name], 136 Type = D#typedef.typespec, 137 InnerType = asn1ct_gen:get_inner(Type#type.def), 138 emit([nl,nl,"%%================================"]), 139 emit([nl,"%% ",Typename]), 140 emit([nl,"%%================================",nl]), 141 FuncName = {asis,enc_func(asn1ct_gen:list2name(Typename))}, 142 case Wrapper of 143 true -> 144 %% This is a top-level type. Generate an 'enc_Type'/1 145 %% wrapper. 146 OTag = Type#type.tag, 147 Tag0 = [encode_tag_val(decode_class(Class), Form, Number) || 148 #tag{class=Class,form=Form,number=Number} <- OTag], 149 Tag = lists:reverse(Tag0), 150 emit([FuncName,"(Val) ->",nl, 151 " ",FuncName,"(Val, ",{asis,Tag},").",nl,nl]); 152 false -> 153 ok 154 end, 155 emit([FuncName,"(Val, TagIn) ->",nl]), 156 CurrentMod = get(currmod), 157 case asn1ct_gen:type(InnerType) of 158 {constructed,bif} -> 159 asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D); 160 {primitive,bif} -> 161 gen_encode_prim(ber,Type,"TagIn","Val"), 162 emit([".",nl]); 163 #'Externaltypereference'{module=CurrentMod,type=Etype} -> 164 emit([" ",{asis,enc_func(Etype)},"(Val, TagIn).",nl]); 165 #'Externaltypereference'{module=Emod,type=Etype} -> 166 emit([" ",{asis,Emod},":",{asis,enc_func(Etype)}, 167 "(Val, TagIn).",nl]); 168 'ASN1_OPEN_TYPE' -> 169 emit(["%% OPEN TYPE",nl]), 170 gen_encode_prim(ber, 171 Type#type{def='ASN1_OPEN_TYPE'}, 172 "TagIn","Val"), 173 emit([".",nl]) 174 end. 175 176gen_encode_prim(_Erules, #type{}=D, DoTag, Value) -> 177 BitStringConstraint = get_size_constraint(D#type.constraint), 178 MaxBitStrSize = case BitStringConstraint of 179 [] -> none; 180 {_,'MAX'} -> none; 181 {_,Max} -> Max; 182 Max when is_integer(Max) -> Max 183 end, 184 asn1ct_name:new(enumval), 185 Type = case D#type.def of 186 'OCTET STRING' -> restricted_string; 187 'ObjectDescriptor'-> restricted_string; 188 'NumericString' -> restricted_string; 189 'TeletexString' -> restricted_string; 190 'T61String' -> restricted_string; 191 'VideotexString' -> restricted_string; 192 'GraphicString' -> restricted_string; 193 'VisibleString' -> restricted_string; 194 'GeneralString' -> restricted_string; 195 'PrintableString' -> restricted_string; 196 'IA5String' -> restricted_string; 197 'UTCTime' -> restricted_string; 198 'GeneralizedTime' -> restricted_string; 199 Other -> Other 200 end, 201 case Type of 202 restricted_string -> 203 call(encode_restricted_string, [Value,DoTag]); 204 'BOOLEAN' -> 205 call(encode_boolean, [Value,DoTag]); 206 'INTEGER' -> 207 call(encode_integer, [Value,DoTag]); 208 {'INTEGER',NamedNumberList} -> 209 call(encode_integer, [Value,{asis,NamedNumberList}, DoTag]); 210 {'ENUMERATED',NamedNumberList={_,_}} -> 211 emit(["case ",Value," of",nl]), 212 emit_enc_enumerated_cases(NamedNumberList,DoTag); 213 {'ENUMERATED',NamedNumberList} -> 214 emit(["case ",Value," of",nl]), 215 emit_enc_enumerated_cases(NamedNumberList,DoTag); 216 'REAL' -> 217 asn1ct_name:new(realval), 218 asn1ct_name:new(realsize), 219 emit(["begin",nl, 220 {curr,realval}," = ", 221 {call,real_common,ber_encode_real,[Value]},com,nl, 222 {curr,realsize}," = ", 223 {call,erlang,byte_size,[{curr,realval}]},com,nl, 224 {call,ber,encode_tags, 225 [DoTag,{curr,realval},{curr,realsize}]},nl, 226 "end"]); 227 {'BIT STRING',[]} -> 228 case asn1ct:use_legacy_types() of 229 false when MaxBitStrSize =:= none -> 230 call(encode_unnamed_bit_string, [Value,DoTag]); 231 false -> 232 call(encode_unnamed_bit_string, 233 [{asis,MaxBitStrSize},Value,DoTag]); 234 true -> 235 call(encode_bit_string, 236 [{asis,BitStringConstraint},Value, 237 {asis,[]},DoTag]) 238 end; 239 {'BIT STRING',NamedNumberList} -> 240 case asn1ct:use_legacy_types() of 241 false when MaxBitStrSize =:= none -> 242 call(encode_named_bit_string, 243 [Value,{asis,NamedNumberList},DoTag]); 244 false -> 245 call(encode_named_bit_string, 246 [{asis,MaxBitStrSize},Value, 247 {asis,NamedNumberList},DoTag]); 248 true -> 249 call(encode_bit_string, 250 [{asis,BitStringConstraint},Value, 251 {asis,NamedNumberList},DoTag]) 252 end; 253 'NULL' -> 254 call(encode_null, [Value,DoTag]); 255 'OBJECT IDENTIFIER' -> 256 call(encode_object_identifier, [Value,DoTag]); 257 'RELATIVE-OID' -> 258 call(encode_relative_oid, [Value,DoTag]); 259 'UniversalString' -> 260 call(encode_universal_string, [Value,DoTag]); 261 'UTF8String' -> 262 call(encode_UTF8_string, [Value,DoTag]); 263 'BMPString' -> 264 call(encode_BMP_string, [Value,DoTag]); 265 'ASN1_OPEN_TYPE' -> 266 call(encode_open_type, [Value,DoTag]) 267 end. 268 269emit_enc_enumerated_cases({L1,L2}, Tags) -> 270 emit_enc_enumerated_cases(L1++L2, Tags, ext); 271emit_enc_enumerated_cases(L, Tags) -> 272 emit_enc_enumerated_cases(L, Tags, noext). 273 274emit_enc_enumerated_cases([{EnumName,EnumVal}|T], Tags, Ext) -> 275 {Bytes,Len} = encode_integer(EnumVal), 276 emit([{asis,EnumName}," -> ", 277 {call,ber,encode_tags,[Tags,{asis,Bytes},Len]},";",nl]), 278 emit_enc_enumerated_cases(T, Tags, Ext); 279emit_enc_enumerated_cases([], _Tags, _Ext) -> 280 %% FIXME: Should extension be handled? 281 emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]), 282 emit([nl,"end"]). 283 284encode_integer(Val) -> 285 Bytes = 286 if 287 Val >= 0 -> 288 encode_integer_pos(Val, []); 289 true -> 290 encode_integer_neg(Val, []) 291 end, 292 {Bytes,length(Bytes)}. 293 294encode_integer_pos(0, [B|_Acc]=L) when B < 128 -> 295 L; 296encode_integer_pos(N, Acc) -> 297 encode_integer_pos((N bsr 8), [N band 16#ff| Acc]). 298 299encode_integer_neg(-1, [B1|_T]=L) when B1 > 127 -> 300 L; 301encode_integer_neg(N, Acc) -> 302 encode_integer_neg(N bsr 8, [N band 16#ff|Acc]). 303 304%%=============================================================================== 305%%=============================================================================== 306%%=============================================================================== 307%% Generate DECODING 308%%=============================================================================== 309%%=============================================================================== 310%%=============================================================================== 311 312%%=============================================================================== 313%% decode #{typedef, {pos, name, typespec}} 314%%=============================================================================== 315 316gen_decode(Erules,Type) when is_record(Type,typedef) -> 317 Def = Type#typedef.typespec, 318 InnerTag = Def#type.tag , 319 320 Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- InnerTag], 321 322 FuncName0 = 323 case {asn1ct:get_gen_state_field(active), 324 asn1ct:get_gen_state_field(prefix)} of 325 {true,Pref} -> 326 %% prevent duplicated function definitions 327 case asn1ct:current_sindex() of 328 I when is_integer(I), I > 0 -> 329 [Pref,Type#typedef.name,"_",I]; 330 _-> 331 [Pref,Type#typedef.name] 332 end; 333 {_,_} -> 334 ["dec_",Type#typedef.name] 335 end, 336 FuncName = {asis,list_to_atom(lists:concat(FuncName0))}, 337 emit([nl,nl, 338 FuncName,"(Tlv) ->",nl, 339 " ",FuncName,"(Tlv, ",{asis,Tag},").",nl,nl, 340 FuncName,"(Tlv, TagIn) ->",nl]), 341 gen_decode_user(Erules,Type). 342 343gen_inc_decode(Erules,Type) when is_record(Type,typedef) -> 344 Prefix = asn1ct:get_gen_state_field(prefix), 345 Suffix = asn1ct_gen:index2suffix(asn1ct:current_sindex()), 346 FuncName0 = [Prefix,Type#typedef.name,Suffix], 347 FuncName = {asis,list_to_atom(lists:concat(FuncName0))}, 348 emit([nl,nl, 349 FuncName,"(Tlv, TagIn) ->",nl]), 350 gen_decode_user(Erules,Type). 351 352%% gen_decode_selected exported function for selected decode 353gen_decode_selected(Erules,Type,FuncName) -> 354 emit([FuncName,"(Bin) ->",nl]), 355 Patterns = asn1ct:read_config_data(partial_decode), 356 Pattern = 357 case lists:keysearch(FuncName,1,Patterns) of 358 {value,{_,P}} -> P; 359 false -> exit({error,{internal,no_pattern_saved}}) 360 end, 361 emit([" case ",{call,ber,decode_selective, 362 [{asis,Pattern},"Bin"]}," of",nl, 363 " {ok,Bin2} when is_binary(Bin2) ->",nl, 364 " {Tlv,_} = ", {call,ber,ber_decode_nif,["Bin2"]},com,nl]), 365 emit("{ok,"), 366 gen_decode_selected_type(Erules,Type), 367 emit(["};",nl," Err -> exit({error,{selective_decode,Err}})",nl, 368 " end.",nl]). 369 370gen_decode_selected_type(_Erules,TypeDef) -> 371 Def = TypeDef#typedef.typespec, 372 InnerType = asn1ct_gen:get_inner(Def#type.def), 373 BytesVar = "Tlv", 374 Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || 375 X <- Def#type.tag], 376 case asn1ct_gen:type(InnerType) of 377 'ASN1_OPEN_TYPE' -> 378 asn1ct_name:new(len), 379 gen_dec_prim(Def#type{def='ASN1_OPEN_TYPE'}, 380 BytesVar, Tag); 381 {primitive,bif} -> 382 asn1ct_name:new(len), 383 gen_dec_prim(Def, BytesVar, Tag); 384 {constructed,bif} -> 385 TopType = case TypeDef#typedef.name of 386 A when is_atom(A) -> [A]; 387 N -> N 388 end, 389 DecFunName = lists:concat(["'",dec,"_", 390 asn1ct_gen:list2name(TopType),"'"]), 391 emit([DecFunName,"(",BytesVar, 392 ", ",{asis,Tag},")"]); 393 TheType -> 394 DecFunName = mkfuncname(TheType,dec), 395 emit([DecFunName,"(",BytesVar, 396 ", ",{asis,Tag},")"]) 397 end. 398 399%%=============================================================================== 400%% decode #{type, {tag, def, constraint}} 401%%=============================================================================== 402 403%% This gen_decode is called by the gen_decode/3 that decodes 404%% ComponentType and the type of a SEQUENCE OF/SET OF for an inner 405%% type of an exclusive decode top type.. 406gen_decode(Erules,Typename,Type) when is_record(Type,type) -> 407 InnerType = asn1ct_gen:get_inner(Type#type.def), 408 FunctionName = 409 case asn1ct:get_gen_state_field(active) of 410 true -> 411 Pattern = asn1ct:get_gen_state_field(namelist), 412 Suffix = 413 case asn1ct:maybe_saved_sindex(Typename,Pattern) of 414 I when is_integer(I),I>0 -> 415 lists:concat(["_",I]); 416 _ -> "" 417 end, 418 lists:concat(["'dec-inc-", 419 asn1ct_gen:list2name(Typename),Suffix]); 420 _ -> 421 lists:concat(["'dec_",asn1ct_gen:list2name(Typename)]) 422 end, 423 case asn1ct_gen:type(InnerType) of 424 {constructed,bif} -> 425 ObjFun = 426 case Type#type.tablecinf of 427 [{objfun,_}|_R] -> 428 ", ObjFun"; 429 _ -> 430 "" 431 end, 432 emit([FunctionName,"'(Tlv, TagIn",ObjFun,") ->",nl]), 433 asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); 434 Rec when is_record(Rec,'Externaltypereference') -> 435 case {Typename,asn1ct:get_gen_state_field(namelist)} of 436 {[Cname|_],[{Cname,_}|_]} -> %% 437 %% This referenced type must only be generated 438 %% once as incomplete partial decode. Therefore we 439 %% have to check whether this function already is 440 %% generated. 441 case asn1ct:is_function_generated(Typename) of 442 true -> 443 ok; 444 _ -> 445 asn1ct:generated_refed_func(Typename), 446 #'Externaltypereference'{module=M,type=Name}=Rec, 447 TypeDef = asn1_db:dbget(M,Name), 448 gen_decode(Erules,TypeDef) 449 end; 450 _ -> 451 true 452 end; 453 _ -> 454 true 455 end; 456 457 458%%=============================================================================== 459%% decode ComponentType 460%%=============================================================================== 461 462gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> 463 NewTname = [Cname|Tname], 464 %% The tag is set to [] to avoid that it is taken into account 465 %% twice, both as a component/alternative (passed as argument to 466 %% the encode/decode function), and within the encode decode 467 %% function itself. 468 NewType = Type#type{tag=[]}, 469 case {asn1ct:get_gen_state_field(active), 470 asn1ct:get_tobe_refed_func(NewTname)} of 471 {true,{_,NameList}} -> 472 asn1ct:update_gen_state(namelist,NameList), 473 %% remove to gen_refed_funcs list from tobe_refed_funcs later 474 gen_decode(Erules,NewTname,NewType); 475 {No,_} when No == false; No == undefined -> 476 gen_decode(Erules,NewTname,NewType); 477 _ -> 478 ok 479 end. 480 481 482gen_decode_user(Erules,D) when is_record(D,typedef) -> 483 Typename = [D#typedef.name], 484 Def = D#typedef.typespec, 485 InnerType = asn1ct_gen:get_inner(Def#type.def), 486 BytesVar = "Tlv", 487 case asn1ct_gen:type(InnerType) of 488 'ASN1_OPEN_TYPE' -> 489 asn1ct_name:new(len), 490 gen_dec_prim(Def#type{def='ASN1_OPEN_TYPE'}, 491 BytesVar, {string,"TagIn"}), 492 emit([".",nl,nl]); 493 {primitive,bif} -> 494 asn1ct_name:new(len), 495 gen_dec_prim(Def, BytesVar, {string,"TagIn"}), 496 emit([".",nl,nl]); 497 {constructed,bif} -> 498 asn1ct:update_namelist(D#typedef.name), 499 asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D); 500 TheType -> 501 DecFunName = mkfuncname(TheType,dec), 502 emit([DecFunName,"(",BytesVar, 503 ", TagIn).",nl,nl]) 504 end. 505 506 507gen_dec_prim(Att, BytesVar, DoTag) -> 508 Typename = Att#type.def, 509 Constraint = get_size_constraint(Att#type.constraint), 510 IntConstr = int_constr(Att#type.constraint), 511 NewTypeName = case Typename of 512 'NumericString' -> restricted_string; 513 'TeletexString' -> restricted_string; 514 'T61String' -> restricted_string; 515 'VideotexString' -> restricted_string; 516 'GraphicString' -> restricted_string; 517 'VisibleString' -> restricted_string; 518 'GeneralString' -> restricted_string; 519 'PrintableString' -> restricted_string; 520 'IA5String' -> restricted_string; 521 'ObjectDescriptor'-> restricted_string; 522 'UTCTime' -> restricted_string; 523 'GeneralizedTime' -> restricted_string; 524 'OCTET STRING' -> 525 case asn1ct:use_legacy_types() of 526 true -> restricted_string; 527 false -> Typename 528 end; 529 _ -> Typename 530 end, 531 TagStr = case DoTag of 532 {string,Tag1} -> Tag1; 533 _ when is_list(DoTag) -> {asis,DoTag} 534 end, 535 case NewTypeName of 536 'BOOLEAN'-> 537 call(decode_boolean, [BytesVar,TagStr]); 538 'INTEGER' -> 539 check_constraint(decode_integer, [BytesVar,TagStr], 540 IntConstr, 541 identity, 542 identity); 543 {'INTEGER',NNL} -> 544 check_constraint(decode_integer, 545 [BytesVar,TagStr], 546 IntConstr, 547 identity, 548 fun(Val) -> 549 asn1ct_name:new(val), 550 emit([{curr,val}," = "]), 551 Val(), 552 emit([com,nl, 553 {call,ber,number2name, 554 [{curr,val},{asis,NNL}]}]) 555 end); 556 {'ENUMERATED',NNL} -> 557 gen_dec_enumerated(BytesVar, NNL, TagStr); 558 'REAL' -> 559 asn1ct_name:new(tmpbuf), 560 emit(["begin",nl, 561 {curr,tmpbuf}," = ", 562 {call,ber,match_tags,[BytesVar,TagStr]},com,nl, 563 {call,real_common,decode_real,[{curr,tmpbuf}]},nl, 564 "end",nl]); 565 {'BIT STRING',NNL} -> 566 gen_dec_bit_string(BytesVar, Constraint, NNL, TagStr); 567 'NULL' -> 568 call(decode_null, [BytesVar,TagStr]); 569 'OBJECT IDENTIFIER' -> 570 call(decode_object_identifier, [BytesVar,TagStr]); 571 'RELATIVE-OID' -> 572 call(decode_relative_oid, [BytesVar,TagStr]); 573 'OCTET STRING' -> 574 check_constraint(decode_octet_string, [BytesVar,TagStr], 575 Constraint, {erlang,byte_size}, identity); 576 restricted_string -> 577 check_constraint(decode_restricted_string, [BytesVar,TagStr], 578 Constraint, 579 {erlang,byte_size}, 580 fun(Val) -> 581 emit("binary_to_list("), 582 Val(), 583 emit(")") 584 end); 585 'UniversalString' -> 586 check_constraint(decode_universal_string, [BytesVar,TagStr], 587 Constraint, {erlang,length}, identity); 588 'UTF8String' -> 589 call(decode_UTF8_string, [BytesVar,TagStr]); 590 'BMPString' -> 591 check_constraint(decode_BMP_string, [BytesVar,TagStr], 592 Constraint, {erlang,length}, identity); 593 'ASN1_OPEN_TYPE' -> 594 call(decode_open_type_as_binary, [BytesVar,TagStr]) 595 end. 596 597%% Simplify an integer constraint so that we can efficiently test it. 598-spec int_constr(term()) -> [] | {integer(),integer()|'MAX'}. 599int_constr(C) -> 600 case asn1ct_imm:effective_constraint(integer, C) of 601 [{_,[]}] -> 602 %% Extension - ignore constraint. 603 []; 604 [{'ValueRange',{'MIN',_}}] -> 605 %% Tricky to implement efficiently - ignore it. 606 []; 607 [{'ValueRange',{_,_}=Range}] -> 608 Range; 609 [{'SingleValue',Sv}] -> 610 Sv; 611 [] -> 612 [] 613 end. 614 615gen_dec_bit_string(BytesVar, _Constraint, [_|_]=NNL, TagStr) -> 616 call(decode_named_bit_string, 617 [BytesVar,{asis,NNL},TagStr]); 618gen_dec_bit_string(BytesVar, Constraint, [], TagStr) -> 619 case asn1ct:get_bit_string_format() of 620 compact -> 621 check_constraint(decode_compact_bit_string, 622 [BytesVar,TagStr], 623 Constraint, 624 {ber,compact_bit_string_size}, 625 identity); 626 legacy -> 627 check_constraint(decode_native_bit_string, 628 [BytesVar,TagStr], 629 Constraint, 630 {erlang,bit_size}, 631 fun(Val) -> 632 asn1ct_name:new(val), 633 emit([{curr,val}," = "]), 634 Val(), 635 emit([com,nl, 636 {call,ber,native_to_legacy_bit_string, 637 [{curr,val}]}]) 638 end); 639 bitstring -> 640 check_constraint(decode_native_bit_string, 641 [BytesVar,TagStr], 642 Constraint, 643 {erlang,bit_size}, 644 identity) 645 end. 646 647check_constraint(F, Args, Constr, PreConstr0, ReturnVal0) -> 648 PreConstr = case PreConstr0 of 649 identity -> 650 fun(V) -> V end; 651 {Mod,Name} -> 652 fun(V) -> 653 asn1ct_name:new(c), 654 emit([{curr,c}," = ", 655 {call,Mod,Name,[V]},com,nl]), 656 {curr,c} 657 end 658 end, 659 ReturnVal = case ReturnVal0 of 660 identity -> fun(Val) -> Val() end; 661 _ -> ReturnVal0 662 end, 663 case Constr of 664 [] when ReturnVal0 =:= identity -> 665 %% No constraint, no complications. 666 call(F, Args); 667 [] -> 668 %% No constraint, but the return value could consist 669 %% of more than one statement. 670 emit(["begin",nl]), 671 ReturnVal(fun() -> call(F, Args) end), 672 emit([nl, 673 "end",nl]); 674 _ -> 675 %% There is a constraint. 676 asn1ct_name:new(val), 677 emit(["begin",nl, 678 {curr,val}," = ",{call,ber,F,Args},com,nl]), 679 PreVal0 = asn1ct_gen:mk_var(asn1ct_name:curr(val)), 680 PreVal = PreConstr(PreVal0), 681 emit("if "), 682 case Constr of 683 {Min,Max} -> 684 emit([{asis,Min}," =< ",PreVal,", ", 685 PreVal," =< ",{asis,Max}]); 686 Sv when is_integer(Sv) -> 687 emit([PreVal," =:= ",{asis,Sv}]) 688 end, 689 emit([" ->",nl]), 690 ReturnVal(fun() -> emit(PreVal0) end), 691 emit([";",nl, 692 "true ->",nl, 693 "exit({error,{asn1,bad_range}})",nl, 694 "end",nl, 695 "end"]) 696 end. 697 698gen_dec_enumerated(BytesVar, NNL0, TagStr) -> 699 asn1ct_name:new(enum), 700 emit(["case ", 701 {call,ber,decode_integer,[BytesVar,TagStr]}, 702 " of",nl]), 703 NNL = case NNL0 of 704 {L1,L2} -> 705 L1 ++ L2 ++ [accept]; 706 [_|_] -> 707 NNL0 ++ [error] 708 end, 709 gen_dec_enumerated_1(NNL), 710 emit("end"). 711 712gen_dec_enumerated_1([accept]) -> 713 asn1ct_name:new(default), 714 emit([{curr,default}," -> {asn1_enum,",{curr,default},"}",nl]); 715gen_dec_enumerated_1([error]) -> 716 asn1ct_name:new(default), 717 emit([{curr,default}," -> exit({error,{asn1,{illegal_enumerated,", 718 {curr,default},"}}})",nl]); 719gen_dec_enumerated_1([{V,K}|T]) -> 720 emit([{asis,K}," -> ",{asis,V},";",nl]), 721 gen_dec_enumerated_1(T). 722 723 724%% Object code generating for encoding and decoding 725%% ------------------------------------------------ 726 727gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) -> 728 ObjName = Obj#typedef.name, 729 Def = Obj#typedef.typespec, 730 #'Externaltypereference'{module=M,type=ClName} = Def#'Object'.classname, 731 Class = asn1_db:dbget(M,ClName), 732 {object,_,Fields} = Def#'Object'.def, 733 emit([nl,nl,nl, 734 "%%================================",nl, 735 "%% ",ObjName,nl, 736 "%%================================",nl]), 737 EncConstructed = 738 gen_encode_objectfields(ClName,get_class_fields(Class), 739 ObjName,Fields,[]), 740 emit(nl), 741 gen_encode_constr_type(Erules,EncConstructed), 742 emit(nl), 743 DecConstructed = 744 gen_decode_objectfields(ClName,get_class_fields(Class), 745 ObjName,Fields,[]), 746 emit(nl), 747 gen_decode_constr_type(Erules,DecConstructed), 748 emit_tlv_format_function(). 749 750gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], 751 ObjName,ObjectFields,ConstrAcc) -> 752 EmitFuncClause = 753 fun(Arg) -> 754 emit([{asis,enc_func(ObjName)},"(",{asis,Name}, 755 ", ",Arg,", _RestPrimFieldName) ->",nl]) 756 end, 757 MaybeConstr= 758 case {get_object_field(Name,ObjectFields),OptOrMand} of 759 {false,'OPTIONAL'} -> 760 EmitFuncClause("Val"), 761 emit([" {Val,0}"]), 762 []; 763 {false,{'DEFAULT',DefaultType}} -> 764 EmitFuncClause("Val"), 765 gen_encode_default_call(ClassName,Name,DefaultType); 766 {{Name,TypeSpec},_} -> 767 %% A specified field owerwrites any 'DEFAULT' or 768 %% 'OPTIONAL' field in the class 769 EmitFuncClause("Val"), 770 gen_encode_field_call(ObjName,Name,TypeSpec) 771 end, 772 case more_genfields(Rest) of 773 true -> 774 emit([";",nl]); 775 false -> 776 emit([".",nl]) 777 end, 778 gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields, 779 MaybeConstr++ConstrAcc); 780gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], 781 ObjName,ObjectFields,ConstrAcc) -> 782 CurrentMod = get(currmod), 783 EmitFuncClause = 784 fun(Args) -> 785 emit([{asis,enc_func(ObjName)},"(",{asis,Name}, 786 ", ",Args,") ->",nl]) 787 end, 788 case {get_object_field(Name,ObjectFields),OptOrMand} of 789 {false,'OPTIONAL'} -> 790 EmitFuncClause("_,_"), 791 emit([" exit({error,{'use of missing field in object', ",{asis,Name}, 792 "}})"]); 793 {false,{'DEFAULT',_DefaultObject}} -> 794 exit({error,{asn1,{"not implemented yet",Name}}}); 795 {{Name,#'Externalvaluereference'{module=CurrentMod, 796 value=TypeName}},_} -> 797 EmitFuncClause(" Val, [H|T]"), 798 emit([indent(3),{asis,enc_func(TypeName)},"(H, Val, T)"]); 799 {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> 800 EmitFuncClause(" Val, [H|T]"), 801 emit([indent(3),{asis,M},":",{asis,enc_func(TypeName)}, 802 "(H, Val, T)"]); 803 {{Name,#typedef{name=TypeName}},_} when is_atom(TypeName) -> 804 EmitFuncClause(" Val, [H|T]"), 805 emit([indent(3),{asis,enc_func(TypeName)},"(H, Val, T)"]) 806 end, 807 case more_genfields(Rest) of 808 true -> 809 emit([";",nl]); 810 false -> 811 emit([".",nl]) 812 end, 813 gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); 814 815 816gen_encode_objectfields(ClassName,[_C|Cs],O,OF,Acc) -> 817 gen_encode_objectfields(ClassName,Cs,O,OF,Acc); 818gen_encode_objectfields(_,[],_,_,Acc) -> 819 Acc. 820 821gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> 822 case is_already_generated(enc,TypeDef#typedef.name) of 823 true -> ok; 824 false -> gen_encode_user(Erules, TypeDef, false) 825 end, 826 gen_encode_constr_type(Erules,Rest); 827gen_encode_constr_type(_,[]) -> 828 ok. 829 830gen_encode_field_call(_ObjName,_FieldName, 831 #'Externaltypereference'{module=M,type=T}) -> 832 CurrentMod = get(currmod), 833 TDef = asn1_db:dbget(M,T), 834 Def = TDef#typedef.typespec, 835 OTag = Def#type.tag, 836 Tag = [encode_tag_val(decode_class(X#tag.class), 837 X#tag.form,X#tag.number)|| 838 X <- OTag], 839 if 840 M == CurrentMod -> 841 emit([" ",{asis,enc_func(T)},"(Val, ",{asis,Tag},")"]), 842 []; 843 true -> 844 emit([" ",{asis,M},":",{asis,enc_func(T)}, 845 "(Val, ",{asis,Tag},")"]), 846 [] 847 end; 848gen_encode_field_call(ObjName,FieldName,Type) -> 849 Def = Type#typedef.typespec, 850 OTag = Def#type.tag, 851 Tag = [encode_tag_val(decode_class(X#tag.class), 852 X#tag.form,X#tag.number)|| 853 X <- OTag], 854 case Type#typedef.name of 855 {primitive,bif} -> %tag should be the primitive tag 856 gen_encode_prim(ber,Def,{asis,lists:reverse(Tag)}, 857 "Val"), 858 []; 859 {constructed,bif} -> 860 Name = lists:concat([ObjName,'_',FieldName]), 861 emit([" ",{asis,enc_func(Name)},"(Val,",{asis,Tag},")"]), 862 [Type#typedef{name=list_to_atom(Name)}]; 863 {ExtMod,TypeName} -> 864 emit([" ",{asis,ExtMod},":",{asis,enc_func(TypeName)}, 865 "(Val,",{asis,Tag},")"]), 866 []; 867 TypeName -> 868 emit([" ",{asis,enc_func(TypeName)}, 869 "(Val,",{asis,Tag},")"]), 870 [] 871 end. 872 873gen_encode_default_call(ClassName,FieldName,Type) -> 874 CurrentMod = get(currmod), 875 InnerType = asn1ct_gen:get_inner(Type#type.def), 876 OTag = Type#type.tag, 877 Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag], 878 case asn1ct_gen:type(InnerType) of 879 {constructed,bif} -> 880 Name = lists:concat([ClassName,'_',FieldName]), 881 emit([" ",{asis,enc_func(Name)}, 882 "(Val, ",{asis,Tag},")"]), 883 [#typedef{name=list_to_atom(Name),typespec=Type}]; 884 {primitive,bif} -> 885 gen_encode_prim(ber,Type,{asis,lists:reverse(Tag)},"Val"), 886 []; 887 #'Externaltypereference'{module=CurrentMod,type=Etype} -> 888 emit([" 'enc_",Etype,"'(Val, ",{asis,Tag},")",nl]), 889 []; 890 #'Externaltypereference'{module=Emod,type=Etype} -> 891 emit([" '",Emod,"':'enc_",Etype,"'(Val, ",{asis,Tag},")",nl]), 892 [] 893 end. 894 895%%%%%%%%%%%%%%%% 896 897gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], 898 ObjName,ObjectFields,ConstrAcc) -> 899 EmitFuncClause = 900 fun(Arg) -> 901 emit([{asis,dec_func(ObjName)},"(",{asis,Name}, 902 ", ",Arg,",_) ->",nl]) 903 end, 904 MaybeConstr= 905 case {get_object_field(Name,ObjectFields),OptOrMand} of 906 {false,'OPTIONAL'} -> 907 EmitFuncClause(" Bytes"), 908 emit([" Bytes"]), 909 []; 910 {false,{'DEFAULT',DefaultType}} -> 911 EmitFuncClause("Bytes"), 912 emit_tlv_format("Bytes"), 913 gen_decode_default_call(ClassName,Name,"Tlv",DefaultType); 914 {{Name,TypeSpec},_} -> 915 %% A specified field owerwrites any 'DEFAULT' or 916 %% 'OPTIONAL' field in the class 917 EmitFuncClause("Bytes"), 918 emit_tlv_format("Bytes"), 919 gen_decode_field_call(ObjName,Name,"Tlv",TypeSpec) 920 end, 921 case more_genfields(Rest) of 922 true -> 923 emit([";",nl]); 924 false -> 925 emit([".",nl]) 926 end, 927 gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc); 928gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], 929 ObjName,ObjectFields,ConstrAcc) -> 930 CurrentMod = get(currmod), 931 EmitFuncClause = 932 fun(Args) -> 933 emit([{asis,dec_func(ObjName)},"(",{asis,Name}, 934 ", ",Args,") ->",nl]) 935 end, 936 case {get_object_field(Name,ObjectFields),OptOrMand} of 937 {false,'OPTIONAL'} -> 938 EmitFuncClause("_,_"), 939 emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name}, 940 "}})"]); 941 {false,{'DEFAULT',_DefaultObject}} -> 942 exit({error,{asn1,{"not implemented yet",Name}}}); 943 {{Name,#'Externalvaluereference'{module=CurrentMod, 944 value=TypeName}},_} -> 945 EmitFuncClause("Bytes,[H|T]"), 946 emit([indent(3),{asis,dec_func(TypeName)},"(H, Bytes, T)"]); 947 {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> 948 EmitFuncClause("Bytes,[H|T]"), 949 emit([indent(3),{asis,M},":",{asis,dec_func(TypeName)}, 950 "(H, Bytes, T)"]); 951 {{Name,#typedef{name=TypeName}},_} when is_atom(TypeName) -> 952 EmitFuncClause("Bytes,[H|T]"), 953 emit([indent(3),{asis,dec_func(TypeName)},"(H, Bytes, T)"]) 954 end, 955 case more_genfields(Rest) of 956 true -> 957 emit([";",nl]); 958 false -> 959 emit([".",nl]) 960 end, 961 gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); 962gen_decode_objectfields(CN,[_C|Cs],O,OF,CAcc) -> 963 gen_decode_objectfields(CN,Cs,O,OF,CAcc); 964gen_decode_objectfields(_,[],_,_,CAcc) -> 965 CAcc. 966 967emit_tlv_format(Bytes) -> 968 notice_tlv_format_gen(), % notice for generating of tlv_format/1 969 emit([" Tlv = tlv_format(",Bytes,"),",nl]). 970 971notice_tlv_format_gen() -> 972 Module = get(currmod), 973 case get(tlv_format) of 974 {done,Module} -> 975 ok; 976 _ -> % true or undefined 977 put(tlv_format,true) 978 end. 979 980emit_tlv_format_function() -> 981 Module = get(currmod), 982 case get(tlv_format) of 983 true -> 984 emit_tlv_format_function1(), 985 put(tlv_format,{done,Module}); 986 _ -> 987 ok 988 end. 989emit_tlv_format_function1() -> 990 emit(["tlv_format(Bytes) when is_binary(Bytes) ->",nl, 991 " {Tlv,_} = ",{call,ber,ber_decode_nif,["Bytes"]},com,nl, 992 " Tlv;",nl, 993 "tlv_format(Bytes) ->",nl, 994 " Bytes.",nl]). 995 996 997gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> 998 case is_already_generated(dec,TypeDef#typedef.name) of 999 true -> ok; 1000 _ -> 1001 emit([nl,nl, 1002 "'dec_",TypeDef#typedef.name, 1003 "'(Tlv, TagIn) ->",nl]), 1004 gen_decode_user(Erules, TypeDef) 1005 end, 1006 gen_decode_constr_type(Erules,Rest); 1007gen_decode_constr_type(_,[]) -> 1008 ok. 1009 1010%%%%%%%%%%% 1011gen_decode_field_call(_ObjName,_FieldName,Bytes, 1012 #'Externaltypereference'{module=M,type=T}) -> 1013 CurrentMod = get(currmod), 1014 TDef = asn1_db:dbget(M,T), 1015 Def = TDef#typedef.typespec, 1016 OTag = Def#type.tag, 1017 Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || 1018 X <- OTag], 1019 if 1020 M == CurrentMod -> 1021 emit([" ",{asis,dec_func(T)},"(",Bytes, 1022 ", ",{asis,Tag},")"]), 1023 []; 1024 true -> 1025 emit([" ",{asis,M},":",{asis,dec_func(T)}, 1026 "(",Bytes,", ",{asis,Tag},")"]), 1027 [] 1028 end; 1029gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> 1030 Def = Type#typedef.typespec, 1031 OTag = Def#type.tag, 1032 Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || 1033 X <- OTag], 1034 case Type#typedef.name of 1035 {primitive,bif} -> 1036 gen_dec_prim(Def, Bytes, Tag), 1037 []; 1038 {constructed,bif} -> 1039 Name = lists:concat([ObjName,"_",FieldName]), 1040 emit([" ",{asis,dec_func(Name)}, 1041 "(",Bytes,",",{asis,Tag},")"]), 1042 [Type#typedef{name=list_to_atom(Name)}]; 1043 {ExtMod,TypeName} -> 1044 emit([" ",{asis,ExtMod},":",{asis,dec_func(TypeName)}, 1045 "(",Bytes,",",{asis,Tag},")"]), 1046 []; 1047 TypeName -> 1048 emit([" ",{asis,dec_func(TypeName)}, 1049 "(",Bytes,",",{asis,Tag},")"]), 1050 [] 1051 end. 1052 1053gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> 1054 CurrentMod = get(currmod), 1055 InnerType = asn1ct_gen:get_inner(Type#type.def), 1056 OTag = Type#type.tag, 1057 Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag], 1058 case asn1ct_gen:type(InnerType) of 1059 {constructed,bif} -> 1060 emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,",", 1061 {asis,Tag},")"]), 1062 [#typedef{name=list_to_atom(lists:concat([ClassName,'_', 1063 FieldName])), 1064 typespec=Type}]; 1065 {primitive,bif} -> 1066 gen_dec_prim(Type, Bytes, Tag), 1067 []; 1068 #'Externaltypereference'{module=CurrentMod,type=Etype} -> 1069 emit([" 'dec_",Etype,"'(",Bytes, " ,",{asis,Tag},")",nl]), 1070 []; 1071 #'Externaltypereference'{module=Emod,type=Etype} -> 1072 emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", ", 1073 {asis,Tag},")",nl]), 1074 [] 1075 end. 1076%%%%%%%%%%% 1077 1078is_already_generated(Operation,Name) -> 1079 case get(class_default_type) of 1080 undefined -> 1081 put(class_default_type,[{Operation,Name}]), 1082 false; 1083 GeneratedList -> 1084 case lists:member({Operation,Name},GeneratedList) of 1085 true -> 1086 true; 1087 false -> 1088 put(class_default_type,[{Operation,Name}|GeneratedList]), 1089 false 1090 end 1091 end. 1092 1093more_genfields([]) -> 1094 false; 1095more_genfields([Field|Fields]) -> 1096 case element(1,Field) of 1097 typefield -> 1098 true; 1099 objectfield -> 1100 true; 1101 _ -> 1102 more_genfields(Fields) 1103 end. 1104 1105 1106 1107 1108%% Object Set code generating for encoding and decoding 1109%% ---------------------------------------------------- 1110gen_objectset_code(Erules,ObjSet) -> 1111 ObjSetName = ObjSet#typedef.name, 1112 Def = ObjSet#typedef.typespec, 1113 #'Externaltypereference'{module=ClassModule, 1114 type=ClassName} = Def#'ObjectSet'.class, 1115 ClassDef = asn1_db:dbget(ClassModule,ClassName), 1116 UniqueFName = Def#'ObjectSet'.uniquefname, 1117 Set = Def#'ObjectSet'.set, 1118 emit([nl,nl,nl, 1119 "%%================================",nl, 1120 "%% ",ObjSetName,nl, 1121 "%%================================",nl]), 1122 case ClassName of 1123 {_Module,ExtClassName} -> 1124 gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ExtClassName,ClassDef); 1125 _ -> 1126 gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef) 1127 end, 1128 emit(nl). 1129 1130gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> 1131 ClassFields = get_class_fields(ClassDef), 1132 InternalFuncs=gen_objset_enc(Erules,ObjSetName,UniqueFName,Set, 1133 ClassName,ClassFields,1,[]), 1134 gen_objset_dec(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), 1135 gen_internal_funcs(Erules,InternalFuncs). 1136 1137%% gen_objset_enc iterates over the objects of the object set 1138gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) -> 1139 %% There is no unique field in the class of this object set 1140 %% don't bother about the constraint 1141 []; 1142gen_objset_enc(Erules, ObjSetName, UniqueName, 1143 [{ObjName,Val,Fields}|T], ClName, ClFields, 1144 NthObj,Acc)-> 1145 CurrMod = get(currmod), 1146 {InternalFunc,NewNthObj}= 1147 case ObjName of 1148 {no_mod,no_name} -> 1149 gen_inlined_enc_funs(Fields, ClFields, ObjSetName, Val, NthObj); 1150 {CurrMod,Name} -> 1151 emit([asis_atom(["getenc_",ObjSetName]), 1152 "(Id) when Id =:= ",{asis,Val}," ->",nl, 1153 " fun ",asis_atom(["enc_",Name]),"/3;",nl]), 1154 {[],NthObj}; 1155 {ModuleName,Name} -> 1156 emit([asis_atom(["getenc_",ObjSetName]), 1157 "(Id) when Id =:= ",{asis,Val}," ->",nl]), 1158 emit_ext_fun(enc,ModuleName,Name), 1159 emit([";",nl]), 1160 {[],NthObj}; 1161 _ -> 1162 emit([asis_atom(["getenc_",ObjSetName]), 1163 "(",{asis,Val},") ->",nl, 1164 " fun ",asis_atom(["enc_",ObjName]),"/3;",nl]), 1165 {[],NthObj} 1166 end, 1167 gen_objset_enc(Erules, ObjSetName, UniqueName, T, ClName, ClFields, 1168 NewNthObj, InternalFunc ++ Acc); 1169%% See X.681 Annex E for the following case 1170gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, 1171 _ClFields,_NthObj,Acc) -> 1172 emit([asis_atom(["getenc_",ObjSetName]),"(_) ->",nl, 1173 indent(2),"fun(_, Val, _RestPrimFieldName) ->",nl]), 1174 emit_enc_open_type(4), 1175 emit([nl, 1176 indent(2),"end.",nl,nl]), 1177 Acc; 1178gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) -> 1179 emit_default_getenc(ObjSetName, UniqueName), 1180 emit([".",nl,nl]), 1181 Acc. 1182 1183emit_ext_fun(EncDec,ModuleName,Name) -> 1184 emit([indent(3),"fun(T,V,O) -> '",ModuleName,"':'",EncDec,"_", 1185 Name,"'(T,V,O) end"]). 1186 1187emit_default_getenc(ObjSetName,UniqueName) -> 1188 emit([asis_atom(["getenc_",ObjSetName]),"(ErrV) ->",nl, 1189 indent(3),"fun(C,V,_) ->",nl, 1190 "exit({'Type not compatible with table constraint',{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). 1191 1192%% gen_inlined_enc_funs for each object iterates over all fields of a 1193%% class, and for each typefield it checks if the object has that 1194%% field and emits the proper code. 1195gen_inlined_enc_funs(Fields, [{typefield,_,_}|_]=T, ObjSetName, Val, NthObj) -> 1196 emit([asis_atom(["getenc_",ObjSetName]),"(",{asis,Val},") ->",nl, 1197 indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl, 1198 indent(6),"case Type of",nl]), 1199 gen_inlined_enc_funs1(Fields, T, ObjSetName, [], NthObj, []); 1200gen_inlined_enc_funs(Fields, [_|Rest], ObjSetName, Val, NthObj) -> 1201 gen_inlined_enc_funs(Fields, Rest, ObjSetName, Val, NthObj); 1202gen_inlined_enc_funs(_, [], _, _, NthObj) -> 1203 {[],NthObj}. 1204 1205gen_inlined_enc_funs1(Fields, [{typefield,Name,_}|Rest], ObjSetName, 1206 Sep0, NthObj, Acc0) -> 1207 emit(Sep0), 1208 Sep = [";",nl], 1209 CurrMod = get(currmod), 1210 InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), 1211 {Acc,NAdd} = 1212 case lists:keyfind(Name,1,Fields) of 1213 {_,#type{}=Type} -> 1214 {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), 1215 {Ret++Acc0,N}; 1216 {_,#typedef{}=Type} -> 1217 emit([indent(9),{asis,Name}," ->",nl]), 1218 {Ret,N} = emit_inner_of_fun(Type, InternalDefFunName), 1219 {Ret++Acc0,N}; 1220 {_,#'Externaltypereference'{module=M,type=T}} -> 1221 emit([indent(9),{asis,Name}," ->",nl]), 1222 if 1223 M =:= CurrMod -> 1224 emit([indent(12),"'enc_",T,"'(Val)"]); 1225 true -> 1226 #typedef{typespec=Type} = asn1_db:dbget(M,T), 1227 OTag = Type#type.tag, 1228 Tag = [encode_tag_val(decode_class(X#tag.class), 1229 X#tag.form,X#tag.number) || 1230 X <- OTag], 1231 emit([indent(12),"'",M,"':'enc_",T,"'(Val, ", 1232 {asis,Tag},")"]) 1233 end, 1234 {Acc0,0}; 1235 false -> 1236 %% This field was not present in the object; thus, there 1237 %% was no type in the table and we therefore generate 1238 %% code that returns the input for application 1239 %% treatment. 1240 emit([indent(9),{asis,Name}," ->",nl]), 1241 emit_enc_open_type(11), 1242 {Acc0,0} 1243 end, 1244 gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj+NAdd, Acc); 1245gen_inlined_enc_funs1(Fields,[_|Rest], ObjSetName, Sep, NthObj, Acc)-> 1246 gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj, Acc); 1247gen_inlined_enc_funs1(_, [], _, _, NthObj, Acc) -> 1248 emit([nl,indent(6),"end",nl, 1249 indent(3),"end;",nl]), 1250 {Acc,NthObj}. 1251 1252emit_enc_open_type(I) -> 1253 Indent = indent(I), 1254 S = [Indent, "case Val of",nl, 1255 Indent,indent(2),"{asn1_OPENTYPE,Bin} when is_binary(Bin) ->",nl, 1256 Indent,indent(4),"{Bin,byte_size(Bin)}"| 1257 case asn1ct:use_legacy_types() of 1258 false -> 1259 [nl, 1260 Indent,"end"]; 1261 true -> 1262 [";",nl, 1263 Indent,indent(2),"Bin when is_binary(Bin) ->",nl, 1264 Indent,indent(4),"{Bin,byte_size(Bin)};",nl, 1265 Indent,indent(2),"_ ->",nl, 1266 Indent,indent(4),"{Val,length(Val)}",nl, 1267 Indent, "end"] 1268 end], 1269 emit(S). 1270 1271emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, 1272 InternalDefFunName) -> 1273 OTag = Type#type.tag, 1274 Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag], 1275 case {ExtMod,Name} of 1276 {primitive,bif} -> 1277 emit(indent(12)), 1278 gen_encode_prim(ber,Type,[{asis,lists:reverse(Tag)}],"Val"), 1279 {[],0}; 1280 {constructed,bif} -> 1281 emit([indent(12),"'enc_", 1282 InternalDefFunName,"'(Val, ",{asis,Tag},")"]), 1283 {[TDef#typedef{name=InternalDefFunName}],1}; 1284 _ -> 1285 emit([indent(12),"'",ExtMod,"':'enc_",Name,"'(Val",{asis,Tag},")"]), 1286 {[],0} 1287 end; 1288emit_inner_of_fun(#typedef{name=Name},_) -> 1289 emit([indent(12),"'enc_",Name,"'(Val)"]), 1290 {[],0}; 1291emit_inner_of_fun(Type,_) when is_record(Type,type) -> 1292 CurrMod = get(currmod), 1293 case Type#type.def of 1294 Def when is_atom(Def) -> 1295 OTag = Type#type.tag, 1296 Tag = [encode_tag_val(decode_class(X#tag.class), 1297 X#tag.form,X#tag.number)||X <- OTag], 1298 emit([indent(9),Def," ->",nl,indent(12)]), 1299 gen_encode_prim(ber,Type,{asis,lists:reverse(Tag)},"Val"); 1300 #'Externaltypereference'{module=CurrMod,type=T} -> 1301 emit([indent(9),T," ->",nl,indent(12),"'enc_",T, 1302 "'(Val)"]); 1303 #'Externaltypereference'{module=ExtMod,type=T} -> 1304 #typedef{typespec=ExtType} = asn1_db:dbget(ExtMod,T), 1305 OTag = ExtType#type.tag, 1306 Tag = [encode_tag_val(decode_class(X#tag.class), 1307 X#tag.form,X#tag.number) || 1308 X <- OTag], 1309 emit([indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", 1310 T,"'(Val, ",{asis,Tag},")"]) 1311 end, 1312 {[],0}. 1313 1314indent(N) -> 1315 lists:duplicate(N,32). % 32 = space 1316 1317 1318gen_objset_dec(_,_,{unique,undefined},_,_,_,_) -> 1319 %% There is no unique field in the class of this object set 1320 %% don't bother about the constraint 1321 ok; 1322gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], 1323 ClName, ClFields, NthObj)-> 1324 CurrMod = get(currmod), 1325 NewNthObj= 1326 case ObjName of 1327 {no_mod,no_name} -> 1328 gen_inlined_dec_funs(Fields,ClFields,ObjSName,Val,NthObj); 1329 {CurrMod,Name} -> 1330 emit([asis_atom(["getdec_",ObjSName]), 1331 "(Id) when Id =:= ",{asis,Val}," ->",nl, 1332 " fun 'dec_",Name,"'/3;", nl]), 1333 NthObj; 1334 {ModuleName,Name} -> 1335 emit([asis_atom(["getdec_",ObjSName]), 1336 "(Id) when Id =:= ",{asis,Val}," ->",nl]), 1337 emit_ext_fun(dec,ModuleName,Name), 1338 emit([";",nl]), 1339 NthObj; 1340 _ -> 1341 emit([asis_atom(["getdec_",ObjSName]), 1342 "(",{asis,Val},") ->",nl, 1343 " fun 'dec_",ObjName,"'/3;", nl]), 1344 NthObj 1345 end, 1346 gen_objset_dec(Erules, ObjSName, UniqueName, T, ClName, 1347 ClFields, NewNthObj); 1348gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, 1349 _ClFields,_NthObj) -> 1350 emit([asis_atom(["getdec_",ObjSetName]),"(_) ->",nl, 1351 indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), 1352 emit_dec_open_type(4), 1353 emit([nl, 1354 indent(2),"end.",nl,nl]), 1355 ok; 1356gen_objset_dec(_, ObjSetName, UniqueName, [], _, _, _) -> 1357 emit_default_getdec(ObjSetName, UniqueName), 1358 emit([".",nl,nl]), 1359 ok. 1360 1361emit_default_getdec(ObjSetName,UniqueName) -> 1362 emit(["'getdec_",ObjSetName,"'(ErrV) ->",nl]), 1363 emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). 1364 1365gen_inlined_dec_funs(Fields, [{typefield,_,_}|_]=ClFields, ObjSetName, Val, NthObj) -> 1366 emit(["'getdec_",ObjSetName,"'(",{asis,Val},") ->",nl]), 1367 emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",nl, 1368 indent(6),"case Type of",nl]), 1369 gen_inlined_dec_funs1(Fields, ClFields, ObjSetName, "", NthObj); 1370gen_inlined_dec_funs(Fields, [_|ClFields], ObjSetName, Val, NthObj) -> 1371 gen_inlined_dec_funs(Fields, ClFields, ObjSetName, Val, NthObj); 1372gen_inlined_dec_funs(_, _, _, _,NthObj) -> 1373 NthObj. 1374 1375gen_inlined_dec_funs1(Fields, [{typefield,Name,Prop}|Rest], 1376 ObjSetName, Sep0, NthObj) -> 1377 emit(Sep0), 1378 Sep = [";",nl], 1379 DecProp = case Prop of 1380 'OPTIONAL' -> opt_or_default; 1381 {'DEFAULT',_} -> opt_or_default; 1382 _ -> mandatory 1383 end, 1384 InternalDefFunName = [NthObj,Name,ObjSetName], 1385 N = case lists:keyfind(Name, 1, Fields) of 1386 {_,#type{}=Type} -> 1387 emit_inner_of_decfun(Type,DecProp,InternalDefFunName); 1388 {_,#typedef{}=Type} -> 1389 emit([indent(9),{asis,Name}," ->",nl]), 1390 emit_inner_of_decfun(Type,DecProp,InternalDefFunName); 1391 {_,#'Externaltypereference'{module=M,type=T}} -> 1392 emit([indent(9),{asis,Name}," ->",nl]), 1393 CurrMod = get(currmod), 1394 if 1395 M =:= CurrMod -> 1396 emit([indent(12),"'dec_",T,"'(Bytes)"]); 1397 true -> 1398 #typedef{typespec=Type} = asn1_db:dbget(M,T), 1399 OTag = Type#type.tag, 1400 Tag = [(decode_class(X#tag.class) bsl 10) + 1401 X#tag.number || X <- OTag], 1402 emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ",{asis,Tag},")"]) 1403 end, 1404 0; 1405 false -> 1406 emit([indent(9),{asis,Name}," ->",nl]), 1407 emit_dec_open_type(11), 1408 0 1409 end, 1410 gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N); 1411gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj)-> 1412 gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj); 1413gen_inlined_dec_funs1(_, [], _, _, NthObj) -> 1414 emit([nl,indent(6),"end",nl, 1415 indent(3),"end;",nl]), 1416 NthObj. 1417 1418emit_dec_open_type(I) -> 1419 Indent = indent(I), 1420 S = case asn1ct:use_legacy_types() of 1421 false -> 1422 [Indent, "case Bytes of",nl, 1423 Indent,indent(2),"Bin when is_binary(Bin) -> ",nl, 1424 Indent,indent(4),"{asn1_OPENTYPE,Bin};",nl, 1425 Indent,indent(2),"_ ->",nl, 1426 Indent,indent(4),"{asn1_OPENTYPE,", 1427 {call,ber,ber_encode,["Bytes"]},"}",nl, 1428 Indent, "end"]; 1429 true -> 1430 [Indent, "case Bytes of",nl, 1431 Indent,indent(2),"Bin when is_binary(Bin) -> ",nl, 1432 Indent,indent(4),"Bin;",nl, 1433 Indent,indent(2),"_ ->",nl, 1434 Indent,indent(4),{call,ber,ber_encode,["Bytes"]},nl, 1435 Indent, "end"] 1436 end, 1437 emit(S). 1438 1439emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, _Prop, 1440 InternalDefFunName) -> 1441 OTag = Type#type.tag, 1442 Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag], 1443 case {ExtName,Name} of 1444 {primitive,bif} -> 1445 emit(indent(12)), 1446 gen_dec_prim(Type, "Bytes", Tag), 1447 0; 1448 {constructed,bif} -> 1449 emit([indent(12),"'dec_", 1450 asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ", 1451 {asis,Tag},")"]), 1452 1; 1453 _ -> 1454 emit([indent(12),"'",ExtName,"':'dec_",Name,"'(Bytes, ", 1455 {asis,Tag},")"]), 1456 0 1457 end; 1458emit_inner_of_decfun(#typedef{name=Name},_Prop,_) -> 1459 emit([indent(12),"'dec_",Name,"'(Bytes)"]), 1460 0; 1461emit_inner_of_decfun(#type{}=Type, _Prop, _) -> 1462 OTag = Type#type.tag, 1463 Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag], 1464 CurrMod = get(currmod), 1465 Def = Type#type.def, 1466 InnerType = asn1ct_gen:get_inner(Def), 1467 WhatKind = asn1ct_gen:type(InnerType), 1468 case WhatKind of 1469 {primitive,bif} -> 1470 emit([indent(9),Def," ->",nl,indent(12)]), 1471 gen_dec_prim(Type, "Bytes", Tag); 1472 #'Externaltypereference'{module=CurrMod,type=T} -> 1473 emit([indent(9),T," ->",nl,indent(12),"'dec_",T, 1474 "'(Bytes)"]); 1475 #'Externaltypereference'{module=ExtMod,type=T} -> 1476 emit([indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", 1477 T,"'(Bytes, ",{asis,Tag},")"]) 1478 end, 1479 0. 1480 1481gen_internal_funcs(_,[]) -> 1482 ok; 1483gen_internal_funcs(Erules,[TypeDef|Rest]) -> 1484 gen_encode_user(Erules, TypeDef, false), 1485 emit([nl,nl, 1486 "'dec_",TypeDef#typedef.name,"'(Tlv, TagIn) ->",nl]), 1487 gen_decode_user(Erules,TypeDef), 1488 gen_internal_funcs(Erules,Rest). 1489 1490 1491decode_class('UNIVERSAL') -> 1492 ?UNIVERSAL; 1493decode_class('APPLICATION') -> 1494 ?APPLICATION; 1495decode_class('CONTEXT') -> 1496 ?CONTEXT; 1497decode_class('PRIVATE') -> 1498 ?PRIVATE. 1499 1500mkfuncname(#'Externaltypereference'{module=Mod,type=EType}, DecOrEnc) -> 1501 CurrMod = get(currmod), 1502 case CurrMod of 1503 Mod -> 1504 lists:concat(["'",DecOrEnc,"_",EType,"'"]); 1505 _ -> 1506 lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"]) 1507 end. 1508 1509get_size_constraint(C) -> 1510 case lists:keyfind('SizeConstraint', 1, C) of 1511 false -> []; 1512 {_,{_,[]}} -> []; %Extensible. 1513 {_,{Sv,Sv}} -> Sv; 1514 {_,{_,_}=Tc} -> Tc 1515 end. 1516 1517get_class_fields(#classdef{typespec=ObjClass}) -> 1518 ObjClass#objectclass.fields; 1519get_class_fields(#objectclass{fields=Fields}) -> 1520 Fields; 1521get_class_fields(_) -> 1522 []. 1523 1524get_object_field(Name,ObjectFields) -> 1525 case lists:keysearch(Name,1,ObjectFields) of 1526 {value,Field} -> Field; 1527 false -> false 1528 end. 1529 1530%%encode_tag(TagClass(?UNI, APP etc), Form (?PRIM etx), TagInteger) -> 1531%% 8bit Int | binary 1532encode_tag_val(Class, Form, TagNo) when (TagNo =< 30) -> 1533 <<(Class bsr 6):2,(Form bsr 5):1,TagNo:5>>; 1534 1535encode_tag_val(Class, Form, TagNo) -> 1536 {Octets,_Len} = mk_object_val(TagNo), 1537 BinOct = list_to_binary(Octets), 1538 <<(Class bsr 6):2, (Form bsr 5):1, 31:5,BinOct/binary>>. 1539 1540%%%%%%%%%%% 1541%% mk_object_val(Value) -> {OctetList, Len} 1542%% returns a Val as a list of octets, the 8 bit is always set to one except 1543%% for the last octet, where its 0 1544%% 1545 1546 1547mk_object_val(Val) when Val =< 127 -> 1548 {[255 band Val], 1}; 1549mk_object_val(Val) -> 1550 mk_object_val(Val bsr 7, [Val band 127], 1). 1551mk_object_val(0, Ack, Len) -> 1552 {Ack, Len}; 1553mk_object_val(Val, Ack, Len) -> 1554 mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). 1555 1556%% For BER the ExtensionAdditionGroup notation has no impact on the 1557%% encoding/decoding. Therefore we can filter away the 1558%% ExtensionAdditionGroup start and end markers. 1559extaddgroup2sequence(ExtList) when is_list(ExtList) -> 1560 lists:filter(fun(#'ExtensionAdditionGroup'{}) -> 1561 false; 1562 ('ExtensionAdditionGroupEnd') -> 1563 false; 1564 (_) -> 1565 true 1566 end, ExtList). 1567 1568call(F, Args) -> 1569 asn1ct_func:call(ber, F, Args). 1570 1571enc_func(Tname) -> 1572 list_to_atom(lists:concat(["enc_",Tname])). 1573 1574dec_func(Tname) -> 1575 list_to_atom(lists:concat(["dec_",Tname])). 1576 1577asis_atom(List) -> 1578 {asis,list_to_atom(lists:concat(List))}. 1579