~ubuntu-branches/ubuntu/wily/net-snmp/wily-proposed

« back to all changes in this revision

Viewing changes to .pc/05_searchdirs.patch/local/mib2c

  • Committer: Bazaar Package Importer
  • Author(s): Chuck Short
  • Date: 2010-06-28 14:59:36 UTC
  • mfrom: (1.2.3 upstream) (1.1.12 sid)
  • Revision ID: james.westby@ubuntu.com-20100628145936-cbiallic69pn044g
Tags: 5.4.3~dfsg-1ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Set Ubuntu maintainer address.
  - net-snmp-config: Use bash. (LP: #104738)
  - Removed multiuser option when calling update-rc.d. (LP: #254261)
  - debian/snmpd.init: LSBify the init script.
  - debian/patches/52_fix_snmpcmd_1_typo.patch: Adjust a typo in snmpcmd.1
    (LP: #250459)
  - debian/snmpd.postinst: source debconf before doing work, LP: #589056
  - debian/snmp.preinst, debian/snmp.prerm: kill any/all processes owned by
    snmp user before install/uninstall, LP: #573391
  - Add apport hook (LP: #533603):
  - debian/{snmp,snmpd}.apport: Added.
  - debian/control: Build-depends on dh-apport.
  - debian/rules: 
    + Add --with apport.
    + override_dh_apport to install hook on snmpd package only.
 * Dropped patches:
   - debian/patches/99-fix-ubuntu-div0.patch: Fix dvision by zero.. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#!/usr/bin/perl
 
2
#!/usr/bin/perl -w
 
3
 
 
4
#
 
5
# $Id: mib2c 17684 2009-07-10 07:46:43Z jsafranek $
 
6
#
 
7
# Description: 
 
8
#
 
9
# This program, given an OID reference as an argument, creates some
 
10
# template mib module files to be used with the net-snmp agent.  It is
 
11
# far from perfect and will not generate working modules, but it
 
12
# significantly shortens development time by outlining the basic
 
13
# structure.
 
14
#
 
15
# Its up to you to verify what it does and change the default values
 
16
# it returns.
 
17
#
 
18
 
 
19
# SNMP
 
20
my $havesnmp = eval {require SNMP;};
 
21
my $havenetsnmpoid = eval {require NetSNMP::OID;};
 
22
 
 
23
if (!$havesnmp) {
 
24
    print "
 
25
ERROR: You don't have the SNMP perl module installed.  Please obtain
 
26
this by getting the latest source release of the net-snmp toolkit from
 
27
http://www.net-snmp.org/download/ .  Once you download the source and
 
28
unpack it, the perl module is contained in the perl/SNMP directory.
 
29
See the README file there for instructions.
 
30
 
 
31
";
 
32
    exit;
 
33
}
 
34
 
 
35
if ($havesnmp) {
 
36
    eval { import SNMP; }
 
37
}
 
38
if ($havenetsnmp) {
 
39
    eval { import NetSNMP::OID; }
 
40
}
 
41
use FileHandle;
 
42
 
 
43
#use strict 'vars';
 
44
$SNMP::save_descriptions=1;
 
45
$SNMP::use_long_names=1;
 
46
$SNMP::use_enums=1;
 
47
SNMP::initMib();
 
48
 
 
49
$configfile="mib2c.conf";
 
50
$debug=0;
 
51
$quiet=0;
 
52
$strict_unk_token = 0;
 
53
$noindent = 0;
 
54
$currentline = 0;
 
55
$currentlevel = -1;
 
56
%assignments;
 
57
%outputs;
 
58
@def_search_dirs = (".");
 
59
@search_dirs = ();
 
60
if($ENV{MIB2C_DIR}) {
 
61
   push @def_search_dirs, split(/:/, $ENV{MIB2C_DIR});
 
62
}
 
63
push @def_search_dirs, "/usr/local/share/snmp/";
 
64
push @def_search_dirs, "/usr/local/share/snmp/mib2c-data";
 
65
push @def_search_dirs, "./mib2c-conf.d";
 
66
 
 
67
sub usage {
 
68
    print "$0 [-h] [-c configfile] [-f prefix] mibNode\n\n";
 
69
    print "  -h\t\tThis message.\n\n";
 
70
    print "  -c configfile\tSpecifies the configuration file to use\n\t\tthat dictates what the output of mib2c will look like.\n\n";
 
71
    print "  -I PATH\tSpecifies a path to look for configuration files in\n\n";
 
72
    print "  -f prefix\tSpecifies the output prefix to use.  All code\n\t\twill be put into prefix.c and prefix.h\n\n";
 
73
    print "  -d\t\tdebugging output (don't do it.  trust me.)\n\n";
 
74
    print "  -S VAR=VAL\tSet \$VAR variable to \$VAL\n\n";
 
75
    print "  -i\t\tDon't run indent on the resulting code\n\n";
 
76
    print "  mibNode\tThe name of the top level mib node you want to\n\t\tgenerate code for.  By default, the code will be stored in\n\t\tmibNode.c and mibNode.h (use the -f flag to change this)\n\n";
 
77
    1;
 
78
}       
 
79
 
 
80
my @origargs = @ARGV;
 
81
my $args_done = 0;
 
82
while($#ARGV >= 0) {
 
83
    $_ = shift;
 
84
    if (/^-/) {
 
85
      if ($args_done != 0) {
 
86
        warn "all argument must be specified before the mibNode!\n";
 
87
        usage;
 
88
        exit 1;
 
89
      } elsif (/^-c/) {
 
90
        $configfile = shift;
 
91
      } elsif (/^-d/) {
 
92
        $debug = 1;
 
93
      } elsif (/^-S/) {
 
94
        my $expr = shift;
 
95
        my ($var, $val) = ($expr =~ /([^=]*)=(.*)/);
 
96
        die "no variable specified for -S flag." if (!$var);
 
97
        $assignments{$var} = $val;
 
98
      } elsif (/^-q/) {
 
99
        $quiet = 1;
 
100
      } elsif (/^-i/) {
 
101
        $noindent = 1;
 
102
      } elsif (/^-h/) {
 
103
        usage && exit(1);
 
104
      } elsif (/^-f/) {
 
105
        $outputName = shift;
 
106
      } elsif (/^-I/) {
 
107
        my $dirs = shift;
 
108
        push @search_dirs, split(/,/,$dirs);
 
109
      } else {
 
110
        warn "Unknown option '$_'\n";
 
111
        usage;
 
112
        exit 1;
 
113
      }
 
114
    } else {
 
115
      $args_done = 1;
 
116
      warn "Replacing previous mibNode $oid with $_\n" if ($oid);
 
117
      $oid = $_ ;
 
118
    }
 
119
}
 
120
 
 
121
#
 
122
# internal conversion tables
 
123
#
 
124
 
 
125
%accessToIsWritable = qw(ReadOnly 0 ReadWrite 1 
 
126
                         WriteOnly 1 Create 1);
 
127
%perltoctypes = qw(OCTETSTR   ASN_OCTET_STR
 
128
                   INTEGER    ASN_INTEGER
 
129
                   INTEGER32  ASN_INTEGER
 
130
                   UNSIGNED32 ASN_UNSIGNED
 
131
                   OBJECTID   ASN_OBJECT_ID
 
132
                   COUNTER64  ASN_COUNTER64
 
133
                   COUNTER    ASN_COUNTER
 
134
                   NETADDR    ASN_COUNTER
 
135
                   UINTEGER   ASN_UINTEGER
 
136
                   IPADDR     ASN_IPADDRESS
 
137
                   BITS       ASN_OCTET_STR
 
138
                   TICKS      ASN_TIMETICKS
 
139
                   GAUGE      ASN_GAUGE
 
140
                   OPAQUE     ASN_OPAQUE);
 
141
%perltodecl = ("OCTETSTR",  "char",
 
142
               "INTEGER",  "long",
 
143
               "INTEGER32",  "long",
 
144
               "UNSIGNED32", "u_long",
 
145
               "UINTEGER", "u_long",
 
146
               "OBJECTID", "oid",
 
147
               "COUNTER64", "U64",
 
148
               "COUNTER", "u_long",
 
149
               "IPADDR", "in_addr_t",
 
150
               "BITS", "char",
 
151
               "TICKS", "u_long",
 
152
               "GAUGE", "u_long",
 
153
               "OPAQUE", "u_char");
 
154
%perltolen = ("OCTETSTR",  "1",
 
155
               "INTEGER",  "0",
 
156
               "INTEGER32",  "0",
 
157
               "UNSIGNED32", "0",
 
158
               "UINTEGER", "0",
 
159
               "OBJECTID", "1",
 
160
               "COUNTER64", "0",
 
161
               "COUNTER", "0",
 
162
               "IPADDR", "0",
 
163
               "BITS", "1",
 
164
               "TICKS", "0",
 
165
               "GAUGE", "0",
 
166
               "OPAQUE", "1");
 
167
 
 
168
my $mibnode = $SNMP::MIB{$oid};
 
169
 
 
170
if (!$mibnode) { 
 
171
 
 
172
print STDERR "
 
173
You didn't give mib2c a valid OID to start with.  IE, I could not find
 
174
any information about the mib node \"$oid\".  This could be caused
 
175
because you supplied an incorrectly node, or by the MIB that you're
 
176
trying to generate code from isn't loaded.  To make sure your mib is
 
177
loaded, run mib2c using this as an example:
 
178
 
 
179
   env MIBS=\"+MY-PERSONAL-MIB\" mib2c " . join(" ",@origargs) . "
 
180
 
 
181
You might wish to start by reading the MIB loading tutorial at:
 
182
 
 
183
   http://www.net-snmp.org/tutorial-5/commands/mib-options.html
 
184
 
 
185
And making sure you can get snmptranslate to display information about
 
186
your MIB node.  Once snmptranslate works, then come back and try mib2c
 
187
again.
 
188
 
 
189
";
 
190
exit 1;
 
191
}
 
192
 
 
193
# setup
 
194
$outputName = $mibnode->{'label'} if (!defined($outputName));
 
195
$outputName =~ s/-/_/g;
 
196
$vars{'name'} = $outputName;
 
197
$vars{'oid'} = $oid;
 
198
$vars{'example_start'} = "    /*\n" .
 
199
"    ***************************************************\n" .
 
200
"    ***             START EXAMPLE CODE              ***\n" .
 
201
"    ***---------------------------------------------***/";
 
202
$vars{'example_end'} = "    /*\n" .
 
203
"    ***---------------------------------------------***\n" .
 
204
"    ***              END  EXAMPLE CODE              ***\n" .
 
205
"    ***************************************************/";
 
206
 
 
207
# loop through mib nodes, remembering stuff.
 
208
setup_data($mibnode);
 
209
 
 
210
if(($ENV{HOME}) && (-f "$ENV{HOME}/.snmp/mib2c.conf")) {
 
211
  $fh = open_conf("$ENV{HOME}/.snmp/mib2c.conf");
 
212
  process("-balanced");
 
213
  $fh->close;
 
214
}
 
215
 
 
216
my $defaults = find_conf("default-$configfile",1);
 
217
if (-f "$defaults" ) {
 
218
  $fh = open_conf($defaults);
 
219
  process("-balanced");
 
220
  $fh->close;
 
221
}
 
222
 
 
223
my @theassignments = keys(%assignments);
 
224
if ($#theassignments != -1) {
 
225
  foreach $var (@theassignments) {
 
226
    $vars{$var} = $assignments{$var};
 
227
  }
 
228
}
 
229
$configfile = find_conf($configfile,0);
 
230
$fh = open_conf($configfile);
 
231
process("-balanced");
 
232
$fh->close;
 
233
 
 
234
if (!$noindent) {
 
235
  foreach $i (keys(%written)) {
 
236
    next if ($i eq "-");
 
237
    next if (!($i =~ /\.[ch]$/));
 
238
    print STDERR "running indent on $i\n" if (!$quiet);
 
239
    system("indent -orig -nbc -bap -nut -nfca -T size_t -T netsnmp_mib_handler -T netsnmp_handler_registration -T netsnmp_delegated_cache -T netsnmp_mib_handler_methods -T netsnmp_old_api_info -T netsnmp_old_api_cache -T netsnmp_set_info -T netsnmp_request_info -T netsnmp_set_info -T netsnmp_tree_cache -T netsnmp_agent_request_info -T netsnmp_cachemap -T netsnmp_agent_session -T netsnmp_array_group_item -T netsnmp_array_group -T netsnmp_table_array_callbacks -T netsnmp_table_row -T netsnmp_table_data -T netsnmp_table_data_set_storage -T netsnmp_table_data_set -T netsnmp_column_info -T netsnmp_table_registration_info -T netsnmp_table_request_info -T netsnmp_iterator_info -T netsnmp_data_list -T netsnmp_oid_array_header -T netsnmp_oid_array_header_wrapper -T netsnmp_oid_stash_node -T netsnmp_pdu -T netsnmp_request_list -T netsnmp_callback_pass -T netsnmp_callback_info -T netsnmp_transport -T netsnmp_transport_list -T netsnmp_tdomain $i");
 
240
  }
 
241
}
 
242
 
 
243
sub m2c_die {
 
244
  warn "ERROR: ". $_[0] . "\n";
 
245
  die "  at $currentfile:$currentline\n";
 
246
}
 
247
 
 
248
sub tocommas {
 
249
    my $oid = $_[0];
 
250
    $oid =~ s/\./,/g;
 
251
    $oid =~ s/^\s*,//;
 
252
    return $oid;
 
253
}
 
254
 
 
255
sub oidlength {
 
256
    return (scalar split(/\./, $_[0])) - 1;
 
257
}
 
258
 
 
259
# replaces $VAR type expressions and $VAR.subcomponent expressions
 
260
# with data from the mib tree and loop variables.
 
261
# possible uses:
 
262
#
 
263
#   $var               -- as defined by loops, etc.
 
264
#   ${var}otherstuff   -- appending text to variable contents
 
265
#   $var.uc            -- all upper case version of $var
 
266
#
 
267
# NOTE: THESE ARE AUTO-EXTRACTED/PROCESSED BY ../mib2c.extract.pl for man pages
 
268
#
 
269
# Mib components, $var must first expand to a mib node name:
 
270
#
 
271
#   $var.uc            -- all upper case version of $var
 
272
#
 
273
#   $var.objectID      -- dotted, fully-qualified, and numeric OID
 
274
#   $var.commaoid      -- comma separated numeric OID for array initialization
 
275
#   $var.oidlength     -- length of the oid
 
276
#   $var.subid         -- last number component of oid
 
277
#   $var.module        -- MIB name that the object comes from
 
278
#   $var.parent        -- contains the label of the parent node of $var.
 
279
#
 
280
#   $var.isscalar      -- returns 1 if var contains the name of a scalar
 
281
#   $var.iscolumn      -- returns 1 if var contains the name of a column
 
282
#   $var.children      -- returns 1 if var has children
 
283
#
 
284
#   $var.perltype      -- node's perl SYNTAX ($SNMP::MIB{node}{'syntax'})
 
285
#   $var.type          -- node's ASN_XXX type (Net-SNMP specific #define)
 
286
#   $var.decl          -- C data type (char, u_long, ...)
 
287
#
 
288
#   $var.readable      -- 1 if an object is readable, 0 if not
 
289
#   $var.settable      -- 1 if an object is writable, 0 if not
 
290
#   $var.creatable     -- 1 if a column object can be created as part of a new row, 0 if not
 
291
#   $var.noaccess      -- 1 if not-accessible, 0 if not
 
292
#   $var.accessible    -- 1 if accessible, 0 if not
 
293
#   $var.rowstatus     -- 1 if an object is a RowStatus object, 0 if not
 
294
#     'settable', 'creatable' and 'rowstatus' can also be used with table variables
 
295
#     to indicate whether it contains writable, creatable or RowStatus column objects
 
296
#
 
297
#   $var.hasdefval     -- returns 1 if var has a DEFVAL clause
 
298
#   $var.defval        -- node's DEFVAL
 
299
#   $var.hashint       -- returns 1 if var has a HINT clause
 
300
#   $var.hint          -- node's HINT
 
301
#   $var.ranges        -- returns 1 if var has a value range defined
 
302
#   $var.enums         -- returns 1 if var has enums defined for it.
 
303
#   $var.access        -- node's access type
 
304
#   $var.status        -- node's status
 
305
#   $var.syntax        -- node's syntax
 
306
#   $var.reference     -- node's reference
 
307
#   $var.description   -- node's description
 
308
 
 
309
sub process_vars {
 
310
    my $it = shift;
 
311
 
 
312
    # mib substitutions ($var.type -> $mibnode->{'type'})
 
313
   if ( $it =~ /\$(\w+)\.(\w+)/ ) {
 
314
    if ($SNMP::MIB{$vars{$1}} && $SNMP::MIB{$vars{$1}}{'label'} =~ /Table$/) {
 
315
      $it =~ s/\$(\w+)\.(settable)/(table_is_writable($SNMP::MIB{$vars{$1}}{label}))/eg;
 
316
      $it =~ s/\$(\w+)\.(creatable)/(table_has_create($SNMP::MIB{$vars{$1}}{label}))/eg;
 
317
      $it =~ s/\$(\w+)\.(rowstatus)/(table_has_rowstatus($SNMP::MIB{$vars{$1}}{label}))/eg;
 
318
      $it =~ s/\$(\w+)\.(lastchange)/(table_has_lastchange($SNMP::MIB{$vars{$1}}{label}))/eg;
 
319
      $it =~ s/\$(\w+)\.(storagetype)/(table_has_storagetype($SNMP::MIB{$vars{$1}}{label}))/eg;
 
320
    }
 
321
    $it =~ s/\$(\w+)\.(uc)/uc($vars{$1})/eg; # make something uppercase
 
322
    $it =~ s/\$(\w+)\.(commaoid)/tocommas($SNMP::MIB{$vars{$1}}{objectID})/eg;
 
323
    $it =~ s/\$(\w+)\.(oidlength)/oidlength($SNMP::MIB{$vars{$1}}{objectID})/eg;
 
324
    $it =~ s/\$(\w+)\.(description)/$SNMP::MIB{$vars{$1}}{description}/g;
 
325
    $it =~ s/\$(\w+)\.(perltype)/$SNMP::MIB{$vars{$1}}{type}/g;
 
326
    $it =~ s/\$(\w+)\.(type)/$perltoctypes{$SNMP::MIB{$vars{$1}}{$2}}/g;
 
327
    $it =~ s/\$(\w+)\.(subid)/$SNMP::MIB{$vars{$1}}{subID}/g;
 
328
    $it =~ s/\$(\w+)\.(module)/$SNMP::MIB{$vars{$1}}{moduleID}/g;
 
329
    $it =~ s/\$(\w+)\.(settable)/(($SNMP::MIB{$vars{$1}}{access} =~ \/(ReadWrite|Create|WriteOnly)\/)?1:0)/eg;
 
330
    $it =~ s/\$(\w+)\.(creatable)/(($SNMP::MIB{$vars{$1}}{access} =~ \/(Create)\/)?1:0)/eg;
 
331
    $it =~ s/\$(\w+)\.(readable)/(($SNMP::MIB{$vars{$1}}{access} =~ \/(Read|Create)\/)?1:0)/eg;
 
332
    $it =~ s/\$(\w+)\.(noaccess)/(($SNMP::MIB{$vars{$1}}{access} =~ \/(NoAccess)\/)?1:0)/eg;
 
333
    $it =~ s/\$(\w+)\.(accessible)/(($SNMP::MIB{$vars{$1}}{access} !~ \/(NoAccess)\/)?1:0)/eg;
 
334
    $it =~ s/\$(\w+)\.(objectID|label|subID|access|status|syntax|reference)/$SNMP::MIB{$vars{$1}}{$2}/g;
 
335
    $it =~ s/\$(\w+)\.(decl)/$perltodecl{$SNMP::MIB{$vars{$1}}{type}}/g;
 
336
    $it =~ s/\$(\w+)\.(needlength)/$perltolen{$SNMP::MIB{$vars{$1}}{type}}/g;
 
337
    $it =~ s/\$(\w+)\.(iscolumn)/($SNMP::MIB{$vars{$1}}{'parent'}{'label'} =~ \/Entry$\/) ? 1 : 0/eg;
 
338
    $it =~ s/\$(\w+)\.(isscalar)/($SNMP::MIB{$vars{$1}}{'parent'}{'label'} !~ \/Entry$\/ && $SNMP::MIB{$vars{$1}}{access}) ? 1 : 0/eg;
 
339
    $it =~ s/\$(\w+)\.(parent)/$SNMP::MIB{$vars{$1}}{'parent'}{'label'}/g;
 
340
    $it =~ s/\$(\w+)\.(children)/($#{$SNMP::MIB{$vars{$1}}{'children'}} == 0) ? 0 : 1/eg;
 
341
    $it =~ s/\$(\w+)\.(hasdefval)/(length($SNMP::MIB{$vars{$1}}{'defaultValue'}) == 0) ? 0 : 1/eg;
 
342
    $it =~ s/\$(\w+)\.(defval)/$SNMP::MIB{$vars{$1}}{'defaultValue'}/g;
 
343
    $it =~ s/\$(\w+)\.(hashint)/(length($SNMP::MIB{$vars{$1}}{'hint'}) == 0) ? 0 : 1/eg;
 
344
    $it =~ s/\$(\w+)\.(hint)/$SNMP::MIB{$vars{$1}}{'hint'}/g;
 
345
    $it =~ s/\$(\w+)\.(ranges)/($#{$SNMP::MIB{$vars{$1}}{'ranges'}} == -1) ? 0 : 1/eg;
 
346
    # check for enums
 
347
    $it =~ s/\$(\w+)\.(enums)/(%{$SNMP::MIB{$vars{$1}}{'enums'}} == 0) ? 0 : 1/eg;
 
348
    $it =~ s/\$(\w+)\.(enumrange)/%{$SNMP::MIB{$vars{$1}}{'enums'}}/eg;
 
349
    $it =~ s/\$(\w+)\.(rowstatus)/(($SNMP::MIB{$vars{$1}}{syntax} =~ \/(RowStatus)\/)?1:0)/eg;
 
350
    if ( $it =~ /\$(\w+)\.(\w+)/ ) {
 
351
      warn "Possible unknown variable attribute \$$1.$2 at $currentfile:$currentline\n";
 
352
    }
 
353
  }
 
354
    # normal variable substitions
 
355
    $it =~ s/\$\{(\w+)\}/$vars{$1}/g;
 
356
    $it =~ s/\$(\w+)/$vars{$1}/g;
 
357
    # use $@var to put literal '$var'
 
358
    $it =~ s/\$\@(\w+)/\$$1/g;
 
359
    return $it;
 
360
}
 
361
 
 
362
# process various types of statements
 
363
#
 
364
# NOTE: THESE ARE AUTO-EXTRACTED/PROCESSED BY ../mib2c.extract.pl for man pages
 
365
# which include:
 
366
#   @open FILE@
 
367
#     writes generated output to FILE
 
368
#     note that for file specifications, opening '-' will print to stdout.
 
369
#   @append FILE@
 
370
#     appends the given FILE
 
371
#   @close FILE@
 
372
#     closes the given FILE
 
373
#   @push@
 
374
#     save the current outputs, then clear outputs. Use with @open@
 
375
#     and @pop@ to write to a new file without interfering with current
 
376
#     outputs.
 
377
#   @pop@
 
378
#     pop up the process() stack one level. Use after a @push@ to return to
 
379
#     the previous set of open files.
 
380
#   @foreach $VAR scalar@
 
381
#     repeat iterate over code until @end@ setting $VAR to all known scalars
 
382
#   @foreach $VAR table@
 
383
#     repeat iterate over code until @end@ setting $VAR to all known tables
 
384
#   @foreach $VAR column@
 
385
#     repeat iterate over code until @end@ setting $VAR to all known
 
386
#     columns within a given table.  Obviously this must be called
 
387
#     within a foreach-table clause.
 
388
#   @foreach $VAR nonindex@
 
389
#     repeat iterate over code until @end@ setting $VAR to all known
 
390
#     non-index columns within a given table.  Obviously this must be called
 
391
#     within a foreach-table clause.
 
392
#   @foreach $VAR internalindex@
 
393
#     repeat iterate over code until @end@ setting $VAR to all known internal
 
394
#     index columns within a given table.  Obviously this must be called
 
395
#     within a foreach-table clause.
 
396
#   @foreach $VAR externalindex@
 
397
#     repeat iterate over code until @end@ setting $VAR to all known external
 
398
#     index columns within a given table.  Obviously this must be called
 
399
#     within a foreach-table clause.
 
400
#   @foreach $VAR index@
 
401
#     repeat iterate over code until @end@ setting $VAR to all known
 
402
#     indexes within a given table.  Obviously this must be called
 
403
#     within a foreach-table clause.
 
404
#   @foreach $VAR notifications@
 
405
#     repeat iterate over code until @end@ setting $VAR to all known notifications
 
406
#   @foreach $VAR varbinds@
 
407
#     repeat iterate over code until @end@ setting $VAR to all known varbinds
 
408
#     Obviously this must be called within a foreach-notifications clause.
 
409
#   @foreach $LABEL, $VALUE enum@
 
410
#     repeat iterate over code until @end@ setting $LABEL and $VALUE
 
411
#     to the label and values from the enum list.
 
412
#   @foreach $RANGE_START, $RANGE_END range NODE@
 
413
#     repeat iterate over code until @end@ setting $RANGE_START and $RANGE_END
 
414
#     to the legal accepted range set for a given mib NODE.
 
415
#   @foreach $var stuff a b c d@
 
416
#     repeat iterate over values a, b, c, d as assigned generically
 
417
#     (ie, the values are taken straight from the list with no
 
418
#     mib-expansion, etc).
 
419
#   @while expression@
 
420
#     repeat iterate over code until the expression is false
 
421
#   @eval $VAR = expression@
 
422
#     evaluates expression and assigns the results to $VAR.  This is
 
423
#     not a full perl eval, but sort of a "psuedo" eval useful for
 
424
#     simple expressions while keeping the same variable name space.
 
425
#     See below for a full-blown export to perl.
 
426
#   @perleval STUFF@
 
427
#     evaluates STUFF directly in perl.  Note that all mib2c variables
 
428
#     interpereted within .conf files are in $vars{NAME} and that
 
429
#     a warning will be printed if STUFF does not return 0. (adding a
 
430
#     'return 0;' at the end of STUFF is a workaround.
 
431
#   @startperl@
 
432
#   @endperl@
 
433
#     treats everything between these tags as perl code, and evaluates it.
 
434
#   @next@
 
435
#     restart foreach; should only be used inside a conditional.
 
436
#     skips out of current conditional, then continues to skip to
 
437
#     end for the current foreach clause.
 
438
#   @if expression@
 
439
#     evaluates expression, and if expression is true processes
 
440
#     contained part until appropriate @end@ is reached.  If the
 
441
#     expression is false, the next @elsif expression@ expression
 
442
#     (if it exists) will be evaluated, until an expression is
 
443
#     true. If no such expression exists and an @else@
 
444
#     clause is found, it will be evaluated.
 
445
#   @ifconf file@
 
446
#     If the specified file can be found in the conf file search path,
 
447
#     and if found processes contained part until an appropriate @end@ is
 
448
#     found. As with a regular @if expression@, @elsif expression@ and
 
449
#     @else@ can be used.
 
450
#   @ifdir dir@
 
451
#     If the specified directory exists, process contained part until an
 
452
#     appropriate @end@ is found. As with a regular @if expression@,
 
453
#     @elsif expression@ and @else@ can be used.
 
454
#   @define NAME@
 
455
#   @enddefine@
 
456
#     Memorizes "stuff" between the define and enddefine tags for
 
457
#     later calling as NAME by @calldefine NAME@.
 
458
#   @calldefine NAME@
 
459
#     Executes stuff previously memorized as NAME.
 
460
#   @printf "expression" stuff1, stuff2, ...@
 
461
#     Like all the other printf's you know and love.
 
462
#   @run FILE@
 
463
#     Sources the contents of FILE as a mib2c file,
 
464
#     but does not affect current files opened.
 
465
#   @include FILE@
 
466
#     Sources the contents of FILE as a mib2c file and appends its
 
467
#     output to the current output.
 
468
#   @prompt $var QUESTION@
 
469
#     Presents the user with QUESTION, expects a response and puts it in $var
 
470
#   @print STUFF@
 
471
#     Prints stuff directly to the users screen (ie, not to where
 
472
#     normal mib2c output goes)
 
473
#   @quit@
 
474
#     Bail out (silently)
 
475
#   @exit@
 
476
#     Bail out!
 
477
#
 
478
sub skippart {
 
479
  my $endcount = 1;
 
480
  my $arg = shift;
 
481
  my $rtnelse = 0;
 
482
  while ($arg =~ s/-(\w+)\s*//) {
 
483
    $rtnelse = 1 if ($1 eq "else");
 
484
  }
 
485
  while(get_next_line()) {
 
486
    $currentline++;
 
487
    $_ = process_vars($_) if ($debug);
 
488
    print "$currentfile.$currentline:P$currentlevel:S$endcount.$rtnelse:$_" if ($debug);
 
489
        next if ( /^\s*\#\#/ ); #                          noop, it's a comment
 
490
        next if (! /^\s*\@/ ); #                                        output
 
491
        if (! /^\s*\@.*\@/ ) {
 
492
          warn "$currentfile:$currentline contained a line that started with a @ but did not match any mib2c configuration tokens.\n";
 
493
          warn "(maybe missing the trailing @?)\n";
 
494
          warn "$currentfile:$currentline [$_]\n";
 
495
        }
 
496
        elsif (/\@\s*end\@/) {
 
497
            return "end" if ($endcount == 1);
 
498
            $endcount--;
 
499
        }
 
500
        elsif (/\@\s*elseif.*\@/) {
 
501
          m2c_die "use 'elsif' instead of 'elseif'\n";
 
502
        }
 
503
        elsif (/\@\s*else\@/) {
 
504
            return "else" if (($endcount == 1) && ($rtnelse == 1));
 
505
        }
 
506
        elsif (/\@\s*elsif\s+([^\@]+)\@/) {
 
507
            return "else" if (($endcount == 1) && ($rtnelse == 1) && (eval(process_vars($1))));
 
508
        }
 
509
        elsif (/\@\s*(foreach|if|while)/) {
 
510
            $endcount++;
 
511
        }
 
512
    }
 
513
  print "skippart EOF\n";
 
514
  m2c_die "unbalanced code detected in skippart: EOF when $endcount levels deep" if($endcount != 1);
 
515
  return "eof";
 
516
}
 
517
 
 
518
sub close_file {
 
519
  my $name = shift;
 
520
  if (!$name) {
 
521
    print "close_file w/out name!\n";
 
522
    return;
 
523
  }
 
524
  if(!$outputs{$name}) {
 
525
    print "no handle for $name\n";
 
526
    return;
 
527
  }
 
528
  $outputs{$name}->close();
 
529
  delete $outputs{$name};
 
530
#  print STDERR "closing $name\n" if (!$quiet);
 
531
}
 
532
 
 
533
sub close_files {
 
534
  foreach $name (keys(%outputs)) {
 
535
    close_file($name);
 
536
  }
 
537
}
 
538
 
 
539
sub open_file {
 
540
  my $multiple = shift;
 
541
  my $spec = shift;
 
542
  my $name = $spec;
 
543
  $name =~ s/>//;
 
544
  if ($multiple == 0) {
 
545
    close_files();
 
546
  }
 
547
  return if ($outputs{$name});
 
548
  $outputs{$name} = new IO::File;
 
549
  $outputs{$name}->open(">$spec") || m2c_die "failed to open $name";
 
550
  print STDERR "writing to $name\n" if (!$quiet && !$written{$name});
 
551
  $written{$name} = '1';
 
552
}
 
553
 
 
554
sub process_file {
 
555
  my ($file, $missingok, $keepvars) = (@_);
 
556
  my $oldfh = $fh;
 
557
  my $oldfile = $currentfile;
 
558
  my $oldline = $currentline;
 
559
  # keep old copy of @vars and just build on it.
 
560
  my %oldvars;
 
561
 
 
562
  %oldvars = %vars if ($keepvars != 1);
 
563
 
 
564
  $file = find_conf($file,$missingok);
 
565
  return if (! $file);
 
566
 
 
567
  $fh = open_conf($file);
 
568
  $currentline = 0;
 
569
  process("-balanced");
 
570
  $fh->close();
 
571
 
 
572
  $fh = $oldfh;
 
573
  $currentfile = $oldfile;
 
574
  $currentline = $oldline;
 
575
 
 
576
  # don't keep values in replaced vars.  Revert to ours.
 
577
  %vars = %oldvars if ($keepvars != 1);
 
578
}
 
579
 
 
580
sub get_next_line {
 
581
    if ($#process_lines > -1) {
 
582
        return $_ = shift @process_lines;
 
583
    }
 
584
    return $_ = <$fh>;
 
585
}
 
586
 
 
587
sub do_tell {
 
588
    my $stash;
 
589
    $stash->{'startpos'} = $fh->tell();
 
590
    $stash->{'startline'} = $currentline;
 
591
    @{$stash->{'lines'}} = @process_lines;
 
592
    return $stash;
 
593
}
 
594
 
 
595
sub do_seek {
 
596
    my $stash = shift;
 
597
 
 
598
    # save current line number
 
599
    $currentline = $stash->{'startline'};
 
600
    $fh->seek($stash->{'startpos'}, 0); # go to top of section.
 
601
 
 
602
    # save current process_lines state.
 
603
    @process_lines = @{$stash->{'lines'}};
 
604
 
 
605
    # save state of a number of variables (references), and new assignments
 
606
    for (my $i = 0; $i <= $#_; $i += 2) {
 
607
        push @{$stash->{'vars'}}, $_[$i], ${$_[$i]};
 
608
        ${$_[$i]} = $_[$i+1];
 
609
    }
 
610
}
 
611
 
 
612
sub do_unseek {
 
613
    my $stash = shift;
 
614
    for (my $i = 0; $i <= $#{$stash->{'vars'}}; $i += 2) {
 
615
        ${$stash->{'vars'}[$i]} = $stash->{'vars'}[$i+1];
 
616
    }
 
617
}
 
618
 
 
619
sub do_a_loop {
 
620
    my $stash = shift;
 
621
    do_seek($stash, @_);
 
622
    my $return = process();
 
623
    do_unseek($stash);
 
624
    return $return;
 
625
}
 
626
 
 
627
sub process {
 
628
  my $arg = shift;
 
629
  my $elseok = 0;
 
630
  my $balanced = 0;
 
631
  my $startlevel;
 
632
  my $return = "eof";
 
633
  while ($arg =~ s/-(\w+)\s*//) {
 
634
    $elseok = 1 if ($1 eq "elseok");
 
635
    $balanced = 1 if ($1 eq "balanced");
 
636
  }
 
637
 
 
638
  $currentlevel++;
 
639
  $startlevel = $currentlevel;
 
640
  if($balanced) {
 
641
    $balanced = $currentlevel;
 
642
  }
 
643
    while(get_next_line()) {
 
644
      $currentline++;
 
645
      if ($debug) {
 
646
#        my $line = process_vars($_);
 
647
#        chop $line;
 
648
        print "$currentfile.$currentline:P$currentlevel.$elseok:$return:$_";
 
649
      }
 
650
 
 
651
        next if (/^\s*\#\#/); #                            noop, it's a comment
 
652
        if (! /^\s*\@/ ) { #                                          output
 
653
          my $line = process_vars($_);
 
654
          foreach $file (values(%outputs)) {
 
655
            print $file "$line";
 
656
          }
 
657
        } ####################################################################
 
658
        elsif (/\@\s*exit\@/) { #                                         EXIT
 
659
            close_files;
 
660
            die "exiting at conf file ($currentfile:$currentline) request\n";
 
661
        } elsif (/\@\s*quit\@/) { #                                       QUIT
 
662
            close_files;
 
663
            exit;
 
664
        } elsif (/\@\s*debug\s+([^\@]+)\@/) { #                          DEBUG
 
665
          if ($1 eq "on") {
 
666
            $debug = 1;
 
667
          }
 
668
          else {
 
669
            $debug = 0;
 
670
          }
 
671
        } elsif (/\@\s*strict token\s+([^\@]+)\@/) { #                  STRICT
 
672
          if ($1 eq "on") {
 
673
            $strict_unk_token = 1;
 
674
          }
 
675
          else {
 
676
            $strict_unk_token = 0;
 
677
          }
 
678
        } elsif (/\@\s*balanced\@/) { #                               BALANCED
 
679
          $balanced = $currentlevel;
 
680
        } elsif (/\@\s*open\s+([^\@]+)\@/) { #                            OPEN
 
681
            my $arg = $1;
 
682
            my ($multiple) = (0);
 
683
            while ($arg =~ s/-(\w+)\s+//) {
 
684
                $multiple = 1 if ($1 eq 'multiple');
 
685
            }
 
686
            my $spec = process_vars($arg);
 
687
            open_file($multiple, $spec);
 
688
        } elsif (/\@\s*close\s+([^\@]+)\@/) { #                          CLOSE
 
689
            my $spec = process_vars($1);
 
690
            close_file($spec);
 
691
        } elsif (/\@\s*append\s+([^\@]+)\@/) { #                        APPEND
 
692
            my $arg = $1;
 
693
            my ($multiple) = (0);
 
694
            while ($arg =~ s/-(\w+)\s+//) {
 
695
                $multiple = 1 if ($1 eq 'multiple');
 
696
            }
 
697
            my $spec = process_vars($arg);
 
698
            $spec=">$spec";
 
699
            open_file($multiple,$spec);
 
700
        } elsif (/\@\s*define\s*(.*)\@/) { #                              DEFINE
 
701
            my $it = $1;
 
702
            while (<$fh>) {
 
703
                last if (/\@\s*enddefine\s*@/);
 
704
                push @{$defines{$it}}, $_;
 
705
            }
 
706
        } elsif (/\@\s*calldefine\s+(\w+)@/) {
 
707
            if ($#{$defines{$1}} == -1) {
 
708
                warn "called a define of $1 which didn't exist\n";
 
709
                warn "$currentfile:$currentline [$_]\n";
 
710
            } else {
 
711
                unshift @process_lines, @{$defines{$1}};
 
712
            }
 
713
        } elsif (/\@\s*run (.*)\@/) { #                                    RUN
 
714
            my $arg = $1;
 
715
            my ($again) = (0);
 
716
            while ($arg =~ s/-(\w+)\s+//) {
 
717
                $again = 1 if ($1 eq 'again');
 
718
#               if ($1 eq 'file') {
 
719
#                   my ($filearg) = ($arg =~ s/^(\w+)//);
 
720
#               }
 
721
            }
 
722
            my $spec = process_vars($arg);
 
723
            next if (!$again && $ranalready{$spec});
 
724
            $ranalready{$spec} = 1;
 
725
            my %oldout = %outputs;
 
726
            my %emptyarray;
 
727
            %outputs = %emptyoutputs;
 
728
            process_file($spec,0,0);
 
729
            close_files;
 
730
            %outputs = %oldout;
 
731
        } elsif (/\@\s*push\@/) { #                                      PUSH
 
732
            my %oldout = %outputs;
 
733
            my %emptyarray;
 
734
            %outputs = %emptyoutputs;
 
735
            process($arg);
 
736
            close_files;
 
737
            %outputs = %oldout;
 
738
        } elsif (/\@\s*pop\s*\@/) { #                                     POP
 
739
          $return = "pop";
 
740
          last;
 
741
        } elsif (/\@\s*include (.*)\@/) { #                            INCLUDE
 
742
            my $arg = $1;
 
743
            my ($missingok) = (0);
 
744
            while ($arg =~ s/-(\w+)\s+//) {
 
745
                $missingok = 1 if ($1 eq 'ifexists');
 
746
            }
 
747
            my $spec = process_vars($arg);
 
748
            process_file($spec,$missingok,1);
 
749
        } elsif (/\@\s*if([a-z]*)\s+([^@]+)\@/) { #                         IF
 
750
          my ($type,$arg,$ok) = ($1,$2,0);
 
751
          # check condition based on type
 
752
          if (! $type) {
 
753
            $ok = eval(process_vars($arg));
 
754
          } elsif ($type eq conf) {
 
755
            my $file = find_conf(process_vars($arg),1); # missingok
 
756
            $ok = (-f $file);
 
757
          } elsif ($type eq dir) {
 
758
            $ok = (-d $arg);
 
759
          } else {
 
760
            m2c_die "unknown if modifier ($type)\n";
 
761
          }
 
762
          # act on condition
 
763
          if ($ok) {
 
764
            $return = process("-elseok");
 
765
          } else {
 
766
            $return = skippart("-else");
 
767
            $return = process("-elseok") if ($return eq "else");
 
768
          }
 
769
          if ($return eq "next") {
 
770
            $return = skippart();
 
771
            m2c_die("unbalanced code detected while exiting next/2 (returned $return)") if ($return ne "end");
 
772
#            $return = "next";
 
773
            last;
 
774
          }
 
775
          if (($return ne "end") && ($return ne "else")) {
 
776
            m2c_die "unbalanced if / return $return\n";
 
777
          }
 
778
        } elsif (/\@\s*elseif.*\@/) { #                           bogus elseif
 
779
          m2c_die "error: use 'elsif' instead of 'elseif'\n";
 
780
        } elsif (/\@\s*els(e|if).*\@/) { #                          ELSE/ELSIF
 
781
          if ($elseok != 1) {
 
782
            chop $_;
 
783
            m2c_die "unexpected els$1\n";
 
784
          }
 
785
          $return = skippart();
 
786
          if ($return ne "end") {
 
787
            m2c_die "unbalanced els$1 / rtn $rtn\n";
 
788
          }
 
789
          $return = "else";
 
790
          last;
 
791
        } elsif (/\@\s*next\s*\@/) { #                                  NEXT
 
792
          $return = skippart();
 
793
          m2c_die "unbalanced code detected while exiting next/1 (returned $return)" if ($return ne "end");
 
794
          $return = "next";
 
795
          last;
 
796
        } elsif (/\@\s*end\@/) { #                                         END
 
797
          $return = "end";
 
798
          last;
 
799
        } elsif (/\@\s*eval\s+\$(\w+)\s*=\s*([^\@]*)/) { #                EVAL
 
800
            my ($v, $e) = ($1, $2);
 
801
#           print STDERR "eval: $e\n";
 
802
            my $e = process_vars($e);
 
803
            $vars{$v} = eval($e);
 
804
            if (!defined($vars{$v})) {
 
805
              warn "$@";
 
806
              warn "$currentfile:$currentline [$_]\n";
 
807
            }
 
808
        } elsif (/\@\s*perleval\s*(.*)\@/) { #                        PERLEVAL
 
809
#           print STDERR "perleval: $1\n";
 
810
            my $res = eval($1);
 
811
            if ($res) {
 
812
              warn "$@";
 
813
              warn "$currentfile:$currentline [$_]\n";
 
814
            }
 
815
        } elsif (/\@\s*startperl\s*\@/) { #                          STARTPERL
 
816
            my $text;
 
817
            while (get_next_line()) {
 
818
                last if (/\@\s*endperl\s*\@/);
 
819
                $text .= $_;
 
820
            }
 
821
            my $res = eval($text);
 
822
            if ($res) {
 
823
              warn "$@";
 
824
              warn "$currentfile:$currentline [$_]\n";
 
825
            }
 
826
#           print STDERR "perleval: $1\n";
 
827
        } elsif (/\@\s*printf\s+(\"[^\"]+\")\s*,?(.*)\@/) { #           PRINTF
 
828
            my ($f, $rest) = ($1, $2);
 
829
            $rest = process_vars($rest);
 
830
            my @args = split(/\s*,\s*/,$rest);
 
831
            $f = eval $f;
 
832
#           print STDERR "printf: $f, ", join(", ",@args),"\n";
 
833
            foreach $file (values(%outputs)) {
 
834
                printf $file (eval {$f}, @args);
 
835
            }
 
836
        } elsif (/\@\s*foreach\s+\$([^\@]+)\s+scalars*\s*\@/) { #      SCALARS
 
837
            my $var = $1;
 
838
            my $stash = do_tell();
 
839
            my $scalar;
 
840
            my @thekeys = keys(%scalars);
 
841
            if ($#thekeys == -1) {
 
842
              $return = skippart();
 
843
            } else {
 
844
              if ($havenetsnmpoid) {
 
845
                  @thekeys = sort {
 
846
                                    new NetSNMP::OID($a) <=> 
 
847
                                      new NetSNMP::OID($b) } @thekeys;
 
848
              }
 
849
              foreach $scalar (@thekeys) {
 
850
                  $return = do_a_loop($stash, \$vars{$var}, $scalar,
 
851
                                      \$currentscalar, $scalar,
 
852
                                      \$currentvar, $scalar);
 
853
              }
 
854
            }
 
855
            m2c_die("foreach did not end with \@end@") if($return ne "end");
 
856
        } elsif (/\@\s*foreach\s+\$([^\@]+)\s+notifications*\s*\@/) {
 
857
            my $var = $1;
 
858
            my $stash = do_tell();
 
859
            my $notify;
 
860
            my @thekeys = keys(%notifications);
 
861
            if ($#thekeys == -1) {
 
862
              $return = skippart();
 
863
            } else {
 
864
              if ($havenetsnmpoid) {
 
865
                  @thekeys = sort {
 
866
                                    new NetSNMP::OID($a) <=> 
 
867
                                      new NetSNMP::OID($b) } @thekeys;
 
868
              }
 
869
              foreach $notify (@thekeys) {
 
870
                  $return = do_a_loop($stash, \$vars{$var}, $notify,
 
871
                                      \$currentnotify, $notify);
 
872
              }
 
873
            }
 
874
            m2c_die("foreach did not end with \@end@") if($return ne "end");
 
875
          } elsif (/\@\s*foreach\s+\$([^\@]+)\s+varbinds\s*\@/) {
 
876
            my $var = $1;
 
877
            my $stash = do_tell();
 
878
            my $varbind;
 
879
            if ($#{$notifyvars{$currentnotify}} == -1) {
 
880
              $return = skippart();
 
881
            } else {
 
882
              foreach $varbind (@{$notifyvars{$currentnotify}}) {
 
883
                #               print "looping on $var for $varbind\n";
 
884
                  $return = do_a_loop($stash, \$vars{$var}, $varbind,
 
885
                                      \$currentvarbind, $varbind);
 
886
              }
 
887
            }
 
888
            m2c_die("foreach did not end with \@end@") if($return ne "end");
 
889
          } elsif (/\@\s*foreach\s+\$([^\@]+)\s+tables*\s*\@/) {
 
890
            my $var = $1;
 
891
            my $stash = do_tell();
 
892
            my $table;
 
893
            my @thekeys = keys(%tables);
 
894
            if ($#thekeys == -1) {
 
895
              $return = skippart();
 
896
            } else {
 
897
              if ($havenetsnmpoid) {
 
898
                  @thekeys = sort {
 
899
                                    new NetSNMP::OID($a) <=> 
 
900
                                      new NetSNMP::OID($b) } @thekeys;
 
901
              }
 
902
              foreach $table (@thekeys) {
 
903
                  $return = do_a_loop($stash, \$vars{$var}, $table, 
 
904
                                      \$currenttable, $table);
 
905
              }
 
906
            }
 
907
            m2c_die("foreach did not end with \@end@ ($return)") if($return ne "end");
 
908
          } elsif (/\@\s*foreach\s+\$([^\@]+)\s+stuff\s*(.*)\@/) {
 
909
            my $var = $1;
 
910
            my $stuff = $2;
 
911
            my @stuff = split(/[,\s]+/, $stuff);
 
912
            my $stash = do_tell();
 
913
            if ($#stuff == -1) {
 
914
              $return = skippart();
 
915
            } else {
 
916
              foreach $st (@stuff) {
 
917
                  $return = do_a_loop($stash, \$vars{$var}, $st,
 
918
                                      \$currentstuff, $st);
 
919
              }
 
920
            }
 
921
            m2c_die("foreach did not end with \@end@ ($return)") if($return ne "end");
 
922
          } elsif (/\@\s*foreach\s+\$([^\@]+)\s+(column|index|internalindex|externalindex|nonindex)\s*\@/) {
 
923
            my ($var, $type) = ($1, $2);
 
924
            my $stash = do_tell();
 
925
            my $column;
 
926
            if ($#{$tables{$currenttable}{$type}} == -1) {
 
927
              $return = skippart();
 
928
            } else {
 
929
              foreach $column (@{$tables{$currenttable}{$type}}) {
 
930
                #               print "looping on $var for $type -> $column\n";
 
931
                  $return = do_a_loop($stash, \$vars{$var}, $column,
 
932
                                      \$currentcolumn, $column,
 
933
                                      \$currentvar, $column);
 
934
              }
 
935
            }
 
936
            m2c_die("foreach did not end with \@end@") if($return ne "end");
 
937
          } elsif (/\@\s*foreach\s+\$([^\@]+)\s+\$([^\@]+)\s+range\s+([^\@]+)\@/) {
 
938
            my ($svar, $evar, $node) = ($1, $2, $3);
 
939
            my $stash = do_tell();
 
940
            my $range;
 
941
            $node = $currentcolumn if (!$node);
 
942
            my $mibn = $SNMP::MIB{process_vars($node)};
 
943
            die "no such mib node: $node" if (!$mibn);
 
944
            my @ranges = @{$mibn->{'ranges'}};
 
945
            if ($#ranges > -1) {
 
946
                foreach $range (@ranges) {
 
947
                    $return = do_a_loop($stash, \$vars{$svar}, $range->{'low'},
 
948
                                        \$vars{$evar}, $range->{'high'});
 
949
                }
 
950
            } else {
 
951
                $return = skippart();
 
952
            }
 
953
            m2c_die("foreach did not end with \@end@") if($return ne "end");
 
954
        } elsif (/\@\s*foreach\s+\$([^\@,]+)\s*,*\s+\$([^\@]+)\s+(enums*)\s*\@/) {
 
955
            my ($varvar, $varval, $type) = ($1, $2, $3);
 
956
            my $stash = do_tell();
 
957
            my $enum, $enum2;
 
958
 
 
959
            my @keys = sort { $SNMP::MIB{$currentvar}{'enums'}{$a} <=>
 
960
                                  $SNMP::MIB{$currentvar}{'enums'}{$b} } (keys(%{$SNMP::MIB{$currentvar}{'enums'}}));
 
961
            if ($#keys > -1) {
 
962
                foreach $enum (@keys) {
 
963
                  ($enum2 = $enum) =~ s/-/_/g;
 
964
                    $return = do_a_loop($stash, \$vars{$varvar}, $enum2,
 
965
                                        \$vars{$varval},
 
966
                                        $SNMP::MIB{$currentvar}{'enums'}{$enum});
 
967
                }
 
968
            } else {
 
969
                $return = skippart();
 
970
            }
 
971
            m2c_die("foreach did not end with \@end@") if($return ne "end");
 
972
        } elsif (/\@\s*while([a-z]*)\s+([^@]+)\@/) { #                     WHILE
 
973
          my ($type,$arg,$ok) = ($1,$2,0);
 
974
          my $stash = do_tell();
 
975
          my $loop = 1;
 
976
 
 
977
          while ($loop) {
 
978
            # check condition based on type
 
979
            if (! $type) {
 
980
              $ok = eval(process_vars($arg));
 
981
            } elsif ($type eq conf) {
 
982
              my $file = find_conf(process_vars($arg),1); # missingok
 
983
              $ok = (-f $file);
 
984
            } elsif ($type eq dir) {
 
985
              $ok = (-d $arg);
 
986
            } else {
 
987
              m2c_die "unknown while modifier ($type)\n";
 
988
            }
 
989
 
 
990
            # act on condition
 
991
            if ($ok) {
 
992
              $return = do_a_loop($stash, \$vars{$type}, $ok, \$vars{$args});
 
993
            } else {
 
994
              $loop = 0;
 
995
            }
 
996
          }
 
997
        } elsif (/\@\s*prompt\s+\$(\S+)\s*(.*)\@/) { #                  PROMPT
 
998
            my ($var, $prompt) = ($1, $2);
 
999
            if (!$term) {
 
1000
                my $haveit = eval { require Term::ReadLine };
 
1001
                if ($haveit) {
 
1002
                    $term = new Term::ReadLine 'mib2c';
 
1003
                }
 
1004
            }
 
1005
            if ($term) {
 
1006
                $vars{$var} = $term->readline(process_vars($prompt));
 
1007
            }
 
1008
        } elsif (/\@\s*print\s+([^@]*)\@/) { #                           PRINT
 
1009
          my $line = process_vars($1);
 
1010
          print "$line\n";
 
1011
        } else {
 
1012
          my $line = process_vars($_);
 
1013
          mib2c_output($line);
 
1014
          chop $_;
 
1015
          warn "$currentfile:$currentline contained a line that started with a @ but did not match any mib2c configuration tokens.\n";
 
1016
          warn "(maybe missing the trailing @?)\n";
 
1017
          warn "$currentfile:$currentline [$_]\n";
 
1018
          m2c_die if ($strict_unk_token == 1);
 
1019
        }
 
1020
#      $return = "eof";
 
1021
    }
 
1022
    print "< Balanced $balanced / level $currentlevel / rtn $return / $_\n" if($debug);
 
1023
    if((!$_) && ($return ne "eof")) {
 
1024
#      warn "switching return of '$return' to EOF\n" if($debug);
 
1025
      $return = "eof";
 
1026
    }
 
1027
  if ($balanced) {
 
1028
    if(($balanced != $currentlevel) || ($return ne "eof")) {
 
1029
      m2c_die "\@balanced@ specified, but processing terminated with '$return' before EOF!";
 
1030
    }
 
1031
  }
 
1032
  $currentlevel--;
 
1033
  return $return;
 
1034
}
 
1035
 
 
1036
sub mib2c_output {
 
1037
    my $line = shift;
 
1038
    foreach $file (values(%outputs)) {
 
1039
        print $file "$line";
 
1040
    }
 
1041
}
 
1042
 
 
1043
 
 
1044
sub setup_data {
 
1045
    my $mib = shift;
 
1046
    if ($mib->{label} =~ /Table$/) {
 
1047
        my $tablename = $mib->{label};
 
1048
        my $entry = $mib->{children};
 
1049
        my $columns = $entry->[0]{children};
 
1050
        my $augments = $entry->[0]{'augments'};
 
1051
        foreach my $col (sort { $a->{'subID'} <=> $b->{'subID'} } @$columns) {
 
1052
            # store by numeric key so we can sort them later
 
1053
            push @{$tables{$tablename}{'column'}}, $col->{'label'};
 
1054
        }
 
1055
        if ($augments) {
 
1056
           my $mib = $SNMP::MIB{$augments} || 
 
1057
                die "can't find info about augmented table $augments in table $tablename\n";
 
1058
           $mib = $mib->{parent} || 
 
1059
                die "can't find info about augmented table $augments in table $tablename\n";
 
1060
           my $entry = $mib->{children};
 
1061
           foreach my $index (@{$entry->[0]{'indexes'}}) {
 
1062
               my $node = $SNMP::MIB{$index} || 
 
1063
                   die "can't find info about index $index in table $tablename\n";
 
1064
               push @{$tables{$tablename}{'index'}}, $index;
 
1065
               push @{$tables{$tablename}{'externalindex'}}, $index;
 
1066
           }
 
1067
           my $columns = $entry->[0]{children};
 
1068
        }
 
1069
        else {
 
1070
          foreach my $index (@{$entry->[0]{'indexes'}}) {
 
1071
            my $node = $SNMP::MIB{$index} || 
 
1072
              die "can't find info about index $index in table $tablename\n";
 
1073
            push @{$tables{$tablename}{'index'}}, $index;
 
1074
            if("@{$tables{$tablename}{'column'}}" =~ /$index\b/ ) {
 
1075
#              print "idx INT $index\n";
 
1076
              push @{$tables{$tablename}{'internalindex'}}, $index;
 
1077
            } else {
 
1078
#              print "idx EXT $index\n";
 
1079
              push @{$tables{$tablename}{'externalindex'}}, $index;
 
1080
            }
 
1081
          }
 
1082
        }
 
1083
        foreach my $col (sort { $a->{'subID'} <=> $b->{'subID'} } @$columns) {
 
1084
            next if ( "@{$tables{$tablename}{'index'}}" =~ /$col->{'label'}\b/ );
 
1085
            push @{$tables{$tablename}{'nonindex'}}, $col->{'label'};
 
1086
        }
 
1087
#        print "indexes: @{$tables{$tablename}{'index'}}\n";
 
1088
#        print "internal indexes: @{$tables{$tablename}{'internalindex'}}\n";
 
1089
#        print "external indexes: @{$tables{$tablename}{'externalindex'}}\n";
 
1090
#        print "non-indexes: @{$tables{$tablename}{'nonindex'}}\n";
 
1091
    } else {
 
1092
        my $children = $mib->{children};
 
1093
        if ($#children == -1 && $mib->{type}) {
 
1094
            # scalar
 
1095
            if ($mib->{type} eq "NOTIF" ||
 
1096
                $mib->{type} eq "TRAP") {
 
1097
                my $notifyname = $mib->{label};
 
1098
                my @varlist = ();
 
1099
                $notifications{$notifyname} = 1;
 
1100
                $notifyvars{$notifyname} = $mib->{varbinds};
 
1101
            } else {
 
1102
                $scalars{$mib->{label}} = 1 if ($mib->{'access'} ne 'Notify');
 
1103
            }
 
1104
        } else {
 
1105
            my $i;
 
1106
            for($i = 0; $i <= $#$children; $i++) {
 
1107
                setup_data($children->[$i]);
 
1108
            }
 
1109
        }
 
1110
    }
 
1111
}
 
1112
 
 
1113
sub min {
 
1114
    return $_[0] if ($_[0] < $_[1]);
 
1115
    return $_[1];
 
1116
}
 
1117
 
 
1118
sub max {
 
1119
    return $_[0] if ($_[0] > $_[1]);
 
1120
    return $_[1];
 
1121
}
 
1122
 
 
1123
sub find_conf {
 
1124
  my ($configfile, $missingok) = (@_);
 
1125
 
 
1126
  foreach my $d (@search_dirs, @def_search_dirs) {
 
1127
#      print STDERR "using $d/$configfile" if (-f "$d/$configfile");
 
1128
      return "$d/$configfile" if (-f "$d/$configfile");
 
1129
  }
 
1130
  return $configfile if (-f "$configfile");
 
1131
  return if ($missingok);
 
1132
 
 
1133
  print STDERR "Can't find a configuration file called $configfile\n";
 
1134
  print STDERR "(referenced at $currentfile:$currentline)\n" if ($currentfile);
 
1135
  print STDERR "I looked in:\n";
 
1136
  print "  " . join("\n  ", @search_dirs, @def_search_dirs), "\n";
 
1137
  exit 1;
 
1138
}
 
1139
 
 
1140
sub open_conf {
 
1141
    my $configfile = shift;
 
1142
# process .conf file
 
1143
    if (! -f "$configfile") {
 
1144
        print STDERR "Can't find a configuration file called $configfile\n";
 
1145
        exit 1;
 
1146
    }
 
1147
    $currentfile = $configfile;
 
1148
    my $fh = new IO::File;
 
1149
    $fh->open("$configfile");
 
1150
    return $fh;
 
1151
}
 
1152
 
 
1153
sub count_scalars {
 
1154
    my @k = keys(%scalars);
 
1155
    return $#k + 1;
 
1156
}
 
1157
 
 
1158
sub count_tables {
 
1159
    my @k = keys(%tables);
 
1160
    return $#k + 1;
 
1161
}
 
1162
 
 
1163
sub count_columns {
 
1164
    my $table = shift;
 
1165
    return $#{$tables{$table}{'column'}} + 1;
 
1166
}
 
1167
 
 
1168
sub table_is_writable {
 
1169
    my $table = shift;
 
1170
    my $column;
 
1171
    my $result = 0;
 
1172
    foreach $column (@{$tables{$table}{'column'}}) {
 
1173
      if($SNMP::MIB{$column}{access} =~ /(ReadWrite|Create|WriteOnly)/) {
 
1174
        $result = 1;
 
1175
        last;
 
1176
      }
 
1177
    }
 
1178
    return $result;
 
1179
}
 
1180
 
 
1181
sub table_has_create {
 
1182
    my $table = shift;
 
1183
    my $column;
 
1184
    my $result = 0;
 
1185
    foreach $column (@{$tables{$table}{'column'}}) {
 
1186
      if($SNMP::MIB{$column}{access} =~ /(Create)/) {
 
1187
        $result = 1;
 
1188
        last;
 
1189
      }
 
1190
    }
 
1191
    return $result;
 
1192
}
 
1193
 
 
1194
sub table_has_rowstatus {
 
1195
    my $table = shift;
 
1196
    my $column;
 
1197
    my $result = 0;
 
1198
    foreach $column (@{$tables{$table}{'column'}}) {
 
1199
      if($SNMP::MIB{$column}{syntax} =~ /(RowStatus)/) {
 
1200
        $result = 1;
 
1201
        last;
 
1202
      }
 
1203
    }
 
1204
    return $result;
 
1205
}
 
1206
 
 
1207
sub table_has_lastchange {
 
1208
    my $table = shift;
 
1209
    my $column;
 
1210
    my $result = 0;
 
1211
    foreach $column (@{$tables{$table}{'column'}}) {
 
1212
      if(($SNMP::MIB{$column}{syntax} =~ /(TimeStamp)/) &&
 
1213
         ($SNMP::MIB{$column}{label} =~ /(LastChange)/)) {
 
1214
        $result = 1;
 
1215
        last;
 
1216
      }
 
1217
    }
 
1218
    return $result;
 
1219
}
 
1220
 
 
1221
sub table_has_storagetype {
 
1222
    my $table = shift;
 
1223
    my $column;
 
1224
    my $result = 0;
 
1225
    foreach $column (@{$tables{$table}{'column'}}) {
 
1226
      if($SNMP::MIB{$column}{syntax} =~ /(StorageType)/) {
 
1227
        $result = 1;
 
1228
        last;
 
1229
      }
 
1230
    }
 
1231
    return $result;
 
1232
}
 
1233
 
 
1234
sub count_indexes {
 
1235
    my $table = shift;
 
1236
    return $#{$tables{$table}{'index'}} + 1;
 
1237
}
 
1238
 
 
1239
sub count_external_indexes {
 
1240
    my $table = shift;
 
1241
    return $#{$tables{$table}{'externalindex'}} + 1;
 
1242
}
 
1243
 
 
1244
sub count_notifications {
 
1245
    my @k = keys(%notifications);
 
1246
    return $#k + 1;
 
1247
}
 
1248
 
 
1249
sub count_varbinds {
 
1250
    my $notify = shift;
 
1251
    return $#{$notifyvars{$notify}} + 1;
 
1252
}