Search code examples
apacheperlhttp-redirectcgicgi-bin

How does one redirect using an Apache Perl Handler?


I have an Apache Handler that sets an extension, .redir, to a Perl script. The code is as follows:

Action redir-url /cgi-bin/redir.pl
AddHandler redir-url .redir

The script should simply redirect the user to the page contained in the .redir file. Example:

so.redir:

http://stackoverflow.com/

If the user visits http://example.com/so.redir, they will be redirected to http://stackoverflow.com/.

My current code is as follows, though it returns an error 500, and probably is completely off:

#!/usr/bin/perl
use strict;
use warnings;

use Path::Class;
use autodie;

my $file = file($ENV{'PATH_TRANSLATED'});

my $file_handle = $file->openw();

my @list = ('a', 'list', 'of', 'lines');

foreach my $line ( @list ) {
    # Add the line to the file
    $file_handle->print("Location: ".$line."\n\n");
}

Thank you for any help!


Solution

  • Back in the cgi-days we used to have a small subroutine that does the redirecting:

    sub redirect_url {
        my ($url, %params) = @_;
    
        $params{Location} = $url;
    
        if ( ($ENV{'HTTP_USER_AGENT'}=~m|Mozilla\/4\.|)
            && !($ENV{'HTTP_USER_AGENT'}=~m|MSIE|) ) {
    
            # handle redirects on netscape 4.x
            $params{Status} = '303 See Other'
                unless exists $params{Status};
            $params{'Content-Type'} = 'text/html; charset=utf-8'
                unless exists $params{'Content-Type'};
            $params{Content} =<<EOF;
    <html>
      <head>
        <script language="JavaScript"><!--
    location.href = "$params{Location}";
    //--></script>
      </head>
      <body bgcolor="#FFFFFF">
        <a href="$params{Location}">Redirect</a>
      </body>
    EOF
        }
        else {
                $params{Status} = '301 Moved Permanently'
                unless exists $params{Status};
            $params{'Content-Type'} = 'text/plain; charset=utf-8'
                unless exists $params{'Content-Type'};
        }
    
        $params{Expires} = 'Fri, 19 May 1996 00:00:00 GMT'
            unless exists $params{Expires};
        $params{Pragma} = 'no-cache'
            unless exists $params{Pragma};
        $params{'Cache-Control'} = 'no-cache'
            unless exists $params{'Cache-Control'};
    
        my $content = exists $params{Content}
            ? $params{Content} : $params{Status};
        delete $params{Content};
    
        while (my ($key, $value) = each %params) {
            print "$key: $value\n";
        }
        print "\n";
        print $content;
    
        exit 0;
    }
    

    so if I get the rest of your code rite:

    use strict;
    my $file = $ENV{'PATH_TRANSLATED'};
    open (my $fh, '<', $file) or die 'cant open';
    my $url = <$fh>;
    chomp($url);
    redirect_url($url);
    

    would do the job.