home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / parser.pm < prev    next >
Encoding:
Text File  |  2003-05-07  |  23.7 KB  |  970 lines
  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-2002 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. ;# $Id: parser.pm,v 1.12 2003/05/07 15:13:28 gbarr Exp $
  13.  
  14. use strict;
  15. use Convert::ASN1 qw(:all);
  16. use vars qw(
  17.   $asn $yychar $yyerrflag $yynerrs $yyn @yyss
  18.   $yyssp $yystate @yyvs $yyvsp $yylval $yys $yym $yyval
  19. );
  20.  
  21. BEGIN { Convert::ASN1->_internal_syms }
  22.  
  23. my $yydebug=0;
  24. my %yystate;
  25.  
  26. my %base_type = (
  27.   BOOLEAN        => [ asn_encode_tag(ASN_BOOLEAN),        opBOOLEAN ],
  28.   INTEGER        => [ asn_encode_tag(ASN_INTEGER),        opINTEGER ],
  29.   BIT_STRING        => [ asn_encode_tag(ASN_BIT_STR),        opBITSTR  ],
  30.   OCTET_STRING        => [ asn_encode_tag(ASN_OCTET_STR),        opSTRING  ],
  31.   STRING        => [ asn_encode_tag(ASN_OCTET_STR),        opSTRING  ],
  32.   NULL             => [ asn_encode_tag(ASN_NULL),        opNULL    ],
  33.   OBJECT_IDENTIFIER => [ asn_encode_tag(ASN_OBJECT_ID),        opOBJID   ],
  34.   REAL            => [ asn_encode_tag(ASN_REAL),        opREAL    ],
  35.   ENUMERATED        => [ asn_encode_tag(ASN_ENUMERATED),    opINTEGER ],
  36.   ENUM            => [ asn_encode_tag(ASN_ENUMERATED),    opINTEGER ],
  37.   'RELATIVE-OID'    => [ asn_encode_tag(ASN_RELATIVE_OID),    opROID      ],
  38.  
  39.   SEQUENCE        => [ asn_encode_tag(ASN_SEQUENCE | ASN_CONSTRUCTOR), opSEQUENCE ],
  40.   SET               => [ asn_encode_tag(ASN_SET      | ASN_CONSTRUCTOR), opSET ],
  41.  
  42.   ObjectDescriptor  => [ asn_encode_tag(ASN_UNIVERSAL |  7), opSTRING ],
  43.   UTF8String        => [ asn_encode_tag(ASN_UNIVERSAL | 12), opUTF8 ],
  44.   NumericString     => [ asn_encode_tag(ASN_UNIVERSAL | 18), opSTRING ],
  45.   PrintableString   => [ asn_encode_tag(ASN_UNIVERSAL | 19), opSTRING ],
  46.   TeletexString     => [ asn_encode_tag(ASN_UNIVERSAL | 20), opSTRING ],
  47.   T61String         => [ asn_encode_tag(ASN_UNIVERSAL | 20), opSTRING ],
  48.   VideotexString    => [ asn_encode_tag(ASN_UNIVERSAL | 21), opSTRING ],
  49.   IA5String         => [ asn_encode_tag(ASN_UNIVERSAL | 22), opSTRING ],
  50.   UTCTime           => [ asn_encode_tag(ASN_UNIVERSAL | 23), opUTIME ],
  51.   GeneralizedTime   => [ asn_encode_tag(ASN_UNIVERSAL | 24), opGTIME ],
  52.   GraphicString     => [ asn_encode_tag(ASN_UNIVERSAL | 25), opSTRING ],
  53.   VisibleString     => [ asn_encode_tag(ASN_UNIVERSAL | 26), opSTRING ],
  54.   ISO646String      => [ asn_encode_tag(ASN_UNIVERSAL | 26), opSTRING ],
  55.   GeneralString     => [ asn_encode_tag(ASN_UNIVERSAL | 27), opSTRING ],
  56.   CharacterString   => [ asn_encode_tag(ASN_UNIVERSAL | 28), opSTRING ],
  57.   UniversalString   => [ asn_encode_tag(ASN_UNIVERSAL | 28), opSTRING ],
  58.   BMPString         => [ asn_encode_tag(ASN_UNIVERSAL | 30), opSTRING ],
  59.  
  60.   CHOICE => [ '', opCHOICE ],
  61.   ANY    => [ '', opANY ],
  62. );
  63.  
  64. ;# Given an OP, wrap it in a SEQUENCE
  65.  
  66. sub explicit {
  67.   my $op = shift;
  68.   my @seq = @$op;
  69.  
  70.   @seq[cTYPE,cCHILD,cVAR,cLOOP] = ('SEQUENCE',[$op],undef,undef);
  71.   @{$op}[cTAG,cOPT] = ();
  72.  
  73.   \@seq;
  74. }
  75.  
  76. # 74 "y.tab.pl"
  77.  
  78. sub constWORD () { 1 }
  79. sub constCLASS () { 2 }
  80. sub constSEQUENCE () { 3 }
  81. sub constSET () { 4 }
  82. sub constCHOICE () { 5 }
  83. sub constOF () { 6 }
  84. sub constIMPLICIT () { 7 }
  85. sub constEXPLICIT () { 8 }
  86. sub constOPTIONAL () { 9 }
  87. sub constLBRACE () { 10 }
  88. sub constRBRACE () { 11 }
  89. sub constCOMMA () { 12 }
  90. sub constANY () { 13 }
  91. sub constASSIGN () { 14 }
  92. sub constNUMBER () { 15 }
  93. sub constENUM () { 16 }
  94. sub constCOMPONENTS () { 17 }
  95. sub constPOSTRBRACE () { 18 }
  96. sub constDEFINED () { 19 }
  97. sub constBY () { 20 }
  98. sub constYYERRCODE () { 256 }
  99. my @yylhs = (                                               -1,
  100.     0,    0,    2,    2,    3,    3,    6,    6,    6,    6,
  101.     8,   13,   13,   12,   14,   14,   14,    9,    9,    9,
  102.    10,   18,   18,   18,   18,   18,   19,   19,   11,   16,
  103.    16,   20,   20,   20,   21,    1,    1,   22,   22,   22,
  104.    24,   24,   24,   24,   23,   23,   23,   15,   15,    4,
  105.     4,    5,    5,    5,   17,   17,   25,    7,    7,
  106. );
  107. my @yylen = (                                                2,
  108.     1,    1,    3,    4,    4,    1,    1,    1,    1,    1,
  109.     3,    1,    1,    6,    1,    1,    1,    4,    4,    4,
  110.     4,    1,    1,    1,    2,    1,    0,    3,    1,    1,
  111.     2,    1,    3,    3,    4,    1,    2,    1,    3,    3,
  112.     2,    1,    1,    1,    4,    1,    3,    0,    1,    0,
  113.     1,    0,    1,    1,    1,    3,    2,    0,    1,
  114. );
  115. my @yydefred = (                                             0,
  116.     0,   51,    0,    0,    1,    0,    0,   46,    0,   38,
  117.     0,    0,    0,    0,   54,   53,    0,    0,    0,    3,
  118.     0,    6,    0,   11,    0,    0,    0,    0,   47,    0,
  119.    39,   40,    0,   22,    0,    0,    0,    0,   44,   42,
  120.     0,   43,    0,   29,   45,    4,    0,    0,    0,    0,
  121.     7,    8,    9,   10,    0,   25,    0,   49,   41,    0,
  122.     0,    0,    0,    0,    0,   32,   59,    5,    0,    0,
  123.     0,   55,    0,   18,   19,    0,   20,    0,    0,   28,
  124.    57,   21,    0,    0,    0,   34,   33,   56,    0,    0,
  125.    17,   15,   16,    0,   35,   14,
  126. );
  127. my @yydgoto = (                                              4,
  128.     5,    6,   20,    7,   17,   50,   68,    8,   51,   52,
  129.    53,   54,   43,   94,   59,   64,   71,   44,   56,   65,
  130.    66,    9,   10,   45,   72,
  131. );
  132. my @yysindex = (                                             7,
  133.     9,    0,   12,    0,    0,   19,   51,    0,   34,    0,
  134.    75,   51,   31,   -1,    0,    0,   90,   55,   55,    0,
  135.    51,    0,  114,    0,   75,   26,   53,   61,    0,   77,
  136.     0,    0,  114,    0,   26,   53,   64,   76,    0,    0,
  137.    89,    0,   96,    0,    0,    0,   55,   55,  111,  103,
  138.     0,    0,    0,    0,   94,    0,  130,    0,    0,   77,
  139.   122,  128,   77,  139,   78,    0,    0,    0,  154,  143,
  140.    33,    0,   51,    0,    0,   51,    0,  111,  111,    0,
  141.     0,    0,  130,  119,  114,    0,    0,    0,   26,   53,
  142.     0,    0,    0,   89,    0,    0,
  143. );
  144. my @yyrindex = (                                           149,
  145.   100,    0,    0,    0,    0,  159,  106,    0,   39,    0,
  146.   100,  133,    0,    0,    0,    0,    0,  149,  140,    0,
  147.   133,    0,    0,    0,  100,    0,    0,    0,    0,  100,
  148.     0,    0,    0,    0,   16,   29,   42,   69,    0,    0,
  149.    37,    0,    0,    0,    0,    0,  149,  149,    0,  125,
  150.     0,    0,    0,    0,    0,    0,    0,    0,    0,  100,
  151.     0,    0,  100,    0,  150,    0,    0,    0,    0,    0,
  152.     0,    0,  133,    0,    0,  133,    0,    0,  151,    0,
  153.     0,    0,    0,    0,    0,    0,    0,    0,   73,   88,
  154.     0,    0,    0,    3,    0,    0,
  155. );
  156. my @yygindex = (                                             0,
  157.    28,    0,  135,    1,  -11,   79,    0,    8,  -17,  -18,
  158.   -16,  142,    0,    0,   72,    0,    0,    0,    0,    0,
  159.    50,    0,  123,    0,   80,
  160. );
  161. sub constYYTABLESIZE () { 166 }
  162. my @yytable = (                                             29,
  163.    23,   12,   48,   48,   40,   39,   41,    1,    2,   33,
  164.     2,   21,   25,   48,   48,   23,   23,   13,   22,   14,
  165.    48,   12,   11,    3,   23,   21,   23,   23,   24,   24,
  166.    12,   24,   22,   23,   13,   47,   48,   24,   36,   24,
  167.    24,   27,   27,   82,   83,   18,   24,   48,   48,   36,
  168.    27,   19,   27,   27,   48,   30,    2,   15,   16,   27,
  169.    73,   84,   48,   76,   85,   92,   91,   93,   26,   26,
  170.    49,    3,   23,   23,   61,   62,    2,   26,    2,   26,
  171.    26,   23,   55,   23,   23,   57,   26,   24,   24,   78,
  172.    23,    3,   26,   27,   28,   79,   24,   58,   24,   24,
  173.    50,   60,   50,   50,   50,   24,   50,   50,   52,   52,
  174.    52,   63,   50,   69,   34,   50,   35,   36,   28,   34,
  175.    67,   89,   90,   28,   58,   58,   37,   86,   87,   38,
  176.    70,   37,   74,   52,   38,   52,   52,   52,   75,   37,
  177.    31,   32,   50,   50,   50,   52,   50,   50,   52,   77,
  178.    37,   50,   50,   50,   80,   50,   50,   81,    2,   46,
  179.    30,   31,   88,   95,   42,   96,
  180. );
  181. my @yycheck = (                                             17,
  182.    12,    1,    0,    1,   23,   23,   23,    1,    2,   21,
  183.     2,   11,   14,   11,   12,    0,    1,    6,   11,    1,
  184.    18,    6,   14,   17,    9,   25,   11,   12,    0,    1,
  185.    30,    1,   25,   18,    6,   10,    0,    9,    0,   11,
  186.    12,    0,    1,   11,   12,   12,   18,   11,   12,   11,
  187.     9,   18,   11,   12,   18,    1,    2,    7,    8,   18,
  188.    60,   73,   10,   63,   76,   84,   84,   84,    0,    1,
  189.    10,   17,    0,    1,   47,   48,    2,    9,    2,   11,
  190.    12,    9,   19,   11,   12,   10,   18,    0,    1,   12,
  191.    18,   17,    3,    4,    5,   18,    9,    9,   11,   12,
  192.     1,    6,    3,    4,    5,   18,    7,    8,    3,    4,
  193.     5,    1,   13,   20,    1,   16,    3,    4,    5,    1,
  194.    18,    3,    4,    5,    0,    1,   13,   78,   79,   16,
  195.     1,   13,   11,    1,   16,    3,    4,    5,   11,    0,
  196.    18,   19,    3,    4,    5,   13,    7,    8,   16,   11,
  197.    11,    3,    4,    5,    1,    7,    8,   15,    0,   25,
  198.    11,   11,   83,   85,   23,   94,
  199. );
  200. sub constYYFINAL () { 4 }
  201.  
  202.  
  203.  
  204. sub constYYMAXTOKEN () { 20 }
  205. # 270 "y.tab.pl"
  206.  
  207. sub yyclearin { $yychar = -1; }
  208. sub yyerrok { $yyerrflag = 0; }
  209. sub YYERROR { ++$yynerrs; &yy_err_recover; }
  210. sub yy_err_recover
  211. {
  212.   if ($yyerrflag < 3)
  213.   {
  214.     $yyerrflag = 3;
  215.     while (1)
  216.     {
  217.       if (($yyn = $yysindex[$yyss[$yyssp]]) && 
  218.           ($yyn += constYYERRCODE()) >= 0 && 
  219.           $yyn <= $#yycheck && $yycheck[$yyn] == constYYERRCODE())
  220.       {
  221.  
  222.  
  223.  
  224.  
  225.         $yyss[++$yyssp] = $yystate = $yytable[$yyn];
  226.         $yyvs[++$yyvsp] = $yylval;
  227.         next yyloop;
  228.       }
  229.       else
  230.       {
  231.  
  232.  
  233.  
  234.  
  235.         return(1) if $yyssp <= 0;
  236.         --$yyssp;
  237.         --$yyvsp;
  238.       }
  239.     }
  240.   }
  241.   else
  242.   {
  243.     return (1) if $yychar == 0;
  244. # 321 "y.tab.pl"
  245.  
  246.     $yychar = -1;
  247.     next yyloop;
  248.   }
  249. 0;
  250. } # yy_err_recover
  251.  
  252. sub yyparse
  253. {
  254.  
  255.   if ($yys = $ENV{'YYDEBUG'})
  256.   {
  257.     $yydebug = int($1) if $yys =~ /^(\d)/;
  258.   }
  259.  
  260.  
  261.   $yynerrs = 0;
  262.   $yyerrflag = 0;
  263.   $yychar = (-1);
  264.  
  265.   $yyssp = 0;
  266.   $yyvsp = 0;
  267.   $yyss[$yyssp] = $yystate = 0;
  268.  
  269. yyloop: while(1)
  270.   {
  271.     yyreduce: {
  272.       last yyreduce if ($yyn = $yydefred[$yystate]);
  273.       if ($yychar < 0)
  274.       {
  275.         if (($yychar = &yylex) < 0) { $yychar = 0; }
  276. # 360 "y.tab.pl"
  277.  
  278.       }
  279.       if (($yyn = $yysindex[$yystate]) && ($yyn += $yychar) >= 0 &&
  280.               $yyn <= $#yycheck && $yycheck[$yyn] == $yychar)
  281.       {
  282.  
  283.  
  284.  
  285.  
  286.         $yyss[++$yyssp] = $yystate = $yytable[$yyn];
  287.         $yyvs[++$yyvsp] = $yylval;
  288.         $yychar = (-1);
  289.         --$yyerrflag if $yyerrflag > 0;
  290.         next yyloop;
  291.       }
  292.       if (($yyn = $yyrindex[$yystate]) && ($yyn += $yychar) >= 0 &&
  293.             $yyn <= $#yycheck && $yycheck[$yyn] == $yychar)
  294.       {
  295.         $yyn = $yytable[$yyn];
  296.         last yyreduce;
  297.       }
  298.       if (! $yyerrflag) {
  299.         &yyerror('syntax error');
  300.         ++$yynerrs;
  301.       }
  302.       return undef if &yy_err_recover;
  303.     } # yyreduce
  304.  
  305.  
  306.  
  307.  
  308.     $yym = $yylen[$yyn];
  309.     $yyval = $yyvs[$yyvsp+1-$yym];
  310.     switch:
  311.     {
  312. my $label = "State$yyn";
  313. goto $label if exists $yystate{$label};
  314. last switch;
  315. State1: {
  316. # 96 "parser.y"
  317.  
  318. { $yyval = { '' => $yyvs[$yyvsp-0] }; 
  319. last switch;
  320. } }
  321. State3: {
  322. # 101 "parser.y"
  323.  
  324. {
  325.           $yyval = { $yyvs[$yyvsp-2], [$yyvs[$yyvsp-0]] };
  326.         
  327. last switch;
  328. } }
  329. State4: {
  330. # 105 "parser.y"
  331.  
  332. {
  333.           $yyval=$yyvs[$yyvsp-3];
  334.           $yyval->{$yyvs[$yyvsp-2]} = [$yyvs[$yyvsp-0]];
  335.         
  336. last switch;
  337. } }
  338. State5: {
  339. # 112 "parser.y"
  340.  
  341. {
  342.           $yyvs[$yyvsp-1]->[cTAG] = $yyvs[$yyvsp-3];
  343.           $yyval = $yyvs[$yyvsp-2] ? explicit($yyvs[$yyvsp-1]) : $yyvs[$yyvsp-1];
  344.         
  345. last switch;
  346. } }
  347. State11: {
  348. # 126 "parser.y"
  349.  
  350. {
  351.           @{$yyval = []}[cTYPE,cCHILD] = ('COMPONENTS', $yyvs[$yyvsp-0]);
  352.         
  353. last switch;
  354. } }
  355. State14: {
  356. # 136 "parser.y"
  357.  
  358. {
  359.           $yyvs[$yyvsp-1]->[cTAG] = $yyvs[$yyvsp-3];
  360.           @{$yyval = []}[cTYPE,cCHILD,cLOOP,cOPT] = ($yyvs[$yyvsp-5], [$yyvs[$yyvsp-1]], 1, $yyvs[$yyvsp-0]);
  361.           $yyval = explicit($yyval) if $yyvs[$yyvsp-2];
  362.         
  363. last switch;
  364. } }
  365. State18: {
  366. # 149 "parser.y"
  367.  
  368. {
  369.           @{$yyval = []}[cTYPE,cCHILD] = ('SEQUENCE', $yyvs[$yyvsp-1]);
  370.         
  371. last switch;
  372. } }
  373. State19: {
  374. # 153 "parser.y"
  375.  
  376. {
  377.           @{$yyval = []}[cTYPE,cCHILD] = ('SET', $yyvs[$yyvsp-1]);
  378.         
  379. last switch;
  380. } }
  381. State20: {
  382. # 157 "parser.y"
  383.  
  384. {
  385.           @{$yyval = []}[cTYPE,cCHILD] = ('CHOICE', $yyvs[$yyvsp-1]);
  386.         
  387. last switch;
  388. } }
  389. State21: {
  390. # 163 "parser.y"
  391.  
  392. {
  393.           @{$yyval = []}[cTYPE] = ('ENUM');
  394.         
  395. last switch;
  396. } }
  397. State22: {
  398. # 168 "parser.y"
  399.  
  400. { @{$yyval = []}[cTYPE] = $yyvs[$yyvsp-0]; 
  401. last switch;
  402. } }
  403. State23: {
  404. # 169 "parser.y"
  405.  
  406. { @{$yyval = []}[cTYPE] = $yyvs[$yyvsp-0]; 
  407. last switch;
  408. } }
  409. State24: {
  410. # 170 "parser.y"
  411.  
  412. { @{$yyval = []}[cTYPE] = $yyvs[$yyvsp-0]; 
  413. last switch;
  414. } }
  415. State25: {
  416. # 172 "parser.y"
  417.  
  418. {
  419.           @{$yyval = []}[cTYPE,cCHILD,cDEFINE] = ('ANY',undef,$yyvs[$yyvsp-0]);
  420.         
  421. last switch;
  422. } }
  423. State26: {
  424. # 175 "parser.y"
  425.  
  426. { @{$yyval = []}[cTYPE] = $yyvs[$yyvsp-0]; 
  427. last switch;
  428. } }
  429. State27: {
  430. # 178 "parser.y"
  431.  
  432. { $yyval=undef; 
  433. last switch;
  434. } }
  435. State28: {
  436. # 179 "parser.y"
  437.  
  438. { $yyval=$yyvs[$yyvsp-0]; 
  439. last switch;
  440. } }
  441. State30: {
  442. # 185 "parser.y"
  443.  
  444. { $yyval = $yyvs[$yyvsp-0]; 
  445. last switch;
  446. } }
  447. State31: {
  448. # 186 "parser.y"
  449.  
  450. { $yyval = $yyvs[$yyvsp-1]; 
  451. last switch;
  452. } }
  453. State32: {
  454. # 190 "parser.y"
  455.  
  456. {
  457.           $yyval = [ $yyvs[$yyvsp-0] ];
  458.         
  459. last switch;
  460. } }
  461. State33: {
  462. # 194 "parser.y"
  463.  
  464. {
  465.           push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
  466.         
  467. last switch;
  468. } }
  469. State34: {
  470. # 198 "parser.y"
  471.  
  472. {
  473.           push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
  474.         
  475. last switch;
  476. } }
  477. State35: {
  478. # 204 "parser.y"
  479.  
  480. {
  481.           @{$yyval=$yyvs[$yyvsp-0]}[cVAR,cTAG] = ($yyvs[$yyvsp-3],$yyvs[$yyvsp-2]);
  482.           $yyval = explicit($yyval) if $yyvs[$yyvsp-1];
  483.         
  484. last switch;
  485. } }
  486. State36: {
  487. # 211 "parser.y"
  488.  
  489. { $yyval = $yyvs[$yyvsp-0]; 
  490. last switch;
  491. } }
  492. State37: {
  493. # 212 "parser.y"
  494.  
  495. { $yyval = $yyvs[$yyvsp-1]; 
  496. last switch;
  497. } }
  498. State38: {
  499. # 216 "parser.y"
  500.  
  501. {
  502.           $yyval = [ $yyvs[$yyvsp-0] ];
  503.         
  504. last switch;
  505. } }
  506. State39: {
  507. # 220 "parser.y"
  508.  
  509. {
  510.           push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
  511.         
  512. last switch;
  513. } }
  514. State40: {
  515. # 224 "parser.y"
  516.  
  517. {
  518.           push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
  519.         
  520. last switch;
  521. } }
  522. State41: {
  523. # 230 "parser.y"
  524.  
  525. {
  526.           @{$yyval=$yyvs[$yyvsp-1]}[cOPT] = ($yyvs[$yyvsp-0]);
  527.         
  528. last switch;
  529. } }
  530. State45: {
  531. # 239 "parser.y"
  532.  
  533. {
  534.           @{$yyval=$yyvs[$yyvsp-0]}[cVAR,cTAG] = ($yyvs[$yyvsp-3],$yyvs[$yyvsp-2]);
  535.           $yyval->[cOPT] = $yyvs[$yyvsp-3] if $yyval->[cOPT];
  536.           $yyval = explicit($yyval) if $yyvs[$yyvsp-1];
  537.         
  538. last switch;
  539. } }
  540. State47: {
  541. # 246 "parser.y"
  542.  
  543. {
  544.           @{$yyval=$yyvs[$yyvsp-0]}[cTAG] = ($yyvs[$yyvsp-2]);
  545.           $yyval = explicit($yyval) if $yyvs[$yyvsp-1];
  546.         
  547. last switch;
  548. } }
  549. State48: {
  550. # 252 "parser.y"
  551.  
  552. { $yyval = undef; 
  553. last switch;
  554. } }
  555. State49: {
  556. # 253 "parser.y"
  557.  
  558. { $yyval = 1;     
  559. last switch;
  560. } }
  561. State50: {
  562. # 257 "parser.y"
  563.  
  564. { $yyval = undef; 
  565. last switch;
  566. } }
  567. State52: {
  568. # 261 "parser.y"
  569.  
  570. { $yyval = undef; 
  571. last switch;
  572. } }
  573. State53: {
  574. # 262 "parser.y"
  575.  
  576. { $yyval = 1;     
  577. last switch;
  578. } }
  579. State54: {
  580. # 263 "parser.y"
  581.  
  582. { $yyval = 0;     
  583. last switch;
  584. } }
  585. State55: {
  586. # 266 "parser.y"
  587.  
  588. {
  589. last switch;
  590. } }
  591. State56: {
  592. # 267 "parser.y"
  593.  
  594. {
  595. last switch;
  596. } }
  597. State57: {
  598. # 270 "parser.y"
  599.  
  600. {
  601. last switch;
  602. } }
  603. State58: {
  604. # 273 "parser.y"
  605.  
  606. {
  607. last switch;
  608. } }
  609. State59: {
  610. # 274 "parser.y"
  611.  
  612. {
  613. last switch;
  614. } }
  615. # 653 "y.tab.pl"
  616.  
  617.     } # switch
  618.     $yyssp -= $yym;
  619.     $yystate = $yyss[$yyssp];
  620.     $yyvsp -= $yym;
  621.     $yym = $yylhs[$yyn];
  622.     if ($yystate == 0 && $yym == 0)
  623.     {
  624.  
  625.  
  626.  
  627.  
  628.       $yystate = constYYFINAL();
  629.       $yyss[++$yyssp] = constYYFINAL();
  630.       $yyvs[++$yyvsp] = $yyval;
  631.       if ($yychar < 0)
  632.       {
  633.         if (($yychar = &yylex) < 0) { $yychar = 0; }
  634. # 679 "y.tab.pl"
  635.  
  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. # 278 "parser.y"
  656.  
  657.  
  658. my %reserved = (
  659.   'OPTIONAL'     => constOPTIONAL(),
  660.   'CHOICE'     => constCHOICE(),
  661.   'OF'         => constOF(),
  662.   'IMPLICIT'     => constIMPLICIT(),
  663.   'EXPLICIT'     => constEXPLICIT(),
  664.   'SEQUENCE'    => constSEQUENCE(),
  665.   'SET'         => constSET(),
  666.   'ANY'         => constANY(),
  667.   'ENUM'        => constENUM(),
  668.   'ENUMERATED'  => constENUM(),
  669.   'COMPONENTS'  => constCOMPONENTS(),
  670.   '{'        => constLBRACE(),
  671.   '}'        => constRBRACE(),
  672.   ','        => constCOMMA(),
  673.   '::='         => constASSIGN(),
  674.   'DEFINED'     => constDEFINED(),
  675.   'BY'        => constBY()
  676. );
  677.  
  678. my $reserved = join("|", reverse sort grep { /\w/ } keys %reserved);
  679.  
  680. my %tag_class = (
  681.   APPLICATION => ASN_APPLICATION,
  682.   UNIVERSAL   => ASN_UNIVERSAL,
  683.   PRIVATE     => ASN_PRIVATE,
  684.   CONTEXT     => ASN_CONTEXT,
  685.   ''          => ASN_CONTEXT # if not specified, its CONTEXT
  686. );
  687.  
  688. ;##
  689. ;## This is NOT thread safe !!!!!!
  690. ;##
  691.  
  692. my $pos;
  693. my $last_pos;
  694. my @stacked;
  695.  
  696. sub parse {
  697.   local(*asn) = \($_[0]);
  698.   ($pos,$last_pos,@stacked) = ();
  699.  
  700.   eval {
  701.     local $SIG{__DIE__};
  702.     compile(verify(yyparse()));
  703.   }
  704. }
  705.  
  706. sub 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] |= chr(ASN_CONSTRUCTOR)
  734.       if length $op->[cTAG] && ($op->[cTYPE] == opSET || $op->[cTYPE] == opSEQUENCE);
  735.  
  736.     if ($op->[cCHILD]) {
  737.       ;# If we have children we are one of
  738.       ;#  opSET opSEQUENCE opCHOICE
  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 thier 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.  
  774. sub 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 dont 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.  
  795. sub 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.  
  849. sub 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.  
  872. sub _yylex {
  873.   my $ret = &_yylex;
  874.   warn $ret;
  875.   $ret;
  876. }
  877.  
  878. sub 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.     )/sxgo
  907.   ) {
  908.  
  909.     ($last_pos,$pos) = ($pos,pos($asn));
  910.  
  911.     next if defined $1; # comment or whitespace
  912.  
  913.     if (defined $2 or defined $3) {
  914.       #A comma is not required after a '}' so to aid the
  915.       #parser we insert a fake token after any '}'
  916.       push @stacked, constPOSTRBRACE() if defined $2 and $+ eq '}';
  917.  
  918.       return $reserved{$yylval = $+};
  919.     }
  920.  
  921.     if (defined $4) {
  922.       ($yylval = $+) =~ s/\s+/_/g;
  923.       return constWORD();
  924.     }
  925.  
  926.     if (defined $5) {
  927.       $yylval = $+;
  928.       return constWORD();
  929.     }
  930.  
  931.     if (defined $6) {
  932.       my($class,$num) = ($+ =~ /^([A-Z]*)\s*(\d+)$/);
  933.       $yylval = asn_tag($tag_class{$class}, $num); 
  934.       return constCLASS();
  935.     }
  936.  
  937.     if (defined $7) {
  938.       $yylval = $+;
  939.       return constNUMBER();
  940.     }
  941.  
  942.     die "Internal error\n";
  943.  
  944.   }
  945.  
  946.   die "Parse error before ",substr($asn,$pos,40),"\n"
  947.     unless $pos == length($asn);
  948.  
  949.   0
  950. }
  951.  
  952. sub yyerror {
  953.   die @_," ",substr($asn,$last_pos,40),"\n";
  954. }
  955.  
  956. 1;
  957.  
  958. # 1001 "y.tab.pl"
  959.  
  960. %yystate = ('State11','','State30','','State31','','State50','','State32',
  961. '','State14','','State33','','State52','','State34','','State53','',
  962. 'State35','','State54','','State36','','State18','','State55','','State37',
  963. '','State19','','State56','','State38','','State57','','State39','',
  964. 'State58','','State59','','State1','','State3','','State4','','State5','',
  965. 'State20','','State21','','State22','','State40','','State23','','State41',
  966. '','State24','','State25','','State26','','State27','','State45','',
  967. 'State28','','State47','','State48','','State49','');
  968.  
  969. 1;
  970.