asked on

Redirect not working

I am migrating a website developed in PERL from one ISP to another. This is not proving to be a straight forward exercise - I think I have jumped through most of the hoops but have one that I am not getting anywhere with.

(Disclaimer: I did not write the code - I am just doing someone a favour moving their site)

In the index.pl there is this line of code

print $q->redirect('group_admin/clients.pl');

Open in new window

$q is defined as follows

#!/usr/bin/perl

use strict;

use CGI::Carp qw(fatalsToBrowser);
require '/home/domain/public_html/myconfig.conf';
&start();

sub start() {
	my $q = new CGI;
	my $e = new MyConfig($q);

	if( $e->manage_session() ) {
		&display($q, $e);
	}
	return 1;
}

sub display() {
  print $q->redirect('group_admin/clients.pl');
  ....
}

Open in new window

The effect of the above is to output the following to the browser

Status: 302 Found Location: group_admin/clients.pl

Open in new window

In the response these are over two lines

Status: 302 Found
Location: group_admin/clients.pl

Open in new window

In other words the page does not redirect.
If I manually enter the URL to group-admin/clients.pl the correct page loads.

What have I missed that is causing the redirect to fail?

NB: This code base works as is on the current server.

jeromee

Have you tried to send the HTTP header first:
print $q->header,
$q->redirect('group_admin/clients.pl');

Julian Hansen

ASKER

Firstly, I seem to remember that with redirect you don't need to send the header.

Having tried your suggestion I get this

Content-Type: text/html; charset=ISO-8859-1 Status: 302 Found Location: group_admin/clients.pl

Open in new window

Something is causing the header information to be sent as content.

As I said this is a direct port of working code from one server to another.

Dave Baldwin

Something is probably missing. Did you capture the headers from the 'working' server?

This is what I get in the headers for a 302 redirect thru .htaccess on my site. Looks like complete headers to me.

http://www.dibsplace.com/artfish.html

GET /artfish.html HTTP/1.1
Host: www.dibsplace.com
User-Agent: Mozilla/5.0 (Windows NT 5.1; rv:52.0) Gecko/20100101 Firefox/52.0
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-US,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Upgrade-Insecure-Requests: 1

HTTP/1.1 302 Found
Date: Mon, 05 Feb 2018 07:08:49 GMT
Server: Apache/2.4.7 (Ubuntu)
X-Frame-Options: SAMEORIGIN
Location: http://www.dibsplace.com/Alexpics.html
Content-Length: 304
Keep-Alive: timeout=5, max=100
Connection: Keep-Alive
Content-Type: text/html; charset=iso-8859-1

Open in new window

Julian Hansen

ASKER

Thanks Dave,

Here are screen grabs of the headers / requests for working and non-working domains
The working version shows the Status 302 while the new site shows a Status 200 indicating that it is receiving the page and the headers are somehow being delivered as content.
ss150a.jpg
ss150b.jpg

jeromee

Probably unrelated but isn't the missing function parameters missing?

sub display() {
   my($q, $e) = @_;  # ADDED 
   print $q->redirect('group_admin/clients.pl');
}

Open in new window

Julian Hansen

ASKER

@Jeromee,

No, I just left them out of the question - start of script here

