Muhammad Abbas Muhammad Abbas - 1 month ago 10
Perl Question

How to verify form in perl CGI?

I am creating a CGI perl script where user enters first name, last name and phone number. I then check the data they entered with some regular expressions to make sure the data is in correct format for example: phone is numbers not letters.

The problem is when I execute my script from browser I get the form, but when I enter incorrect format I don't get an error. I have tried changing my script, but I haven't corrected the issue.
Here is my script:

#!/usr/bin/perl -w

use strict; #options

my %errors;
my %form;

my %fields = (
"lname" => "Last Name",
"phone" => "Phone Number",
"fname" => "First Name"
);

my %patterns = (
"fname" => '[A-Z][a-z]{2,50}',
"phone" => '[\d{3}-\d{3}-\d{4}',
"lname" => '[A-Z][A-Za-z]{2,60}'
);


#sequence that form fields are printed/processed
my @formSequence = ("fname", "lname", "phone");

print "Content-Type: text/html;charset=ISO-8859-1\n\n";

&startxhtml;

if ($ENV{REQUEST_METHOD} eq "GET") {
&printform;
exit;
}
else {
&readformdata;
if (&checkrequiredfields) {
print "Form Data validated successfully!";
exit;
}
else {
&checkrequiredfields;
&printform;
}
}


=for
if($ENV{REQUEST_METHOD} eq "POST")
{
&readformdata();
#&printformdata;
if(&checkrequiredfields)
{
print "Form data validated successfully";
}
else
{
&printform();
}
}
=cut
print qq~</body></html>\n~;


sub checkrequiredfields
{
my $success = 1;
foreach(keys (%fields))
{
if($form{$_} !~ $patterns{$_})
{
$errors{$_} = "Error: $fields{$_} is missing or incorrect format\n";
$success = 0;
}
}
return $success;
}

sub printform
{
print qq~<html>
<head>
<title>Taint Checking</title>
</head>
<body>
<form action="/new-cgi/file5.cgi" method="POST">
<center>
<h2>Student Survery</h2>
Last Name:<input type=text name=lname value=$form{lname}>
<br>
$errors{lname}
First Name:<input type=text name=fname value=$form{fname}>
<br>
$errors{fname}
Phone Number:<input type=text name=phone value=$form{phone}>
<br>
$errors{phone}
<input type=submit value="Insert" name=Insert>
</form>
</center>
</body>
</html>
~;


}

sub startxhtml
{
print qq~
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml">
<head><title>Taint checking</title>
<body>
~;
}

sub readformdata
{
#Read and decode form data
my $input = <>;
my @pairs = split(/&/, $input);
my ($name, $value);
foreach(@pairs)
{
($name, $value) = split(/=/, $_);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$form{$name} = $value;
}
}


When I access this script from browser I get the form, but if I put wrong format I don't get the warning.

Could someone please suggest what I am doing wrong. Thanks

Answer

when I enter incorrect format I don't get an error

Where have you looked for the error? Your code has an error in it, so I think you'll be getting an error in the web server error log. The error is in the regex for checking the validity of the phone argument:

my %patterns = (
        "fname" => '[A-Z][a-z]{2,50}',
        "phone" => '[\d{3}-\d{3}-\d{4}',
        "lname" => '[A-Z][A-Za-z]{2,60}'
                );

The phone regex has an extra [ at the start of it. It you remove that, then I think that your code will work as expected.

But, as I said yesterday, this code shows some rather old coding practices. I'm not sure where you got this code from ,but I would urge you to look into some more modern Perl coding resources. I've cleaned up your code a little below, but there are many more improvements that can be made.

#!/usr/bin/perl

use strict;
# Use warnings rather than "-w" on the shebang
use warnings;

# Use the module that helps us write CGI programs
use CGI qw[:cgi];

my %errors;

my %fields = (
  # No need to quote the LHS of =>
  lname => 'Last Name',
  phone => 'Phone Number',
  fname => 'First Name',  # Perl tip: Always add optional comma at end of list
);

my %patterns = (
  fname => '[A-Z][a-z]{2,50}',
  phone => '\d{3}-\d{3}-\d{4}',
  lname => '[A-Z][A-Za-z]{2,60}',
);


#sequence that form fields are printed/processed
# Less punctuation using qw(...)
my @formSequence = qw(fname lname phone);

# Use the header function to print a header
print header(-charset => 'ISO-8859-1');

# No ampersands on function calls (but parenthesese look nice)
startxhtml();

if (request_method eq 'GET') {
  printform();
  exit;
}

# exit() above means we don't need the else block

# Declare variables where they are used.
my %form = readformdata();

# Inverted to logic here as checkrequiredfields() returns true (a hash of errors)
# for invalid fields
if (my %errors = checkrequiredfields(%form)) {
  # Slightly weird logic here. If checkrequiredfields() ... else checkrequiredfields() ?
  checkrequiredfields();
  printform(%errors);
} else {
  print "Form Data validated successfully!";
  exit;
}


# Don't use raw HTML. Use the Template Toolkit (or some other templating system)
print qq~</body></html>\n~;


sub checkrequiredfields {
  my %form = @_;

  my %errors;

  my $success = 1;
  foreach (keys %fields) {
    if($form{$_} !~ $patterns{$_}) {
      $errors{$_} = "Error: $fields{$_} is missing or incorrect format\n";
      $success = 0;
    }
  }
  return %errors;
}

# Please use a templating engine!
sub printform {
  # Get rid of "uninitialised value" warnings
  my %errors = (
    fname => '',
    lname => '',
    phone => '',
  );

  %errors = (%errors, @_) if @_;

  print qq~<html>
         <head>
         <title>Taint Checking</title>
         </head>
         <body>
         <form action="/new-cgi/file5.cgi" method="POST">
         <center>
         <h2>Student Survery</h2>
         Last Name:<input type=text name=lname value=$form{lname}>
         <br>
         $errors{lname}
         First Name:<input type=text name=fname value=$form{fname}>
                 <br>
         $errors{fname}
         Phone Number:<input type=text name=phone value=$form{phone}>
                 <br>
         $errors{phone}
         <input type=submit value="Insert" name=Insert>
         </form>
         </center>
         </body>
         </html>
         ~;
}

# Please use a templating system
sub startxhtml {
  print qq~
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml">
<head><title>Taint checking</title>
<body>
~;
}

# Using the param() function from CGI.pm makes this a lot easier.
sub readformdata {
  my %form;
  my @params = qw[fname lname phone];

  foreach (@params) {
    $form{$_} = param($_);
  }

  return %form;
}