#! /usr/local/bin/perl
# 
# RTG Target File Generator 
#
########################################################################
# $Id: targetmaker,v 1.5 2004-09-30 14:09:12-05 btoneill Exp btoneill $
########################################################################
# $Log: targetmaker,v $
# Revision 1.5  2004-09-30 14:09:12-05  btoneill
# Numerous bug fixes
#
# Revision 1.4  2004-09-29 12:14:17-05  btoneill
# Now pings host before trying to query, save from having fatal errors
# Added in a ability to try multiple snmp versions
# now automatically updates changes to the interface table
# can set interfaces to inactive if desired
# numerous bug fixes
#
# Revision 1.3  2004-09-28 13:22:40-05  btoneill
# Added ability to just gather default stats
#
# Revision 1.2  2004-09-28 12:33:35-05  btoneill
# Added support for v0.8 targets file
# Fixed issue with Catalyst switches
# Added command line options
# Added support for SNMP versions
# Added in support for other MySQL database formats
#
# Revision 1.1  2004-09-27 10:03:24-05  btoneill
# Initial revision
#
# Revision 1.3  2004/07/08 19:32:22  btoneill
# Moved standard interface information to a module
# Added order file parsing for modules
# various other cleanups
#
# Revision 1.2  2004/07/08 16:42:52  btoneill
# Added changes to make Extreme switches work better and to
# remove interfaces that had no data for them
#
# Revision 1.1  2004/06/24 20:08:13  btoneill
# Initial revision
#
#
########################################################################

use vars qw($community $defbits $output $DEBUG $DBOFF $INFO @ISA @EXPORT);

#########################################################################
# Local customization

$CONFIG_FILE = "/opt/rtg/etc/targetmaker.cfg";
@configs = ($RTG_CONF_FILE, "rtg.conf", "/usr/local/rtg/etc/rtg.conf", "/etc/rtg.conf","/opt/rtg/etc/rtg.conf");

die "Cannot find file $CONFIG_FILE, exiting...\n" unless -f $CONFIG_FILE;

require $CONFIG_FILE;

##
## Settings now moved to the $CONFIG_FILE
##


# No edits needed beyond this point
#########################################################################

# SNMP vars
$snmp_port   = $SNMP_PORT;
$snmp_ver    = $SNMP_VER;
$snmp_timeout= $SNMP_Session::default_timeout;
$snmp_retries= $SNMP_Session::default_retries;
$snmp_backoff= $SNMP_Session::default_backoff;

# keep only until fixed in parsing of targets file
$OOR = 93750000000;


@standard_modules = ("StandardIf.pl");


# This Perl script requires the included SNMP modules
use lib ".:/opt/rtg/etc";
use BER;
use SNMP_Session;
use SNMP_util;
use Getopt::Long;
use Net::Ping;

# This Perl script requires the not-included DBI module
use DBI;

use vars qw(%snmp_modules %table_map %table_name %table_class @statclasses %statbit %statvalue $currentclass $system);


# This Perl script requires the not-included DBI module
use DBI;


+# Parse options:
Getopt::Long::Configure("permute", "pass_through");
if (!GetOptions("help+" => \$help,
		"debug" => \$DEBUG,
		"routers=s" => \$router_file,
		"output=s" => \$output,
		"bits=s" => \$defbits,
		"config=s@" => \@configs,
		)) {
	usage();
	die "Bad arguments";
}

if ( $help==1 ) { usage(); exit(0); }

sub usage {
	print STDERR "$0 [--routers <routersfile>] [--config <rtg.conf>] [--bits <defaultbits>] [--output <targets.cfg>] --debug\n";
}



#
# Load all the modules we find
#
opendir(DIR,$MODULEDIR);
foreach $found_file (grep { /.*\.pl$/} readdir(DIR)) {
	# if it's extended mode, we add all files
	if($EXTENDEDMODE) {
		push(@modfiles,$found_file);
	}
	else {
		# if it's standard, we only add requested files
		if(grep { /$found_file$/ } @standard_modules) {
			push(@modfiles,$found_file);
		}
	}
}
closedir(DIR);

