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