Viewing file:  rredir.pl (1.68 KB) -rwxr-xr-x
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/usr/bin/perl -T -w
#
# rredir.pl
#
# Author: Peter Eisenhauer <pe@pipetronix.de>
# First Version: 26. May 1997
#
# Description: Direct all request to files who are in a local dir to
# this directory
#
use File::Basename;
use URI::URL;
# customization part
# Local Domainame from which no redirects should be done
$localdomain = 'pipetronix.de';
# Local domainame qouted for regexps
$regexlocaldomain = quotemeta($localdomain);
# Path under which the scripts accesses the local dir (must end with /)
$access_local_dir='/opt/utils/etc/httpd/htdocs/local-rredir/';
# Information for the redirected URL (redirect_path must end with /)
$redirect_scheme = 'http';
$redirect_host = 'ws-server.pipetronix.de';
$redirect_path = 'local-rredir/';
# end of customization part
# flush after every print
$| = 1;
# Process lines of the form 'URL ip-address/fqdn ident method'
# See release notes of Squid 1.1 for details
while ( <> ) {
($url, $addr, $fqdn, $ident, $method) = m:(\S*) (\S*)/(\S*) (\S*) (\S*):;
$url = url $url;
$host = lc($url->host);
# do not process hosts in local domain or unqualified hostnames
if ( $host =~ /$regexlocaldomain/ || $host !~ /\./ ) {
next;
}
# just the file, without any host or path parts
# and just in case: lowercase the file name, so you should make sure
# all the files in the local dir are only lowercase !!
$file = lc(basename($url->path));
# look if in local dir, if yes redirect
if ( $file && -r $access_local_dir . $file
&& $file ne '.' && $file ne '..' ) {
$url->scheme($redirect_scheme);
$url->host($redirect_host);
$url->path($redirect_path . $file);
}
} continue {
print "$url $addr/$fqdn $ident $method\n"
}
|