redirect.pl | WebReference

redirect.pl

redirect.pl Source
1  #!/usr/bin/perl -w
2  # redirect.pl - redirects a browser to the URL contained in QUERY_STRING
3  # by Jonathan Eisenzopf. v1.0 19990818
4  # Copyright (c) 1999 Jupitermedia Corp. All Rights Reserved.
5  # See http://www.webreference.com/perl for more information
6  #
7  # This program is free software; you can redistribute it and/or modify
8  # it under the terms of the GNU General Public License as published by
9  # the Free Software Foundation; either version 2 of the License, or
10  # (at your option) any later version.              
11  
12  use strict;
13  use CGI;
14  use CGI::Carp;
15  use URI;
16  
17  # CONSTANTS
18  my $restricted = 1;
19  my %ok_hosts = ('www.webreference.com' => 1,
20  		'www.internet.com' => 1,
21  		'www.webdeveloper.com' => 1,
22  		'www.wdvl.com' => 1
23  		);
24  
25  # MAIN
26  my $q = new CGI;
27  
28  # print error if QUERY_STRING is empty
29  &error("Must specify URL") unless defined $q->keywords;
30  
31  # print error if there is no HTTP referer
32  &error("Cannot run script directly") unless defined $q->referer;
33  
34  # get referer URL
35  my $referer = new URI($q->referer);
36  
37  # print error if $restricted is on and referer is not in @ok_hosts
38  &error("Host ".$referer->host." is not allow to redirect")
39      if $restricted && !exists($ok_hosts{$referer->host});
40  
41  # redirect
42  print $q->redirect($q->keywords);
43  
44  # SUBROUTINES
45  sub error {
46      my $message = shift;
47      print $q->header;
48      print "<H1>$message</H1>";
49      die "$message";
50  }