home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Internet 1996 World Exposition
/
park.org.s3.amazonaws.com.7z
/
park.org.s3.amazonaws.com
/
cgi-bin
/
Japan
/
index.cgi
< prev
next >
Wrap
Text File
|
2017-09-21
|
5KB
|
210 lines
#!/usr/local/bin/perl
#
# file: index.cgi
# desc: generate default index page based upon browser type
#
eval 'exec /usr/local/bin/perl -s $0 ${1+"$@"}'
if 0;
#
# Redirect or not. For emergency, set $REDIRECT to 0.
#
$REDIRECT = 1 ;
# map of server host names to host.park.org domain
%host2park = (
'town', 'park.org',
'ventus', 'adelaide.park.org',
'amsterdam', 'amsterdam.park.org',
'phoenix', 'imperial.park.org',
'seoul', 'korea.park.org',
'iwe', 'japan.park.org',
'workplace', 'japan.park.org',
);
#
# For debug'ing
#
$debug = $ENV{'DEBUG'};
print "Content-Type: text/plain\n\n" if $debug ;
$target = $ENV{'QUERY_STRING'};
if ($target eq "") {
$path = $ENV{'SCRIPT_NAME'};
@names = split('/', $path);
$nlen = $#names ;
$myname = &basename($0) ;
$mybase = &stripext($myname) ;
print "myname = $myname\n" if $debug > 100 ;
print "mybase = $mybase\n" if $debug > 100 ;
print "SCRIPT_NAME = $path\n" if $debug > 100 ;
print "nlen = $nlen\n" if $debug > 100 ;
print "names[0] = $names[0]\n" if $debug > 100 ;
print "names[1] = $names[1]\n" if $debug > 100 ;
print "names[2] = $names[2]\n" if $debug > 100 ;
print "names[3] = $names[3]\n" if $debug > 100 ;
if ($names[$nlen] eq $myname) {
$nlen = $nlen - 1 ;
}
$tgtpath = "/" . join('/', @names[1 .. $nlen]) . "/" ;
print "tgtpath = $tgtpath\n" if $debug ;
}
# get FQDN park.org host name for this particular server
chop($park_host = `/sbin/uname -n`);
$park_host = $host2park{(split(/\./, $park_host))[0]};
#
# In case a brand new server pops up.
# XXX We should feedback this fact back.
#
#print "park_host = $park_host\n" ;
if ($park_host eq "") {
$park_host = "japan.park.org";
}
# non-buffered STDOUT
$| = 1;
#
# attempt to redirect based upon incoming domain and address
#
if ($REDIRECT == 1) {
print "generating remote info\n" if $debug ;
$rem_host = $ENV{'REMOTE_HOST'};
$rem_addr = $ENV{'REMOTE_ADDRESS'};
} else {
print "no redirection specified\n" if $debug ;
$rem_host = "";
$rem_addr = "";
}
print "park_host = $park_host\n" if $debug ;
print "rem_host = $rem_host, rem_addr = $rem_addr\n" if $debug ;
if ($rem_host) {
if ($park_host !~ /japan/ &&
(
($rem_host =~ /\.jp$/i) ||
($rem_host eq "japan.park.org")
) ) {
&redirect("japan.park.org", $tgtpath);
} elsif ($park_host !~ /imperial/ && $rem_host =~ /\.uk$/i) {
&redirect("imperial.park.org", $tgtpath);
} elsif ($park_host !~ /adelaide/ && $rem_host =~ /\.au$/i) {
&redirect("adelaide.park.org", $tgtpath);
} elsif ($park_host !~ /seoul/ && $rem_host =~ /\.kr$/i) {
&redirect("korea.park.org", $tgtpath);
} elsif ($park_host !~ /amsterdam/ &&
(
($rem_host =~ /\.al$|\.am$|\.at$|\.az$/i) ||
($rem_host =~ /\.be$|\.bg$|\.by$/i) ||
($rem_host =~ /\.ch$|\.cy$|\.cz$/i) ||
($rem_host =~ /\.dz$/i) ||
($rem_host =~ /\.eg$|\.es$/i) ||
($rem_host =~ /\.ge$|\.gr$/i) ||
($rem_host =~ /\.hr$|\.hu$/i) ||
($rem_host =~ /\.ie$/i) ||
($rem_host =~ /\.li$/i) ||
($rem_host =~ /\.ma$|\.md$|\.mk$|\.mt$/i) ||
($rem_host =~ /\.nl$/i) ||
($rem_host =~ /\.pt$/i) ||
($rem_host =~ /\.ro$|\.ru$/i) ||
($rem_host =~ /\.si$|\.sk$|\.su$/i) ||
($rem_host =~ /\.tn$/i) ||
($rem_host =~ /\.ua$/i) ||
($rem_host =~ /\.va$/i) ||
($rem_host =~ /\.yu$/i)
) ) {
&redirect("amsterdam.park.org", $tgtpath);
}
}
#
# Last resort for accesses from expo96.ad.jp domain without
# reverse lookup entry.
#
if ($rem_addr) {
@addr = split($rem_addr, '.');
if ($addr[0] == 133 && $addr[1] == 246) {
&redirect("japan.park.org", $tgtpath) ;
exit 0;
}
}
#&redirect($park_host, $target);
#
# We are on the right server. Feed out the index.html or whatever
# appropriate.
#
#
# Make sure we print MIME type
#
print "Content-Type: text/html\n\n";
#
# Look for a right file.
#
$target = &stripext($0) . ".html" ;
#print "target = $target\n" ;
unless (open(TGTFILE, $target)) {
print "<HTML><HEAD><TITLE>\n" ;
print "Directory Index Redirection Error\n" ;
print "</TITLE></HEAD><BODY>\n" ;
print "<H1>Directory Index Redirection Error</H1>\n" ;
print "Could not find target directory index file.<BR>\n" ;
print "Please contact shinoda\@jaist.ac.jp<BR>\n" ;
print "</BODY></HTML>\n" ;
exit 0 ;
}
while (<TGTFILE>) {
print $_ ;
}
exit 0;
#
# redirect to specified URL
#
sub redirect {
local($redirhost, $redirfile) = @_;
local($logfile) = '/var/log/park-redirect.log';
$url = "http://" . $redirhost . $redirfile ;
# keep track of redirected hosts for debugging
system("/bin/echo $ENV{'SCRIPT_NAME'} $ENV{'QUERY_STRING'} >> $logfile");
system("/bin/echo \"[`date`]: $rem_host -> $url\" >> $logfile");
print "Status: 302\n"; # redirect status code
print "Location: $url\n\n"; # where they should go...
exit 0;
}
sub basename {
local($path) = @_ ;
@pmem = split('/', $path) ;
@pmem[$#pmem];
}
sub stripext {
local($name) = @_ ;
@elms = split('\.', $name) ;
pop(@elms) ;
join('.', @elms) ;
}