JezK
Edit File: mib2c
#!/usr/bin/perl #!/usr/bin/perl # # $Id$ # # Description: # # This program, given an OID reference as an argument, creates some # template mib module files to be used with the net-snmp agent. It is # far from perfect and will not generate working modules, but it # significantly shortens development time by outlining the basic # structure. # # Its up to you to verify what it does and change the default values # it returns. # # SNMP my $havesnmp = eval {require SNMP;}; my $havenetsnmpoid = eval {require NetSNMP::OID;}; if (!$havesnmp) { print " ERROR: You don't have the SNMP perl module installed. Please obtain this by running the command: apt-get install libsnmp-perl "; exit; } if ($havesnmp) { eval { import SNMP; } } if ($havenetsnmp) { eval { import NetSNMP::OID; } } use FileHandle; #use strict 'vars'; $SNMP::save_descriptions=1; $SNMP::use_long_names=1; $SNMP::use_enums=1; SNMP::initMib(); $configfile="mib2c.conf"; $debug=0; $quiet=0; $strict_unk_token = 0; $noindent = 0; $nosed = 0; $currentline = 0; $currentlevel = -1; %assignments; %outputs; @def_search_dirs = ("."); @search_dirs = (); if($ENV{MIB2C_DIR}) { push @def_search_dirs, split(/:/, $ENV{MIB2C_DIR}); } push @def_search_dirs, "/etc/snmp/"; push @def_search_dirs, "/usr/share/snmp/"; push @def_search_dirs, "/usr/share/snmp/mib2c-data"; push @def_search_dirs, "./mib2c-conf.d"; sub usage { print "$0 [-h] [-c configfile] [-f prefix] mibNode\n\n"; print " -h\t\tThis message.\n\n"; print " -c configfile\tSpecifies the configuration file to use\n\t\tthat dictates what the output of mib2c will look like.\n\n"; print " -I PATH\tSpecifies a path to look for configuration files in\n\n"; print " -f prefix\tSpecifies the output prefix to use. All code\n\t\twill be put into prefix.c and prefix.h\n\n"; print " -d\t\tdebugging output (don't do it. trust me.)\n\n"; print " -S VAR=VAL\tSet \$VAR variable to \$VAL\n\n"; print " -i\t\tDon't run indent on the resulting code\n\n"; print " -s\t\tDon't look for mibNode.sed and run sed on the resulting code\n\n"; 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"; 1; } my @origargs = @ARGV; my $args_done = 0; while($#ARGV >= 0) { $_ = shift; if (/^-/) { if ($args_done != 0) { warn "all argument must be specified before the mibNode!\n"; usage; exit 1; } elsif (/^-c/) { $configfile = shift; } elsif (/^-d/) { $debug = 1; } elsif (/^-S/) { my $expr = shift; my ($var, $val) = ($expr =~ /([^=]*)=(.*)/); die "no variable specified for -S flag." if (!$var); $assignments{$var} = $val; } elsif (/^-q/) { $quiet = 1; } elsif (/^-i/) { $noindent = 1; } elsif (/^-s/) { $nosed = 1; } elsif (/^-h/) { usage && exit(1); } elsif (/^-f/) { $outputName = shift; } elsif (/^-I/) { my $dirs = shift; push @search_dirs, split(/,/,$dirs); } else { warn "Unknown option '$_'\n"; usage; exit 1; } } else { $args_done = 1; warn "Replacing previous mibNode $oid with $_\n" if ($oid); $oid = $_ ; } } # # internal conversion tables # %accessToIsWritable = qw(ReadOnly 0 ReadWrite 1 WriteOnly 1 Create 1); %perltoctypes = qw(OCTETSTR ASN_OCTET_STR INTEGER ASN_INTEGER INTEGER32 ASN_INTEGER UNSIGNED32 ASN_UNSIGNED OBJECTID ASN_OBJECT_ID COUNTER64 ASN_COUNTER64 COUNTER ASN_COUNTER NETADDR ASN_COUNTER UINTEGER ASN_UINTEGER IPADDR ASN_IPADDRESS BITS ASN_OCTET_STR TICKS ASN_TIMETICKS GAUGE ASN_GAUGE OPAQUE ASN_OPAQUE); %perltodecl = ("OCTETSTR", "char", "INTEGER", "long", "INTEGER32", "long", "UNSIGNED32", "u_long", "UINTEGER", "u_long", "OBJECTID", "oid", "COUNTER64", "struct counter64", "COUNTER", "u_long", "IPADDR", "in_addr_t", "BITS", "char", "TICKS", "u_long", "GAUGE", "u_long", "OPAQUE", "u_char"); %perltolen = ("OCTETSTR", "1", "INTEGER", "0", "INTEGER32", "0", "UNSIGNED32", "0", "UINTEGER", "0", "OBJECTID", "1", "COUNTER64", "0", "COUNTER", "0", "IPADDR", "0", "BITS", "1", "TICKS", "0", "GAUGE", "0", "OPAQUE", "1"); my $mibnode = $SNMP::MIB{$oid}; if (!$mibnode) { print STDERR " You didn't give mib2c a valid OID to start with. IE, I could not find any information about the mib node \"$oid\". This could be caused because you supplied an incorrectly node, or by the MIB that you're trying to generate code from isn't loaded. To make sure your mib is loaded, run mib2c using this as an example: env MIBS=\"+MY-PERSONAL-MIB\" mib2c " . join(" ",@origargs) . " You might wish to start by reading the MIB loading tutorial at: http://www.net-snmp.org/tutorial-5/commands/mib-options.html And making sure you can get snmptranslate to display information about your MIB node. Once snmptranslate works, then come back and try mib2c again. "; exit 1; } # setup $outputName = $mibnode->{'label'} if (!defined($outputName)); $outputName =~ s/-/_/g; $vars{'name'} = $outputName; $vars{'oid'} = $oid; $vars{'example_start'} = " /*\n" . " ***************************************************\n" . " *** START EXAMPLE CODE ***\n" . " ***---------------------------------------------***/"; $vars{'example_end'} = " /*\n" . " ***---------------------------------------------***\n" . " *** END EXAMPLE CODE ***\n" . " ***************************************************/"; # loop through mib nodes, remembering stuff. setup_data($mibnode); if(($ENV{HOME}) && (-f "$ENV{HOME}/.snmp/mib2c.conf")) { $fh = open_conf("$ENV{HOME}/.snmp/mib2c.conf"); process("-balanced"); $fh->close; } my $defaults = find_conf("default-$configfile",1); if (-f "$defaults" ) { $fh = open_conf($defaults); process("-balanced"); $fh->close; } my @theassignments = keys(%assignments); if ($#theassignments != -1) { foreach $var (@theassignments) { $vars{$var} = $assignments{$var}; } } $configfile = find_conf($configfile,0); $fh = open_conf($configfile); process("-balanced"); $fh->close; if (-f "$outputName.sed" && !$nosed) { foreach $i (keys(%written)) { next if ($i eq "-"); next if (!($i =~ /\.[ch]$/)); print STDERR "running sed --in-place=.orig --file=$outputName.sed $i\n" if (!$quiet); system("sed --in-place=.orig --file=$outputName.sed $i"); } } if (!$noindent) { foreach $i (keys(%written)) { next if ($i eq "-"); next if (!($i =~ /\.[ch]$/)); print STDERR "running indent on $i\n" if (!$quiet); 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"); } } sub m2c_die { warn "ERROR: ". $_[0] . "\n"; die " at $currentfile:$currentline\n"; } sub tocommas { my $oid = $_[0]; $oid =~ s/\./,/g; $oid =~ s/^\s*,//; return $oid; } sub oidlength { return (scalar split(/\./, $_[0])) - 1; } # replaces $VAR type expressions and $VAR.subcomponent expressions # with data from the mib tree and loop variables. # possible uses: # # $var -- as defined by loops, etc. # ${var}otherstuff -- appending text to variable contents # $var.uc -- all upper case version of $var # # NOTE: THESE ARE AUTO-EXTRACTED/PROCESSED BY ../mib2c.extract.pl for man pages # # Mib components, $var must first expand to a mib node name: # # $var.uc -- all upper case version of $var # # $var.objectID -- dotted, fully-qualified, and numeric OID # $var.commaoid -- comma separated numeric OID for array initialization # $var.oidlength -- length of the oid # $var.subid -- last number component of oid # $var.module -- MIB name that the object comes from # $var.parent -- contains the label of the parent node of $var. # # $var.isscalar -- returns 1 if var contains the name of a scalar # $var.iscolumn -- returns 1 if var contains the name of a column # $var.children -- returns 1 if var has children # # $var.perltype -- node's perl SYNTAX ($SNMP::MIB{node}{'syntax'}) # $var.type -- node's ASN_XXX type (Net-SNMP specific #define) # $var.decl -- C data type (char, u_long, ...) # # $var.readable -- 1 if an object is readable, 0 if not # $var.settable -- 1 if an object is writable, 0 if not # $var.creatable -- 1 if a column object can be created as part of a new row, 0 if not # $var.noaccess -- 1 if not-accessible, 0 if not # $var.accessible -- 1 if accessible, 0 if not # $var.storagetype -- 1 if an object is a StorageType object, 0 if not # $var.rowstatus -- 1 if an object is a RowStatus object, 0 if not # 'settable', 'creatable', 'lastchange', 'storagetype' and 'rowstatus' can # also be used with table variables to indicate whether it contains # writable, creatable, LastChange, StorageType or RowStatus column objects # # $var.hasdefval -- returns 1 if var has a DEFVAL clause # $var.defval -- node's DEFVAL # $var.hashint -- returns 1 if var has a HINT clause # $var.hint -- node's HINT # $var.ranges -- returns 1 if var has a value range defined # $var.enums -- returns 1 if var has enums defined for it. # $var.access -- node's access type # $var.status -- node's status # $var.syntax -- node's syntax # $var.reference -- node's reference # $var.description -- node's description sub process_vars { my $it = shift; # mib substitutions ($var.type -> $mibnode->{'type'}) if ( $it =~ /\$(\w+)\.(\w+)/ ) { if (!defined($vars{$1})) { m2c_die "Undefined variable \$$1"; } if ($SNMP::MIB{$vars{$1}} && defined($tables{$SNMP::MIB{$vars{$1}}{'label'}})) { $it =~ s/\$(\w+)\.(settable)/(table_is_writable($SNMP::MIB{$vars{$1}}{label}))/eg; $it =~ s/\$(\w+)\.(creatable)/(table_has_create($SNMP::MIB{$vars{$1}}{label}))/eg; $it =~ s/\$(\w+)\.(rowstatus)/(table_has_rowstatus($SNMP::MIB{$vars{$1}}{label}))/eg; $it =~ s/\$(\w+)\.(lastchange)/(table_has_lastchange($SNMP::MIB{$vars{$1}}{label}))/eg; $it =~ s/\$(\w+)\.(storagetype)/(table_has_storagetype($SNMP::MIB{$vars{$1}}{label}))/eg; } $it =~ s/\$(\w+)\.(uc)/uc($vars{$1})/eg; # make something uppercase $it =~ s/\$(\w+)\.(commaoid)/tocommas($SNMP::MIB{$vars{$1}}{objectID})/eg; $it =~ s/\$(\w+)\.(oidlength)/oidlength($SNMP::MIB{$vars{$1}}{objectID})/eg; $it =~ s/\$(\w+)\.(description)/$SNMP::MIB{$vars{$1}}{description}/g; $it =~ s/\$(\w+)\.(perltype)/$SNMP::MIB{$vars{$1}}{type}/g; $it =~ s/\$(\w+)\.(type)/$perltoctypes{$SNMP::MIB{$vars{$1}}{$2}}/g; $it =~ s/\$(\w+)\.(subid)/$SNMP::MIB{$vars{$1}}{subID}/g; $it =~ s/\$(\w+)\.(module)/$SNMP::MIB{$vars{$1}}{moduleID}/g; $it =~ s/\$(\w+)\.(settable)/(($SNMP::MIB{$vars{$1}}{access} =~ \/(ReadWrite|Create|WriteOnly)\/)?1:0)/eg; $it =~ s/\$(\w+)\.(creatable)/(($SNMP::MIB{$vars{$1}}{access} =~ \/(Create)\/)?1:0)/eg; $it =~ s/\$(\w+)\.(readable)/(($SNMP::MIB{$vars{$1}}{access} =~ \/(Read|Create)\/)?1:0)/eg; $it =~ s/\$(\w+)\.(noaccess)/(($SNMP::MIB{$vars{$1}}{access} =~ \/(NoAccess)\/)?1:0)/eg; $it =~ s/\$(\w+)\.(accessible)/(($SNMP::MIB{$vars{$1}}{access} !~ \/(NoAccess)\/)?1:0)/eg; $it =~ s/\$(\w+)\.(objectID|label|subID|access|status|syntax|reference)/$SNMP::MIB{$vars{$1}}{$2}/g; $it =~ s/\$(\w+)\.(decl)/$perltodecl{$SNMP::MIB{$vars{$1}}{type}}/g; $it =~ s/\$(\w+)\.(needlength)/$perltolen{$SNMP::MIB{$vars{$1}}{type}}/g; $it =~ s/\$(\w+)\.(iscolumn)/($SNMP::MIB{$vars{$1}}{'parent'}{'label'} =~ \/Entry$\/) ? 1 : 0/eg; $it =~ s/\$(\w+)\.(isscalar)/($SNMP::MIB{$vars{$1}}{'parent'}{'label'} !~ \/Entry$\/ && $SNMP::MIB{$vars{$1}}{access}) ? 1 : 0/eg; $it =~ s/\$(\w+)\.(parent)/$SNMP::MIB{$vars{$1}}{'parent'}{'label'}/g; $it =~ s/\$(\w+)\.(children)/($#{$SNMP::MIB{$vars{$1}}{'children'}} == 0) ? 0 : 1/eg; $it =~ s/\$(\w+)\.(hasdefval)/(length($SNMP::MIB{$vars{$1}}{'defaultValue'}) == 0) ? 0 : 1/eg; $it =~ s/\$(\w+)\.(defval)/$SNMP::MIB{$vars{$1}}{'defaultValue'}/g; $it =~ s/\$(\w+)\.(hashint)/(length($SNMP::MIB{$vars{$1}}{'hint'}) == 0) ? 0 : 1/eg; $it =~ s/\$(\w+)\.(hint)/$SNMP::MIB{$vars{$1}}{'hint'}/g; $it =~ s/\$(\w+)\.(ranges)/($#{$SNMP::MIB{$vars{$1}}{'ranges'}} == -1) ? 0 : 1/eg; # check for enums $it =~ s/\$(\w+)\.(enums)/(%{$SNMP::MIB{$vars{$1}}{'enums'}} == 0) ? 0 : 1/eg; $it =~ s/\$(\w+)\.(enumrange)/%{$SNMP::MIB{$vars{$1}}{'enums'}}/eg; $it =~ s/\$(\w+)\.(rowstatus)/(($SNMP::MIB{$vars{$1}}{syntax} =~ \/(RowStatus)\/)?1:0)/eg; $it =~ s/\$(\w+)\.(storagetype)/(($SNMP::MIB{$vars{$1}}{syntax} =~ \/(StorageType)\/)?1:0)/eg; if ( $it =~ /\$(\w+)\.(\w+)/ ) { warn "Possible unknown variable attribute \$$1.$2 at $currentfile:$currentline\n"; } } # normal variable substitions $it =~ s/\$\{(\w+)\}/$vars{$1}/g; $it =~ s/\$(\w+)/$vars{$1}/g; # use $@var to put literal '$var' $it =~ s/\$\@(\w+)/\$$1/g; return $it; } # process various types of statements # # NOTE: THESE ARE AUTO-EXTRACTED/PROCESSED BY ../mib2c.extract.pl for man pages # which include: # @open FILE@ # writes generated output to FILE # note that for file specifications, opening '-' will print to stdout. # @append FILE@ # appends the given FILE # @close FILE@ # closes the given FILE # @push@ # save the current outputs, then clear outputs. Use with @open@ # and @pop@ to write to a new file without interfering with current # outputs. # @pop@ # pop up the process() stack one level. Use after a @push@ to return to # the previous set of open files. # @foreach $VAR scalar@ # repeat iterate over code until @end@ setting $VAR to all known scalars # @foreach $VAR table@ # repeat iterate over code until @end@ setting $VAR to all known tables # @foreach $VAR column@ # repeat iterate over code until @end@ setting $VAR to all known # columns within a given table. Obviously this must be called # within a foreach-table clause. # @foreach $VAR nonindex@ # repeat iterate over code until @end@ setting $VAR to all known # non-index columns within a given table. Obviously this must be called # within a foreach-table clause. # @foreach $VAR internalindex@ # repeat iterate over code until @end@ setting $VAR to all known internal # index columns within a given table. Obviously this must be called # within a foreach-table clause. # @foreach $VAR externalindex@ # repeat iterate over code until @end@ setting $VAR to all known external # index columns within a given table. Obviously this must be called # within a foreach-table clause. # @foreach $VAR index@ # repeat iterate over code until @end@ setting $VAR to all known # indexes within a given table. Obviously this must be called # within a foreach-table clause. # @foreach $VAR notifications@ # repeat iterate over code until @end@ setting $VAR to all known notifications # @foreach $VAR varbinds@ # repeat iterate over code until @end@ setting $VAR to all known varbinds # Obviously this must be called within a foreach-notifications clause. # @foreach $LABEL, $VALUE enum@ # repeat iterate over code until @end@ setting $LABEL and $VALUE # to the label and values from the enum list. # @foreach $RANGE_START, $RANGE_END range NODE@ # repeat iterate over code until @end@ setting $RANGE_START and $RANGE_END # to the legal accepted range set for a given mib NODE. # @foreach $var stuff a b c d@ # repeat iterate over values a, b, c, d as assigned generically # (ie, the values are taken straight from the list with no # mib-expansion, etc). # @while expression@ # repeat iterate over code until the expression is false # @eval $VAR = expression@ # evaluates expression and assigns the results to $VAR. This is # not a full perl eval, but sort of a "psuedo" eval useful for # simple expressions while keeping the same variable name space. # See below for a full-blown export to perl. # @perleval STUFF@ # evaluates STUFF directly in perl. Note that all mib2c variables # interpereted within .conf files are in $vars{NAME} and that # a warning will be printed if STUFF does not return 0. (adding a # 'return 0;' at the end of STUFF is a workaround. # @startperl@ # @endperl@ # treats everything between these tags as perl code, and evaluates it. # @next@ # restart foreach; should only be used inside a conditional. # skips out of current conditional, then continues to skip to # end for the current foreach clause. # @if expression@ # evaluates expression, and if expression is true processes # contained part until appropriate @end@ is reached. If the # expression is false, the next @elsif expression@ expression # (if it exists) will be evaluated, until an expression is # true. If no such expression exists and an @else@ # clause is found, it will be evaluated. # @ifconf file@ # If the specified file can be found in the conf file search path, # and if found processes contained part until an appropriate @end@ is # found. As with a regular @if expression@, @elsif expression@ and # @else@ can be used. # @ifdir dir@ # If the specified directory exists, process contained part until an # appropriate @end@ is found. As with a regular @if expression@, # @elsif expression@ and @else@ can be used. # @define NAME@ # @enddefine@ # Memorizes "stuff" between the define and enddefine tags for # later calling as NAME by @calldefine NAME@. # @calldefine NAME@ # Executes stuff previously memorized as NAME. # @printf "expression" stuff1, stuff2, ...@ # Like all the other printf's you know and love. # @run FILE@ # Sources the contents of FILE as a mib2c file, # but does not affect current files opened. # @include FILE@ # Sources the contents of FILE as a mib2c file and appends its # output to the current output. # @prompt $var QUESTION@ # Presents the user with QUESTION, expects a response and puts it in $var # @print STUFF@ # Prints stuff directly to the users screen (ie, not to where # normal mib2c output goes) # @quit@ # Bail out (silently) # @exit@ # Bail out! # sub skippart { my $endcount = 1; my $arg = shift; my $rtnelse = 0; while ($arg =~ s/-(\w+)\s*//) { $rtnelse = 1 if ($1 eq "else"); } while(get_next_line()) { $currentline++; $_ = process_vars($_) if ($debug); print "$currentfile.$currentline:P$currentlevel:S$endcount.$rtnelse:$_" if ($debug); next if ( /^\s*\#\#/ ); # noop, it's a comment next if (! /^\s*\@/ ); # output if (! /^\s*\@.*\@/ ) { warn "$currentfile:$currentline contained a line that started with a @ but did not match any mib2c configuration tokens.\n"; warn "(maybe missing the trailing @?)\n"; warn "$currentfile:$currentline [$_]\n"; } elsif (/\@\s*end\@/) { return "end" if ($endcount == 1); $endcount--; } elsif (/\@\s*elseif.*\@/) { m2c_die "use 'elsif' instead of 'elseif'\n"; } elsif (/\@\s*else\@/) { return "else" if (($endcount == 1) && ($rtnelse == 1)); } elsif (/\@\s*elsif\s+([^\@]+)\@/) { return "else" if (($endcount == 1) && ($rtnelse == 1) && (eval(process_vars($1)))); } elsif (/\@\s*(foreach|if|while)/) { $endcount++; } } print "skippart EOF\n"; m2c_die "unbalanced code detected in skippart: EOF when $endcount levels deep" if($endcount != 1); return "eof"; } sub close_file { my $name = shift; if (!$name) { print "close_file w/out name!\n"; return; } if(!$outputs{$name}) { print "no handle for $name\n"; return; } $outputs{$name}->close(); delete $outputs{$name}; # print STDERR "closing $name\n" if (!$quiet); } sub close_files { foreach $name (keys(%outputs)) { close_file($name); } } sub open_file { my $multiple = shift; my $spec = shift; my $name = $spec; $name =~ s/>//; if ($multiple == 0) { close_files(); } return if ($outputs{$name}); $outputs{$name} = new IO::File; $outputs{$name}->open(">$spec") || m2c_die "failed to open $name"; print STDERR "writing to $name\n" if (!$quiet && !$written{$name}); $written{$name} = '1'; } sub process_file { my ($file, $missingok, $keepvars) = (@_); my $oldfh = $fh; my $oldfile = $currentfile; my $oldline = $currentline; # keep old copy of @vars and just build on it. my %oldvars; %oldvars = %vars if ($keepvars != 1); $file = find_conf($file,$missingok); return if (! $file); $fh = open_conf($file); $currentline = 0; process("-balanced"); $fh->close(); $fh = $oldfh; $currentfile = $oldfile; $currentline = $oldline; # don't keep values in replaced vars. Revert to ours. %vars = %oldvars if ($keepvars != 1); } sub get_next_line { if ($#process_lines > -1) { return $_ = shift @process_lines; } return $_ = <$fh>; } sub do_tell { my $stash; $stash->{'startpos'} = $fh->tell(); $stash->{'startline'} = $currentline; @{$stash->{'lines'}} = @process_lines; return $stash; } sub do_seek { my $stash = shift; # save current line number $currentline = $stash->{'startline'}; $fh->seek($stash->{'startpos'}, 0); # go to top of section. # save current process_lines state. @process_lines = @{$stash->{'lines'}}; # save state of a number of variables (references), and new assignments for (my $i = 0; $i <= $#_; $i += 2) { push @{$stash->{'vars'}}, $_[$i], ${$_[$i]}; ${$_[$i]} = $_[$i+1]; } } sub do_unseek { my $stash = shift; for (my $i = 0; $i <= $#{$stash->{'vars'}}; $i += 2) { ${$stash->{'vars'}[$i]} = $stash->{'vars'}[$i+1]; } } sub do_a_loop { my $stash = shift; do_seek($stash, @_); my $return = process(); do_unseek($stash); return $return; } sub process { my $arg = shift; my $elseok = 0; my $balanced = 0; my $startlevel; my $return = "eof"; while ($arg =~ s/-(\w+)\s*//) { $elseok = 1 if ($1 eq "elseok"); $balanced = 1 if ($1 eq "balanced"); } $currentlevel++; $startlevel = $currentlevel; if($balanced) { $balanced = $currentlevel; } while(get_next_line()) { $currentline++; if ($debug) { # my $line = process_vars($_); # chop $line; print "$currentfile.$currentline:P$currentlevel.$elseok:$return:$_"; } next if (/^\s*\#\#/); # noop, it's a comment if (! /^\s*\@/ ) { # output my $line = process_vars($_); foreach $file (values(%outputs)) { print $file "$line"; } } #################################################################### elsif (/\@\s*exit\@/) { # EXIT close_files; die "exiting at conf file ($currentfile:$currentline) request\n"; } elsif (/\@\s*quit\@/) { # QUIT close_files; exit; } elsif (/\@\s*debug\s+([^\@]+)\@/) { # DEBUG if ($1 eq "on") { $debug = 1; } else { $debug = 0; } } elsif (/\@\s*strict token\s+([^\@]+)\@/) { # STRICT if ($1 eq "on") { $strict_unk_token = 1; } else { $strict_unk_token = 0; } } elsif (/\@\s*balanced\@/) { # BALANCED $balanced = $currentlevel; } elsif (/\@\s*open\s+([^\@]+)\@/) { # OPEN my $arg = $1; my ($multiple) = (0); while ($arg =~ s/-(\w+)\s+//) { $multiple = 1 if ($1 eq 'multiple'); } my $spec = process_vars($arg); open_file($multiple, $spec); } elsif (/\@\s*close\s+([^\@]+)\@/) { # CLOSE my $spec = process_vars($1); close_file($spec); } elsif (/\@\s*append\s+([^\@]+)\@/) { # APPEND my $arg = $1; my ($multiple) = (0); while ($arg =~ s/-(\w+)\s+//) { $multiple = 1 if ($1 eq 'multiple'); } my $spec = process_vars($arg); $spec=">$spec"; open_file($multiple,$spec); } elsif (/\@\s*define\s*(.*)\@/) { # DEFINE my $it = $1; while (<$fh>) { last if (/\@\s*enddefine\s*@/); push @{$defines{$it}}, $_; } } elsif (/\@\s*calldefine\s+(\w+)@/) { if ($#{$defines{$1}} == -1) { warn "called a define of $1 which didn't exist\n"; warn "$currentfile:$currentline [$_]\n"; } else { unshift @process_lines, @{$defines{$1}}; } } elsif (/\@\s*run (.*)\@/) { # RUN my $arg = $1; my ($again) = (0); while ($arg =~ s/-(\w+)\s+//) { $again = 1 if ($1 eq 'again'); # if ($1 eq 'file') { # my ($filearg) = ($arg =~ s/^(\w+)//); # } } my $spec = process_vars($arg); next if (!$again && $ranalready{$spec}); $ranalready{$spec} = 1; my %oldout = %outputs; my %emptyarray; %outputs = %emptyoutputs; process_file($spec,0,0); close_files; %outputs = %oldout; } elsif (/\@\s*push\@/) { # PUSH my %oldout = %outputs; my %emptyarray; %outputs = %emptyoutputs; process($arg); close_files; %outputs = %oldout; } elsif (/\@\s*pop\s*\@/) { # POP $return = "pop"; last; } elsif (/\@\s*include (.*)\@/) { # INCLUDE my $arg = $1; my ($missingok) = (0); while ($arg =~ s/-(\w+)\s+//) { $missingok = 1 if ($1 eq 'ifexists'); } my $spec = process_vars($arg); process_file($spec,$missingok,1); } elsif (/\@\s*if([a-z]*)\s+([^@]+)\@/) { # IF my ($type,$arg,$ok) = ($1,$2,0); # check condition based on type if (! $type) { $ok = eval(process_vars($arg)); } elsif ($type eq conf) { my $file = find_conf(process_vars($arg),1); # missingok $ok = (-f $file); } elsif ($type eq dir) { $ok = (-d $arg); } else { m2c_die "unknown if modifier ($type)\n"; } # act on condition if ($ok) { $return = process("-elseok"); } else { $return = skippart("-else"); $return = process("-elseok") if ($return eq "else"); } if ($return eq "next") { $return = skippart(); m2c_die("unbalanced code detected while exiting next/2 (returned $return)") if ($return ne "end"); # $return = "next"; last; } if (($return ne "end") && ($return ne "else")) { m2c_die "unbalanced if / return $return\n"; } } elsif (/\@\s*elseif.*\@/) { # bogus elseif m2c_die "error: use 'elsif' instead of 'elseif'\n"; } elsif (/\@\s*els(e|if).*\@/) { # ELSE/ELSIF if ($elseok != 1) { chop $_; m2c_die "unexpected els$1\n"; } $return = skippart(); if ($return ne "end") { m2c_die "unbalanced els$1 / rtn $rtn\n"; } $return = "else"; last; } elsif (/\@\s*next\s*\@/) { # NEXT $return = skippart(); m2c_die "unbalanced code detected while exiting next/1 (returned $return)" if ($return ne "end"); $return = "next"; last; } elsif (/\@\s*end\@/) { # END $return = "end"; last; } elsif (/\@\s*eval\s+\$(\w+)\s*=\s*([^\@]*)/) { # EVAL my ($v, $e) = ($1, $2); # print STDERR "eval: $e\n"; my $e = process_vars($e); $vars{$v} = eval($e); if (!defined($vars{$v})) { warn "$@"; warn "$currentfile:$currentline [$_]\n"; } } elsif (/\@\s*perleval\s*(.*)\@/) { # PERLEVAL # print STDERR "perleval: $1\n"; my $res = eval($1); if ($res) { warn "$@"; warn "$currentfile:$currentline [$_]\n"; } } elsif (/\@\s*startperl\s*\@/) { # STARTPERL my $text; while (get_next_line()) { last if (/\@\s*endperl\s*\@/); $text .= $_; } my $res = eval($text); if ($res) { warn "$@"; warn "$currentfile:$currentline [$_]\n"; } # print STDERR "perleval: $1\n"; } elsif (/\@\s*printf\s+(\"[^\"]+\")\s*,?(.*)\@/) { # PRINTF my ($f, $rest) = ($1, $2); $rest = process_vars($rest); my @args = split(/\s*,\s*/,$rest); $f = eval $f; # print STDERR "printf: $f, ", join(", ",@args),"\n"; foreach $file (values(%outputs)) { printf $file (eval {$f}, @args); } } elsif (/\@\s*foreach\s+\$([^\@]+)\s+scalars*\s*\@/) { # SCALARS my $var = $1; my $stash = do_tell(); my $scalar; my @thekeys = keys(%scalars); if ($#thekeys == -1) { $return = skippart(); } else { if ($havenetsnmpoid) { @thekeys = sort { new NetSNMP::OID($a) <=> new NetSNMP::OID($b) } @thekeys; } foreach $scalar (@thekeys) { $return = do_a_loop($stash, \$vars{$var}, $scalar, \$currentscalar, $scalar, \$currentvar, $scalar); } } m2c_die("foreach did not end with \@end@") if($return ne "end"); } elsif (/\@\s*foreach\s+\$([^\@]+)\s+notifications*\s*\@/) { my $var = $1; my $stash = do_tell(); my $notify; my @thekeys = keys(%notifications); if ($#thekeys == -1) { $return = skippart(); } else { if ($havenetsnmpoid) { @thekeys = sort { new NetSNMP::OID($a) <=> new NetSNMP::OID($b) } @thekeys; } foreach $notify (@thekeys) { $return = do_a_loop($stash, \$vars{$var}, $notify, \$currentnotify, $notify); } } m2c_die("foreach did not end with \@end@") if($return ne "end"); } elsif (/\@\s*foreach\s+\$([^\@]+)\s+varbinds\s*\@/) { my $var = $1; my $stash = do_tell(); my $varbind; if ($#{$notifyvars{$currentnotify}} == -1) { $return = skippart(); } else { foreach $varbind (@{$notifyvars{$currentnotify}}) { # print "looping on $var for $varbind\n"; $return = do_a_loop($stash, \$vars{$var}, $varbind, \$currentvarbind, $varbind, \$currentvar, $varbind); } } m2c_die("foreach did not end with \@end@") if($return ne "end"); } elsif (/\@\s*foreach\s+\$([^\@]+)\s+tables*\s*\@/) { my $var = $1; my $stash = do_tell(); my $table; my @thekeys = keys(%tables); if ($#thekeys == -1) { $return = skippart(); } else { if ($havenetsnmpoid) { @thekeys = sort { new NetSNMP::OID($a) <=> new NetSNMP::OID($b) } @thekeys; } foreach $table (@thekeys) { $return = do_a_loop($stash, \$vars{$var}, $table, \$currenttable, $table); } } m2c_die("foreach did not end with \@end@ ($return)") if($return ne "end"); } elsif (/\@\s*foreach\s+\$([^\@]+)\s+stuff\s*(.*)\@/) { my $var = $1; my $stuff = $2; my @stuff = split(/[,\s]+/, $stuff); my $stash = do_tell(); if ($#stuff == -1) { $return = skippart(); } else { foreach $st (@stuff) { $return = do_a_loop($stash, \$vars{$var}, $st, \$currentstuff, $st); } } m2c_die("foreach did not end with \@end@ ($return)") if($return ne "end"); } elsif (/\@\s*foreach\s+\$([^\@]+)\s+(column|index|internalindex|externalindex|nonindex)\s*\@/) { my ($var, $type) = ($1, $2); my $stash = do_tell(); my $column; if ($#{$tables{$currenttable}{$type}} == -1) { $return = skippart(); } else { foreach $column (@{$tables{$currenttable}{$type}}) { # print "looping on $var for $type -> $column\n"; $return = do_a_loop($stash, \$vars{$var}, $column, \$currentcolumn, $column, \$currentvar, $column); } } m2c_die("foreach did not end with \@end@") if($return ne "end"); } elsif (/\@\s*foreach\s+\$([^\@]+)\s+\$([^\@]+)\s+range\s+([^\@]+)\@/) { my ($svar, $evar, $node) = ($1, $2, $3); $svar =~ s/,$//; my $stash = do_tell(); my $range; $node = $currentcolumn if (!$node); my $mibn = $SNMP::MIB{process_vars($node)}; die "no such mib node: $node" if (!$mibn); my @ranges = @{$mibn->{'ranges'}}; if ($#ranges > -1) { foreach $range (@ranges) { $return = do_a_loop($stash, \$vars{$svar}, $range->{'low'}, \$vars{$evar}, $range->{'high'}); } } else { $return = skippart(); } m2c_die("foreach did not end with \@end@") if($return ne "end"); } elsif (/\@\s*foreach\s+\$([^\@,]+)\s*,*\s+\$([^\@]+)\s+(enums*)\s*\@/) { my ($varvar, $varval, $type) = ($1, $2, $3); my $stash = do_tell(); my $enum, $enum2; my @keys = sort { $SNMP::MIB{$currentvar}{'enums'}{$a} <=> $SNMP::MIB{$currentvar}{'enums'}{$b} } (keys(%{$SNMP::MIB{$currentvar}{'enums'}})); if ($#keys > -1) { foreach $enum (@keys) { ($enum2 = $enum) =~ s/-/_/g; $return = do_a_loop($stash, \$vars{$varvar}, $enum2, \$vars{$varval}, $SNMP::MIB{$currentvar}{'enums'}{$enum}); } } else { $return = skippart(); } m2c_die("foreach did not end with \@end@") if($return ne "end"); } elsif (/\@\s*while([a-z]*)\s+([^@]+)\@/) { # WHILE my ($type,$arg,$ok) = ($1,$2,0); my $stash = do_tell(); my $loop = 1; my $everlooped = 0; while ($loop) { # check condition based on type if (! $type) { $ok = eval(process_vars($arg)); } elsif ($type eq conf) { my $file = find_conf(process_vars($arg),1); # missingok $ok = (-f $file); } elsif ($type eq dir) { $ok = (-d $arg); } else { m2c_die "unknown while modifier ($type)\n"; } # act on condition if ($ok) { $return = do_a_loop($stash, \$vars{$type}, $ok, \$vars{$args}); $everlooped = 1; } else { if (!$everlooped) { $return = skippart(); } $loop = 0; } } } elsif (/\@\s*prompt\s+\$(\S+)\s*(.*)\@/) { # PROMPT my ($var, $prompt) = ($1, $2); if (!$term) { my $haveit = eval { require Term::ReadLine }; if ($haveit) { $term = new Term::ReadLine 'mib2c'; } } if ($term) { $vars{$var} = $term->readline(process_vars($prompt)); } } elsif (/\@\s*print\s+([^@]*)\@/) { # PRINT my $line = process_vars($1); print "$line\n"; } else { my $line = process_vars($_); mib2c_output($line); chop $_; warn "$currentfile:$currentline contained a line that started with a @ but did not match any mib2c configuration tokens.\n"; warn "(maybe missing the trailing @?)\n"; warn "$currentfile:$currentline [$_]\n"; m2c_die if ($strict_unk_token == 1); } # $return = "eof"; } print "< Balanced $balanced / level $currentlevel / rtn $return / $_\n" if($debug); if((!$_) && ($return ne "eof")) { # warn "switching return of '$return' to EOF\n" if($debug); $return = "eof"; } if ($balanced) { if(($balanced != $currentlevel) || ($return ne "eof")) { m2c_die "\@balanced@ specified, but processing terminated with '$return' before EOF!"; } } $currentlevel--; return $return; } sub mib2c_output { my $line = shift; foreach $file (values(%outputs)) { print $file "$line"; } } sub setup_data { my $mib = shift; if ($mib->{label} =~ /Table$/ && $#{$mib->{children}} != -1) { my $tablename = $mib->{label}; my $entry = $mib->{children}; my $columns = $entry->[0]{children}; my $augments = $entry->[0]{'augments'}; foreach my $col (sort { $a->{'subID'} <=> $b->{'subID'} } @$columns) { # store by numeric key so we can sort them later push @{$tables{$tablename}{'column'}}, $col->{'label'}; } if ($augments) { my $mib = $SNMP::MIB{$augments} || die "can't find info about augmented table $augments in table $tablename\n"; $mib = $mib->{parent} || die "can't find info about augmented table $augments in table $tablename\n"; my $entry = $mib->{children}; foreach my $index (@{$entry->[0]{'indexes'}}) { my $node = $SNMP::MIB{$index} || die "can't find info about index $index in table $tablename\n"; push @{$tables{$tablename}{'index'}}, $index; push @{$tables{$tablename}{'externalindex'}}, $index; } my $columns = $entry->[0]{children}; } else { foreach my $index (@{$entry->[0]{'indexes'}}) { my $node = $SNMP::MIB{$index} || die "can't find info about index $index in table $tablename\n"; push @{$tables{$tablename}{'index'}}, $index; if("@{$tables{$tablename}{'column'}}" =~ /$index\b/ ) { # print "idx INT $index\n"; push @{$tables{$tablename}{'internalindex'}}, $index; } else { # print "idx EXT $index\n"; push @{$tables{$tablename}{'externalindex'}}, $index; } } } foreach my $col (sort { $a->{'subID'} <=> $b->{'subID'} } @$columns) { next if ( "@{$tables{$tablename}{'index'}}" =~ /$col->{'label'}\b/ ); push @{$tables{$tablename}{'nonindex'}}, $col->{'label'}; } # print "indexes: @{$tables{$tablename}{'index'}}\n"; # print "internal indexes: @{$tables{$tablename}{'internalindex'}}\n"; # print "external indexes: @{$tables{$tablename}{'externalindex'}}\n"; # print "non-indexes: @{$tables{$tablename}{'nonindex'}}\n"; } else { my $children = $mib->{children}; if ($#children == -1 && $mib->{type}) { # scalar if ($mib->{type} eq "NOTIF" || $mib->{type} eq "TRAP") { my $notifyname = $mib->{label}; my @varlist = (); $notifications{$notifyname} = 1; $notifyvars{$notifyname} = $mib->{varbinds}; } else { $scalars{$mib->{label}} = 1 if ($mib->{'access'} ne 'Notify'); } } else { my $i; for($i = 0; $i <= $#$children; $i++) { setup_data($children->[$i]); } } } } sub min { return $_[0] if ($_[0] < $_[1]); return $_[1]; } sub max { return $_[0] if ($_[0] > $_[1]); return $_[1]; } sub find_conf { my ($configfile, $missingok) = (@_); foreach my $d (@search_dirs, @def_search_dirs) { # print STDERR "using $d/$configfile" if (-f "$d/$configfile"); return "$d/$configfile" if (-f "$d/$configfile"); } return $configfile if (-f "$configfile"); return if ($missingok); print STDERR "Can't find a configuration file called $configfile\n"; print STDERR "(referenced at $currentfile:$currentline)\n" if ($currentfile); print STDERR "I looked in:\n"; print " " . join("\n ", @search_dirs, @def_search_dirs), "\n"; exit 1; } sub open_conf { my $configfile = shift; # process .conf file if (! -f "$configfile") { print STDERR "Can't find a configuration file called $configfile\n"; exit 1; } $currentfile = $configfile; my $fh = new IO::File; $fh->open("$configfile"); return $fh; } sub count_scalars { my @k = keys(%scalars); return $#k + 1; } sub count_tables { my @k = keys(%tables); return $#k + 1; } sub count_columns { my $table = shift; return $#{$tables{$table}{'column'}} + 1; } sub table_is_writable { my $table = shift; my $column; my $result = 0; foreach $column (@{$tables{$table}{'column'}}) { if($SNMP::MIB{$column}{access} =~ /(ReadWrite|Create|WriteOnly)/) { $result = 1; last; } } return $result; } sub table_has_create { my $table = shift; my $column; my $result = 0; foreach $column (@{$tables{$table}{'column'}}) { if($SNMP::MIB{$column}{access} =~ /(Create)/) { $result = 1; last; } } return $result; } sub table_has_rowstatus { my $table = shift; my $column; my $result = 0; foreach $column (@{$tables{$table}{'column'}}) { if($SNMP::MIB{$column}{syntax} =~ /(RowStatus)/) { $result = 1; last; } } return $result; } sub table_has_lastchange { my $table = shift; my $column; my $result = 0; foreach $column (@{$tables{$table}{'column'}}) { if(($SNMP::MIB{$column}{syntax} =~ /(TimeStamp)/) && ($SNMP::MIB{$column}{label} =~ /(LastChange)/)) { $result = 1; last; } } return $result; } sub table_has_storagetype { my $table = shift; my $column; my $result = 0; foreach $column (@{$tables{$table}{'column'}}) { if($SNMP::MIB{$column}{syntax} =~ /(StorageType)/) { $result = 1; last; } } return $result; } sub count_indexes { my $table = shift; return $#{$tables{$table}{'index'}} + 1; } sub count_external_indexes { my $table = shift; return $#{$tables{$table}{'externalindex'}} + 1; } sub count_notifications { my @k = keys(%notifications); return $#k + 1; } sub count_varbinds { my $notify = shift; return $#{$notifyvars{$notify}} + 1; }