[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |