#!/usr/drwho/local/bin/perl
# -*- mode: Perl -*-
BEGIN{
#$main::OS = 'UNIX';
#$main::OS = 'NT';
$main::OS = 'VMS';

##################################################################
# Multi Router Traffic Grapher
##################################################################
# Created by Tobias Oetiker <oetiker@ee.ethz.ch>
#            and Dave Rand <dlr@bungi.com>
#
# Code Strictification by Richard Bullington <rbulling@obscure.org>
#
#################################################################
#
# Distributed under the GNU copyleft
#
# $Id: mrtg,v 2.11 1998/10/13 08:29:47 oetiker Exp oetiker $
#
###################################################################
   # The path separator is a slash, backslash or semicolon, depending
   # on the platform.
   $main::SL = {
     UNIX=>'/',
     WINDOWS=>'\\',
     NT=>'\\',
     VMS=>''
     }->{$main::OS};

   # The search path separator is a colon or semicolon depending on the
   # operating system.
   $main::PS = {
     UNIX=>':',
     WINDOWS=>';',
     NT=>';',
     VMS=>':'
     }->{$main::OS};

  # We need to find the place where mrtg is installed, and
  # then take the .pm and rateup programms from there.
  $main::binpath ="mrtg_dir:";

}

###
# Finally, SNMPGet fully written in PERL5. 
# Thanks to Simon Leinen <simon@switch.ch>
# More on: http://www.switch.ch/misc/leinen/snmp/perl/
####

# There older perls tend to behave peculiar with
# large integers ... 
require 5.003;

{
    use SNMP_Session "0.59";
    use BER "0.57";
    use Config;
    $main::SNMPDEBUG =0;
}

use strict;

{
    my($i) = 0;
    my($name);

    foreach $name (split(/ /, $Config{sig_name}))
    {
	$main::signo{$name} = $i;
	$main::signame[$i++] = $name;
    }
}

$main::DEBUG=0;

%snmpget::OIDS = 
  ('sysDescr' => '1.3.6.1.2.1.1.1.0',
   'sysContact' => '1.3.6.1.2.1.1.4.0',
   'sysName' => '1.3.6.1.2.1.1.5.0',
   'sysLocation' => '1.3.6.1.2.1.1.6.0',
   'sysUptime' => '1.3.6.1.2.1.1.3.0',
   'ifNumber' =>  '1.3.6.1.2.1.2.1.0',
   ###################################
   # add the ifNumber ....
   'ifDescr' => '1.3.6.1.2.1.2.2.1.2',
   'ifType' => '1.3.6.1.2.1.2.2.1.3',
   'ifIndex' => '1.3.6.1.2.1.2.2.1.1',
   'ifInErrors' => '1.3.6.1.2.1.2.2.1.14',
   'ifOutErrors' => '1.3.6.1.2.1.2.2.1.20',
   'ifInOctets' => '1.3.6.1.2.1.2.2.1.10',
   'ifOutOctets' => '1.3.6.1.2.1.2.2.1.16',
   'ifInDiscards' => '1.3.6.1.2.1.2.2.1.13',
   'ifOutDiscards' => '1.3.6.1.2.1.2.2.1.19',
   'ifInUcastPkts' => '1.3.6.1.2.1.2.2.1.11',
   'ifOutUcastPkts' => '1.3.6.1.2.1.2.2.1.17',
   'ifInNUcastPkts' => '1.3.6.1.2.1.2.2.1.12',
   'ifOutNUcastPkts' => '1.3.6.1.2.1.2.2.1.18',
   'ifInUnknownProtos' => '1.3.6.1.2.1.2.2.1.15',
   'ifOutQLen' => '1.3.6.1.2.1.2.2.1.21',
   'ifSpeed' => '1.3.6.1.2.1.2.2.1.5', 
   # up 1, down 2, testing 3
   'ifOperStatus' => '1.3.6.1.2.1.2.2.1.8',             
   'ifAdminStatus' => '1.3.6.1.2.1.2.2.1.7',  
   # up = 1 else 0;
   'ifOperHack' => '1.3.6.1.2.1.2.2.1.8',             
   'ifAdminHack' => '1.3.6.1.2.1.2.2.1.7',  
    #frame relay stuff ... see the docs for explanations
    'frInOctets' => '1.3.6.1.2.1.10.32.2.1.9',
    'frOutOctets' => '1.3.6.1.2.1.10.32.2.1.7',
  );

sub END {
	local($?, $!);
	unlink ${main::Cleanfile} if($main::Cleanfile);
}

sub main {
  
  my ($router, $target);
  
  # unbuffer stdout to see everything immediately
  $|=1 if $main::DEBUG;   
  
  # read in the config file
  my ($routers, $cfg, $rcfg, $cfgfile) = readcfg();
  $target = cfgcheck($routers, $cfg, $rcfg);
  

  # removed this ... it just breaks too much ...   
  #chdir ($cfg{'workdir'});
  
  # Use SNMP to populate the target object
  readtargets($target, $cfg, $rcfg,$cfgfile);
  
  foreach $router (@$routers) {
    my($savetz) = $ENV{'TZ'};

    if ($$rcfg{'timezone'}{$router} ne '') {
      $ENV{'TZ'} = $$rcfg{'timezone'}{$router}
    }  

    my ($inlast, $outlast, $uptime, $name, $time) = 
      getcurrent($target, $router, $rcfg);
    
    print "inlast $inlast outlast $outlast uptime $uptime".
      " name $name time $time\n"  if $main::DEBUG;
    #abort, if the router is not responding.
    next if ($inlast == -1);
    
    my ($maxin, $maxout, $avin, $avout, $cuin, $cuout) =  
      writegraphics($router, $cfg, $rcfg, $inlast, $outlast, $time);
    
    print "maxin $maxin maxout $maxout avin $avin ",
    "avout $avout cuin $cuin cuout $cuout\n" 
      if $main::DEBUG >2;
    
    writehtml($router, $cfg, $rcfg, 
	      $maxin, $maxout, $avin, $avout, 
	      $cuin, $cuout, $uptime, $name);
    
    #put TZ things back in shape ... 
    if ($savetz) {$ENV{'TZ'} =  $savetz;} else
    {delete $ENV{'TZ'}};
    
  }
}

main;
exit(0);

