#!/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;

#####
# username script
#####


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

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


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

my @parml = ('un', 'ut');			# valid parameter list
my $pw = "https://$hbu::sip/cgi-bin/pw.pl";	# password response URL


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

my($q, $ip, $er, $key, $okey, $un, $ut, $oun, $out, $js, $sec, $now, $chal, $chalstr);


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

sub passwordreq ($$$);


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


openlog('webhb-un', '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?
        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 ('info|LOG_AUTH', 'connection from "%s" for un', $ip);
syslog ('info', 'connection from %s for un', $ip);
if ( $er = parmv($q, @parml) ) {		# is someone monkeying with our params?
    syslog ('err', 'parameters from %s unrecognized: %s', $ip, $er);
    failbail ($q, $ip, "parameters from $ip unrecognized: $er");
}
if ( $q->param('un') ) {
    $un = $q->param('un');
} else {
    $un = '';
}
if ( $q->param('ut') ) {
    $ut = $q->param('ut');
} else {
    $ut = '';
}
unless ( ($ut eq 'stu') || ($ut eq 'ltu') ) {	# user types are constrained
#    syslog ('info|LOG_AUTH', 'improper user type "%s" for username "%s"', $ut, $un);
    syslog ('info', 'improper user type "%s" for username "%s"', $ut, $un);
    failbail ($q, $ip, "improper user type \"$ut\" for username \"$un\"");
}

#syslog ('info|LOG_AUTH', 'authentication attempt by "%s" on %s', $un, $ip);
syslog ('info', 'authentication attempt by "%s" on %s', $un, $ip);
$okey = keyg ($ip);				# read any old key present
if ( ! ($okey =~ m/ERRKEY/) ) {			# hmm, no error, so key was present
    ($oun, $out, my $rn, $js, my @tr) = parsekey ($okey);
    $sec = secjul ($js);
    $now = time();
    if ( $now < $sec ) {			# correct for midnight passage?
    	$now += 86400;
    }
    if ( ($now - $sec) < $hbu::reapt ) {	# is that old key still fresh?
        if ( $un ne $oun ) {			# is the same user stomping on someone?
#            syslog ('warning|LOG_AUTH', '\"%s\" from %s stomping on \"%s\" active less than %s seconds ago', $un, $oun, $ip);
            syslog ('warning', '\"%s\" from %s stomping on \"%s\" active less than %s seconds ago', $un, $ip, $oun, $hbu::reapt);
            failbail ($q, $ip, "$ip is in use by another username");
        }
    }
}
$key = keyl($un, $ut, $ip);			# generate and store new key
if ( $key =~ m/^ERRKEY/ ) {			# did storage of new key work?
    syslog ('err', '%s: new key generation or storage failure for %s', $key, $ip);
    failbail ($q, $ip, "$key: new key generation or storage failure for $ip");
}

# use the users type and name to come up with challenge
$chal = 'Password';				# stub:  assume simple password for now
if ( $chal eq 'Password' || $chal eq 'password' || $chal eq 'passwd' ) {
    $chalstr = $chal . ": ";
} else {
    $chalstr = "Challenge: " . $chal . "<br>Response: ";
}

passwordreq ($q, $key, $chalstr);			# no problems, so ask for pw

closelog ();
exit 0;


sub passwordreq ($$$) {
#####
# next page: password
#####
    my $q = shift @_;
    my $key = shift @_;
    my $chalstr = shift @_;
    
    print $q->header(-Refresh=>"$hbu::w; URL=$hbu::e"),
        $q->start_html(-title=>"Logging in as $un", -bgcolor=>"white", -text=>"black"),
        $q->h2("Logging in as <em>$un</em>"),
#        $q->startform(-method=>"post", -action=>"$pw", -target=>"heartbeat"),
        $q->startform(-method=>"post", -action=>"$pw"),
        $q->hidden(-name=>"key",-default=>"$key",-override=>1),
        $q->p("Username: <font size=\"+1\"><em>$un</em></font>"),
        $q->p("$chalstr"),
        $q->password_field(-name=>'pw',-default=>"",-size=>60,-maxlength=>60,-override=>1),
        $q->p("<center>"),
        $q->submit("submit", "Log In Now"),
        $q->p("</center>"),
        $q->endform;
        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 username was recognized as: $un"),
                $q->p("The usertype was recognized as: $ut"),
                $q->p("You connected from IP address: $ip"),
                $q->p("The HTTP refresh header on this page tells your browser to fetch <a href=\"$hbu::e\">URL=$hbu::e</a> after $hbu::w seconds.");
        }
    print $q->end_html;
}


# javaschist for resizing the new window
#<SCRIPT>
#function openTarget (form, features, windowName) {
#    if (!windowName)
#        windowName = 'formTarget' + (new Date().getTime());
#    form.target = windowName;
#    open ('', windowName, features);
#}
#</SCRIPT>
#<FORM ACTION="$pw"
#    ONSUBMIT="openTarget
#    (this, 'width=300,height=300,resizable=1,scrollbars=1'); return true;"
#>