Hi ninjazin,
First, you should really use not only 'warnings', but 'strict' as well:
use strict;
use warnings;
Secondly, you have to show us the code for "learn/db_connect.pl".
(And is "index.pl" the thing which calls "login.pl"? It wouldn't hurt
to show us that as well).
Third, assuming you have access to a webserver where you can test this,
try putting the following line with the other 'use' statements:
use CGI::Carp qw{ fatalsToBrowser };
while debugging. This will make the browser display any fatal errors,
rather than having to rely on your webserver logfiles. Additionally (andx
only while debugging), you can make warnings become fatal errors (which
with "fatalsToBrowser" will make them conviently appear in the output, with:
use warnings FATAL => "all";
and cleanup any warnings that appear, such as the one I'm getting:
Use of unitialized value in numeric eq (==) at login.cgi line 50.
which is this line:
if($ref->{'counted'} == 1){
where $ref wasn't assigned correctly because in the code:
my $dbh = connectDB();
my $sth = $dbh->prepare("SELECT count(id) as counted FROM perl_use
+rs WHERE `username` = ? AND `password` = ?");
$sth->execute($uname, $pass_hash);
my $ref = $sth->fetchrow_hashref();
$dbh never got assigned (It's part of the missing code that you
haven't shown us in "learn/db_connect").
Another aid you can employ in debugging is to create a subroutine in
login.pl called debug():
sub debug {
my ($msg) = @_;
my $lnum = (caller)[2];
print qq{<pre><b>Debug [line $lnum]</b>: $msg</pre>};
}
now any time you want to debug any line of your code, you can call
debug() with an informational message. For example, to make sure that the
request method was really a "POST", do this:
if($q->request_method eq "POST"){
debug("Yes, the request method WAS 'POST'");
and to ascertain that you're getting the right values for $uname and
$pass, you could do:
my $uname = $q->param('uname');
my $pass = $q->param('pass');
debug("Passed values were: Uname=$uname Pass=$pass");
Finally, you can really simplify your logic by refactoring your
if ... else clauses to handle the reverse cases first, and get them
out of the way. Also, though it's not strictly necessary, I find it easier
to break long lines up into shorter ones, especially when you have long SQL
text.
Here's how I would rewrite everything:
#!/usr/bin/perl
print "Content-type: text/html\n\n";
require 'learn/db_connect.pl';
use CGI;
use CGI::Session qw();
use CGI::Carp qw{ fatalsToBrowser };
use DBI;
use strict;
# use warnings; # Put this back in when done with FATAL =>
+"all"
use warnings FATAL => "all";
my $username;
my $user_id;
use File::Basename;
my $prog = 'profile.cgi';
use Digest::SHA qw(hmac_sha512_hex);
my $q = new CGI;
my $cgi = new CGI;
my $meth = $q->request_method;
sub debug {
my ($msg) = @_;
my $lnum = (caller)[2];
print qq{<pre><b>Debug [line $lnum]</b>: $msg</pre>};
}
# If it's NOT POST, go back to index.pl
if($q->request_method ne "POST"){
print "<script>window.location.href = 'index.pl';</script>";
exit;
}
# Get parameters
my $uname = $q->param('uname');
my $pass = $q->param('pass');
debug("Passed values were: Uname=$uname Pass=$pass");
# A better way to write if (!defined($uname) or $uname eq "") { ..
+. }
# is if (!($uname || "")) { ... }
##
if (!($uname || "")) {
my $err = qq{error=please fill all fields};
print "<script>window.location.href = 'index.pl?$error';</scri
+pt>";
exit;
}
my $pass_hash = hmac_sha512_hex($pass);
my $dbh = connectDB();
my $sql = qq{
SELECT count(id) as counted FROM perl_users
WHERE `username` = ? AND `password` = ?
};
$sth->execute($uname, $pass_hash);
my $ref = $sth->fetchrow_hashref();
if ($ref->{'counted'} != 1) {
my $err = qq{error=Invalid Username Or Password.};
print "<script>window.location.href = 'index.pl?$error';</scri
+pt>";
exit;
}
# Successful up to this point -- note the lack of hard-to-read,
# multiply nested if ... else .. else ... else clauses.
##
$sql = qq{
SELECT * FROM perl_users WHERE `username` = ? AND `password` =
+ ?
};
my $sql001 = $dbh->prepare($sql);
$sql001->execute($uname, $pass_hash);
my $result = $sql001->fetchrow_hashref();
$user_id = $result->{'id'};
$username = $result->{'username'};
my $s = CGI::Session->new;
$s->param("user_id" => $user_id);
my $id = $s->id;
print "<script>window.location.href = 'profile.pl?token=$id';</scr
+ipt>";
say
substr+lc crypt(qw $i3 SI$),4,5
| 