#!/usr/bin/perl
#  Copyright 2001-2022 Leslie Richardson

#  This file is part of Open Admin for Schools.

#  Open Admin for Schools is free software; you can redistribute it 
#  and/or modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2 of 
#  the License, or (at your option) any later version.


my %lex = ('Password' => 'Password',
	   'Duration' => 'Duration',
	   'Login' => 'Login',
	   'Log In' => 'Log In',
	   'Log Out' => 'Log Out',
	   'min' => 'min',
	   'Incorrect Password' => 'Incorrect Password',
	   'Logged In' => 'Logged In',
	   'Error' => 'Error',
	   'Continue' => 'Continue',
	   'User' => 'User',
	   'Parent' => 'Parent',
	   'Student' => 'Student',
	   'Student Number' => 'Student Number',
	   'Not Found' => 'Not Found',
	   'Main' => 'Main',
	   'Out of Range' => 'Out of Range',

	   );

my $self = 'plogin.pl';

use DBI;
use CGI;
use CGI::Session;

my $q = CGI->new;
my %arr = $q->Vars;


eval require "../etc/admin.conf";
if ( $@ ) {
    print $lex{Error}. ": $@<br>\n";
    die $lex{Error}. ": $@\n";
}

my $dsn = "DBI:$dbtype:dbname=$dbase";
my $dbh = DBI->connect($dsn,$user,$password);
$dbh->{mysql_enable_utf8} = 1;

# print $q->header( -charset, $charset );
# foreach my $key ( sort keys %arr ) { print "K:$key V:$arr{$key}<br>\n"; }

my $title = "$lex{Parent}/$lex{Student} $lex{'Log In'}";

if ( not $arr{page} or $arr{page} == -1 ) {
    print $q->header( -charset, $charset );
    printHTMLHeader();
    showStartPage();

} elsif ( $arr{page} == 1 ) { 
    delete $arr{page};
    doLogin();

} elsif ( $arr{page} == 2 ) {
    delete $arr{page};
    doLogout();
} 


#----------------
sub showStartPage {
#----------------

    print qq{<h3>$title</h3>\n};

    print qq{<form action="$self" method="post">\n};
    print qq{<input type="hidden" name="page" value="1">\n};

    if ( $arr{script} ) {
	print qq{<input type="hidden" name="script" value="$arr{script}">\n};
    }

    print qq{<table cellpadding="6" cellspacing="0" border="1">\n};
    print qq{<tr><th colspan="2"> </th></tr>\n};

    print qq{<tr><td class="bra">$lex{'Student Number'}</td>\n};
    print qq{<td><input type="text" name="userid" size="10" value="$arr{user}"></td></tr>\n};

    print qq{<tr><td class="bra">$lex{Password}</td>\n};
    print qq{<td><input type="password" name="password" size="10"></td></tr>\n};

    print qq{<tr><td class="bra">$lex{Duration}</td>\n};
    print qq{<td><input type="text" name="duration" size="3" value="20"> $lex{min}</td></tr>\n};

    print qq{<tr><td class="cn" colspan="2">\n};
    print qq{<input type="submit" value="$lex{Login}"></td></tr>\n};

    print qq{</table></form></body></html>\n};

    exit;

}



#-----------
sub doLogout {
#-----------

    # $dbtype set in admin.conf
    my $session = new CGI::Session("driver:$dbtype;serializer:FreezeThaw",
				undef,{Handle => $dbh}) or die CGI::Session->errstr;
    $session->delete;
    $session->flush;
    print $q->header( -charset, $charset );
    printHTMLHeader();
    print qq{<h3>$lex{User}: $arr{user} -  $lex{'Log Out'}</h3>\n};

    # print qq{<p><form><input type="hidden" name="none">\n};
    # print qq{<input type="button" value="Close" };
    # print qq{onClick="parent.close()"></form></p>};

    print qq{</body></html>\n};

    exit;

}