sub quickcheck {
  my ($first,$second,$arg,$line) = @_;
  my %rules =
    (# General CFG
     'workdir' => 
     ['$arg && (-d $arg)','"Directory $arg does not exist"'],
     
     'refresh' => 
     ['int($arg) >= 300', '"$arg should be 300 seconds or more"'],
     
     'interval' => 
     ['int($arg) >= 5','"$arg should be more than 5 Minutes"'], 
     
     'writeexpires' =>  
     ['1','"Internal Error"'],
     
     'icondir' =>
     ['$arg','"Directory argument missing"'],

     # Per Router CFG
     'target[]' => 
     ['1','"Internal Error"'],  #will test this later
     
     'routeruptime[]' => 
     ['1','"Internal Error"'],  #will test this later
     
     'maxbytes[]' => 
     ['(($arg =~ /^[0-9]+$/) && ($arg < (2**31)-1))',
	'"$arg must be a Number smaller than maxint"'],

     'absmax[]' => 
     ['($arg =~ /^[0-9]+$/)','"$arg must be a Number"'],
     
     'title[]' => 
     ['1','"Internal Error"'], #what ever the user chooses.
     
     'directory[]' => 
     ['1','"Internal Error"'], #what ever the user chooses.
     
     'pagetop[]' => 
     ['1','"Internal Error"'], #what ever the user chooses.

     'pagefoot[]' => 
     ['1','"Internal Error"'], #what ever the user chooses.

     'addhead[]' => 
     ['1','"Internal Error"'], #what ever the user chooses.
     
     'unscaled[]' => 
     ['$arg =~ /[dwmy]+/i','"Must be a string of [d]ay, [w]eek, [m]onth, [y]ear"'],
     
     'weekformat[]' => 
     ['$arg =~ /[UVW]/','"Must be either W, V, or U"'],
     
     'withpeak[]' =>
     ['$arg =~ /[dwmy]+/i','"Must be a string of [d]ay, [w]eek, [m]onth, [y]ear"'],
     
     'suppress[]' =>
     ['$arg =~ /[dwmy]+/i','"Must be a string of [d]ay, [w]eek, [m]onth, [y]ear"'],
     
     'xsize[]' =>
     ['((int($arg) >= 30) && (int($arg) <= 600))','"$arg must be between 30 and 600 pixels"'],
     
     'ysize[]' =>
     ['(int($arg) >= 30)','"Must be >= 30 pixels"'],

     'step[]'  =>
     ['(int($arg) >= 0)','"$arg must be > 0"'],

     'timezone[]' =>
     ['1','"Internal Error"'],

     'options[]' =>
     ['1','"Internal Error"'],
     
     'colours[]' =>
     ['1','"Internal Error"'],


     'background[]' =>
     ['1','"Internal Error"'],
     
     'ylegend[]' =>
     ['1','"Internal Error"'],

     'shortlegend[]' =>
     ['1','"Internal Error"'],

     'legend1[]' =>
     ['1','"Internal Error"'],

     'legend2[]' =>
     ['1','"Internal Error"'],

     'legend3[]' =>
     ['1','"Internal Error"'],

     'legend4[]' =>
     ['1','"Internal Error"'],

     'legendi[]' =>
     ['1','"Internal Error"'],

     'legendo[]' =>
     ['1','"Internal Error"'],

     'xzoom[]' =>
     ['($arg =~ /^[0-9]+(?:\.[0-9]+)?$/)',
      '"$arg must be a Number xxx.xxx"'],

     'yzoom[]' =>
     ['($arg =~ /^[0-9]+(?:\.[0-9]+)?$/)',
      '"$arg must be a Number xxx.xxx"'],

     'xscale[]' =>
     ['($arg =~ /^[0-9]+(?:\.[0-9]+)?$/)',
      '"$arg must be a Number xxx.xxx"'],

     'yscale[]' =>
     ['($arg =~ /^[0-9]+(?:\.[0-9]+)?$/)',
      '"$arg must be a Number xxx.xxx"']
    );
 
  my $braces = $second ? '[]':'';
  if (exists $rules{$first.$braces}) {
    if (eval($rules{$first.$braces}[0])) {
      return 1;
    } else {
      if ($second) {
	die "\nCFG Error in \"$first\[$second\]\", line $line: ".
	  eval($rules{$first.$braces}[1])."\n\n"; 
      } else {
	die "\nCFG Error in \"$first\", line $line: ".
	  eval($rules{$first.$braces}[1])."\n\n"; 
      } 
    }
  }
  die "\nCFG Error: Unknown Option \"$first\" on line $line or above.\n".
    "           Check readme.html for Help\n\n";
}

sub readcfg {
  my ($first,$second,$key);
  my (%seen);
  my (@routers);
  my (%rcfg,%cfg,%pre,%post,%deflt,%defaulted);
  my ($cfgfile) = pop(@ARGV);
  open (CFG, $cfgfile) || do { print "ERROR: unable to open config file: $cfgfile\n\n"; &printusage };
  while (<CFG>) {
    s/\s+$//g; #remove whitespace at the end of the line
    s/\s/ /g;  #replace whitespace by space
    next if /^\s*\#/; #ignore comment lines
    next if /^\s*$/;  #ignore empty lines
    # oops spelling error
    s/^supress/suppress/gi;
    # append mode
    if ($first && /^\s+(.*\S)\s*$/) {
      if ($second eq '^') {
	$pre{$first} .= " $1";
	next;
      }
      if ($second eq '$') {
	$post{$first} .= " $1";
	next;
      }
      if ($second eq '_') {
	$deflt{$first} .= " $1";
	next;
      }

      if ($second) {
	$rcfg{$first}{$second} .= " $1";
      } else {
	$cfg{$first} .= " $1";
      }
      next;
    }
    
    if ($first && $second && $post{$first} && ($second !~ /^[\$^_]$/)) {
      if ($defaulted{$first}{$second}) {
        $rcfg{$first}{$second} = $post{$first};
        delete $defaulted{$first}{$second};
      } else {
        $rcfg{$first}{$second} .= " $post{$first}"
      }
    }

    if ($first && exists $deflt{$first} && ($second eq '_')) {
      &quickcheck($first,$second,$deflt{$first},$.)
    } elsif ($first && $second && ($second !~ /^[\$^_]$/)) {
      &quickcheck($first,$second,$rcfg{$first}{$second},$.)
    } elsif ($first && ($second !~ /^[\$^_]$/)) {
      &quickcheck($first,0,$cfg{$first},$.)
    }

    if (/^([A-Za-z0-9]+)\[(\S+)\]\s*:\s*(.*\S?)\s*$/) {
      print "readcfg: rcfg $1 $2  = $3\n" if $main::DEBUG > 1; 
      $first = lc($1);
      $second = lc($2);
      if ($second eq '^')
        { if ($3 ne '') {$pre{$first}=$3} else {delete $pre{$first}}; next; }
      if ($second eq '$')
        { if ($3 ne '') {$post{$first}=$3} else {delete $post{$first}}; next; }
      if ($second eq '_')
        { if ($3 ne '') {$deflt{$first}=$3} else {delete $deflt{$first}}; next; }

      push (@routers, $second) unless grep (/^$second$/, @routers); 
      
      # make sure that default tags spring into existance upon first 
      # call of a router

      foreach $key (keys %deflt) {
	if (! exists $rcfg{$key}{$second}) {
	  $rcfg{$key}{$second} = $deflt{$key};
	  $defaulted{$key}{$second} = 1;
	}
      }

      # make sure that prefix-only tags spring into existance upon first 
      # call of a router

      foreach $key (keys %pre) {
	if (! exists $rcfg{$key}{$second}) {
          delete $defaulted{$key}{$second} if $defaulted{$key}{$second};
	  $rcfg{$key}{$second} = "$pre{$key} ";
	}
      }

      if ($seen{$first}{$second}) {
	die ("\nLine $. in CFG file contains a duplicate definition for\n".
	     "$first\[$second]. First definition is on line $seen{$first}{$second}\n")
      } else {
	$seen{$first}{$second} = $.;
      }

      if ($defaulted{$first}{$second}) {
        $rcfg{$first}{$second} = '';
        delete $defaulted{$first}{$second};
      }
      $rcfg{$first}{$second} .= $3;

      next;

    }
    if (/^(\S+):\s*(.*\S)\s*$/) {
      $first = lc($1);	
      $cfg{$first} = $2;
      $second = '';
      next;
    }
    die ( "\nLine $. in CFG file does not make sense\n" );
  }

  # append $ stuff to the very last tag in cfg file if necessary 
  if ($first && $second && $post{$first} && ($second !~ /^[\$^_]$/)) {
    if ($defaulted{$first}{$second}) {
      $rcfg{$first}{$second} = $post{$first};
      delete $defaulted{$first}{$second};
    } else {
      $rcfg{$first}{$second} .= " $post{$first}"
    }
  }
  
  #check the last input line
  if ($first && exists $deflt{$first} && ($second eq '_')) {
    &quickcheck($first,$second,$deflt{$first},$.)
  } elsif ($first && $second) {
    &quickcheck($first,$second,$rcfg{$first}{$second},$.)
  } elsif ($first) {
    &quickcheck($first,0,$cfg{$first},$.)
  }

  close (CFG);
  (\@routers, \%cfg, \%rcfg, $cfgfile);
}

