# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-06 21:30 (EST)
# Function: web page stuff
#
# $Id: Web.pm,v 1.50 2005/12/11 21:21:52 jaw Exp $

package MonEl;
use strict;

# they could hear Circe within, singing most beautifully as she worked
# at her loom, making a web so fine, so soft, and of such dazzling colours
# as no one but a goddess could weave.
#   -- Homer, Odyssey

sub web_build {
    my $me = shift;
    my $topp = shift;
    my( $h, $file, $fh );

    return undef if $Conf::Config{_test_mode};
    $h = $topp ? 'bldtimetop' : 'bldtime';
    $file = "$::datadir/html/" . $me->filename() . ($topp ? '.top' : '.base');
    return $file if $me->{web}{$h} > $me->{web}{transtime};
    
    $topp = 0 if $me->{web}{alwaysbase};
    $fh   = BaseIO::anon_fh();
    return ::loggit( "Cannot open web file '$file': $!", 0 )
	unless open( $fh, "> $file" ) ;

    $me->web_top($fh, $topp);
    $me->webpage($fh, $topp);	# virt func
    unless( $topp ){
	print $fh "<HR>\n";
	if( $me->{graph} ){
	    $me->web_graphs($fh);
	}
	if( $me->{web}{showstats} && !$me->{nostats} && $me->web_stats($fh) ){
	    print $fh "<HR>\n";
	}
	$me->web_notifs($fh);
	$me->web_logs($fh);
    }
    $me->web_bottom($fh, $topp);
    
    close $fh;
    $me->{web}{$h} = $^T;
    return $file;
	
}

sub web_top {
    my $me = shift;
    my $fh = shift;
    my $topp = shift;
    my( $icon, $n, $file, $wav, $t, $color );
    
    $n = $me->unique();
    $file = $me->filename();
    
    my $refresh = $me->{web}{refresh};
    my $bkgimg  = $me->{web}{bkgimage};
    $bkgimg = "BACKGROUND=\"$bkgimg\"" if $bkgimg;

    print $fh "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
    print $fh "<!-- start of web_top -->\n";
    print $fh "<!-- cachestale: $me->{web}{cachestale} -->\n";
    print $fh "<HTML><HEAD><TITLE>Argus - $n</TITLE>\n";
    print $fh "<META HTTP-EQUIV=\"REFRESH\" CONTENT=\"$refresh\">\n" if $refresh;
    if( $me->{ovstatus} eq 'up' ){
	$icon = $me->{web}{icon_up};
    }elsif( $me->{ovstatus} eq 'down' ){
	$icon = $me->{web}{icon_down};
    }
    $icon ||= $me->{web}{icon};
    print $fh "<LINK REL=\"icon\" HREF=\"$icon\" TYPE=\"image/gif\">\n"
	if $icon;
    if( $me->{web}{style_sheet} ){
	print $fh "<LINK REL=\"stylesheet\" TYPE=\"text/css\" HREF=\"$me->{web}{style_sheet}\">\n";
    }
    print $fh "</HEAD><BODY $bkgimg BGCOLOR=\"#FFFFFF\" ID=\"$file\">\n";
    
    print $fh "<!-- START AUTHORIZATION READ NEEDED $me->{acl_page} -->\n";

    print $fh "<DIV CLASS=HEADER>\n";
    print $fh "$me->{web}{header_all}\n" if $me->{web}{header_all};
    print $fh "$me->{web}{header}\n" if $me->{web}{header};
    print $fh "</DIV>\n";
    
    if( $me->{alarm} ){
	$t = $me->{sirentime};
	$wav = $me->{web}{sirensong};
	if( $wav ){
	    # cgi will do browser detection and re-write this
	    print $fh "<!-- START SIREN $t $wav -->\n";
	}
    }

    print $fh "<TABLE WIDTH=\"95%\" BORDER=1 CLASS=MAIN>\n";
    if( $Conf::has_errors && $topp ){
	print $fh <<X;
        <TR BGCOLOR="#FF8888"><TD COLSPAN=2>
	<TABLE CLASS=WARNING><TR><TD>
	<H2>Warning&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</H2>
	</TD><TD>
	<B>Errors detected during startup</B><BR>
	Attempting to run anyway<BR>
	Examine the <A HREF="__BASEURL__?func=logfile">Error Log</A> for details
	</TD></TR></TABLE>
	</TD></TR>
X
    ;
    }
    
    if( $Conf::has_errors ){
	$color = 'FF8888';
    }else{
	$color = 'AAAAFF';
    }

    my $nospkr = $me->{web}{nospkr_icon};
    $nospkr = "<IMG SRC=\"$nospkr\" ALT=\"speaker off\">" if $nospkr;
    print $fh <<X;
<TR BGCOLOR="#$color"><TD COLSPAN=2>
  <TABLE BORDER=0 WIDTH="100%" CLASS=TOPBAR>
    <TR> <TD ALIGN=LEFT>$n</TD> <TD ALIGN=RIGHT><L10N User>: <TT>__USER__</TT>
	<!-- SIREN ICON -->$nospkr
	</TD> </TR>
  </TABLE>
</TD></TR>      
<TR><TD WIDTH="85%" VALIGN=TOP>
<!-- end of web_top -->
X
    ;
    
}