# Load all the added modules
foreach $mod_file (@modfiles) {
	debug("Now loading module $mod_file...");
	require "$MODULEDIR/$mod_file";
};



# List of "reserved" interfaces, i.e. those we don't care to monitor
# This list is inclusive of only Cisco/Juniper/Extreme
@reserved = (
    "tap",  "pimd", "pime", "ipip", "lo",
    "lo0",  "gre",  "pd-",  "pe-",  "gr-", "ip-",
    "vt-",  "mt-",  "mtun", "Null", "Loopback", "aal5",
    "-atm", "sc0", "T1", "Voice", 
    # these are for Extreme. The VLAN 000 is because no stats show up in
    # their VLAN interfaces, and they are all 000x for numbering
    "802.1Q", "rif", "VLAN 000"
);

foreach $conf (@configs) {
  if (open CONF, "<$conf") {
    print "Reading [$conf].\n" if $DEBUG;
    while ($line = <CONF>) {
      @cVals = split /\s+/, $line;
      if ($cVals[0] =~ /DB_Host/) {
        $db_host=$cVals[1];
      } elsif ($cVals[0] =~ /DB_User/) {
        $db_user=$cVals[1];
      } elsif ($cVals[0] =~ /DB_Pass/) {
        $db_pass=$cVals[1];
      } elsif ($cVals[0] =~ /DB_Database/) {
        $db_db=$cVals[1];
      } elsif ($cVals[0] =~ /Interval/) {
        $interval=$cVals[1];
      } elsif ($cVals[0] =~ /SNMP_Port/) {
	$snmp_port=$cVals[1];
      } elsif ($cVals[0] =~ /SNMP_Ver/) {
	$snmp_ver=$cVals[1];
      }
    }
    last;
  }
}


sub find_interface_id($$$$);
sub debug($);
sub print_target($$$$$$$$);
sub process_classes(@);
sub has_class($);
sub add_class($);
sub hasoid($$$);
sub getrouterbits($);
sub rtg_snmpget($$);
sub set_inactive($);

#
# Makes things easier with debugging from
# modules, even tho it's not as fast as doing
# the if $DEBUG before calling debug()
#
sub debug($) {
	$debug_line = shift;

	return 1 if($debug_line =~ /^Class:/ & $DEBUGCLASS == 0);

	print "$debug_line\n" if $DEBUG;
}

#
# get counter bits from config file to module that
# needs it
# 
sub getrouterbits($) {
	my $routername = shift;
	return $counterBits{$routername};

}
#
# If people use this instead of doing it themselves in their
# code, it makes it easier to change later on
#
sub print_target($$$$$$$$) {
	my ($router,$oid,$bits,$community,$table,$iid,$speed,$descr) = @_;

	($a,$a,$a,$a,@addrs) = gethostbyname($router);
	if($TARGETTYPE >= 0.8) {
		print CFG "\ttarget $oid {\n";
		print CFG "\t\tbits $bits;\n";
		print CFG "\t\ttable $table;\n";
		print CFG "\t\tid $iid;\n";
		if($speed =~ /^\d+$/) {
			print CFG "\t\tspeed $speed;\n";
		}	
		else {
			print CFG "\t\tspeed $OOR;\n";
		}
		print CFG "\t\tdescr \"$descr\";\n";
		print CFG "\t};\n";

	} else
	{
		($a,$a,$a,$a,@addrs) = gethostbyname($router);
		printf CFG "%d.%d.%d.%d\t", unpack('C4',$addrs[0]);
		print CFG "$oid\t";
		print CFG "$bits\t";
		print CFG "$community\t";
		print CFG "$table\t";
		print CFG "$iid\t";
		if($speed ne "") {
			print CFG "$speed\t";
		}
		print CFG "$descr\n";
	}

}

