File Coverage

blib/lib/Convert/ASN1/parser.pm
Criterion Covered Total %
statement 283 389 72.8
branch 79 130 60.8
condition 36 71 50.7
subroutine 11 18 61.1
pod 0 13 0.0
total 409 621 65.9


line stmt bran cond sub pod time code
1             # 1 "y.tab.pl"
2             #$yysccsid = "@(#)yaccpar 1.8 (Berkeley) 01/20/91 (Perl 2.0 12/31/92)";
3              
4             # 22 "parser.y"
5              
6             ;# Copyright (c) 2000-2005 Graham Barr <gbarr@pobox.com>. All rights reserved.
7             ;# This program is free software; you can redistribute it and/or
8             ;# modify it under the same terms as Perl itself.
9              
10             package Convert::ASN1::parser;
11              
12 15     15   211 use strict;
  15         141  
  15         287  
13 15     15   328 use Convert::ASN1 qw(:all);
  15         144  
  15         429  
14 15         272 use vars qw(
15             $asn $yychar $yyerrflag $yynerrs $yyn @yyss
16             $yyssp $yystate @yyvs $yyvsp $yylval $yys $yym $yyval
17 15     15   414 );
  15         143  
18              
19 15     15   299 BEGIN { Convert::ASN1->_internal_syms }
20              
21             my $yydebug=0;
22             my %yystate;
23              
24             my %base_type = (
25               BOOLEAN => [ asn_encode_tag(ASN_BOOLEAN), opBOOLEAN ],
26               INTEGER => [ asn_encode_tag(ASN_INTEGER), opINTEGER ],
27               BIT_STRING => [ asn_encode_tag(ASN_BIT_STR), opBITSTR ],
28               OCTET_STRING => [ asn_encode_tag(ASN_OCTET_STR), opSTRING ],
29               STRING => [ asn_encode_tag(ASN_OCTET_STR), opSTRING ],
30               NULL => [ asn_encode_tag(ASN_NULL), opNULL ],
31               OBJECT_IDENTIFIER => [ asn_encode_tag(ASN_OBJECT_ID), opOBJID ],
32               REAL => [ asn_encode_tag(ASN_REAL), opREAL ],
33               ENUMERATED => [ asn_encode_tag(ASN_ENUMERATED), opINTEGER ],
34               ENUM => [ asn_encode_tag(ASN_ENUMERATED), opINTEGER ],
35               'RELATIVE-OID' => [ asn_encode_tag(ASN_RELATIVE_OID), opROID ],
36              
37               SEQUENCE => [ asn_encode_tag(ASN_SEQUENCE | ASN_CONSTRUCTOR), opSEQUENCE ],
38               SET => [ asn_encode_tag(ASN_SET | ASN_CONSTRUCTOR), opSET ],
39              
40               ObjectDescriptor => [ asn_encode_tag(ASN_UNIVERSAL | 7), opSTRING ],
41               UTF8String => [ asn_encode_tag(ASN_UNIVERSAL | 12), opUTF8 ],
42               NumericString => [ asn_encode_tag(ASN_UNIVERSAL | 18), opSTRING ],
43               PrintableString => [ asn_encode_tag(ASN_UNIVERSAL | 19), opSTRING ],
44               TeletexString => [ asn_encode_tag(ASN_UNIVERSAL | 20), opSTRING ],
45               T61String => [ asn_encode_tag(ASN_UNIVERSAL | 20), opSTRING ],
46               VideotexString => [ asn_encode_tag(ASN_UNIVERSAL | 21), opSTRING ],
47               IA5String => [ asn_encode_tag(ASN_UNIVERSAL | 22), opSTRING ],
48               UTCTime => [ asn_encode_tag(ASN_UNIVERSAL | 23), opUTIME ],
49               GeneralizedTime => [ asn_encode_tag(ASN_UNIVERSAL | 24), opGTIME ],
50               GraphicString => [ asn_encode_tag(ASN_UNIVERSAL | 25), opSTRING ],
51               VisibleString => [ asn_encode_tag(ASN_UNIVERSAL | 26), opSTRING ],
52               ISO646String => [ asn_encode_tag(ASN_UNIVERSAL | 26), opSTRING ],
53               GeneralString => [ asn_encode_tag(ASN_UNIVERSAL | 27), opSTRING ],
54               CharacterString => [ asn_encode_tag(ASN_UNIVERSAL | 28), opSTRING ],
55               UniversalString => [ asn_encode_tag(ASN_UNIVERSAL | 28), opSTRING ],
56               BMPString => [ asn_encode_tag(ASN_UNIVERSAL | 30), opSTRING ],
57               BCDString => [ asn_encode_tag(ASN_OCTET_STR), opBCD ],
58              
59               CHOICE => [ '', opCHOICE ],
60               ANY => [ '', opANY ],
61             );
62              
63             ;# Given an OP, wrap it in a SEQUENCE
64              
65             sub explicit {
66 1     1 0 9   my $op = shift;
67 1         11   my @seq = @$op;
68              
69 1         12   @seq[cTYPE,cCHILD,cVAR,cLOOP] = ('SEQUENCE',[$op],undef,undef);
70 1         9   @{$op}[cTAG,cOPT] = ();
  1         10  
71              
72 1         11   \@seq;
73             }
74              
75             # 74 "y.tab.pl"
76              
77             sub constWORD () { 1 }
78             sub constCLASS () { 2 }
79             sub constSEQUENCE () { 3 }
80             sub constSET () { 4 }
81             sub constCHOICE () { 5 }
82             sub constOF () { 6 }
83             sub constIMPLICIT () { 7 }
84             sub constEXPLICIT () { 8 }
85             sub constOPTIONAL () { 9 }
86             sub constLBRACE () { 10 }
87             sub constRBRACE () { 11 }
88             sub constCOMMA () { 12 }
89             sub constANY () { 13 }
90             sub constASSIGN () { 14 }
91             sub constNUMBER () { 15 }
92             sub constENUM () { 16 }
93             sub constCOMPONENTS () { 17 }
94             sub constPOSTRBRACE () { 18 }
95             sub constDEFINED () { 19 }
96             sub constBY () { 20 }
97             sub constYYERRCODE () { 256 }
98             my @yylhs = ( -1,
99                 0, 0, 2, 2, 3, 3, 6, 6, 6, 6,
100                 8, 13, 13, 12, 14, 14, 14, 9, 9, 9,
101                10, 18, 18, 18, 18, 18, 19, 19, 11, 16,
102                16, 20, 20, 20, 21, 1, 1, 22, 22, 22,
103                24, 24, 24, 24, 23, 23, 23, 15, 15, 4,
104                 4, 5, 5, 5, 17, 17, 25, 7, 7,
105             );
106             my @yylen = ( 2,
107                 1, 1, 3, 4, 4, 1, 1, 1, 1, 1,
108                 3, 1, 1, 6, 1, 1, 1, 4, 4, 4,
109                 4, 1, 1, 1, 2, 1, 0, 3, 1, 1,
110                 2, 1, 3, 3, 4, 1, 2, 1, 3, 3,
111                 2, 1, 1, 1, 4, 1, 3, 0, 1, 0,
112                 1, 0, 1, 1, 1, 3, 2, 0, 1,
113             );
114             my @yydefred = ( 0,
115                 0, 51, 0, 0, 1, 0, 0, 46, 0, 38,
116                 0, 0, 0, 0, 54, 53, 0, 0, 0, 3,
117                 0, 6, 0, 11, 0, 0, 0, 0, 47, 0,
118                39, 40, 0, 22, 0, 0, 0, 0, 44, 42,
119                 0, 43, 0, 29, 45, 4, 0, 0, 0, 0,
120                 7, 8, 9, 10, 0, 25, 0, 49, 41, 0,
121                 0, 0, 0, 0, 0, 32, 59, 5, 0, 0,
122                 0, 55, 0, 18, 19, 0, 20, 0, 0, 28,
123                57, 21, 0, 0, 0, 34, 33, 56, 0, 0,
124                17, 15, 16, 0, 35, 14,
125             );
126             my @yydgoto = ( 4,
127                 5, 6, 20, 7, 17, 50, 68, 8, 51, 52,
128                53, 54, 43, 94, 59, 64, 71, 44, 56, 65,
129                66, 9, 10, 45, 72,
130             );
131             my @yysindex = ( 7,
132                 9, 0, 12, 0, 0, 19, 51, 0, 34, 0,
133                75, 51, 31, -1, 0, 0, 90, 55, 55, 0,
134                51, 0, 114, 0, 75, 26, 53, 61, 0, 77,
135                 0, 0, 114, 0, 26, 53, 64, 76, 0, 0,
136                89, 0, 96, 0, 0, 0, 55, 55, 111, 103,
137                 0, 0, 0, 0, 94, 0, 130, 0, 0, 77,
138               122, 128, 77, 139, 78, 0, 0, 0, 154, 143,
139                33, 0, 51, 0, 0, 51, 0, 111, 111, 0,
140                 0, 0, 130, 119, 114, 0, 0, 0, 26, 53,
141                 0, 0, 0, 89, 0, 0,
142             );
143             my @yyrindex = ( 149,
144               100, 0, 0, 0, 0, 159, 106, 0, 39, 0,
145               100, 133, 0, 0, 0, 0, 0, 149, 140, 0,
146               133, 0, 0, 0, 100, 0, 0, 0, 0, 100,
147                 0, 0, 0, 0, 16, 29, 42, 69, 0, 0,
148                37, 0, 0, 0, 0, 0, 149, 149, 0, 125,
149                 0, 0, 0, 0, 0, 0, 0, 0, 0, 100,
150                 0, 0, 100, 0, 150, 0, 0, 0, 0, 0,
151                 0, 0, 133, 0, 0, 133, 0, 0, 151, 0,
152                 0, 0, 0, 0, 0, 0, 0, 0, 73, 88,
153                 0, 0, 0, 3, 0, 0,
154             );
155             my @yygindex = ( 0,
156                28, 0, 135, 1, -11, 79, 0, 8, -17, -18,
157               -16, 142, 0, 0, 72, 0, 0, 0, 0, 0,
158                50, 0, 123, 0, 80,
159             );
160             sub constYYTABLESIZE () { 166 }
161             my @yytable = ( 29,
162                23, 12, 48, 48, 40, 39, 41, 1, 2, 33,
163                 2, 21, 25, 48, 48, 23, 23, 13, 22, 14,
164                48, 12, 11, 3, 23, 21, 23, 23, 24, 24,
165                12, 24, 22, 23, 13, 47, 48, 24, 36, 24,
166                24, 27, 27, 82, 83, 18, 24, 48, 48, 36,
167                27, 19, 27, 27, 48, 30, 2, 15, 16, 27,
168                73, 84, 48, 76, 85, 92, 91, 93, 26, 26,
169                49, 3, 23, 23, 61, 62, 2, 26, 2, 26,
170                26, 23, 55, 23, 23, 57, 26, 24, 24, 78,
171                23, 3, 26, 27, 28, 79, 24, 58, 24, 24,
172                50, 60, 50, 50, 50, 24, 50, 50, 52, 52,
173                52, 63, 50, 69, 34, 50, 35, 36, 28, 34,
174                67, 89, 90, 28, 58, 58, 37, 86, 87, 38,
175                70, 37, 74, 52, 38, 52, 52, 52, 75, 37,
176                31, 32, 50, 50, 50, 52, 50, 50, 52, 77,
177                37, 50, 50, 50, 80, 50, 50, 81, 2, 46,
178                30, 31, 88, 95, 42, 96,
179             );
180             my @yycheck = ( 17,
181                12, 1, 0, 1, 23, 23, 23, 1, 2, 21,
182                 2, 11, 14, 11, 12, 0, 1, 6, 11, 1,
183                18, 6, 14, 17, 9, 25, 11, 12, 0, 1,
184                30, 1, 25, 18, 6, 10, 0, 9, 0, 11,
185                12, 0, 1, 11, 12, 12, 18, 11, 12, 11,
186                 9, 18, 11, 12, 18, 1, 2, 7, 8, 18,
187                60, 73, 10, 63, 76, 84, 84, 84, 0, 1,
188                10, 17, 0, 1, 47, 48, 2, 9, 2, 11,
189                12, 9, 19, 11, 12, 10, 18, 0, 1, 12,
190                18, 17, 3, 4, 5, 18, 9, 9, 11, 12,
191                 1, 6, 3, 4, 5, 18, 7, 8, 3, 4,
192                 5, 1, 13, 20, 1, 16, 3, 4, 5, 1,
193                18, 3, 4, 5, 0, 1, 13, 78, 79, 16,
194                 1, 13, 11, 1, 16, 3, 4, 5, 11, 0,
195                18, 19, 3, 4, 5, 13, 7, 8, 16, 11,
196                11, 3, 4, 5, 1, 7, 8, 15, 0, 25,
197                11, 11, 83, 85, 23, 94,
198             );
199             sub constYYFINAL () { 4 }
200              
201              
202              
203             sub constYYMAXTOKEN () { 20 }
204             # 270 "y.tab.pl"
205              
206 0     0 0 0 sub yyclearin { $yychar = -1; }
207 0     0 0 0 sub yyerrok { $yyerrflag = 0; }
208 0     0 0 0 sub YYERROR { ++$yynerrs; &yy_err_recover; }
  0         0  