# I saw by night, and behold a man riding upon a red horse, and
# he stood among the myrtle trees that were in the bottom;
#   -- zechariah 1:8
sub web_bottom {
    my $me = shift;
    my $fh = shift;
    my $topp = shift;
    
    print $fh "<!-- start of web_bottom -->\n</TD><TD WIDTH=\"15%\" VALIGN=TOP>\n";
    $me->web_side_buttons($fh, $topp);
    print $fh "</TD></TR>\n</TABLE>\n";

    print $fh "<DIV CLASS=FOOTER>\n";
    print $fh "$me->{web}{footer}\n" if $me->{web}{footer};
    print $fh "$me->{web}{footer_all}\n" if $me->{web}{footer_all};
    print $fh "</DIV>\n";
    print $fh "<!-- END AUTHORIZATION READ NEEDED -->\n";
    print $fh "<DIV CLASS=FOOTERARGUS>$me->{web}{footer_argus}</DIV>\n"
	if $me->{web}{footer_argus};
    print $fh "</BODY>\n";
    print $fh "<!-- end of web_bottom -->\n";
    print $fh "</HTML>\n";
}

# I must remove Some thousands of these logs and pile them up
#   -- Shakespeare, Tempest
sub web_logs {
    my $me = shift;
    my $fh = shift;

    return undef unless $me->{stats}{log} && @{$me->{stats}{log}};
    print $fh "<!-- start of web_logs -->\n";
    print $fh "<TABLE CLASS=LOGS>\n";
    foreach my $l ( reverse @{$me->{stats}{log}} ){
	# [time, status, ovstatus, tag, msg]
	my $st = $l->[2];
	print $fh "<TR><TD ALIGN=RIGHT><LOCALTIME $l->[0]> ", 
	    "</TD><TD> <L10N $st> </TD><TD> $l->[3] - $l->[4]</TD></TR>\n";

    }
    print $fh "</TABLE>\n";
    print $fh "<!-- end of web_logs -->\n";
    1;
}

sub percent {
    my $n = shift;
    my $d = shift;
    my( $x, $y );
    
    return "0.00" unless $d;
    $x = 100 * $n/$d;
    return "100.0" if $x == 100;
    if( $x > 99.99 && $x < 100.0 ){
	sprintf "%.4f", $x;
    }else{
	sprintf "%.2f", $x;
    }
}

sub elapsed {
    my $e = shift;
    my( $r, @e );

    @e = gmtime($e);
    $e[5] -= 70;
    $e[3] --;
    $e[4] += 12 * $e[5];
    
    $r = sprintf " %dm %dd %d:%0.2d:%0.2d", @e[4,3,2,1,0];
    $r =~ s/ 0[md]//g;
    $r =~ s/^\s+//;
    $r;
}
    
sub web_stat_line {
    my $me = shift;
    my $fh = shift;
    my $label = shift;
    my $set   = shift;
    my $n     = shift;
    my( $x, $e, $color );

    $x = $me->{stats}{$set}[$n];
    return unless $x;
    $e = $x->{elapsed};
    $color = $n ? '' : ' BGCOLOR="#AAAAFF"';
    
    print $fh "<TR$color><TD><L10N $label> </TD><TD ALIGN=RIGHT>&nbsp; <LOCALTIME $x->{start}>",
    	"</TD><TD ALIGN=RIGHT> ",
    elapsed($x->{elapsed}), " </TD><TD ALIGN=RIGHT>&nbsp; ", percent($x->{up}, $e),
    "</TD><TD ALIGN=RIGHT>&nbsp; ", percent($x->{down}, $e),
    "</TD><TD ALIGN=RIGHT> $x->{ndown}</TD></TR>\n";

}

