path: root/local/mib2c

#!/usr/bin/perl
#!/usr/bin/perl -w

#
# $Id: mib2c 17684 2009-07-10 07:46:43Z jsafranek $
#
# 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 getting the latest source release of the net-snmp toolkit from
http://www.net-snmp.org/download/ .  Once you download the source and
unpack it, the perl module is contained in the perl/SNMP directory.
See the README file there for instructions.

";
    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;
$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, "/usr/local/share/snmp/";
push @def_search_dirs, "/usr/local/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 "  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 (/^-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", "U64",
	       "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 (!$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.rowstatus     -- 1 if an object is a RowStatus object, 0 if not
#     'settable', 'creatable' and 'rowstatus' can also be used with table variables
#     to indicate whether it contains writable, creatable 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 ($SNMP::MIB{$vars{$1}} && $SNMP::MIB{$vars{$1}}{'label'} =~ /Table$/) {
      $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;
    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);
	      }
	    }
            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);
	    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;

          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});
            } else {
	      $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$/) {
	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;
}