Re: A CGI redirect problem

[krujos]

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");

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
        }
   }

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.

[CharlesClarkson]

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  {}

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;
      }
}

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';
}

---

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
    }
}

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

    return unless $::flag;

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;

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

    my $text = $_[1];

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;
    }

Let's outline the rest of the sub:

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

Let's nest this instead:

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

Same thing a little clearer. But how about:

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

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

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;
}

---

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);

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;

---

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;
}

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;
}

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




HTH,
Charles K. Clarkson