cgi script with password_field parameter

[m4x123]

Hi,

I have this cgi script which is a simple authentication web page, it check the value of the password_field and if correct call the subroutine alfa.

I don't know why it stops with an error when I click on "insert new stream"

I tried to call the subroutine without the authentication part and it works.

#!/usr/bin/perl -Tw
use CGI;
$query = new CGI;
print $query->header;
print $query->start_html();
if (!$query->param) {
        print $query->startform;
        print $query->password_field(-name=>'the_password',
                -size=>35,
                -maxlength=>50);
        print $query->br;
        print $query->submit(-value=>'Submit your password');
        print $query->endform;
} else {
        $yourPassword = $query->param('the_password');
if ($yourPassword eq '123') { alfa ();} {print 'error';}
 
}
 
print $query->end_html;
 
 
 
sub alfa () {
use strict;
use CGI::Carp qw(fatalsToBrowser);
use CGI qw(:standard);
use DBI;
my $mode = param('mode');
my $url = url;
print header,
start_html;
 
print h2('insert values'),
     start_form(),
textfield('DETAILS'),  'detail bor bla bla..' . br,
textfield('TARGET_DATABASE') . br ,
textfield('TARGET_HOST'). br,
textfield('TARGET_IP') . br,
textfield('TARGET_ACCOUNT') . br,
textfield('SOURCE_DATABASE') . br,
textfield('SOURCE_HOST'). br,
textfield('SOUCE_IP') . br,
textfield('SOURCE_ACCOUNT') . br,
textfield('STREAM_NAME') . br,
textfield('ID') . br,
submit('insert new stream'),
     end_form;
 
if($mode eq 'process_form')
   {
my $dbh = DBI->connect('DBI:Oracle:(DESCRIPTION = (ADDRESS_LIST =(ADDRESS = (PROTOCOL = TCP)(HOST = xx.xx.xx.xx)(PORT = xxxx)))(CONNECT_DATA =(SERVICE_
NAME = xxxxxxx)))', 'monitor', 'monitor', {RaiseError=>'1'});
my $sth = $dbh->prepare('insert into s_test (DETAILS, TARGET_DATABASE, TARGET_HOST, TARGET_IP, TARGET_ACCOUNT, SOURCE_DATABASE, SOURCE_HOST, SOUCE_IP, S
OURCE_ACCOUNT,STREAM_NAME, ID)  values (? , ? , ?, ?, ?, ?, ?, ?, ?, ?, ?)');
     $sth->execute(param('DETAILS'), param('TARGET_DATABASE'), param('TARGET_HOST'), param('TARGET_IP'), param('TARGET_ACCOUNT'), param('SOURCE_DATABASE
'), param('SOURCE_HOST'), param('SOUCE_IP'), param('SOURCE_ACCOUNT'),param('STREAM_NAME'), param('ID'));
     $dbh->disconnect;
   }
   print end_html;
}
 

[numberwhun]

In line 16, shown here:

if ($yourPassword eq '123') { alfa ();} {print 'error';}
 

I took out the {print 'error';} and it gave a bunch of output. Try removing that and see if that is what you were looking for. Not sure why you had that print statement there, but it overrode the subroutine execution, or so it seems.

Also, any time you post code in the forums, please use code tags.

Regards,

Jeff

[RonB]

Here are some questions for you to think about. As you answer them, your problem and solution should be discovered.

Why are you loading the CGI module twice?

Why are you using CGI's OO interface in the begining but then switch over to the functional interface in the sub?

Why do you have the use statements in the sub and not at the beginning of the script?

Why are you specifying an empty prototype in the subroutine declaration? You should be receiving this warning:

main::alfa() called too early to check prototype at m4x123.pl line 16

Why are you enclosing the print 'error'; statement in it's own block?

Why are you outputting 2 sets of headers?

[RonB]

I have not tested the script but I don't think that print error statement prevented the script from working correctly.