sub web_stats {
    my $me = shift;
    my $fh = shift;
    
    print $fh "<!-- start of web_stats -->\n";

    print $fh "<B><L10N Status>: <L10N $me->{status} since> <LOCALTIME $me->{transtime}></B><BR>\n";
    print $fh "<TABLE BORDER=0 CELLSPACING=0 CLASS=STATS>\n";
    print $fh "<TR><TH>&nbsp;</TH><TH><L10N start></TH><TH><L10N elapsed time></TH>",
    "<TH>% <L10N up></TH><TH>% <L10N down></TH><TH><L10N times down></TH></TR>\n";
    
    $me->web_stat_line($fh, 'Today', 'daily', 0);
    $me->web_stat_line($fh, 'Yesterday', 'daily', 1);
    $me->web_stat_line($fh, '2 Days Ago', 'daily', 2);

    $me->web_stat_line($fh, 'This Month', 'monthly', 0);
    $me->web_stat_line($fh, 'Last Month', 'monthly', 1);
    $me->web_stat_line($fh, '2 Months Ago', 'monthly', 2);

    $me->web_stat_line($fh, 'This Year', 'yearly', 0);
    $me->web_stat_line($fh, 'Last Year', 'yearly', 1);
    $me->web_stat_line($fh, '2 Years Ago', 'yearly', 2);
    print $fh "</TABLE>\n";

    print $fh "<!-- end of web_stats -->\n";
    1;
}

sub web_override {
    my $me = shift;
    my $fh = shift;
    
    return unless $me->{override};
    print $fh "<!-- start of web_override -->\n";
    print $fh "<HR>\n<B><L10N Override></B>\n<TABLE CLASS=OVERRIDE>\n";
    foreach my $k (qw(user time expires mode ticket text)){
	my $v = $me->{override}{$k};
	next unless $v;
	$v = "<LOCALTIME $v>" if( $k eq 'time' || $k eq 'expires' );
	if( $k eq 'ticket' && $me->can('tkt_web_value') ){
	    $v = $me->tkt_web_value($v);
	}
	print $fh "<TR><TD>&nbsp;</TD><TD><L10N $k></TD><TD>$v</TD></TR>\n";
    }
	
    
    print $fh "</TABLE>\n";
    print $fh "<!-- end of web_override -->\n";
}

sub web_button {
    my $me    = shift;
    my $label = shift;
    my $color = shift || 'DDDDDD';
    my $link  = $me->url(@_);

    web_button_text( "<A HREF=\"$link\"><L10N $label></A>", $color )
}

sub web_button_no {
    my $me    = shift;
    my $label = shift;
    my $color = shift || 'DDDDDD';
    my $link  = join( ';', @_ );

    $link = '__BASEURL__' . ($link ? '?' : '') . $link;
    web_button_text( "<A HREF=\"$link\"><L10N $label></A>", $color )
}

sub web_button_text {
    my $txt   = shift;
    my $color = shift || 'DDDDDD';
    
    "<TABLE BORDER=1 WIDTH=\"100%\"><TR><TD CLASS=BUTTON ALIGN=CENTER BGCOLOR=\"#$color\">".
    "$txt</TD></TR></TABLE>\n";
}

