Added Net::LDAP to the distribution for easier installs.
This commit is contained in:
JT Smith
parent
f51b335d74
commit
223c014813
47 changed files with 15060 additions and 2 deletions
910
lib/Convert/ASN1/parser.pm
Normal file
910
lib/Convert/ASN1/parser.pm
Normal file
|
|
@ -0,0 +1,910 @@
|
|||
# 1 "y.tab.pl"
|
||||
#$yysccsid = "@(#)yaccpar 1.8 (Berkeley) 01/20/91 (Perl 2.0 12/31/92)";
|
||||
|
||||
# 20 "parser.y"
|
||||
|
||||
;# Copyright (c) 2000-2002 Graham Barr <gbarr@pobox.com>. All rights reserved.
|
||||
;# This program is free software; you can redistribute it and/or
|
||||
;# modify it under the same terms as Perl itself.
|
||||
|
||||
package Convert::ASN1::parser;
|
||||
|
||||
;# $Id$
|
||||
|
||||
use strict;
|
||||
use Convert::ASN1 qw(:all);
|
||||
use vars qw(
|
||||
$asn $yychar $yyerrflag $yynerrs $yyn @yyss
|
||||
$yyssp $yystate @yyvs $yyvsp $yylval $yys $yym $yyval
|
||||
);
|
||||
|
||||
BEGIN { Convert::ASN1->_internal_syms }
|
||||
|
||||
my $yydebug=0;
|
||||
my %yystate;
|
||||
|
||||
my %base_type = (
|
||||
BOOLEAN => [ asn_encode_tag(ASN_BOOLEAN), opBOOLEAN ],
|
||||
INTEGER => [ asn_encode_tag(ASN_INTEGER), opINTEGER ],
|
||||
BIT_STRING => [ asn_encode_tag(ASN_BIT_STR), opBITSTR ],
|
||||
OCTET_STRING => [ asn_encode_tag(ASN_OCTET_STR), opSTRING ],
|
||||
STRING => [ asn_encode_tag(ASN_OCTET_STR), opSTRING ],
|
||||
NULL => [ asn_encode_tag(ASN_NULL), opNULL ],
|
||||
OBJECT_IDENTIFIER => [ asn_encode_tag(ASN_OBJECT_ID), opOBJID ],
|
||||
REAL => [ asn_encode_tag(ASN_REAL), opREAL ],
|
||||
ENUMERATED => [ asn_encode_tag(ASN_ENUMERATED), opINTEGER ],
|
||||
ENUM => [ asn_encode_tag(ASN_ENUMERATED), opINTEGER ],
|
||||
'RELATIVE-OID' => [ asn_encode_tag(ASN_RELATIVE_OID), opROID ],
|
||||
|
||||
SEQUENCE => [ asn_encode_tag(ASN_SEQUENCE | ASN_CONSTRUCTOR), opSEQUENCE ],
|
||||
SET => [ asn_encode_tag(ASN_SET | ASN_CONSTRUCTOR), opSET ],
|
||||
|
||||
ObjectDescriptor => [ asn_encode_tag(ASN_UNIVERSAL | 7), opSTRING ],
|
||||
UTF8String => [ asn_encode_tag(ASN_UNIVERSAL | 12), opUTF8 ],
|
||||
NumericString => [ asn_encode_tag(ASN_UNIVERSAL | 18), opSTRING ],
|
||||
PrintableString => [ asn_encode_tag(ASN_UNIVERSAL | 19), opSTRING ],
|
||||
TeletexString => [ asn_encode_tag(ASN_UNIVERSAL | 20), opSTRING ],
|
||||
T61String => [ asn_encode_tag(ASN_UNIVERSAL | 20), opSTRING ],
|
||||
VideotexString => [ asn_encode_tag(ASN_UNIVERSAL | 21), opSTRING ],
|
||||
IA5String => [ asn_encode_tag(ASN_UNIVERSAL | 22), opSTRING ],
|
||||
UTCTime => [ asn_encode_tag(ASN_UNIVERSAL | 23), opUTIME ],
|
||||
GeneralizedTime => [ asn_encode_tag(ASN_UNIVERSAL | 24), opGTIME ],
|
||||
GraphicString => [ asn_encode_tag(ASN_UNIVERSAL | 25), opSTRING ],
|
||||
VisibleString => [ asn_encode_tag(ASN_UNIVERSAL | 26), opSTRING ],
|
||||
ISO646String => [ asn_encode_tag(ASN_UNIVERSAL | 26), opSTRING ],
|
||||
GeneralString => [ asn_encode_tag(ASN_UNIVERSAL | 27), opSTRING ],
|
||||
CharacterString => [ asn_encode_tag(ASN_UNIVERSAL | 28), opSTRING ],
|
||||
UniversalString => [ asn_encode_tag(ASN_UNIVERSAL | 28), opSTRING ],
|
||||
BMPString => [ asn_encode_tag(ASN_UNIVERSAL | 30), opSTRING ],
|
||||
|
||||
CHOICE => [ '', opCHOICE ],
|
||||
ANY => [ '', opANY ],
|
||||
);
|
||||
|
||||
;# Given an OP, wrap it in a SEQUENCE
|
||||
|
||||
sub explicit {
|
||||
my $op = shift;
|
||||
my @seq = @$op;
|
||||
|
||||
@seq[cTYPE,cCHILD,cVAR,cLOOP] = ('SEQUENCE',[$op],undef,undef);
|
||||
@{$op}[cTAG,cOPT] = ();
|
||||
|
||||
\@seq;
|
||||
}
|
||||
|
||||
# 74 "y.tab.pl"
|
||||
|
||||
sub constWORD () { 1 }
|
||||
sub constCLASS () { 2 }
|
||||
sub constSEQUENCE () { 3 }
|
||||
sub constSET () { 4 }
|
||||
sub constCHOICE () { 5 }
|
||||
sub constOF () { 6 }
|
||||
sub constIMPLICIT () { 7 }
|
||||
sub constEXPLICIT () { 8 }
|
||||
sub constOPTIONAL () { 9 }
|
||||
sub constLBRACE () { 10 }
|
||||
sub constRBRACE () { 11 }
|
||||
sub constCOMMA () { 12 }
|
||||
sub constANY () { 13 }
|
||||
sub constASSIGN () { 14 }
|
||||
sub constNUMBER () { 15 }
|
||||
sub constENUM () { 16 }
|
||||
sub constCOMPONENTS () { 17 }
|
||||
sub constPOSTRBRACE () { 18 }
|
||||
sub constYYERRCODE () { 256 }
|
||||
my @yylhs = ( -1,
|
||||
0, 0, 2, 2, 3, 3, 6, 6, 6, 6,
|
||||
8, 13, 13, 12, 14, 14, 14, 9, 9, 9,
|
||||
10, 17, 17, 17, 17, 17, 11, 15, 15, 18,
|
||||
18, 18, 19, 1, 1, 20, 20, 20, 22, 22,
|
||||
22, 22, 21, 21, 21, 23, 23, 4, 4, 5,
|
||||
5, 5, 16, 16, 24, 7, 7,
|
||||
);
|
||||
my @yylen = ( 2,
|
||||
1, 1, 3, 4, 4, 1, 1, 1, 1, 1,
|
||||
3, 1, 1, 5, 1, 1, 1, 4, 4, 4,
|
||||
4, 1, 1, 1, 1, 1, 1, 1, 2, 1,
|
||||
3, 3, 4, 1, 2, 1, 3, 3, 2, 1,
|
||||
1, 1, 4, 1, 3, 0, 1, 0, 1, 0,
|
||||
1, 1, 1, 3, 2, 0, 1,
|
||||
);
|
||||
my @yydefred = ( 0,
|
||||
0, 49, 0, 0, 1, 0, 0, 44, 0, 36,
|
||||
0, 0, 0, 0, 52, 51, 0, 0, 0, 3,
|
||||
0, 6, 0, 11, 0, 0, 0, 0, 45, 0,
|
||||
37, 38, 0, 22, 0, 0, 25, 0, 42, 40,
|
||||
0, 41, 0, 27, 43, 4, 0, 0, 0, 0,
|
||||
7, 8, 9, 10, 0, 47, 39, 0, 0, 0,
|
||||
0, 0, 0, 30, 57, 5, 0, 0, 53, 0,
|
||||
18, 19, 0, 20, 0, 0, 55, 21, 0, 0,
|
||||
0, 32, 31, 54, 0, 0, 17, 15, 16, 14,
|
||||
33,
|
||||
);
|
||||
my @yydgoto = ( 4,
|
||||
5, 6, 20, 7, 17, 50, 66, 8, 51, 52,
|
||||
53, 54, 43, 90, 62, 68, 44, 63, 64, 9,
|
||||
10, 45, 57, 69,
|
||||
);
|
||||
my @yysindex = ( 53,
|
||||
5, 0, -1, 0, 0, 12, 96, 0, 30, 0,
|
||||
7, 96, 14, 4, 0, 0, 41, 70, 70, 0,
|
||||
96, 0, 92, 0, 7, 17, 20, 43, 0, 33,
|
||||
0, 0, 92, 0, 17, 20, 0, 82, 0, 0,
|
||||
64, 0, 93, 0, 0, 0, 70, 70, 75, 91,
|
||||
0, 0, 0, 0, 110, 0, 0, 33, 106, 117,
|
||||
33, 131, 62, 0, 0, 0, 128, 95, 0, 96,
|
||||
0, 0, 96, 0, 75, 75, 0, 0, 110, 97,
|
||||
92, 0, 0, 0, 17, 20, 0, 0, 0, 0,
|
||||
0,
|
||||
);
|
||||
my @yyrindex = ( 127,
|
||||
78, 0, 0, 0, 0, 133, 85, 0, 21, 0,
|
||||
78, 111, 0, 0, 0, 0, 0, 127, 118, 0,
|
||||
111, 0, 0, 0, 78, 0, 0, 0, 0, 78,
|
||||
0, 0, 0, 0, 11, 25, 0, 38, 0, 0,
|
||||
57, 0, 0, 0, 0, 0, 127, 127, 0, 119,
|
||||
0, 0, 0, 0, 0, 0, 0, 78, 0, 0,
|
||||
78, 0, 134, 0, 0, 0, 0, 0, 0, 111,
|
||||
0, 0, 111, 0, 0, 135, 0, 0, 0, 0,
|
||||
0, 0, 0, 0, 40, 66, 0, 0, 0, 0,
|
||||
0,
|
||||
);
|
||||
my @yygindex = ( 0,
|
||||
89, 0, 123, 3, -11, 68, 0, -9, -17, -20,
|
||||
-15, 121, 0, 0, 0, 0, 0, 0, 63, 0,
|
||||
122, 0, 0, 71,
|
||||
);
|
||||
sub constYYTABLESIZE () { 150 }
|
||||
my @yytable = ( 29,
|
||||
23, 22, 40, 12, 13, 39, 2, 41, 2, 33,
|
||||
23, 23, 14, 21, 24, 22, 12, 25, 11, 23,
|
||||
34, 23, 23, 3, 24, 24, 47, 21, 23, 48,
|
||||
13, 34, 12, 24, 2, 24, 24, 26, 26, 23,
|
||||
23, 18, 24, 26, 27, 28, 26, 19, 26, 26,
|
||||
23, 23, 49, 1, 2, 26, 46, 23, 80, 88,
|
||||
70, 81, 87, 73, 89, 24, 24, 46, 46, 3,
|
||||
30, 2, 56, 75, 46, 61, 24, 24, 48, 76,
|
||||
48, 48, 48, 24, 48, 48, 3, 50, 50, 50,
|
||||
48, 55, 34, 48, 35, 36, 28, 34, 58, 85,
|
||||
86, 28, 15, 16, 37, 78, 79, 38, 65, 37,
|
||||
67, 50, 38, 50, 50, 50, 71, 35, 56, 56,
|
||||
48, 48, 48, 50, 48, 48, 50, 72, 35, 48,
|
||||
48, 48, 2, 48, 48, 59, 60, 82, 83, 31,
|
||||
32, 74, 77, 42, 28, 29, 0, 46, 91, 84,
|
||||
);
|
||||
my @yycheck = ( 17,
|
||||
12, 11, 23, 1, 6, 23, 2, 23, 2, 21,
|
||||
0, 1, 1, 11, 1, 25, 6, 14, 14, 9,
|
||||
0, 11, 12, 17, 0, 1, 10, 25, 18, 10,
|
||||
6, 11, 30, 9, 2, 11, 12, 0, 1, 0,
|
||||
1, 12, 18, 3, 4, 5, 9, 18, 11, 12,
|
||||
11, 12, 10, 1, 2, 18, 0, 18, 70, 80,
|
||||
58, 73, 80, 61, 80, 0, 1, 11, 12, 17,
|
||||
1, 2, 9, 12, 18, 1, 11, 12, 1, 18,
|
||||
3, 4, 5, 18, 7, 8, 17, 3, 4, 5,
|
||||
13, 10, 1, 16, 3, 4, 5, 1, 6, 3,
|
||||
4, 5, 7, 8, 13, 11, 12, 16, 18, 13,
|
||||
1, 1, 16, 3, 4, 5, 11, 0, 0, 1,
|
||||
3, 4, 5, 13, 7, 8, 16, 11, 11, 3,
|
||||
4, 5, 0, 7, 8, 47, 48, 75, 76, 18,
|
||||
19, 11, 15, 23, 11, 11, -1, 25, 81, 79,
|
||||
);
|
||||
sub constYYFINAL () { 4 }
|
||||
|
||||
|
||||
|
||||
sub constYYMAXTOKEN () { 18 }
|
||||
# 262 "y.tab.pl"
|
||||
|
||||
sub yyclearin { $yychar = -1; }
|
||||
sub yyerrok { $yyerrflag = 0; }
|
||||
sub YYERROR { ++$yynerrs; &yy_err_recover; }
|
||||
sub yy_err_recover
|
||||
{
|
||||
if ($yyerrflag < 3)
|
||||
{
|
||||
$yyerrflag = 3;
|
||||
while (1)
|
||||
{
|
||||
if (($yyn = $yysindex[$yyss[$yyssp]]) &&
|
||||
($yyn += constYYERRCODE()) >= 0 &&
|
||||
$yycheck[$yyn] == constYYERRCODE())
|
||||
{
|
||||
|
||||
|
||||
|
||||
|
||||
$yyss[++$yyssp] = $yystate = $yytable[$yyn];
|
||||
$yyvs[++$yyvsp] = $yylval;
|
||||
next yyloop;
|
||||
}
|
||||
else
|
||||
{
|
||||
|
||||
|
||||
|
||||
|
||||
return(1) if $yyssp <= 0;
|
||||
--$yyssp;
|
||||
--$yyvsp;
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
return (1) if $yychar == 0;
|
||||
# 313 "y.tab.pl"
|
||||
|
||||
$yychar = -1;
|
||||
next yyloop;
|
||||
}
|
||||
0;
|
||||
} # yy_err_recover
|
||||
|
||||
sub yyparse
|
||||
{
|
||||
|
||||
if ($yys = $ENV{'YYDEBUG'})
|
||||
{
|
||||
$yydebug = int($1) if $yys =~ /^(\d)/;
|
||||
}
|
||||
|
||||
|
||||
$yynerrs = 0;
|
||||
$yyerrflag = 0;
|
||||
$yychar = (-1);
|
||||
|
||||
$yyssp = 0;
|
||||
$yyvsp = 0;
|
||||
$yyss[$yyssp] = $yystate = 0;
|
||||
|
||||
yyloop: while(1)
|
||||
{
|
||||
yyreduce: {
|
||||
last yyreduce if ($yyn = $yydefred[$yystate]);
|
||||
if ($yychar < 0)
|
||||
{
|
||||
if (($yychar = &yylex) < 0) { $yychar = 0; }
|
||||
# 352 "y.tab.pl"
|
||||
|
||||
}
|
||||
if (($yyn = $yysindex[$yystate]) && ($yyn += $yychar) >= 0 &&
|
||||
$yycheck[$yyn] == $yychar)
|
||||
{
|
||||
|
||||
|
||||
|
||||
|
||||
$yyss[++$yyssp] = $yystate = $yytable[$yyn];
|
||||
$yyvs[++$yyvsp] = $yylval;
|
||||
$yychar = (-1);
|
||||
--$yyerrflag if $yyerrflag > 0;
|
||||
next yyloop;
|
||||
}
|
||||
if (($yyn = $yyrindex[$yystate]) && ($yyn += $yychar) >= 0 &&
|
||||
$yycheck[$yyn] == $yychar)
|
||||
{
|
||||
$yyn = $yytable[$yyn];
|
||||
last yyreduce;
|
||||
}
|
||||
if (! $yyerrflag) {
|
||||
&yyerror('syntax error');
|
||||
++$yynerrs;
|
||||
}
|
||||
return undef if &yy_err_recover;
|
||||
} # yyreduce
|
||||
|
||||
|
||||
|
||||
|
||||
$yym = $yylen[$yyn];
|
||||
$yyval = $yyvs[$yyvsp+1-$yym];
|
||||
switch:
|
||||
{
|
||||
my $label = "State$yyn";
|
||||
goto $label if exists $yystate{$label};
|
||||
last switch;
|
||||
State1: {
|
||||
# 94 "parser.y"
|
||||
|
||||
{ $yyval = { '' => $yyvs[$yyvsp-0] };
|
||||
last switch;
|
||||
} }
|
||||
State3: {
|
||||
# 99 "parser.y"
|
||||
|
||||
{
|
||||
$yyval = { $yyvs[$yyvsp-2], [$yyvs[$yyvsp-0]] };
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State4: {
|
||||
# 103 "parser.y"
|
||||
|
||||
{
|
||||
$yyval=$yyvs[$yyvsp-3];
|
||||
$yyval->{$yyvs[$yyvsp-2]} = [$yyvs[$yyvsp-0]];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State5: {
|
||||
# 110 "parser.y"
|
||||
|
||||
{
|
||||
$yyvs[$yyvsp-1]->[cTAG] = $yyvs[$yyvsp-3];
|
||||
$yyval = $yyvs[$yyvsp-2] ? explicit($yyvs[$yyvsp-1]) : $yyvs[$yyvsp-1];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State11: {
|
||||
# 124 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval = []}[cTYPE,cCHILD] = ('COMPONENTS', $yyvs[$yyvsp-0]);
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State14: {
|
||||
# 134 "parser.y"
|
||||
|
||||
{
|
||||
$yyvs[$yyvsp-0]->[cTAG] = $yyvs[$yyvsp-2];
|
||||
@{$yyval = []}[cTYPE,cCHILD,cLOOP] = ($yyvs[$yyvsp-4], [$yyvs[$yyvsp-0]], 1);
|
||||
$yyval = explicit($yyval) if $yyvs[$yyvsp-1];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State18: {
|
||||
# 147 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval = []}[cTYPE,cCHILD] = ('SEQUENCE', $yyvs[$yyvsp-1]);
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State19: {
|
||||
# 151 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval = []}[cTYPE,cCHILD] = ('SET', $yyvs[$yyvsp-1]);
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State20: {
|
||||
# 155 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval = []}[cTYPE,cCHILD] = ('CHOICE', $yyvs[$yyvsp-1]);
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State21: {
|
||||
# 161 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval = []}[cTYPE] = ('ENUM');
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State27: {
|
||||
# 174 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval = []}[cTYPE] = ($yyvs[$yyvsp-0]);
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State28: {
|
||||
# 179 "parser.y"
|
||||
|
||||
{ $yyval = $yyvs[$yyvsp-0];
|
||||
last switch;
|
||||
} }
|
||||
State29: {
|
||||
# 180 "parser.y"
|
||||
|
||||
{ $yyval = $yyvs[$yyvsp-1];
|
||||
last switch;
|
||||
} }
|
||||
State30: {
|
||||
# 184 "parser.y"
|
||||
|
||||
{
|
||||
$yyval = [ $yyvs[$yyvsp-0] ];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State31: {
|
||||
# 188 "parser.y"
|
||||
|
||||
{
|
||||
push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State32: {
|
||||
# 192 "parser.y"
|
||||
|
||||
{
|
||||
push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State33: {
|
||||
# 198 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval=$yyvs[$yyvsp-0]}[cVAR,cTAG] = ($yyvs[$yyvsp-3],$yyvs[$yyvsp-2]);
|
||||
$yyval = explicit($yyval) if $yyvs[$yyvsp-1];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State34: {
|
||||
# 205 "parser.y"
|
||||
|
||||
{ $yyval = $yyvs[$yyvsp-0];
|
||||
last switch;
|
||||
} }
|
||||
State35: {
|
||||
# 206 "parser.y"
|
||||
|
||||
{ $yyval = $yyvs[$yyvsp-1];
|
||||
last switch;
|
||||
} }
|
||||
State36: {
|
||||
# 210 "parser.y"
|
||||
|
||||
{
|
||||
$yyval = [ $yyvs[$yyvsp-0] ];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State37: {
|
||||
# 214 "parser.y"
|
||||
|
||||
{
|
||||
push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State38: {
|
||||
# 218 "parser.y"
|
||||
|
||||
{
|
||||
push @{$yyval=$yyvs[$yyvsp-2]}, $yyvs[$yyvsp-0];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State39: {
|
||||
# 224 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval=$yyvs[$yyvsp-1]}[cOPT] = ($yyvs[$yyvsp-0]);
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State43: {
|
||||
# 233 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval=$yyvs[$yyvsp-0]}[cVAR,cTAG] = ($yyvs[$yyvsp-3],$yyvs[$yyvsp-2]);
|
||||
$yyval->[cOPT] = $yyvs[$yyvsp-3] if $yyval->[cOPT];
|
||||
$yyval = explicit($yyval) if $yyvs[$yyvsp-1];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State45: {
|
||||
# 240 "parser.y"
|
||||
|
||||
{
|
||||
@{$yyval=$yyvs[$yyvsp-0]}[cTAG] = ($yyvs[$yyvsp-2]);
|
||||
$yyval = explicit($yyval) if $yyvs[$yyvsp-1];
|
||||
|
||||
last switch;
|
||||
} }
|
||||
State46: {
|
||||
# 246 "parser.y"
|
||||
|
||||
{ $yyval = undef;
|
||||
last switch;
|
||||
} }
|
||||
State47: {
|
||||
# 247 "parser.y"
|
||||
|
||||
{ $yyval = 1;
|
||||
last switch;
|
||||
} }
|
||||
State48: {
|
||||
# 251 "parser.y"
|
||||
|
||||
{ $yyval = undef;
|
||||
last switch;
|
||||
} }
|
||||
State50: {
|
||||
# 255 "parser.y"
|
||||
|
||||
{ $yyval = undef;
|
||||
last switch;
|
||||
} }
|
||||
State51: {
|
||||
# 256 "parser.y"
|
||||
|
||||
{ $yyval = 1;
|
||||
last switch;
|
||||
} }
|
||||
State52: {
|
||||
# 257 "parser.y"
|
||||
|
||||
{ $yyval = 0;
|
||||
last switch;
|
||||
} }
|
||||
State53: {
|
||||
# 260 "parser.y"
|
||||
|
||||
{
|
||||
last switch;
|
||||
} }
|
||||
State54: {
|
||||
# 261 "parser.y"
|
||||
|
||||
{
|
||||
last switch;
|
||||
} }
|
||||
State55: {
|
||||
# 264 "parser.y"
|
||||
|
||||
{
|
||||
last switch;
|
||||
} }
|
||||
State56: {
|
||||
# 267 "parser.y"
|
||||
|
||||
{
|
||||
last switch;
|
||||
} }
|
||||
State57: {
|
||||
# 268 "parser.y"
|
||||
|
||||
{
|
||||
last switch;
|
||||
} }
|
||||
# 615 "y.tab.pl"
|
||||
|
||||
} # switch
|
||||
$yyssp -= $yym;
|
||||
$yystate = $yyss[$yyssp];
|
||||
$yyvsp -= $yym;
|
||||
$yym = $yylhs[$yyn];
|
||||
if ($yystate == 0 && $yym == 0)
|
||||
{
|
||||
|
||||
|
||||
|
||||
|
||||
$yystate = constYYFINAL();
|
||||
$yyss[++$yyssp] = constYYFINAL();
|
||||
$yyvs[++$yyvsp] = $yyval;
|
||||
if ($yychar < 0)
|
||||
{
|
||||
if (($yychar = &yylex) < 0) { $yychar = 0; }
|
||||
# 641 "y.tab.pl"
|
||||
|
||||
}
|
||||
return $yyvs[$yyvsp] if $yychar == 0;
|
||||
next yyloop;
|
||||
}
|
||||
if (($yyn = $yygindex[$yym]) && ($yyn += $yystate) >= 0 &&
|
||||
$yyn <= $#yycheck && $yycheck[$yyn] == $yystate)
|
||||
{
|
||||
$yystate = $yytable[$yyn];
|
||||
} else {
|
||||
$yystate = $yydgoto[$yym];
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
$yyss[++$yyssp] = $yystate;
|
||||
$yyvs[++$yyvsp] = $yyval;
|
||||
} # yyloop
|
||||
} # yyparse
|
||||
# 272 "parser.y"
|
||||
|
||||
|
||||
my %reserved = (
|
||||
'OPTIONAL' => constOPTIONAL(),
|
||||
'CHOICE' => constCHOICE(),
|
||||
'OF' => constOF(),
|
||||
'IMPLICIT' => constIMPLICIT(),
|
||||
'EXPLICIT' => constEXPLICIT(),
|
||||
'SEQUENCE' => constSEQUENCE(),
|
||||
'SET' => constSET(),
|
||||
'ANY' => constANY(),
|
||||
'ENUM' => constENUM(),
|
||||
'ENUMERATED' => constENUM(),
|
||||
'COMPONENTS' => constCOMPONENTS(),
|
||||
'{' => constLBRACE(),
|
||||
'}' => constRBRACE(),
|
||||
',' => constCOMMA(),
|
||||
'::=' => constASSIGN(),
|
||||
);
|
||||
|
||||
my $reserved = join("|", reverse sort grep { /\w/ } keys %reserved);
|
||||
|
||||
my %tag_class = (
|
||||
APPLICATION => ASN_APPLICATION,
|
||||
UNIVERSAL => ASN_UNIVERSAL,
|
||||
PRIVATE => ASN_PRIVATE,
|
||||
CONTEXT => ASN_CONTEXT,
|
||||
'' => ASN_CONTEXT # if not specified, its CONTEXT
|
||||
);
|
||||
|
||||
;##
|
||||
;## This is NOT thread safe !!!!!!
|
||||
;##
|
||||
|
||||
my $pos;
|
||||
my $last_pos;
|
||||
my @stacked;
|
||||
|
||||
sub parse {
|
||||
local(*asn) = \($_[0]);
|
||||
($pos,$last_pos,@stacked) = ();
|
||||
|
||||
eval {
|
||||
local $SIG{__DIE__};
|
||||
compile(verify(yyparse()));
|
||||
}
|
||||
}
|
||||
|
||||
sub compile_one {
|
||||
my $tree = shift;
|
||||
my $ops = shift;
|
||||
my $name = shift;
|
||||
foreach my $op (@$ops) {
|
||||
next unless ref($op) eq 'ARRAY';
|
||||
bless $op;
|
||||
my $type = $op->[cTYPE];
|
||||
if (exists $base_type{$type}) {
|
||||
$op->[cTYPE] = $base_type{$type}->[1];
|
||||
$op->[cTAG] = defined($op->[cTAG]) ? asn_encode_tag($op->[cTAG]): $base_type{$type}->[0];
|
||||
}
|
||||
else {
|
||||
die "Unknown type '$type'\n" unless exists $tree->{$type};
|
||||
my $ref = compile_one(
|
||||
$tree,
|
||||
$tree->{$type},
|
||||
defined($op->[cVAR]) ? $name . "." . $op->[cVAR] : $name
|
||||
);
|
||||
if (defined($op->[cTAG]) && $ref->[0][cTYPE] == opCHOICE) {
|
||||
@{$op}[cTYPE,cCHILD] = (opSEQUENCE,$ref);
|
||||
}
|
||||
else {
|
||||
@{$op}[cTYPE,cCHILD,cLOOP] = @{$ref->[0]}[cTYPE,cCHILD,cLOOP];
|
||||
}
|
||||
$op->[cTAG] = defined($op->[cTAG]) ? asn_encode_tag($op->[cTAG]): $ref->[0][cTAG];
|
||||
}
|
||||
$op->[cTAG] |= chr(ASN_CONSTRUCTOR)
|
||||
if length $op->[cTAG] && ($op->[cTYPE] == opSET || $op->[cTYPE] == opSEQUENCE);
|
||||
|
||||
if ($op->[cCHILD]) {
|
||||
;# If we have children we are one of
|
||||
;# opSET opSEQUENCE opCHOICE
|
||||
|
||||
compile_one($tree, $op->[cCHILD], defined($op->[cVAR]) ? $name . "." . $op->[cVAR] : $name);
|
||||
|
||||
;# If a CHOICE is given a tag, then it must be EXPLICIT
|
||||
$op = explicit($op) if $op->[cTYPE] == opCHOICE && defined($op->[cTAG]) && length($op->[cTAG]);
|
||||
|
||||
if ( @{$op->[cCHILD]} > 1) {
|
||||
;#if ($op->[cTYPE] != opSEQUENCE) {
|
||||
;# Here we need to flatten CHOICEs and check that SET and CHOICE
|
||||
;# do not contain duplicate tags
|
||||
;#}
|
||||
}
|
||||
else {
|
||||
;# A SET of one element can be treated the same as a SEQUENCE
|
||||
$op->[cTYPE] = opSEQUENCE if $op->[cTYPE] == opSET;
|
||||
}
|
||||
}
|
||||
}
|
||||
$ops;
|
||||
}
|
||||
|
||||
sub compile {
|
||||
my $tree = shift;
|
||||
|
||||
;# The tree should be valid enough to be able to
|
||||
;# - resolve references
|
||||
;# - encode tags
|
||||
;# - verify CHOICEs do not contain duplicate tags
|
||||
|
||||
;# once references have been resolved, and also due to
|
||||
;# flattening of COMPONENTS, it is possible for an op
|
||||
;# to appear in multiple places. So once an op is
|
||||
;# compiled we bless it. This ensure we dont try to
|
||||
;# compile it again.
|
||||
|
||||
while(my($k,$v) = each %$tree) {
|
||||
compile_one($tree,$v,$k);
|
||||
}
|
||||
|
||||
$tree;
|
||||
}
|
||||
|
||||
sub verify {
|
||||
my $tree = shift or return;
|
||||
my $err = "";
|
||||
|
||||
;# Well it parsed correctly, now we
|
||||
;# - check references exist
|
||||
;# - flatten COMPONENTS OF (checking for loops)
|
||||
;# - check for duplicate var names
|
||||
|
||||
while(my($name,$ops) = each %$tree) {
|
||||
my $stash = {};
|
||||
my @scope = ();
|
||||
my $path = "";
|
||||
my $idx = 0;
|
||||
|
||||
while($ops) {
|
||||
if ($idx < @$ops) {
|
||||
my $op = $ops->[$idx++];
|
||||
my $var;
|
||||
if (defined ($var = $op->[cVAR])) {
|
||||
|
||||
$err .= "$name: $path.$var used multiple times\n"
|
||||
if $stash->{$var}++;
|
||||
|
||||
}
|
||||
if (defined $op->[cCHILD]) {
|
||||
if (ref $op->[cCHILD]) {
|
||||
push @scope, [$stash, $path, $ops, $idx];
|
||||
if (defined $var) {
|
||||
$stash = {};
|
||||
$path .= "." . $var;
|
||||
}
|
||||
$idx = 0;
|
||||
$ops = $op->[cCHILD];
|
||||
}
|
||||
elsif ($op->[cTYPE] eq 'COMPONENTS') {
|
||||
splice(@$ops,--$idx,1,expand_ops($tree, $op->[cCHILD]));
|
||||
}
|
||||
else {
|
||||
die "Internal error\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $s = pop @scope
|
||||
or last;
|
||||
($stash,$path,$ops,$idx) = @$s;
|
||||
}
|
||||
}
|
||||
}
|
||||
die $err if length $err;
|
||||
$tree;
|
||||
}
|
||||
|
||||
sub expand_ops {
|
||||
my $tree = shift;
|
||||
my $want = shift;
|
||||
my $seen = shift || { };
|
||||
|
||||
die "COMPONENTS OF loop $want\n" if $seen->{$want}++;
|
||||
die "Undefined macro $want\n" unless exists $tree->{$want};
|
||||
my $ops = $tree->{$want};
|
||||
die "Bad macro for COMPUNENTS OF '$want'\n"
|
||||
unless @$ops == 1
|
||||
&& ($ops->[0][cTYPE] eq 'SEQUENCE' || $ops->[0][cTYPE] eq 'SET')
|
||||
&& ref $ops->[0][cCHILD];
|
||||
$ops = $ops->[0][cCHILD];
|
||||
for(my $idx = 0 ; $idx < @$ops ; ) {
|
||||
my $op = $ops->[$idx++];
|
||||
if ($op->[cTYPE] eq 'COMPONENTS') {
|
||||
splice(@$ops,--$idx,1,expand_ops($tree, $op->[cCHILD], $seen));
|
||||
}
|
||||
}
|
||||
|
||||
@$ops;
|
||||
}
|
||||
|
||||
sub _yylex {
|
||||
my $ret = &_yylex;
|
||||
warn $ret;
|
||||
$ret;
|
||||
}
|
||||
|
||||
sub yylex {
|
||||
return shift @stacked if @stacked;
|
||||
|
||||
while ($asn =~ /\G(?:
|
||||
(\s+|--[^\n]*)
|
||||
|
|
||||
([,{}]|::=)
|
||||
|
|
||||
($reserved)\b
|
||||
|
|
||||
(
|
||||
(?:OCTET|BIT)\s+STRING
|
||||
|
|
||||
OBJECT\s+IDENTIFIER
|
||||
|
|
||||
RELATIVE-OID
|
||||
)\b
|
||||
|
|
||||
(\w+)
|
||||
|
|
||||
\[\s*
|
||||
(
|
||||
(?:(?:APPLICATION|PRIVATE|UNIVERSAL|CONTEXT)\s+)?
|
||||
\d+
|
||||
)
|
||||
\s*\]
|
||||
|
|
||||
\((\d+)\)
|
||||
)/sxgo
|
||||
) {
|
||||
|
||||
($last_pos,$pos) = ($pos,pos($asn));
|
||||
|
||||
next if defined $1; # comment or whitespace
|
||||
|
||||
if (defined $2 or defined $3) {
|
||||
#A comma is not required after a '}' so to aid the
|
||||
#parser we insert a fake token after any '}'
|
||||
push @stacked, constPOSTRBRACE() if defined $2 and $+ eq '}';
|
||||
|
||||
return $reserved{$yylval = $+};
|
||||
}
|
||||
|
||||
if (defined $4) {
|
||||
($yylval = $+) =~ s/\s+/_/g;
|
||||
return constWORD();
|
||||
}
|
||||
|
||||
if (defined $5) {
|
||||
$yylval = $+;
|
||||
return constWORD();
|
||||
}
|
||||
|
||||
if (defined $6) {
|
||||
my($class,$num) = ($+ =~ /^([A-Z]*)\s*(\d+)$/);
|
||||
$yylval = asn_tag($tag_class{$class}, $num);
|
||||
return constCLASS();
|
||||
}
|
||||
|
||||
if (defined $7) {
|
||||
$yylval = $+;
|
||||
return constNUMBER();
|
||||
}
|
||||
|
||||
die "Internal error\n";
|
||||
|
||||
}
|
||||
|
||||
die "Parse error before ",substr($asn,$pos,40),"\n"
|
||||
unless $pos == length($asn);
|
||||
|
||||
0
|
||||
}
|
||||
|
||||
sub yyerror {
|
||||
die @_," ",substr($asn,$last_pos,40),"\n";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# 947 "y.tab.pl"
|
||||
|
||||
%yystate = ('State20','','State21','','State43','','State27','','State28',
|
||||
'','State45','','State29','','State46','','State47','','State48','',
|
||||
'State1','','State3','','State4','','State5','','State11','','State14','',
|
||||
'State30','','State31','','State32','','State33','','State18','','State34',
|
||||
'','State50','','State19','','State35','','State51','','State36','',
|
||||
'State52','','State37','','State53','','State38','','State54','','State39',
|
||||
'','State55','','State56','','State57','');
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue