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