#! /usr/bin/perl -w
# -*- mode: Perl -*-
##################################################################
# MRTG 2.9.23  --- Index Generator
##################################################################
#
# This reads a mrtg.cfg file form std input or cmdline argument
# and it takes a regexp on the cmdline to specify which 
# targets to look at.
#
# from this info it produces a router index on stdout or
# on the filename specified by the --output option
#
##################################################################
# Distributed under the GNU General Public License
# Copyright 2000 by Tobias Oetiker <tobi@oetiker.ch>
##################################################################

$main::GRAPHFMT="png";

require 5.005;
use strict;

# DEBUG TARGETS
# base - basic program flow
#@main::DEBUG=qw(base);

BEGIN {
    # Automatic OS detection ... do NOT touch
    if ( $^O =~ /^(?:(ms)?(dos|win(32|nt)?))/i ) {
        $main::OS = 'NT';
        $main::SL = '\\';
        $main::PS = ';';
    } elsif ( $^O =~ /^VMS$/i ) {
        $main::OS = 'VMS';
        $main::SL = '.';
        $main::PS = ':';
    } else {
        $main::OS = 'UNIX';
        $main::SL = '/';
        $main::PS = ':';
    }
}

use FindBin;
use lib "${FindBin::Bin}";
use lib "${FindBin::Bin}${main::SL}..${main::SL}lib${main::SL}mrtg2";

use MRTG_lib "2.090017";
use Getopt::Long;
use Pod::Usage;

my @argv = @ARGV;
my $argz = "$0";
foreach my $ar (@argv) {
   if ($ar =~ /[ |()]/ ) {
      $ar = sprintf "\"%s\"", $ar;
   }
   $argz .= " $ar";
}


main();
exit 0;

