amateur at Perl need helpwith small script

jpys has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to get specific data from an array and match with an element. Namely verify a user and password. I can see all users within the array but cannot get to a point of a successful verification. I could use some help figuring this out. Here's the script. Even though I print the array and elements coming from a form so I can see it all, I cannot create a verification with a match. I can only get a "ne" result.

#!/usr/bin/perl

&page_header;

&read_form; # Read form


$user = "$FORM{'username'}" if $FORM{'username'};
$pass = "$FORM{'password'}" if $FORM{'password'};

print "<P>$user &nbsp; &nbsp; &nbsp; $pass<P>";

$userpass = "$user$pass";

print "<BR><BR>";

$data_file = "up.txt";
open(UPD, "<$data_file") or die "Cannot open $data_file (5Z).";
flock UPD,2;
seek(UPD,0,0);
@upd = <UPD>;
close(UPD);
chomp(@upd);

foreach $line (@upd)   {
    ($d_line) = split (/\n/, $line);
    ($username, $password, $user_pass, $active) = split (/\|/, $d_line
+);
    print "<P>$username  &nbsp; &nbsp; &nbsp;  $password<P>";
    next if $username ne $user;
    $good = 1 if $username eq $user and $password eq $pass;
}

if($good)  {
    &do_enter;
}else   {
    &do_trap;
}



###################################
#                                 #
#      S U B R O U T I N E S      #
#                                 #
###################################                              

# READ FORM DATA

sub read_form   {

    read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
    if ($ENV{'QUERY_STRING'}) {
        $buffer = "$buffer\&$ENV{'QUERY_STRING'}"
    }
    @pairs = split(/&/,$buffer);
    foreach $pair (@pairs) {
        ($name,$value) = split(/=/,$pair);
        $value =~ tr/+/ /;
        #$value =~ s/%0a/\n/gi;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        $value =~ s/([;<>\*\|\`\$#\[\]\{\}])/'&#' . ord($1) . ';'/eg;
        $value =~ s/\r//g;
        $FORM{$name} = $value;
    }

}


#  CREATE META FOR PAGE HEADER

sub page_header   {

    print "Content-type: text/html\n\n";
    print "<html>\n<head>\n";
    print "<meta http-equiv=\"Content-Type\" content=\"text/html; char
+set=windows-1252\">\n";
    print "<meta http-equiv=\"Content-Language\" content=\"en-us\">\n"
+;
    print "<meta name=\"keywords\">\n";
    print "<meta name=\"robots\" content=\"index, follow, all\">\n";
    print "<meta name=\"revisit-after\" content=\"30 days\">\n";
    print "<meta name=\"classification\" content=\"\">\n";
    print "<meta name=\"rating\" content=\"Safe For Kids\">\n";

}


sub do_enter   {

    print "<table align=center><tr align=center><td align=center>\n";
    print "<center><font face=arial size=5 color=green>\n";
    print "<form action=\"https://bohol-ent.com/cgi-bin/report-generat
+or.pl\" method=\"post\" id=\"user\">\n";
    print "<center><B><button onClick type=\"submit\"> ENTER REPORTS <
+/button></B></font></center>\n";
    print "</form>\n";
}
 

sub do_trap   {

    print "<center><font face=arial size=5 color=red><B>Username or Pa
+ssword is incorrect.</B></font></center>\n";
    $name = "";
    $password = "";
    $user = "";
    $pass = "";
    print "<center><font face=arial size=5><B><form action=\"https://b
+ohol-ent.com/\" method=\"post\">\n";
    print "<P><font face=arial size=5 color=black><B><button onClick t
+ype=\"submit\"> Try Again</button></B></font></form></center>\n";
    print "</td></tr></table>\n";
}
[download]

Comment on amateur at Perl need helpwith small script Download Code

Replies are listed 'Best First'.
Re: amateur at Perl need helpwith small script by jwkrahn (Abbot) on Sep 01, 2022 at 00:52 UTC
`open(UPD, "<$data_file") or die "Cannot open $data_file (5Z)."; flock UPD,2; seek(UPD,0,0); @upd = <UPD>; close(UPD); chomp(@upd); foreach $line (@upd) { ($d_line) = split (/\n/, $line);` [download] You are reading a text file into the array `@upd` and then you `chomp` the array which removes all newlines (`"\n"`). Inside the `foreach` loop you try to split the current line on newlines which do not exist because you have already removed them.	[reply] [d/l]
Re: amateur at Perl need help with small script by hippo (Archbishop) on Sep 01, 2022 at 09:55 UTC
There is a lot in your script which I would do differently and there is a lot in there which is irrelevant for your problem. However, this SSCCE shows that the logic in your loop, however inefficient, does create a match. `#!/usr/bin/perl use strict; use warnings; my $user = 'foo'; my $pass = 'bar'; my @upd = ( 'abc\|abc\|xyz\|xyz', 'foo\|bar\|xyz\|xyz', 'baz\|quux\|xyz\|xyz' ); my $good = 0; foreach my $line (@upd) { my ($d_line) = split (/\n/, $line); my ($username, $password, $user_pass, $active) = split (/\\|/, $d_l +ine); print "Testing '$username' and '$password'\n"; next if $username ne $user; $good = 1 if $username eq $user and $password eq $pass; } print "Good is '$good', should be '1'\n";` [download] This suggests that either you are not processing the form fields correctly or as has already been suggested you are not filling the @upd array correctly (or it doesn't contain what you think it does). Notice how I've used strict and warnings - they are there to help. See the rest of the Basic Debugging Checklist for more ways to help solve your problem. 🦛	[reply] [d/l]
Re: amateur at Perl need helpwith small script by hv (Prior) on Sep 01, 2022 at 00:07 UTC
While there are aspects of your Perl that I'd recommend changing to a more modern style, the cause of the problem doesn't spring out at me. I'd suggest putting some extra diagnostics in the loop that might help you see what's happening: `# next if $username ne $user; if ($username ne $user) { print "<P>user '$user' didn't match '$username'</P>"; next; } # $good = 1 if $username eq $user and $password eq $pass; print "<P>matched username '$user'</P>"; if ($password eq $pass) { print "<P>.. and matched password, marking as good</P>"; $good = 1; } else { print "<P>.. but password '$pass' didn't match '$password'</P> +"; }` [download]	[reply] [d/l]
Re: amateur at Perl need helpwith small script by marto (Cardinal) on Sep 01, 2022 at 08:14 UTC
Unrelated to your question, there are plenty of modern frameworks out there to make life easier, and fun. See Mojolicious::Lite/Mojolicious (see tutorial). Worth considering before reinventing too many wheels.	[reply]