1
%% ``The contents of this file are subject to the Erlang Public License,
2
%% Version 1.1, (the "License"); you may not use this file except in
3
%% compliance with the License. You should have received a copy of the
4
%% Erlang Public License along with this software. If not, it can be
5
%% retrieved via the world wide web at http://www.erlang.org/.
7
%% Software distributed under the License is distributed on an "AS IS"
8
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
9
%% the License for the specific language governing rights and limitations
12
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
13
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
14
%% AB. All Rights Reserved.''
16
%% $Id: asn1ct_gen_ber.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $
18
-module(asn1ct_gen_ber).
20
%% Generate erlang module which handles (PER) encode and decode for
21
%% all types in an ASN.1 module
23
-include("asn1_records.hrl").
26
-export([decode_class/1, decode_type/1]).
27
-export([add_removed_bytes/0]).
28
-export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]).
29
-export([gen_encode_prim/4]).
30
-export([gen_dec_prim/8]).
31
-export([gen_objectset_code/2, gen_obj_code/3]).
32
-export([re_wrap_erule/1]).
33
-export([unused_var/2]).
35
-import(asn1ct_gen, [emit/1,demit/1]).
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).
43
% primitive or constructed encoding % bit 6
44
-define(PRIMITIVE, 0).
45
-define(CONSTRUCTED, 2#00100000).
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
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
64
%% TypeOrVal = {TypeList,ValueList,PTypeList}
65
%% TypeList = ValueList = [atom()]
67
pgen(OutFile,Erules,Module,TypeOrVal) ->
68
asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true).
71
%%===============================================================================
72
%%===============================================================================
73
%%===============================================================================
75
%%===============================================================================
76
%%===============================================================================
77
%%===============================================================================
79
%%===============================================================================
80
%% encode #{typedef, {pos, name, typespec}}
81
%%===============================================================================
83
gen_encode(Erules,Type) when record(Type,typedef) ->
84
gen_encode_user(Erules,Type).
86
%%===============================================================================
87
%% encode #{type, {tag, def, constraint}}
88
%%===============================================================================
90
gen_encode(Erules,Typename,Type) when record(Type,type) ->
91
InnerType = asn1ct_gen:get_inner(Type#type.def),
93
case lists:keysearch(objfun,1,Type#type.tablecinf) of
99
case asn1ct_gen:type(InnerType) of
101
emit([nl,nl,nl,"%%================================"]),
102
emit([nl,"%% ",asn1ct_gen:list2name(Typename)]),
103
emit([nl,"%%================================",nl]),
104
case lists:member(InnerType,['SET','SEQUENCE']) of
106
case get(asn_keyed_list) of
109
case Type#type.def of
110
#'SEQUENCE'{components=Cl} -> Cl;
111
#'SET'{components=Cl} -> Cl
113
emit([nl,"'enc_",asn1ct_gen:list2name(Typename),
114
"'(Val, TagIn",ObjFun,
115
") when list(Val) ->",nl]),
116
emit([" 'enc_",asn1ct_gen:list2name(Typename),
117
"'(?RT_BER:fixoptionals(",
118
{asis,optionals(CompList)},
119
",Val), TagIn",ObjFun,");",nl,nl]);
123
emit([nl,"'enc_",asn1ct_gen:list2name(Typename),
124
"'({'",asn1ct_gen:list2name(Typename),
125
"',Val}, TagIn",ObjFun,") ->",nl]),
126
emit([" 'enc_",asn1ct_gen:list2name(Typename),
127
"'(Val, TagIn",ObjFun,");",nl,nl])
129
emit(["'enc_",asn1ct_gen:list2name(Typename),
130
"'(Val, TagIn",ObjFun,") ->",nl," "]),
131
asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
136
%%===============================================================================
137
%% encode ComponentType
138
%%===============================================================================
140
gen_encode(Erules,Tname,{'ComponentType',_Pos,Cname,Type,_,_}) ->
141
NewTname = [Cname|Tname],
142
%% The tag is set to [] to avoid that it is
143
%% taken into account twice, both as a component/alternative (passed as
144
%% argument to the encode decode function and within the encode decode
146
NewType = Type#type{tag=[]},
147
gen_encode(Erules,NewTname,NewType).
149
gen_encode_user(Erules,D) when record(D,typedef) ->
150
Typename = [D#typedef.name],
151
Type = D#typedef.typespec,
152
InnerType = asn1ct_gen:get_inner(Type#type.def),
153
OTag = Type#type.tag,
154
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
155
emit([nl,nl,"%%================================"]),
156
emit([nl,"%% ",Typename]),
157
emit([nl,"%%================================",nl]),
158
case lists:member(InnerType,['SET','SEQUENCE']) of
160
case get(asn_keyed_list) of
163
case Type#type.def of
164
#'SEQUENCE'{components=Cl} -> Cl;
165
#'SET'{components=Cl} -> Cl
168
emit([nl,"'enc_",asn1ct_gen:list2name(Typename),
169
"'(Val, TagIn) when list(Val) ->",nl]),
170
emit([" 'enc_",asn1ct_gen:list2name(Typename),
171
"'(?RT_BER:fixoptionals(",
172
{asis,optionals(CompList)},
173
",Val), TagIn);",nl,nl]);
177
emit({nl,"'enc_",asn1ct_gen:list2name(Typename),
178
"'({'",asn1ct_gen:list2name(Typename),"',Val}, TagIn) ->",nl}),
179
emit({" 'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn);",nl,nl})
181
emit({"'enc_",asn1ct_gen:list2name(Typename),"'(",
182
unused_var("Val",Type#type.def),", TagIn) ->",nl}),
183
CurrentMod = get(currmod),
184
case asn1ct_gen:type(InnerType) of
186
asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D);
188
asn1ct_gen_ber:gen_encode_prim(ber,Type,["TagIn ++ ",
191
#typereference{val=Ename} ->
192
emit([" 'enc_",Ename,"'(Val, TagIn ++ ",{asis,Tag},").",nl]);
193
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
194
emit([" 'enc_",Etype,"'(Val, TagIn ++ ",
195
{asis,Tag},").",nl]);
196
#'Externaltypereference'{module=Emod,type=Etype} ->
197
emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn ++ ",
198
{asis,Tag},").",nl]);
200
emit(["%% OPEN TYPE",nl]),
201
asn1ct_gen_ber:gen_encode_prim(ber,
202
Type#type{def='ASN1_OPEN_TYPE'},
208
unused_var(Var,#'SEQUENCE'{components=Cl}) ->
210
unused_var(Var,#'SET'{components=Cl}) ->
214
unused_var1(Var,Cs) when Cs == []; Cs == {[],[]} ->
215
lists:concat(["_",Var]);
216
unused_var1(Var,_) ->
219
unused_optormand_var(Var,Def) ->
220
case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of
222
lists:concat(["_",Var]);
228
gen_encode_prim(_Erules,D,DoTag,Value) when record(D,type) ->
230
%%% Currently not used for BER (except for BitString) and therefore replaced
231
%%% with [] as a placeholder
232
BitStringConstraint = D#type.constraint,
234
asn1ct_name:new(enumval),
237
emit_encode_func('boolean',Value,DoTag);
239
emit_encode_func('integer',Constraint,Value,DoTag);
240
{'INTEGER',NamedNumberList} ->
241
emit_encode_func('integer',Constraint,Value,
242
NamedNumberList,DoTag);
243
{'ENUMERATED',NamedNumberList={_,_}} ->
245
emit(["case (case ",Value," of {asn1_enum,_}->",Value,";{_,_}->element(2,",Value,");_->",
246
Value," end) of",nl]),
247
emit_enc_enumerated_cases(NamedNumberList,DoTag);
248
{'ENUMERATED',NamedNumberList} ->
250
emit(["case (case ",Value," of {_,_}->element(2,",Value,");_->",
251
Value," end) of",nl]),
252
emit_enc_enumerated_cases(NamedNumberList,DoTag);
254
{'BIT STRING',NamedNumberList} ->
255
emit_encode_func('bit_string',BitStringConstraint,Value,
256
NamedNumberList,DoTag);
258
emit_encode_func('open_type', Value,DoTag);
260
emit_encode_func('null',Value,DoTag);
261
'OBJECT IDENTIFIER' ->
262
emit_encode_func("object_identifier",Value,DoTag);
263
'ObjectDescriptor' ->
264
emit_encode_func('restricted_string',Constraint,Value,
265
?T_ObjectDescriptor,DoTag);
267
emit_encode_func('octet_string',Constraint,Value,DoTag);
269
emit_encode_func('restricted_string',Constraint,Value,
270
?T_NumericString,DoTag);
272
emit_encode_func('restricted_string',Constraint,Value,
273
?T_TeletexString,DoTag);
275
emit_encode_func('restricted_string',Constraint,Value,
276
?T_VideotexString,DoTag);
278
emit_encode_func('restricted_string',Constraint,Value,
279
?T_GraphicString,DoTag);
281
emit_encode_func('restricted_string',Constraint,Value,
282
?T_VisibleString,DoTag);
284
emit_encode_func('restricted_string',Constraint,Value,
285
?T_GeneralString,DoTag);
287
emit_encode_func('restricted_string',Constraint,Value,
288
?T_PrintableString,DoTag);
290
emit_encode_func('restricted_string',Constraint,Value,
293
emit_encode_func('universal_string',Constraint,Value,DoTag);
295
emit_encode_func('BMP_string',Constraint,Value,DoTag);
297
emit_encode_func('utc_time',Constraint,Value,DoTag);
299
emit_encode_func('generalized_time',Constraint,Value,DoTag);
301
emit_encode_func('open_type', Value,DoTag);
303
exit({'can not encode' ,XX})
307
emit_encode_func(Name,Value,Tags) when atom(Name) ->
308
emit_encode_func(atom_to_list(Name),Value,Tags);
309
emit_encode_func(Name,Value,Tags) ->
310
Fname = "?RT_BER:encode_" ++ Name,
311
emit([Fname,"(",Value,", ",Tags,")"]).
313
emit_encode_func(Name,Constraint,Value,Tags) when atom(Name) ->
314
emit_encode_func(atom_to_list(Name),Constraint,Value,Tags);
315
emit_encode_func(Name,Constraint,Value,Tags) ->
316
Fname = "?RT_BER:encode_" ++ Name,
317
emit([Fname,"(",{asis,Constraint},", ",Value,", ",Tags,")"]).
319
emit_encode_func(Name,Constraint,Value,Asis,Tags) when atom(Name) ->
320
emit_encode_func(atom_to_list(Name),Constraint,Value,Asis,Tags);
321
emit_encode_func(Name,Constraint,Value,Asis,Tags) ->
322
Fname = "?RT_BER:encode_" ++ Name,
323
emit([Fname,"(",{asis,Constraint},", ",Value,
327
emit_enc_enumerated_cases({L1,L2}, Tags) ->
328
emit_enc_enumerated_cases(L1++L2, Tags, ext);
329
emit_enc_enumerated_cases(L, Tags) ->
330
emit_enc_enumerated_cases(L, Tags, noext).
332
emit_enc_enumerated_cases([{EnumName,EnumVal},H2|T], Tags, Ext) ->
333
emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]),
334
%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]),
335
emit_enc_enumerated_cases([H2|T], Tags, Ext);
336
emit_enc_enumerated_cases([{EnumName,EnumVal}], Tags, Ext) ->
337
emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]),
338
%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]),
340
noext -> emit([";",nl]);
342
emit([";",nl,"{asn1_enum,",{curr,enumval},"} -> ",
343
"?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]),
344
asn1ct_name:new(enumval)
346
emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]),
350
%%===============================================================================
351
%%===============================================================================
352
%%===============================================================================
354
%%===============================================================================
355
%%===============================================================================
356
%%===============================================================================
358
%%===============================================================================
359
%% decode #{typedef, {pos, name, typespec}}
360
%%===============================================================================
362
gen_decode(Erules,Type) when record(Type,typedef) ->
365
emit({"'dec_",Type#typedef.name,"'(Bytes, OptOrMand) ->",nl}),
366
emit({" 'dec_",Type#typedef.name,"'(Bytes, OptOrMand, []).",nl,nl}),
367
emit({"'dec_",Type#typedef.name,"'(Bytes, ",
368
unused_optormand_var("OptOrMand",(Type#typedef.typespec)#type.def),", TagIn) ->",nl}),
369
dbdec(Type#typedef.name),
370
gen_decode_user(Erules,D).
373
%%===============================================================================
374
%% decode #{type, {tag, def, constraint}}
375
%%===============================================================================
377
gen_decode(Erules,Tname,Type) when record(Type,type) ->
379
InnerType = asn1ct_gen:get_inner(Type#type.def),
380
case asn1ct_gen:type(InnerType) of
383
case Type#type.tablecinf of
389
emit({"'dec_",asn1ct_gen:list2name(Typename),"'(Bytes, OptOrMand, TagIn",ObjFun,") ->",nl}),
391
asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type);
397
%%===============================================================================
398
%% decode ComponentType
399
%%===============================================================================
401
gen_decode(Erules,Tname,{'ComponentType',_Pos,Cname,Type,_,_}) ->
402
NewTname = [Cname|Tname],
403
%% The tag is set to [] to avoid that it is
404
%% taken into account twice, both as a component/alternative (passed as
405
%% argument to the encode decode function and within the encode decode
407
NewType = Type#type{tag=[]},
408
gen_decode(Erules,NewTname,NewType).
411
gen_decode_user(Erules,D) when record(D,typedef) ->
412
Typename = [D#typedef.name],
413
Def = D#typedef.typespec,
414
InnerType = asn1ct_gen:get_inner(Def#type.def),
415
InnerTag = Def#type.tag ,
416
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- InnerTag],
417
case asn1ct_gen:type(InnerType) of
419
BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
420
asn1ct_name:new(len),
421
gen_dec_prim(Erules, Def#type{def='ASN1_OPEN_TYPE'},
422
BytesVar, Tag, "TagIn",no_length,
423
?PRIMITIVE,"OptOrMand"),
426
BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
427
asn1ct_name:new(len),
428
gen_dec_prim(Erules, Def, BytesVar, Tag, "TagIn",no_length,
429
?PRIMITIVE,"OptOrMand"),
432
asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D);
434
DecFunName = mkfuncname(TheType,dec),
435
emit({DecFunName,"(",{curr,bytes},
436
", OptOrMand, TagIn++",{asis,Tag},")"}),
441
gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Length,_Form,OptOrMand) ->
442
Typename = Att#type.def,
443
%% Currently not used for BER replaced with [] as place holder
444
%% Constraint = Att#type.constraint,
447
case get_constraint(Att#type.constraint,'SizeConstraint') of
452
case get_constraint(Att#type.constraint,'ValueRange') of
457
case get_constraint(Att#type.constraint,'SingleValue') of
461
AsBin = case get(binary_strings) of
465
NewTypeName = case Typename of
466
'ANY' -> 'ASN1_OPEN_TYPE';
472
emit({"?RT_BER:decode_boolean(",BytesVar,","}),
475
emit({"?RT_BER:decode_integer(",BytesVar,",",
476
{asis,int_constr(SingleValue,ValueRange)},","}),
478
{'INTEGER',NamedNumberList} ->
479
emit({"?RT_BER:decode_integer(",BytesVar,",",
480
{asis,int_constr(SingleValue,ValueRange)},",",
481
{asis,NamedNumberList},","}),
483
{'ENUMERATED',NamedNumberList} ->
484
emit({"?RT_BER:decode_enumerated(",BytesVar,",",
485
{asis,Constraint},",",
486
{asis,NamedNumberList},","}),
488
{'BIT STRING',NamedNumberList} ->
489
case get(compact_bit_string) of
491
emit({"?RT_BER:decode_compact_bit_string(",
492
BytesVar,",",{asis,Constraint},",",
493
{asis,NamedNumberList},","});
495
emit({"?RT_BER:decode_bit_string(",BytesVar,",",
496
{asis,Constraint},",",
497
{asis,NamedNumberList},","})
501
emit({"?RT_BER:decode_null(",BytesVar,","}),
503
'OBJECT IDENTIFIER' ->
504
emit({"?RT_BER:decode_object_identifier(",BytesVar,","}),
506
'ObjectDescriptor' ->
507
emit({"?RT_BER:decode_restricted_string(",
508
BytesVar,",",{asis,Constraint},",",{asis,?T_ObjectDescriptor},","}),
511
emit({"?RT_BER:decode_octet_string",AsBin,"(",BytesVar,",",{asis,Constraint},","}),
514
emit({"?RT_BER:decode_restricted_string",AsBin,"(",
515
BytesVar,",",{asis,Constraint},",",{asis,?T_NumericString},","}),true;
517
emit({"?RT_BER:decode_restricted_string",AsBin,"(",
518
BytesVar,",",{asis,Constraint},",",{asis,?T_TeletexString},","}),
521
emit({"?RT_BER:decode_restricted_string",AsBin,"(",
522
BytesVar,",",{asis,Constraint},",",{asis,?T_VideotexString},","}),
525
emit({"?RT_BER:decode_restricted_string",AsBin,"(",
526
BytesVar,",",{asis,Constraint},",",{asis,?T_GraphicString},","})
529
emit({"?RT_BER:decode_restricted_string",AsBin,"(",
530
BytesVar,",",{asis,Constraint},",",{asis,?T_VisibleString},","}),
533
emit({"?RT_BER:decode_restricted_string",AsBin,"(",
534
BytesVar,",",{asis,Constraint},",",{asis,?T_GeneralString},","}),
537
emit({"?RT_BER:decode_restricted_string",AsBin,"(",
538
BytesVar,",",{asis,Constraint},",",{asis,?T_PrintableString},","}),
541
emit({"?RT_BER:decode_restricted_string",AsBin,"(",
542
BytesVar,",",{asis,Constraint},",",{asis,?T_IA5String},","}),
545
emit({"?RT_BER:decode_universal_string",AsBin,"(",
546
BytesVar,",",{asis,Constraint},","}),
549
emit({"?RT_BER:decode_BMP_string",AsBin,"(",
550
BytesVar,",",{asis,Constraint},","}),
553
emit({"?RT_BER:decode_utc_time",AsBin,"(",
554
BytesVar,",",{asis,Constraint},","}),
557
emit({"?RT_BER:decode_generalized_time",AsBin,"(",
558
BytesVar,",",{asis,Constraint},","}),
561
emit(["?RT_BER:decode_open_type(",re_wrap_erule(Erules),",",
565
exit({'can not decode' ,Other})
568
NewLength = case DoLength of
569
true -> [", ", Length];
572
NewOptOrMand = case OptOrMand of
573
_ when list(OptOrMand) -> OptOrMand;
574
mandatory -> {asis,mandatory};
575
_ -> {asis,opt_or_default}
577
case {TagIn,NewTypeName} of
578
{[],'ASN1_OPEN_TYPE'} ->
579
emit([{asis,DoTag},")"]);
580
{_,'ASN1_OPEN_TYPE'} ->
581
emit([TagIn,"++",{asis,DoTag},")"]);
583
emit([{asis,DoTag},NewLength,", ",NewOptOrMand,")"]);
584
_ when list(TagIn) ->
585
emit([TagIn,"++",{asis,DoTag},NewLength,", ",NewOptOrMand,")"])
591
int_constr([],ValueRange) ->
593
int_constr(SingleValue,[]) ->
598
%% Object code generating for encoding and decoding
599
%% ------------------------------------------------
601
gen_obj_code(Erules,_Module,Obj) when record(Obj,typedef) ->
602
ObjName = Obj#typedef.name,
603
Def = Obj#typedef.typespec,
604
#'Externaltypereference'{module=M,type=ClName} = Def#'Object'.classname,
605
Class = asn1_db:dbget(M,ClName),
607
{object,_,Fields} = Def#'Object'.def,
608
emit({nl,nl,nl,"%%================================"}),
609
emit({nl,"%% ",ObjName}),
610
emit({nl,"%%================================",nl}),
612
gen_encode_objectfields(ClName,get_class_fields(Class),
615
gen_encode_constr_type(Erules,EncConstructed),
618
gen_decode_objectfields(ClName,get_class_fields(Class),
621
gen_decode_constr_type(Erules,DecConstructed);
622
gen_obj_code(_Erules,_Module,Obj) when record(Obj,pobjectdef) ->
626
gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
627
ObjName,ObjectFields,ConstrAcc) ->
630
emit(["'enc_",ObjName,"'(",{asis,Name},
631
", ",Args,", _RestPrimFieldName) ->",nl])
633
% emit(["'enc_",ObjName,"'(",{asis,Name},
634
% ", Val, TagIn, _RestPrimFieldName) ->",nl]),
636
case {get_object_field(Name,ObjectFields),OptOrMand} of
637
{false,'MANDATORY'} -> %% this case is illegal
638
exit({error,{asn1,{"missing mandatory field in object",
640
{false,'OPTIONAL'} ->
641
EmitFuncClause("_, _"),
644
{false,{'DEFAULT',DefaultType}} ->
645
EmitFuncClause("Val, TagIn"),
646
gen_encode_default_call(ClassName,Name,DefaultType);
647
{{Name,TypeSpec},_} ->
648
%% A specified field owerwrites any 'DEFAULT' or
649
%% 'OPTIONAL' field in the class
650
EmitFuncClause("Val, TagIn"),
651
gen_encode_field_call(ObjName,Name,TypeSpec)
653
case more_genfields(Rest) of
659
gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,
660
MaybeConstr++ConstrAcc);
661
gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
662
ObjName,ObjectFields,ConstrAcc) ->
665
emit(["'enc_",ObjName,"'(",{asis,Name},
666
", ",Args,") ->",nl])
668
% emit(["'enc_",ObjName,"'(",{asis,Name},
669
% ", Val, TagIn, [H|T]) ->",nl]),
670
case {get_object_field(Name,ObjectFields),OptOrMand} of
671
{false,'MANDATORY'} ->
672
exit({error,{asn1,{"missing mandatory field in object",
674
{false,'OPTIONAL'} ->
675
EmitFuncClause("_,_,_"),
676
emit([" exit({error,{'use of missing field in object', ",Name,
678
{false,{'DEFAULT',_DefaultObject}} ->
679
exit({error,{asn1,{"not implemented yet",Name}}});
680
{{Name,TypeSpec},_} ->
681
EmitFuncClause(" Val, TagIn, [H|T]"),
682
case TypeSpec#typedef.name of
684
emit({indent(3),"'",ExtMod,"':'enc_",TypeName,
685
"'(H, Val, TagIn, T)"});
687
emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"})
690
case more_genfields(Rest) of
696
gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
697
gen_encode_objectfields(ClassName,[_|Cs],O,OF,Acc) ->
698
gen_encode_objectfields(ClassName,Cs,O,OF,Acc);
699
gen_encode_objectfields(_,[],_,_,Acc) ->
703
% gen_encode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) ->
704
% Fields = Class#objectclass.fields,
706
% case is_typefield(Fields,FieldName) of
708
% Def = Type#typedef.typespec,
709
% OTag = Def#type.tag,
710
% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
711
% emit({"'enc_",ObjName,"'(",{asis,FieldName},
712
% ", Val, TagIn, RestPrimFieldName) ->",nl}),
714
% case Type#typedef.name of
716
% gen_encode_prim(ber,Def,["TagIn ++ ",{asis,Tag}],
719
% {constructed,bif} ->
720
% %%InnerType = asn1ct_gen:get_inner(Def#type.def),
721
% %%asn1ct_gen:gen_encode_constructed(ber,[ObjName],
723
% emit({" 'enc_",ObjName,'_',FieldName,
724
% "'(Val, TagIn ++ ",{asis,Tag},")"}),
725
% [{['enc_',ObjName,'_',FieldName],Def}];
726
% {ExtMod,TypeName} ->
727
% emit({" '",ExtMod,"':'enc_",TypeName,
728
% "'(Val, TagIn ++ ",{asis,Tag},")"}),
731
% emit({" 'enc_",TypeName,"'(Val, TagIn ++ ",
735
% case more_genfields(Fields,Rest) of
742
% {false,objectfield} ->
743
% emit({"'enc_",ObjName,"'(",{asis,FieldName},
744
% ", Val, TagIn, [H|T]) ->",nl}),
745
% case Type#typedef.name of
746
% {ExtMod,TypeName} ->
747
% emit({indent(3),"'",ExtMod,"':'enc_",TypeName,
748
% "'(H, Val, TagIn, T)"});
750
% emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"})
752
% case more_genfields(Fields,Rest) of
761
% gen_encode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc);
762
% gen_encode_objectfields(C,O,[H|T],Acc) ->
763
% gen_encode_objectfields(C,O,T,Acc);
764
% gen_encode_objectfields(_,_,[],Acc) ->
767
% gen_encode_constr_type([{Name,Def}|Rest]) ->
768
% emit({Name,"(Val,TagIn) ->",nl}),
769
% InnerType = asn1ct_gen:get_inner(Def#type.def),
770
% asn1ct_gen:gen_encode_constructed(ber,Name,InnerType,Def),
771
% gen_encode_constr_type(Rest);
772
gen_encode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) ->
773
case is_already_generated(enc,TypeDef#typedef.name) of
775
_ -> gen_encode_user(Erules,TypeDef)
777
gen_encode_constr_type(Erules,Rest);
778
gen_encode_constr_type(_,[]) ->
781
gen_encode_field_call(ObjName,FieldName,Type) ->
782
Def = Type#typedef.typespec,
784
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
785
case Type#typedef.name of
786
{primitive,bif} -> %%tag should be the primitive tag
787
gen_encode_prim(ber,Def,["TagIn ++ ",{asis,Tag}],
791
emit({" 'enc_",ObjName,'_',FieldName,
792
"'(Val, TagIn ++",{asis,Tag},")"}),
793
[Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
795
emit({" '",ExtMod,"':'enc_",TypeName,
796
"'(Val, TagIn ++ ",{asis,Tag},")"}),
799
emit({" 'enc_",TypeName,"'(Val, TagIn ++ ",{asis,Tag},")"}),
803
gen_encode_default_call(ClassName,FieldName,Type) ->
804
CurrentMod = get(currmod),
805
InnerType = asn1ct_gen:get_inner(Type#type.def),
806
OTag = Type#type.tag,
807
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
808
case asn1ct_gen:type(InnerType) of
810
%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
811
emit([" 'enc_",ClassName,'_',FieldName,"'(Bytes, TagIn ++ ",
813
[#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
816
gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"),
818
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
819
emit([" 'enc_",Etype,"'(Val, TagIn ++ ",{asis,Tag},")",nl]),
821
#'Externaltypereference'{module=Emod,type=Etype} ->
822
emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn ++ ",{asis,Tag},")",nl]),
828
gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
829
ObjName,ObjectFields,ConstrAcc) ->
832
emit(["'dec_",ObjName,"'(",{asis,Name},
833
", ",Args,"_) ->",nl])
835
% emit(["'dec_",ObjName,"'(",{asis,Name},
836
% ", Bytes, TagIn, RestPrimFieldName) ->",nl]),
838
case {get_object_field(Name,ObjectFields),OptOrMand} of
839
{false,'MANDATORY'} -> %% this case is illegal
840
exit({error,{asn1,{"missing mandatory field in object",
842
{false,'OPTIONAL'} ->
843
EmitFuncClause("_, _,"),
844
emit([" asn1_NOVALUE"]),
846
{false,{'DEFAULT',DefaultType}} ->
847
EmitFuncClause("Bytes, TagIn,"),
848
gen_decode_default_call(ClassName,Name,"Bytes",DefaultType);
849
{{Name,TypeSpec},_} ->
850
%% A specified field owerwrites any 'DEFAULT' or
851
%% 'OPTIONAL' field in the class
852
EmitFuncClause("Bytes, TagIn,"),
853
gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec)
855
case more_genfields(Rest) of
861
gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc);
862
gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
863
ObjName,ObjectFields,ConstrAcc) ->
866
emit(["'dec_",ObjName,"'(",{asis,Name},
867
", ",Args,") ->",nl])
869
% emit(["'dec_",ObjName,"'(",{asis,Name},
870
% ", Bytes,TagIn,[H|T]) ->",nl]),
871
case {get_object_field(Name,ObjectFields),OptOrMand} of
872
{false,'MANDATORY'} ->
873
exit({error,{asn1,{"missing mandatory field in object",
875
{false,'OPTIONAL'} ->
876
EmitFuncClause("_,_,_"),
877
emit([" exit({error,{'illegal use of missing field in object', ",Name,
879
{false,{'DEFAULT',_DefaultObject}} ->
880
exit({error,{asn1,{"not implemented yet",Name}}});
881
{{Name,TypeSpec},_} ->
882
EmitFuncClause("Bytes,TagIn,[H|T]"),
883
case TypeSpec#typedef.name of
885
emit({indent(3),"'",ExtMod,"':'dec_",TypeName,
886
"'(H, Bytes, TagIn, T)"});
888
emit({indent(3),"'dec_",TypeName,"'(H, Bytes, TagIn, T)"})
891
case more_genfields(Rest) of
897
gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
898
gen_decode_objectfields(CN,[_|Cs],O,OF,CAcc) ->
899
gen_decode_objectfields(CN,Cs,O,OF,CAcc);
900
gen_decode_objectfields(_,[],_,_,CAcc) ->
905
% gen_decode_objectfields(Erules,Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) ->
906
% Fields = Class#objectclass.fields,
908
% case is_typefield(Fields,FieldName) of
910
% Def = Type#typedef.typespec,
911
% emit({"'dec_",ObjName,"'(",{asis,FieldName},
912
% ", Bytes, TagIn, RestPrimFieldName) ->",nl}),
913
% OTag = Def#type.tag,
914
% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
916
% case get_optionalityspec(Fields,FieldName) of
917
% 'OPTIONAL' -> opt_or_default;
918
% {'DEFAULT',_} -> opt_or_default;
922
% case Type#typedef.name of
924
% gen_dec_prim(Erules,Def,"Bytes",Tag,"TagIn",no_length,
927
% {constructed,bif} ->
928
% emit({" 'dec_",ObjName,'_',FieldName,"'(Bytes,",
929
% {asis,Prop},", TagIn ++ ",{asis,Tag},")"}),
930
% [{['dec_',ObjName,'_',FieldName],Def}];
931
% {ExtMod,TypeName} ->
932
% emit({" '",ExtMod,"':'dec_",TypeName,"'(Bytes, ",
933
% {asis,Prop},", TagIn ++ ",{asis,Tag},")"}),
936
% emit({" 'dec_",TypeName,"'(Bytes, ",{asis,Prop},
937
% ", TagIn ++ ",{asis,Tag},")"}),
940
% case more_genfields(Fields,Rest) of
947
% {false,objectfield} ->
948
% emit({"'dec_",ObjName,"'(",{asis,FieldName},
949
% ", Bytes, TagIn, [H|T]) ->",nl}),
950
% case Type#typedef.name of
951
% {ExtMod,TypeName} ->
952
% emit({indent(3),"'",ExtMod,"':'dec_",TypeName,
953
% "'(H, Bytes, TagIn, T)"});
955
% emit({indent(3),"'dec_",TypeName,
956
% "'(H, Bytes, TagIn, T)"})
958
% case more_genfields(Fields,Rest) of
968
% gen_decode_objectfields(Erules,Class,ObjName,Rest,MaybeConstr ++ ConstrAcc);
969
% gen_decode_objectfields(Erules,C,O,[H|T],CAcc) ->
970
% gen_decode_objectfields(Erules,C,O,T,CAcc);
971
% gen_decode_objectfields(_,_,_,[],CAcc) ->
974
gen_decode_constr_type(Erules,[{Name,Def}|Rest]) ->
975
%% emit({Name,"(Bytes, OptOrMand) ->",nl}),
976
%% emit({" ",Name,"(Bytes, OptOrMand, []).",nl,nl}),
977
emit({Name,"(Bytes, OptOrMand, TagIn) ->",nl}),
978
InnerType = asn1ct_gen:get_inner(Def#type.def),
979
asn1ct_gen:gen_decode_constructed(ber,Name,InnerType,Def),
980
gen_decode_constr_type(Erules,Rest);
981
gen_decode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) ->
982
case is_already_generated(dec,TypeDef#typedef.name) of
985
gen_decode(Erules,TypeDef)
987
gen_decode_constr_type(Erules,Rest);
988
gen_decode_constr_type(_,[]) ->
991
gen_decode_field_call(ObjName,FieldName,Bytes,Type) ->
992
Def = Type#typedef.typespec,
994
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
995
case Type#typedef.name of
996
{primitive,bif} -> %%tag should be the primitive tag
997
gen_dec_prim(ber,Def,Bytes,Tag,"TagIn",no_length,
998
?PRIMITIVE,opt_or_default),
1000
{constructed,bif} ->
1001
emit({" 'dec_",ObjName,'_',FieldName,
1002
"'(",Bytes,",opt_or_default, TagIn ++ ",{asis,Tag},")"}),
1003
[Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
1004
{ExtMod,TypeName} ->
1005
emit({" '",ExtMod,"':'dec_",TypeName,
1006
"'(",Bytes,", opt_or_default,TagIn ++ ",{asis,Tag},")"}),
1009
emit({" 'dec_",TypeName,"'(",Bytes,
1010
", opt_or_default,TagIn ++ ",{asis,Tag},")"}),
1014
gen_decode_default_call(ClassName,FieldName,Bytes,Type) ->
1015
CurrentMod = get(currmod),
1016
InnerType = asn1ct_gen:get_inner(Type#type.def),
1017
OTag = Type#type.tag,
1018
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
1019
case asn1ct_gen:type(InnerType) of
1020
{constructed,bif} ->
1021
emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,
1022
",opt_or_default, TagIn ++ ",{asis,Tag},")"]),
1023
[#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
1026
gen_dec_prim(ber,Type,Bytes,Tag,"TagIn",no_length,
1027
?PRIMITIVE,opt_or_default),
1029
#'Externaltypereference'{module=CurrentMod,type=Etype} ->
1030
emit([" 'dec_",Etype,"'(",Bytes,
1031
" ,opt_or_default, TagIn ++ ",{asis,Tag},")",nl]),
1033
#'Externaltypereference'{module=Emod,type=Etype} ->
1034
emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,
1035
", opt_or_defualt, TagIn ++ ",{asis,Tag},")",nl]),
1040
more_genfields([]) ->
1042
more_genfields([Field|Fields]) ->
1043
case element(1,Field) of
1049
more_genfields(Fields)
1054
%% Object Set code generating for encoding and decoding
1055
%% ----------------------------------------------------
1056
gen_objectset_code(Erules,ObjSet) ->
1057
ObjSetName = ObjSet#typedef.name,
1058
Def = ObjSet#typedef.typespec,
1059
% {ClassName,ClassDef} = Def#'ObjectSet'.class,
1060
#'Externaltypereference'{module=ClassModule,
1061
type=ClassName} = Def#'ObjectSet'.class,
1062
ClassDef = asn1_db:dbget(ClassModule,ClassName),
1063
UniqueFName = Def#'ObjectSet'.uniquefname,
1064
Set = Def#'ObjectSet'.set,
1065
emit({nl,nl,nl,"%%================================"}),
1066
emit({nl,"%% ",ObjSetName}),
1067
emit({nl,"%%================================",nl}),
1069
{_Module,ExtClassName} ->
1070
gen_objset_code(Erules,ObjSetName,UniqueFName,Set,
1071
ExtClassName,ClassDef);
1073
gen_objset_code(Erules,ObjSetName,UniqueFName,Set,
1078
gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)->
1079
ClassFields = (ClassDef#classdef.typespec)#objectclass.fields,
1080
InternalFuncs=gen_objset_enc(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]),
1081
gen_objset_dec(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1),
1082
gen_internal_funcs(Erules,InternalFuncs).
1084
%% gen_objset_enc iterates over the objects of the object set
1085
gen_objset_enc(_,{unique,undefined},_,_,_,_,_) ->
1086
%% There is no unique field in the class of this object set
1087
%% don't bother about the constraint
1089
gen_objset_enc(ObjSName,UniqueName,
1090
[{ObjName,Val,Fields},T|Rest],ClName,ClFields,NthObj,Acc)->
1091
emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}),
1092
{InternalFunc,NewNthObj}=
1095
gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj);
1097
emit({" fun 'enc_",ObjName,"'/4"}),
1101
gen_objset_enc(ObjSName,UniqueName,[T|Rest],ClName,ClFields,
1102
NewNthObj,InternalFunc ++ Acc);
1103
gen_objset_enc(ObjSetName,UniqueName,
1104
[{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) ->
1105
emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}),
1109
gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj);
1111
emit({" fun 'enc_",ObjName,"'/4"}),
1115
InternalFunc ++ Acc;
1116
%% See X.681 Annex E for the following case
1117
gen_objset_enc(ObjSetName,_UniqueName,['EXTENSIONMARK'],
1118
_ClName,_ClFields,_NthObj,Acc) ->
1119
emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}),
1120
emit({indent(3),"fun(_Attr, Val, _TagIn, _RestPrimFieldName) ->",nl}),
1121
emit({indent(6),"Len = case Val of",nl,indent(9),
1122
"Bin when binary(Bin) -> size(Bin);",nl,indent(9),
1123
"_ -> length(Val)",nl,indent(6),"end,"}),
1124
emit({indent(6),"{Val,Len}",nl}),
1125
emit({indent(3),"end.",nl,nl}),
1127
gen_objset_enc(_,_,[],_,_,_,Acc) ->
1130
%% gen_inlined_enc_funs for each object iterates over all fields of a
1131
%% class, and for each typefield it checks if the object has that
1132
%% field and emits the proper code.
1133
gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest],ObjSetName,
1135
InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
1136
case lists:keysearch(Name,1,Fields) of
1137
{value,{_,Type}} when record(Type,type) ->
1138
emit({indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl,
1139
indent(6),"case Type of",nl}),
1140
{Ret,N} = emit_inner_of_fun(Type,InternalDefFunName),
1141
gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret);
1142
{value,{_,Type}} when record(Type,typedef) ->
1143
emit({indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl,
1144
indent(6),"case Type of",nl}),
1145
emit({indent(9),{asis,Name}," ->",nl}),
1146
{Ret,N} = emit_inner_of_fun(Type,InternalDefFunName),
1147
gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret);
1149
gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj)
1151
gen_inlined_enc_funs(Fields,[_H|Rest],ObjSetName,NthObj) ->
1152
gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj);
1153
gen_inlined_enc_funs(_,[],_,NthObj) ->
1156
gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName,
1158
InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
1160
case lists:keysearch(Name,1,Fields) of
1161
{value,{_,Type}} when record(Type,type) ->
1163
{Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
1165
{value,{_,Type}} when record(Type,typedef) ->
1166
emit({";",nl,indent(9),{asis,Name}," ->",nl}),
1167
{Ret,N}=emit_inner_of_fun(Type,InternalDefFunName),
1172
gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2);
1173
gen_inlined_enc_funs1(Fields,[_H|Rest],ObjSetName,NthObj,Acc)->
1174
gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc);
1175
gen_inlined_enc_funs1(_,[],_,NthObj,Acc) ->
1176
emit({nl,indent(6),"end",nl}),
1177
emit({indent(3),"end"}),
1181
emit_inner_of_fun(TDef = #typedef{name={ExtMod,Name},typespec=Type},
1182
InternalDefFunName) ->
1183
OTag = Type#type.tag,
1184
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
1185
case {ExtMod,Name} of
1188
gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"),
1190
{constructed,bif} ->
1191
emit([indent(12),"'enc_",
1192
InternalDefFunName,"'(Val,TagIn ++ ",
1194
{[TDef#typedef{name=InternalDefFunName}],1};
1196
emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val, TagIn ++ ",
1200
emit_inner_of_fun(#typedef{name=Name,typespec=Type},_) ->
1201
OTag = Type#type.tag,
1202
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
1203
emit({indent(12),"'enc_",Name,"'(Val, TagIn ++ ",{asis,Tag},")"}),
1205
emit_inner_of_fun(Type,_) when record(Type,type) ->
1206
CurrMod = get(currmod),
1207
OTag = Type#type.tag,
1208
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
1209
case Type#type.def of
1210
Def when atom(Def) ->
1211
emit({indent(9),Def," ->",nl,indent(12)}),
1212
gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val");
1213
TRef when record(TRef,typereference) ->
1214
T = TRef#typereference.val,
1215
emit({indent(9),T," ->",nl,indent(12),"'enc_",T,
1216
"'(Val, TagIn ++ ",{asis,Tag},")"});
1217
#'Externaltypereference'{module=CurrMod,type=T} ->
1218
emit({indent(9),T," ->",nl,indent(12),"'enc_",T,
1219
"'(Val, TagIn ++ ",{asis,Tag},")"});
1220
#'Externaltypereference'{module=ExtMod,type=T} ->
1221
emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_",
1222
T,"'(Val, TagIn ++ ",{asis,Tag},")"})
1227
lists:duplicate(N,32). % 32 = space
1230
gen_objset_dec(_,_,{unique,undefined},_,_,_,_) ->
1231
%% There is no unique field in the class of this object set
1232
%% don't bother about the constraint
1234
gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],
1235
ClName,ClFields,NthObj)->
1236
emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},
1241
gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSName,
1244
emit({" fun 'dec_",ObjName,"'/4"}),
1248
gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields,
1250
gen_objset_dec(Erules,ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName,
1252
emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}),
1255
gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSetName,
1258
emit({" fun 'dec_",ObjName,"'/4"})
1261
gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,_ClFields,
1263
emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}),
1264
emit({indent(3),"fun(_, Bytes, _, _) ->",nl}),
1265
emit({indent(6),"Len = case Bytes of",nl,indent(9),
1266
"Bin when binary(Bin) -> size(Bin);",nl,indent(9),
1267
"_ -> length(Bytes)",nl,indent(6),"end,"}),
1268
emit({indent(6),"{Bytes,[],Len}",nl}),
1269
emit({indent(3),"end.",nl,nl}),
1271
gen_objset_dec(_,_,_,[],_,_,_) ->
1274
gen_inlined_dec_funs(Erules,Fields,[{typefield,Name,Prop}|Rest],
1275
ObjSetName,NthObj) ->
1276
DecProp = case Prop of
1277
'OPTIONAL' -> opt_or_default;
1278
{'DEFAULT',_} -> opt_or_default;
1281
InternalDefFunName = [NthObj,Name,ObjSetName],
1282
case lists:keysearch(Name,1,Fields) of
1283
{value,{_,Type}} when record(Type,type) ->
1284
emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->",
1285
nl,indent(6),"case Type of",nl}),
1286
N=emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName),
1287
gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N);
1288
{value,{_,Type}} when record(Type,typedef) ->
1289
emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->",
1290
nl,indent(6),"case Type of",nl}),
1291
emit({indent(9),{asis,Name}," ->",nl}),
1292
N=emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName),
1293
gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N);
1295
gen_inlined_dec_funs(Erules,Fields,Rest,ObjSetName,NthObj)
1297
gen_inlined_dec_funs(Erules,Fields,[_H|Rest],ObjSetName,NthObj) ->
1298
gen_inlined_dec_funs(Erules,Fields,Rest,ObjSetName,NthObj);
1299
gen_inlined_dec_funs(_,_,[],_,NthObj) ->
1302
gen_inlined_dec_funs1(Erules,Fields,[{typefield,Name,Prop}|Rest],
1303
ObjSetName,NthObj) ->
1304
DecProp = case Prop of
1305
'OPTIONAL' -> opt_or_default;
1306
{'DEFAULT',_} -> opt_or_default;
1309
InternalDefFunName = [NthObj,Name,ObjSetName],
1311
case lists:keysearch(Name,1,Fields) of
1312
{value,{_,Type}} when record(Type,type) ->
1314
emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName);
1315
{value,{_,Type}} when record(Type,typedef) ->
1316
emit({";",nl,indent(9),{asis,Name}," ->",nl}),
1317
emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName);
1321
gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N);
1322
gen_inlined_dec_funs1(Erules,Fields,[_H|Rest],ObjSetName,NthObj)->
1323
gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj);
1324
gen_inlined_dec_funs1(_,_,[],_,NthObj) ->
1325
emit({nl,indent(6),"end",nl}),
1326
emit({indent(3),"end"}),
1329
emit_inner_of_decfun(Erules,#typedef{name={ExtName,Name},typespec=Type},
1330
Prop,InternalDefFunName) ->
1331
OTag = Type#type.tag,
1332
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
1333
case {ExtName,Name} of
1336
gen_dec_prim(Erules,Type,"Bytes",Tag,"TagIn",no_length,
1339
{constructed,bif} ->
1340
emit({indent(12),"'dec_",
1341
asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ",Prop,
1342
", TagIn ++ ",{asis,Tag},")"}),
1345
emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Bytes, ",Prop,
1346
", TagIn ++ ",{asis,Tag},")"}),
1349
emit_inner_of_decfun(_,#typedef{name=Name,typespec=Type},Prop,_) ->
1350
OTag = Type#type.tag,
1351
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
1352
emit({indent(12),"'dec_",Name,"'(Bytes, ",Prop,", TagIn ++ ",
1355
emit_inner_of_decfun(Erules,Type,Prop,_) when record(Type,type) ->
1356
OTag = Type#type.tag,
1357
Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag],
1358
CurrMod = get(currmod),
1359
Def = Type#type.def,
1360
InnerType = asn1ct_gen:get_inner(Def),
1361
WhatKind = asn1ct_gen:type(InnerType),
1364
emit({indent(9),Def," ->",nl,indent(12)}),
1365
gen_dec_prim(Erules,Type,"Bytes",Tag,"TagIn",no_length,
1367
% TRef when record(TRef,typereference) ->
1368
% T = TRef#typereference.val,
1369
% emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
1370
#'Externaltypereference'{module=CurrMod,type=T} ->
1371
emit({indent(9),T," ->",nl,indent(12),"'dec_",T,
1372
"'(Bytes, ",Prop,", TagIn ++ ",{asis,Tag},")"});
1373
#'Externaltypereference'{module=ExtMod,type=T} ->
1374
emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_",
1375
T,"'(Bytes, ",Prop,", TagIn ++ ",{asis,Tag},")"})
1380
gen_internal_funcs(_,[]) ->
1382
gen_internal_funcs(Erules,[TypeDef|Rest]) ->
1383
gen_encode_user(Erules,TypeDef),
1384
emit({"'dec_",TypeDef#typedef.name,"'(Bytes, ",
1385
unused_optormand_var("OptOrMand",(TypeDef#typedef.typespec)#type.def),", TagIn) ->",nl}),
1386
gen_decode_user(Erules,TypeDef),
1387
gen_internal_funcs(Erules,Rest).
1391
demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}).
1394
decode_class('UNIVERSAL') ->
1396
decode_class('APPLICATION') ->
1398
decode_class('CONTEXT') ->
1400
decode_class('PRIVATE') ->
1403
decode_type('BOOLEAN') -> 1;
1404
decode_type('INTEGER') -> 2;
1405
decode_type('BIT STRING') -> 3;
1406
decode_type('OCTET STRING') -> 4;
1407
decode_type('NULL') -> 5;
1408
decode_type('OBJECT IDENTIFIER') -> 6;
1409
decode_type('OBJECT DESCRIPTOR') -> 7;
1410
decode_type('EXTERNAL') -> 8;
1411
decode_type('REAL') -> 9;
1412
decode_type('ENUMERATED') -> 10;
1413
decode_type('EMBEDDED_PDV') -> 11;
1414
decode_type('SEQUENCE') -> 16;
1415
decode_type('SEQUENCE OF') -> 16;
1416
decode_type('SET') -> 17;
1417
decode_type('SET OF') -> 17;
1418
decode_type('NumericString') -> 18;
1419
decode_type('PrintableString') -> 19;
1420
decode_type('TeletexString') -> 20;
1421
decode_type('VideotexString') -> 21;
1422
decode_type('IA5String') -> 22;
1423
decode_type('UTCTime') -> 23;
1424
decode_type('GeneralizedTime') -> 24;
1425
decode_type('GraphicString') -> 25;
1426
decode_type('VisibleString') -> 26;
1427
decode_type('GeneralString') -> 27;
1428
decode_type('UniversalString') -> 28;
1429
decode_type('BMPString') -> 30;
1430
decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative
1431
decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}).
1433
add_removed_bytes() ->
1434
asn1ct_name:delete(rb),
1435
add_removed_bytes(asn1ct_name:all(rb)).
1437
add_removed_bytes([H,T1|T]) ->
1438
emit({{var,H},"+"}),
1439
add_removed_bytes([T1|T]);
1440
add_removed_bytes([H|T]) ->
1442
add_removed_bytes(T);
1443
add_removed_bytes([]) ->
1446
mkfuncname(WhatKind,DecOrEnc) ->
1448
#'Externaltypereference'{module=Mod,type=EType} ->
1449
CurrMod = get(currmod),
1452
lists:concat(["'",DecOrEnc,"_",EType,"'"]);
1454
% io:format("CurrMod: ~p, Mod: ~p~n",[CurrMod,Mod]),
1455
lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"])
1457
#'typereference'{val=EType} ->
1458
lists:concat(["'",DecOrEnc,"_",EType,"'"]);
1460
lists:concat(["'",DecOrEnc,"_",WhatKind,"'"])
1464
optionals(L) -> optionals(L,[],1).
1466
optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) ->
1467
optionals(Rest,Acc,Pos); % optionals in extension are currently not handled
1468
optionals([#'ComponentType'{name=Name,prop='OPTIONAL'}|Rest],Acc,Pos) ->
1469
optionals(Rest,[{Name,Pos}|Acc],Pos+1);
1470
optionals([#'ComponentType'{name=Name,prop={'DEFAULT',_}}|Rest],Acc,Pos) ->
1471
optionals(Rest,[{Name,Pos}|Acc],Pos+1);
1472
optionals([#'ComponentType'{}|Rest],Acc,Pos) ->
1473
optionals(Rest,Acc,Pos+1);
1474
optionals([],Acc,_) ->
1477
get_constraint(C,Key) ->
1478
case lists:keysearch(Key,1,C) of
1485
%% if the original option was ber and it has been wrapped to ber_bin
1486
%% turn it back to ber
1487
re_wrap_erule(ber_bin) ->
1488
case get(encoding_options) of
1489
Options when list(Options) ->
1490
case lists:member(ber,Options) of
1496
re_wrap_erule(Erule) ->
1499
is_already_generated(Operation,Name) ->
1500
case get(class_default_type) of
1502
put(class_default_type,[{Operation,Name}]),
1505
case lists:member({Operation,Name},GeneratedList) of
1509
put(class_default_type,[{Operation,Name}|GeneratedList]),
1514
get_class_fields(#classdef{typespec=ObjClass}) ->
1515
ObjClass#objectclass.fields;
1516
get_class_fields(#objectclass{fields=Fields}) ->
1518
get_class_fields(_) ->
1521
get_object_field(Name,ObjectFields) ->
1522
case lists:keysearch(Name,1,ObjectFields) of
1523
{value,Field} -> Field;
added
removed
lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_ber.erl
