[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/site_perl/5.10.0/Convert/ASN1/ -> parser.pm (source)

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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1