After fixing the formatting of that else block, here is what it looks like.

else {
    $yourPassword = $query->param('the_password');
 
    if ($yourPassword eq '123') {
        alfa();
    }
 
    { print 'error'; }
}

It's more likely that it's the prototype that's causing the problem.

[numberwhun]

I agree with you that I don't see why that would have effected it, but when I removed the print statement it produced a totally different output.

[RonB]

I just tested the script as written by the OP and the only "error message" I receive is the one that is hard coded into the script and is displayed whenever the user clicks on the 'Submit your password' button.

The script works exactly as I would expect. Meaning that the form in the alfa() sub is displayed, but since there is no form field with the name of 'mode' anywhere in the script, then the corresponding DB code won't be executed.

[m4x123]

Hi,
First of all thanks to all of you for the help.
I changed the code as follow(see m4x123.txt attached):

1) implemented the Rob's formatting at line 16-21
2) I've updated the script with form field with method=post, hidden name and value='process_form'

I tested the subroutine again removing lines from 1 to 25 and using only "alfa ();" to call it and it works.

when I use all the script I can access the form for inserting the values in the form but after clicking on
the insert button I get the print 'error'; from line 23

from the error.log on the apache server:
[Tue Dec 29 11:46:39 2009] null: Use of uninitialized value in string eq at /u01/appl/ora102/product/http10g/Apache/Apache/cgi-bin/inspwd.pl line 19.

Still cannot figure out why the subroutine doesn't work if I call it from if statement.

should I use a different form ?

regards,
max

[RonB]

What makes you think the subroutine is not working? For me, it works exactly as I'd expect, but clearly it's not what you want. What are your expectations.

One of the first and most important steps in writing and troubleshooting code is the ability to clearly describe step by step what the code needs to do. This is called writing pseudo code. From there you fill in the code details to accomplish each step.

I have a good idea of what you want the script to do, but as written has a number of logic errors, which is why it's not doing what you want.

[RonB]

Line 31 is one logic error example.

How can you retrieve the value of a hidden form field before creating the form in which it is defined?

[m4x123]

Hi Ron,

I just tried to reuse some code which I've found on internet since I like the flexibility and simplicity of perl/cgi but of course I'm not a perl expert

this for the insert into the database:
http://www.expertwebinstalls.com/cgi...ipulation.html

and http://www.devdaily.com/perl/perl-cg...ield-html-form
for the authentication

btw I don't want necessarily use this code what I'm trying to do is just creating a simple form for inserting a row in my table after authentication through another form. If you could address me I would really appreciate it.

thanks,
Max

[RonB]

Your starting point should be to get a good beginners Perl book, such as Learning Perl http://oreilly.com/catalog/9780596520113

Once you have the basics, then move on to learning CGI and DBI programing with Perl.

I'm not going to rewrite your entire script, but I will give you a big head start by giving you the skeleton code.

#!/usr/bin/perl -T
 
use strict;
use warnings;
use DBI;
use CGI;
use CGI::Carp qw<fatalsToBrowser>;
 
my $cgi = CGI->new;
my %form = $cgi->Vars;
my %dispatch = (
    login_form   => \&display_login_form,
    authenticate => \&authenticate_user,
    db_form      => \&display_db_form,
    process      => \&insert_db_data,
    error        => \&display_error,
);
 
print $cgi->header, $cgi->start_html;
 
if (exists $dispatch{ $form{action}} ) {
    $dispatch{ $form{action} }->();
}
else {
    $dispatch{ login_form }->();
}
 
exit;
 
 
### subroutine declarations ###
 
sub display_login_form {
    # output your form
}
 
sub authenticate_user {
    # if successful auth, display the DB form
    # else display error and login form
}
 
sub display_db_form {
    # output your form
}
 
sub insert_db_data {
    # db stuff
}
 
sub display_error {
    # some error message
}

[m4x123]