#----------
sub doLogin {
#----------

    # print $q->header( -charset, $charset );
    # foreach my $key ( sort keys %arr) { print qq{K:$key V:$arr{$key}<br>\n}; }

    # Remove passed script name from hash
    my $script = $arr{script};
    delete $arr{script};

    # Strip values from entries
    foreach $key (keys %arr){
#	$arr{$key} =~ s/'/''/g; # strip single quotes
	$arr{$key} =~ s/;//g;   # strip semicolons
	$arr{$key} =~ s/\s+//g; # strip spaces
    }


    # Check length of entered values...
    my $maxpwdlength = $g_studentpwd_maxlen;
      
    unless ( $arr{password} =~ m/^[a-zA-Z0-9]{3,10}$/ ) {
	print $q->header( -charset, $charset );
	printHTMLHeader();
	print qq{<h1>Password can only contain from 3 to 10 letters };
	print qq{and/or numbers! $arr{password}</h1>\n};
	print qq{</body></html>\n};
	exit "Password entry failure";
    }

    if ( length( $arr{password}) > $maxpwdlength ) {
	print $q->header( -charset, $charset );
	print qq{<h1>$lex{Error}: $arr{password} $lex{'Out of Range'}</h1>\n};
	print qq{</body></html>\n};
	exit;
    }


    # Check that userid/studnum is a digit and between 2 and 10 characters.
    unless ( $arr{userid} =~ m/^\d{2,10}$/ ) {
	print $q->header( -charset, $charset );
	printHTMLHeader();
	print qq{<h1>$lex{Error}: Student Number can only contain from 2 to 10 digits: $arr{userid}</h1>\n};
	print qq{</body></html>\n};
	exit;
    }


    # Check Student Number Range.
    my $sth = $dbh->prepare("select min(studnum), max(studnum) from student");
    $sth->execute;
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my ( $minStudnum, $maxStudnum ) = $sth->fetchrow;

    if ( $arr{userid} > $maxStudnum or $arr{userid} < $minStudnum ) {
	print $q->header( -charset, $charset );
	printHTMLHeader();
	print qq{<h1>$lex{Error}: $arr{userid} $lex{'Out of Range'}</h1>\n};
	print qq{</body></html>\n};
	exit;
    }


    # strip any spaces at start and end of password.
    $arr{password} =~ s/^\s+//;
    $arr{password} =~ s/\s+$//;

    #print qq{Student Number: $arr{userid}<br>\n};
    #print qq{Password: $arr{password}<br>\n};


    my $session = new CGI::Session("driver:$dbtype;serializer:FreezeThaw",
				undef,{Handle => $dbh}) or die CGI::Session->errstr;


    # Check password/userid against database (-1 no user, -2 wrong password;
    my $error = checkPassword($arr{userid}, $arr{password});

    if ($error == -1){
	print $q->header( -charset, $charset );
	printHTMLHeader();
	print qq{<h3>$lex{'Student Number'} $lex{'Not Found'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }
    if ($error == -2){ 
	print $q->header( -charset, $charset );
	printHTMLHeader();
	print qq{<h3>$lex{'Incorrect Password'}</h3>\n};
	print qq{</body></html>\n};
	exit;
    }

    my $cookietime = checkCookieTime($arr{duration});

    # Set values for userid, logged_in and duration in session
    $session->param('logged_in','1');
    $session->expire('logged_in',$cookietime);
    $session->param('userid',$arr{userid});
    $session->param('duration', $cookietime ); # was $arr{duration}
    # The duration value in the session has cookie markup: +20m format.

    # Now print page header...
    print $session->header( -charset, $charset );
    
    printHTMLHeader();
    print qq{<h3>$title</h3>\n};

    my $sth = $dbh->prepare("select firstname, lastname from studentall 
     where studnum = ?");
    $sth->execute($arr{userid});
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my ($firstname, $lastname) = $sth->fetchrow;

    
    print qq{<p>$firstname $lastname<br>$lex{'Logged In'}</p>\n};

    if ( $arr{script} ) {
	print qq{<form action="$arr{script}" method="post">\n};
	print qq{<input type="submit" value="$lex{Continue}">\n};
	print qq{</form>};

    } else {
	# Disable Print Close Form button
	# print qq{<p><form><input type="hidden" name="none">\n};
	# print qq{<input type="button" value="Close" };
	# print qq{onClick="parent.close()"></form></p>};
    }


    print qq{</body></html>\n};

    exit; 

}


#----------------
sub checkPassword {
#----------------

    my ($userid, $password) = @_;
    
    if (not $userid){ return -1;}
    if (not $password){ return -2;}

    # Sanitize 
    unless ( $password =~ m#^([\w\d.-@_+]+)$# ) {
      return -2;
    }
    $password = $1;

    #check for presence of userid
    my $sth = $dbh->prepare("select count(*) from student 
     where studnum = ?");
    $sth->execute( $userid );
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my $count = $sth->fetchrow;
    if ( $count < 1 ) { return -1;} # no userid

    #check for presence of correct password and userid
    my $sth = $dbh->prepare("select count(*) from student 
     where studnum = ? and password = ?");
    $sth->execute($userid, $password);
    if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; }
    my $count = $sth->fetchrow;
    if ($count < 1){ return -2;} # not correct password

    return 0; # if all ok...

}


#------------------
sub checkCookieTime {
#------------------

    # defaults
    $defaulttime = 20; # minutes
    $minimumtime = 3; # minutes
    $maximumtime = 60;

    my ($duration) = @_;

    if ($duration) { 
	$cookietime = $duration;
    } else { 
	$cookietime = $defaulttime;
    }

    $cookietime = $minimumtime if $cookietime < $minimumtime; 
    $cookietime = $maximumtime if $cookietime > $maximumtime; 
    $cookietime = "+".$cookietime."m"; # set format
    
    return $cookietime;

}

#------------------
sub printHTMLHeader {
#------------------

    # Print Page Heading
    print qq{$doctype\n<html><head><title>$title</title>\n};
    print qq{<meta name="viewport" content="width=device-width, initial-scale=1.0">\n};
    print qq{<link rel="stylesheet" href="$parcss" type="text/css">\n};
    if ( $arr{user} ) { # if user, jump to the password field.
	print qq{</head><body onload="document.forms[0].elements[2].focus()" style="padding:1em;">\n};
    } else {
	print qq{</head><body onload="document.forms[0].elements[1].focus()" style="padding:1em;">\n};
    }
    print qq{<p>[ <a href="$parpage">$lex{Parent} $lex{Main}</a> ]</p>\n};

}