sub web_side_buttons {
    my $me = shift;
    my $fh = shift;
    my $topp = shift || 0;

    print $fh $me->{web}{buttons_top_html}, "\n" if $me->{web}{buttons_top_html};
    
    unless( $topp ){
	if( $me->{overridable} ){
	    print $fh "<!-- START AUTHORIZATION RW NEEDED $me->{acl_override} -->\n";
	    if( $me->{override} ){
		print $fh $me->web_button('Remove Override', undef, 'func=rmoverride');
	    }else{
		print $fh $me->web_button('Override', undef, 'func=override');
	    }
	    print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";
	}
	
	print $fh "<!-- START AUTHORIZATION RW NEEDED $me->{acl_annotate} -->\n";
	if( $me->{annotation} ){
	    print $fh $me->web_button('Remove Annotation', undef, 'func=rmannotate');
	}else{
	    print $fh $me->web_button('Annotate', undef, 'func=annotate');
	}
	print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";
	
	print $fh "<!-- START AUTHORIZATION RW NEEDED $me->{acl_flush} -->\n";
	print $fh $me->web_button('Flush Cache', undef, 'func=flushcache');
	print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";
	
	print $fh "<!-- START AUTHORIZATION RW NEEDED $me->{acl_checknow} -->\n";
	print $fh $me->web_button('Check Now', undef, 'func=checknow');
	print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";
    }
    print $fh "<!-- START AUTHORIZATION RW NEEDED $me->{acl_getconf} -->\n";
    print $fh $me->web_button('Display Config', undef, 'func=dispconf');
    print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";
    
    print $fh "<!-- START AUTHORIZATION DEBUG NEEDED $me->{acl_about} -->\n";
    print $fh $me->web_button('Debugging', undef, 'func=about');
    print $fh "<!-- END AUTHORIZATION DEBUG NEEDED -->\n";

    # paging...
    print $fh "<!-- START AUTHORIZATION RW NEEDED $me->{acl_ntfylist} -->\n";
    print $fh $me->web_button_no('Un-Acked Notifies', undef, 'func=ntfylsua');
    print $fh $me->web_button_no('Notifies', undef, 'func=ntfylist');
    print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";

    # error log
    print $fh "<!-- START AUTHORIZATION RW NEEDED $me->{acl_logfile} -->\n";
    print $fh $me->web_button_no('Error Log',
				 $Conf::has_errors ? 'FF8888' : undef,
				 'func=logfile',
				 );
    print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";

    if( $me->{alarm} && $Conf::Config{sirensong} ){
	my $t = $me->{sirentime};
	print $fh "<!-- START SIRENBUTTON $t -->\n";
	if( $topp ){
	    print $fh $me->web_button('Hush Siren', undef, 'func=hushsiren', 'top=1');
	}else{
	    print $fh $me->web_button('Hush Siren', undef, 'func=hushsiren');
	}
	print $fh "<!-- END SIRENBUTTON -->\n";
    }
    
    # Top
    print $fh "<BR>\n";
    print $fh web_button_text( "<A HREF=\"__BASEURL__?object=__TOP__;func=page\">Top</A>" )
	unless $topp;

    # parents
    foreach my $p (@{$me->{parents}}){
	unless( $p->{name} eq 'Top' ){
	    print $fh "<!-- START AUTHORIZATION RW NEEDED $p->{acl_page} -->\n";
	    print $fh $p->web_button( $p->{name}, undef, 'func=page' );
	    print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";
	}
    }

    print $fh "<BR>\n";

# RSN - web based configurator
#    print $fh "<!-- START AUTHORIZATION CONF NEEDED $me->{acl_conf} -->\n";
#    print $fh $me->web_button('Add Data',    undef, 'func=adddata');
#    print $fh $me->web_button('Add Group',   undef, 'func=addgrp')  if $me->{type} =~ /Group|Host/;
#    print $fh $me->web_button('Add Service', undef, 'func=addsrvc') if $me->{type} =~ /Group|Host/;
#    print $fh "<!-- END AUTHORIZATION CONF NEEDED -->\n";
    
    print $fh $me->{web}{buttons_bottom_html}, "\n" if $me->{web}{buttons_bottom_html};

    # logout
    print $fh $me->web_button('Logout', undef, 'func=logout');

    
}

sub web_page_row_top {
    my $me = shift;
    my $fh = shift;
    my $label = shift;
    my( %cs, $csv );

    return if $me->{web}{hidden};
    return unless @{$me->{children}};
    print $fh "<TR><TD><A HREF=\"", $me->url('func=page'), "\">",
        ($label||$me->{label_left}||$me->{name}), "</A></TD>";

    for my $c (@{$me->{children}}){
	my $cc = $c;
	$cc = $c->aliaslookup() if $c->can('aliaslookup');

	if( $cc->{countstop} ){
	    $cs{ $cc->{ovstatus} } ++;
	    next;
	}

	if( ! @{$cc->{children}} ){
	    $cs{ $cc->{ovstatus} } ++;
	    next;
	}
	
	if( $cc->{override} ){
	    $cs{override} += @{$cc->{children}};
	    next;
	}
	
	# what severity are down items?
	$csv = $cc->{currseverity} if $cc->{ovstatus} eq 'down' &&
	    $MonEl::severity_sort{$cc->{currseverity}} > $MonEl::severity_sort{$csv};

	foreach my $gc ( @{$cc->{children}} ){
	    my $gcc = $gc;
	    $gcc = $gc->aliaslookup() if $gc->can('aliaslookup');
	    $cs{ $gcc->{ovstatus} } ++;
	}
    }
    foreach my $s ('up', 'down', 'override'){
	my $color = $cs{$s} ? (" BGCOLOR=\"" . MonEl::web_color($s, $csv) . "\"" ) : '';
	print $fh "<TD WIDTH=\"25%\" ALIGN=RIGHT$color>", ($cs{$s}||0), "</TD>";
    }
    print $fh "</TR>\n";
}

