# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-02 23:39 (EST)
# Function: misc web stuff
#
# $Id: web_misc.pl,v 1.21 2005/01/30 20:37:31 jaw Exp $

package Argus::Web;

sub web_error {
    my $me = shift;
    my( $file );

    $file = $me->{q}->path_info();
    $me->error("Method Not Implemented<BR>Cannot Access $file");
}

sub httpheader {
    my $me = shift;

    my @a;
    
    if( $me->{co} ){
	@a = ( -cookie => $me->makecookie() );
    }
    if( $me->{charset} ){
	push @a, -charset => $me->{charset};
    }

    print $me->{q}->header( @a );
    $me->{header} = 1;
}

sub startpage {
    my $me        = shift;
    my $title     = shift;
    my $refresh   = shift;
    my $bkgimg    = shift;
    my $style     = shift;
    my $icon      = shift;
    
    $me->httpheader();
    print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
    print "<HTML><HEAD><TITLE>$title</TITLE>\n";
    print "<META HTTP-EQUIV=\"REFRESH\" CONTENT=\"$refresh\">\n" if $refresh;
    print "<LINK REL=\"icon\" HREF=\"$icon\" TYPE=\"image/gif\">\n" if $icon;
    print "<LINK REL=\"stylesheet\" TYPE=\"text/css\" HREF=\"$style\">\n" if $style;

    print "</HEAD><BODY BGCOLOR=\"#FFFFFF\" ", ($bkgimg ? "BACKGROUND=\"$bkgimg\"" : ''), ">\n";
    $me->header();
}

sub endpage {
    my $me = shift;
    
    $me->footer();
    print $me->{q}->end_html;
}

sub error {
    my $me  = shift;
    my $msg = shift;
    my $faq = shift;
    my $a;

    $a = "<A HREF=\"$ARGUS_URL/faq.html#$faq\"><I>please explain</I></A>"
	if $faq;
    
    $me->startpage("ERROR", 60) unless $me->{header};
    print <<EOW;
    <TABLE BORDER=1 BGCOLOR="#FF8888" WIDTH="95%"><TR><TD>
    <TABLE><TR><TD>
    <H2>ERROR&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</H2>
    $a
    </TD><TD>
    $msg
    </TD></TR></TABLE>
    </TD></TR></TABLE>
EOW
    ;
    $me->endpage();
    my $obj = $me->{q}->param('object');
    print STDERR "[$$] ($me->{auth}{user} $obj) ERROR: $msg\n";
    die;
}

sub warning {
    my $me  = shift;
    my $msg = shift;
    my $faq = shift;
    my( $a, $url );

    $a = "<A HREF=\"$ARGUS_URL/faq.html#$faq\"><I>please explain</I></A>"
	if $faq;
    $url = $me->{q}->url() . "?func=logfile";
    print <<X;
    <TABLE BORDER=1 BGCOLOR="#FF8888" WIDTH="95%"><TR><TD>
    <TABLE><TR><TD>
    <H2>Warning&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</H2>
    $a
    </TD><TD>
    $msg
    <P>Examine the <A HREF="$url">Error Log</A> for details
    </TD></TR></TABLE>
    </TD></TR></TABLE>
X
    ;
}

sub header {}
sub footer {}

sub makecookie {
    my $me = shift;

    $me->{q}->cookie(-name    => $COOKIENAME,
                     -value   => $me->{co},
                     -expires => '+1M',
                     );
}

# this is needed to avoid problem with IE and redirecting from a POST
sub heavy_redirect {
    my $me  = shift;
    my $url = shift;

    $me->httpheader();
    print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
    print "<HTML><HEAD><TITLE>Redirecting...</TITLE>\n";
    print "<META HTTP-EQUIV=\"REFRESH\" CONTENT=\"0; URL=$url\">\n";
    print "</HEAD><BODY BGCOLOR=\"#FFFFFF\">\n";
#     print "<I>Redirecting to <A HREF=$url>Next Page</A></I>...\n";
    print "</BODY></HTML>\n";
    $me->{header} = 1;
}

sub light_redirect {
    my $me  = shift;
    my $url = shift;

    return $me->heavy_redirect( $url ) if $me->{co};
    
    print $me->{q}->redirect( $url );
    $me->{header} = 1;
}

my $warned_about_random = 0;
sub new_cookie {
    my( $c, $buf, $v, $x );
    my @set = ('A'..'Z', 'a'..'z', '0'..'9', '_', '.');
    # split('', '.:,/+=-_%@'));

    if( open( DEVRND, "/dev/urandom" ) ){
	foreach (1..64){
	    sysread( DEVRND, $buf, 1 );
	    $v = ord($buf);
	    $x ^= ($v & ~63) >> (rand(7)+1);
	    $c .= $set[ ($x ^ ord($buf)) & 63 ];
	}
	close DEVRND;
    }else{
	print STDERR "WARNING: could not open /dev/urandom ($!) - using potentially unsafe random numbers\n"
	    unless $warned_about_random;
	$warned_about_random = 1;
	$c = sprintf "%08X%08X%08X%08X", rand(0xFFFFFFFF), $$, rand(0xFFFFFFFF), time();
    }
    $c;
}

1;

