Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

A CGI redirect problem

by krujos (Curate)
on Jan 26, 2002 at 14:42 UTC ( [id://141754]=perlquestion: print w/replies, xml ) Need Help??

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

I am trying to get this script to redirect me to a url upon validation of l/p. It validates just fine. then instead of redirecting at the right time the script continues to run. here is the code, and the output to the browser is below it. 

#!/usr/bin/perl

use strict;
use warnings;
use CGI qw ( :standard );
use Fcntl qw ( :flock );
use XML::Parser;

if (param) {
   my ($parser, $document, $users);
   local($::flag);
   $::flag=0; 
   open(USERS, "../../xml_final/users/users.xml") || 
      die "Could not open users.xml $!";
   flock(USERS, LOCK_SH);

print header, start_html(-title => "Login" ,-style => {
      -src => "../../xml_final/db.css"}), title ("please login");
print start_html;

   $parser= new XML::Parser();
   $parser->setHandlers(
    Start => \&start_handler,
        Char  => \&char_handler
   );
   
   $document = $parser->parse (\*USERS);
   close (USERS);

   sub start_handler{
      my ($expat, $element, %attributes) =@_;
      if ($::flag==0 && $element eq "username") {
         $::flag=1;
      }

      if ($::flag==1 && $element eq "password") {
         $::flag=2;
      } 
   }

   sub char_handler {
        my ($expat, $text) =@_;
    if ($::flag==1 && $text eq (param("username"))) {
       $::flag=1;
        } 

        if ($::flag==2 && $text eq (param("password"))) {
           print h1("LOGIN IN IS ALL GOOD");
       print redirect("viewdb.pl?username=(param(username)");
       print end_html;
        }
        elsif ($::flag==2 && $text ne (param("password"))) {
       print h1 ("incorrect password");
       $::flag=0;
           
          print p({-align=>'CENTER'},a{-href=>"login.pl"},"Try Agian?"
+);
           print end_html;
           #print a link back to login.pl    
       }
   }
}
else {
   print header, start_html(-title => "Login" ,-style => {
      -src => "../../xml_final/db.css"}), title ("please login");
   print start_form;
   print h1({-align=>'CENTER'}, "Please login");
   print p({-align=>'CENTER'},"username:", textfield(
      -NAME=>"username"
    ));
   print p({-align=>'CENTER'},"password:", password_field(
      -NAME=>"password"
    ));
   print p({-align=>'CENTER'},submit("send"),reset);

   print end_form;
   print p({-align=>'CENTER'},a{-href=>"newuser.pl"},"New User?");

   print end_html;
}

[download]
and the browser output is Content-Type: text/html; charset=ISO-8859-1 <?xml version="1.0" encoding="utf-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN" "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Login</title> <link rel="stylesheet" type="text/css" href="../../xml_final/db.css" /> </head><body><title>please login</title><?xml version="1.0" encoding="utf-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN" "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title> </head><body>

LOGIN IN IS ALL GOOD

Status: 302 Moved location: viewdb.pl?username=(param(username) </body></html>

incorrect password

Try Agian?

</body></html>

Replies are listed 'Best First'.
Re: A CGI redirect problem
by flocto (Pilgrim) on Jan 26, 2002 at 15:06 UTC
    The redirect you want to do is done via the HTTP Status #302. Since this is HTTP you need to send it with the header. Therefore the header you're sending out is superflous. You have a normal HTTP header (hopefully status code #200), everything that follows is considered being HTML, that's why you see "Status: 302 Moved location: ..." in your browser window. Exactly this should be your HTTP header. By the way: not only should you make the path absolute, but even give a complete URL. Your response might look like this:
    Status: 302 FOUND
Localtion: http://www.foo.com/cgi-bin/bar.cgi?qwz=qwzz
Content-type: text/plain

please go to http://www.foo.com/cgi-bin/bar.cgi?qwz=qwzz

    [download]

    Regards,
    -octo-

    --
    GED/CC d-- s:- a--- C++(+++) UL+++ P++++$ L++>++++ E--- W+++@ N o? K? w-- O- M-(+) V? !PS !PE !Y PGP+(++) t-- 5 X+ R+(+++) tv+(++) b++@ DI+() D+ G++ e->+++ h!++ r+(++) y+
[reply]
[d/l]
Re: A CGI redirect problem
by krujos (Curate) on Jan 26, 2002 at 15:03 UTC
    Problem solved many thanks to Chrisf and Zaxo for their help in the chatterbox with this... here is what i (with the help of those mentioned above, remember if your in my nect of the woods cookies will be yours) did. #1 I changed the redirect statemnt to contain the full URL so it looks like this 
    print redirect("http://www.awebserver.com/cgi-bin/~whereyouneedtogo.pl
+?username=$un");

    [download]
    2.I also changed the way I was evaluating the params passed to the script the redirect was calling. Now they evaluate before.It is questionable if this was needed or not but it makes the code a little cleaner. 3. And here is the big fix. If you look closley the script was already sending info back to the browser when the redirect was called. this dosent work.... so i changed it now that whole section of code. Now it looks like this: 
      sub char_handler {
        my ($expat, $text) =@_;
        if ($::flag==1 && $text eq (param("username"))) {
           $::flag=1;
        }

        if ($::flag==2 && $text eq (param("password"))) {
           my($un);
           $un=param("username");
           print redirect("http://www.domain.com/cgi-bin/xml_final/vie
+wdb.pl?username=$un");
        }
        elsif ($::flag==2 && $text ne (param("password"))) {
           $::flag=0;

           print header;
           print start_html(-title => "Not so much correct with tha lo
+gin" ,-style => {
              -src => "../..//xml_final/db.css"});
           print h1("incorrect password");
           print p({-align=>'CENTER'},a{-href=>"login.pl"},"Try Agian?
+");
           print end_html;
           #print a link back to login.pl
        }
   }

    [download]
    Nifty huh? If you wondering what the script actually does. it is taking usernames and passwords from an xml file and validating them agianst what was entered in the web browser... this is a first run at it. If anyone wants to suggest impovements pelase feel free.
[reply]
[d/l]
[select]
      If anyone wants to suggest impovements pelase feel free.

      Let's start with an outline of the script:

      if ( param ) {
} else {
}
sub start_handler {}
sub char_handler  {}

      [download]

      Next, we'll add in the subroutines:

      sub start_handler {
      my ($expat, $element, %attributes) =@_;
      if ($::flag==0 && $element eq "username") {
         $::flag=1;
      }

      if ($::flag==1 && $element eq "password") {
         $::flag=2;
      }
}

      [download]

      We'll rewrite this to exclude variables we don't use and using conditional statements: 

      sub start_handler {
    my $element = $_[1];
    $::flag = 1 if $::flag == 0 && $element eq 'username';
    $::flag = 2 if $::flag == 1 && $element eq 'password';
}

      [download]
      sub char_handler {
    my ($expat, $text) =@_;
    if ($::flag==1 && $text eq (param("username"))) {
       $::flag=1;
    }

    if ($::flag==2 && $text eq (param("password"))) {
       my($un);
       $un=param("username");
       print redirect("http://www.domain.com/cgi-bin/xml_final/viewdb.
+pl?username=$un");
    }
    elsif ($::flag==2 && $text ne (param("password"))) {
       $::flag=0;

       print header;
       print start_html(-title => "Not so much correct with tha login"
+ ,-style => {
          -src => "../..//xml_final/db.css"});
       print h1("incorrect password");
       print p({-align=>'CENTER'},a{-href=>"login.pl"},"Try Agian?");
       print end_html;
       #print a link back to login.pl
    }
}

      [download]

      Let's return immediately if $::flag is not set. Just in case we have a very large file to process. 

          return unless $::flag;

      [download]

      Let's add some more error checking to that $::flag variable. It will remind us what is going on when we look at this code again in a few months: 

          warn '$::flag must be 0, 1, or 2 only' if $::flag > 2 or $::flag <
+ 0;

      [download]

      We're not using $expat, let's not include it.

          my $text = $_[1];

      [download]

      This doesn't do anything. Why set $::flag to 1 if it already is 1? Let's remove it.

          if ($::flag==1 && $text eq (param("username"))) {
       $::flag=1;
    }

      [download]

      Let's outline the rest of the sub:

          if       ( $::flag==2 && $text eq param('password') ) {
    } elsif  ( $::flag==2 && $text ne param('password') {
    }

      [download]

      Let's nest this instead:

          if ( $::flag==2 ) {
        if ( $text eq param('password') ) {
        } else {
        }
    }

      [download]

      Same thing a little clearer. But how about:

          return unless $::flag == 2;
    if ( $text eq param('password') ) {
    } else {
    }

      [download]

      Now let's fill it in:

          if ( $text eq param('password') ) {
        print redirect( 'http://www.domain.com/cgi-bin/xml_final/viewd
+b.pl?username=' . param('username') );
    } else {
        print
            header,
            start_html(
                -title => 'Not so much correct with that login',
                -style => {-src => '../..//xml_final/db.css'} ),

                h1('Incorrect password'),
                p({-align => 'center'},
                    a({-href => 'login.pl'}, 'Try Agian?') ),
            end_html;
    }
    exit;   # no reason to continue processing if the browser is movin
+g on

      [download]

      Putting it together:

      sub char_handler {
    return unless $::flag;

    my $text = $_[1];

    warn '$::flag must be 0, 1, or 2 only' if $::flag > 2;

    return unless $::flag == 2;

    if ( $text eq param('password') ) {
        print redirect('http://www.domain.com/cgi-bin/xml_final/viewdb
+.pl?username=' . param('username'));
    } else {
        $::flag = 0;
        print
            header,
            start_html(
                -title => 'Not so much correct with that login',
                -style => {
                    -src => '../..//xml_final/db.css'}),

                h1('Incorrect password'),
                p({-align => 'center'},
                    a({-href => 'login.pl'}, 'Try Agian?') ),
            end_html;
    }
    exit;
}

      [download]

      Let's fill in the main if. This is what you presented:

         my ($parser, $document, $users);
   local($::flag);
   $::flag=0;
   open(USERS, "../../xml_final/users/users.xml") ||
      die "Could not open users.xml $!";
   flock(USERS, LOCK_SH);

print header, start_html(-title => "Login" ,-style => {
      -src => "../../xml_final/db.css"}), title ("please login");
print start_html;

   $parser= new XML::Parser();
   $parser->setHandlers(
    Start => \&start_handler,
        Char  => \&char_handler
   );

   $document = $parser->parse (\*USERS);
   close (USERS);

      [download]

      Since the subroutines handle their own HTML, we don't need it here. We'll eliminate the my statement and use it on-the-fly instead. We'll also eliminate local($::flag); as it isn't needed at the file level. Finally we'll change some indenting and change double quotes to single quotes where possible: 

      $::flag = 0;
open USERS, '../../xml_final/users/users.xml' or die "Could not open u
+sers.xml: $!";
flock(USERS, LOCK_SH);
    my $parser = new XML::Parser();
    $parser->setHandlers(
        Start => \&start_handler,
        Char  => \&char_handler);

    my $document = $parser->parse(\*USERS);
close USERS;

      [download]

      The else clause just prints a form and exits. Let's use an unless and a sub: 

      unless ( param ) {
    print login_form();
    exit;
}

sub login_form {
    return
        header,
        start_html(
            -title => 'Login',
            -style => {
                -src => "../../xml_final/db.css"}),
            center(
                h1('Please login'),
                start_form,
                        'username:', textfield( -name => 'username'),
                        'password:', password_field( -name => 'passwor
+d'),
                        submit('send'),
                        reset,
                end_form,
                a({ -href => 'newuser.pl'}, 'New User?') ),
        end_html;
}

      [download]

      In order to import the center sub we'll have to add it to our use CGI statement.

      Let's look at the whole thing:

      #!/usr/bin/perl

use strict;
use warnings;
use CGI qw( :standard center);
use Fcntl qw( :flock );
use XML::Parser;

unless ( param ) {
    print login_form();
    exit;
}

$::flag = 0;
open USERS, '../../xml_final/users/users.xml' or die "Could not open u
+sers.xml: $!";
flock(USERS, LOCK_SH);
    my $parser = new XML::Parser();
    $parser->setHandlers(
        Start => \&start_handler,
        Char  => \&char_handler);

    my $document = $parser->parse(\*USERS);
close USERS;

sub login_form {
    return
        header,
        start_html(
            -title => 'Login',
            -style => {
                -src => "../../xml_final/db.css"}),
            center(
                h1('Please login'),
                start_form,
                        'username:', textfield( -name => 'username'),
                        'password:', password_field( -name => 'passwor
+d'),
                        submit('send'),
                        reset,
                end_form,
                a({ -href => 'newuser.pl'}, 'New User?') ),
        end_html;
}

sub start_handler {
    my $element = $_[1];
    $::flag = 1 if $::flag == 0 && $element eq 'username';
    $::flag = 2 if $::flag == 1 && $element eq 'password';
}

sub char_handler {
    return unless $::flag;

    warn '$::flag must be 0, 1, or 2 only' if $::flag > 2 or $::flag <
+ 0;

    return unless $::flag == 2;

    my $text = $_[1];
    if ( $text eq param('password') ) {
        print redirect('http://www.domain.com/cgi-bin/xml_final/viewdb
+.pl?username=' . param('username'));
    } else {
        print
            header,
            start_html(
                -title => 'Not so much correct with that login',
                -style => {
                    -src => '../..//xml_final/db.css'}),

                h1('Incorrect password'),
                p({-align => 'center'},
                    a({-href => 'login.pl'}, 'Try Agian?') ),
            end_html;
    }
    exit;
}

      [download]

      Unfortunately, I can not run this from my system. You'll have to test it yourself.




      HTH,
      Charles K. Clarkson
[reply]
[d/l]
[select]
Re: A CGI redirect problem
by Kanji (Parson) on Jan 26, 2002 at 15:04 UTC

    Because it generates headers of its own, you can't output anything before the redirect, otherwise you're script is telling browsers that it's sending them a file (ie, an HTML page) or (if you forgot header) bogus output.

        --k.


[reply]
Re: A CGI redirect problem
by krujos (Curate) on Jan 26, 2002 at 14:50 UTC
    Still not working quite right, although I have added a fully qualified url to the redirect statement...
[reply]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://141754]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others cooling their heels in the Monastery: (6)
As of 2024-04-19 03:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found