sub web_notifs {
    my $me = shift;
    my $fh = shift;

    return unless $me->{notify}{list} && @{$me->{notify}{list}};
    return unless $me->{web}{shownotiflist};
    print $fh "<!-- start of web_notifs -->\n";
    print $fh "<!-- START AUTHORIZATION RW NEEDED $me->{acl_ntfydetail} -->\n";
    print $fh "<B><L10N Notifications>:</B> \n";
    foreach my $n ( @{$me->{notify}{list}} ){
	my $link = "__BASEURL__?func=ntfydetail;idno=$n->{idno}";
	my $color = web_color( $n->{objstate}, $n->{severity} );
	print $fh "<A HREF=\"$link\"><FONT COLOR=$color>$n->{idno}</FONT></A>\n";
    }
    print $fh "<BR>\n<HR>\n";
    print $fh "<!-- END AUTHORIZATION RW NEEDED -->\n";
    print $fh "<!-- end of web_notifs -->\n";

}

sub web_graphs {
    my $me = shift;
    my $fh = shift;
    my( $n );
    
    return unless $::HAVE_GD;
    return unless $me->{graph};
    return if $Conf::Config{_no_images};

    print $fh "<!-- start of web_graphs -->\n";
    print $fh "<CENTER><TABLE BORDER=0 CLASS=GRAPHS><TR>\n";
    for my $w (qw(samples hours days)){
	$n++;
	next unless $me->{image}{whichgraphs} =~ /$n/;
	my $url = $me->url('func=graph', "which=$w", 'size=thumb', 'ext=.png');
	my $big = $me->url('func=graphpage', "which=$w", 'size=full' );
	print $fh "\t<TD><A HREF=\"$big\"><IMG HEIGHT=64 WIDTH=160 BORDER=0 ",
	"SRC=\"$url\" ALT=\"graph\"></A><BR><CENTER><L10N $w></CENTER></TD>\n";
    }
    print $fh "</TR></TABLE></CENTER>\n";
    print $fh "<HR>\n";
    print $fh "<!-- end of web_graphs -->\n";
}

################################################################

# Downward the various goddess took her flight, 
# And drew a thousand colors from the light; 
#   -- Virgil, Aeneid
sub web_color {
    my $st = shift;
    my $sv = shift() || 'critical';

    if( $st eq 'down' ){
	{ clear    => '#24C926', # green
	  warning  => '#2424FF', # blue
	  minor    => '#EEEE00', # yellow
	  major    => '#FFA500', # orange
	  critical => '#FF0012', # red
      }->{$sv};
    }else{
	{ up       => '#24C926', # green
	  down     => '#FF0012', # red
	  override => '#DDDDDD', # gray
	  depends  => '#FFA500', # orange,  or '#EEEE00', yellow(ish)
      }->{$st};
    }
}
      

################################################################

sub cmd_webpage {
    my $ctl = shift;
    my $param = shift;
    my( $x, $f );
    
    $x = $MonEl::byname{ $param->{object} };
    if( $x ){
	$f = $x->web_build( ($param->{top} eq 'yes')? 1 : 0 );
	$ctl->ok();
	$ctl->write( "file: $f\n" );
	$ctl->write("\n");
    }else{
	::loggit( "object not found: $param->{object}", 0 );
        $ctl->bummer(404, 'Object Not Found');
    }
}

# This was what she said, and we assented; whereon we could see her
# working on her great web all day long, but at night she would unpick
# the stitches again by torchlight.
#   -- Homer, Odyssey
sub cmd_flushpage {
    my $ctl = shift;
    my $param = shift;
    my( $x );

    $x = $MonEl::byname{ $param->{object} };
    if( $x ){
	$x->{web}{transtime} = $^T;
	$ctl->ok_n();
    }else{
        $ctl->bummer(404, 'Object Not Found');
    }
}

# spit out data used on login webpage
sub cmd_logindata {
    my $ctl = shift;
    
    my $x = $MonEl::byname{Top};
    $ctl->ok();
    $ctl->write( "header: ". encode("$x->{web}{header_all}") . "\n");
    $ctl->write( "footer: ". encode("$x->{web}{footer_all} " .
					  "$x->{web}{footer_argus}") . "\n");
    $ctl->write( "bkgimg: ". encode($x->{web}{bkgimage}) . "\n");
    $ctl->write( "style_sheet: ". encode($x->{web}{style_sheet}) . "\n");
    $ctl->write( "icon: ". encode($x->{web}{icon}) . "\n");
    $ctl->final();
}



################################################################
Control::command_install( 'webpage',   \&cmd_webpage,   "build webpage for object",        "object top" );
Control::command_install( 'flushpage', \&cmd_flushpage, "force cached data to be flushed", "object" );
Control::command_install( 'logindata', \&cmd_logindata, 'return decorations for login page' );


1;