sub main {
    # default options
    my %opt = (
	       sort => 'original',
	       show => 'day',
	       section => 'h1',
	       columns => 2,
	       addhead => '',
	       bodyopt => 'bgcolor="#ffffff" text="#000000" '.
	                  'link="#000000" vlink="#000000" alink="#000000"',
	       title => 'MRTG Index Page',
	       headlevel => 1,
	       pagetopend => '',
	       pagetop => '',
	       pageend => '',
	       prefix => '',
	       rrdviewer => '/cgi-bin/14all.cgi',
	       optlog => 1,
	       bold => 1,
	       boldon => '<B>',
	       boldoff => '</B>',
	       div => 'DIV',
	       imgborder => 1,
	       cellspacing => 10,
	       legend => 1,
	      );
    $opt{headon} = "<H$opt{headlevel}>";
    $opt{headoff} = "</H$opt{headlevel}>";
    # load real options
    options(\%opt);

    #adapt some defaults to the current options
    die "ERROR: --autoprefix requires --output"
      if ($opt{autoprefix} and !defined $opt{output});
    $opt{pageend} = $opt{pagetopend} if (defined $opt{pagetopend} and not $opt{pageend});
    $opt{pagetop} = $opt{pagetopend} if (defined $opt{pagetopend} and not $opt{pagetop});
    $opt{boldon} = $opt{boldoff} = "" if (!$opt{bold});
    $opt{picfirst} = (defined $opt{picfirst}?1:0);
    if ($opt{compact}) {
        $opt{imgborder} = 0;
        $opt{cellspacing} = 0;
        $opt{headon} = $opt{boldon};
        $opt{headoff} = $opt{boldoff};
    }
	if ($opt{sidebyside}) {
		$opt{div} = 'TD';
	}
	
    # slurp config files
    my %rcfg;
    my %cfg;
    my @target;
    my @routers;
    while (@ARGV) {
	    my $cfgfile = shift @ARGV;
	    readcfg($cfgfile,\@routers,\%cfg,\%rcfg);
	    if ($opt{sectionhost}) {
	    	#We need to cache the "hostname" as appeared in cfgfile,
	    	#since it does change in cfgcheck (for ex. if multiple 
	    	#overlapping cfgfiles are specified)
	    	for my $targ (@routers) {
	    		if ( !defined $rcfg{host}{$targ} and
	    			 !($rcfg{target}{$targ} =~ m/(?<!\\)[ \`]/) ) {
	    			$rcfg{target}{$targ} =~ m/.*[^\\]@([^:]*)/;
	    			$rcfg{host}{$targ} = ucfirst $1 if (defined $1);
	    		}
	    	}
	    }
	    cfgcheck(\@routers, \%cfg, \%rcfg, \@target);
	    if ($opt{autoprefix}) {
		    $rcfg{prefixes} = {} if (!defined $rcfg{prefixes});
	        my $pref = subpath($cfg{htmldir},$opt{output});
		    for my $targ (@routers) {
		        $rcfg{prefixes}->{$targ} = $pref
		          if (! defined $rcfg{prefixes}->{$targ});
		    }
		}
    }
    # generate index page
    genindex(\@routers, \%cfg, \%rcfg, \%opt);
}

sub cleanurl ($) {
    my $url = shift;    
    $url =~ s|([^/.][^/.]*/)\.\./\1|$1|g;
    return $url;
}

#Take a path the mrtg (usually the mrtg output directory) and the overview
#file, find the relative path from the overview to the directory
sub subpath ($$) {
	my $sub = shift;
	my $out = shift;
	my @s=split /$main::SL/,$sub;
	my @o=split /$main::SL/,$out;
	pop @o;	#Last is a filename;
	for my $i (0..$#s) {		#cut common dirs
		if (defined $s[0] and
		    defined $o[0] and
		    $s[0] eq $o[0] ) {
		    	shift @s;
		    	shift @o;
		}
	}
	my $ret = join $main::SL,@s;
	for my $i (0..$#o) {
		$ret = "..$main::SL$ret";	# ".." == "Directory below this one" for
									# dos, windows, unix. What about VMS ?
									# Is this correct ? HEH
	}
	$ret .= $main::SL;			#Possibly this should be "/" in order not
								#to break on platforms !unix, since it will be
								#used for generating urls ?
	#Don't degenerate in "/" when really no prefix is needed.
	$ret = "" if ($ret eq $main::SL);
	return $ret;
}

sub genindex ($$$$) {
    my $routers = shift;
    my $cfg = shift;
    my $rcfg = shift;
    my $opt = shift;
    my $index;
    # -----------------------------------------------------------
    # keep only the items our users want (--filter)
    # -----------------------------------------------------------
    my @filtered;
    ITEM: foreach my $item (@{$routers}) {
	foreach my $filter (@{$$opt{filter}}) {
	    if ($filter =~ /(.+)([=!]~)(.+)/) {
		my ($area,$comp,$regex) = ($1,$2,$3);
		my $value;
	        for ($area) {
		    /^title|pagetop$/ && 
		      do { $value = $$rcfg{$area}{$item}; last };

		    /^name$/ && 
		      do { $value = $item; last };

		    die "ERROR: unknown filter area $_\n";
		};
		for ($comp) {
		    /^=~$/ &&
		      do { next ITEM unless $value =~ /$regex/; last };
		    /^!~$/ &&
		      do { next ITEM unless $value !~ /$regex/; last };
		    die "ERROR: unknown comparison operator $_\n";
		};
	    } else {
		die "ERROR: invalid filter expression $filter\n";
	    }
	}
	push @filtered, $item;
    };

    # -----------------------------------------------------------
    # get items into proper order (--sort)
    # -----------------------------------------------------------
    my @order;
    for ($$opt{sort}) {
	/^original$/ && do {@order = @filtered; last};
	/^name$/ &&  do { @order = sort @filtered; last};
	/^title$/ && do { @order =
			    sort { $$rcfg{title}{$a} cmp $$rcfg{title}{$b} || $a cmp $b }
			      @filtered;
			  last;
		      };
	/^descr(iption)?$/ &&
	    do {
	      @order =
	        sort {
		  $$rcfg{pagetop}{$a} =~ 
	           m[<td>Description:</td>\S*<td>(?:\S+\s+)?(.+?)</td>]i;
		  my $aval = lc $1;
		  $$rcfg{pagetop}{$b} =~ 
	           m[<td>Description:</td>\S*<td>(?:\S+\s+)?(.+?)</td>]i;
		  my $bval = lc $1;
		  $aval cmp $bval;
	        } @filtered;
			  last;
		      };
	die "ERROR: unknown sort order '$$opt{sort}'\n";
    }

    # -----------------------------------------------------------
    # issue page top
    # -----------------------------------------------------------
    my $interval =$$cfg{'interval'} ? $$cfg{'interval'} : 5;
    my $expiration = &expistr($interval);
    my $refresh =  $$cfg{'refresh'} ? $$cfg{'refresh'} : 300;
    for ($$opt{show}) {
       $refresh = /^week$/     && 1800
               || /^month$/    && 7200
               || /^year$/     && 86400
               || $refresh ;
    }
    $index = <<ECHO;
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
    <TITLE>$$opt{title}</TITLE>
    <META HTTP-EQUIV="Refresh" CONTENT="$refresh">
    <META HTTP-EQUIV="Cache-Control" content="no-cache">
    <META HTTP-EQUIV="Pragma" CONTENT="no-cache">
    <META HTTP-EQUIV="Expires" CONTENT="$expiration">
ECHO
    $index .= <<ECHO if ($$opt{addhead});
    $$opt{addhead}
ECHO
    $index .= <<ECHO;
</HEAD>

<BODY $$opt{bodyopt}>
ECHO
    $index .= <<ECHO if ($$opt{optlog});
<!-- commandline was: $argz -->
ECHO

    $index .= <<ECHO;

$$opt{pagetop}
$$opt{headon}$$opt{title}$$opt{headoff}

<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=$$opt{cellspacing}>
<TR>
ECHO

    # -----------------------------------------------------------
    # print the graph items
    # -----------------------------------------------------------
    my $itemnr = 0;
    my $first = $order[0];
    foreach my $item (@order) {
    $$opt{prefix} = $$rcfg{prefixes}->{$item} if ($$opt{autoprefix});
	$itemnr++;
	$index .= "<TD>";
        my $dirrel = "../" x ($$rcfg{'directory_web'}{$item} =~ tr|/|/|);

	# --- produce graph section title ---
	my $section;
	for ($$opt{section}) {
	    /^h1$/ &&
	      do{
		  if ($$rcfg{pagetop}{$item} =~ m[<h1[^>+]*>(.+?)</h1]i) {
		      $section = $1;
		      last;
		  } else {
		      die "ERROR: no H1 line pagetop property in $item section\n";
		  }
	      };
	    /^title$/ &&
	      do{
		  $section = $$rcfg{title}{$item}; last
	      };
	    /^name$/ &&
	      do{
		  $section = $item; last
	      };
            /^descr(iption)?$/ &&
              do{
		  $$rcfg{setenv}{$item} =~ /\bMRTG_INT_DESCR="([^"]*)"/;
		  if ($$rcfg{pagetop}{$item} =~ 
		   m,<td>Description:</td>\S*<td>($1)\s*([^<]+)?\s+(?=</td>),i) {
		      $section = $2 || $1;
                      last;
                  } else {
                      die "ERROR: no Description: line PageTop property in $item section\n";
                  }
              };
             /^portname$/ && 
               do{
                 if ($$rcfg{pagetop}{$item} =~
                     m,<TR><TD>Port Name:</TD>\s*<TD>([^<]+)</TD>,i ) {
                      $section = $1;
                      last;
                 } else {
                      die "ERROR: no Port Name: PageTop property in $item section\n"
                 }
               };
            die "ERROR: unknown sectioning type $_\n";
	};
	if (defined $$rcfg{host}{$item} and
		!($section =~ m/\b\Q$$rcfg{host}{$item}\E\b/i)) {
		$section = ucfirst $$rcfg{host}{$item} . ": $section";
	}

	# --- write the actual graph ----
	die "ERROR: Unknown show type $$opt{show}\n"
	  unless $$opt{show} =~ /^day|week|month|year|none$/;

	my $image = "$item-$$opt{show}.${main::GRAPHFMT}"
	 if $$opt{show} ne 'none';

	$index .= "<$$opt{div}>" if (!$$opt{sidebyside});

    if (not $image) {
	    $index .= "$$opt{boldon}".
	          "<A HREF=\"".cleanurl($$opt{prefix}.
		      $$rcfg{directory_web}{$item}).$item.
		      ".$$rcfg{extension}{$item}\">".
		      "$section$$opt{boldoff}</A></$$opt{div}>\n<$$opt{div}>";
	} else {
		#loop used for reversing (text,images) to (images,text) if req.
		for my $picfirstloop (1,0) {
			if ( $picfirstloop^$$opt{picfirst} ) {
				$index .= "$$opt{boldon}$itemnr. $$opt{boldoff}"
	  			  if $$opt{enumerate};
			    if ($$opt{clicktext}) {
			        $index .= "$$opt{boldon}<A HREF=\"".cleanurl($$opt{prefix}.
					  $$rcfg{directory_web}{$item}).$item.
					  ".$$rcfg{extension}{$item}\">";
				$index .= $section;
				$index .= "</A>$$opt{boldoff}";
			    } else {
			    	$index .= "$$opt{boldon}$section$$opt{boldoff}";
			    }
	 	        $index .= "</$$opt{div}>\n<$$opt{div}>" if $picfirstloop;
		    }
		    
		    if ( !($picfirstloop^$$opt{picfirst}) ) {
		    	# figure show name for rrd viewer
			    if ($$cfg{logformat} eq 'rrdtool') {
               my $sep = $$opt{rrdviewer} =~ /\?/ ? '&' : '?'; 
               $index .= "<A HREF=\"$$opt{rrdviewer}".$sep."log=$item\">".
		                          "<IMG BORDER=$$opt{imgborder} ALT=\"$item Traffic Graph\" ".
                         "SRC=\"$$opt{rrdviewer}".$sep."log=$item&png=$$opt{show}.".
					  "s&small=1\"></A>"
			    } else {
				$index .= "<A HREF=\"".cleanurl($$opt{prefix}.
					  $$rcfg{directory_web}{$item}).$item.
					  ".$$rcfg{extension}{$item}\">";
		        	$index .= "<IMG BORDER=$$opt{imgborder} ALT=\"$item Traffic Graph\" ".
					  "SRC=\"".cleanurl($$opt{prefix}.
					  $$rcfg{directory_web}{$item}.$dirrel.
					  $$cfg{imagehtml}.$$rcfg{directory_web}{$item}).
					  "$image\"";
				$index .= ' WIDTH="'.$$opt{width}.'"' 
		                      if defined $$opt{width};
				$index .= ' HEIGHT="'.$$opt{height}.'"'
				      if defined $$opt{height};
				$index .= "></A>";
				$index .= "<BR>"
				      if ( ! defined $$opt{compact} );
				$index .= "\n<SMALL><!--#flastmod file=\"".
					  cleanurl($$opt{prefix}.$$rcfg{directory_web}{$item}).$item.
					  ".$$rcfg{extension}{$item}\" --></SMALL>";
			    }
			    $index .= "</$$opt{div}>\n<$$opt{div}>" if $picfirstloop;
			}
		}
	}

	$index .= "</$$opt{div}>" if (!$$opt{sidebyside});
	$index .= "\n</TD>";

	# --- new table column if necessary ----
	if (($itemnr) % $$opt{columns} == 0) {
	    $index .= "</TR>\n<TR>\n";
	}
    }
    # -----------------------------------------------------------
    # print page end
    # -----------------------------------------------------------

    my $gifPath = '';

    if (defined $$cfg{icondir}) {
        $gifPath = $$cfg{icondir};
        #lets make sure there is a trailing path separator
        $gifPath =~ s|/*$|/|;
    } else {
        $gifPath = "$$cfg{imagehtml}";
    }

    my $VERSION = "2.9.23";
    $index .= <<ECHO;
</TR>
</TABLE>
ECHO

   $index .= <<ECHO if (defined $$opt{pageend});
$$opt{pageend}
ECHO

   $index .= <<ECHO if (!$$opt{nolegend});
<BR>
<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0>
  <TR>
    <TD WIDTH=63><A
    HREF="http://www.ee.ethz.ch/~oetiker/webtools/mrtg/"><IMG
    BORDER=0 SRC="${gifPath}mrtg-l.${main::GRAPHFMT}" WIDTH=63 HEIGHT=25 ALT="MRTG"></A></TD>
    <TD WIDTH=25><A
    HREF="http://www.ee.ethz.ch/~oetiker/webtools/mrtg/"><IMG
    BORDER=0 SRC="${gifPath}mrtg-m.${main::GRAPHFMT}" WIDTH=25 HEIGHT=25 ALT=""></A></TD>
    <TD WIDTH=388><A
    HREF="http://www.ee.ethz.ch/~oetiker/webtools/mrtg/"><IMG
    BORDER=0 SRC="${gifPath}mrtg-r.${main::GRAPHFMT}" WIDTH=388 HEIGHT=25
    ALT="Multi Router Traffic Grapher"></A></TD>
  </TR>
</TABLE>
<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0>
  <TR VALIGN=top>
  <TD WIDTH=88 ALIGN=RIGHT><FONT FACE="Arial,Helvetica" SIZE=2>
  version $VERSION</FONT></TD>
  <TD WIDTH=388 ALIGN=RIGHT><FONT FACE="Arial,Helvetica" SIZE=2>
  <A HREF="http://www.ee.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>
ECHO
   $index .= <<ECHO;
</BODY>
</HTML>
ECHO

    # -----------------------------------------------------------
    # write out the index page
    # -----------------------------------------------------------
    if ($$opt{output}) {
	debug ('base', "Writing $$opt{output}");
	open X, ">$$opt{output}" or die "ERROR: creating $$opt{output}: $!\n";
	print X $index;
	close X;
    } else {
	print $index;
    }

}

sub options ($) {
    my $opt = shift;
    my @options = (
	       'help|?',
	       'man',
	       'output=s',
	       'filter=s@',
          'addhead=s',
	       'title=s',
	       'bodyopt=s',
	       'pagetopend=s',
	       'pagetop=s',
	       'pageend=s',
	       'columns=i',
	       'sort=s',
	       'enumerate',
	       'width=i',
	       'height=i',
	       'show=s',
	       'section=s',
               'version',
	       'prefix=s',
	       'clicktext!',
	       'optlog!',
	       'compact!',
	       'headlevel=i',
	       'bold!',
	       'picfirst!',
	       'sidebyside!',
	       'nolegend',
	       'autoprefix!',
	       'sectionhost!',
	       'rrdviewer=s');

	#generate --option-file from --option
	for ( grep /=s$/,@options ) {
		my $fileopt = $_;
		$fileopt =~ s/=s$/-file=s/;
		push @options, $fileopt;
	}
	
    GetOptions( $opt, @options ) or pod2usage(-verbose => 1);
    
    if ($$opt{prefix}){
	$$opt{prefix} .= '/';
	$$opt{prefix} =~ s|/+$|/|;
    }
    die ("Indexmaker for mrtg-2.9.23\n") if $$opt{version};
    pod2usage(-exitval => 1, -verbose => 2) if $$opt{man};
    pod2usage(-verbose => 1) if not @ARGV;
    
    #take care of --fileoption --> --option
    for my $fileopt ( grep /-file$/, keys %{$opt} ) {
    	my $orgopt = $fileopt;
    	$orgopt =~ s/-file$//;
    	$$opt{$orgopt} = &readfile($$opt{$fileopt});
    }
}

#return the contents of a file
sub readfile(