Hi Ron,
I was thinking to download/buy some book but I didn't know which one would have worked better thks!!!
I've found now a code that works but I'll try to put it as your skeleton code.
Really appreciated your help and your valuable suggestions, thanks a LOT!!

     1  #!/usr/bin/perl -w
     2  use strict;
     3  use CGI qw(:standard);
     4  use DBI;
     5  my $dbh = DBI->connect('DBI:Oracle:(DESCRIPTION = (ADDRESS_LIST =(ADDRESS = (PROTOCOL = TCP)(HOST = xxxxxx)(PORT = xxxx)))
     6  (CONNECT_DATA =(SERVICE_NAME = xxxxx)))', 'xxxx', 'xxxx', {RaiseError=>'1'});
     7  my $mode = param('mode');
     8  my $url = url;
     9  print header,
    10  start_html;
    11  print h2({-align=>'center'}, 'Please insert the admin password to access this page'),
    12   start_form(-action=>$url,
    13                  -method=>'post'),
    14       hidden(-name=>'mode',
    15              -override=>2),
    16  password_field ('password') . br ,
    17  submit('check password'),
    18       end_form,
    19  ,br,hr,"\n";
    20
    21  if (param('password') eq 'a')
    22     {
    23  print h2('insert values'),
    24       start_form(-action=>$url,
    25                  -method=>'post'),
    26       hidden(-name=>'mode',
    27              -value=>'process_form',
    28              -override=>2),
    29  textfield('DETAILS'),  'detail bor bla bla..' . br,
    30  textfield('TARGET_DATABASE') . br ,
    31  textfield('TARGET_HOST'). br,
    32  textfield('TARGET_IP') . br,
    33  textfield('TARGET_ACCOUNT') . br,
    34  textfield('SOURCE_DATABASE') . br,
    35  textfield('SOURCE_HOST'). br,
    36  textfield('SOUCE_IP') . br,
    37  textfield('SOURCE_ACCOUNT') . br,
    38  textfield('STREAM_NAME') . br,
    39  textfield('ID') . br,
    40  submit('insert new stream'),
    41       end_form;
    42     }
    43  elsif ($mode eq 'process_form')
    44     {
    45  my $sth = $dbh->prepare('insert into s_test (DETAILS, TARGET_DATABASE, TARGET_HOST, TARGET_IP, TARGET_ACCOUNT, SOURCE_DATABASE,
    46  SOURCE_HOST, SOUCE_IP, SOURCE_ACCOUNT,STREAM_NAME, ID)  values (? , ? , ?, ?, ?, ?, ?, ?, ?, ?, ?)');
    47  $sth->execute(param('DETAILS'), param('TARGET_DATABASE'), param('TARGET_HOST'), param('TARGET_IP'), param('TARGET_ACCOUNT'),
    48  param('SOURCE_DATABASE'), param('SOURCE_HOST'), param('SOUCE_IP'), param('SOURCE_ACCOUNT'),param('STREAM_NAME'), param('ID'));
    49       print redirect($url . '?mode=read_submitted_names');
    50       $dbh->disconnect;
    51     }
    52  elsif($mode eq 'read_submitted_names')
    53     {
    54       my $sth = $dbh->prepare('select *  from s_test');
    55       $sth->execute;
    56       while(my $row_href = $sth->fetchrow_hashref)
    57       {
    58         print $row_href->{ID};
    59         print $row_href->{TARGET_DATABASE};
    60         print $row_href->{TARGET_HOST};
    61         print $row_href->{TARGET_IP};
    62         print $row_href->{TARGET_ACCOUNT};
    63         print $row_href->{SOURCE_DATABASE};
    64         print $row_href->{SOURCE_HOST};
    65         print $row_href->{SOUCE_IP};
    66         print $row_href->{SOURCE_ACCOUNT};
    67         print $row_href->{STRERAM_NAME};
    68         print $row_href->{DETAILS};
    69       }
    70         $dbh->disconnect;
    71     }
    72     print end_html;