sub display() {
	my($q, $e) = @_;

	my $user_id = $q->param('user_id') || $e->{'user_id'};

	if( $e->{'group_admin'} ) {
		print $q->redirect('group_admin/clients.pl');

Open in new window

$e refers to the package that manages the session.

In the session management function there is code to output the headers from the CGI package.

If I remove this line the redirect works - but the page it redirects to then fails.

Still trying to figure out why

Dave Baldwin

Any chance the 'new' site is sending some unwanted white space before the redirect? That would do it.

Julian Hansen

ASKER

I have looked at that but with PERL I might be missing something - almost zero exposure to it so a bit green. I have checked for whitespace at teh end of the package files - they all seem good. Any ideas where else to look?

I traced execution through the code to see if there were any rogue output statements - nothing until the

my $q = shift;
my $headers = shift || {};
...
// This is the line when removed allows the redirect but breaks the target page
print $q->headers(%$headers);

Open in new window

Dave Baldwin

On this page http://perldoc.perl.org/perlfaq9.html#How-do-I-redirect-to-another-page%3F it says that the 'redirect' function is supplied by the Catalyst framework. Do you have something installed on the 'new' server that will support the 'redirect'?

Julian Hansen

ASKER

the redirect in the project is being done by the CGI module and as I mentioned it does work. For instance this script works out of the box

#!/usr/bin/perl

use strict;

use CGI;

my $query=new CGI;
print $query->redirect('path/clients.pl');

Open in new window

It seems the header call is breaking it but I don't know why on this server it is different as it works fine on the live server - I was hoping it was a PERL config I was missing somewhere.

Dave Baldwin

That code works perfectly here. Windows XP, IIS 5.1, Active Perl 5.14.

Julian Hansen

ASKER

It works here as well - that is the test script.

Here is the bit that does not work - manage_sessions() function that is called in the index.pl file
index.pl

#!/usr/bin/perl

use strict;

use CGI::Carp qw(fatalsToBrowser);
require '/home/domain/public_html/config.conf';
&start();

sub start() {
	my $q = new CGI;
	my $e = new Config($q);


	if( $e->manage_session() ) {
		&display($q, $e);
	}
	return 1;
}

sub display() {
	my($q, $e) = @_;

	my $user_id = $q->param('user_id') || $e->{'user_id'};

	if( $e->{'group_admin'} ) {
		print $q->redirect('group_admin/clients.pl');
       }
       else {
         #Show some default stuff
       }

Open in new window

The above code is supposed to redirect the logged in user to the clients.pl script.
In the Config package the manage_session() looks like this - relevant bit is on line 82.

Package Config;

use strict;

$Config::VERSION = '0.01';

sub new { bless { 'CGI' => $_[1], '_dbh' => undef }, $_[0] }

sub dbh {
  my $self = shift;
  
  unless( $self->{'_dbh'} ) {
    my $dbh = DBI->connect("DBI:mysql:database=$Config::db_database;host=$Config::db_server", $Config::db_user, $Config::db_pass, { PrintError => 1 });
    unless( $dbh ) {
      die $DBI::errstr;
    }
    $self->{'_dbh'} = $dbh;
  }
  
  return $self->{'_dbh'};
}


sub manage_session {
    my $self = shift;
  my $header_options = shift || {}};

    my $q = $self->{'CGI'};

    if( $q->param('_.sign-up._') ) {
        return $self->display_sign_up();
    }
    
    my $session_id = $q->cookie('SessionID');

    my (@data);
    if( $q->param('_..username.._') ) {
        my $dbh = $self->dbh;
        my $sql = "SELECT users.*, groups.parent_group_id FROM users INNER JOIN groups ON users.group_id = groups.group_id WHERE username = " . $dbh->quote($q->param('_..username.._')) . " AND password = " . $dbh->quote($q->param('_..password.._'));
        #warn "$sql\n";
        my $sth = $dbh->prepare($sql);
        $sth->execute;
        my $data = $sth->fetchrow_hashref;
        $sth->finish;
        
        if( ref($data) ) {
            $self->session('delete', 0, $session_id);
            $self->session('new', $data->{'user_id'}, ($session_id ? $session_id : $self->generate_unique_id()));
            $self->{'user_id'} = $data->{'user_id'};
            $self->{'group_id'} = $data->{'group_id'};
            $self->{'parent_group_id'} = $data->{'parent_group_id'};
            $self->{'group_admin'} = $data->{'group_admin'};
            $self->{'is_admin'} = $data->{'is_admin'};
            $q->param('user_id', $data->{'user_id'});

            unless( $data->{'online_access'} ) {
              return $self->display_login('You don\'t have access to login');
            }

            return 1;
        } else {
            return $self->display_login('Username or Password incorrect!');
        }
    }
    
    if( $q->param('_.logout._') ) {
        $self->session('delete', 0, $session_id);
        return $self->display_login();
    }
    
    if( $session_id ) {
        my $data = $self->session('get', 0, $session_id);
        
        if( $data ) {

            unless( $data->{'online_access'} ) {
        return $self->display_login('You don\'t have access to login');
      }

            if( time() - $data->{'last_request_time'} > $MealTool::session_timeout ) {
                $self->session('delete', 0, $session_id);
                return $self->display_login('You have logged out or your session has expired.');
            } else {
                print $q->header(%$header_options);
                $self->session('update', 0, $session_id);
                $self->{'user_id'} = $data->{'user_id'};
                $self->{'group_id'} = $data->{'group_id'};
                $self->{'group_admin'} = $data->{'group_admin'};
                $self->{'is_admin'} = $data->{'is_admin'};
                $self->{'parent_group_id'} = $data->{'parent_group_id'};
                return 1;
            }
        } else {
            #warn "session not found in db: $session_id\n";
            return $self->display_login('You have logged out or your session has expired.');
        }
    } else {
        return $self->display_login();
    }
    
    return 0;
}

Open in new window

Remove line 82 - redirect works - but the clients.pl gives error 500.
Leave it in no redirect but manually go to clients.pl and that page works.
This code is unchanged from current live server.

FishMonger

I realize you didn't write the code and I don't want to do a line-by-line analysis but the code is using some questionable practices and IMO poorly written, which is part of the reason you're having problems.

When doing redirects you should always use a full URL. Using relative paths may "work" but the results can be unpredictable.

Julian Hansen

ASKER

@FishMonger - no need to be diplomatic - I have no idea who wrote this and it is the bane of my existence - so feel free to trash the code as much as you like.

The key thing here is it works on ISP A but not on ISP B - and I am looking for something simple that I need to do to make it work on ISP B.

Some combination of the print $q->headers and the redirect on THIS server is resulting in the headers being interpreted as content.

One thing I just found out - if I force a syntax error in the manage_session() package I get the errors below.

Error caused by doing this (extra '}' on line 3)

sub manage_session {
    my $self = shift;
	my $header_options = shift || {}};

Open in new window

Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 315.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 318.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 325.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 334.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 335.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 335.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 336.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 337.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 338.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 339.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 340.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 344.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 349.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 354.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 355.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 359.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 364.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 368.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 369.
Global symbol "$header_options" requires explicit package name at /home/domain/public_html/lib/Config.pm line 371.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 372.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 373.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 374.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 375.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 376.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 377.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 383.
Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 386.
Unmatched right curly bracket at /home/domain/public_html/lib/Config.pm line 390, at end of line
/home/domain/public_html/lib/Config.pm has too many errors.
Compilation failed in require at /home/domain/public_html/mealtool.conf line 110.
BEGIN failed--compilation aborted at /home/domain/public_html/mealtool.conf line 110.

Open in new window

FishMonger

Yeah, I discovered that error as soon as I loaded the code into my IDE.

Also, when doing a redirect, you don't send the header before doing the redirect. The CGI module's redirect method will send the header, but in some cases you'll need to add additional parameters to the redirect statement. The CGI module documentation provides the examples.

Once you correct those issues, the redirect will probably work correctly, but I've only skimmed over the code and haven't looked at in great detail.

Julian Hansen

ASKER

Ok but we are talking about code changes - the code works as is on ISP A. Something is different on ISP B that is causing it not to work. I am looking for the solution that makes the code work on ISP B or the reason why it does not work so I can get ISP B to fix their server.

Any idea how I can resolve those errors? What is the missing package referring to in this case ($self).

Dave Baldwin

You haven't told us what versions of Perl are on the two servers.

Julian Hansen

ASKER

Working server v5.8.8 [works]
New server v5.10.1 [not working]

FishMonger

Are both servers running apache and are the the same version?

Is the CGI module the same version on each server?

Did you change the redirect statement to use a full url instead of a relative path?
Generating a redirection header

Julian Hansen

ASKER

No one is running apache - the other is running lightspeed

New server: LiteSpeed V6.11 (Apache 2)
Old server: Apache 2

FishMonger

I've never worked with lightspeed (which is "drop-in replacement" for apache) so I can't say for sure but, you may need to set the -nph parameter in the header and possibly the -status parameter.

Julian Hansen

ASKER

Going back to this error

Global symbol "$self" requires explicit package name at /home/domain/public_html/lib/Config.pm line 315.

Open in new window

Any insight into what might be throwing this out?

FishMonger

You were getting that error due to the extra closing curly brace on this statement

my $header_options = shift || {}};

Open in new window

in the manage_session() sub. That closing brace terminated the sub and each time you used $self beyond that point up to the point where the sub should have ended, it generated that error.

Julian Hansen

ASKER

Thanks for that - stupid choice of character to use when trying to force an error.

Seems this was a red herring - when I raised this issue with ISP B they said I was missing packages. I deliberately tried to cause an error to see if errors were turned on and that I was not missing something - used the '}' and generated the other errors which also mentioned a package so added 1 and 1 and got a banana.

I am going to do some more digging and see if I can find anything else that is different.

ASKER CERTIFIED SOLUTION

Julian Hansen

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Julian Hansen

ASKER

There is no clear solution to this problem which was caused by script being out of date.

FishMonger

Sounds like the best solution is a combination of options B and C but more on the C side.

If the code is as outdated as it sounds, then refactoring it will be as much if not a bigger project than rebuilding from scratch. If you rebuild from scratch, I'd recommend using one of Perl's web frameworks such as Dancer2 or Mojolicious.

Julian Hansen

ASKER

C is the preferred option - the only problem is time - if the ISP closes down the working server before we can finish the build then we are stuck - so a hack for now to get it to work until we can rebuild.

If we build from scratch though, it won't be in Perl - but thanks for the references.