# DBI SQL Insert Subroutine
sub sql_insert {
    ($sql) = @_;

    if($sql =~ /^CREATE/i) { $sql = "$sql TYPE=$STORAGE_TYPE"; }

    debug("SQL-: $sql");
    my $sth = $dbh->prepare($sql)
      or die "Can't prepare $sql: $dbh->errstr\n";
    my $rv = $sth->execute
      or die "can't execute the query: $sth->errstr\n";
}

# Find an RTG router id (rid) in the MySQL database.  If it doesn't
# exist, create a new entry and corresponding tables.
sub find_router_id {
    ($router) = @_;
    $sql = "SELECT DISTINCT rid FROM router WHERE name=\"$router\"";
    debug("SQL: $sql");
    my $sth = $dbh->prepare($sql)
      or die "Can't prepare $sql: $dbh->errstr\n";
    my $rv = $sth->execute
      or die "can't execute the query: $sth->errstr\n";
    if ( $sth->rows == 0 ) {
        print "No router id found for $router...";
        $sql = "INSERT INTO router (name) VALUES(\"$router\")";
        print "adding.\n";
        &sql_insert($sql);
        $rid = &find_router_id($router);
    }
    else {
        @row = $sth->fetchrow_array();
        $rid = $row[0];
    }
    $sth->finish;
    return $rid;
}

#
# set all interfaces for a device inactive
#
sub set_inactive($) {
	my ($rid) = @_;

	$sql = "UPDATE interface set status='inactive' where rid=\"$rid\"";
	debug("SQL: $sql");
	my $sth = $dbh->prepare($sql)
		or die "Can't prepare $sql: $dbh->errstr\n";
	my $rv = $sth->execute
		or die "can't execute the query: $sth->errstr\n";

	return 1;
}

# Find an RTG interface id (iid) in the MySQL database.  If it doesn't
# exist, create a new entry.
sub find_interface_id($$$$) {
	( $rid, $int, $desc, $speed ) = @_;
	$desc =~ s/ +$//g;    #remove trailing whitespace
	$sql = "SELECT id, description,speed FROM interface WHERE rid=$rid AND name=\"$int\"";
	debug("SQL: $sql"); 
	my $sth = $dbh->prepare($sql)
		or die "Can't prepare $sql: $dbh->errstr\n";
	my $rv = $sth->execute
		or die "can't execute the query: $sth->errstr\n";
	if ( $sth->rows == 0 ) {
		print "No id found for $int on device $rid...";
		$desc =~ s/\"/\\\"/g;    # Fix " in desc
		$sql = "INSERT INTO interface (name, rid, speed, description) VALUES(\"$int\", $rid, $speed, \"$desc\")";
		print "adding.\n";
		&sql_insert($sql);
		$iid = &find_interface_id( $rid, $int, $desc, $speed );
	}
	else {
		@row = $sth->fetchrow_array();
		$iid = $row[0];
		if ( $row[1] ne $desc ) {
			if($UPDATE_DESC) {
				$sql = "UPDATE interface SET description='$desc' WHERE id=$iid";
				&sql_insert($sql);
			} else {
				print "Interface description changed.\n";
				print "Was: \"$row[1]\"\n";
				print "Now: \"$desc\"\n";
				print "Suggest: UPDATE interface SET description='$desc' WHERE id=$iid\n";
			}
		}

		if($row[2] ne $speed) {
			if($UPDATE_SPEED) {
				$sql = "UPDATE interface SET speed='$speed' WHERE id=$iid";
				&sql_insert($sql);
			} else {
				print "Interface speed changed.\n";
				print "Was: \"$row[2]\"\n";
				print "Now: \"$speed\"\n";
				print "Suggest: UPDATE interface SET speed='$speed' WHERE id=$iid\n";
			}
		}
	
		if($SET_INACTIVE) {
			$sql = "UPDATE interface set status='active' WHERE id=$iid";
			&sql_insert($sql);	
		}
	}
	$sth->finish;
	return $iid;
}

