%lex = ('User Id' => 'User Id', 'Password' => 'Password', 'Cookie Duration' => 'Cookie Duration', 'Continue' => 'Continue', 'Please Log In' => 'Please Log In', 'Main' => 'Main', ); #-------- sub login { # print error, login screen and die; #-------- # Requires $lex: Continue, UserId, Password, Cookie Duration, Please Log In my ( $error, $userid, $lexref) = @_; # may not be present... # my %lex = %{$lexref}; if ( not $error ) { $error = $lex{'Please Log In'}; } print qq{$doctype\n$error\n}; print qq{\n}; print qq{$chartype\n\n}; print qq{\n}; print qq{[ $lex{Main} ]\n}; print qq{

$error

\n}; # foreach my $key ( sort keys %lex ) { # print "K:$key V:$lex{$key}
\n"; # } print qq{
\n}; print qq{\n}; print qq{\n}; print qq{\n}; my $uservalue; if ( $userid ) { $uservalue = qq{value="$userid"}; } print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{\n}; print qq{
$lex{'User Id'}
$lex{Password}
$lex{'Cookie Duration'}
\n}; print qq{
\n}; print qq{\n}; exit; } # end of login function #---------------- sub checkPassword { #---------------- my ($userid, $password, $dbh) = @_; # $dbh should likely be read-only handle, also 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(userid) from staff where userid = ?"); $sth->execute( $userid ); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr;} my $count = $sth->fetchrow; if ($count < 1){ return -1;} # no userid # Now check for a match in uppercase/lowercase. if ( $count ) { my $sth = $dbh->prepare("select userid from staff where userid = ?"); $sth->execute($userid); if ($DBI::errstr){ print $DBI::errstr; die $DBI::errstr; } my $testid = $sth->fetchrow; if ( $testid ne $userid ) { # we have a case mis match return -1; # no userid; } } if ($count < 1){ return -1;} # no userid #check for presence of correct password and userid my $sth = $dbh->prepare("select count(userid) from staff where userid = ? 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 { #------------------ # Requires defaults of: $defaulttime, $maximumtime, $minimumtime my $defaulttime = 60; my $maximumtime = 90; my $minimumtime = 3; my $duration = shift; if ($duration) { $cookietime = $duration; } else { $cookietime = $defaulttime; } $cookietime = $minimumtime if $cookietime < $minimumtime; $cookietime = $maximumtime if $cookietime > $maximumtime; $cookietime = "+".$cookietime."m"; # set format return $cookietime; } 1;