line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- Mode: Perl -*- |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
########################################################################## |
4
|
|
|
|
|
|
|
# MIB Compiler supporting SMI(v1) and SMIv2 |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Author: Fabien Tassin |
7
|
|
|
|
|
|
|
# Copyright 1998, 1999 Fabien Tassin |
8
|
|
|
|
|
|
|
########################################################################## |
9
|
|
|
|
|
|
|
# See Also : |
10
|
|
|
|
|
|
|
# Rec. X.208: Specification of Abstract Syntax Notation (ASN.1) |
11
|
|
|
|
|
|
|
# RFC 1155: Structure and Identification of Management Information |
12
|
|
|
|
|
|
|
# for TCP/IP-based Internets |
13
|
|
|
|
|
|
|
# RFC 1158: Management Information Base for network management of |
14
|
|
|
|
|
|
|
# TCP/IP-based internets: MIB-II |
15
|
|
|
|
|
|
|
# RFC 1212: Concise MIB definitions |
16
|
|
|
|
|
|
|
# RFC 1215: Convention for defining traps for use with the SNMP |
17
|
|
|
|
|
|
|
# RFC 1902: Structure of Management Information for Version 2 of the |
18
|
|
|
|
|
|
|
# Simple Network Management Protocol (SNMPv2) |
19
|
|
|
|
|
|
|
# RFC 1903: Textual Conventions for Version 2 of the Simple Network |
20
|
|
|
|
|
|
|
# Management Protocol (SNMPv2) |
21
|
|
|
|
|
|
|
# RFC 1904: Conformance Statements for Version 2 of the Simple Network |
22
|
|
|
|
|
|
|
# Management Protocol (SNMPv2) |
23
|
|
|
|
|
|
|
########################################################################## |
24
|
|
|
|
|
|
|
# ABSOLUTELY NO WARRANTY WITH THIS PACKAGE. USE IT AT YOUR OWN RISKS. |
25
|
|
|
|
|
|
|
########################################################################## |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# TODO: |
28
|
|
|
|
|
|
|
# - resolve constants (e.g. 'max-bindings' in SNMPv2-PDU) |
29
|
|
|
|
|
|
|
# - check a value against a syntax |
30
|
|
|
|
|
|
|
# - extend the API |
31
|
|
|
|
|
|
|
# - more test scripts |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
package SNMP::MIB::Compiler; |
34
|
|
|
|
|
|
|
|
35
|
7
|
|
|
7
|
|
202836
|
use strict; |
|
7
|
|
|
|
|
18
|
|
|
7
|
|
|
|
|
486
|
|
36
|
7
|
|
|
7
|
|
89
|
use vars qw(@ISA @EXPORT $VERSION $DEBUG); |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
796
|
|
37
|
7
|
|
|
7
|
|
39
|
use Exporter; |
|
7
|
|
|
|
|
15
|
|
|
7
|
|
|
|
|
407
|
|
38
|
7
|
|
|
7
|
|
37
|
use Carp; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
572
|
|
39
|
7
|
|
|
7
|
|
11194
|
use Data::Dumper; |
|
7
|
|
|
|
|
125664
|
|
|
7
|
|
|
|
|
560
|
|
40
|
7
|
|
|
7
|
|
65
|
use FileHandle; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
56
|
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
43
|
|
|
|
|
|
|
@EXPORT = (); |
44
|
|
|
|
|
|
|
$VERSION = 0.06; |
45
|
|
|
|
|
|
|
$DEBUG = 1; # no longer used |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
###################################################################### |
48
|
|
|
|
|
|
|
# ASN1 items. (See Rec. X.208 §8) |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Type references (§8.2) |
51
|
|
|
|
|
|
|
my $ITEM_TYPEREFERENCE_PAT = '[A-Z](\-?[A-Za-z0-9])*'; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Reserved character sequences (See Table 3/X.208) |
54
|
|
|
|
|
|
|
# and Additional keyword items (See §A.2.9) |
55
|
|
|
|
|
|
|
my @RESERVED_CHAR_SEQ = ('BOOLEAN', 'INTEGER', 'BIT', 'STRING', 'OCTET', |
56
|
|
|
|
|
|
|
'NULL', 'SEQUENCE', 'OF', 'SET', 'IMPLICIT', 'CHOICE', |
57
|
|
|
|
|
|
|
'ANY', 'EXTERNAL', 'OBJECT', 'IDENTIFIER', 'OPTIONAL', |
58
|
|
|
|
|
|
|
'DEFAULT', 'COMPONENTS', 'UNIVERSAL', 'APPLICATION', |
59
|
|
|
|
|
|
|
'PRIVATE', 'TRUE', 'FALSE', 'BEGIN', 'END', |
60
|
|
|
|
|
|
|
'DEFINITIONS', 'EXPLICIT', 'ENUMERATED', 'EXPORTS', |
61
|
|
|
|
|
|
|
'IMPORTS', 'REAL', 'INCLUDES', 'MIN', 'MAX', 'SIZE', |
62
|
|
|
|
|
|
|
'FROM', 'WITH', 'COMPONENT', 'PRESENT', 'ABSENT', |
63
|
|
|
|
|
|
|
'DEFINED', 'BY', 'PLUS-INFINITY', 'MINUS-INFINITY', |
64
|
|
|
|
|
|
|
'TAGS', |
65
|
|
|
|
|
|
|
'MACRO', 'TYPE', 'NOTATION', 'VALUE', # Macro keywords |
66
|
|
|
|
|
|
|
); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# my $ITEM_TYPEREFERENCE = '(?!' . |
69
|
|
|
|
|
|
|
# (join '(?!\-?[A-Za-z0-9])|', @RESERVED_CHAR_SEQ) . |
70
|
|
|
|
|
|
|
# '(?!\-?[A-Za-z0-9]))' . $ITEM_TYPEREFERENCE_PAT; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $ITEM_TYPEREFERENCE = |
73
|
|
|
|
|
|
|
'(?!(?:' . (join '|', @RESERVED_CHAR_SEQ) . ')(?!\-?[A-Za-z0-9]))' . |
74
|
|
|
|
|
|
|
$ITEM_TYPEREFERENCE_PAT; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# Identifiers (§8.3) |
77
|
|
|
|
|
|
|
my $ITEM_IDENTIFIER = '\b[a-z](?:\-?[A-Za-z0-9])*\b'; |
78
|
|
|
|
|
|
|
my $ITEM_IDENTIFIER2 = '\b[a-z](?:[\-_]?[A-Za-z0-9])*\b'; # w/allow_underscore |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Number item (§8.8) |
81
|
|
|
|
|
|
|
my $ITEM_NUMBER = '\b(?:0|[1-9][0-9]*)\b'; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Binary string item (§8.9) (bstring) |
84
|
|
|
|
|
|
|
my $ITEM_BINARYSTRING = '\'[01]*\'B'; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# Hexadecimal string item (§8.10) (hstring) |
87
|
|
|
|
|
|
|
my $ITEM_HEXADECIMALSTRING = '\'[A-F0-9]*\'H'; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# Single character items (§8.13) |
90
|
|
|
|
|
|
|
my $ITEM_SINGLECHARACTER = '[\{\}\<,\.\(\)\[\]\-;]'; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub MIBERROR() { 0 }; |
93
|
|
|
|
|
|
|
sub MIBWARN() { 1 }; |
94
|
|
|
|
|
|
|
sub MIBNOTICE() { 2 }; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
###################################################################### |
97
|
|
|
|
|
|
|
# Tokens |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
my $TOKEN = &create_tokens(); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
my $BSTRING = &add_token ($TOKEN, 'BSTRING'); |
102
|
|
|
|
|
|
|
my $HSTRING = &add_token ($TOKEN, 'HSTRING'); |
103
|
|
|
|
|
|
|
my $CSTRING = &add_token ($TOKEN, 'CSTRING'); |
104
|
|
|
|
|
|
|
my $ASSIGNMENT = &add_token ($TOKEN, 'ASSIGNMENT'); |
105
|
|
|
|
|
|
|
my $NUMBER = &add_token ($TOKEN, 'NUMBER'); |
106
|
|
|
|
|
|
|
my $IDENTIFIER = &add_token ($TOKEN, 'IDENTIFIER'); |
107
|
|
|
|
|
|
|
my $TYPEMODREFERENCE = &add_token ($TOKEN, 'TYPEMODREFERENCE'); |
108
|
|
|
|
|
|
|
my $EMPTY = &add_token ($TOKEN, 'EMPTY'); |
109
|
|
|
|
|
|
|
my $BOOLEAN = &add_token ($TOKEN, 'BOOLEAN'); |
110
|
|
|
|
|
|
|
my $INTEGER = &add_token ($TOKEN, 'INTEGER'); |
111
|
|
|
|
|
|
|
my $BIT = &add_token ($TOKEN, 'BIT'); |
112
|
|
|
|
|
|
|
my $STRING = &add_token ($TOKEN, 'STRING'); |
113
|
|
|
|
|
|
|
my $OCTET = &add_token ($TOKEN, 'OCTET'); |
114
|
|
|
|
|
|
|
my $NULL = &add_token ($TOKEN, 'NULL'); |
115
|
|
|
|
|
|
|
my $SEQUENCE = &add_token ($TOKEN, 'SEQUENCE'); |
116
|
|
|
|
|
|
|
my $OF = &add_token ($TOKEN, 'OF'); |
117
|
|
|
|
|
|
|
my $SET = &add_token ($TOKEN, 'SET'); |
118
|
|
|
|
|
|
|
my $IMPLICIT = &add_token ($TOKEN, 'IMPLICIT'); |
119
|
|
|
|
|
|
|
my $CHOICE = &add_token ($TOKEN, 'CHOICE'); |
120
|
|
|
|
|
|
|
my $ANY = &add_token ($TOKEN, 'ANY'); |
121
|
|
|
|
|
|
|
my $EXTERNAL = &add_token ($TOKEN, 'EXTERNAL'); |
122
|
|
|
|
|
|
|
my $OBJECT = &add_token ($TOKEN, 'OBJECT'); |
123
|
|
|
|
|
|
|
my $OPTIONAL = &add_token ($TOKEN, 'OPTIONAL'); |
124
|
|
|
|
|
|
|
my $DEFAULT = &add_token ($TOKEN, 'DEFAULT'); |
125
|
|
|
|
|
|
|
my $COMPONENTS = &add_token ($TOKEN, 'COMPONENTS'); |
126
|
|
|
|
|
|
|
my $UNIVERSAL = &add_token ($TOKEN, 'UNIVERSAL'); |
127
|
|
|
|
|
|
|
my $APPLICATION = &add_token ($TOKEN, 'APPLICATION'); |
128
|
|
|
|
|
|
|
my $PRIVATE = &add_token ($TOKEN, 'PRIVATE'); |
129
|
|
|
|
|
|
|
my $TRUE = &add_token ($TOKEN, 'TRUE'); |
130
|
|
|
|
|
|
|
my $FALSE = &add_token ($TOKEN, 'FALSE'); |
131
|
|
|
|
|
|
|
my $BEGIN = &add_token ($TOKEN, 'BEGIN'); |
132
|
|
|
|
|
|
|
my $END = &add_token ($TOKEN, 'END'); |
133
|
|
|
|
|
|
|
my $DEFINITIONS = &add_token ($TOKEN, 'DEFINITIONS'); |
134
|
|
|
|
|
|
|
my $EXPLICIT = &add_token ($TOKEN, 'EXPLICIT'); |
135
|
|
|
|
|
|
|
my $ENUMERATED = &add_token ($TOKEN, 'ENUMERATED'); |
136
|
|
|
|
|
|
|
my $EXPORTS = &add_token ($TOKEN, 'EXPORTS'); |
137
|
|
|
|
|
|
|
my $IMPORTS = &add_token ($TOKEN, 'IMPORTS'); |
138
|
|
|
|
|
|
|
my $REAL = &add_token ($TOKEN, 'REAL'); |
139
|
|
|
|
|
|
|
my $INCLUDES = &add_token ($TOKEN, 'INCLUDES'); |
140
|
|
|
|
|
|
|
my $MIN = &add_token ($TOKEN, 'MIN'); |
141
|
|
|
|
|
|
|
my $MAX = &add_token ($TOKEN, 'MAX'); |
142
|
|
|
|
|
|
|
my $SIZE = &add_token ($TOKEN, 'SIZE'); |
143
|
|
|
|
|
|
|
my $FROM = &add_token ($TOKEN, 'FROM'); |
144
|
|
|
|
|
|
|
my $WITH = &add_token ($TOKEN, 'WITH'); |
145
|
|
|
|
|
|
|
my $COMPONENT = &add_token ($TOKEN, 'COMPONENT'); |
146
|
|
|
|
|
|
|
my $PRESENT = &add_token ($TOKEN, 'PRESENT'); |
147
|
|
|
|
|
|
|
my $ABSENT = &add_token ($TOKEN, 'ABSENT'); |
148
|
|
|
|
|
|
|
my $DEFINED = &add_token ($TOKEN, 'DEFINED'); |
149
|
|
|
|
|
|
|
my $BY = &add_token ($TOKEN, 'BY'); |
150
|
|
|
|
|
|
|
my $PLUSINFINITY = &add_token ($TOKEN, 'PLUSINFINITY'); |
151
|
|
|
|
|
|
|
my $MINUSINFINITY = &add_token ($TOKEN, 'MINUSINFINITY'); |
152
|
|
|
|
|
|
|
my $TAGS = &add_token ($TOKEN, 'TAGS'); |
153
|
|
|
|
|
|
|
my $MACRO = &add_token ($TOKEN, 'MACRO'); |
154
|
|
|
|
|
|
|
my $TYPE = &add_token ($TOKEN, 'TYPE'); |
155
|
|
|
|
|
|
|
my $NOTATION = &add_token ($TOKEN, 'NOTATION'); |
156
|
|
|
|
|
|
|
my $VALUE = &add_token ($TOKEN, 'VALUE'); |
157
|
|
|
|
|
|
|
my $MACROTYPE = &add_token ($TOKEN, 'MACROTYPE'); |
158
|
|
|
|
|
|
|
my $MACROVALUE = &add_token ($TOKEN, 'MACROVALUE'); |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
my $keywords = { |
161
|
|
|
|
|
|
|
'BOOLEAN' => $BOOLEAN, |
162
|
|
|
|
|
|
|
'INTEGER' => $INTEGER, |
163
|
|
|
|
|
|
|
'BIT' => $BIT, |
164
|
|
|
|
|
|
|
'STRING' => $STRING, |
165
|
|
|
|
|
|
|
'OCTET' => $OCTET, |
166
|
|
|
|
|
|
|
'NULL' => $NULL, |
167
|
|
|
|
|
|
|
'SEQUENCE' => $SEQUENCE, |
168
|
|
|
|
|
|
|
'OF' => $OF, |
169
|
|
|
|
|
|
|
'SET' => $SET, |
170
|
|
|
|
|
|
|
'IMPLICIT' => $IMPLICIT, |
171
|
|
|
|
|
|
|
'CHOICE' => $CHOICE, |
172
|
|
|
|
|
|
|
'ANY' => $ANY, |
173
|
|
|
|
|
|
|
'EXTERNAL' => $EXTERNAL, |
174
|
|
|
|
|
|
|
'OBJECT' => $OBJECT, |
175
|
|
|
|
|
|
|
'IDENTIFIER' => $IDENTIFIER, |
176
|
|
|
|
|
|
|
'OPTIONAL' => $OPTIONAL, |
177
|
|
|
|
|
|
|
'DEFAULT' => $DEFAULT, |
178
|
|
|
|
|
|
|
'COMPONENTS' => $COMPONENTS, |
179
|
|
|
|
|
|
|
'UNIVERSAL' => $UNIVERSAL, |
180
|
|
|
|
|
|
|
'APPLICATION' => $APPLICATION, |
181
|
|
|
|
|
|
|
'PRIVATE' => $PRIVATE, |
182
|
|
|
|
|
|
|
'TRUE' => $TRUE, |
183
|
|
|
|
|
|
|
'FALSE' => $FALSE, |
184
|
|
|
|
|
|
|
'BEGIN' => $BEGIN, |
185
|
|
|
|
|
|
|
'END' => $END, |
186
|
|
|
|
|
|
|
'DEFINITIONS' => $DEFINITIONS, |
187
|
|
|
|
|
|
|
'EXPLICIT' => $EXPLICIT, |
188
|
|
|
|
|
|
|
'ENUMERATED' => $ENUMERATED, |
189
|
|
|
|
|
|
|
'EXPORTS' => $EXPORTS, |
190
|
|
|
|
|
|
|
'IMPORTS' => $IMPORTS, |
191
|
|
|
|
|
|
|
'REAL' => $REAL, |
192
|
|
|
|
|
|
|
'INCLUDES' => $INCLUDES, |
193
|
|
|
|
|
|
|
'MIN' => $MIN, |
194
|
|
|
|
|
|
|
'MAX' => $MAX, |
195
|
|
|
|
|
|
|
'SIZE' => $SIZE, |
196
|
|
|
|
|
|
|
'FROM' => $FROM, |
197
|
|
|
|
|
|
|
'WITH' => $WITH, |
198
|
|
|
|
|
|
|
'COMPONENT' => $COMPONENT, |
199
|
|
|
|
|
|
|
'PRESENT' => $PRESENT, |
200
|
|
|
|
|
|
|
'ABSENT' => $ABSENT, |
201
|
|
|
|
|
|
|
'DEFINED' => $DEFINED, |
202
|
|
|
|
|
|
|
'BY' => $BY, |
203
|
|
|
|
|
|
|
'TAGS' => $TAGS, |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
'MACRO' => $MACRO, |
206
|
|
|
|
|
|
|
'TYPE' => $TYPE, |
207
|
|
|
|
|
|
|
'NOTATION' => $NOTATION, |
208
|
|
|
|
|
|
|
'VALUE' => $VALUE, |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
'MACROTYPE' => $MACROTYPE, |
211
|
|
|
|
|
|
|
'MACROVALUE' => $MACROVALUE, |
212
|
|
|
|
|
|
|
}; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
###################################################################### |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# Create the standard tokens |
217
|
|
|
|
|
|
|
sub create_tokens { |
218
|
7
|
|
|
7
|
0
|
16
|
my $TOKEN = []; |
219
|
7
|
|
|
|
|
36
|
my $i = -1; |
220
|
7
|
|
|
|
|
47
|
while ($i++ < 255) { |
221
|
1792
|
|
|
|
|
4365
|
$$TOKEN[$i] = chr $i; |
222
|
|
|
|
|
|
|
} |
223
|
7
|
|
|
|
|
23
|
$TOKEN; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# Add a 'specialized' token to the current list of tokens |
227
|
|
|
|
|
|
|
sub add_token { |
228
|
406
|
|
|
406
|
0
|
493
|
my $TOKEN = shift; |
229
|
406
|
|
|
|
|
796
|
my $k = shift; |
230
|
406
|
|
|
|
|
718
|
push @$TOKEN, $k; |
231
|
406
|
|
|
|
|
1121
|
$#$TOKEN; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# The 'heart' of the compiler: the parser |
235
|
|
|
|
|
|
|
# returns the couple token/value or the scalar 0 if something goes wrong. |
236
|
|
|
|
|
|
|
sub yylex { |
237
|
452
|
|
|
452
|
0
|
679
|
my $self = shift; |
238
|
|
|
|
|
|
|
|
239
|
452
|
|
|
|
|
590
|
my $s = $self->{'stream'}; |
240
|
452
|
|
|
|
|
1337
|
my $val; |
241
|
452
|
|
|
|
|
522
|
my $c = ' '; # initialization. |
242
|
452
|
|
33
|
|
|
2318
|
CHAR: while ($c ne '' && $c !~ m/^[A-Za-z0-9:=,\{\}<.\(\)\[\]\'\">|]$/o) { |
243
|
|
|
|
|
|
|
# remove useless blanks and comments |
244
|
473
|
|
66
|
|
|
898
|
1 while ($c = $s->getc) eq ' ' || $c eq "\t" || $c eq "\n" || $c eq "\r"; |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
245
|
473
|
50
|
|
|
|
956
|
return 0 if $c eq ''; |
246
|
473
|
100
|
|
|
|
733
|
if ($c eq '-') { # The first char of a "comment" (See §8.6) |
247
|
22
|
|
|
|
|
48
|
$c = $s->getc; |
248
|
22
|
50
|
|
|
|
75
|
if ($c eq '') { # a single hyphen followed by EOF |
249
|
0
|
|
|
|
|
0
|
$s->ungetc; # keep EOF for the next yylex call |
250
|
0
|
|
|
|
|
0
|
$c = '-'; |
251
|
0
|
|
|
|
|
0
|
last CHAR; |
252
|
|
|
|
|
|
|
} |
253
|
22
|
100
|
|
|
|
55
|
if ($c eq '-') { # it is a real "comment" marker |
254
|
21
|
|
|
|
|
33
|
while (1) { |
255
|
28
|
|
66
|
|
|
62
|
1 while ($c = $s->getc) ne '' && $c ne '-' |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
256
|
|
|
|
|
|
|
&& $c ne "\n" && $c ne "\r"; |
257
|
28
|
50
|
|
|
|
80
|
return 0 if $c eq ''; # End of file. |
258
|
28
|
100
|
|
|
|
69
|
if ($c eq '-') { |
259
|
13
|
|
|
|
|
30
|
$c = $s->getc; |
260
|
13
|
50
|
|
|
|
48
|
return 0 if $c eq ''; # End of file. |
261
|
13
|
100
|
66
|
|
|
142
|
next CHAR if $c eq "\n" || $c eq "\r" || |
|
|
|
100
|
|
|
|
|
262
|
|
|
|
|
|
|
$c eq '-'; # End of comment. |
263
|
|
|
|
|
|
|
} |
264
|
22
|
100
|
|
|
|
141
|
next CHAR if $c eq "\n"; # End of comment. |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
else { # it is NOT a comment but a single hyphen. |
268
|
1
|
|
|
|
|
4
|
$s->ungetc; |
269
|
1
|
|
|
|
|
3
|
$c = '-'; |
270
|
1
|
|
|
|
|
2
|
last CHAR; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
else { |
274
|
451
|
|
|
|
|
528
|
last; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
# Here, the current char is a valid ASN.1 char, it can be a hyphen but |
278
|
|
|
|
|
|
|
# not a double hyphen (comment start). |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# Read a word and return the correspondant token. |
281
|
452
|
50
|
|
|
|
783
|
return 0 if $c eq ''; |
282
|
452
|
100
|
|
|
|
1516
|
if ($c =~ m/^$ITEM_SINGLECHARACTER$/o) { |
283
|
|
|
|
|
|
|
# it is a single characters |
284
|
128
|
|
|
|
|
388
|
return (ord ($c), $c); |
285
|
|
|
|
|
|
|
} |
286
|
324
|
100
|
|
|
|
691
|
if ($c =~ m/^[>|]/o) { |
287
|
|
|
|
|
|
|
# it is a single extension characters |
288
|
9
|
|
|
|
|
29
|
return (ord ($c), $c); |
289
|
|
|
|
|
|
|
} |
290
|
315
|
50
|
|
|
|
630
|
if ($c eq '\'') { # it can be a cstring or a hstring. |
291
|
0
|
|
|
|
|
0
|
$val = $c; |
292
|
|
|
|
|
|
|
# while (($c = $s->getc) ne '' && ($c =~ m/[0-9A-F]/o || |
293
|
|
|
|
|
|
|
# ($self->{'allow_lowcase_hstrings'} && $c =~ m/[a-f]/o))) { |
294
|
0
|
|
0
|
|
|
0
|
while (($c = $s->getc) ne '' && $c =~ m/[0-9A-Fa-f]/o) { |
295
|
0
|
|
|
|
|
0
|
$val .= $c; |
296
|
|
|
|
|
|
|
} |
297
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
298
|
|
|
|
|
|
|
"Unexpected EOF near \"$val\"") if $c eq ''; |
299
|
0
|
0
|
|
|
|
0
|
if ($c eq '\'') { |
300
|
0
|
|
|
|
|
0
|
$val .= $c; |
301
|
0
|
|
|
|
|
0
|
$c = $s->getc; |
302
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
303
|
|
|
|
|
|
|
"Unexpected EOF near \"$val\"") if $c eq ''; |
304
|
0
|
|
|
|
|
0
|
$val .= $c; |
305
|
|
|
|
|
|
|
# it must be 'B' or 'H'. |
306
|
0
|
0
|
0
|
|
|
0
|
$c = 'B' if $c eq 'b' && $self->{'allow_lowcase_bstrings'}; |
307
|
0
|
0
|
0
|
|
|
0
|
if ($c =~ m/[hH]/o && $self->{'allow_lowcase_hstrings'}) { |
308
|
0
|
|
|
|
|
0
|
$c = 'H'; |
309
|
0
|
|
|
|
|
0
|
$val = uc $val; |
310
|
|
|
|
|
|
|
} |
311
|
0
|
0
|
0
|
|
|
0
|
if ($c eq 'B' && $val =~ m/^$ITEM_BINARYSTRING$/o) { |
312
|
0
|
|
|
|
|
0
|
return ($BSTRING, $val); |
313
|
|
|
|
|
|
|
} |
314
|
0
|
0
|
0
|
|
|
0
|
if ($c eq 'H' && $val =~ m/^$ITEM_HEXADECIMALSTRING$/o) { |
315
|
0
|
|
|
|
|
0
|
return ($HSTRING, $val); |
316
|
|
|
|
|
|
|
} |
317
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
318
|
|
|
|
|
|
|
"Invalid \"$val\". See 'allow_lowcase_{b|h}strings' switches"); |
319
|
|
|
|
|
|
|
} |
320
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
321
|
|
|
|
|
|
|
"Syntax error near \"$val\""); |
322
|
|
|
|
|
|
|
} |
323
|
315
|
100
|
|
|
|
575
|
if ($c eq '"') { # a cstring |
324
|
27
|
|
|
|
|
36
|
$val = $c; |
325
|
27
|
|
|
|
|
30
|
while (1) { |
326
|
27
|
|
66
|
|
|
52
|
while (($c = $s->getc) ne '' && $c ne '"') { |
327
|
1985
|
|
|
|
|
4307
|
$val .= $c; |
328
|
|
|
|
|
|
|
} |
329
|
27
|
50
|
|
|
|
70
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
330
|
|
|
|
|
|
|
"Unexpected EOF near \"$val\"") if $c eq ''; |
331
|
27
|
|
|
|
|
38
|
$val .= $c; |
332
|
27
|
|
|
|
|
54
|
$c = $s->getc; |
333
|
27
|
50
|
33
|
|
|
134
|
if ($c eq '' || $c ne '"') { |
334
|
27
|
50
|
|
|
|
87
|
$s->ungetc if $c; |
335
|
27
|
|
|
|
|
102
|
return ($CSTRING, $val); |
336
|
|
|
|
|
|
|
} |
337
|
0
|
|
|
|
|
0
|
$val .= $c; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
} |
340
|
288
|
100
|
|
|
|
547
|
if ($c eq ':') { # an assignment item |
341
|
8
|
|
|
|
|
17
|
$val = $c; |
342
|
8
|
|
|
|
|
19
|
$c = $s->getc; |
343
|
8
|
50
|
|
|
|
25
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
344
|
|
|
|
|
|
|
"Unexpected EOF near \"$val\"") if $c eq ''; |
345
|
8
|
50
|
|
|
|
21
|
if ($c ne ':') { |
346
|
0
|
0
|
|
|
|
0
|
$s->ungetc if $c; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
else { |
349
|
8
|
|
|
|
|
14
|
$val .= $c; |
350
|
8
|
|
|
|
|
20
|
$c = $s->getc; |
351
|
8
|
50
|
|
|
|
26
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
352
|
|
|
|
|
|
|
"Unexpected EOF near \"$val\"") if $c eq ''; |
353
|
8
|
50
|
|
|
|
25
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
354
|
|
|
|
|
|
|
"Syntax error near \"$val\"") unless $c eq '='; |
355
|
8
|
|
|
|
|
10
|
$val .= $c; |
356
|
8
|
|
|
|
|
28
|
return ($ASSIGNMENT, $val); |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
} |
359
|
280
|
100
|
|
|
|
615
|
if ($c =~ m/\d/o) { # it is a number |
360
|
44
|
|
|
|
|
62
|
$val = $c; |
361
|
44
|
|
66
|
|
|
90
|
while (($c = $s->getc) ne '' && $c =~ m/\d/o) { |
362
|
5
|
|
|
|
|
13
|
$val .= $c; |
363
|
|
|
|
|
|
|
} |
364
|
44
|
50
|
|
|
|
152
|
$s->ungetc if $c; |
365
|
44
|
50
|
|
|
|
448
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
366
|
|
|
|
|
|
|
"Syntax error near \"$val\"") unless $val =~ m/^$ITEM_NUMBER$/; |
367
|
44
|
|
|
|
|
140
|
return ($NUMBER, $val); |
368
|
|
|
|
|
|
|
} |
369
|
236
|
50
|
|
|
|
660
|
if ($c =~ m/[a-zA-Z]/o) { |
370
|
236
|
|
|
|
|
312
|
$val = $c; |
371
|
236
|
|
|
|
|
219
|
while (1) { |
372
|
294
|
|
66
|
|
|
557
|
while (($c = $s->getc) ne '' && ($c =~ m/[A-Za-z0-9]/o || |
|
|
|
33
|
|
|
|
|
373
|
|
|
|
|
|
|
($self->{'allow_underscore'} && $c eq '_'))) { |
374
|
2098
|
|
|
|
|
4640
|
$val .= $c; |
375
|
|
|
|
|
|
|
} |
376
|
294
|
100
|
|
|
|
619
|
if ($c eq '-') { |
377
|
61
|
|
|
|
|
124
|
$c = $s->getc; |
378
|
|
|
|
|
|
|
# a hyphen shall not be the last character |
379
|
61
|
50
|
33
|
|
|
392
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
|
|
|
33
|
|
|
|
|
380
|
|
|
|
|
|
|
"Syntax error near \"$val\"") |
381
|
|
|
|
|
|
|
if $c eq '' || $c eq "\n" || $c eq "\r"; |
382
|
61
|
100
|
|
|
|
119
|
if ($c eq '-') { # it is a comment. |
383
|
3
|
|
|
|
|
5
|
COMM: while (1) { |
384
|
4
|
|
66
|
|
|
9
|
1 while ($c = $s->getc) ne '' && $c ne '-' && |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
385
|
|
|
|
|
|
|
$c ne "\n" && $c ne "\r"; |
386
|
4
|
100
|
66
|
|
|
29
|
last COMM if $c eq '' || # End of file... |
|
|
|
66
|
|
|
|
|
387
|
|
|
|
|
|
|
$c eq "\n" || $c eq "\r"; # End of comment. |
388
|
2
|
|
|
|
|
5
|
$c = $s->getc; |
389
|
2
|
100
|
33
|
|
|
22
|
last COMM if $c eq '' || # End of file... |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
390
|
|
|
|
|
|
|
$c eq "\n" || $c eq "\r" || $c eq '-'; # End of comment. |
391
|
1
|
|
|
|
|
4
|
$s->ungetc; |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
# TypeReference or ModuleReference |
394
|
3
|
100
|
|
|
|
204
|
return ($TYPEMODREFERENCE, $val) |
395
|
|
|
|
|
|
|
if $val =~ m/^$ITEM_TYPEREFERENCE$/o; |
396
|
|
|
|
|
|
|
# Identifier or ValueReference |
397
|
2
|
100
|
|
|
|
29
|
return ($IDENTIFIER, $val) if $val =~ m/^$ITEM_IDENTIFIER$/o; |
398
|
1
|
50
|
33
|
|
|
27
|
return ($IDENTIFIER, $val) if $val =~ m/^$ITEM_IDENTIFIER2$/o && |
399
|
|
|
|
|
|
|
$self->{'allow_underscore'}; |
400
|
1
|
50
|
|
|
|
7
|
return ($PLUSINFINITY, $val) if $val eq 'PLUS-INFINITY'; |
401
|
0
|
0
|
|
|
|
0
|
return ($MINUSINFINITY, $val) if $val eq 'MINUS-INFINITY'; |
402
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
403
|
|
|
|
|
|
|
"Syntax error near \"$val\""); |
404
|
|
|
|
|
|
|
} |
405
|
58
|
50
|
|
|
|
161
|
$s->ungetc if $c ne ''; |
406
|
58
|
|
|
|
|
102
|
$val .= "-"; |
407
|
|
|
|
|
|
|
} |
408
|
291
|
100
|
|
|
|
749
|
if ($c !~ m/[A-Za-z0-9]/o) { |
409
|
233
|
50
|
|
|
|
602
|
$s->ungetc if $c; |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# Is it a known keyword ? |
412
|
233
|
100
|
|
|
|
631
|
return ($$keywords{$val}, $val) if defined $$keywords{$val}; |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# TypeReference/ModuleReference/MacroReference/ProductionReference/ |
415
|
|
|
|
|
|
|
# LocalTypeReference |
416
|
200
|
100
|
|
|
|
2980
|
return ($TYPEMODREFERENCE, $val) if $val =~ m/^$ITEM_TYPEREFERENCE$/o; |
417
|
|
|
|
|
|
|
# Identifier/ValueReference/LocalValueReference |
418
|
98
|
100
|
|
|
|
963
|
return ($IDENTIFIER, $val) if $val =~ m/^$ITEM_IDENTIFIER$/o; |
419
|
2
|
100
|
66
|
|
|
50
|
return ($IDENTIFIER, $val) if $val =~ m/^$ITEM_IDENTIFIER2$/o && |
420
|
|
|
|
|
|
|
$self->{'allow_underscore'}; |
421
|
1
|
50
|
|
|
|
4
|
return ($PLUSINFINITY, $val) if $val eq 'PLUS-INFINITY'; |
422
|
1
|
50
|
|
|
|
8
|
return ($MINUSINFINITY, $val) if $val eq 'MINUS-INFINITY'; |
423
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
424
|
|
|
|
|
|
|
"'$val' unrecognized"); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
} |
428
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $s->{'lineno'}, |
429
|
|
|
|
|
|
|
"'$c' unrecognized"); |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# Constructor |
433
|
|
|
|
|
|
|
sub new { |
434
|
7
|
|
|
7
|
1
|
355
|
my $this = shift; |
435
|
|
|
|
|
|
|
|
436
|
7
|
|
33
|
|
|
62
|
my $class = ref($this) || $this; |
437
|
7
|
|
|
|
|
18
|
my $self = {}; |
438
|
7
|
|
|
|
|
24
|
bless $self, $class; |
439
|
7
|
|
|
|
|
38
|
$self->initialize(); |
440
|
7
|
|
|
|
|
22
|
return $self; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# Create the MIB tree with some special nodes. |
444
|
|
|
|
|
|
|
sub initialize { |
445
|
7
|
|
|
7
|
0
|
16
|
my $self = shift; |
446
|
|
|
|
|
|
|
|
447
|
7
|
|
|
|
|
70
|
$self->{'token_list'} = []; |
448
|
7
|
|
|
|
|
41
|
$self->{'srcpath'} = []; |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
# extension of the produced files |
451
|
7
|
|
|
|
|
21
|
$self->{'dumpext'} = ".dump"; |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# '_' is not defined in the ASN.1 charset set but is sometimes found |
454
|
|
|
|
|
|
|
# in SNMP MIBs. This flag can be used to avoid parsing errors on such |
455
|
|
|
|
|
|
|
# mibs. |
456
|
7
|
|
|
|
|
20
|
$self->{'allow_underscore'} = 0; |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
# 'abfc'h is invalid (must be 'ABFC'H) but is sometimes used in SNMP MIBs. |
459
|
7
|
|
|
|
|
19
|
$self->{'allow_lowcase_hstrings'} = 0; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# '1001'b is invalid (must be '1001'B) but is sometimes used in SNMP MIBs. |
462
|
7
|
|
|
|
|
18
|
$self->{'allow_lowcase_bstrings'} = 0; |
463
|
|
|
|
|
|
|
|
464
|
7
|
|
|
|
|
19
|
$self->{'allow_keyword_any'} = 1; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# Add the 3 roots of the tree. |
467
|
|
|
|
|
|
|
# These nodes cannot be specified using valid ASN.1 clauses. |
468
|
7
|
|
|
|
|
42
|
$self->{'root'}{'ccitt'}{'oid'} = [ 0 ]; |
469
|
7
|
|
|
|
|
31
|
$self->{'root'}{'iso'}{'oid'} = [ 1 ]; |
470
|
7
|
|
|
|
|
29
|
$self->{'root'}{'joint-iso-ccitt'}{'oid'} = [ 2 ]; |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
# debug flags |
473
|
7
|
|
|
|
|
20
|
$self->{'debug_recursive'} = 0; |
474
|
7
|
|
|
|
|
18
|
$self->{'debug_lexer'} = 0; |
475
|
|
|
|
|
|
|
|
476
|
7
|
|
|
|
|
33
|
$self->{'make_dump'} = 1; |
477
|
7
|
|
|
|
|
17
|
$self->{'use_dump'} = 1; |
478
|
|
|
|
|
|
|
|
479
|
7
|
|
|
|
|
17
|
$self->{'accept_smiv1'} = 1; |
480
|
7
|
|
|
|
|
18
|
$self->{'accept_smiv2'} = 1; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# should we import dependencies ? |
483
|
7
|
|
|
|
|
31
|
$self->{'do_imports'} = 1; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub assert { |
487
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
488
|
0
|
|
|
|
|
0
|
my $level = shift; |
489
|
0
|
|
|
|
|
0
|
my $file = shift; |
490
|
0
|
|
|
|
|
0
|
my $line = shift; |
491
|
0
|
|
|
|
|
0
|
my $msg = shift; |
492
|
|
|
|
|
|
|
|
493
|
0
|
0
|
|
|
|
0
|
if (defined $level) { |
494
|
0
|
0
|
|
|
|
0
|
$self->{'msg'} = [] unless defined $self->{'msg'}; |
495
|
0
|
|
|
|
|
0
|
my ($cpackage, $cfile, $cline) = caller; |
496
|
0
|
|
|
|
|
0
|
push @{$self->{'msg'}}, { 'level' => $level, |
|
0
|
|
|
|
|
0
|
|
497
|
|
|
|
|
|
|
'file' => $file, |
498
|
|
|
|
|
|
|
'line' => $line, |
499
|
|
|
|
|
|
|
'msg' => sprintf($msg, @_), |
500
|
|
|
|
|
|
|
'cpackage' => $cpackage, |
501
|
|
|
|
|
|
|
'cfile' => $cfile, |
502
|
|
|
|
|
|
|
'cline' => $cline, |
503
|
|
|
|
|
|
|
}; |
504
|
0
|
|
|
|
|
0
|
return $level; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
else { |
507
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
508
|
0
|
|
|
|
|
0
|
return $level; |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
else { |
511
|
0
|
|
|
|
|
0
|
my $s = ""; |
512
|
0
|
0
|
|
|
|
0
|
map { |
513
|
0
|
|
|
|
|
0
|
$s .= sprintf "Error %d: %s at %s line %d.%s\n", $$_{'level'}, |
514
|
|
|
|
|
|
|
$$_{'msg'}, $$_{'file'}, $$_{'line'}, |
515
|
|
|
|
|
|
|
$DEBUG ? sprintf " [%s %d]", $$_{'cfile'}, $$_{'cline'}: ""; |
516
|
0
|
0
|
|
|
|
0
|
} @{$self->{'msg'}} if defined $self->{'msg'}; |
517
|
0
|
|
|
|
|
0
|
return $s; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
# Get the next token from the parser |
523
|
|
|
|
|
|
|
sub get_token { |
524
|
501
|
|
|
501
|
0
|
12023
|
my $self = shift; |
525
|
501
|
|
|
|
|
523
|
my $needed = shift; |
526
|
|
|
|
|
|
|
|
527
|
501
|
|
|
|
|
461
|
my ($res, $k); |
528
|
501
|
100
|
|
|
|
471
|
if (@{$self->{'token_list'}}) { |
|
501
|
|
|
|
|
1105
|
|
529
|
66
|
|
|
|
|
66
|
my $temp = shift @{$self->{'token_list'}}; |
|
66
|
|
|
|
|
104
|
|
530
|
66
|
|
|
|
|
158
|
($res, $k) = ($$temp[0], $$temp[1]); |
531
|
66
|
|
|
|
|
154
|
$self->{'lineno'} = $$temp[2]; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
else { |
534
|
435
|
|
|
|
|
747
|
($res, $k) = $self->yylex(); |
535
|
435
|
|
|
|
|
1079
|
$self->{'lineno'} = $self->{'stream'}->lineno; |
536
|
435
|
50
|
|
|
|
885
|
return unless $res; |
537
|
|
|
|
|
|
|
} |
538
|
501
|
0
|
|
|
|
1031
|
warn "DEBUG: token='" . ($res ? $$TOKEN[$res] : $res) . "' value='" . |
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
539
|
|
|
|
|
|
|
(defined $k ? $k : '') . "'\n" if $self->{'debug_lexer'}; |
540
|
501
|
50
|
66
|
|
|
1654
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
|
|
|
66
|
|
|
|
|
541
|
|
|
|
|
|
|
"'$needed' expected") |
542
|
|
|
|
|
|
|
if defined $needed && $res && $$TOKEN[$res] ne $needed; |
543
|
501
|
|
|
|
|
746
|
$self->{'current_token'} = $res; |
544
|
501
|
|
|
|
|
643
|
$self->{'current_value'} = $k; |
545
|
501
|
|
|
|
|
2217
|
($res, $k); |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
# Requeue the last token in the incoming queue. |
549
|
|
|
|
|
|
|
# WARNING: only one token can be requeued. |
550
|
|
|
|
|
|
|
sub unget_token { |
551
|
66
|
|
|
66
|
0
|
82
|
my $self = shift; |
552
|
|
|
|
|
|
|
|
553
|
66
|
50
|
|
|
|
171
|
warn "DEBUG: unshift\n" if $self->{'debug_lexer'}; |
554
|
66
|
50
|
|
|
|
127
|
if (defined $self->{'current_token'}) { |
555
|
66
|
|
|
|
|
67
|
push @{$self->{'token_list'}}, [ $self->{'current_token'}, |
|
66
|
|
|
|
|
247
|
|
556
|
|
|
|
|
|
|
$self->{'current_value'}, |
557
|
|
|
|
|
|
|
$self->{'lineno'} ]; |
558
|
66
|
|
|
|
|
180
|
$self->{'current_token'} = $self->{'current_value'} = |
559
|
|
|
|
|
|
|
$self->{'lineno'} = undef; |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
else { |
562
|
0
|
|
|
|
|
0
|
die "Error: can't unget more than one token. Abort.\n"; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
sub create_tree { |
567
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
568
|
|
|
|
|
|
|
|
569
|
0
|
|
|
|
|
0
|
for my $node (keys %{$self->{'nodes'}}) { |
|
0
|
|
|
|
|
0
|
|
570
|
0
|
|
|
|
|
0
|
my $t = $self->{'nodes'}{$node}{'oid'}; |
571
|
0
|
|
|
|
|
0
|
$self->{'tree'}{$$t[$#$t - 1]}{$$t[$#$t]} = $node; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# Compile a MIB file given its name |
576
|
|
|
|
|
|
|
sub compile { |
577
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
578
|
0
|
|
|
|
|
0
|
my $file = shift; |
579
|
|
|
|
|
|
|
|
580
|
0
|
0
|
|
|
|
0
|
croak "Error: you MUST specify a file to compile\n" unless $file; |
581
|
0
|
|
|
|
|
0
|
my $outdir = $self->repository; |
582
|
0
|
0
|
0
|
|
|
0
|
croak "Error: you MUST specify a repository\n" |
583
|
|
|
|
|
|
|
if $self->{'make_dump'} && !$outdir; |
584
|
0
|
|
|
|
|
0
|
my $filename; |
585
|
0
|
0
|
|
|
|
0
|
if ($file =~ m|/([^/]+)$|) { |
586
|
0
|
0
|
|
|
|
0
|
croak "Error: can't find $file" unless -e $file; |
587
|
0
|
|
|
|
|
0
|
$filename = $file; |
588
|
0
|
|
|
|
|
0
|
$file = $1; |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
else { |
591
|
0
|
|
0
|
|
|
0
|
my $dir = $self->{'srcpath'} || |
592
|
|
|
|
|
|
|
croak "Error: you MUST specify a path using add_path()\n"; |
593
|
0
|
|
0
|
|
|
0
|
my $ext = $self->extensions || [ '' ]; |
594
|
0
|
|
|
|
|
0
|
my $windir; |
595
|
|
|
|
|
|
|
my $extfile; |
596
|
0
|
|
|
|
|
0
|
my @dirtmp = @$dir; |
597
|
0
|
|
|
|
|
0
|
while (my $d = shift @dirtmp) { |
598
|
0
|
|
|
|
|
0
|
map { |
599
|
0
|
|
|
|
|
0
|
my $e = $_; |
600
|
|
|
|
|
|
|
# warn "testing '$d/$file$e'\n"; |
601
|
0
|
0
|
|
|
|
0
|
$windir = $d, $extfile = $e, last if -e "$d/$file$e"; |
602
|
|
|
|
|
|
|
} @$ext; |
603
|
|
|
|
|
|
|
} |
604
|
0
|
0
|
|
|
|
0
|
croak "Error: can't find $file" unless $windir; |
605
|
0
|
|
|
|
|
0
|
$filename = "$windir/$file$extfile"; |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
# push @{$self->{'filename'}}, $filename; |
608
|
0
|
|
|
|
|
0
|
$self->{'filename'} = $filename; |
609
|
|
|
|
|
|
|
# my $filename = $ {$self->{'filename'}}[$#{$self->{'filename'}}]; |
610
|
|
|
|
|
|
|
|
611
|
0
|
0
|
0
|
|
|
0
|
if ($self->{'use_dump'} && -e "$outdir/$file$self->{'dumpext'}") { |
612
|
0
|
0
|
|
|
|
0
|
if (-M $filename < -M "$outdir/$file$self->{'dumpext'}") { |
613
|
0
|
|
|
|
|
0
|
$self->assert(MIBNOTICE, $self->{'filename'}, $self->{'fileno'}, |
614
|
|
|
|
|
|
|
"$outdir/$file$self->{'dumpext'} is older than " . |
615
|
|
|
|
|
|
|
"$filename. Recompiling $filename..."); |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
else { |
618
|
0
|
|
|
|
|
0
|
my $v; |
619
|
0
|
|
|
|
|
0
|
my $fh = new FileHandle "$outdir/$file$self->{'dumpext'}"; |
620
|
0
|
0
|
|
|
|
0
|
if (defined $fh) { |
621
|
0
|
|
|
|
|
0
|
local $/ = undef; |
622
|
0
|
|
|
|
|
0
|
$v = eval <$fh>; |
623
|
0
|
0
|
|
|
|
0
|
if ($v) { |
624
|
0
|
|
|
|
|
0
|
map { $self->{'nodes'}{$_} = $$v{'nodes'}{$_} } keys %{$$v{'nodes'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
625
|
0
|
|
|
|
|
0
|
map { $self->{'types'}{$_} = $$v{'types'}{$_} } keys %{$$v{'types'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
626
|
0
|
|
|
|
|
0
|
for my $node (keys %{$$v{'tree'}}) { |
|
0
|
|
|
|
|
0
|
|
627
|
0
|
|
|
|
|
0
|
for my $son (keys %{$$v{'tree'}{$node}}) { |
|
0
|
|
|
|
|
0
|
|
628
|
0
|
|
|
|
|
0
|
$self->{'tree'}{$node}{$son} = $$v{'tree'}{$node}{$son}; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
0
|
|
|
|
|
0
|
map { $self->{'traps'}{$_} = $$v{'traps'}{$_} } keys %{$$v{'traps'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
632
|
0
|
|
|
|
|
0
|
map { push @{$self->{'macros'}}, $_ } @{$$v{'macros'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
633
|
|
|
|
|
|
|
} |
634
|
0
|
|
|
|
|
0
|
$fh->close; |
635
|
|
|
|
|
|
|
} |
636
|
0
|
0
|
|
|
|
0
|
return $self if $v; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
# open the MIB file |
641
|
0
|
|
|
|
|
0
|
my $fh = new FileHandle $filename; |
642
|
0
|
0
|
|
|
|
0
|
unless (defined $fh) { |
643
|
0
|
|
|
|
|
0
|
croak "Error: can't open $filename: $!\n"; |
644
|
0
|
|
|
|
|
0
|
return; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
# create a new MIB object |
647
|
0
|
|
|
|
|
0
|
my $mib = new SNMP::MIB::Compiler; |
648
|
0
|
|
|
|
|
0
|
$mib->{'filename'} = $filename; |
649
|
0
|
|
|
|
|
0
|
$mib->repository($self->repository); |
650
|
0
|
|
|
|
|
0
|
$mib->extensions($self->extensions); |
651
|
0
|
|
|
|
|
0
|
$mib->{'srcpath'} = $self->{'srcpath'}; |
652
|
0
|
0
|
|
|
|
0
|
push @{$mib->{'msg'}}, @{$self->{'msg'}} if defined $self->{'msg'}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
653
|
|
|
|
|
|
|
|
654
|
0
|
|
|
|
|
0
|
$mib->{'make_dump'} = $self->{'make_dump'}; |
655
|
0
|
|
|
|
|
0
|
$mib->{'use_dump'} = $self->{'use_dump'}; |
656
|
0
|
|
|
|
|
0
|
$mib->{'do_imports'} = $self->{'do_imports'}; |
657
|
|
|
|
|
|
|
|
658
|
0
|
|
|
|
|
0
|
$mib->{'allow_underscore'} = $self->{'allow_underscore'}; |
659
|
0
|
|
|
|
|
0
|
$mib->{'allow_lowcase_hstrings'} = $self->{'allow_lowcase_hstrings'}; |
660
|
0
|
|
|
|
|
0
|
$mib->{'allow_lowcase_bstrings'} = $self->{'allow_lowcase_bstrings'}; |
661
|
|
|
|
|
|
|
|
662
|
0
|
0
|
|
|
|
0
|
if ($self->{'debug_recursive'}) { |
663
|
0
|
|
|
|
|
0
|
$mib->{'debug_recursive'} = $self->{'debug_recursive'}; |
664
|
0
|
|
|
|
|
0
|
$mib->{'debug_lexer'} = $self->{'debug_lexer'}; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
# create a stream |
667
|
0
|
|
|
|
|
0
|
my $s = Stream->new($fh); |
668
|
0
|
|
|
|
|
0
|
$mib->{'stream'} = $s; |
669
|
|
|
|
|
|
|
# parse the MIB |
670
|
0
|
|
|
|
|
0
|
my $r = $mib->parse_Module(); |
671
|
0
|
0
|
|
|
|
0
|
push @{$self->{'msg'}}, @{$mib->{'msg'}} if defined $mib->{'msg'}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
# destroy the stream |
674
|
0
|
|
|
|
|
0
|
delete $mib->{'stream'}; |
675
|
|
|
|
|
|
|
# close the file |
676
|
0
|
|
|
|
|
0
|
$fh->close; |
677
|
0
|
0
|
|
|
|
0
|
return undef unless $r; |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
# Create the MIB 'tree' |
680
|
0
|
|
|
|
|
0
|
$mib->create_tree(); |
681
|
|
|
|
|
|
|
|
682
|
0
|
0
|
|
|
|
0
|
if ($self->{'make_dump'}) { |
683
|
0
|
|
|
|
|
0
|
local $Data::Dumper::Purity = 1; |
684
|
0
|
|
|
|
|
0
|
local $Data::Dumper::Indent = 1; |
685
|
0
|
|
|
|
|
0
|
local $Data::Dumper::Terse = 1; |
686
|
|
|
|
|
|
|
|
687
|
0
|
|
|
|
|
0
|
my $file = $mib->{'name'}; |
688
|
0
|
|
|
|
|
0
|
my $fh = new FileHandle "> $outdir/$file$self->{'dumpext'}"; |
689
|
0
|
0
|
|
|
|
0
|
if (defined $fh) { |
690
|
0
|
|
|
|
|
0
|
print $fh "## Compiled by SNMP::MIB::Compiler version $VERSION\n" . |
691
|
|
|
|
|
|
|
"## Source: $filename\n" . |
692
|
|
|
|
|
|
|
"## Date: " . (scalar localtime (time)) ."\n\n"; |
693
|
0
|
|
|
|
|
0
|
print $fh Dumper { 'nodes' => $mib->{'nodes'}, |
694
|
|
|
|
|
|
|
'types' => $mib->{'types'}, |
695
|
|
|
|
|
|
|
'macros' => $mib->{'macros'}, |
696
|
|
|
|
|
|
|
'tree' => $mib->{'tree'}, |
697
|
|
|
|
|
|
|
'traps' => $mib->{'traps'}, |
698
|
|
|
|
|
|
|
'version' => $VERSION, |
699
|
|
|
|
|
|
|
}; |
700
|
0
|
|
|
|
|
0
|
$fh->close; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
else { |
703
|
0
|
|
|
|
|
0
|
croak "Warning: can't create dump $outdir/$file$self->{'dumpext'}" . |
704
|
|
|
|
|
|
|
": $!\n"; |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
# insert this MIB into the current object |
708
|
0
|
|
|
|
|
0
|
map { $self->{'nodes'}{$_} = $mib->{'nodes'}{$_} } keys %{$mib->{'nodes'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
709
|
0
|
|
|
|
|
0
|
map { $self->{'types'}{$_} = $mib->{'types'}{$_} } keys %{$mib->{'types'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
710
|
0
|
|
|
|
|
0
|
map { $self->{'traps'}{$_} = $mib->{'traps'}{$_} } keys %{$mib->{'traps'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
711
|
0
|
|
|
|
|
0
|
map { push @{$self->{'macros'}}, $_ } @{$mib->{'macros'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
712
|
|
|
|
|
|
|
|
713
|
0
|
|
|
|
|
0
|
for my $node (keys %{$mib->{'tree'}}) { |
|
0
|
|
|
|
|
0
|
|
714
|
0
|
|
|
|
|
0
|
for my $son (keys %{$self->{'tree'}{$node}}) { |
|
0
|
|
|
|
|
0
|
|
715
|
0
|
|
|
|
|
0
|
$self->{'tree'}{$node}{$son} = $mib->{'tree'}{$node}{$son}; |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
} |
718
|
0
|
|
|
|
|
0
|
$self->create_tree(); |
719
|
0
|
|
|
|
|
0
|
$self; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
sub load { |
723
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
724
|
0
|
|
|
|
|
0
|
my $file = shift; |
725
|
|
|
|
|
|
|
|
726
|
0
|
0
|
|
|
|
0
|
croak "Error: you MUST specify a MIB to load\n" unless $file; |
727
|
0
|
|
|
|
|
0
|
my $outdir = $self->repository; |
728
|
0
|
0
|
|
|
|
0
|
die "Error: you MUST specify a repository\n" unless $outdir; |
729
|
0
|
0
|
0
|
|
|
0
|
if ($self->{'use_dump'} && -e "$outdir/$file$self->{'dumpext'}") { |
730
|
0
|
|
|
|
|
0
|
my $v; |
731
|
0
|
|
|
|
|
0
|
my $fh = new FileHandle "$outdir/$file$self->{'dumpext'}"; |
732
|
0
|
0
|
|
|
|
0
|
if (defined $fh) { |
733
|
0
|
|
|
|
|
0
|
local $/ = undef; |
734
|
0
|
|
|
|
|
0
|
$v = eval <$fh>; |
735
|
0
|
0
|
|
|
|
0
|
if ($v) { |
736
|
0
|
|
|
|
|
0
|
map { $self->{'nodes'}{$_} = $$v{'nodes'}{$_} } keys %{$$v{'nodes'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
737
|
0
|
|
|
|
|
0
|
map { $self->{'types'}{$_} = $$v{'types'}{$_} } keys %{$$v{'types'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
738
|
0
|
|
|
|
|
0
|
map { $self->{'traps'}{$_} = $$v{'traps'}{$_} } keys %{$$v{'traps'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
739
|
0
|
|
|
|
|
0
|
for my $node (keys %{$$v{'tree'}}) { |
|
0
|
|
|
|
|
0
|
|
740
|
0
|
|
|
|
|
0
|
for my $son (keys %{$$v{'tree'}{$node}}) { |
|
0
|
|
|
|
|
0
|
|
741
|
0
|
|
|
|
|
0
|
$self->{'tree'}{$node}{$son} = $$v{'tree'}{$node}{$son}; |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
} |
744
|
0
|
|
|
|
|
0
|
map { push @{$self->{'macros'}}, $_ } @{$$v{'macros'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
745
|
|
|
|
|
|
|
} |
746
|
0
|
|
|
|
|
0
|
$fh->close; |
747
|
|
|
|
|
|
|
} |
748
|
0
|
|
|
|
|
0
|
1; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
else { |
751
|
0
|
0
|
|
|
|
0
|
$self->assert(MIBWARN, $self->{'filename'}, $self->{'lineno'}, |
752
|
|
|
|
|
|
|
"can't find precompiled $file. Ignored\n") if $self->{'debug_lexer'}; |
753
|
0
|
|
|
|
|
0
|
0; |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
sub parse_Module { |
758
|
2
|
|
|
2
|
0
|
15
|
my $self = shift; |
759
|
2
|
|
|
|
|
6
|
my ($token, $mibname, $value); |
760
|
|
|
|
|
|
|
# ModuleIdentifier |
761
|
2
|
50
|
|
|
|
16
|
(($token, $mibname) = $self->get_token('TYPEMODREFERENCE')) || return; |
762
|
2
|
|
|
|
|
6
|
$self->{'name'} = $mibname; |
763
|
2
|
50
|
|
|
|
7
|
$self->get_token('DEFINITIONS') || return; |
764
|
2
|
50
|
|
|
|
7
|
$self->get_token('ASSIGNMENT') || return; |
765
|
2
|
50
|
|
|
|
7
|
$self->get_token('BEGIN') || return; |
766
|
2
|
50
|
|
|
|
7
|
(($token, $value) = $self->get_token()) || return; |
767
|
2
|
|
66
|
|
|
18
|
while ($token && $token != $END) { |
768
|
2
|
50
|
|
|
|
15
|
if ($token == $IMPORTS) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
769
|
0
|
|
|
|
|
0
|
$self->{'imports'} = $self->parse_imports(); |
770
|
0
|
0
|
|
|
|
0
|
$self->import_modules() if $self->{'do_imports'}; |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
elsif ($token == $EXPORTS) { |
773
|
0
|
|
|
|
|
0
|
$self->{'exports'} = $self->parse_exports(); |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
elsif ($token == $IDENTIFIER) { |
776
|
2
|
|
|
|
|
5
|
my $assign = $value; |
777
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
778
|
2
|
50
|
|
|
|
9
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
779
|
|
|
|
|
|
|
"Syntax error") unless $token; |
780
|
2
|
50
|
|
|
|
12
|
if ($token == $OBJECT) { # probably an OBJECT IDENTIFIER |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
781
|
0
|
0
|
|
|
|
0
|
$self->get_token('IDENTIFIER') || return; |
782
|
0
|
0
|
|
|
|
0
|
$self->get_token('ASSIGNMENT') || return; |
783
|
0
|
|
|
|
|
0
|
my $oid = $self->parse_oid(); |
784
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign}{'oid'} = $oid; |
785
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign}{'type'} = 'OBJECT IDENTIFIER'; |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
elsif ($token == $INTEGER) { |
788
|
0
|
0
|
|
|
|
0
|
$self->get_token('ASSIGNMENT') || return; |
789
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
790
|
0
|
|
|
|
|
0
|
$self->{'constants'}{$assign}{'value'} = $value; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
elsif ($value eq 'OBJECT-TYPE') { |
793
|
2
|
|
50
|
|
|
12
|
$self->{'nodes'}{$assign} = $self->parse_objecttype() || return; |
794
|
|
|
|
|
|
|
# return undef unless $self->{'nodes'}{$assign}; |
795
|
2
|
|
|
|
|
15
|
$self->{'nodes'}{$assign}{'type'} = 'OBJECT-TYPE'; |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
elsif ($value eq 'OBJECT-IDENTITY') { |
798
|
0
|
0
|
|
|
|
0
|
$self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
799
|
|
|
|
|
|
|
"Syntax error at '$value'") unless $self->{'accept_smiv2'}; |
800
|
0
|
|
0
|
|
|
0
|
$self->{'nodes'}{$assign} = $self->parse_objectidentity() || return; |
801
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign}{'type'} = 'OBJECT-IDENTITY'; |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
elsif ($value eq 'MODULE-IDENTITY') { |
804
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
805
|
|
|
|
|
|
|
"Syntax error at '$value'") |
806
|
|
|
|
|
|
|
unless $self->{'accept_smiv2'}; |
807
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign} = $self->parse_moduleidentity(); |
808
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign}{'type'} = 'MODULE-IDENTITY'; |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
elsif ($value eq 'MODULE-COMPLIANCE') { |
811
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
812
|
|
|
|
|
|
|
"Syntax error at '$value'") |
813
|
|
|
|
|
|
|
unless $self->{'accept_smiv2'}; |
814
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign} = $self->parse_modulecompliance(); |
815
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign}{'type'} = 'MODULE-COMPLIANCE'; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
elsif ($value eq 'OBJECT-GROUP') { |
818
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
819
|
|
|
|
|
|
|
"Syntax error at '$value'") |
820
|
|
|
|
|
|
|
unless $self->{'accept_smiv2'}; |
821
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign} = $self->parse_objectgroup(); |
822
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign}{'type'} = 'OBJECT-GROUP'; |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
elsif ($value eq 'NOTIFICATION-GROUP') { |
825
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
826
|
|
|
|
|
|
|
"Syntax error at '$value'") |
827
|
|
|
|
|
|
|
unless $self->{'accept_smiv2'}; |
828
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign} = $self->parse_notificationgroup(); |
829
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign}{'type'} = 'NOTIFICATION-GROUP'; |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
elsif ($value eq 'AGENT-CAPABILITIES') { |
832
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
833
|
|
|
|
|
|
|
"Syntax error at '$value'") |
834
|
|
|
|
|
|
|
unless $self->{'accept_smiv2'}; |
835
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign} = $self->parse_agentcapabilities(); |
836
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$assign}{'type'} = 'AGENT-CAPABILITIES'; |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
elsif ($value eq 'TRAP-TYPE') { |
839
|
|
|
|
|
|
|
# as defined in RFC 1215 |
840
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
841
|
|
|
|
|
|
|
"Syntax error at '$value'") |
842
|
|
|
|
|
|
|
unless $self->{'accept_smiv1'}; |
843
|
0
|
|
|
|
|
0
|
$self->{'traps'}{$assign} = $self->parse_traptype(); |
844
|
0
|
|
|
|
|
0
|
$self->{'traps'}{$assign}{'type'} = 'TRAP-TYPE'; |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
elsif ($value eq 'NOTIFICATION-TYPE') { |
847
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
848
|
|
|
|
|
|
|
"Syntax error at '$value'") |
849
|
|
|
|
|
|
|
unless $self->{'accept_smiv2'}; |
850
|
0
|
|
|
|
|
0
|
$self->{'traps'}{$assign} = $self->parse_notificationtype(); |
851
|
0
|
|
|
|
|
0
|
$self->{'traps'}{$assign}{'type'} = 'NOTIFICATION-TYPE'; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
else { |
854
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
855
|
|
|
|
|
|
|
"Syntax error at '$value'"); |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
elsif ($token == $TYPEMODREFERENCE) { |
859
|
0
|
|
|
|
|
0
|
my $label = $value; |
860
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
861
|
0
|
0
|
|
|
|
0
|
if ($token == $ASSIGNMENT) { |
|
|
0
|
|
|
|
|
|
862
|
0
|
|
|
|
|
0
|
my $type = $self->parse_type(); |
863
|
|
|
|
|
|
|
# warn "Warning: type '$label' already defined" |
864
|
|
|
|
|
|
|
# if defined $self->{'types'}{$label}; |
865
|
0
|
|
|
|
|
0
|
$self->{'types'}{$label} = $type; |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
elsif ($token == $MACRO) { |
868
|
|
|
|
|
|
|
# Skip this beast.. |
869
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('ASSIGNMENT')) || return; |
870
|
0
|
|
0
|
|
|
0
|
while ($token && $token != $END) { |
871
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
872
|
|
|
|
|
|
|
} |
873
|
0
|
|
|
|
|
0
|
push @{$self->{'macros'}}, $label; |
|
0
|
|
|
|
|
0
|
|
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
else { |
876
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
877
|
|
|
|
|
|
|
"unrecognized syntax '$value' ($$TOKEN[$token])..."); |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
else { |
881
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
882
|
|
|
|
|
|
|
"received an unknown token ($$TOKEN[$token])"); |
883
|
|
|
|
|
|
|
} |
884
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
885
|
|
|
|
|
|
|
} |
886
|
2
|
50
|
|
|
|
10
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
887
|
|
|
|
|
|
|
"'END' expected") unless $token == $END; |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
# Given a type, this will return the corresponding SMI (v2 or v1) type |
891
|
|
|
|
|
|
|
# or the corresponding ASN.1 type. |
892
|
|
|
|
|
|
|
sub resolve_type { |
893
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
894
|
0
|
|
|
|
|
0
|
my $type = shift; |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
# a basic ASN.1 type. |
897
|
0
|
0
|
|
|
|
0
|
return $type if $type =~ m/^(SEQUENCE|CHOICE|INTEGER|OCTET\ STRING| |
898
|
|
|
|
|
|
|
OBJECT\ IDENTIFIER|NULL)$/ox; |
899
|
|
|
|
|
|
|
# SMIv1 type |
900
|
0
|
0
|
|
|
|
0
|
return $type if $type =~ m/^(IpAddress|Counter|Gauge|TimeTicks|Opaque)$/o; |
901
|
|
|
|
|
|
|
# SMIv2 type |
902
|
0
|
0
|
|
|
|
0
|
return $type if $type =~ m/^(Integer32|Counter32|Gauge32|Unsigned32| |
903
|
|
|
|
|
|
|
Counter64)$/ox; |
904
|
0
|
0
|
|
|
|
0
|
defined $self->{'types'}{$type} ? |
|
|
0
|
|
|
|
|
|
905
|
|
|
|
|
|
|
defined $self->{'types'}{$type}{'syntax'} ? |
906
|
|
|
|
|
|
|
$self->{'types'}{$type}{'syntax'}{'type'} : |
907
|
|
|
|
|
|
|
$self->{'types'}{$type}{'type'} : $type; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
sub resolve_oid { |
911
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
912
|
0
|
|
|
|
|
0
|
my $node = shift; |
913
|
|
|
|
|
|
|
|
914
|
0
|
0
|
|
|
|
0
|
return $node unless defined $node; # no node |
915
|
0
|
|
|
|
|
0
|
return $node unless defined $self->{'nodes'}{$node} && |
916
|
0
|
|
|
|
|
0
|
scalar keys %{$self->{'nodes'}{$node}} || |
917
|
|
|
|
|
|
|
defined $self->{'root'}{$node} && |
918
|
0
|
0
|
0
|
|
|
0
|
scalar keys %{$self->{'root'}{$node}}; # no such node |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
919
|
|
|
|
|
|
|
# copy the OID if needed |
920
|
0
|
0
|
0
|
|
|
0
|
if (defined $self->{'nodes'}{$node}{'oid'} && |
921
|
|
|
|
|
|
|
!defined $self->{'nodes'}{$node}{'OID'}) { |
922
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$node}{'OID'} = []; |
923
|
0
|
|
|
|
|
0
|
@{$self->{'nodes'}{$node}{'OID'}} = @{$self->{'nodes'}{$node}{'oid'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
924
|
|
|
|
|
|
|
} |
925
|
0
|
|
0
|
|
|
0
|
my $list = $self->{'nodes'}{$node}{'OID'} || |
926
|
|
|
|
|
|
|
$self->{'root'}{$node}{'oid'}; |
927
|
0
|
|
0
|
|
|
0
|
while (defined $self->{'nodes'}{$$list[0]} || |
928
|
|
|
|
|
|
|
defined $self->{'root'}{$$list[0]}) { |
929
|
|
|
|
|
|
|
# copy the OID if needed |
930
|
0
|
0
|
0
|
|
|
0
|
if (defined $self->{'nodes'}{$$list[0]} && |
|
|
|
0
|
|
|
|
|
931
|
|
|
|
|
|
|
defined $self->{'nodes'}{$$list[0]}{'oid'} && |
932
|
|
|
|
|
|
|
!defined $self->{'nodes'}{$$list[0]}{'OID'}) { |
933
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$$list[0]}{'OID'} = []; |
934
|
0
|
|
|
|
|
0
|
@{$self->{'nodes'}{$$list[0]}{'OID'}} = |
|
0
|
|
|
|
|
0
|
|
935
|
0
|
|
|
|
|
0
|
@{$self->{'nodes'}{$$list[0]}{'oid'}}; |
936
|
|
|
|
|
|
|
} |
937
|
0
|
|
|
|
|
0
|
my @l = @$list; |
938
|
0
|
0
|
|
|
|
0
|
if (defined $self->{'nodes'}{$$list[0]}) { |
939
|
0
|
|
|
|
|
0
|
my $eq = 1; |
940
|
0
|
0
|
|
|
|
0
|
if ($#{$self->{'nodes'}{$$list[0]}{'OID'}} == |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
941
|
|
|
|
|
|
|
$#{$self->{'nodes'}{$$list[0]}{'oid'}}) { |
942
|
0
|
|
|
|
|
0
|
my $i = -1; |
943
|
0
|
|
|
|
|
0
|
for (@{$self->{'nodes'}{$$list[0]}{'OID'}}) { |
|
0
|
|
|
|
|
0
|
|
944
|
0
|
|
|
|
|
0
|
$i++; |
945
|
0
|
|
|
|
|
0
|
$eq = 0, last unless $ {$self->{'nodes'}{$$list[0]}{'OID'}}[$i] |
|
0
|
|
|
|
|
0
|
|
946
|
0
|
0
|
|
|
|
0
|
eq $ {$self->{'nodes'}{$$list[0]}{'oid'}}[$i]; |
947
|
|
|
|
|
|
|
} |
948
|
0
|
0
|
|
|
|
0
|
unless ($eq) { |
949
|
0
|
|
|
|
|
0
|
my @a = @{$self->{'nodes'}{$$list[0]}{'oid'}}; |
|
0
|
|
|
|
|
0
|
|
950
|
0
|
|
|
|
|
0
|
my @l = @{$self->{'nodes'}{$$list[0]}{'OID'}}; |
|
0
|
|
|
|
|
0
|
|
951
|
0
|
|
|
|
|
0
|
shift @l; |
952
|
0
|
|
|
|
|
0
|
my $last = pop @l; |
953
|
0
|
|
|
|
|
0
|
for my $elem (@l) { |
954
|
0
|
0
|
|
|
|
0
|
last unless $elem =~ m/^\d+$/o; |
955
|
0
|
|
|
|
|
0
|
my $o = shift @a; |
956
|
0
|
|
|
|
|
0
|
$self->{'tree'}{$o}{$elem} = $a[0]; |
957
|
|
|
|
|
|
|
} |
958
|
0
|
0
|
|
|
|
0
|
$self->{'tree'}{$a[0]}{$last} = $node if scalar @a == 1; |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
} |
961
|
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
splice @$list, 0, 1, defined $self->{'nodes'}{$$list[0]} && |
963
|
0
|
|
|
|
|
0
|
scalar keys %{$self->{'nodes'}{$$list[0]}} ? |
964
|
0
|
|
|
|
|
0
|
@{$self->{'nodes'}{$$list[0]}{'OID'}} : |
965
|
0
|
0
|
0
|
|
|
0
|
@{$self->{'root'}{$$list[0]}{'oid'}}; |
966
|
|
|
|
|
|
|
} |
967
|
0
|
|
|
|
|
0
|
for my $l (@$list) { |
968
|
0
|
0
|
|
|
|
0
|
if (defined $self->{'nodes'}{$l}) { |
969
|
|
|
|
|
|
|
# copy the OID if needed |
970
|
0
|
0
|
0
|
|
|
0
|
if (defined $self->{'nodes'}{$l} && |
|
|
|
0
|
|
|
|
|
971
|
|
|
|
|
|
|
defined $self->{'nodes'}{$l}{'oid'} && |
972
|
|
|
|
|
|
|
!defined $self->{'nodes'}{$l}{'OID'}) { |
973
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$l}{'OID'} = []; |
974
|
0
|
|
|
|
|
0
|
@{$self->{'nodes'}{$l}{'OID'}} = @{$self->{'nodes'}{$l}{'oid'}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
975
|
|
|
|
|
|
|
} |
976
|
0
|
|
|
|
|
0
|
my @t = @{$self->{'nodes'}{$l}{'OID'}}; |
|
0
|
|
|
|
|
0
|
|
977
|
0
|
|
|
|
|
0
|
$l = $t[$#t]; |
978
|
|
|
|
|
|
|
} |
979
|
0
|
0
|
|
|
|
0
|
if (defined $self->{'root'}{$l}) { |
980
|
0
|
|
|
|
|
0
|
my @t = @{$self->{'root'}{$l}{'OID'}}; |
|
0
|
|
|
|
|
0
|
|
981
|
0
|
|
|
|
|
0
|
$l = $t[$#t]; |
982
|
|
|
|
|
|
|
} |
983
|
|
|
|
|
|
|
} |
984
|
0
|
|
|
|
|
0
|
join '.', @$list; |
985
|
|
|
|
|
|
|
} |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
sub convert_oid { |
988
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
989
|
0
|
|
|
|
|
0
|
my $oid = shift; |
990
|
|
|
|
|
|
|
|
991
|
0
|
|
|
|
|
0
|
my @l = split /\./, $oid; |
992
|
0
|
|
|
|
|
0
|
my @r; |
993
|
0
|
|
|
|
|
0
|
my $node = $l[0]; |
994
|
0
|
|
|
|
|
0
|
for my $id (keys %{$self->{'root'}}) { |
|
0
|
|
|
|
|
0
|
|
995
|
0
|
0
|
|
|
|
0
|
last unless $l[0] =~ m/^\d+$/o; |
996
|
0
|
0
|
|
|
|
0
|
$node = $id, last if $l[0] == $self->{'root'}{$id}{'oid'}[0]; |
997
|
|
|
|
|
|
|
} |
998
|
0
|
|
|
|
|
0
|
shift @l; |
999
|
0
|
|
|
|
|
0
|
push @r, $node; |
1000
|
0
|
|
|
|
|
0
|
while (my $elem = shift @l) { |
1001
|
0
|
0
|
|
|
|
0
|
push (@r, $elem), last unless defined $self->{'tree'}{$node}{$elem}; |
1002
|
0
|
|
|
|
|
0
|
push @r, $self->{'tree'}{$node}{$elem}; |
1003
|
0
|
|
|
|
|
0
|
$node = $self->{'tree'}{$node}{$elem}; |
1004
|
|
|
|
|
|
|
} |
1005
|
0
|
|
|
|
|
0
|
join '.', @r, @l; |
1006
|
|
|
|
|
|
|
} |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
sub parse_one { |
1009
|
30
|
|
|
30
|
0
|
36
|
my $self = shift; |
1010
|
|
|
|
|
|
|
|
1011
|
30
|
50
|
|
|
|
74
|
warn "DEBUG: Parsing one item...\n" if $self->{'debug_lexer'}; |
1012
|
|
|
|
|
|
|
# 1 |
1013
|
|
|
|
|
|
|
# -1..3 |
1014
|
|
|
|
|
|
|
# foo |
1015
|
|
|
|
|
|
|
# foo..bar |
1016
|
30
|
50
|
|
|
|
50
|
(my ($token, $value) = $self->get_token()) || return; |
1017
|
30
|
50
|
|
|
|
77
|
if ($value eq '-') { # a negative value ? |
1018
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1019
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1020
|
|
|
|
|
|
|
"\"$value\" must be an integer") unless $token == $NUMBER; |
1021
|
0
|
|
|
|
|
0
|
$value = "-$value"; |
1022
|
|
|
|
|
|
|
} |
1023
|
30
|
|
|
|
|
37
|
my $val = $value; |
1024
|
30
|
50
|
|
|
|
67
|
(($token, $value) = $self->get_token()) || return; |
1025
|
30
|
100
|
|
|
|
68
|
if ($value eq '.') { |
1026
|
8
|
50
|
|
|
|
29
|
$self->get_token('.') || return; # range |
1027
|
8
|
50
|
|
|
|
22
|
(($token, $value) = $self->get_token()) || return; |
1028
|
8
|
50
|
|
|
|
27
|
if ($value eq '-') { # a negative value ? |
1029
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1030
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1031
|
|
|
|
|
|
|
"\"$value\" must be an integer") unless $token == $NUMBER; |
1032
|
0
|
|
|
|
|
0
|
$value = "-$value"; |
1033
|
|
|
|
|
|
|
} |
1034
|
8
|
|
|
|
|
38
|
$val = { 'range' => { 'min' => $val, 'max' => $value } }; |
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
else { |
1037
|
22
|
|
|
|
|
51
|
$self->unget_token(); |
1038
|
|
|
|
|
|
|
} |
1039
|
30
|
|
|
|
|
67
|
$val; |
1040
|
|
|
|
|
|
|
} |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
sub parse_subtype { |
1043
|
33
|
|
|
33
|
0
|
2551
|
my $self = shift; |
1044
|
|
|
|
|
|
|
|
1045
|
33
|
50
|
|
|
|
79
|
warn "DEBUG: Parsing a sub-type...\n" if $self->{'debug_lexer'}; |
1046
|
33
|
50
|
|
|
|
92
|
(my ($token, $value) = $self->get_token()) || return; |
1047
|
33
|
100
|
66
|
|
|
185
|
if ($token && $value eq '(') { |
|
|
100
|
66
|
|
|
|
|
1048
|
22
|
50
|
|
|
|
50
|
(($token, $value) = $self->get_token()) || return; |
1049
|
22
|
100
|
|
|
|
53
|
if ($token == $SIZE) { |
1050
|
1
|
|
|
|
|
7
|
my $subtype = $self->parse_subtype(); |
1051
|
1
|
50
|
|
|
|
4
|
return unless $subtype; |
1052
|
1
|
50
|
|
|
|
3
|
$self->get_token(')') || return; |
1053
|
1
|
|
|
|
|
6
|
return { 'size' => $subtype }; |
1054
|
|
|
|
|
|
|
} |
1055
|
|
|
|
|
|
|
else { |
1056
|
21
|
|
|
|
|
48
|
$self->unget_token(); |
1057
|
21
|
|
|
|
|
24
|
my $list; |
1058
|
21
|
|
|
|
|
56
|
while ($value ne ')') { |
1059
|
30
|
|
|
|
|
70
|
my $v = $self->parse_one(); |
1060
|
30
|
50
|
|
|
|
67
|
return unless defined $v; |
1061
|
30
|
|
|
|
|
57
|
push @$list, $v; |
1062
|
30
|
50
|
|
|
|
65
|
(($token, $value) = $self->get_token()) || return; |
1063
|
30
|
50
|
66
|
|
|
149
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1064
|
|
|
|
|
|
|
"\"$value\" must be ')' or '|'") |
1065
|
|
|
|
|
|
|
unless $value eq ')' || $value eq '|'; |
1066
|
|
|
|
|
|
|
} |
1067
|
|
|
|
|
|
|
# return scalar @$list == 1 ? { 'value' => $$list[0] } : |
1068
|
|
|
|
|
|
|
# { 'choice' => $list }; |
1069
|
21
|
100
|
|
|
|
94
|
return scalar @$list == 1 ? $$list[0] : { 'choice' => $list }; |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
} |
1072
|
|
|
|
|
|
|
elsif ($token && $value eq '{') { |
1073
|
8
|
|
|
|
|
15
|
my $list = {}; |
1074
|
8
|
|
|
|
|
339
|
while ($value ne '}') { |
1075
|
11
|
50
|
|
|
|
30
|
(($token, $value) = $self->get_token()) || return; |
1076
|
11
|
50
|
|
|
|
26
|
if ($token == $IDENTIFIER) { |
1077
|
11
|
|
|
|
|
48
|
my $res = $self->parse_subtype(); |
1078
|
11
|
50
|
|
|
|
29
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1079
|
|
|
|
|
|
|
"must have a subtype") unless defined $res; |
1080
|
11
|
|
|
|
|
41
|
$$list{$res} = $value; |
1081
|
|
|
|
|
|
|
} |
1082
|
|
|
|
|
|
|
else { |
1083
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1084
|
|
|
|
|
|
|
"should be an identifier"); |
1085
|
|
|
|
|
|
|
} |
1086
|
11
|
50
|
|
|
|
27
|
(($token, $value) = $self->get_token()) || return; |
1087
|
11
|
50
|
66
|
|
|
53
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1088
|
|
|
|
|
|
|
"must be a '}' or a ',' instead of '$value'") |
1089
|
|
|
|
|
|
|
unless $value eq '}' || $value eq ','; |
1090
|
|
|
|
|
|
|
} |
1091
|
8
|
|
|
|
|
38
|
return { 'values' => $list }; |
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
else { |
1094
|
3
|
|
|
|
|
9
|
$self->unget_token(); |
1095
|
|
|
|
|
|
|
} |
1096
|
|
|
|
|
|
|
} |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
# parse a type (SYNTAX field of an OBJECT-TYPE, TC) |
1099
|
|
|
|
|
|
|
sub parse_type { |
1100
|
10
|
|
|
10
|
0
|
15
|
my $self = shift; |
1101
|
|
|
|
|
|
|
|
1102
|
10
|
50
|
|
|
|
31
|
warn "DEBUG: Parsing a type...\n" if $self->{'debug_lexer'}; |
1103
|
10
|
50
|
|
|
|
26
|
(my ($token, $value) = $self->get_token()) || return; |
1104
|
10
|
50
|
0
|
|
|
37
|
if ($token == $IMPLICIT) { # implicit types |
|
|
50
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1105
|
0
|
|
|
|
|
0
|
my $type = $self->parse_type(); |
1106
|
0
|
|
|
|
|
0
|
my $ref = ref $type; |
1107
|
0
|
0
|
0
|
|
|
0
|
if (defined $ref && $ref eq 'HASH') { |
1108
|
0
|
|
|
|
|
0
|
$$type{'implicit'} = 'true'; |
1109
|
0
|
|
|
|
|
0
|
return $type; |
1110
|
|
|
|
|
|
|
} |
1111
|
|
|
|
|
|
|
else { |
1112
|
0
|
|
|
|
|
0
|
return { 'implicit' => 'true', |
1113
|
|
|
|
|
|
|
'type' => $type }; |
1114
|
|
|
|
|
|
|
} |
1115
|
|
|
|
|
|
|
} |
1116
|
|
|
|
|
|
|
elsif ($token == $INTEGER) { # integers |
1117
|
10
|
|
|
|
|
17
|
my $type = "INTEGER"; |
1118
|
10
|
|
|
|
|
35
|
my $subtype = $self->parse_subtype(); # what if parse_subtype failed ??? |
1119
|
10
|
|
|
|
|
25
|
my $ref = ref $subtype; |
1120
|
10
|
100
|
66
|
|
|
62
|
if (defined $ref && $ref eq 'HASH') { |
1121
|
9
|
|
|
|
|
22
|
$$subtype{'type'} = $type; |
1122
|
9
|
|
|
|
|
22
|
return $subtype; |
1123
|
|
|
|
|
|
|
} |
1124
|
|
|
|
|
|
|
else { |
1125
|
1
|
50
|
|
|
|
4
|
if (defined $subtype) { |
1126
|
0
|
|
|
|
|
0
|
return { 'values' => $subtype, |
1127
|
|
|
|
|
|
|
'type' => $type }; |
1128
|
|
|
|
|
|
|
} |
1129
|
|
|
|
|
|
|
else { |
1130
|
1
|
|
|
|
|
4
|
return { 'type' => $type }; |
1131
|
|
|
|
|
|
|
} |
1132
|
|
|
|
|
|
|
} |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
elsif ($token == $OCTET) { # octet strings |
1135
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1136
|
0
|
0
|
|
|
|
0
|
if ($token == $STRING) { |
1137
|
0
|
|
|
|
|
0
|
my $type = "OCTET STRING"; |
1138
|
0
|
|
|
|
|
0
|
my $subtype = $self->parse_subtype(); |
1139
|
0
|
|
|
|
|
0
|
$$subtype{'type'} = $type; |
1140
|
0
|
|
|
|
|
0
|
return $subtype; |
1141
|
|
|
|
|
|
|
} |
1142
|
|
|
|
|
|
|
else { |
1143
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1144
|
|
|
|
|
|
|
"parse error"); |
1145
|
|
|
|
|
|
|
} |
1146
|
|
|
|
|
|
|
} |
1147
|
|
|
|
|
|
|
elsif ($token == $OBJECT) { # object types |
1148
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1149
|
0
|
0
|
|
|
|
0
|
if ($token == $IDENTIFIER) { |
1150
|
0
|
|
|
|
|
0
|
my $type = "OBJECT IDENTIFIER"; |
1151
|
0
|
|
|
|
|
0
|
my $subtype = $self->parse_subtype(); |
1152
|
0
|
|
|
|
|
0
|
$$subtype{'type'} = $type; |
1153
|
0
|
|
|
|
|
0
|
return $subtype; |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
else { |
1156
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1157
|
|
|
|
|
|
|
"parse error"); |
1158
|
|
|
|
|
|
|
} |
1159
|
|
|
|
|
|
|
} |
1160
|
|
|
|
|
|
|
elsif ($token == $NULL) { |
1161
|
0
|
|
|
|
|
0
|
return { 'type' => "NULL" }; |
1162
|
|
|
|
|
|
|
} |
1163
|
|
|
|
|
|
|
elsif ($token == $ANY && $self->{'allow_keyword_any'}) { |
1164
|
|
|
|
|
|
|
# ANY is only valid in ASN.1.. but nor in SMI, nor SMIv2. |
1165
|
|
|
|
|
|
|
# As it is used in RFC 1157, we must allow it :( |
1166
|
0
|
|
|
|
|
0
|
return { 'type' => "ANY" }; |
1167
|
|
|
|
|
|
|
} |
1168
|
|
|
|
|
|
|
elsif ($token == $CHOICE) { # choices |
1169
|
|
|
|
|
|
|
# CHOICE { va ta, vb tb, vc tc } |
1170
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('{')) || return; |
1171
|
0
|
|
|
|
|
0
|
my $list = {}; |
1172
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
1173
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1174
|
0
|
|
|
|
|
0
|
my $res = $self->parse_type(); |
1175
|
0
|
|
|
|
|
0
|
my $ref = ref $res; |
1176
|
0
|
0
|
0
|
|
|
0
|
if (defined $ref && $ref eq 'HASH') { |
1177
|
0
|
|
|
|
|
0
|
$$list{$value} = $res; |
1178
|
|
|
|
|
|
|
} |
1179
|
|
|
|
|
|
|
else { |
1180
|
0
|
|
|
|
|
0
|
$$list{$value} = { 'type' => $res }; |
1181
|
|
|
|
|
|
|
} |
1182
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1183
|
0
|
0
|
0
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1184
|
|
|
|
|
|
|
"must be a '}' or a ',' instead of '$value'") |
1185
|
|
|
|
|
|
|
unless $value eq '}' || $value eq ','; |
1186
|
|
|
|
|
|
|
} |
1187
|
0
|
|
|
|
|
0
|
return { 'type' => 'CHOICE', |
1188
|
|
|
|
|
|
|
'items' => $list }; |
1189
|
|
|
|
|
|
|
} |
1190
|
|
|
|
|
|
|
elsif ($token == $SEQUENCE) { # sequence (of) |
1191
|
0
|
|
|
|
|
0
|
my $list = {}; # Should we keep the order of the items (and then |
1192
|
|
|
|
|
|
|
# use an array instead of a hash) ?? |
1193
|
0
|
|
|
|
|
0
|
my $subtype; |
1194
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1195
|
0
|
0
|
|
|
|
0
|
if ($value eq '(') { |
1196
|
0
|
|
|
|
|
0
|
$self->unget_token(); |
1197
|
0
|
|
|
|
|
0
|
$subtype = $self->parse_subtype(); |
1198
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1199
|
|
|
|
|
|
|
} |
1200
|
0
|
0
|
|
|
|
0
|
if ($token == $OF) { |
1201
|
|
|
|
|
|
|
# Small hack to obtain a name for this unique (?) item |
1202
|
0
|
0
|
|
|
|
0
|
(my ($t1, $t2) = $self->get_token()) || return; |
1203
|
0
|
|
|
|
|
0
|
$self->unget_token(); |
1204
|
0
|
|
|
|
|
0
|
$t2 = lc $t2; |
1205
|
|
|
|
|
|
|
|
1206
|
0
|
|
|
|
|
0
|
my $res = $self->parse_type(); |
1207
|
0
|
|
|
|
|
0
|
my $r = { 'type' => 'SEQUENCE' }; |
1208
|
0
|
|
|
|
|
0
|
$$r{'items'} = { $t2 => $res }; |
1209
|
0
|
0
|
|
|
|
0
|
if (defined $subtype) { |
1210
|
0
|
|
|
|
|
0
|
map { $$r{$_} = $$subtype{$_} } keys %$subtype; |
|
0
|
|
|
|
|
0
|
|
1211
|
|
|
|
|
|
|
} |
1212
|
0
|
|
|
|
|
0
|
return $r; |
1213
|
|
|
|
|
|
|
} |
1214
|
0
|
0
|
|
|
|
0
|
if ($value eq '{') { |
1215
|
0
|
|
|
|
|
0
|
my $list = {}; |
1216
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
1217
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1218
|
0
|
|
|
|
|
0
|
my $res; |
1219
|
0
|
0
|
|
|
|
0
|
if ($token == $CHOICE) { |
1220
|
0
|
|
|
|
|
0
|
$self->unget_token(); |
1221
|
0
|
|
|
|
|
0
|
$res = $self->parse_type(); |
1222
|
|
|
|
|
|
|
} |
1223
|
|
|
|
|
|
|
else { |
1224
|
0
|
|
|
|
|
0
|
$res = $self->parse_type(); |
1225
|
|
|
|
|
|
|
} |
1226
|
0
|
|
|
|
|
0
|
my $ref = ref $res; |
1227
|
0
|
0
|
0
|
|
|
0
|
if (defined $ref && $ref eq 'HASH') { |
1228
|
0
|
|
|
|
|
0
|
$$list{$value} = $res; |
1229
|
|
|
|
|
|
|
} |
1230
|
|
|
|
|
|
|
else { |
1231
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, |
1232
|
|
|
|
|
|
|
$self->{'lineno'}, "FATAL ERROR (please report)"); |
1233
|
0
|
|
|
|
|
0
|
$$list{$value} = { 'type' => $res }; |
1234
|
|
|
|
|
|
|
} |
1235
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1236
|
0
|
0
|
0
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1237
|
|
|
|
|
|
|
"must be a '}' or a ',' instead of '$value'") |
1238
|
|
|
|
|
|
|
unless $value eq '}' || $value eq ','; |
1239
|
|
|
|
|
|
|
} |
1240
|
0
|
|
|
|
|
0
|
return { 'type' => 'SEQUENCE', |
1241
|
|
|
|
|
|
|
'items' => $list }; |
1242
|
|
|
|
|
|
|
} |
1243
|
|
|
|
|
|
|
else { |
1244
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1245
|
|
|
|
|
|
|
"fatal error"); |
1246
|
|
|
|
|
|
|
} |
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
elsif ($value eq '[') { # tagged types |
1249
|
0
|
|
|
|
|
0
|
my $list = []; |
1250
|
0
|
|
|
|
|
0
|
while ($value ne ']') { # read the tag |
1251
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1252
|
0
|
0
|
|
|
|
0
|
push @$list, $value unless $value eq ']'; |
1253
|
|
|
|
|
|
|
} |
1254
|
0
|
|
|
|
|
0
|
my $type = $self->parse_type(); |
1255
|
0
|
|
|
|
|
0
|
$$type{'tag'} = $list; |
1256
|
0
|
|
|
|
|
0
|
return $type; |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
elsif ($value eq 'TEXTUAL-CONVENTION') { # textual convention |
1259
|
0
|
|
|
|
|
0
|
return $self->parse_textualconvention(); |
1260
|
|
|
|
|
|
|
} |
1261
|
|
|
|
|
|
|
elsif ($token == $IDENTIFIER || $token == $TYPEMODREFERENCE) { |
1262
|
0
|
|
|
|
|
0
|
my $type = $value; |
1263
|
0
|
|
|
|
|
0
|
my $subtype = $self->parse_subtype(); |
1264
|
0
|
|
|
|
|
0
|
$$subtype{'type'} = $type; |
1265
|
0
|
|
|
|
|
0
|
return $subtype; |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
else { |
1268
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1269
|
|
|
|
|
|
|
"Syntax error at '$value'"); |
1270
|
|
|
|
|
|
|
} |
1271
|
|
|
|
|
|
|
} |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
sub parse_textualconvention { |
1274
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
1275
|
0
|
|
|
|
|
0
|
my $data; |
1276
|
|
|
|
|
|
|
|
1277
|
0
|
0
|
|
|
|
0
|
(my ($token, $value) = $self->get_token()) || return; |
1278
|
0
|
0
|
|
|
|
0
|
if ($value eq 'DISPLAY-HINT') { |
1279
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1280
|
0
|
|
|
|
|
0
|
$$data{'display-hint'} = $value; |
1281
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1282
|
|
|
|
|
|
|
} |
1283
|
0
|
0
|
|
|
|
0
|
if ($value eq 'STATUS') { |
1284
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1285
|
0
|
0
|
|
|
|
0
|
if ($value =~ m/^(current|deprecated|obsolete)$/o) { |
1286
|
0
|
|
|
|
|
0
|
$$data{'status'} = $value; |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
else { |
1289
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1290
|
|
|
|
|
|
|
"unknown status ($value) for TEXTUAL-CONVENTION"); |
1291
|
|
|
|
|
|
|
} |
1292
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1293
|
|
|
|
|
|
|
} |
1294
|
|
|
|
|
|
|
else { |
1295
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1296
|
|
|
|
|
|
|
"Syntax error in TC: 'STATUS' requiered"); |
1297
|
|
|
|
|
|
|
} |
1298
|
0
|
0
|
|
|
|
0
|
if ($value eq 'DESCRIPTION') { |
1299
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1300
|
0
|
|
|
|
|
0
|
$$data{'description'} = $value; |
1301
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1302
|
|
|
|
|
|
|
} |
1303
|
|
|
|
|
|
|
else { |
1304
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1305
|
|
|
|
|
|
|
"Syntax error in TC: 'DESCRIPTION' requiered"); |
1306
|
|
|
|
|
|
|
} |
1307
|
0
|
0
|
|
|
|
0
|
if ($value eq 'REFERENCE') { |
1308
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1309
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
1310
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1311
|
|
|
|
|
|
|
} |
1312
|
0
|
0
|
|
|
|
0
|
if ($value eq 'SYNTAX') { |
1313
|
0
|
|
|
|
|
0
|
my $type; |
1314
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1315
|
0
|
0
|
|
|
|
0
|
if ($value eq 'BITS') { |
1316
|
0
|
|
|
|
|
0
|
$$type{'type'} = $value; |
1317
|
0
|
0
|
|
|
|
0
|
$self->get_token('{') || return; |
1318
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
1319
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1320
|
0
|
|
|
|
|
0
|
my $identifier = $value; |
1321
|
0
|
0
|
|
|
|
0
|
$self->get_token('(') || return; |
1322
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('NUMBER')) || return; |
1323
|
0
|
|
|
|
|
0
|
$$type{'values'}{$value} = $identifier; |
1324
|
0
|
0
|
|
|
|
0
|
$self->get_token(')') || return; |
1325
|
|
|
|
|
|
|
# should be ',' or ')' |
1326
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1327
|
|
|
|
|
|
|
} |
1328
|
|
|
|
|
|
|
} |
1329
|
|
|
|
|
|
|
else { |
1330
|
0
|
|
|
|
|
0
|
$self->unget_token(); |
1331
|
0
|
|
|
|
|
0
|
$type = $self->parse_type; |
1332
|
|
|
|
|
|
|
} |
1333
|
0
|
|
|
|
|
0
|
$$data{'syntax'} = $type; |
1334
|
|
|
|
|
|
|
} |
1335
|
|
|
|
|
|
|
else { |
1336
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1337
|
|
|
|
|
|
|
"Syntax error in TC: 'SYNTAX' requiered"); |
1338
|
|
|
|
|
|
|
} |
1339
|
0
|
|
|
|
|
0
|
$data; |
1340
|
|
|
|
|
|
|
} |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
sub parse_objectidentity { |
1343
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
1344
|
0
|
|
|
|
|
0
|
my $data; |
1345
|
|
|
|
|
|
|
|
1346
|
0
|
|
|
|
|
0
|
my ($token, $value); |
1347
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1348
|
0
|
0
|
|
|
|
0
|
if ($value eq 'STATUS') { |
1349
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1350
|
0
|
0
|
|
|
|
0
|
if ($value =~ m/^(current|deprecated|obsolete)$/o) { |
1351
|
0
|
|
|
|
|
0
|
$$data{'status'} = $value; |
1352
|
|
|
|
|
|
|
} |
1353
|
|
|
|
|
|
|
else { |
1354
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1355
|
|
|
|
|
|
|
"unknown status ($value) for OBJECT-IDENTITY"); |
1356
|
|
|
|
|
|
|
} |
1357
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1358
|
|
|
|
|
|
|
} |
1359
|
|
|
|
|
|
|
else { |
1360
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1361
|
|
|
|
|
|
|
"Syntax error. 'STATUS' needed"); |
1362
|
|
|
|
|
|
|
} |
1363
|
0
|
0
|
|
|
|
0
|
if ($value eq 'DESCRIPTION') { |
1364
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1365
|
0
|
|
|
|
|
0
|
$$data{'description'} = $value; |
1366
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1367
|
|
|
|
|
|
|
} |
1368
|
|
|
|
|
|
|
else { |
1369
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1370
|
|
|
|
|
|
|
"Syntax error. 'DESCRIPTION' needed"); |
1371
|
|
|
|
|
|
|
} |
1372
|
0
|
0
|
|
|
|
0
|
if ($value eq 'REFERENCE') { |
1373
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1374
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
1375
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1376
|
|
|
|
|
|
|
} |
1377
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1378
|
|
|
|
|
|
|
"Syntax error. '::=' needed") unless $token == $ASSIGNMENT; |
1379
|
0
|
|
|
|
|
0
|
$$data{'oid'} = $self->parse_oid(); |
1380
|
0
|
|
|
|
|
0
|
$data; |
1381
|
|
|
|
|
|
|
} |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
# parse MODULE-IDENTITY macro (see RFC 1902) |
1384
|
|
|
|
|
|
|
sub parse_moduleidentity { |
1385
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
1386
|
0
|
|
|
|
|
0
|
my $data; |
1387
|
|
|
|
|
|
|
|
1388
|
0
|
|
|
|
|
0
|
my ($token, $value); |
1389
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1390
|
0
|
0
|
|
|
|
0
|
if ($value eq 'LAST-UPDATED') { |
1391
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1392
|
0
|
|
|
|
|
0
|
$$data{'last-updated'} = $value; |
1393
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1394
|
|
|
|
|
|
|
} |
1395
|
|
|
|
|
|
|
else { |
1396
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1397
|
|
|
|
|
|
|
"Syntax error. 'LAST-UPDATED' needed"); |
1398
|
|
|
|
|
|
|
} |
1399
|
0
|
0
|
|
|
|
0
|
if ($value eq 'ORGANIZATION') { |
1400
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1401
|
0
|
|
|
|
|
0
|
$$data{'organization'} = $value; |
1402
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1403
|
|
|
|
|
|
|
} |
1404
|
|
|
|
|
|
|
else { |
1405
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1406
|
|
|
|
|
|
|
"Syntax error. 'ORGANIZATION' needed"); |
1407
|
|
|
|
|
|
|
} |
1408
|
0
|
0
|
|
|
|
0
|
if ($value eq 'CONTACT-INFO') { |
1409
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1410
|
0
|
|
|
|
|
0
|
$$data{'contact-info'} = $value; |
1411
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1412
|
|
|
|
|
|
|
} |
1413
|
|
|
|
|
|
|
else { |
1414
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1415
|
|
|
|
|
|
|
"Syntax error. 'CONTACT-INFO' needed"); |
1416
|
|
|
|
|
|
|
} |
1417
|
0
|
0
|
|
|
|
0
|
if ($value eq 'DESCRIPTION') { |
1418
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1419
|
0
|
|
|
|
|
0
|
$$data{'description'} = $value; |
1420
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1421
|
|
|
|
|
|
|
} |
1422
|
|
|
|
|
|
|
else { |
1423
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1424
|
|
|
|
|
|
|
"Syntax error. 'DESCRIPTION' needed"); |
1425
|
|
|
|
|
|
|
} |
1426
|
0
|
|
|
|
|
0
|
while ($value eq 'REVISION') { |
1427
|
0
|
0
|
|
|
|
0
|
$$data{'revision'} = [] unless defined $$data{'revision'}; |
1428
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1429
|
0
|
|
|
|
|
0
|
my $val = $value; |
1430
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1431
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1432
|
|
|
|
|
|
|
"Syntax error: found '$value', need 'DESCRIPTION'") |
1433
|
|
|
|
|
|
|
unless $value eq 'DESCRIPTION'; |
1434
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1435
|
0
|
|
|
|
|
0
|
push @{$$data{'revision'}}, { 'revision' => $val, |
|
0
|
|
|
|
|
0
|
|
1436
|
|
|
|
|
|
|
'description' => $value }; |
1437
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1438
|
|
|
|
|
|
|
} |
1439
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1440
|
|
|
|
|
|
|
"Syntax error. '::=' needed") unless $token == $ASSIGNMENT; |
1441
|
0
|
|
|
|
|
0
|
$$data{'oid'} = $self->parse_oid(); |
1442
|
0
|
|
|
|
|
0
|
$data; |
1443
|
|
|
|
|
|
|
} |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
# parse NOTIFICATION-TYPE macro (see RFC 1902) |
1446
|
|
|
|
|
|
|
sub parse_notificationtype { |
1447
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
1448
|
0
|
|
|
|
|
0
|
my $data; |
1449
|
|
|
|
|
|
|
|
1450
|
0
|
|
|
|
|
0
|
my ($token, $value); |
1451
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1452
|
0
|
0
|
|
|
|
0
|
if ($value eq 'OBJECTS') { |
1453
|
0
|
|
|
|
|
0
|
my $list = []; |
1454
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('{')) || return; |
1455
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
1456
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1457
|
0
|
|
|
|
|
0
|
push @$list, $value; |
1458
|
|
|
|
|
|
|
# shoud be a ',' or a '}' |
1459
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1460
|
|
|
|
|
|
|
} |
1461
|
0
|
|
|
|
|
0
|
$$data{'objects'} = $list; |
1462
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1463
|
|
|
|
|
|
|
} |
1464
|
0
|
0
|
|
|
|
0
|
if ($value eq 'STATUS') { |
1465
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1466
|
0
|
0
|
|
|
|
0
|
if ($value =~ m/^(current|deprecated|obsolete)$/o) { |
1467
|
0
|
|
|
|
|
0
|
$$data{'status'} = $value; |
1468
|
|
|
|
|
|
|
} |
1469
|
|
|
|
|
|
|
else { |
1470
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1471
|
|
|
|
|
|
|
"unknown status ($value) for NOTIFICATION-TYPE"); |
1472
|
|
|
|
|
|
|
} |
1473
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1474
|
|
|
|
|
|
|
} |
1475
|
|
|
|
|
|
|
else { |
1476
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1477
|
|
|
|
|
|
|
"Syntax error. 'STATUS' needed"); |
1478
|
|
|
|
|
|
|
} |
1479
|
0
|
0
|
|
|
|
0
|
if ($value eq 'DESCRIPTION') { |
1480
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1481
|
0
|
|
|
|
|
0
|
$$data{'description'} = $value; |
1482
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1483
|
|
|
|
|
|
|
} |
1484
|
|
|
|
|
|
|
else { |
1485
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1486
|
|
|
|
|
|
|
"Syntax error. 'DESCRIPTION' needed"); |
1487
|
|
|
|
|
|
|
} |
1488
|
0
|
0
|
|
|
|
0
|
if ($value eq 'REFERENCE') { |
1489
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1490
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
1491
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1492
|
|
|
|
|
|
|
} |
1493
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1494
|
|
|
|
|
|
|
"Syntax error. '::=' needed") unless $token == $ASSIGNMENT; |
1495
|
0
|
|
|
|
|
0
|
$$data{'oid'} = $self->parse_oid(); |
1496
|
0
|
|
|
|
|
0
|
$data; |
1497
|
|
|
|
|
|
|
} |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
# parse MODULE-COMPLIANCE macro (see RFC 1904) |
1500
|
|
|
|
|
|
|
sub parse_modulecompliance { |
1501
|
3
|
|
|
3
|
0
|
74
|
my $self = shift; |
1502
|
3
|
|
|
|
|
7
|
my $data; |
1503
|
|
|
|
|
|
|
|
1504
|
3
|
|
|
|
|
6
|
my ($token, $value); |
1505
|
3
|
50
|
|
|
|
7
|
(($token, $value) = $self->get_token()) || return; |
1506
|
3
|
|
|
|
|
8
|
my $name = 'this'; |
1507
|
3
|
50
|
|
|
|
8
|
if ($value eq 'STATUS') { |
1508
|
3
|
50
|
|
|
|
7
|
(($token, $value) = $self->get_token()) || return; |
1509
|
3
|
50
|
|
|
|
22
|
if ($value =~ m/^(current|deprecated|obsolete)$/o) { |
1510
|
3
|
|
|
|
|
8
|
$$data{'status'} = $value; |
1511
|
|
|
|
|
|
|
} |
1512
|
|
|
|
|
|
|
else { |
1513
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1514
|
|
|
|
|
|
|
"unknown status ($value) for MODULE-COMPLIANCE"); |
1515
|
|
|
|
|
|
|
} |
1516
|
3
|
50
|
|
|
|
10
|
(($token, $value) = $self->get_token()) || return; |
1517
|
|
|
|
|
|
|
} |
1518
|
|
|
|
|
|
|
else { |
1519
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1520
|
|
|
|
|
|
|
"Syntax error. 'STATUS' needed"); |
1521
|
|
|
|
|
|
|
} |
1522
|
3
|
50
|
|
|
|
11
|
if ($value eq 'DESCRIPTION') { |
1523
|
3
|
50
|
|
|
|
10
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1524
|
3
|
|
|
|
|
8
|
$$data{'description'} = $value; |
1525
|
3
|
50
|
|
|
|
7
|
(($token, $value) = $self->get_token()) || return; |
1526
|
|
|
|
|
|
|
} |
1527
|
|
|
|
|
|
|
else { |
1528
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1529
|
|
|
|
|
|
|
"Syntax error. 'DESCRIPTION' needed"); |
1530
|
|
|
|
|
|
|
} |
1531
|
3
|
50
|
|
|
|
10
|
if ($value eq 'REFERENCE') { |
1532
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1533
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
1534
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1535
|
|
|
|
|
|
|
} |
1536
|
3
|
|
|
|
|
9
|
while ($value eq 'MODULE') { |
1537
|
5
|
|
|
|
|
7
|
$name = 'this'; |
1538
|
5
|
50
|
|
|
|
16
|
(($token, $value) = $self->get_token()) || return; |
1539
|
5
|
|
100
|
|
|
55
|
while ($value ne 'MODULE' && $token != $ASSIGNMENT) { |
1540
|
19
|
100
|
|
|
|
68
|
if ($value eq 'MANDATORY-GROUPS') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1541
|
5
|
|
|
|
|
7
|
my $list = []; |
1542
|
5
|
50
|
|
|
|
13
|
(($token, $value) = $self->get_token('{')) || return; |
1543
|
5
|
|
|
|
|
16
|
while ($value ne '}') { |
1544
|
9
|
50
|
|
|
|
21
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1545
|
9
|
|
|
|
|
15
|
push @$list, $value; |
1546
|
|
|
|
|
|
|
# shoud be a ',' or a '}' |
1547
|
9
|
50
|
|
|
|
19
|
(($token, $value) = $self->get_token()) || return; |
1548
|
|
|
|
|
|
|
} |
1549
|
5
|
|
|
|
|
25
|
$$data{'module'}{$name}{'mandatory-groups'} = $list; |
1550
|
|
|
|
|
|
|
} |
1551
|
|
|
|
|
|
|
elsif ($value eq 'GROUP') { |
1552
|
2
|
50
|
|
|
|
4
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1553
|
2
|
|
|
|
|
2
|
my $val = $value; |
1554
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
1555
|
2
|
50
|
|
|
|
7
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1556
|
|
|
|
|
|
|
"Syntax error: found '$value', need 'DESCRIPTION'") |
1557
|
|
|
|
|
|
|
unless $value eq 'DESCRIPTION'; |
1558
|
2
|
50
|
|
|
|
12
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1559
|
2
|
|
|
|
|
11
|
$$data{'module'}{$name}{'group'}{$val} = $value; |
1560
|
|
|
|
|
|
|
} |
1561
|
|
|
|
|
|
|
elsif ($value eq 'OBJECT') { |
1562
|
10
|
50
|
|
|
|
23
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1563
|
10
|
|
|
|
|
16
|
my $val = $value; |
1564
|
10
|
50
|
|
|
|
23
|
(($token, $value) = $self->get_token()) || return; |
1565
|
10
|
100
|
|
|
|
25
|
if ($value eq 'SYNTAX') { |
1566
|
5
|
|
|
|
|
16
|
my $type = $self->parse_type(); |
1567
|
5
|
|
|
|
|
23
|
$$data{'module'}{$name}{'object'}{$val}{'syntax'} = $type; |
1568
|
5
|
50
|
|
|
|
12
|
(($token, $value) = $self->get_token()) || return; |
1569
|
|
|
|
|
|
|
} |
1570
|
10
|
50
|
|
|
|
25
|
if ($value eq 'WRITE-SYNTAX') { |
1571
|
0
|
|
|
|
|
0
|
my $type = $self->parse_type(); |
1572
|
0
|
|
|
|
|
0
|
$$data{'module'}{$name}{'object'}{$val}{'write-syntax'} = $type; |
1573
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1574
|
|
|
|
|
|
|
} |
1575
|
10
|
50
|
|
|
|
18
|
if ($value eq 'MIN-ACCESS') { |
1576
|
10
|
50
|
|
|
|
21
|
(($token, $value) = $self->get_token()) || return; |
1577
|
10
|
50
|
|
|
|
52
|
if ($value =~ m/^(read-(only|write|create)|not-accessible| |
1578
|
|
|
|
|
|
|
accessible-for-notify)$/ox) { |
1579
|
10
|
|
|
|
|
51
|
$$data{'module'}{$name}{'object'}{$val}{'min-access'} = $value; |
1580
|
|
|
|
|
|
|
} |
1581
|
|
|
|
|
|
|
else { |
1582
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, |
1583
|
|
|
|
|
|
|
$self->{'lineno'}, "Unknown MIN-ACCESS type ($value)"); |
1584
|
|
|
|
|
|
|
} |
1585
|
10
|
50
|
|
|
|
23
|
(($token, $value) = $self->get_token()) || return; |
1586
|
|
|
|
|
|
|
} |
1587
|
10
|
50
|
|
|
|
28
|
if ($value eq 'DESCRIPTION') { |
1588
|
10
|
50
|
|
|
|
32
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1589
|
10
|
|
|
|
|
39
|
$$data{'module'}{$name}{'object'}{$val}{'description'} = $value; |
1590
|
10
|
50
|
|
|
|
21
|
(($token, $value) = $self->get_token()) || return; |
1591
|
|
|
|
|
|
|
} |
1592
|
10
|
|
|
|
|
27
|
$self->unget_token(); |
1593
|
|
|
|
|
|
|
} |
1594
|
|
|
|
|
|
|
elsif ($token == $TYPEMODREFERENCE) { |
1595
|
|
|
|
|
|
|
# Modulename |
1596
|
2
|
|
|
|
|
4
|
$name = $value; |
1597
|
2
|
50
|
|
|
|
8
|
(($token, $value) = $self->get_token()) || return; |
1598
|
2
|
50
|
|
|
|
9
|
if ($token == $IDENTIFIER) { # ModuleIdentifier |
1599
|
0
|
|
|
|
|
0
|
$$data{'module'}{$name}{'identifier'} = $value; |
1600
|
|
|
|
|
|
|
} |
1601
|
|
|
|
|
|
|
else { |
1602
|
2
|
|
|
|
|
8
|
$self->unget_token(); |
1603
|
|
|
|
|
|
|
} |
1604
|
|
|
|
|
|
|
} |
1605
|
|
|
|
|
|
|
else { |
1606
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1607
|
|
|
|
|
|
|
"Syntax error at '$value'"); |
1608
|
|
|
|
|
|
|
} |
1609
|
19
|
50
|
|
|
|
42
|
(($token, $value) = $self->get_token()) || return; |
1610
|
|
|
|
|
|
|
} |
1611
|
|
|
|
|
|
|
} |
1612
|
3
|
50
|
|
|
|
10
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1613
|
|
|
|
|
|
|
"Syntax error. '::=' needed") unless $token == $ASSIGNMENT; |
1614
|
3
|
|
|
|
|
14
|
$$data{'oid'} = $self->parse_oid(); |
1615
|
3
|
|
|
|
|
15
|
$data; |
1616
|
|
|
|
|
|
|
} |
1617
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
# parse OBJECT-GROUP macro (see RFC 1904) |
1619
|
|
|
|
|
|
|
sub parse_objectgroup { |
1620
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
1621
|
0
|
|
|
|
|
0
|
my $data; |
1622
|
|
|
|
|
|
|
|
1623
|
0
|
|
|
|
|
0
|
my ($token, $value); |
1624
|
0
|
0
|
|
|
|
0
|
(($token, $value)= $self->get_token()) || return; |
1625
|
0
|
0
|
|
|
|
0
|
if ($value eq 'OBJECTS') { |
1626
|
0
|
|
|
|
|
0
|
my $list = []; |
1627
|
0
|
|
|
|
|
0
|
(($token, $value) = $self->get_token('{')); |
1628
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
1629
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1630
|
0
|
|
|
|
|
0
|
push @$list, $value; |
1631
|
|
|
|
|
|
|
# shoud be a ',' or a '}' |
1632
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1633
|
|
|
|
|
|
|
} |
1634
|
0
|
|
|
|
|
0
|
$$data{'objects'} = $list; |
1635
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1636
|
|
|
|
|
|
|
} |
1637
|
|
|
|
|
|
|
else { |
1638
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1639
|
|
|
|
|
|
|
"Syntax error. 'OBJECTS' needed"); |
1640
|
|
|
|
|
|
|
} |
1641
|
0
|
0
|
|
|
|
0
|
if ($value eq 'STATUS') { |
1642
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1643
|
0
|
0
|
|
|
|
0
|
if ($value =~ m/^(current|deprecated|obsolete)$/o) { |
1644
|
0
|
|
|
|
|
0
|
$$data{'status'} = $value; |
1645
|
|
|
|
|
|
|
} |
1646
|
|
|
|
|
|
|
else { |
1647
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1648
|
|
|
|
|
|
|
"unknown status ($value) for OBJECT-GROUP"); |
1649
|
|
|
|
|
|
|
} |
1650
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1651
|
|
|
|
|
|
|
} |
1652
|
|
|
|
|
|
|
else { |
1653
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1654
|
|
|
|
|
|
|
"Syntax error. 'STATUS' needed"); |
1655
|
|
|
|
|
|
|
} |
1656
|
0
|
0
|
|
|
|
0
|
if ($value eq 'DESCRIPTION') { |
1657
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1658
|
0
|
|
|
|
|
0
|
$$data{'description'} = $value; |
1659
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1660
|
|
|
|
|
|
|
} |
1661
|
|
|
|
|
|
|
else { |
1662
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1663
|
|
|
|
|
|
|
"Syntax error. 'DESCRIPTION' needed"); |
1664
|
|
|
|
|
|
|
} |
1665
|
0
|
0
|
|
|
|
0
|
if ($value eq 'REFERENCE') { |
1666
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1667
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
1668
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1669
|
|
|
|
|
|
|
} |
1670
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1671
|
|
|
|
|
|
|
"Syntax error. '::=' needed") unless $token == $ASSIGNMENT; |
1672
|
0
|
|
|
|
|
0
|
$$data{'oid'} = $self->parse_oid(); |
1673
|
0
|
|
|
|
|
0
|
$data; |
1674
|
|
|
|
|
|
|
} |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
# parse NOTIFICATION-GROUP macro (see RFC 1904) |
1677
|
|
|
|
|
|
|
sub parse_notificationgroup { |
1678
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
1679
|
0
|
|
|
|
|
0
|
my $data; |
1680
|
|
|
|
|
|
|
|
1681
|
0
|
|
|
|
|
0
|
my ($token, $value); |
1682
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1683
|
0
|
0
|
|
|
|
0
|
if ($value eq 'NOTIFICATIONS') { |
1684
|
0
|
|
|
|
|
0
|
my $list = []; |
1685
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('{')) || return; |
1686
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
1687
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1688
|
0
|
|
|
|
|
0
|
push @$list, $value; |
1689
|
|
|
|
|
|
|
# shoud be a ',' or a '}' |
1690
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1691
|
|
|
|
|
|
|
} |
1692
|
0
|
|
|
|
|
0
|
$$data{'NOTIFICATIONS'} = $list; |
1693
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1694
|
|
|
|
|
|
|
} |
1695
|
|
|
|
|
|
|
else { |
1696
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1697
|
|
|
|
|
|
|
"Syntax error. 'NOTIFICATIONS' needed"); |
1698
|
|
|
|
|
|
|
} |
1699
|
0
|
0
|
|
|
|
0
|
if ($value eq 'STATUS') { |
1700
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1701
|
0
|
0
|
|
|
|
0
|
if ($value =~ m/^(current|deprecated|obsolete)$/o) { |
1702
|
0
|
|
|
|
|
0
|
$$data{'status'} = $value; |
1703
|
|
|
|
|
|
|
} |
1704
|
|
|
|
|
|
|
else { |
1705
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1706
|
|
|
|
|
|
|
"unknown status ($value) for NOTIFICATION-GROUP"); |
1707
|
|
|
|
|
|
|
} |
1708
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1709
|
|
|
|
|
|
|
} |
1710
|
|
|
|
|
|
|
else { |
1711
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1712
|
|
|
|
|
|
|
"Syntax error. 'STATUS' needed"); |
1713
|
|
|
|
|
|
|
} |
1714
|
0
|
0
|
|
|
|
0
|
if ($value eq 'DESCRIPTION') { |
1715
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1716
|
0
|
|
|
|
|
0
|
$$data{'description'} = $value; |
1717
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1718
|
|
|
|
|
|
|
} |
1719
|
|
|
|
|
|
|
else { |
1720
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1721
|
|
|
|
|
|
|
"Syntax error. 'DESCRIPTION' needed"); |
1722
|
|
|
|
|
|
|
} |
1723
|
0
|
0
|
|
|
|
0
|
if ($value eq 'REFERENCE') { |
1724
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1725
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
1726
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1727
|
|
|
|
|
|
|
} |
1728
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1729
|
|
|
|
|
|
|
"Syntax error. '::=' needed") unless $token == $ASSIGNMENT; |
1730
|
0
|
|
|
|
|
0
|
$$data{'oid'} = $self->parse_oid(); |
1731
|
0
|
|
|
|
|
0
|
$data; |
1732
|
|
|
|
|
|
|
} |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
sub parse_agentcapabilities { |
1735
|
1
|
|
|
1
|
0
|
8
|
my $self = shift; |
1736
|
1
|
|
|
|
|
2
|
my $data; |
1737
|
|
|
|
|
|
|
|
1738
|
1
|
|
|
|
|
2
|
my $name = 'this'; |
1739
|
1
|
|
|
|
|
2
|
my ($token, $value); |
1740
|
1
|
|
|
|
|
3
|
(($token, $value) = $self->get_token()); |
1741
|
1
|
50
|
|
|
|
5
|
return unless $token; |
1742
|
|
|
|
|
|
|
# "PRODUCT-RELEASE" Text |
1743
|
1
|
50
|
|
|
|
3
|
if ($value eq 'PRODUCT-RELEASE') { |
1744
|
1
|
50
|
|
|
|
4
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1745
|
1
|
|
|
|
|
4
|
$$data{'product-release'} = $value; |
1746
|
1
|
50
|
|
|
|
4
|
(($token, $value) = $self->get_token()) || return; |
1747
|
|
|
|
|
|
|
} |
1748
|
|
|
|
|
|
|
else { |
1749
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1750
|
|
|
|
|
|
|
"Syntax error. 'PRODUCT-RELEASE' needed"); |
1751
|
|
|
|
|
|
|
} |
1752
|
|
|
|
|
|
|
# "STATUS" Status |
1753
|
1
|
50
|
|
|
|
8
|
if ($value eq 'STATUS') { |
1754
|
1
|
50
|
|
|
|
4
|
(($token, $value) = $self->get_token()) || return; |
1755
|
1
|
50
|
|
|
|
7
|
if ($value =~ m/^(current|obsolete)$/o) { |
1756
|
1
|
|
|
|
|
4
|
$$data{'status'} = $value; |
1757
|
1
|
50
|
|
|
|
4
|
(($token, $value) = $self->get_token()) || return; |
1758
|
|
|
|
|
|
|
} |
1759
|
|
|
|
|
|
|
else { |
1760
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1761
|
|
|
|
|
|
|
"unknown status ($value) for AGENT-CAPABILITIES"); |
1762
|
|
|
|
|
|
|
} |
1763
|
|
|
|
|
|
|
} |
1764
|
|
|
|
|
|
|
else { |
1765
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1766
|
|
|
|
|
|
|
"Syntax error. 'STATUS' needed"); |
1767
|
|
|
|
|
|
|
} |
1768
|
|
|
|
|
|
|
# "DESCRIPTION" Text |
1769
|
1
|
50
|
|
|
|
4
|
if ($value eq 'DESCRIPTION') { |
1770
|
1
|
50
|
|
|
|
4
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1771
|
1
|
|
|
|
|
4
|
$$data{'description'} = $value; |
1772
|
1
|
50
|
|
|
|
3
|
(($token, $value) = $self->get_token()) || return; |
1773
|
|
|
|
|
|
|
} |
1774
|
|
|
|
|
|
|
else { |
1775
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1776
|
|
|
|
|
|
|
"Syntax error. 'DESCRIPTION' needed"); |
1777
|
|
|
|
|
|
|
} |
1778
|
|
|
|
|
|
|
# ReferPart |
1779
|
1
|
50
|
|
|
|
4
|
if ($value eq 'REFERENCE') { |
1780
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1781
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
1782
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1783
|
|
|
|
|
|
|
} |
1784
|
|
|
|
|
|
|
# ModulePart |
1785
|
1
|
|
66
|
|
|
10
|
while (defined $token && $token != $ASSIGNMENT) { |
1786
|
7
|
|
66
|
|
|
47
|
while (defined $token && $value ne 'SUPPORTS' && $token != $ASSIGNMENT) { |
|
|
|
100
|
|
|
|
|
1787
|
6
|
50
|
|
|
|
15
|
if ($value eq 'INCLUDES') { |
1788
|
6
|
|
|
|
|
8
|
my $list = []; |
1789
|
6
|
50
|
|
|
|
14
|
(($token, $value) = $self->get_token('{')) || return; |
1790
|
6
|
|
|
|
|
16
|
while ($value ne '}') { |
1791
|
12
|
50
|
|
|
|
25
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1792
|
12
|
|
|
|
|
23
|
push @$list, $value; |
1793
|
|
|
|
|
|
|
# shoud be a ',' or a '}' |
1794
|
12
|
50
|
|
|
|
33
|
(($token, $value) = $self->get_token()) || return; |
1795
|
|
|
|
|
|
|
} |
1796
|
6
|
|
|
|
|
23
|
$$data{'supports'}{$name}{'includes'} = $list; |
1797
|
6
|
50
|
|
|
|
42
|
(($token, $value) = $self->get_token()) || return |
1798
|
|
|
|
|
|
|
} |
1799
|
6
|
|
|
|
|
20
|
while ($value eq 'VARIATION') { |
1800
|
8
|
50
|
|
|
|
18
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1801
|
8
|
|
|
|
|
11
|
my $val = $value; # ObjectName or NotificationName |
1802
|
8
|
50
|
|
|
|
18
|
(($token, $value) = $self->get_token()) || return; |
1803
|
8
|
100
|
|
|
|
21
|
if ($value eq 'SYNTAX') { |
1804
|
3
|
|
|
|
|
19
|
my $type = $self->parse_type(); |
1805
|
3
|
|
|
|
|
14
|
$$data{'supports'}{$name}{'variation'}{$val}{'syntax'} = $type; |
1806
|
3
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
1807
|
|
|
|
|
|
|
} |
1808
|
8
|
50
|
|
|
|
18
|
if ($value eq 'WRITE-SYNTAX') { |
1809
|
0
|
|
|
|
|
0
|
my $type = $self->parse_type(); |
1810
|
0
|
|
|
|
|
0
|
$$data{'supports'}{$name}{'variation'}{$val}{'write-syntax'} = $type; |
1811
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1812
|
|
|
|
|
|
|
} |
1813
|
8
|
100
|
|
|
|
18
|
if ($value eq 'ACCESS') { |
1814
|
2
|
50
|
|
|
|
34
|
(($token, $value) = $self->get_token()) || return; |
1815
|
2
|
50
|
|
|
|
15
|
if ($value =~ m/^(not-implemented|accessible-for-notify| |
1816
|
|
|
|
|
|
|
read-(only|write|create)|write-only)$/ox) { |
1817
|
2
|
|
|
|
|
12
|
$$data{'supports'}{$name}{'variation'}{$val}{'access'} = $value; |
1818
|
|
|
|
|
|
|
} |
1819
|
|
|
|
|
|
|
else { |
1820
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, |
1821
|
|
|
|
|
|
|
$self->{'lineno'}, "Unknown ACCESS type ($value)"); |
1822
|
|
|
|
|
|
|
} |
1823
|
2
|
50
|
|
|
|
7
|
(($token, $value) = $self->get_token()) || return; |
1824
|
|
|
|
|
|
|
} |
1825
|
8
|
100
|
|
|
|
20
|
if ($value eq 'CREATION-REQUIRES') { |
1826
|
2
|
|
|
|
|
4
|
my $list = []; |
1827
|
2
|
50
|
|
|
|
7
|
(($token, $value) = $self->get_token('{')) || return; |
1828
|
2
|
|
|
|
|
8
|
while ($value ne '}') { |
1829
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1830
|
2
|
|
|
|
|
5
|
push @$list, $value; |
1831
|
|
|
|
|
|
|
# shoud be a ',' or a '}' |
1832
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
1833
|
|
|
|
|
|
|
} |
1834
|
2
|
|
|
|
|
11
|
$$data{'supports'}{$name}{'variation'}{$val}{'creation-requires'} = |
1835
|
|
|
|
|
|
|
$list; |
1836
|
2
|
50
|
|
|
|
5
|
(($token, $value) = $self->get_token()) || return; |
1837
|
|
|
|
|
|
|
} |
1838
|
8
|
50
|
|
|
|
16
|
if ($value eq 'DEFVAL') { |
1839
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('{')) || return; |
1840
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1841
|
0
|
|
|
|
|
0
|
$$data{'supports'}{$name}{'variation'}{$val}{'defval'} = $value; |
1842
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('}')) || return; |
1843
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1844
|
|
|
|
|
|
|
} |
1845
|
8
|
50
|
|
|
|
19
|
if ($value eq 'DESCRIPTION') { |
1846
|
8
|
50
|
|
|
|
18
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1847
|
8
|
|
|
|
|
34
|
$$data{'supports'}{$name}{'variation'}{$val}{'description'} = $value; |
1848
|
8
|
50
|
|
|
|
17
|
(($token, $value) = $self->get_token()) || return; |
1849
|
|
|
|
|
|
|
} |
1850
|
|
|
|
|
|
|
else { |
1851
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, |
1852
|
|
|
|
|
|
|
$self->{'lineno'}, "Syntax error. 'DESCRIPTION' needed"); |
1853
|
|
|
|
|
|
|
} |
1854
|
|
|
|
|
|
|
} |
1855
|
|
|
|
|
|
|
} |
1856
|
7
|
100
|
|
|
|
17
|
if ($value eq 'SUPPORTS') { |
1857
|
|
|
|
|
|
|
# Modulename |
1858
|
6
|
50
|
|
|
|
13
|
(($token, $value) = $self->get_token()) || return; |
1859
|
6
|
|
|
|
|
9
|
$name = $value; |
1860
|
6
|
50
|
|
|
|
16
|
(($token, $value) = $self->get_token()) || return; |
1861
|
6
|
50
|
|
|
|
14
|
if ($token == $IDENTIFIER) { # ModuleIdentifier |
1862
|
0
|
|
|
|
|
0
|
$$data{'module'}{$name}{'identifier'} = $value; |
1863
|
|
|
|
|
|
|
} |
1864
|
|
|
|
|
|
|
else { |
1865
|
6
|
|
|
|
|
16
|
$self->unget_token(); |
1866
|
|
|
|
|
|
|
} |
1867
|
|
|
|
|
|
|
} |
1868
|
7
|
100
|
50
|
|
|
24
|
(($token, $value) = $self->get_token()) || return |
1869
|
|
|
|
|
|
|
unless $token == $ASSIGNMENT; |
1870
|
|
|
|
|
|
|
} |
1871
|
1
|
|
|
|
|
7
|
$$data{'oid'} = $self->parse_oid(); |
1872
|
1
|
|
|
|
|
7
|
$data; |
1873
|
|
|
|
|
|
|
} |
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
# Parse TRAP-TYPE macro (see RFC 1215) |
1876
|
|
|
|
|
|
|
sub parse_traptype { |
1877
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
1878
|
0
|
|
|
|
|
0
|
my $data; |
1879
|
|
|
|
|
|
|
|
1880
|
0
|
|
|
|
|
0
|
my ($token, $value); |
1881
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1882
|
0
|
0
|
|
|
|
0
|
if ($value eq 'ENTERPRISE') { |
1883
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1884
|
0
|
|
|
|
|
0
|
$$data{'enterprise'} = $value; |
1885
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1886
|
|
|
|
|
|
|
} |
1887
|
|
|
|
|
|
|
else { |
1888
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1889
|
|
|
|
|
|
|
"Syntax error. 'ENTERPRISE' needed"); |
1890
|
|
|
|
|
|
|
} |
1891
|
0
|
0
|
|
|
|
0
|
if ($value eq 'VARIABLES') { |
1892
|
0
|
|
|
|
|
0
|
my $list = []; |
1893
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('{')) || return; |
1894
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
1895
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
1896
|
0
|
|
|
|
|
0
|
push @$list, $value; |
1897
|
|
|
|
|
|
|
# shoud be a ',' or a '}' |
1898
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1899
|
|
|
|
|
|
|
} |
1900
|
0
|
|
|
|
|
0
|
$$data{'variables'} = $list; |
1901
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1902
|
|
|
|
|
|
|
} |
1903
|
0
|
0
|
|
|
|
0
|
if ($value eq 'DESCRIPTION') { |
1904
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1905
|
0
|
|
|
|
|
0
|
$$data{'description'} = $value; |
1906
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1907
|
|
|
|
|
|
|
} |
1908
|
0
|
0
|
|
|
|
0
|
if ($value eq 'REFERENCE') { |
1909
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1910
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
1911
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1912
|
|
|
|
|
|
|
} |
1913
|
0
|
0
|
|
|
|
0
|
if ($token == $ASSIGNMENT) { |
1914
|
0
|
0
|
|
|
|
0
|
(my $value = $self->get_token('NUMBER')) || return; |
1915
|
0
|
|
|
|
|
0
|
$$data{'value'} = $value; |
1916
|
|
|
|
|
|
|
} |
1917
|
|
|
|
|
|
|
else { |
1918
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1919
|
|
|
|
|
|
|
"Should be '::='instead of '$value'"); |
1920
|
|
|
|
|
|
|
} |
1921
|
0
|
|
|
|
|
0
|
$data; |
1922
|
|
|
|
|
|
|
} |
1923
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
# parse OBJECT-TYPE macro (see RFC 1902) |
1925
|
|
|
|
|
|
|
sub parse_objecttype { |
1926
|
2
|
|
|
2
|
0
|
4
|
my $self = shift; |
1927
|
2
|
|
|
|
|
3
|
my $data; |
1928
|
|
|
|
|
|
|
|
1929
|
2
|
|
|
|
|
4
|
my ($token, $value); |
1930
|
2
|
50
|
|
|
|
5
|
(($token, $value) = $self->get_token()) || return; |
1931
|
2
|
50
|
|
|
|
8
|
if ($value eq 'SYNTAX') { |
1932
|
2
|
|
|
|
|
3
|
my $syntax = {}; |
1933
|
2
|
|
|
|
|
4
|
my $type; |
1934
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
1935
|
2
|
50
|
33
|
|
|
13
|
if ($self->{'accept_smiv2'} && $value eq 'BITS') { |
1936
|
0
|
|
|
|
|
0
|
$$type{'type'} = $value; |
1937
|
0
|
0
|
|
|
|
0
|
$self->get_token('{') || return; |
1938
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
1939
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1940
|
0
|
|
|
|
|
0
|
my $identifier = $value; |
1941
|
0
|
0
|
|
|
|
0
|
$self->get_token('(') || return; |
1942
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('NUMBER')) || return; |
1943
|
0
|
|
|
|
|
0
|
$$type{'values'}{$value} = $identifier; |
1944
|
0
|
0
|
|
|
|
0
|
$self->get_token(')') || return; |
1945
|
|
|
|
|
|
|
# should be ',' or ')' |
1946
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1947
|
|
|
|
|
|
|
} |
1948
|
|
|
|
|
|
|
} |
1949
|
|
|
|
|
|
|
else { |
1950
|
2
|
|
|
|
|
7
|
$self->unget_token(); |
1951
|
2
|
|
|
|
|
9
|
$type = $self->parse_type; |
1952
|
|
|
|
|
|
|
} |
1953
|
2
|
|
|
|
|
6
|
my $subtype = $self->parse_subtype(); |
1954
|
2
|
|
|
|
|
7
|
my $ref = ref $type; |
1955
|
2
|
50
|
33
|
|
|
13
|
if (defined $ref && $ref eq 'HASH') { |
1956
|
2
|
|
|
|
|
9
|
for my $key (keys %$type) { |
1957
|
3
|
|
|
|
|
10
|
$$syntax{$key} = $$type{$key}; |
1958
|
|
|
|
|
|
|
} |
1959
|
|
|
|
|
|
|
} |
1960
|
|
|
|
|
|
|
else { # should not happen |
1961
|
0
|
|
|
|
|
0
|
$$syntax{'type'} = $type; |
1962
|
|
|
|
|
|
|
} |
1963
|
2
|
50
|
|
|
|
6
|
if ($subtype) { |
1964
|
0
|
|
|
|
|
0
|
for my $key (keys %$subtype) { |
1965
|
0
|
|
|
|
|
0
|
$$syntax{$key} = $$subtype{$key}; |
1966
|
|
|
|
|
|
|
} |
1967
|
|
|
|
|
|
|
} |
1968
|
2
|
|
|
|
|
6
|
$$data{'syntax'} = $syntax; |
1969
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
1970
|
|
|
|
|
|
|
} |
1971
|
|
|
|
|
|
|
else { |
1972
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1973
|
|
|
|
|
|
|
"'SYNTAX' needed"); |
1974
|
|
|
|
|
|
|
} |
1975
|
2
|
50
|
33
|
|
|
29
|
if ($self->{'accept_smiv2'} && $value eq 'UNITS') { |
1976
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
1977
|
0
|
|
|
|
|
0
|
$$data{'units'} = $value; |
1978
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1979
|
|
|
|
|
|
|
} |
1980
|
2
|
50
|
33
|
|
|
11
|
if ($value eq 'ACCESS' || $value eq 'MAX-ACCESS') { |
1981
|
2
|
50
|
|
|
|
6
|
if ($value eq 'MAX-ACCESS') { |
1982
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1983
|
|
|
|
|
|
|
"Syntax error at $value") unless $self->{'accept_smiv2'}; |
1984
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
1985
|
0
|
0
|
|
|
|
0
|
if ($value =~ m/^(read-(only|write)|not-accessible| |
1986
|
|
|
|
|
|
|
accessible-for-notify|read-create)$/ox) { |
1987
|
|
|
|
|
|
|
# Valid SMIv2 acces type (rfc 1902, draft-ops-smiv2-smi-01) |
1988
|
0
|
|
|
|
|
0
|
$$data{'access'} = $value; |
1989
|
|
|
|
|
|
|
} |
1990
|
|
|
|
|
|
|
else { |
1991
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1992
|
|
|
|
|
|
|
"Unknown acces type ($value)"); |
1993
|
|
|
|
|
|
|
} |
1994
|
|
|
|
|
|
|
} |
1995
|
|
|
|
|
|
|
else { # 'ACCESS' |
1996
|
2
|
50
|
|
|
|
7
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
1997
|
|
|
|
|
|
|
"Syntax error at $value") unless $self->{'accept_smiv1'}; |
1998
|
2
|
50
|
|
|
|
5
|
(($token, $value) = $self->get_token()) || return; |
1999
|
2
|
50
|
|
|
|
16
|
if ($value =~ m/^(read-(only|write)|write-only|not-accessible)$/o) { |
2000
|
|
|
|
|
|
|
# Valid SMIv1 acces type (rfc 1155, rfc 1212) |
2001
|
2
|
|
|
|
|
7
|
$$data{'access'} = $value; |
2002
|
|
|
|
|
|
|
} |
2003
|
|
|
|
|
|
|
else { |
2004
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2005
|
|
|
|
|
|
|
"Unknown acces type ($value)"); |
2006
|
|
|
|
|
|
|
} |
2007
|
|
|
|
|
|
|
} |
2008
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
2009
|
|
|
|
|
|
|
} |
2010
|
|
|
|
|
|
|
else { |
2011
|
0
|
0
|
0
|
|
|
0
|
if ($self->{'accept_smiv1'} && !$self->{'accept_smiv2'}) { |
|
|
0
|
0
|
|
|
|
|
2012
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2013
|
|
|
|
|
|
|
"Syntax error. 'ACCESS' needed"); |
2014
|
|
|
|
|
|
|
} |
2015
|
|
|
|
|
|
|
elsif (!$self->{'accept_smiv1'} && $self->{'accept_smiv2'}) { |
2016
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2017
|
|
|
|
|
|
|
"Syntax error. 'MAX-ACCESS' needed"); |
2018
|
|
|
|
|
|
|
} |
2019
|
|
|
|
|
|
|
else { |
2020
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2021
|
|
|
|
|
|
|
"Syntax error. 'ACCESS' or 'MAX-ACCESS' needed"); |
2022
|
|
|
|
|
|
|
} |
2023
|
|
|
|
|
|
|
} |
2024
|
2
|
50
|
|
|
|
7
|
if ($value eq 'STATUS') { |
2025
|
2
|
50
|
|
|
|
5
|
(($token, $value) = $self->get_token()) || return; |
2026
|
2
|
50
|
33
|
|
|
21
|
if ($self->{'accept_smiv1'} && |
|
|
0
|
0
|
|
|
|
|
2027
|
|
|
|
|
|
|
$value =~ m/^(mandatory|optional|obsolete|deprecated)$/o) { |
2028
|
|
|
|
|
|
|
# Valid SMIv1 status (rfc 1155) |
2029
|
|
|
|
|
|
|
# add 'deprecated' (rfc 1158, rfc 1212) |
2030
|
2
|
|
|
|
|
5
|
$$data{'status'} = $value; |
2031
|
|
|
|
|
|
|
} |
2032
|
|
|
|
|
|
|
elsif ($self->{'accept_smiv2'} && |
2033
|
|
|
|
|
|
|
$value =~ m/^(current|obsolete|deprecated)$/o) { |
2034
|
|
|
|
|
|
|
# Valid SMIv2 status (rfc 1902, draft-ops-smiv2-smi-01) |
2035
|
0
|
|
|
|
|
0
|
$$data{'status'} = $value; |
2036
|
|
|
|
|
|
|
} |
2037
|
|
|
|
|
|
|
else { |
2038
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2039
|
|
|
|
|
|
|
"Unknown status ($value)"); |
2040
|
|
|
|
|
|
|
} |
2041
|
2
|
50
|
|
|
|
6
|
(($token, $value) = $self->get_token()) || return; |
2042
|
|
|
|
|
|
|
} |
2043
|
|
|
|
|
|
|
else { |
2044
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2045
|
|
|
|
|
|
|
"Syntax error. 'STATUS' needed"); |
2046
|
|
|
|
|
|
|
} |
2047
|
2
|
50
|
|
|
|
7
|
if ($value eq 'DESCRIPTION') { |
2048
|
2
|
50
|
|
|
|
7
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
2049
|
2
|
|
|
|
|
6
|
$$data{'description'} = $value; |
2050
|
2
|
50
|
|
|
|
13
|
(($token, $value) = $self->get_token()) || return; |
2051
|
|
|
|
|
|
|
} |
2052
|
|
|
|
|
|
|
else { |
2053
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2054
|
|
|
|
|
|
|
"Syntax error. 'STATUS' needed") unless $self->{'accept_smiv1'}; |
2055
|
|
|
|
|
|
|
} |
2056
|
2
|
50
|
|
|
|
8
|
if ($value eq 'REFERENCE') { |
2057
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('CSTRING')) || return; |
2058
|
0
|
|
|
|
|
0
|
$$data{'reference'} = $value; |
2059
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2060
|
|
|
|
|
|
|
} |
2061
|
2
|
50
|
|
|
|
5
|
if ($value eq 'INDEX') { |
2062
|
0
|
|
|
|
|
0
|
my $list = []; |
2063
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('{')) || return; |
2064
|
0
|
|
|
|
|
0
|
while ($value ne '}') { |
2065
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2066
|
0
|
|
|
|
|
0
|
my $implied = 0; |
2067
|
0
|
0
|
|
|
|
0
|
if ($value eq 'IMPLIED') { |
2068
|
0
|
|
|
|
|
0
|
$implied++; |
2069
|
0
|
|
|
|
|
0
|
(($token, $value) = $self->get_token('IDENTIFIER')); |
2070
|
|
|
|
|
|
|
} |
2071
|
0
|
|
|
|
|
0
|
push @$list, { 'value' => $value, 'implied' => $implied }; |
2072
|
|
|
|
|
|
|
# shoud be a ',' or a '}' |
2073
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2074
|
|
|
|
|
|
|
} |
2075
|
0
|
|
|
|
|
0
|
$$data{'index'} = $list; |
2076
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2077
|
|
|
|
|
|
|
} |
2078
|
2
|
50
|
33
|
|
|
9
|
if ($value eq 'AUGMENTS' && $self->{'accept_smiv2'}) { |
2079
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2080
|
|
|
|
|
|
|
"Can't define both 'INDEX' and 'AUGMENTS'") if defined $$data{'index'}; |
2081
|
0
|
0
|
|
|
|
0
|
$self->get_token('{') || return; |
2082
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('IDENTIFIER')) || return; |
2083
|
0
|
|
|
|
|
0
|
$$data{'augments'} = $value; |
2084
|
0
|
0
|
|
|
|
0
|
$self->get_token('}') || return; |
2085
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2086
|
|
|
|
|
|
|
} |
2087
|
2
|
50
|
|
|
|
6
|
if ($value eq 'DEFVAL') { |
2088
|
|
|
|
|
|
|
# SMIv1: rfc 1212 |
2089
|
|
|
|
|
|
|
# SMIv2: rfc 1902 |
2090
|
0
|
0
|
|
|
|
0
|
$self->get_token('{') || return; |
2091
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2092
|
0
|
0
|
|
|
|
0
|
if ($value eq '-') { |
2093
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2094
|
0
|
|
|
|
|
0
|
$value = "-" . $value; |
2095
|
|
|
|
|
|
|
} |
2096
|
0
|
0
|
|
|
|
0
|
$self->get_token('}') || return; |
2097
|
0
|
|
|
|
|
0
|
$$data{'defval'} = $value; |
2098
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2099
|
|
|
|
|
|
|
} |
2100
|
2
|
50
|
|
|
|
8
|
if ($token == $ASSIGNMENT) { |
2101
|
2
|
|
|
|
|
8
|
my $oid = $self->parse_oid(); |
2102
|
2
|
|
|
|
|
11
|
$$data{'oid'} = $oid; |
2103
|
|
|
|
|
|
|
} |
2104
|
|
|
|
|
|
|
else { |
2105
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2106
|
|
|
|
|
|
|
"should be ::="); |
2107
|
|
|
|
|
|
|
} |
2108
|
2
|
|
|
|
|
11
|
$data; |
2109
|
|
|
|
|
|
|
} |
2110
|
|
|
|
|
|
|
|
2111
|
|
|
|
|
|
|
# parse an OBJECT IDENTIFIER clause |
2112
|
|
|
|
|
|
|
# note: everything except the value has already been parsed. |
2113
|
|
|
|
|
|
|
sub parse_oid { |
2114
|
6
|
|
|
6
|
0
|
16
|
my $self = shift; |
2115
|
|
|
|
|
|
|
# |
2116
|
|
|
|
|
|
|
# internet OBJECT IDENTIFIER ::= { iso org(3) dod(6) 1 } |
2117
|
|
|
|
|
|
|
# mgmt OBJECT IDENTIFIER ::= { internet 2 } |
2118
|
|
|
|
|
|
|
# ^^^^^^^^^^^^^^^^^^^^^^^ |
2119
|
|
|
|
|
|
|
# |
2120
|
6
|
|
|
|
|
10
|
my ($list, $old, $old2); |
2121
|
6
|
50
|
|
|
|
18
|
$self->get_token('{') || return; |
2122
|
6
|
|
|
|
|
13
|
my ($token, $value); |
2123
|
6
|
50
|
|
|
|
14
|
(($token, $value) = $self->get_token()) || return; |
2124
|
6
|
|
66
|
|
|
46
|
while (defined $token && $value ne '}') { |
2125
|
12
|
50
|
66
|
|
|
51
|
if ($token == $IDENTIFIER || |
|
|
0
|
|
|
|
|
|
2126
|
|
|
|
|
|
|
$token == $NUMBER) { |
2127
|
12
|
|
|
|
|
31
|
push @$list, $value; |
2128
|
12
|
|
|
|
|
14
|
$old2 = $old; |
2129
|
12
|
|
|
|
|
19
|
$old = $value; |
2130
|
|
|
|
|
|
|
} |
2131
|
|
|
|
|
|
|
elsif ($value eq '(') { |
2132
|
0
|
0
|
0
|
|
|
0
|
if ($old2 && $old) { |
2133
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token('NUMBER')) || return; |
2134
|
0
|
0
|
|
|
|
0
|
$self->get_token(')') || return; |
2135
|
|
|
|
|
|
|
# Add this to the tree |
2136
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$old}{'oid'} = [ $old2, $value ]; |
2137
|
|
|
|
|
|
|
} |
2138
|
|
|
|
|
|
|
else { |
2139
|
|
|
|
|
|
|
# These syntaxes are incorrect: |
2140
|
|
|
|
|
|
|
# { iso(1) ...} |
2141
|
|
|
|
|
|
|
# { (1) ... } |
2142
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2143
|
|
|
|
|
|
|
"Syntax error"); |
2144
|
|
|
|
|
|
|
} |
2145
|
|
|
|
|
|
|
} |
2146
|
|
|
|
|
|
|
else { |
2147
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2148
|
|
|
|
|
|
|
"Syntax error"); |
2149
|
|
|
|
|
|
|
} |
2150
|
12
|
50
|
|
|
|
47
|
(($token, $value) = $self->get_token()) || return; |
2151
|
|
|
|
|
|
|
} |
2152
|
6
|
|
|
|
|
22
|
$list; |
2153
|
|
|
|
|
|
|
} |
2154
|
|
|
|
|
|
|
|
2155
|
|
|
|
|
|
|
# parse an IMPORTS clause. |
2156
|
|
|
|
|
|
|
# note: the 'IMPORTS' keyword has already been parsed. |
2157
|
|
|
|
|
|
|
sub parse_imports { |
2158
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
2159
|
|
|
|
|
|
|
# |
2160
|
|
|
|
|
|
|
# IMPORT a, b, c FROM mib-foo |
2161
|
|
|
|
|
|
|
# d, e, f, g FROM mib-bar; |
2162
|
|
|
|
|
|
|
# |
2163
|
0
|
|
|
|
|
0
|
my ($list, $data); |
2164
|
0
|
|
|
|
|
0
|
my $elem = 0; |
2165
|
0
|
|
|
|
|
0
|
my ($token, $value); |
2166
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2167
|
0
|
|
0
|
|
|
0
|
while (defined $token && $value ne ';') { |
2168
|
0
|
0
|
0
|
|
|
0
|
if ($token == $IDENTIFIER || |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2169
|
|
|
|
|
|
|
$token == $TYPEMODREFERENCE) { |
2170
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2171
|
|
|
|
|
|
|
"two values must be separated by a comma") if $elem; |
2172
|
0
|
|
|
|
|
0
|
push @$list, $value; |
2173
|
0
|
|
|
|
|
0
|
$elem = 1; |
2174
|
|
|
|
|
|
|
} |
2175
|
|
|
|
|
|
|
elsif ($value eq ',') { |
2176
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2177
|
|
|
|
|
|
|
"value expected. ',' found") unless $elem; |
2178
|
0
|
|
|
|
|
0
|
$elem = 0; |
2179
|
|
|
|
|
|
|
} |
2180
|
|
|
|
|
|
|
elsif ($token == $FROM) { |
2181
|
0
|
|
|
|
|
0
|
$elem = 0; |
2182
|
0
|
|
|
|
|
0
|
my $oldvalue = $value; |
2183
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2184
|
0
|
0
|
0
|
|
|
0
|
if ($token == $IDENTIFIER || |
2185
|
|
|
|
|
|
|
$token == $TYPEMODREFERENCE) { |
2186
|
0
|
|
|
|
|
0
|
my @l; |
2187
|
0
|
0
|
|
|
|
0
|
@l = @{$$data{$value}} if defined $$data{$value}; |
|
0
|
|
|
|
|
0
|
|
2188
|
0
|
|
|
|
|
0
|
push @l, @$list; |
2189
|
0
|
|
|
|
|
0
|
$$data{$value} = \@l; |
2190
|
0
|
|
|
|
|
0
|
undef $list; |
2191
|
|
|
|
|
|
|
} |
2192
|
|
|
|
|
|
|
else { |
2193
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2194
|
|
|
|
|
|
|
"identifier expected after '$oldvalue'"); |
2195
|
|
|
|
|
|
|
} |
2196
|
|
|
|
|
|
|
|
2197
|
|
|
|
|
|
|
} |
2198
|
|
|
|
|
|
|
else { |
2199
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2200
|
|
|
|
|
|
|
"syntax error while parsing IMPORTS clause"); |
2201
|
|
|
|
|
|
|
} |
2202
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2203
|
|
|
|
|
|
|
} |
2204
|
0
|
|
|
|
|
0
|
$data; |
2205
|
|
|
|
|
|
|
} |
2206
|
|
|
|
|
|
|
|
2207
|
|
|
|
|
|
|
# parse an EXPORTS clause. |
2208
|
|
|
|
|
|
|
# note: the 'EXPORTS' keyword has already been parsed. |
2209
|
|
|
|
|
|
|
sub parse_exports { |
2210
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
2211
|
|
|
|
|
|
|
# |
2212
|
|
|
|
|
|
|
# EXPORTS a, b, c; |
2213
|
|
|
|
|
|
|
# |
2214
|
0
|
|
|
|
|
0
|
my $list; |
2215
|
0
|
|
|
|
|
0
|
my $elem = 0; |
2216
|
0
|
|
|
|
|
0
|
my ($token, $value); |
2217
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2218
|
0
|
|
0
|
|
|
0
|
while (defined $token && $value ne ';') { |
2219
|
0
|
0
|
0
|
|
|
0
|
if ($token == $IDENTIFIER || |
|
|
0
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
$token == $TYPEMODREFERENCE) { |
2221
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2222
|
|
|
|
|
|
|
"two values must be separated by a comma") if $elem; |
2223
|
0
|
|
|
|
|
0
|
push @$list, $value; |
2224
|
0
|
|
|
|
|
0
|
$elem = 1; |
2225
|
|
|
|
|
|
|
} |
2226
|
|
|
|
|
|
|
elsif ($value eq ',') { |
2227
|
0
|
0
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2228
|
|
|
|
|
|
|
"value expected. ',' found") unless $elem; |
2229
|
0
|
|
|
|
|
0
|
$elem = 0; |
2230
|
|
|
|
|
|
|
} |
2231
|
|
|
|
|
|
|
else { |
2232
|
0
|
|
|
|
|
0
|
return $self->assert(MIBERROR, $self->{'filename'}, $self->{'lineno'}, |
2233
|
|
|
|
|
|
|
"syntax error while parsing EXPORTS clause"); |
2234
|
|
|
|
|
|
|
} |
2235
|
0
|
0
|
|
|
|
0
|
(($token, $value) = $self->get_token()) || return; |
2236
|
|
|
|
|
|
|
} |
2237
|
0
|
|
|
|
|
0
|
$list; |
2238
|
|
|
|
|
|
|
} |
2239
|
|
|
|
|
|
|
|
2240
|
|
|
|
|
|
|
sub import_modules { |
2241
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
2242
|
|
|
|
|
|
|
|
2243
|
0
|
|
|
|
|
0
|
for my $k (keys %{$self->{'imports'}}) { |
|
0
|
|
|
|
|
0
|
|
2244
|
0
|
0
|
|
|
|
0
|
warn "DEBUG: importing $k...\n" if $self->{'debug_lexer'}; |
2245
|
0
|
|
|
|
|
0
|
my $mib = new SNMP::MIB::Compiler(); |
2246
|
0
|
|
|
|
|
0
|
$mib->repository($self->repository); |
2247
|
0
|
|
|
|
|
0
|
$mib->extensions($self->extensions); |
2248
|
0
|
|
|
|
|
0
|
$mib->{'srcpath'} = $self->{'srcpath'}; |
2249
|
|
|
|
|
|
|
|
2250
|
0
|
|
|
|
|
0
|
$mib->{'make_dump'} = $self->{'make_dump'}; |
2251
|
0
|
|
|
|
|
0
|
$mib->{'use_dump'} = $self->{'use_dump'}; |
2252
|
0
|
|
|
|
|
0
|
$mib->{'do_imports'} = $self->{'do_imports'}; |
2253
|
|
|
|
|
|
|
|
2254
|
0
|
|
|
|
|
0
|
$mib->{'allow_underscore'} = $self->{'allow_underscore'}; |
2255
|
0
|
|
|
|
|
0
|
$mib->{'allow_lowcase_hstrings'} = $self->{'allow_lowcase_hstrings'}; |
2256
|
0
|
|
|
|
|
0
|
$mib->{'allow_lowcase_bstrings'} = $self->{'allow_lowcase_bstrings'}; |
2257
|
|
|
|
|
|
|
|
2258
|
0
|
0
|
|
|
|
0
|
if ($self->{'debug_recursive'}) { |
2259
|
0
|
|
|
|
|
0
|
$mib->{'debug_recursive'} = $self->{'debug_recursive'}; |
2260
|
0
|
|
|
|
|
0
|
$mib->{'debug_lexer'} = $self->{'debug_lexer'}; |
2261
|
|
|
|
|
|
|
} |
2262
|
0
|
0
|
|
|
|
0
|
$mib->load($k) || $mib->compile($k); |
2263
|
0
|
|
|
|
|
0
|
for my $item (@{$self->{'imports'}{$k}}) { |
|
0
|
|
|
|
|
0
|
|
2264
|
0
|
0
|
|
|
|
0
|
warn "DEBUG: importing symbol $item from $k for $self->{'name'}...\n" |
2265
|
|
|
|
|
|
|
if $self->{'debug_lexer'}; |
2266
|
0
|
0
|
|
|
|
0
|
if (defined $mib->{'nodes'}{$item}) { |
|
|
0
|
|
|
|
|
|
2267
|
|
|
|
|
|
|
# resolve OID to break the dependencies |
2268
|
0
|
|
|
|
|
0
|
my @a = split /\./, $mib->convert_oid($mib->resolve_oid($item)); |
2269
|
0
|
|
|
|
|
0
|
my @l = @{$mib->{'nodes'}{$item}{'OID'}}; |
|
0
|
|
|
|
|
0
|
|
2270
|
0
|
|
|
|
|
0
|
$a[$#a] = $l[$#l]; |
2271
|
0
|
|
|
|
|
0
|
@{$mib->{'nodes'}{$item}{'oid'}} = @a; |
|
0
|
|
|
|
|
0
|
|
2272
|
0
|
|
|
|
|
0
|
shift @l; |
2273
|
0
|
|
|
|
|
0
|
my $last = pop @l; |
2274
|
0
|
|
|
|
|
0
|
for my $elem (@l) { |
2275
|
0
|
0
|
|
|
|
0
|
last unless $elem =~ m/^\d+$/o; |
2276
|
0
|
|
|
|
|
0
|
my $o = shift @a; |
2277
|
0
|
|
|
|
|
0
|
$self->{'tree'}{$o}{$elem} = $a[0]; |
2278
|
|
|
|
|
|
|
} |
2279
|
0
|
0
|
|
|
|
0
|
$self->{'tree'}{$a[0]}{$last} = $item if scalar @a == 1; |
2280
|
0
|
|
|
|
|
0
|
$self->{'nodes'}{$item} = $mib->{'nodes'}{$item}; |
2281
|
|
|
|
|
|
|
} |
2282
|
|
|
|
|
|
|
elsif (defined $mib->{'types'}{$item}) { |
2283
|
0
|
|
|
|
|
0
|
$self->{'types'}{$item} = $mib->{'types'}{$item}; |
2284
|
|
|
|
|
|
|
} |
2285
|
|
|
|
|
|
|
else { |
2286
|
0
|
|
|
|
|
0
|
my $found = 0; |
2287
|
0
|
|
|
|
|
0
|
for my $macro (@{$mib->{'macros'}}) { |
|
0
|
|
|
|
|
0
|
|
2288
|
0
|
0
|
|
|
|
0
|
$found++, push (@{$self->{'macros'}}, $item) if $macro eq $item; |
|
0
|
|
|
|
|
0
|
|
2289
|
|
|
|
|
|
|
} |
2290
|
0
|
0
|
|
|
|
0
|
$self->assert(MIBWARN, $self->{'filename'}, $self->{'lineno'}, |
2291
|
|
|
|
|
|
|
"can't find '$item' in $k") unless $found; |
2292
|
|
|
|
|
|
|
} |
2293
|
|
|
|
|
|
|
} |
2294
|
0
|
0
|
|
|
|
0
|
warn "DEBUG: $k imported.\n" if $self->{'debug_lexer'}; |
2295
|
|
|
|
|
|
|
} |
2296
|
|
|
|
|
|
|
} |
2297
|
|
|
|
|
|
|
|
2298
|
|
|
|
|
|
|
# Where the MIBs are stored |
2299
|
|
|
|
|
|
|
sub repository { |
2300
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
2301
|
0
|
|
|
|
|
0
|
my $dir = shift; |
2302
|
|
|
|
|
|
|
|
2303
|
0
|
0
|
|
|
|
0
|
$self->{'repository'} = $dir if defined $dir; |
2304
|
0
|
|
|
|
|
0
|
return $self->{'repository'}; |
2305
|
|
|
|
|
|
|
} |
2306
|
|
|
|
|
|
|
|
2307
|
|
|
|
|
|
|
# Add some paths to the list of possible MIB locations |
2308
|
|
|
|
|
|
|
sub add_path { |
2309
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
2310
|
|
|
|
|
|
|
|
2311
|
0
|
0
|
|
|
|
0
|
croak "Usage: Compiler::addpath(path1[,path2[,path3]])" if $#_ == -1; |
2312
|
0
|
|
|
|
|
0
|
while (defined (my $path = shift)) { |
2313
|
0
|
|
|
|
|
0
|
push @{$self->{'srcpath'}}, $path; |
|
0
|
|
|
|
|
0
|
|
2314
|
|
|
|
|
|
|
} |
2315
|
0
|
|
|
|
|
0
|
@{$self->{'srcpath'}}; |
|
0
|
|
|
|
|
0
|
|
2316
|
|
|
|
|
|
|
} |
2317
|
|
|
|
|
|
|
|
2318
|
|
|
|
|
|
|
# List of possible MIB filename extensions |
2319
|
|
|
|
|
|
|
sub extensions { |
2320
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
2321
|
0
|
|
|
|
|
0
|
my $ext = shift; |
2322
|
|
|
|
|
|
|
|
2323
|
0
|
0
|
|
|
|
0
|
$self->{'extensions'} = $ext if defined $ext; |
2324
|
0
|
|
|
|
|
0
|
return $self->{'extensions'}; |
2325
|
|
|
|
|
|
|
} |
2326
|
|
|
|
|
|
|
|
2327
|
|
|
|
|
|
|
# Add some possible MIB filename extensions |
2328
|
|
|
|
|
|
|
sub add_extension { |
2329
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
2330
|
|
|
|
|
|
|
|
2331
|
0
|
0
|
|
|
|
0
|
croak "Usage: Compiler::extension(ext1[,ext2[,ext3]])" if $#_ == -1; |
2332
|
0
|
|
|
|
|
0
|
while (defined (my $ext = shift)) { |
2333
|
0
|
|
|
|
|
0
|
push @{$self->{'extensions'}}, $ext; |
|
0
|
|
|
|
|
0
|
|
2334
|
|
|
|
|
|
|
} |
2335
|
|
|
|
|
|
|
} |
2336
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
my $treemodes = {'read-only' => '-r-', |
2338
|
|
|
|
|
|
|
'read-write' => '-rw', |
2339
|
|
|
|
|
|
|
'read-create' => 'cr-', |
2340
|
|
|
|
|
|
|
'write-only' => '--w', |
2341
|
|
|
|
|
|
|
'not-accessible' => '---', |
2342
|
|
|
|
|
|
|
'accessible-for-notify' => 'n--', |
2343
|
|
|
|
|
|
|
'not-implemented' => 'i--', |
2344
|
|
|
|
|
|
|
}; |
2345
|
|
|
|
|
|
|
|
2346
|
|
|
|
|
|
|
my $treetypes = {'SEQUENCE' => '', |
2347
|
|
|
|
|
|
|
'CHOICE' => '', |
2348
|
|
|
|
|
|
|
'INTEGER' => 'Integer', |
2349
|
|
|
|
|
|
|
'OCTET STRING' => 'String', |
2350
|
|
|
|
|
|
|
'OBJECT IDENTIFIER' => 'ObjectID', |
2351
|
|
|
|
|
|
|
'NULL' => 'Null', |
2352
|
|
|
|
|
|
|
'IpAddress' => 'IPAddr', |
2353
|
|
|
|
|
|
|
'Counter' => 'Counter', |
2354
|
|
|
|
|
|
|
'Gauge' => 'Gauge', |
2355
|
|
|
|
|
|
|
'TimeTicks' => 'TimeTcks', |
2356
|
|
|
|
|
|
|
'Opaque' => 'Opaque', |
2357
|
|
|
|
|
|
|
'Integer32' => 'Int32', |
2358
|
|
|
|
|
|
|
'Counter32' => 'Count32', |
2359
|
|
|
|
|
|
|
'Gauge32' => 'Gauge32', |
2360
|
|
|
|
|
|
|
'Unsigned32' => 'UInt32', |
2361
|
|
|
|
|
|
|
'Counter64' => 'Count64', |
2362
|
|
|
|
|
|
|
}; |
2363
|
|
|
|
|
|
|
|
2364
|
|
|
|
|
|
|
# return an ASCII driagram showing the tree under the given node |
2365
|
|
|
|
|
|
|
sub tree { |
2366
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
2367
|
0
|
|
|
|
|
0
|
my $node = shift; |
2368
|
0
|
|
|
|
|
0
|
my $level = shift; |
2369
|
0
|
|
|
|
|
0
|
my $inc = shift; |
2370
|
0
|
|
|
|
|
0
|
my $s = shift; |
2371
|
|
|
|
|
|
|
|
2372
|
0
|
0
|
|
|
|
0
|
$level = 0 unless defined $level; |
2373
|
0
|
0
|
|
|
|
0
|
$inc = 4 unless defined $inc; |
2374
|
|
|
|
|
|
|
|
2375
|
0
|
0
|
|
|
|
0
|
return $level ? $s : "$node\n" unless defined $self->{'tree'}{$node}; |
|
|
0
|
|
|
|
|
|
2376
|
0
|
0
|
|
|
|
0
|
unless ($level) { |
2377
|
0
|
|
|
|
|
0
|
$s .= $node . "\n"; |
2378
|
0
|
|
|
|
|
0
|
$s .= " |\n"; |
2379
|
|
|
|
|
|
|
} |
2380
|
0
|
|
|
|
|
0
|
for my $n (sort { $a <=> $b } keys %{$self->{'tree'}{$node}}) { |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2381
|
0
|
|
|
|
|
0
|
my $new = $self->{'tree'}{$node}{$n}; |
2382
|
0
|
|
|
|
|
0
|
$s .= " "; |
2383
|
0
|
|
|
|
|
0
|
$s .= " " x ($inc * $level) . "+-- "; |
2384
|
0
|
|
|
|
|
0
|
my $access = ""; |
2385
|
0
|
0
|
0
|
|
|
0
|
$access = $$treemodes{$self->{'nodes'}{$new}{'access'}} || "???" |
2386
|
|
|
|
|
|
|
if defined $self->{'nodes'}{$new}{'access'}; |
2387
|
0
|
0
|
|
|
|
0
|
$access .= " " if $access; |
2388
|
0
|
|
|
|
|
0
|
my $type = ""; |
2389
|
0
|
0
|
0
|
|
|
0
|
$type = $self->{'nodes'}{$new}{'syntax'}{'type'} if |
2390
|
|
|
|
|
|
|
defined $self->{'nodes'}{$new}{'syntax'} && |
2391
|
|
|
|
|
|
|
defined $self->{'nodes'}{$new}{'syntax'}{'type'}; |
2392
|
0
|
0
|
|
|
|
0
|
if ($type) { |
2393
|
0
|
|
|
|
|
0
|
$type = $self->resolve_type($type); |
2394
|
0
|
0
|
|
|
|
0
|
$type = sprintf "%-8.8s ", defined $$treetypes{$type} ? |
2395
|
|
|
|
|
|
|
$$treetypes{$type} : $type; |
2396
|
0
|
0
|
|
|
|
0
|
$type = "" if $type =~ m/^\s+$/o; |
2397
|
|
|
|
|
|
|
} |
2398
|
0
|
|
|
|
|
0
|
$s .= $access . $type . $new . '(' . $n . ")\n"; |
2399
|
0
|
0
|
|
|
|
0
|
if (defined $self->{'tree'}{$new}) { |
2400
|
0
|
|
|
|
|
0
|
$s .= " "; |
2401
|
0
|
|
|
|
|
0
|
$s .= " " x ($inc * ($level + 1)) . "|\n"; |
2402
|
0
|
|
|
|
|
0
|
$s = $self->tree($new, $level + 1, $inc, $s); |
2403
|
|
|
|
|
|
|
} |
2404
|
|
|
|
|
|
|
} |
2405
|
0
|
|
|
|
|
0
|
$s; |
2406
|
|
|
|
|
|
|
} |
2407
|
|
|
|
|
|
|
|
2408
|
|
|
|
|
|
|
########################################################################### |
2409
|
|
|
|
|
|
|
package Stream; |
2410
|
|
|
|
|
|
|
|
2411
|
7
|
|
|
7
|
|
174908
|
use strict; |
|
7
|
|
|
|
|
24
|
|
|
7
|
|
|
|
|
490
|
|
2412
|
7
|
|
|
7
|
|
45
|
use vars qw($VERSION); |
|
7
|
|
|
|
|
17
|
|
|
7
|
|
|
|
|
4133
|
|
2413
|
|
|
|
|
|
|
|
2414
|
|
|
|
|
|
|
$VERSION = 1.00; |
2415
|
|
|
|
|
|
|
|
2416
|
|
|
|
|
|
|
sub new { |
2417
|
7
|
|
|
7
|
|
112
|
my $this = shift; |
2418
|
7
|
|
|
|
|
27
|
my $fh = shift; |
2419
|
7
|
|
33
|
|
|
116
|
my $class = ref($this) || $this; |
2420
|
7
|
|
|
|
|
26
|
my $self = {}; |
2421
|
7
|
|
|
|
|
15
|
bless $self, $class; |
2422
|
7
|
|
|
|
|
61
|
$self->{'fh'} = $fh; |
2423
|
7
|
|
|
|
|
25
|
$self->{'lineno'} = 1; |
2424
|
7
|
|
|
|
|
18
|
$self->{'saved'} = 0; |
2425
|
7
|
|
|
|
|
29
|
$self; |
2426
|
|
|
|
|
|
|
} |
2427
|
|
|
|
|
|
|
|
2428
|
|
|
|
|
|
|
sub getc { |
2429
|
7675
|
|
|
7675
|
|
8597
|
my $self = shift; |
2430
|
|
|
|
|
|
|
|
2431
|
7675
|
|
|
|
|
7495
|
my $char; |
2432
|
7675
|
100
|
|
|
|
24652
|
if ($self->{'saved'}) { |
|
|
50
|
|
|
|
|
|
2433
|
360
|
|
|
|
|
517
|
$char = $self->{'save'}; |
2434
|
360
|
|
|
|
|
449
|
$self->{'saved'} = 0; |
2435
|
360
|
100
|
|
|
|
751
|
$self->{'lineno'}++ if $char eq "\n"; |
2436
|
|
|
|
|
|
|
} |
2437
|
|
|
|
|
|
|
elsif (defined ($char = getc $self->{'fh'})) { |
2438
|
7315
|
|
|
|
|
8907
|
$self->{'save'} = $char; |
2439
|
7315
|
100
|
|
|
|
15551
|
$self->{'lineno'}++ if $char eq "\n"; |
2440
|
|
|
|
|
|
|
} |
2441
|
|
|
|
|
|
|
else { |
2442
|
0
|
|
|
|
|
0
|
$char = ''; |
2443
|
|
|
|
|
|
|
} |
2444
|
7675
|
|
|
|
|
41413
|
$char; |
2445
|
|
|
|
|
|
|
} |
2446
|
|
|
|
|
|
|
|
2447
|
|
|
|
|
|
|
sub ungetc { |
2448
|
364
|
|
|
364
|
|
395
|
my $self = shift; |
2449
|
|
|
|
|
|
|
|
2450
|
364
|
|
|
|
|
448
|
$self->{'saved'} = 1; |
2451
|
364
|
100
|
|
|
|
992
|
$self->{'lineno'}-- if $self->{'save'} eq "\n"; |
2452
|
|
|
|
|
|
|
} |
2453
|
|
|
|
|
|
|
|
2454
|
|
|
|
|
|
|
sub lineno { |
2455
|
435
|
|
|
435
|
|
517
|
my $self = shift; |
2456
|
|
|
|
|
|
|
|
2457
|
435
|
|
|
|
|
784
|
$self->{'lineno'}; |
2458
|
|
|
|
|
|
|
} |
2459
|
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
1; |
2461
|
|
|
|
|
|
|
|
2462
|
|
|
|
|
|
|
=head1 NAME |
2463
|
|
|
|
|
|
|
|
2464
|
|
|
|
|
|
|
SNMP::MIB::Compiler - a MIB Compiler supporting SMIv1 and SMIv2 |
2465
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
=head1 SYNOPSIS |
2467
|
|
|
|
|
|
|
|
2468
|
|
|
|
|
|
|
use SNMP::MIB::Compiler; |
2469
|
|
|
|
|
|
|
|
2470
|
|
|
|
|
|
|
my $mib = new SNMP::MIB::Compiler; |
2471
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
# search MIBs there... |
2473
|
|
|
|
|
|
|
$mib->add_path('./mibs', '/foo/bar/mibs'); |
2474
|
|
|
|
|
|
|
|
2475
|
|
|
|
|
|
|
# possibly using these extensions... |
2476
|
|
|
|
|
|
|
$mib->add_extension('', '.mib', '.my'); |
2477
|
|
|
|
|
|
|
|
2478
|
|
|
|
|
|
|
# store the compiled MIBs there.. |
2479
|
|
|
|
|
|
|
$mib->repository('./out'); |
2480
|
|
|
|
|
|
|
|
2481
|
|
|
|
|
|
|
# only accept SMIv2 MIBs |
2482
|
|
|
|
|
|
|
$mib->{'accept_smiv1'} = 0; |
2483
|
|
|
|
|
|
|
$mib->{'accept_smiv2'} = 1; |
2484
|
|
|
|
|
|
|
|
2485
|
|
|
|
|
|
|
# no debug |
2486
|
|
|
|
|
|
|
$mib->{'debug_lexer'} = 0; |
2487
|
|
|
|
|
|
|
$mib->{'debug_recursive'} = 0; |
2488
|
|
|
|
|
|
|
|
2489
|
|
|
|
|
|
|
# store compiled MIBs into files |
2490
|
|
|
|
|
|
|
$mib->{'make_dump'} = 1; |
2491
|
|
|
|
|
|
|
# read compiled MIBs |
2492
|
|
|
|
|
|
|
$mib->{'use_dump'} = 1; |
2493
|
|
|
|
|
|
|
# follow IMPORTS clause while compiling |
2494
|
|
|
|
|
|
|
$mib->{'do_imports'} = 1; |
2495
|
|
|
|
|
|
|
|
2496
|
|
|
|
|
|
|
# load a precompiled MIB |
2497
|
|
|
|
|
|
|
$mib->load('SNMPv2-MIB'); |
2498
|
|
|
|
|
|
|
|
2499
|
|
|
|
|
|
|
# compile a new MIB |
2500
|
|
|
|
|
|
|
$mib->compile('IF-MIB'); |
2501
|
|
|
|
|
|
|
|
2502
|
|
|
|
|
|
|
print $mib->resolve_oid('ifInOctets'), "\n"; |
2503
|
|
|
|
|
|
|
print $mib->convert_oid('1.3.6.1.2.1.31.1.1.1.10'), "\n"; |
2504
|
|
|
|
|
|
|
print $mib->tree('ifMIB'); |
2505
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
=head1 DESCRIPTION |
2507
|
|
|
|
|
|
|
|
2508
|
|
|
|
|
|
|
SNMP::MIB::Compiler is a MIB compiler that fully supports |
2509
|
|
|
|
|
|
|
both SMI(v1) and SMIv2. This module can be use to compile |
2510
|
|
|
|
|
|
|
MIBs (recursively or not) or load already compiled MIBs for |
2511
|
|
|
|
|
|
|
later use. |
2512
|
|
|
|
|
|
|
Some tasks can be performed by the resulting object such as : |
2513
|
|
|
|
|
|
|
|
2514
|
|
|
|
|
|
|
- resolution of object names into object identifiers (OIDs). |
2515
|
|
|
|
|
|
|
e.g. ifInOctets => 1.3.6.1.2.1.2.2.1.10 |
2516
|
|
|
|
|
|
|
|
2517
|
|
|
|
|
|
|
- convertion of OIDs. |
2518
|
|
|
|
|
|
|
e.g. 1.3.6.1.2.1.2.1 => |
2519
|
|
|
|
|
|
|
iso.org.dod.internet.mgmt.mib-2.interfaces.ifNumber |
2520
|
|
|
|
|
|
|
|
2521
|
|
|
|
|
|
|
- drawing MIB trees. |
2522
|
|
|
|
|
|
|
e.g. ifTestTable => ifTestTable |
2523
|
|
|
|
|
|
|
| |
2524
|
|
|
|
|
|
|
+-- --- ifTestEntry(1) |
2525
|
|
|
|
|
|
|
| |
2526
|
|
|
|
|
|
|
+-- -rw Integer ifTestId(1) |
2527
|
|
|
|
|
|
|
+-- -rw Integer ifTestStatus(2) |
2528
|
|
|
|
|
|
|
+-- -rw ObjectID ifTestType(3) |
2529
|
|
|
|
|
|
|
+-- -r- Integer ifTestResult(4) |
2530
|
|
|
|
|
|
|
+-- -r- ObjectID ifTestCode(5) |
2531
|
|
|
|
|
|
|
+-- -rw String ifTestOwner(6) |
2532
|
|
|
|
|
|
|
|
2533
|
|
|
|
|
|
|
|
2534
|
|
|
|
|
|
|
The MIB to be compiled requires no modification. Everything legal |
2535
|
|
|
|
|
|
|
according to SMIs is accepted, including MACRO definitions (which |
2536
|
|
|
|
|
|
|
are parsed but ignored). |
2537
|
|
|
|
|
|
|
|
2538
|
|
|
|
|
|
|
This module is shipped with the basic MIBs usually needed by IMPORTS |
2539
|
|
|
|
|
|
|
clauses. A lot of IETF MIBs has been successfully tested as well as |
2540
|
|
|
|
|
|
|
some private ones. |
2541
|
|
|
|
|
|
|
|
2542
|
|
|
|
|
|
|
=head1 Methods |
2543
|
|
|
|
|
|
|
|
2544
|
|
|
|
|
|
|
=over 5 |
2545
|
|
|
|
|
|
|
|
2546
|
|
|
|
|
|
|
=item C |
2547
|
|
|
|
|
|
|
|
2548
|
|
|
|
|
|
|
C I |
2549
|
|
|
|
|
|
|
|
2550
|
|
|
|
|
|
|
To create a new MIB, send a new() message to the SNMP::MIB::Compiler |
2551
|
|
|
|
|
|
|
class. For example: |
2552
|
|
|
|
|
|
|
|
2553
|
|
|
|
|
|
|
my $mib = new SNMP::MIB::Compiler; |
2554
|
|
|
|
|
|
|
|
2555
|
|
|
|
|
|
|
This will create an empty MIB ready to accept both SMIv1 and SMIv2 |
2556
|
|
|
|
|
|
|
MIBs. A lot of attributes can be (des)activated to obtain a more |
2557
|
|
|
|
|
|
|
or less strict and verbose compiler. |
2558
|
|
|
|
|
|
|
The created object is returned. |
2559
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
=item C |
2561
|
|
|
|
|
|
|
|
2562
|
|
|
|
|
|
|
C I |
2563
|
|
|
|
|
|
|
|
2564
|
|
|
|
|
|
|
Add one or more directories to the search path. This path is used to |
2565
|
|
|
|
|
|
|
locate a MIB file when the 'compile' method is invoqued. |
2566
|
|
|
|
|
|
|
The current list of paths is returned. |
2567
|
|
|
|
|
|
|
|
2568
|
|
|
|
|
|
|
Example: |
2569
|
|
|
|
|
|
|
|
2570
|
|
|
|
|
|
|
# search MIBs in the "mibs" directory (relative |
2571
|
|
|
|
|
|
|
# to cwd) and in "/foo/bar/mibs" (absolute path) |
2572
|
|
|
|
|
|
|
$mib->add_path('./mibs', '/foo/bar/mibs'); |
2573
|
|
|
|
|
|
|
|
2574
|
|
|
|
|
|
|
=item C |
2575
|
|
|
|
|
|
|
|
2576
|
|
|
|
|
|
|
C I |
2577
|
|
|
|
|
|
|
|
2578
|
|
|
|
|
|
|
Add one or more extensions to the extension list. These extensions are |
2579
|
|
|
|
|
|
|
used to locate a MIB file when the 'compile' method is invoqued. All |
2580
|
|
|
|
|
|
|
extensions are tested for each directory specified by the add_path() |
2581
|
|
|
|
|
|
|
method until one match. |
2582
|
|
|
|
|
|
|
The current list of extensions is returned. |
2583
|
|
|
|
|
|
|
|
2584
|
|
|
|
|
|
|
Example: |
2585
|
|
|
|
|
|
|
|
2586
|
|
|
|
|
|
|
$mib->add_path('./mibs', '/foo/bar/mibs'); |
2587
|
|
|
|
|
|
|
$mib->add_extension('', '.mib'); |
2588
|
|
|
|
|
|
|
$mib->compile('FOO'); |
2589
|
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
The order is "./mibs/FOO", "./mibs/FOO.mib", "/foo/bar/mibs/FOO" |
2591
|
|
|
|
|
|
|
and "/foo/bar/mibs/FOO.mib". |
2592
|
|
|
|
|
|
|
|
2593
|
|
|
|
|
|
|
=item C |
2594
|
|
|
|
|
|
|
|
2595
|
|
|
|
|
|
|
C I |
2596
|
|
|
|
|
|
|
|
2597
|
|
|
|
|
|
|
If 'dir' is defined, set the directory where compiled MIBs will be |
2598
|
|
|
|
|
|
|
stored (using the compile() method) or loaded (using the load() method). |
2599
|
|
|
|
|
|
|
The repository MUST be initialized before a MIB can be compiled or loaded. |
2600
|
|
|
|
|
|
|
The current repository is returned. |
2601
|
|
|
|
|
|
|
|
2602
|
|
|
|
|
|
|
Example: |
2603
|
|
|
|
|
|
|
|
2604
|
|
|
|
|
|
|
$mib->repository('./out'); |
2605
|
|
|
|
|
|
|
print "Current repository is ", $mib->repository, "\n"; |
2606
|
|
|
|
|
|
|
|
2607
|
|
|
|
|
|
|
=item C |
2608
|
|
|
|
|
|
|
|
2609
|
|
|
|
|
|
|
C I |
2610
|
|
|
|
|
|
|
|
2611
|
|
|
|
|
|
|
Compile a MIB given its name. All information contained in |
2612
|
|
|
|
|
|
|
this MIB is inserted into the current object and is stored |
2613
|
|
|
|
|
|
|
into a file in the repository (see the 'make_dump' attribute). |
2614
|
|
|
|
|
|
|
The choosen name is the same as the real MIB name (defined |
2615
|
|
|
|
|
|
|
in the MIB itself). If a precompiled MIB already exists in |
2616
|
|
|
|
|
|
|
the repository and is newer than the given file, it is used |
2617
|
|
|
|
|
|
|
instead of a real compilation (see the 'use_dump' attribute). |
2618
|
|
|
|
|
|
|
The compiler can be recursive if IMPORTS clauses are followed |
2619
|
|
|
|
|
|
|
(see the 'do_imports' attribute) and in that case, uncompiled |
2620
|
|
|
|
|
|
|
MIB names must be explict according to paths and extensions |
2621
|
|
|
|
|
|
|
critaeria (see add_path() and add_extensions() methods). |
2622
|
|
|
|
|
|
|
The current object is returned. |
2623
|
|
|
|
|
|
|
|
2624
|
|
|
|
|
|
|
=item C |
2625
|
|
|
|
|
|
|
|
2626
|
|
|
|
|
|
|
C I |
2627
|
|
|
|
|
|
|
|
2628
|
|
|
|
|
|
|
Load a precompiled MIB given its name. All information contained in |
2629
|
|
|
|
|
|
|
this MIB is inserted into the current object. The file is searched in the |
2630
|
|
|
|
|
|
|
repository which MUST be initialized. In case of success, returns 1 |
2631
|
|
|
|
|
|
|
else returns 0. |
2632
|
|
|
|
|
|
|
|
2633
|
|
|
|
|
|
|
Example: |
2634
|
|
|
|
|
|
|
|
2635
|
|
|
|
|
|
|
$mib->load('SNMPv2-SMI'); |
2636
|
|
|
|
|
|
|
$mib->load('SNMPv2-MIB'); |
2637
|
|
|
|
|
|
|
|
2638
|
|
|
|
|
|
|
=item C |
2639
|
|
|
|
|
|
|
|
2640
|
|
|
|
|
|
|
C I |
2641
|
|
|
|
|
|
|
|
2642
|
|
|
|
|
|
|
Example: |
2643
|
|
|
|
|
|
|
|
2644
|
|
|
|
|
|
|
print $mib->resolve_oid('ifInOctets'), "\n"; |
2645
|
|
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
=item C |
2647
|
|
|
|
|
|
|
|
2648
|
|
|
|
|
|
|
C I |
2649
|
|
|
|
|
|
|
|
2650
|
|
|
|
|
|
|
Example: |
2651
|
|
|
|
|
|
|
|
2652
|
|
|
|
|
|
|
print $mib->convert_oid('1.3.6.1.2.1.31.1.1.1.10'), "\n"; |
2653
|
|
|
|
|
|
|
|
2654
|
|
|
|
|
|
|
=item C |
2655
|
|
|
|
|
|
|
|
2656
|
|
|
|
|
|
|
C I |
2657
|
|
|
|
|
|
|
|
2658
|
|
|
|
|
|
|
Example: |
2659
|
|
|
|
|
|
|
|
2660
|
|
|
|
|
|
|
print $mib->tree('ifMIB'); |
2661
|
|
|
|
|
|
|
|
2662
|
|
|
|
|
|
|
=back |
2663
|
|
|
|
|
|
|
|
2664
|
|
|
|
|
|
|
=head1 Attributes |
2665
|
|
|
|
|
|
|
|
2666
|
|
|
|
|
|
|
=over 5 |
2667
|
|
|
|
|
|
|
|
2668
|
|
|
|
|
|
|
=item C |
2669
|
|
|
|
|
|
|
|
2670
|
|
|
|
|
|
|
=item C |
2671
|
|
|
|
|
|
|
|
2672
|
|
|
|
|
|
|
=item C |
2673
|
|
|
|
|
|
|
|
2674
|
|
|
|
|
|
|
=item C |
2675
|
|
|
|
|
|
|
|
2676
|
|
|
|
|
|
|
=item C |
2677
|
|
|
|
|
|
|
|
2678
|
|
|
|
|
|
|
=item C |
2679
|
|
|
|
|
|
|
|
2680
|
|
|
|
|
|
|
=item C |
2681
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
=item C |
2683
|
|
|
|
|
|
|
|
2684
|
|
|
|
|
|
|
=item C |
2685
|
|
|
|
|
|
|
|
2686
|
|
|
|
|
|
|
=item C |
2687
|
|
|
|
|
|
|
|
2688
|
|
|
|
|
|
|
=item C |
2689
|
|
|
|
|
|
|
|
2690
|
|
|
|
|
|
|
=back |
2691
|
|
|
|
|
|
|
|
2692
|
|
|
|
|
|
|
=head1 BUGS |
2693
|
|
|
|
|
|
|
|
2694
|
|
|
|
|
|
|
Currently, it is more a TODO list than a bug list. |
2695
|
|
|
|
|
|
|
|
2696
|
|
|
|
|
|
|
- not enough documentation |
2697
|
|
|
|
|
|
|
|
2698
|
|
|
|
|
|
|
- not enough methods |
2699
|
|
|
|
|
|
|
|
2700
|
|
|
|
|
|
|
- not enough test scripts |
2701
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
- find a better name for compiled MIBs than 'dump's.. even if they are |
2703
|
|
|
|
|
|
|
no more than dumps. |
2704
|
|
|
|
|
|
|
|
2705
|
|
|
|
|
|
|
If your MIBs can't be compiled by this module, please, double check |
2706
|
|
|
|
|
|
|
their syntax. If you really think that they are correct, send them |
2707
|
|
|
|
|
|
|
to me including their "uncommon" dependencies. |
2708
|
|
|
|
|
|
|
|
2709
|
|
|
|
|
|
|
=head1 AUTHOR |
2710
|
|
|
|
|
|
|
|
2711
|
|
|
|
|
|
|
Fabien Tassin (fta@oleane.net) |
2712
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
=head1 COPYRIGHT |
2714
|
|
|
|
|
|
|
|
2715
|
|
|
|
|
|
|
Copyright 1998, 1999, Fabien Tassin. All rights reserved. |
2716
|
|
|
|
|
|
|
It may be used and modified freely, but I do request that |
2717
|
|
|
|
|
|
|
this copyright notice remain attached to the file. You may |
2718
|
|
|
|
|
|
|
modify this module as you wish, but if you redistribute a |
2719
|
|
|
|
|
|
|
modified version, please attach a note listing the modifications |
2720
|
|
|
|
|
|
|
you have made. |
2721
|
|
|
|
|
|
|
|
2722
|
|
|
|
|
|
|
=cut |