sub process_classes(@) {
	@classes = @_;

	# remove any duplicates
	map { $classlist{$_} = 1; } @classes;

	$bit=0; $value=1;
	foreach(sort keys %classlist) {
		$statbit{$_} = $bit;
		$statvalue{$_} = $value;
		debug("Added stat $_ with bit $bit and value $value");
		$value *=2;
		$bit++;
	}

#	$currentclass = $statvalue{'disk'} + $statvalue{'cpu'} + $statvalue{'network'};
#	has_class("network");
}

sub has_class($) {
	my $classname = shift;

	my $foundclass = 0;

	#
	# we create a vector out of the current class value
	# and then turn it into a binary array, reversing it so
	# that bit order is the same order as in the original 
	# array. We then check to see if the bit location of the
	# requested class is set to 1, if so, we have already
	# added information for the requested class
	#
	vec($classvector,0,32) = $currentclass;
	my @bitlist = reverse split(//,unpack("B*",$classvector));
	if($bitlist[$statbit{$classname}] == 1) {
		debug("Class: $classname in $currentclass");
		$foundclass = 1;
	}
	else {	
		debug("Class: $classname not in $currentclass");
	}

	return $foundclass;
}

sub add_class($) {
	my $classname = shift;

	unless(has_class($classname)) {
		debug("Class: adding $classname");
		$currentclass += $statvalue{$classname};
	}
}

sub hasoid($$$) {
	my $comm = shift;
	my $router = shift;
	my $mib = shift;

	# we don't want messages about not finding the oid, it might
	# confuse/concern people as alot of these will fail
	#
	$SNMP_Session::suppress_warnings=2;

	my @result = rtg_snmpget ("$comm\@$router", $mib);

	# turn warnings back on
	$SNMP_Session::suppress_warnings=0;

	if($result[0] eq "") {
		debug("SNMP: $sstat not on $router...");
		return 0;
	}
	else { return 1; }

}

sub rtg_snmpget($$) {
	my $routerpluscomm = shift;
	my $mib = shift;

	return snmpget("$routerpluscomm:$snmp_port:$snmp_timeout:$snmp_retries:$snmp_backoff:$snmp_ver",$mib);

}

sub getmoduleorder($%) {
	my $systemtype = shift;
	my %module_list = @_;;

	my %current_list;
	my @final_order;

	my $count = 0;
	foreach $module (sort keys %module_list) {
		$current_list{$module} = $count;
		$count += 10;
	}

	foreach $key (keys %order_mod) { 
		next unless(exists $module_list{$order_mod{$key}});
		if($systemtype =~ /$order_regex{$key}/) {
			debug("Changing order of $order_mod{$key} by $order_change{$key}...");
			$current_list{$order_mod{$key}} += $order_change{$key};
		}
	}

	foreach $module (sort { $current_list{$a} <=> $current_list{$b} } keys %current_list) {
			push(@final_order,$module);
	}

	return @final_order;

}


sub main {
    #
    # initial the classes vector information
    #
    process_classes(@statclasses);


    open ROUTERS, "<$router_file" or die "Could not open file: $router_file";
    while (<ROUTERS>) {
        chomp;
        s/ +$//g;    #remove space at the end of the line
        next if /^ *\#/;    #ignore comment lines
        next if /^ *$/;     #ignore empty lines
        if ( $_ =~ /(.+):(.+):(.+)/ ) {
            $r = $1;
            $c = $2;
            $b = $3;
            $communities{$r} = $c;
            $counterBits{$r} = $b;
            push @routers, $r;
        } elsif ( $_ =~ /(.+):(.+)/ ) {
            $r = $1;
            $c = $2;
            $communities{$r} = $c;
            push @routers, $r;
        } else {
            $communities{$_} = $community;
            push @routers, $_;
        }
    }
    close ROUTERS;

    open(MODULES, "$MODULEORDERFILE") || die "Can't open file $MODULEORDERFILE: $!\n"; 
    while(<MODULES>) {
	chomp;
	s/ +$//g;    #remove space at the end of the line
	next if /^ *\#/;    #ignore comment lines
	next if /^ *$/;     #ignore empty lines

	my($mod,$regex,$poschg) = /(.+):(.+):([+-]\d+)/;

	if($poschg eq "") {
		debug("ERROR: Ignoring order line $_...");

	} else {
		$order_mod{"$mod--$regex"} = $mod;
		$order_regex{"$mod--$regex"} = $regex;
		$order_change{"$mod--$regex"} = $poschg;
	}
    }

    close(MODULES);

    if ( $routers[0] eq "rtr-1.my.net" ) {
        print "\n** Error, $0 is not yet configured\n\n";
        print "Please edit the \"$router_file\" file and add network devices\n";
        exit(-1);
    }

    # SQL Database Handle
    if ( !$DBOFF ) {
       $dbh = DBI->connect("DBI:mysql:$db_db:host=$db_host",$db_user,$db_pass);
       if (!$dbh) {
          print "Could not connect to database ($db_db) on $db_host.\n";
          print "Check configuration.\n";
          exit(-1);
       }
    }

    open CFG, ">$output" or die "Could not open file: $!";
    ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
      localtime( time() );
    printf CFG "# Generated %02d/%02d/%02d %02d:%02d by $0\n", $mon + 1, $mday,
      $year + 1900, $hour, $min;


    $def_snmp_ver = $snmp_ver;

    foreach $router (@routers) {

	my $p = Net::Ping->new();

	unless($p->ping($router)){
		print "ERROR! $router is not pingable, skipping...\n";
		next;
	}

	$p->close();

        $bits = getrouterbits{$router};
        # Sanity check bits
        $bits = $defbits if ( ( $bits != 32 ) && ( $bits != 64 ) );

	# This is really ugly, but not sure about a better way to
	# handle this. This entire fallback section could probably
	# use some work, or maybe not. It does work tho...
	my %snmp_trial_hash = ();
	
	# whatever we have $snmp_ver set to, mark is as active in our
	# trial hash
	$snmp_trial_hash{$def_snmp_ver} = 1;

	# if we want to enable fall back, we add in version 1
	if($SNMP_FALL_BACK) { $snmp_trial_hash{'1'} = 1; }

	

	# lets go thru all versions of SNMP to try in decending order
	foreach $our_snmp_ver (reverse sort keys %snmp_trial_hash) {
		$snmp_ver = $our_snmp_ver;
		
	        print "Poking $router ($communities{$router}) ($bits bit) using SNMPv$our_snmp_ver...\n" if $INFO;

		$SNMP_Session::suppress_warnings=2;
		@result = rtg_snmpget( "$communities{$router}\@$router", 'sysDescr' );
		$SNMP_Session::suppress_warnings=0;

		$system = join ( ' ', @result );
		if ( $system =~ /.*Cisco.*WS-.*/ ) {
			$system = "Catalyst";
		}
		last if($result[0] ne "");
	}

	if($system eq "") {
		print "$router is not responding to snmp, skipping...\n" if $INFO;
		next;
	}
	debug("System: $system");
	
	
	unless($DBOFF) {
		$rid = find_router_id($router);
		if($SET_INACTIVE) {
			print "Setting all interfaces for $router inactive...\n" if $INFO;
			set_inactive($rid);

		}
	}

	$session = SNMP_Session->open( $router, $communities{$router}, 161 )
          || die "Error opening SNMP session to $router";
	
	if($TARGETTYPE >= 0.8) {
		($a,$a,$a,$a,@addrs) = gethostbyname($router);
		print CFG "# $router\n";
		printf CFG "host %d.%d.%d.%d {\n", unpack('C4',$addrs[0]);
		print CFG "\tcommunity $communities{$router};\n";
		print CFG "\tsnmpver $snmp_ver;\n";
	} else 
	{
	    print CFG "# Host\tOID\tBits\tCommunity\tTable\tID\tDescription\n";
	}

	debug("Checking for modules information...");

	@module_ordering = getmoduleorder($system,%snmp_modules);
	
	$currentclass = 0;

	@found_mods = ();
	#foreach $mod_name (sort keys %snmp_modules) {
	print "Looking for stats on $router...\n" if $INFO;
	foreach $mod_name (@module_ordering) {
		# we will have failures, suppress warnings to make output cleaner
		debug("Checking for $mod_name support");

		# we don't want messages about not finding the oid, it might
		# confuse/concern people as alot of these will fail
		#
		$SNMP_Session::suppress_warnings=2;

	 	@result = rtg_snmpget ("$communities{$router}\@$router", $snmp_modules{$mod_name});

		# turn warnings back on
		$SNMP_Session::suppress_warnings=0;

		if($result[0] ne "") {
			debug("Class: $currentclass");
			$module_func = "process_module_$mod_name";
			&$module_func($router,$communities{$router},$session);
			push(@found_mods,$mod_name);
		}
		debug("Class: $currentclass");

	}
	print "Found support for modules @found_mods.\n" if $INFO;
	
	if($TARGETTYPE >= 0.8) {
		print CFG "};\n";
	}
    }

    #
    # Are we creating the graphing table?
    #
    if($CREATE_GRAPHING_TABLES) {

    	print "Updating graphing table data...\n" if $INFO;

	$sql = "CREATE TABLE IF NOT EXISTS mapping_table \
		(graphname CHAR(64) NOT NULL, tablename CHAR(64) NOT NULL, \
		INDEX graph_idx(graphname), INDEX table_idx (tablename))";
	&sql_insert($sql);

	$sql = "CREATE TABLE IF NOT EXISTS options_table \
		(graphname CHAR(64) UNIQUE NOT NULL, options CHAR(128) NOT NULL, \
		class CHAR(32) NOT NULL, INDEX opt_idx (graphname), INDEX class_idx (class))";
	&sql_insert($sql);

	foreach $graph (keys %table_map) {
		$sql = "DELETE FROM mapping_table WHERE graphname=\"$graph\"";
		&sql_insert($sql);

		$sql = "SELECT * FROM options_table where graphname=\"$graph\"";
		debug("SQL: $sql");
		my $sth = $dbh->prepare($sql)
			or die "Can't prepare $sql: $dbh->errstr\n";
		my $rv = $sth->execute
			or die "can't execute the query: $sth->errstr\n";
		if ( $sth->rows == 0 ) {
			$sql = "INSERT INTO options_table VALUES (\"$graph\",\"@{$table_options{$graph}}\",\"$table_class{$graph}\")";
			&sql_insert($sql);
		} 
		else {
			@row = $sth->fetchrow_array;
			if($row[1] ne join(@{$table_options{$graph}}) || $row[2] ne $table_class{$graph}) {
				$sql = "UPDATE options_table SET options=\"".join(" ",@{$table_options{$graph}})."\",class=\"$table_class{$graph}\" WHERE graphname=\"$graph\"";
				&sql_insert($sql);
			}

		}

		foreach $table (@{$table_map{$graph}}) {
			$sql = "SELECT * FROM mapping_table WHERE graphname=\"$graph\" AND tablename=\"$table\"";
			debug("SQL: $sql");
			my $sth = $dbh->prepare($sql)
				or die "Can't prepare $sql: $dbh->errstr\n";
			my $rv = $sth->execute
				or die "can't execute the query: $sth->errstr\n";
			if ( $sth->rows == 0 ) {
				print "No row found for $graph and $table, adding...\n" if $INFO;
				$sql = "INSERT INTO mapping_table VALUES (\"$graph\",\"$table\")";
				&sql_insert($sql);
			}
			else {
				print "ERROR! Found duplicate $graph and $table\n";
			}
		}
	}


    }

    close CFG;
    if ( !$DBOFF ) {
        $dbh->disconnect;
    }
    print "Done.\n";
}

main;
exit(0);