sub cfgcheck {
  my ($routers, $cfg, $rcfg) = @_;
  my ($rou, $confname, $one_option);
  my %target;
  my $error="no";
  my(@known_options) = qw(growright bits noinfo absolute gauge nopercent integer);
  if (! $$cfg{workdir}) {
      warn ("\nERROR: \"WorkDir\" not specified\n");
      $error = "yes";
  }

  foreach $rou (@$routers) {
    # and now for the testing
    if (! $$rcfg{"title"}{$rou}) {
      warn ("\nERROR: \"Title[$rou]\" not specified\n");
      $error = "yes";
    }
	if ($$rcfg{'directory'}{$rou})
	{
		# They specified a directory for this router.  Append the
		# pathname seperator to it (so that it can either be present or
		# absent, and the rules for including it are the same).
		$$rcfg{'directory'}{$rou} .= ${main::SL};
		# remove any stray spaces ...
		$$rcfg{'directory'}{$rou} =~ s/\s//g;
	}
    if (! $$rcfg{"pagetop"}{$rou}) {
      warn ("\nERROR: \"PageTop[$rou]\" is not specified.\n");
      $error = "yes";
    } else {
      # allow for linebreaks
      $$rcfg{"pagetop"}{$rou} =~ s/\\n/\n/g;
    }
  if (exists $$rcfg{"pagefoot"}{$rou}) {
    # allow for linebreaks
    $$rcfg{"pagefoot"}{$rou} =~ s/\\n/\n/g;
  }
 
    if ($$rcfg{"maxbytes"}{$rou} eq '') {
      warn ("\nERROR: \"MaxBytes[$rou]\" not specified\n");
      $error = "yes";
    }
    # set default size 
    if (! exists $$rcfg{"xsize"}{$rou}) {
      $$rcfg{"xsize"}{$rou}=400;
    } 
    if (! exists $$rcfg{"ysize"}{$rou}) {
      $$rcfg{"ysize"}{$rou}=100;
    }
    
    if (exists $$rcfg{"options"}{$rou}) {
      foreach $one_option (split /[,\s]+/, lc($$rcfg{"options"}{$rou})) {
	if (grep {$one_option eq $_} @known_options) {
	  $$rcfg{'options'}{$one_option}{$rou} = 1;
	} else {
	  warn ("\nERROR: Option[$rou]: \"$one_option\" is unknown\n");
	  $error="yes";
	}
      }
    }
    #
    # Check out routeruptime definition
    #    
    if ($$rcfg{"routeruptime"}{$rou}) {
      ($$rcfg{"community"}{$rou},$$rcfg{"router"}{$rou}) =
        split(/@/,$$rcfg{"routeruptime"}{$rou});
    }
    #
    # Check out target definition
    #    
    if ($$rcfg{"target"}{$rou}) {
      print "TARGSTART: '".$$rcfg{"target"}{$rou}."'\n" if $main::DEBUG > 1;
	    
      my ($pr) = "\$\$target\{'";
      my ($po) = "'\}\{\$mode\}";
      $$rcfg{targorig}{$rou} = $$rcfg{target}{$rou};
      $$rcfg{target}{$rou}  =~ s/,/ \+ /g;
      
      while ($$rcfg{target}{$rou}  =~ 
            s/(-?)([a-z0-9\.&]+):([^\s\@]+)\@([-a-z0-9_\.]+(:[0-9.]*)*)(?=[\s\+\/\*]|$)/$pr$&$po/i)
	{
	my $targ=$&;       
	print "TARGNEW:   '".$$rcfg{"target"}{$rou}."'\n" if $main::DEBUG > 1;
	print "TARGMATCH: '".$targ."'\n" if $main::DEBUG > 1;
	$$rcfg{targtest}{$rou} .= "($pr$&$po == -1) || ";
	$$rcfg{targcount}{$rou}++;
	# my($host) = $4;
	$target{$targ}{'ioswap'} = $1;
	my($port) = $2;
	$target{$targ}{'community'} = $3;
	$target{$targ}{'router'} = $4;
	if ($port =~ /^\d+$/) {   # By default get the input/output octets
	  $target{$targ}{'oid1'} = "ifInOctets.$port";
	  $target{$targ}{'oid2'} = "ifOutOctets.$port";
	} else {
	  my($o1, $o2) = split(/\&/, $port,2);
	  if (!$o1 || !$o2) {
	    warn ("\nERROR: If specifying the full OID, you must specify\n".
		  "2 full OID's separated by '&'. Error found with\n".
		  "\"$&\" in \"Target[$rou]\"\n");
	    $error = "yes";
	  }
	  $target{$targ}{'oid1'} = $o1;
	  $target{$targ}{'oid2'} = $o2;
	}	
      }
      
      while ($$rcfg{"target"}{$rou} =~ /\`([^\`]+)\`(?=[\s\+\/\*]|$)/) {
	my $cmd = $1;
	my $targ = my $tq = $&;
	$tq =~ s/['\\]/\\$&/g;
	$$rcfg{"target"}{$rou} =~ s/\`([^\`]+)\`(?=[\s\+\/\*]|$)/$pr$tq$po/;
	$$rcfg{targtest}{$rou} .= "($pr$tq$po == -1) || ";
	$$rcfg{targcount}{$rou}++;

	print "TARGSUBST:".$$rcfg{"target"}{$rou}."\n" if $main::DEBUG > 1;;
	$target{$targ}{'command'} = $cmd;
      }
    } else {
      warn ("\nERROR: I can't find a \"target[$rou]\" definition\n");
      $error = "yes";
    }
    
    # colors format: name#hexcol,
    if ($$rcfg{"colours"}{$rou}) {
      if ($$rcfg{"colours"}{$rou} =~  
	  /^([^\#]+)(\#[0-9a-f]{6})\s*,\s*
		([^\#]+)(\#[0-9a-f]{6})\s*,\s*
		([^\#]+)(\#[0-9a-f]{6})\s*,\s*
		([^\#]+)(\#[0-9a-f]{6})/ix) {
	($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou},
	 $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou},
	 $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou},
	 $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou}) = 
	   ($1, $2, $3, $4, $5, $6, $7, $8);
      } else {
	warn ("\nERROR: \"colours[$rou]\" for colour definition\n".
	      "       use the format: Name#hexcolour, Name#Hexcolour,...\n");
	$error="yes";
      }
    } else {            
      ($$rcfg{'col1'}{$rou}, $$rcfg{'rgb1'}{$rou},
       $$rcfg{'col2'}{$rou}, $$rcfg{'rgb2'}{$rou},
       $$rcfg{'col3'}{$rou}, $$rcfg{'rgb3'}{$rou},
       $$rcfg{'col4'}{$rou}, $$rcfg{'rgb4'}{$rou}) = 
	 ("GREEN","#00cc00",
	  "BLUE","#0000ff",
	  "DARK GREEN","#006600",
	  "MAGENTA","#ff00ff");
    }

    # Background color, format: #rrggbb
    if ($$rcfg{'background'}{$rou}) {
      if ($$rcfg{'background'}{$rou} =~ /^(\#[0-9a-f]{6})/i) {
	$$rcfg{'backgc'}{$rou} = "BGCOLOR=\"$1\"";
      } else {
	warn ("\nERROR: \"background[$rou]: ".
	      "$$rcfg{'background'}{$rou}\" for colour definition\n".
	      "       use the format: #rrggbb\n");
	$error="yes";
      }
    } else {
      $$rcfg{'backgc'}{$rou} = "BGCOLOR=\"#ffffff\"";
    }
    
    if (! $$rcfg{'xzoom'}{$rou}) { $$rcfg{'xzoom'}{$rou} = 1.0 }
    if (! $$rcfg{'yzoom'}{$rou}) { $$rcfg{'yzoom'}{$rou} = 1.0 }
    if (! $$rcfg{'xscale'}{$rou}) { $$rcfg{'xscale'}{$rou} = 1.0 }
    if (! $$rcfg{'yscale'}{$rou}) { $$rcfg{'yscale'}{$rou} = 1.0 }
    
    if ($error eq "yes") {
      die ("\n\nABORT: Please fix the error(s) in your config file\n\n");
    }
  }
  \%target;
}



	
sub getcurrent {
  my ($target, $rou, $rcfg) = @_;

  if ($main::DEBUG > 1) {
    print "getcurrent: dumping rcfg keys\n";
    my $key;
    foreach $key (keys %$rcfg) {
      print "getcurrent: rcfg $key $$rcfg{$key}\n";
    }
  }
  
  
  my $inlast=0;
  my $outlast=0;
  my $uptime;
  my $name;
  my $strg;
  my $time;
  my $count=0;


  print "getcurrent: rcfg target router $rou = $$rcfg{'target'}{$rou}\n"
    if $main::DEBUG;

  my $mode='in';
	
 if ( eval("(" . $$rcfg{targtest}{$rou}."0 )")) {
    $inlast = -1;
  } else {
  # we must get a plain value
    $inlast = sprintf("%.0f",eval($$rcfg{target}{$rou}));
    die "* Problem with '$$rcfg{targorig}{$rou}':\n  $@\n" if $@;
  }

  $mode='out';
  if ( eval("(" . $$rcfg{targtest}{$rou}."0 )")) {
    $outlast = -1;
  } else {
    $outlast = sprintf("%.0f",eval($$rcfg{target}{$rou}));
    die "* Problem with '$$rcfg{targorig}{$rou}':\n  $@\n" if $@;
  }

  if ($$rcfg{targcount}{$rou} == 1) {
    $uptime = $$target{$$rcfg{targorig}{$rou}}{'uptime'};
    $name = $$target{$$rcfg{targorig}{$rou}}{'name'};
    $time = $$target{$$rcfg{targorig}{$rou}}{'time'};
  }
  #make sure we have a time set ...
  $time = time unless defined $time;

  if ($$rcfg{routeruptime}{$rou} ne '') {
    ($uptime,$name) = &snmpget($$rcfg{"router"}{$rou},
	     $$rcfg{"community"}{$rou},
	     'sysUptime',
	     'sysName');
  }

  ($inlast, $outlast, $uptime, $name, $time);
}


sub writegraphics {
  my($router, $cfg, $rcfg, $inlast, $outlast, $time) = @_;
  
  my($absmax,$maxv, $i, $period, $res);
  my(@exec,@metas);
  my(%maxin, %maxout, %avin, %avout, %cuin, %cuout);

  @metas = ();
  $maxv = $$rcfg{'maxbytes'}{$router};
  $absmax = $$rcfg{'absmax'}{$router};
  $absmax = $maxv unless $absmax;

  
  print "writegraphics: inlast $inlast outlast $outlast\n" if $main::DEBUG;

  # select whether the datasource gives relative or absolte return values.
  my $up_abs="u";
  $up_abs='a' if $$rcfg{'options'}{'absolute'}{$router};
  $up_abs='g' if $$rcfg{'options'}{'gauge'}{$router};


  if (open (HTML,"<$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}$router.html")) {
    for ($i=0 ; $i<40 ; $i++) {
      $_=<HTML>;
      if (/<!-- maxin ([dwmy]) (\d*)/) {
	$maxin{$1}{$router}=0+$2;
      };
      if (/<!-- maxout ([dwmy]) (\d*)/) {
	$maxout{$1}{$router}=0+$2;
      };
      if (/<!-- avin ([dwmy]) (\d*)/) {
	$avin{$1}{$router}=0+$2;
      };
      if (/<!-- avout ([dwmy]) (\d*)/) {
	$avout{$1}{$router}=0+$2;
      };
      if (/<!-- cuin ([dwmy]) (\d*)/) {
	$cuin{$1}{$router}=0+$2;
      };
      if (/<!-- cuout ([dwmy]) (\d+)/) {
	$cuout{$1}{$router}=0+$2;
      };
    }
    close HTML;
  };


# 
	my $rateup = "\$rateup ".
	   " $$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}".
		" $router"." ".$time." ".$up_abs." ".$inlast." ".$outlast." ".$absmax;
    
  my $maxx = $$rcfg{'xsize'}{$router}; 
  my $maxy = $$rcfg{'ysize'}{$router};
  my $xscale = $$rcfg{'xscale'}{$router}; 
  my $yscale = $$rcfg{'yscale'}{$router}; 
  my $growright = 0+$$rcfg{'options'}{'growright'}{$router};
  my $bits = 0+$$rcfg{'options'}{'bits'}{$router};
  my $integer = 0+$$rcfg{'options'}{'integer'}{$router};
  my $step = 5*60; 
  my $rop;

	@exec = $rateup;


  if ($$rcfg{'ylegend'}{$router}) {
	push (@exec, "l", "[$$rcfg{'ylegend'}{$router}]");
  }
  my $sign = ($$rcfg{'unscaled'}{$router} =~ /d/) ? 1 : -1;
  
  if ($$rcfg{'weekformat'}{$router}){
      push (@exec, "W", $$rcfg{'weekformat'}{$router});
  }


  if ($$rcfg{'suppress'}{$router} !~/d/)
	{
	push (@exec, "i", "${router}-day.gif", 
		$sign*$maxv, $maxx, $maxy, ,$xscale, $yscale, $growright, $step, $bits);
	push (@metas, "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-day.gif", 
		$$cfg{'interval'} ? $$cfg{'interval'} : 5);

	print "\nEXEC: ",(join " ", @exec),"\n" if $main::DEBUG;
	open (RATEUP, join (" ", @exec)."|");

	$period = "d";
	chomp($res = <RATEUP>); 
	print "$period: maxin \"$res\"\n" if $main::DEBUG >2;
	$maxin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: maxout \"$res\"\n" if $main::DEBUG >2;
	$maxout{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: avin \"$res\"\n" if $main::DEBUG >2;
	$avin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: avout \"$res\"\n" if $main::DEBUG >2;
	$avout{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: cuin \"$res\"\n" if $main::DEBUG >2;
	$cuin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: cuout \"$res\"\n" if $main::DEBUG >2;
	$cuout{$period}{$router}=sprintf("%.0f",0+$res);
	
	close	RATEUP;
	}
#

  if (((not -e "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-week.gif") ||
       (-M "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-week.gif" >= 0.5/24)) &&
      ($$rcfg{'suppress'}{$router} !~/w/)
     ) {
	$step=30*60;
	$sign = ($$rcfg{'unscaled'}{$router} =~ /w/) ? 1 : -1;

	$rop =($$rcfg{'withpeak'}{$router} =~ /w/) ? "p" : "i"; 

  	@exec = $rateup;
	push (@exec,$rop ,"${router}-week.gif", 
		$sign*$maxv, $maxx, $maxy, $xscale, $yscale, $growright, $step, $bits);
	push (@metas, "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-week.gif", 30);

	print "\nEXEC: ",(join " ", @exec),"\n" if $main::DEBUG;
	open (RATEUP, join (" ", @exec)."|");

	$period = "w";
	chomp($res = <RATEUP>); 
	print "$period: maxin \"$res\"\n" if $main::DEBUG >2;
	$maxin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: maxout \"$res\"\n" if $main::DEBUG >2;
	$maxout{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: avin \"$res\"\n" if $main::DEBUG >2;
	$avin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: avout \"$res\"\n" if $main::DEBUG >2;
	$avout{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: cuin \"$res\"\n" if $main::DEBUG >2;
	$cuin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: cuout \"$res\"\n" if $main::DEBUG >2;
	$cuout{$period}{$router}=sprintf("%.0f",0+$res);
	
	close	RATEUP;
	}
  

  if (((not -e "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-month.gif") || 
       ( -M "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-month.gif" >= 2/24))  &&
      ($$rcfg{'suppress'}{$router} !~/m/)) {
    $step=2*60*60;
    $sign = ($$rcfg{'unscaled'}{$router} =~ /m/) ? 1 : -1;

    $rop =($$rcfg{'withpeak'}{$router} =~ /m/) ? "p" : "i"; 
  	@exec = $rateup;
	push (@exec, $rop ,"${router}-month.gif", 
	  $sign*$maxv, $maxx, $maxy, $xscale, $yscale, $growright, $step, $bits);
	push (@metas, "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-month.gif", 120);

	print "EXEC: ",(join " ", @exec),"\n" if $main::DEBUG;
	open (RATEUP, join (" ", @exec)."|");

	$period = "m";
	chomp($res = <RATEUP>); 
	print "$period: maxin \"$res\"\n" if $main::DEBUG >2;
	$maxin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: maxout \"$res\"\n" if $main::DEBUG >2;
	$maxout{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: avin \"$res\"\n" if $main::DEBUG >2;
	$avin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: avout \"$res\"\n" if $main::DEBUG >2;
	$avout{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: cuin \"$res\"\n" if $main::DEBUG >2;
	$cuin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: cuout \"$res\"\n" if $main::DEBUG >2;
	$cuout{$period}{$router}=sprintf("%.0f",0+$res);

	close	RATEUP;
	}
  

  if (((not -e "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-year.gif") || 
       ( -M "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-year.gif" >= 1)) &&
      ($$rcfg{'suppress'}{$router} !~/y/)) {
    $step=24*60*60;
    $sign = ($$rcfg{'unscaled'}{$router} =~ /y/) ? 1 : -1;

    $rop =($$rcfg{'withpeak'}{$router} =~ /y/) ? "p" : "i"; 
  	@exec = $rateup;
	push (@exec, $rop, "${router}-year.gif", 
	  $sign*$maxv, $maxx, $maxy, $xscale, $yscale, $growright, $step, $bits) ;
	push (@metas, "$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}${router}-year.gif", 1440);

	print "EXEC: ",(join " ", @exec),"\n" if $main::DEBUG;
	open (RATEUP, join (" ", @exec)."|");

	$period = "y";
	chomp($res = <RATEUP>); 
	print "$period: maxin \"$res\"\n" if $main::DEBUG >2;
	$maxin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: maxout \"$res\"\n" if $main::DEBUG >2;
	$maxout{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: avin \"$res\"\n" if $main::DEBUG >2;
	$avin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: avout \"$res\"\n" if $main::DEBUG >2;
	$avout{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: cuin \"$res\"\n" if $main::DEBUG >2;
	$cuin{$period}{$router}=sprintf("%.0f",0+$res);
	chomp($res = <RATEUP>); 
	print "$period: cuout \"$res\"\n" if $main::DEBUG >2;
	$cuout{$period}{$router}=sprintf("%.0f",0+$res);

	close	RATEUP;
	}    
   

  if ($?) {
      my $value = $?;
	my $signal =  $? & 127; #ignore the most significant bit 
				#as it is always one when it is a returning
				#child says dave ...
	if(($main::OS != 'UNIX') || (($? == -1) && ($! != $main::signo{CHLD})))
	{
	my $exitval = $? >> 8;
	warn "\nPROBLEM: rateup died from Signal $signal\n".
	" with Exit Value $exitval when doing router '$router'\n".
	" code was $value, retcode was $!.".
	" If this happens all the time,\n".
	" you should probably investigate the cause. :-)\n\n";
  }
    }
  if( $$cfg{'writeexpires'} =~ /^y/i ) {
    my($fil,$exp);
    while( $fil = shift(@metas) ) {
      $exp = &expistr(shift(@metas));
      open(META, ">$fil.meta");
      print META "Expires: $exp\n";
      close(META);
    }
  }

  (\%maxin, \%maxout, \%avin, \%avout, \%cuin, \%cuout);
}

#format 10000 to 10 kB/s
sub fmi {
  my($number, $router, $rcfg) = @_;
  my(@short,$mul);
  if ($$rcfg{'options'}{'bits'}{$router} == 1) {
    @short = ("b/s","kb/s","Mb/s","Gb/s");
    $mul= 8;
  } else {
    @short = ("B/s","kB/s","MB/s","GB/s");
    $mul= 1;
  }
  if ($$rcfg{'shortlegend'}{$router}) {
	@short = ("$$rcfg{'shortlegend'}{$router}",
		  "k$$rcfg{'shortlegend'}{$router}",
		  "M$$rcfg{'shortlegend'}{$router}",
		  "G$$rcfg{'shortlegend'}{$router}");
  }
  my $digits=length("".$number*$mul);
  my $divm=0;
  while ($digits-$divm*3 > 4) { $divm++; }
  my $divnum = $number*$mul/10**($divm*3);
  my $perc;
  if ($$rcfg{'maxbytes'}{$router}*$number == 0) {
    $perc = 0;
  } else {
    $perc = 100/$$rcfg{'maxbytes'}{$router}*$number;
  }
  if ($$rcfg{'options'}{'integer'}{$router} == 1) {
    if ($$rcfg{'options'}{'nopercent'}{$router}) {
      return sprintf("%0.f ",$number);
    } else {
      return sprintf("%0.f (%2.1f%%)",$number,$perc);
    }
  } else {
    if ($$rcfg{'options'}{'nopercent'}{$router}) {
      return sprintf("%1.1f %s",$divnum,$short[$divm]);  # Added: FvW
    } else {
      return sprintf("%1.1f %s (%2.1f%%)",$divnum,$short[$divm],$perc);
    }
   return sprintf("%1.1f %s (%2.1f%%)",$divnum,$short[$divm],$perc);
  }
}

sub datestr {
  my ($time) = shift(@_) || return 0;
  my ($wday) = ('Sunday','Monday','Tuesday','Wednesday',
		'Thursday','Friday','Saturday')[(localtime($time))[6]];
  my ($month) = ('January','February' ,'March' ,'April' ,
		 'May' , 'June' , 'July' , 'August' , 'September' , 
		 'October' ,
		 'November' , 'December' )[(localtime($time))[4]];
  my ($mday,$year,$hour,$min) = (localtime($time))[3,5,2,1];
  if ($min<10) {$min = "0$min";}
  return "$wday, $mday $month ".($year+1900)." at $hour:$min";
}

sub expistr {
  my ($time) = time+$_[0]*60+5;
  my ($wday) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[(gmtime($time))[6]];
  my ($month) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', 
		 'Oct','Nov','Dec')[(gmtime($time))[4]];
  my ($mday,$year,$hour,$min,$sec) = (gmtime($time))[3,5,2,1,0];
  if ($mday<10) {$mday = "0$mday"};
  if ($hour<10) {$hour = "0$hour"};
  if ($min<10) {$min = "0$min";}
  if ($sec<10) {$sec = "0$sec";}
  return "$wday, $mday $month ".($year+1900)." $hour:$min:$sec GMT";
}

sub writehtml {
  my($router, $cfg, $rcfg, $maxin, $maxout, 
     $avin, $avout, $cuin, $cuout, $uptime, $name) = @_;
  
  my($rev,$date,$Today,$peri);
  
  my($persec);
  if ($$rcfg{'options'}{'bits'}{$router} == 1) {
     $persec = "Bits";
  } else {
     $persec = "Bytes";
  }

#  Work out the Colour legend
  my($leg1, $leg2, $leg3, $leg4);
  if ($$rcfg{'legend1'}{$router}) {
	$leg1 = $$rcfg{'legend1'}{$router};
  } else {
	$leg1 = "Incoming Traffic in $persec per Second";
  }
  if ($$rcfg{'legend2'}{$router}) {
	$leg2 = $$rcfg{'legend2'}{$router};
  } else {
	$leg2 = "Outgoing Traffic in $persec per Second";
  }
  if ($$rcfg{'legend3'}{$router}) {
	$leg3 = $$rcfg{'legend3'}{$router};
  } else {
	$leg3 = "Maximal 5 Minute Incoming Traffic";
  }
  if ($$rcfg{'legend4'}{$router}) {
	$leg4 = $$rcfg{'legend4'}{$router};
  } else {
	$leg4 = "Maximal 5 Minute Outgoing Traffic";
  }

  $Today=datestr(time);
  '$Revision: 2.5.4 $ ' =~ /Revision: (\S*)/;
  $rev=$1;
  '$Date: 1998/10/13 08:29:47 $ ' =~ /Date: (\S*)/;
  $date=$1;
  open (HTML,">$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}$router.html") || 
    warn ("\nCan not write $router.html");
  print HTML "<HTML>\n";
  my $interval =$$cfg{'interval'} ? $$cfg{'interval'} : 5;
  my $expiration = &expistr($interval);
  my $refresh =  $$cfg{'refresh'} ? $$cfg{'refresh'} : 300;
  my $namestring = "the device";  
  print HTML <<"TEXT";    
<HEAD>
<TITLE>
$$rcfg{'title'}{$router}
</TITLE>
<META HTTP-EQUIV="Refresh" CONTENT=$refresh >
<META HTTP-EQUIV="Expires" CONTENT="$expiration">
TEXT

  foreach $peri (qw(d w m y)) {
    print HTML <<"TEXT";
<!-- maxin $peri $$maxin{$peri}{$router} -->
<!-- maxout $peri $$maxout{$peri}{$router} -->
<!-- avin $peri $$avin{$peri}{$router} -->
<!-- avout $peri $$avout{$peri}{$router} -->
<!-- cuin $peri $$cuin{$peri}{$router} -->
<!-- cuout $peri $$cuout{$peri}{$router} -->
TEXT
  }
  if ($name ne '') {$namestring = "<B>'$name'</B>"};
  # allow for \n in addhead
  $$rcfg{addhead}{$router} =~ s/\\n/\n/g;
print HTML <<"TEXT";    
$$rcfg{'addhead'}{$router}
</HEAD>
<BODY $$rcfg{'backgc'}{$router}>
$$rcfg{'pagetop'}{$router}<P>
<HR>
The statistics were last updated <B>$Today $$rcfg{'timezone'}{$router}</B>
TEXT

if ($uptime && ! $$rcfg{options}{noinfo}{$router}) {
print HTML <<"TEXT"
,<BR>
at which time $namestring had been up for <B>$uptime</B>.
TEXT
  }

  my %sample= ('d' => "`Daily' Graph (".$interval.' Minute',
	       'w' => "`Weekly' Graph (30 Minute",
	       'm' => "`Monthly' Graph (2 Hour",
	       'y' => "`Yearly' Graph (1 Day");
  
  my %full = ('d' => 'day',
	      'w' => 'week',
	      'm' => 'month',
	      'y' => 'year');
  
  my $InCo;
  if (exists $$rcfg{'legendi'}{$router}) {
    if ($$rcfg{'legendi'}{$router} ne "") {
      $InCo="<FONT COLOR=$$rcfg{'rgb1'}{$router}>".
	"$$rcfg{'legendi'}{$router}</FONT>" }
  } else {
    $InCo="<FONT COLOR=$$rcfg{'rgb1'}{$router}>".
      "&nbsp;In:</FONT>" }
  my $OutCo;
  if (exists $$rcfg{'legendo'}{$router}) {
    if ($$rcfg{'legendo'}{$router} ne "") {
      $OutCo="<FONT COLOR=$$rcfg{'rgb2'}{$router}>".
	"$$rcfg{'legendo'}{$router}</FONT>" }
  } else {
    $OutCo="<FONT COLOR=$$rcfg{'rgb2'}{$router}>".
      "&nbsp;Out:</FONT>" }
  
  foreach $peri (qw(d w m y)){
    next if $$rcfg{'suppress'}{$router} =~/$peri/;
    my $gifw=sprintf("%.0f",($$rcfg{'xsize'}{$router}*$$rcfg{'xscale'}{$router}+100)
		 *$$rcfg{'xzoom'}{$router});
    my $gifh=sprintf("%.0f",($$rcfg{'ysize'}{$router}*$$rcfg{'yscale'}{$router}+35)
		 *$$rcfg{'yzoom'}{$router});
		 
  
    print HTML "
<HR>
<B>$sample{$peri} Average)</B><BR>
<IMG VSPACE=10 WIDTH=$gifw HEIGHT=$gifh ALIGN=TOP 
     SRC=\"$router-$full{$peri}.gif\">
 <TABLE CELLPADDING=0 CELLSPACING=0>
";
    print HTML "<TR>
  <TD ALIGN=right><SMALL>Max$InCo</SMALL></TD>
  <TD ALIGN=right><SMALL>".&fmi($$maxin{$peri}{$router}, $router, $rcfg)."
   </SMALL></TD>
  <TD WIDTH=5></TD>
  <TD ALIGN=right><SMALL>Average$InCo</SMALL></TD>
  <TD ALIGN=right><SMALL>".&fmi($$avin{$peri}{$router}, $router, $rcfg)."
  </SMALL></TD>
  <TD WIDTH=5></TD>
  <TD ALIGN=right><SMALL>Current$InCo</SMALL></TD>
  <TD ALIGN=right><SMALL>".&fmi($$cuin{$peri}{$router}, $router, $rcfg)."
  </SMALL></TD>
 </TR>
" if $InCo;
print HTML "
 <TR>
  <TD ALIGN=right><SMALL>Max$OutCo</SMALL></TD>
  <TD ALIGN=right><SMALL>".&fmi($$maxout{$peri}{$router}, $router, $rcfg)."
  </SMALL></TD>
  <TD WIDTH=5></TD>
  <TD ALIGN=right><SMALL>Average$OutCo</SMALL></TD>
  <TD ALIGN=right><SMALL>".&fmi($$avout{$peri}{$router}, $router, $rcfg)."
  </SMALL></TD>
  <TD WIDTH=5></TD>
  <TD ALIGN=right><SMALL>Current$OutCo</SMALL></TD>
  <TD ALIGN=right><SMALL>".&fmi($$cuout{$peri}{$router}, $router, $rcfg)."
 </SMALL></TD>
 </TR> " if $OutCo;
    print HTML "
</TABLE>\n";
  }
  print HTML "
  <HR><P>
  <TABLE WIDTH=500 BORDER=0 CELLPADDING=4 CELLSPACING=0>";
  print HTML "
   <TR><TD ALIGN=RIGHT><FONT SIZE=-1 COLOR=\"$$rcfg{'rgb1'}{$router}\">
      <B>$$rcfg{'col1'}{$router} ###</B></FONT></TD>
      <TD><FONT SIZE=-1>$leg1</FONT></TD></TR> " if $InCo;
  print HTML "
   <TR><TD ALIGN=RIGHT><FONT SIZE=-1 COLOR=\"$$rcfg{'rgb2'}{$router}\">
      <B>$$rcfg{'col2'}{$router} ###</B></FONT></TD>
      <TD><FONT SIZE=-1>$leg2</FONT></TD></TR> " if $OutCo;
  
  if ($$rcfg{'withpeak'}{$router}) {
    print HTML "
   <TR><TD ALIGN=RIGHT><FONT SIZE=-1 COLOR=\"$$rcfg{'rgb3'}{$router}\">
			<B>$$rcfg{'col3'}{$router}###</B></FONT></TD>
       <TD><FONT SIZE=-1>$leg3</FONT></TD></TR> " if $InCo;
  print HTML "
   <TR><TD ALIGN=RIGHT><FONT SIZE=-1 COLOR=\"$$rcfg{'rgb4'}{$router}\">
			<B>$$rcfg{'col4'}{$router}###</B></FONT></TD>
       <TD><FONT SIZE=-1>$leg4</FONT></TD></TR> "if $OutCo;
     }

  # If they're using the "directory" option, we have to adjust the
  # path to the gifs.
  my $gifPath = "..${main::SL}" x ($$rcfg{'directory'}{$router} =~ tr|${main::SL}|${main::SL}|);
  if (defined $$cfg{icondir}) {
	$gifPath = $$cfg{icondir};
	#lets make sure there is a trailing path separator
        $gifPath =~ s|${main::SL}*$|${main::SL}|; 
  }

  print HTML <<TEXT;
</TABLE><P><HR><P>

<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0>
  <TR>
    <TD WIDTH=63><A ALT="MRTG"
    HREF="http://ee-staff.ethz.ch/~oetiker/webtools/mrtg/mrtg.html"><IMG
    BORDER=0 SRC="${gifPath}mrtg-l.gif"></A></TD>
    <TD WIDTH=25><A ALT=""
    HREF="http://ee-staff.ethz.ch/~oetiker/webtools/mrtg/mrtg.html"><IMG
    BORDER=0 SRC="${gifPath}mrtg-month.gif"></A></TD>
    <TD WIDTH=388><A ALT=""
    HREF="http://ee-staff.ethz.ch/~oetiker/webtools/mrtg/mrtg.html"><IMG
    BORDER=0 SRC="${gifPath}mrtg-r.gif"></A></TD>
  </TR>
</TABLE>
<SPACER TYPE=VERTICAL SIZE=4>
<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0>
  <TR VALIGN=top>
  <TD WIDTH=88 ALIGN=RIGHT><FONT FACE="Arial,Helvetica" SIZE=2>
  $rev-$date</FONT></TD>
  <TD WIDTH=388 ALIGN=RIGHT><FONT FACE="Arial,Helvetica" SIZE=2>
  <A HREF="http://ee-staff.ethz.ch/~oetiker/">Tobias Oetiker</A>
  <A HREF="mailto:oetiker\@ee.ethz.ch">&lt;oetiker\@ee.ethz.ch&gt;</A> 
  and&nbsp;<A HREF="http://www.bungi.com">Dave&nbsp;Rand</A>&nbsp;<A HREF="mailto:dlr\@bungi.com">&lt;dlr\@bungi.com&gt;</A></FONT>
  </TD>
</TR>
</TABLE>
TEXT

  # We don't need this any more.
  undef $gifPath;

  if ($main::OS eq 'VMS') {
    print HTML <<TEXT;
 <HR NOSHADE>
 Ported to OpenVMS Alpha by 
 <NOBR><A HREF="http://www.cerberus.ch">Werner Berger</A>
 <A href="mailto:werner.berger\@cch.cerberus.ch">
 &lt;werner.berger\@cch.cerberus.ch&gt;</A></NOBR>
TEXT
  }
  if ($main::OS eq 'NT') {
    print HTML <<TEXT;
  <HR NOSHADE>
  Ported to WindowsNT by
  <NOBR><A HREF="http://www.testlab.orst.edu">Stuart Schneider</A>
  <A HREF="mailto:schneis\@testlab.orst.edu">
  &lt;schneis\@testlab.orst.edu&gt;</A></NOBR>
TEXT
  }

  print HTML $$rcfg{'pagefoot'}{$router} if defined $$rcfg{'pagefoot'}{$router};
  print HTML <<TEXT;
</BODY>
</HTML>
TEXT
  close HTML;

  if ($$cfg{'writeexpires'} =~ /^y/i)
  {
    open(HTMLG, ">$$cfg{'workdir'}${main::SL}$$rcfg{'directory'}{$router}$router.html.meta");
    print HTMLG "Expires: $expiration\n";
    close(HTMLG);
  }
}

sub printusage {
    print <<USAGEDESC;
Usage: mrtg <config-file>

mrtg: Multi Router Traffic Grapher.

If you want to know more about this tool, you might want
to read the docs. They came together with mrtg! 

Home: http://ee-staff.ethz.ch/~oetiker/webtools/mrtg/mrtg.html

USAGEDESC
    exit(1);
}


sub readtargets {
  my ($target, $cfg, $rcfg, $cfgfile) = @_;
  
  my($in,$out,$uptime,$name,$targ,$now,$i,$okfile,$cfgorig);

  # get a list of known ifDescrs, in order to cross check the
  # the values returned by querying the various targets ...

  my(%oldifDescrs,%newifDescrs);
  # remove any trailing . something from the cfg file name.
  $cfgorig=$cfgfile;
  $cfgfile =~ s/\.[^\.]+$//g;  
  if(open (CFGOK,"<$cfgfile.ok")) {
    print STDERR "Reading ifDescs from $cfgfile.ok ...\n" if $main::DEBUG;
    while (<CFGOK>) {
      chomp;
       my($targ,$desc) = split (' = ', $_, 2);
      # ignore empty ifDescs ...
      $oldifDescrs{$targ}=$desc if $desc;
    }
    close CFGOK;
  } else {
    print STDERR "Could not read ifDescs from $cfgfile.ok ...\n" if $main::DEBUG;
  }

  open SR, ">>$$cfg{'workdir'}${main::SL}mrtg.dbg" if $main::SNMPDEBUG;
  print SR time," -- ", (join " | ", keys %$target), "\n" if $main::SNMPDEBUG;
  foreach $targ (keys %$target) {
    print "getting SNMP variables for target: $targ\n" 
      if $main::DEBUG;
    if (exists $$target{$targ}{'command'}) {
      print "external snmpget: executing $$target{$targ}{'command'}\n" 
	if $main::DEBUG;

      open (EXTERNAL , $$target{$targ}{'command'}."|")
	|| warn "Can't fork to start \'".$$target{$targ}{'command'}."\': $!\n";
     
      warn "Could not get any data from external command ".
	  "'".$$target{$targ}{'command'}.
	    "'\nMaybe the external command did not even start. ($!)\n\n" if eof EXTERNAL;
      
      chomp( $$target{$targ}{'in'}=<EXTERNAL>) unless eof EXTERNAL;
      chomp( $$target{$targ}{'out'}=<EXTERNAL>) unless eof EXTERNAL;
      chomp( $$target{$targ}{'uptime'}=<EXTERNAL>) unless eof EXTERNAL;
      chomp( $$target{$targ}{'name'}=<EXTERNAL>) unless eof EXTERNAL;

      close EXTERNAL;
      print "External Command returned: in '$$target{$targ}{'in'}'\n".
      "                          out '$$target{$targ}{'out'}'\n".
      "                       uptime '$$target{$targ}{'uptime'}'\n".
      "                         name '$$target{$targ}{'name'}'\n" if $main::DEBUG >2;
	
      # if there is no data set it to -1 so that the graph is 
      # not generated
      if (! exists $$target{$targ}{'in'}) {
	$$target{$targ}{'in'}=-1;
	$$target{$targ}{'out'}=-1;
      } else {

        $$target{$targ}{'in'} =~ s/^\s*//;
        $$target{$targ}{'in'} =~ s/\s*$//;
        $$target{$targ}{'out'} =~ s/^\s*//;
        $$target{$targ}{'out'} =~ s/\s*$//;
        $$target{$targ}{'uptime'} =~ s/^\s*//;
        $$target{$targ}{'uptime'} =~ s/\s*$//;
        $$target{$targ}{'name'} =~ s/^\s*//;
        $$target{$targ}{'name'} =~ s/\s*$//;

	# do we have numbers in the external programs answer ?
	if ( $$target{$targ}{'in'} !~ /^\d+$/ ) {
	  warn "Problem with Externale get '$targ':\n".
	    "   Expected an INTEGER for 'in' but got '$$target{$targ}{'in'}'\n\n";
	  $$target{$targ}{'in'} = int($$target{$targ}{'in'});
	}	
	if ( $$target{$targ}{'out'} !~ /^\d+$/ ) {
	  warn "Problem with Externale get '$targ':\n".
	    "    Expected an INTEGER for 'out' but got '$$target{$targ}{'out'}'\n\n";
	  $$target{$targ}{'out'} = int($$target{$targ}{'out'});
	}	
      }
      
      if ($main::SNMPDEBUG) {
	$now=time;
	print SR "$now -- $targ ".
	  "in: \"$$target{$targ}{'in'}\"  ".
	    "out: \"$$target{$targ}{'out'}\"\n";
      }
    } else {
      
      print "snmpget: $$target{$targ}{oid1} $$target{$targ}{oid2} ".
	"$$target{$targ}{router} ".
	"$$target{$targ}{community}\n" if $main::DEBUG;
#      for ($i=0;$i<2;$i++) {
	if (($$target{$targ}{'oid1'} =~ /^if.+\.(\d+)$/) ||
	    ($$target{$targ}{'oid1'} =~ 
	     /^1\.3\.6\.1\.2\.1\.2\.2\.1\.\d+\.(\d+)$/)){
	  # we ll do the interface check only if 
	  # the request is to an if OID. Otherwhise this does not make
	  # sense.
	  ($in,$out,$uptime,$name,$newifDescrs{$targ}) = 
	    &snmpget($$target{$targ}{'router'},
		     $$target{$targ}{'community'},
		     $$target{$targ}{'oid1'},
		     $$target{$targ}{'oid2'},
		     'sysUptime',
		     'sysName',
		     "ifDescr.$1");
	} else {
	  ($in,$out,$uptime,$name) = 
	    &snmpget($$target{$targ}{'router'},
		     $$target{$targ}{'community'},
		     $$target{$targ}{'oid1'},
		     $$target{$targ}{'oid2'},
		     'sysUptime',
		     'sysName');
	}

	if (($in >= 0) && (($$target{$targ}{'oid1'} =~ /ifOperHack/) || 
	    ($$target{$targ}{'oid1'} =~ /ifAdminHack/))) {
	  $in = 0 unless $in == 1;
	  print SR "SNMPGET: if*Hack in action: targ - '$targ' in - '$in'\n" 
	    if $main::SNMPDEBUG;
	}
	if (($$target{$targ}{'oid2'} =~ /ifOperHack/) || 
	    ($$target{$targ}{'oid2'} =~ /ifAdminHack/)) {
	  $out = 0 unless $out == 1;
	  print SR "SNMPGET: if*Hack in action: targ - '$targ' out - '$out'\n"
	    if $main::SNMPDEBUG;
	  
	}

#	if ($in != -1) {
#	  last;
#	}

#	print "CANT GET $targ PROBLEM in:'$in' out:'$out'\n " if $main::DEBUG;
#	sleep(1); # try again in 1 seconds ...
 #     }
      if (($in==-1) || ($out==-1)) {
	print STDERR "SNMPGET: Failed to reach target: \"$targ\". I tried multiple times!\n";
      } else {
	# we only get here if there was data returned 
	print "$targ --> in: $in  out: $out  name: $name\n" if $main::DEBUG;
	
	
	if (($oldifDescrs{$targ} ne '') &&
	    ($newifDescrs{$targ} ne '') &&
	    ($oldifDescrs{$targ} ne $newifDescrs{$targ})){
	  $in=-1,$out=-1;	
	  print STDERR <<WARN;
Warning: There is something wrong with Target '$targ'
  
* Its ifDescr used to be '$oldifDescrs{$targ}'
* Now it is '$newifDescrs{$targ}'

I will not update this graph for the moment. Maybe your Router has
changed the port to interface mapping. This can happen when new
Interfaces are added to the router or when it is rebooted.

You should alter your '$cfgfile' file to fix the mapping and then
remove the offending lines from your '$cfgfile.ok' file. Mrtg will
then assume that everything is OK and create new entries representing 
the new matching. 
---------------------------------------------------------------------
WARN
  ;
	  
	}
	# Build the new ok files
	if ($oldifDescrs{$targ} ne '') {
	  $okfile .= "$targ = $oldifDescrs{$targ}\n";
	} elsif ($newifDescrs{$targ} ne '') {
	  $okfile .= "$targ = $newifDescrs{$targ}\n";
	}
      }
      #
      
      # sometimes we can only observe the router on the wrong side 
      # of the fence ...
      
      if ($$target{$targ}{'ioswap'} eq '-') {
	$$target{$targ}{'in'}=$out;
	$$target{$targ}{'out'}=$in;
      } else {
	$$target{$targ}{'in'}=$in;
	$$target{$targ}{'out'}=$out;
      }
      
      $$target{$targ}{'uptime'}=$uptime;
      $$target{$targ}{'name'}=$name;
      
      if ($main::SNMPDEBUG) {
	$now=time;
	print SR "$now -- $$target{$targ}{'router'} ".
	  " in: \"$in\"  out: \"$out\"\n";
	}
    }
    # now that the data is gatherd we take a time stamp ...
    # for simple targets we will pass this along to rateup and be happy
    $$target{$targ}{'time'}=time;
  }  

  close SR if $main::SNMPDEBUG;
  #
  # store the new ifDescr File
  if(open CFGOK,">$cfgfile.ok") {
    print STDERR "Writing ifDescs to $cfgfile.ok ...\n" if $main::DEBUG;
    print CFGOK $okfile;
    close CFGOK;
  } else {
    print STDERR "Problem: Could not write ifDescs to $cfgfile.ok ...\n";
  }  
  #
}

#
# A restricted snmpget.
#

sub snmpget {
  my($target,$community,@vars) = @_;
  my($host,$port,$timeout,$retries,$backoff) = split(/:/,$target,5);
  my(@enoid, $var,$response, $bindings, $binding, $value, $inoid,$outoid,
     $upoid,$oid,@retvals);
  $port = 161 unless $port;
  foreach $var (@vars) {
    if ($var =~ /^([a-z]+)/i) {
      my $oid = $snmpget::OIDS{$1};
      if ($oid) {
	$var =~ s/$1/$oid/;
      } else {
	die "Unknown SNMP var $var\n" 
      }
    }
    print "SNMPGET OID: $var\n" if $main::DEBUG >5;
    push @enoid,  encode_oid((split /\./, $var));
  }
  srand();
  my $session;
  $session = SNMP_Session->open($host,$community,$port);
  if (! defined($session)) {
    warn "SNMPGET Problem for $community\@$host\n";
    return (-1,-1);
  }
  $session->set_timeout ($timeout) if defined $timeout && $timeout ne '';
  $session->set_retries ($retries) if defined $retries && $retries ne '';
  $session->set_backoff ($backoff) if defined $backoff && $backoff ne '';
  if ($session->get_request_response(@enoid)) {
    $response = $session->pdu_buffer;
    ($bindings) = $session->decode_get_response ($response);
    $session->close ();    
    while ($bindings) {
      ($binding,$bindings) = decode_sequence ($bindings);
      ($oid,$value) = decode_by_template ($binding, "%O%@");
      my $tempo = pretty_print($value);
      $tempo=~s/\t/ /g;
      $tempo=~s/\n/ /g;
      $tempo=~s/^\s+//;
      $tempo=~s/\s+$//;
      push @retvals,  $tempo;
    }
    return (@retvals);
  } else {
    return (-1,-1);
  }
}


