#!/usr/local/bin/perl -Tw

#  Copyright (c) 2000 River of Stars, LLC.  All rights reserved.
#  
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#  3. All advertising materials mentioning features or use of this software
#     must display the following acknowledgement:
#       This product includes software developed by River of Stars, LLC.
#  4. The name of the author may not be used to endorse or promote products
#     derived from this software without specific prior written permission.
#  
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
#  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
#  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
#  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
#  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
#  NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
#  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
#  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
#  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
#  THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

my $DEBUG = 1;


#####
# heartbeat script
#####


use strict;
use CGI qw/:standard/;
use Sys::Syslog;
use Time::Zone;

BEGIN {
    push(@INC, '/usr/local/libexec/authhb', '/home/rjohnson/hb/');
}
use hbu;


#####
# setup/constants
#####

my @parml = ('key');				# valid parameter list
my $u = "https://$hbu::sip/cgi-bin/hb.pl?key=";	# heartbeat base URL
#my $lo = "https://$hbu::sip/cgi-bin/lo.pl";	# logout URL
my $lo = "https://$hbu::sip/cgi-bin/lo.pl?key=";	# logout URL


#####
# var declarations
#####

my($q, $ip, $er, $nkey, $okey, $kv, $un, $ut);


#####
# prototypes predeclarations to avoid screwing up line number reports
#####

sub nextheartbeat ($$$$);


#####
# main
#####


openlog('webhb-hb', 'pid', 'local6');		# set specialized options for syslog
$q = new CGI;
if ( $ip = $ENV{'REMOTE_ADDR'} ) {
    if ( ! ($ip = ip4v($ip)) ) {		# is ip valid and in allowed subnets?
        $er = keyr ($ip);			# make sure any bogus key & rule goes away
        syslog ('info', 'invalid remote ip %s', $ip);
        failbail ($q, $ip, "invalid remote ip $ip");
    }
} else {
    $ip = '192.168.1.1';			# stub for testing script standalone
}
#syslog ('debug', 'connection from "%s" for hb', $ip);
if ( $er = parmv($q, @parml) ) {		# is someone monkeying with our params?
    $er = keyr ($ip);				# make sure any key & rule goes away
    syslog ('err', 'parameters from %s unrecognized: %s', $ip, $er);
    failbail ($q, $ip, "parameters from $ip unrecognized: $er");
}
$okey = $q->param('key');
($un, $ut, my @trash) = parsekey ($okey);	# pull username & type off front of key
$kv = keyv($ip, $okey);				# does provided key match what's in db?
if ( $kv ne '1' ) {
    $er = keyr ($ip);				# make sure any key & rule goes away
    syslog ('warning', '%s: browser at %s gave nonmatching key "%s" for user "%s"', $kv, $ip, $okey, $un);
#    syslog ('warning|LOG_AUTH', '%s - browser at "%s" gave nonmatching key "%s" for user "%s"', $kv, $ip, $okey, $un);
    failbail ($q, $ip, "$kv: browser at $ip gave nonmatching key \"$okey\" for user \"$un\"");
}
$nkey = keyl($un, $ut, $ip);			# generate and store new key
if ( $nkey =~ m/^ERRKEY/ ) {			# did storage of new key work?
    $er = keyr ($ip);				# make sure any bogus key & rule goes away
    syslog ('err', '%s: new key generation or storage failure for %s', $nkey, $ip);
    failbail ($q, $ip, "$nkey: new key generation or storage failure for $ip");
}

nextheartbeat ($q, $ip, $okey, $nkey);		# no problems, so send new page

closelog ();
exit 0;


sub nextheartbeat ($$$$) {
#####
# spit back next heartbeat
#####
    my $q = shift @_;
    my $ip = shift @_;
    my $okey = shift @_;
    my $nkey = shift @_;
    my ($d, $tz);
    
    $d = scalar localtime ();
    $tz = tz_name ();
    print $q->header(-Refresh=>"$hbu::t; URL=$u$nkey"),
        $q->start_html(-title=>"Heartbeat", -bgcolor=>"white", -text=>"black"),
        $q->h2("Web Heartbeat"),
        $q->p("<font color=\"green\" size=\"+1\"><strong>You must leave this browser window open to remain logged in.</font></strong>"),
        $q->p("When you are done using the wireless network, just"),
#        $q->startform(-method=>"post", -action=>"$lo"),
#        $q->hidden(-name=>"key",-default=>"$nkey",-override=>1),
#        $q->p("<center>"),
#        $q->submit("submit", "Log Off"),
#        $q->p("</center>"),
#        $q->endform,
        $q->p("<center><font size=\"+1\"><a href=\"$lo$nkey\">Log Off</a></font></center>"),
        $q->p("Your browser's last refresh was:"),
        $q->p("<center>$d $tz</center>"),
        $q->p("You can <a href=\"$u$nkey\">manually refresh</a> if your browser missed a beat");
    if ( $DEBUG ) {
        print $q->hr,
            $q->p("Here is some debugging information for the test."),
#            $q->p("The argument list on the previous fetch was"),
#            $q->dump,
    	    $q->p("The old key was recognized as: $okey"),
    	    $q->p("The new key in the db is: $nkey"),
            $q->p("You connected from IP address: $ip"),
            $q->p("The HTTP refresh header on this page tells your browser to fetch <a href=\"$u$nkey\">URL=$u$nkey</a> after $hbu::t seconds.");
    }
    print $q->end_html;
}