209             sub yy_err_recover
210             {
211 0 0   0 0 0   if ($yyerrflag < 3)
212               {
213 0         0     $yyerrflag = 3;
214 0         0     while (1)
215                 {
216 0 0 0     0       if (($yyn = $yysindex[$yyss[$yyssp]]) &&
      0        
      0        
217                       ($yyn += constYYERRCODE()) >= 0 &&
218                       $yyn <= $#yycheck && $yycheck[$yyn] == constYYERRCODE())
219                   {
220              
221              
222              
223              
224 0         0         $yyss[++$yyssp] = $yystate = $yytable[$yyn];
225 0         0         $yyvs[++$yyvsp] = $yylval;
226 0         0         next yyloop;
227                   }
228                   else
229                   {
230              
231              
232              
233              
234 0 0       0         return(1) if $yyssp <= 0;
235 0         0         --$yyssp;
236 0         0         --$yyvsp;
237                   }
238                 }
239               }
240               else
241               {
242 0 0       0     return (1) if $yychar == 0;
243             # 321 "y.tab.pl"
244              
245 0         0     $yychar = -1;
246 0         0     next yyloop;
247               }
248 0         0 0;
249             } # yy_err_recover
250              
251             sub yyparse
252             {
253              
254 79 50   79 0 1020   if ($yys = $ENV{'YYDEBUG'})
255               {
256 0 0       0     $yydebug = int($1) if $yys =~ /^(\d)/;
257               }
258              
259              
260 79         764   $yynerrs = 0;
261 79         661   $yyerrflag = 0;
262 79         653   $yychar = (-1);
263              
264 79         868   $yyssp = 0;
265 79         1207   $yyvsp = 0;
266 79         902   $yyss[$yyssp] = $yystate = 0;
267              
268 79         687 yyloop: while(1)
269               {
270 1675 100       23455     yyreduce: {
271 1675         16366       last yyreduce if ($yyn = $yydefred[$yystate]);
272 904 100       13524       if ($yychar < 0)
273                   {
274 488 50       5213         if (($yychar = &yylex) < 0) { $yychar = 0; }
  0         0  
275             # 360 "y.tab.pl"
276              
277                   }
278 904 100 33     23272       if (($yyn = $yysindex[$yystate]) && ($yyn += $yychar) >= 0 &&
      33        
      66        
279                           $yyn <= $#yycheck && $yycheck[$yyn] == $yychar)
280                   {
281              
282              
283              
284              
285 409         5228         $yyss[++$yyssp] = $yystate = $yytable[$yyn];
286 409         4139         $yyvs[++$yyvsp] = $yylval;
287 409         3702         $yychar = (-1);
288 409 50       4455         --$yyerrflag if $yyerrflag > 0;
289 409         3962         next yyloop;
290                   }
291 495 50 33     11825       if (($yyn = $yyrindex[$yystate]) && ($yyn += $yychar) >= 0 &&
      33        
      33        
292                         $yyn <= $#yycheck && $yycheck[$yyn] == $yychar)
293                   {
294 495         4317         $yyn = $yytable[$yyn];
295 495         6790         last yyreduce;
296                   }
297 0 0       0       if (! $yyerrflag) {
298 0         0         &yyerror('syntax error');
299 0         0         ++$yynerrs;
300                   }
301 0 0       0       return undef if &yy_err_recover;
302                 } # yyreduce
303              
304              
305              
306              
307 1266         11005     $yym = $yylen[$yyn];
308 1266         15332     $yyval = $yyvs[$yyvsp+1-$yym];
309 1266         12921     switch:
310                 {
311 1266         18277 my $label = "State$yyn";
312 1266 100       20157 goto $label if exists $yystate{$label};
313 188         1622 last switch;
314 73         1007 State1: {
315             # 96 "parser.y"
316              
317 73         631 { $yyval = { '' => $yyvs[$yyvsp-0] };
  73         600  
318 73         724 last switch;
319             } }
320             State3: {
321             # 101 "parser.y"
322              
323 6         52 {
324 6         72 $yyval = { $yyvs[$yyvsp-2], [$yyvs[$yyvsp-0]] };
  6         82  
325            
326 6         61 last switch;
327             } }
328             State4: {
329             # 105 "parser.y"
330              
331 14         175 {
332 14         169 $yyval=$yyvs[$yyvsp-3];
  14         206  
333 14         242 $yyval->{$yyvs[$yyvsp-2]} = [$yyvs[$yyvsp-0]];
334            
335 14         131 last switch;
336             } }
337             State5: {
338             # 112 "parser.y"
339              
340 20         168 {
341 20         576 $yyvs[$yyvsp-1]->[cTAG] = $yyvs[$yyvsp-3];
  20         207  
342 20 100       246 $yyval = $yyvs[$yyvsp-2] ? explicit($yyvs[$yyvsp-1]) : $yyvs[$yyvsp-1];
343            
344 20         295 last switch;
345             } }
346             State11: {
347             # 126 "parser.y"
348              
349 0         0 {
350 0         0 @{$yyval = []}[cTYPE,cCHILD] = ('COMPONENTS', $yyvs[$yyvsp-0]);
  0         0  
  0         0  
351            
352 0         0 last switch;
353             } }
354             State14: {
355             # 136 "parser.y"
356              
357 9         108 {
358 9         78 $yyvs[$yyvsp-1]->[cTAG] = $yyvs[$yyvsp-3];
  9         97  
359 9         109 @{$yyval = []}[cTYPE,cCHILD,cLOOP,cOPT] = ($yyvs[$yyvsp-5], [$yyvs[$yyvsp-1]], 1, $yyvs[$yyvsp-0]);
  9         127  
360 9 50       116 $yyval = explicit($yyval) if $yyvs[$yyvsp-2];
361            
362 9         80 last switch;
363             } }
364             State18: {
365             # 149 "parser.y"
366              
367 12         110 {
368 12         134 @{$yyval = []}[cTYPE,cCHILD] = ('SEQUENCE', $yyvs[$yyvsp-1]);
  12         135  
  12         175  
369            
370 12         124 last switch;
371             } }
372             State19: {
373             # 153 "parser.y"
374              
375 4         6942 {
376 4         33 @{$yyval = []}[cTYPE,cCHILD] = ('SET', $yyvs[$yyvsp-1]);
  4         44  
  4         66  
377            
378 4         45 last switch;
379             } }
380             State20: {
381             # 157 "parser.y"
382              
383 4         63 {
384 4         35 @{$yyval = []}[cTYPE,cCHILD] = ('CHOICE', $yyvs[$yyvsp-1]);
  4         37  
  4         52  
385            
386 4         41 last switch;
387             } }
388             State21: {
389             # 163 "parser.y"
390              
391 0         0 {
392 0         0 @{$yyval = []}[cTYPE] = ('ENUM');
  0         0  
  0         0  
393            
394 0         0 last switch;
395             } }
396             State22: {
397             # 168 "parser.y"
398              
399 112         991 { @{$yyval = []}[cTYPE] = $yyvs[$yyvsp-0];
  112         1338  
  112         4173  
  112         1623  
400 112         1171 last switch;
401             } }
402             State23: {
403             # 169 "parser.y"
404              
405 0         0 { @{$yyval = []}[cTYPE] = $yyvs[$yyvsp-0];
  0         0  
  0         0  
  0         0  
406 0         0 last switch;
407             } }
408             State24: {
409             # 170 "parser.y"
410              
411 0         0 { @{$yyval = []}[cTYPE] = $yyvs[$yyvsp-0];
  0         0  
  0         0  
  0         0  
412 0         0 last switch;
413             } }
414             State25: {
415             # 172 "parser.y"
416              
417 1         11 {
418 1         111 @{$yyval = []}[cTYPE,cCHILD,cDEFINE] = ('ANY',undef,$yyvs[$yyvsp-0]);
  1         19  
  1         17  
419            
420 1         11 last switch;
421             } }
422             State26: {
423             # 175 "parser.y"
424              
425 3         26 { @{$yyval = []}[cTYPE] = $yyvs[$yyvsp-0];
  3         24  
  3         27  
  3         40  
426 3         30 last switch;
427             } }
428             State27: {
429             # 178 "parser.y"
430              
431 0         0 { $yyval=undef;
  0         0  
  0         0  
432 0         0 last switch;
433             } }
434             State28: {
435             # 179 "parser.y"
436              
437 1         10 { $yyval=$yyvs[$yyvsp-0];
  1         10  
  1         9  
438 1         10 last switch;
439             } }
440             State30: {
441             # 185 "parser.y"
442              
443 4         34 { $yyval = $yyvs[$yyvsp-0];
  4         37  
  4         36  
444 4         37 last switch;
445             } }
446             State31: {
447             # 186 "parser.y"
448              
449 0         0 { $yyval = $yyvs[$yyvsp-1];
  0         0  
  0         0  
450 0         0 last switch;
451             } }
452             State32: {
453             # 190 "parser.y"
454              
455 4         35 {
456 4         35 $yyval = [ $yyvs[$yyvsp-0] ];
  4         44  
457            
458 4         39 last switch;
459             } }
460             State33: {
461             # 194 "parser.y"
462              
463 0         0 {
464 0         0 push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
  0         0  
  0         0  
465            
466 0         0 last switch;
467             } }
468             State34: {
469             # 198 "parser.y"
470              
471 2         19 {
472 2         18 push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
  2         17  
  2         23  
473            
474 2         18 last switch;
475             } }
476             State35: {
477             # 204 "parser.y"
478              
479 6         53 {
480 6         48 @{$yyval=$yyvs[$yyvsp-0]}[cVAR,cTAG] = ($yyvs[$yyvsp-3],$yyvs[$yyvsp-2]);
  6         89  
  6         73  
481 6 50       124 $yyval = explicit($yyval) if $yyvs[$yyvsp-1];
482            
483 6         56 last switch;
484             } }
485             State36: {
486             # 211 "parser.y"
487              
488 78         744 { $yyval = $yyvs[$yyvsp-0];
  78         659  
  78         748  
489 78         714 last switch;
490             } }
491             State37: {
492             # 212 "parser.y"
493              
494 11         96 { $yyval = $yyvs[$yyvsp-1];
  11         93  
  11         149  
495 11         108 last switch;
496             } }
497             State38: {
498             # 216 "parser.y"
499              
500 89         740 {
501 89         816 $yyval = [ $yyvs[$yyvsp-0] ];
  89         1197  
502            
503 89         1670 last switch;
504             } }
505             State39: {
506             # 220 "parser.y"
507              
508 21         186 {
509 21         172 push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
  21         180  
  21         230  
510            
511 21         196 last switch;
512             } }
513             State40: {
514             # 224 "parser.y"
515              
516 0         0 {
517 0         0 push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
  0         0  
  0         0  
518            
519 0         0 last switch;
520             } }
521             State41: {
522             # 230 "parser.y"
523              
524 96         1032 {
525 96         864 @{$yyval=$yyvs[$yyvsp-1]}[cOPT] = ($yyvs[$yyvsp-0]);
  96         1062  
  96         2381  
526            
527 96         997 last switch;
528             } }
529             State45: {
530             # 239 "parser.y"
531              
532 101         2194 {
533 101         913 @{$yyval=$yyvs[$yyvsp-0]}[cVAR,cTAG] = ($yyvs[$yyvsp-3],$yyvs[$yyvsp-2]);
  101         1516  
  101         2779  
534 101 100       1193 $yyval->[cOPT] = $yyvs[$yyvsp-3] if $yyval->[cOPT];
535 101 50       1017 $yyval = explicit($yyval) if $yyvs[$yyvsp-1];
536            
537 101         1690 last switch;
538             } }
539             State47: {
540             # 246 "parser.y"
541              
542 9         80 {
543 9         96 @{$yyval=$yyvs[$yyvsp-0]}[cTAG] = ($yyvs[$yyvsp-2]);
  9         111  
  9         100  
544 9 50       109 $yyval = explicit($yyval) if $yyvs[$yyvsp-1];
545            
546 9         86 last switch;
547             } }
548             State48: {
549             # 252 "parser.y"
550              
551 101         1979 { $yyval = undef;
  101         867  
  101         1120  
552 101         947 last switch;
553             } }
554             State49: {
555             # 253 "parser.y"
556              
557 4         35 { $yyval = 1;
  4         32  
  4         36  
558 4         36 last switch;
559             } }
560             State50: {
561             # 257 "parser.y"
562              
563 128         1115 { $yyval = undef;
  128         1419  
  128         1302  
564 128         1291 last switch;
565             } }
566             State52: {
567             # 261 "parser.y"
568              
569 144         1363 { $yyval = undef;
  144         1310  
  144         1288  
570 144         1260 last switch;
571             } }
572             State53: {
573             # 262 "parser.y"
574              
575 1         10 { $yyval = 1;
  1         35  
  1         9  
576 1         10 last switch;
577             } }
578             State54: {
579             # 263 "parser.y"
580              
581 0         0 { $yyval = 0;
  0         0  
  0         0  
582 0         0 last switch;
583             } }
584             State55: {
585             # 266 "parser.y"
586              
587 0         0 {
588 0         0 last switch;
  0         0  
589             } }
590             State56: {
591             # 267 "parser.y"
592              
593 0         0 {
594 0         0 last switch;
  0         0  
595             } }
596             State57: {
597             # 270 "parser.y"
598              
599 0         0 {
600 0         0 last switch;
  0         0  
601             } }
602             State58: {
603             # 273 "parser.y"
604              
605 11         102 {
606 11         110 last switch;
  11         98  
607             } }
608             State59: {
609             # 274 "parser.y"
610              
611 9         79 {
612 9         73 last switch;
  9         77  
613             } }
614             # 653 "y.tab.pl"
615              
616                 } # switch
617 1266         14416     $yyssp -= $yym;
618 1266         12282     $yystate = $yyss[$yyssp];
619 1266         19718     $yyvsp -= $yym;
620 1266         13960     $yym = $yylhs[$yyn];
621 1266 100 100     28304     if ($yystate == 0 && $yym == 0)
622                 {
623              
624              
625              
626              
627 79         688       $yystate = constYYFINAL();
628 79         673       $yyss[++$yyssp] = constYYFINAL();
629 79         862       $yyvs[++$yyvsp] = $yyval;
630 79 50       3240       if ($yychar < 0)
631                   {
632 0 0       0         if (($yychar = &yylex) < 0) { $yychar = 0; }
  0         0  
633             # 679 "y.tab.pl"
634              
635                   }
636 79 50       1224       return $yyvs[$yyvsp] if $yychar == 0;
637 0         0       next yyloop;
638                 }
639 1187 100 100     29877     if (($yyn = $yygindex[$yym]) && ($yyn += $yystate) >= 0 &&
      100        
      100        
640                     $yyn <= $#yycheck && $yycheck[$yyn] == $yystate)
641                 {
642 459         4214         $yystate = $yytable[$yyn];
643                 } else {
644 728         6581         $yystate = $yydgoto[$yym];
645                 }
646              
647              
648              
649              
650 1187         10785     $yyss[++$yyssp] = $yystate;
651 1187         14244     $yyvs[++$yyvsp] = $yyval;
652               } # yyloop
653             } # yyparse
654             # 278 "parser.y"
655              
656              
657             my %reserved = (
658               'OPTIONAL' => constOPTIONAL(),
659               'CHOICE' => constCHOICE(),
660               'OF' => constOF(),
661               'IMPLICIT' => constIMPLICIT(),
662               'EXPLICIT' => constEXPLICIT(),
663               'SEQUENCE' => constSEQUENCE(),
664               'SET' => constSET(),
665               'ANY' => constANY(),
666               'ENUM' => constENUM(),
667               'ENUMERATED' => constENUM(),
668               'COMPONENTS' => constCOMPONENTS(),
669               '{' => constLBRACE(),
670               '}' => constRBRACE(),
671               ',' => constCOMMA(),
672               '::=' => constASSIGN(),
673               'DEFINED' => constDEFINED(),
674               'BY' => constBY()
675             );
676              
677             my $reserved = join("|", reverse sort grep { /\w/ } keys %reserved);
678              
679             my %tag_class = (
680               APPLICATION => ASN_APPLICATION,
681               UNIVERSAL => ASN_UNIVERSAL,
682               PRIVATE => ASN_PRIVATE,
683               CONTEXT => ASN_CONTEXT,
684               '' => ASN_CONTEXT # if not specified, its CONTEXT
685             );
686              
687             ;##
688             ;## This is NOT thread safe !!!!!!
689             ;##
690              
691             my $pos;
692             my $last_pos;
693             my @stacked;
694              
695             sub parse {
696 79     79 0 979   local(*asn) = \($_[0]);
697 79         768   ($pos,$last_pos,@stacked) = ();
698              
699 79         1234   eval {
700 79         1245     local $SIG{__DIE__};
701 79         2065     compile(verify(yyparse()));
702               }
703             }
704              
705             sub compile_one {
706 146     146 0 1670   my $tree = shift;
707 146         1345   my $ops = shift;
708 146         2027   my $name = shift;
709 146         1591   foreach my $op (@$ops) {
710 173 100       2355     next unless ref($op) eq 'ARRAY';
711 146         1597     bless $op;
712 146         1458     my $type = $op->[cTYPE];
713 146 100       1569     if (exists $base_type{$type}) {
714 132         2344       $op->[cTYPE] = $base_type{$type}->[1];
715 132 100       1615       $op->[cTAG] = defined($op->[cTAG]) ? asn_encode_tag($op->[cTAG]): $base_type{$type}->[0];
716                 }
717                 else {
718 14 50       142       die "Unknown type '$type'\n" unless exists $tree->{$type};
719 14 100       253       my $ref = compile_one(
720             $tree,
721             $tree->{$type},
722             defined($op->[cVAR]) ? $name . "." . $op->[cVAR] : $name
723             );
724 14 50 33     187       if (defined($op->[cTAG]) && $ref->[0][cTYPE] == opCHOICE) {
725 0         0         @{$op}[cTYPE,cCHILD] = (opSEQUENCE,$ref);
  0         0  
726                   }
727                   else {
728 14         1275         @{$op}[cTYPE,cCHILD,cLOOP] = @{$ref->[0]}[cTYPE,cCHILD,cLOOP];
  14         150  
  14         139  
729                   }
730 14 50       220       $op->[cTAG] = defined($op->[cTAG]) ? asn_encode_tag($op->[cTAG]): $ref->[0][cTAG];
731                 }
732 146 100 100     2895     $op->[cTAG] |= chr(ASN_CONSTRUCTOR)
      100        
733                   if length $op->[cTAG] && ($op->[cTYPE] == opSET || $op->[cTYPE] == opSEQUENCE);
734              
735 146 100       2005     if ($op->[cCHILD]) {
736                   ;# If we have children we are one of
737                   ;# opSET opSEQUENCE opCHOICE
738              
739 39 100       1010       compile_one($tree, $op->[cCHILD], defined($op->[cVAR]) ? $name . "." . $op->[cVAR] : $name);
740              
741                   ;# If a CHOICE is given a tag, then it must be EXPLICIT
742 39 50 66     684       if ($op->[cTYPE] == opCHOICE && defined($op->[cTAG]) && length($op->[cTAG])) {
      66        
743 0         0 $op = bless explicit($op);
744 0         0 $op->[cTYPE] = opSEQUENCE;
745                   }
746              
747 39 100       348       if ( @{$op->[cCHILD]} > 1) {
  39         484  
748                     ;#if ($op->[cTYPE] != opSEQUENCE) {
749                     ;# Here we need to flatten CHOICEs and check that SET and CHOICE
750                     ;# do not contain duplicate tags
751                     ;#}
752 19 100       225 if ($op->[cTYPE] == opSET) {
753             ;# In case we do CER encoding we order the SET elements by thier tags
754 0         0 my @tags = map {
755 4         472 length($_->[cTAG])
756             ? $_->[cTAG]
757             : $_->[cTYPE] == opCHOICE
758 12 0       227 ? (sort map { $_->[cTAG] } $_->[cCHILD])[0]
    50          
759             : ''
760 4         264 } @{$op->[cCHILD]};
761 4         126 @{$op->[cCHILD]} = @{$op->[cCHILD]}[sort { $tags[$a] cmp $tags[$b] } 0..$#tags];
  4         102  
  4         147  
  11         174  
762             }
763                   }
764                   else {
765             ;# A SET of one element can be treated the same as a SEQUENCE
766 20 100       265 $op->[cTYPE] = opSEQUENCE if $op->[cTYPE] == opSET;
767                   }
768                 }
769               }
770 146         3878   $ops;
771             }
772              
773             sub compile {
774 79     79 0 685   my $tree = shift;
775              
776               ;# The tree should be valid enough to be able to
777               ;# - resolve references
778               ;# - encode tags
779               ;# - verify CHOICEs do not contain duplicate tags
780              
781               ;# once references have been resolved, and also due to
782               ;# flattening of COMPONENTS, it is possible for an op
783               ;# to appear in multiple places. So once an op is
784               ;# compiled we bless it. This ensure we dont try to
785               ;# compile it again.
786              
787 79         953   while(my($k,$v) = each %$tree) {
788 93         1709     compile_one($tree,$v,$k);
789               }
790              
791 79         1707   $tree;
792             }
793              
794             sub verify {
795 79 50   79 0 874   my $tree = shift or return;
796 79         701   my $err = "";
797              
798               ;# Well it parsed correctly, now we
799               ;# - check references exist
800               ;# - flatten COMPONENTS OF (checking for loops)
801               ;# - check for duplicate var names
802              
803 79         1066   while(my($name,$ops) = each %$tree) {
804 93         5648     my $stash = {};
805 93         873     my @scope = ();
806 93         818     my $path = "";
807 93         1079     my $idx = 0;
808              
809 93         2460     while($ops) {
810 269 100       2720       if ($idx < @$ops) {
811 146         3956 my $op = $ops->[$idx++];
812 146         1187 my $var;
813 146 100       1609 if (defined ($var = $op->[cVAR])) {
814            
815 107 50       1486 $err .= "$name: $path.$var used multiple times\n"
816             if $stash->{$var}++;
817              
818             }
819 146 100       1933 if (defined $op->[cCHILD]) {
820 30 50       328 if (ref $op->[cCHILD]) {
    0          
821 30         353 push @scope, [$stash, $path, $ops, $idx];
822 30 100       316 if (defined $var) {
823 5         47 $stash = {};
824 5         55 $path .= "." . $var;
825             }
826 30         250 $idx = 0;
827 30         320 $ops = $op->[cCHILD];
828             }
829             elsif ($op->[cTYPE] eq 'COMPONENTS') {
830 0         0 splice(@$ops,--$idx,1,expand_ops($tree, $op->[cCHILD]));
831             }
832                       else {
833 0         0 die "Internal error\n";
834                       }
835             }
836                   }
837                   else {
838 123 100       2139 my $s = pop @scope
839             or last;
840 30         485 ($stash,$path,$ops,$idx) = @$s;
841                   }
842                 }
843               }
844 79 50       889   die $err if length $err;
845 79         1020   $tree;
846             }
847              
848             sub expand_ops {
849 0     0 0 0   my $tree = shift;
850 0         0   my $want = shift;
851 0   0     0   my $seen = shift || { };
852               
853 0 0       0   die "COMPONENTS OF loop $want\n" if $seen->{$want}++;
854 0 0       0   die "Undefined macro $want\n" unless exists $tree->{$want};
855 0         0   my $ops = $tree->{$want};
856 0 0 0     0   die "Bad macro for COMPUNENTS OF '$want'\n"
      0        
      0        
857                 unless @$ops == 1
858                     && ($ops->[0][cTYPE] eq 'SEQUENCE' || $ops->[0][cTYPE] eq 'SET')
859                     && ref $ops->[0][cCHILD];
860 0         0   $ops = $ops->[0][cCHILD];
861               for(my $idx = 0 ; $idx < @$ops ; ) {
862 0         0     my $op = $ops->[$idx++];
863 0 0       0     if ($op->[cTYPE] eq 'COMPONENTS') {
864 0         0       splice(@$ops,--$idx,1,expand_ops($tree, $op->[cCHILD], $seen));
865                 }
866 0         0   }
867              
868 0         0   @$ops;
869             }
870              
871             sub _yylex {
872 0     0   0   my $ret = &_yylex;
873 0         0   warn $ret;
874 0         0   $ret;
875             }
876              
877             sub yylex {
878 488 100   488 0 7601   return shift @stacked if @stacked;
879              
880 468         10173   while ($asn =~ /\G(?:
881             (\s+|--[^\n]*)
882             |
883             ([,{}]|::=)
884             |
885             ($reserved)\b
886             |
887             (
888             (?:OCTET|BIT)\s+STRING
889             |
890             OBJECT\s+IDENTIFIER
891             |
892             RELATIVE-OID
893             )\b
894             |
895             (\w+(?:-\w+)*)
896             |
897             \[\s*
898             (
899             (?:(?:APPLICATION|PRIVATE|UNIVERSAL|CONTEXT)\s+)?
900             \d+
901             )
902             \s*\]
903             |
904             \((\d+)\)
905             )/sxgo
906               ) {
907              
908 751         17302     ($last_pos,$pos) = ($pos,pos($asn));
909              
910 751 100       11227     next if defined $1; # comment or whitespace
911              
912 389 100 100     5680     if (defined $2 or defined $3) {
913             #A comma is not required after a '}' so to aid the
914             #parser we insert a fake token after any '}'
915 132 100 100     2036       push @stacked, constPOSTRBRACE() if defined $2 and $+ eq '}';
916              
917 132         1923       return $reserved{$yylval = $+};
918                 }
919              
920 257 100       5482     if (defined $4) {
921 14         183       ($yylval = $+) =~ s/\s+/_/g;
922 14         160       return constWORD();
923                 }
924              
925 243 100       2615     if (defined $5) {
926 226         2660       $yylval = $+;
927 226         2978       return constWORD();
928                 }
929              
930 17 50       206     if (defined $6) {
931 17         347       my($class,$num) = ($+ =~ /^([A-Z]*)\s*(\d+)$/);
932 17         699       $yylval = asn_tag($tag_class{$class}, $num);
933 17         294       return constCLASS();
934                 }
935              
936 0 0       0     if (defined $7) {
937 0         0       $yylval = $+;
938 0         0       return constNUMBER();
939                 }
940              
941 0         0     die "Internal error\n";
942              
943               }
944              
945 79 50       966   die "Parse error before ",substr($asn,$pos,40),"\n"
946                 unless $pos == length($asn);
947              
948 79         1200   0
949             }
950              
951             sub yyerror {
952 0     0 0     die @_," ",substr($asn,$last_pos,40),"\n";
953             }
954              
955             1;
956              
957             # 1001 "y.tab.pl"
958              
959             %yystate = ('State11','','State30','','State31','','State50','','State32',
960             '','State14','','State33','','State52','','State34','','State53','',
961             'State35','','State54','','State36','','State18','','State55','','State37',
962             '','State19','','State56','','State38','','State57','','State39','',
963             'State58','','State59','','State1','','State3','','State4','','State5','',
964             'State20','','State21','','State22','','State40','','State23','','State41',
965             '','State24','','State25','','State26','','State27','','State45','',
966             'State28','','State47','','State48','','State49','');
967              
968             1;
969