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-noredir.cgi < prev    next >
Text File  |  2017-09-21  |  5KB  |  201 lines
  1. #!/usr/local/bin/perl
  2. #
  3. #  file: index.cgi
  4. #  desc: generate default index page based upon browser type
  5. #
  6.  
  7. eval 'exec /usr/local/bin/perl -s $0 ${1+"$@"}'
  8.   if 0;
  9.  
  10. #
  11. # For emergency: pretend we are on the right server.
  12. #
  13. $NOREDIRECT = 1 ;
  14.  
  15. # map of server host names to host.park.org domain
  16. %host2park = (
  17. 'town',      'park.org',
  18. 'ventus',    'adelaide.park.org',
  19. 'amsterdam', 'amsterdam.park.org',
  20. 'phoenix',   'imperial.park.org',
  21. 'seoul',     'korea.park.org',
  22. 'iwe',       'japan.park.org',
  23. 'workplace',       'japan.park.org',
  24. );
  25.  
  26. #
  27. # For debug'ing
  28. #
  29. print "Content-Type: text/plain\n\n";
  30.  
  31. $target = $ENV{'QUERY_STRING'};
  32.  
  33. if ($target eq "") {
  34.     $path = $ENV{'SCRIPT_NAME'};
  35.     @names = split('/', $path);
  36.     $nlen = $#names ;
  37.  
  38.     $myname = &basename($0) ;
  39.     $mybase = &stripext($myname) ;
  40.  
  41. #print "myname = $myname\n";
  42. #print "mybase = $mybase\n";
  43. #print "SCRIPT_NAME = $path\n";
  44. #print "nlen = $nlen\n";
  45. #print "names[0] = $names[0]\n";
  46. #print "names[1] = $names[1]\n";
  47. #print "names[2] = $names[2]\n";
  48. #print "names[3] = $names[3]\n";
  49.  
  50.     if ($names[$nlen] eq $myname) {
  51.         $nlen = $nlen - 1 ;
  52.     }
  53.  
  54.     $tgtpath = "/" . join('/', @names[1 .. $nlen]) . "/" ;
  55.  
  56. print "tgtpath = $tgtpath\n";
  57. }
  58.  
  59. # get FQDN park.org host name for this particular server
  60. chop($park_host = `/sbin/uname -n`);
  61. $park_host = $host2park{(split(/\./, $park_host))[0]};
  62.  
  63. #
  64. # In case a brand new server pops up.
  65. # XXX We should feedback this fact back.
  66. #
  67. #print "park_host = $park_host\n" ;
  68.  
  69. if ($park_host eq "") {
  70.     $park_host = "japan.park.org";
  71. }
  72.  
  73. # non-buffered STDOUT
  74. $| = 1;
  75.  
  76. # attempt to redirect based upon incoming domain and address
  77. $rem_host = $ENV{'REMOTE_HOST'};
  78. $rem_addr = $ENV{'REMOTE_ADDRESS'};
  79. # Escape for non-redirection
  80. if ($NOREDIRECT) {
  81.     $rem_host = "" ;
  82.     $rem_addr = "" ;
  83. }
  84. if ($rem_host) {
  85.     if ($park_host !~ /japan/ &&
  86.          (
  87.           ($rem_host =~ /\.jp$/i) ||
  88.           ($rem_host eq "japan.park.org")
  89.          ) ) {
  90.         &redirect("japan.park.org", $tgtpath);
  91.     } elsif ($park_host !~ /imperial/ && $rem_host =~ /\.uk$/i) {
  92.         &redirect("imperial.park.org", $tgtpath);
  93.     } elsif ($park_host !~ /adelaide/ && $rem_host =~ /\.au$/i) {
  94.         &redirect("adelaide.park.org", $tgtpath);
  95.     } elsif ($park_host !~ /seoul/ && $rem_host =~ /\.kr$/i) {
  96.         &redirect("korea.park.org", $tgtpath);
  97.     } elsif ($park_host !~ /amsterdam/ &&
  98.              (
  99.               ($rem_host =~ /\.al$|\.am$|\.at$|\.az$/i) ||
  100.               ($rem_host =~ /\.be$|\.bg$|\.by$/i)       ||
  101.               ($rem_host =~ /\.ch$|\.cy$|\.cz$/i)       ||
  102.               ($rem_host =~ /\.dz$/i)                   ||
  103.               ($rem_host =~ /\.eg$|\.es$/i)             ||
  104.               ($rem_host =~ /\.ge$|\.gr$/i)             ||
  105.               ($rem_host =~ /\.hr$|\.hu$/i)             ||
  106.               ($rem_host =~ /\.ie$/i)                   ||
  107.               ($rem_host =~ /\.li$/i)                   ||
  108.               ($rem_host =~ /\.ma$|\.md$|\.mk$|\.mt$/i) ||
  109.               ($rem_host =~ /\.nl$/i)                   ||
  110.               ($rem_host =~ /\.pt$/i)                   ||
  111.               ($rem_host =~ /\.ro$|\.ru$/i)             ||
  112.               ($rem_host =~ /\.si$|\.sk$|\.su$/i)       ||
  113.               ($rem_host =~ /\.tn$/i)                   ||
  114.               ($rem_host =~ /\.ua$/i)                   ||
  115.               ($rem_host =~ /\.va$/i)                   ||
  116.               ($rem_host =~ /\.yu$/i)
  117.              ) ) {
  118.         &redirect("amsterdam.park.org", $tgtpath);
  119.     }
  120. }
  121.  
  122. #
  123. # Last resort for accesses from expo96.ad.jp domain without
  124. # reverse lookup entry.
  125. #
  126. if ($rem_addr) {
  127.     @addr = split($rem_addr, '.');
  128.     if ($addr[0] == 133 && $addr[1] == 246) {
  129.         &redirect("japan.park.org", $tgtpath) ;
  130.         exit 0;
  131.     }
  132. }
  133.  
  134. #&redirect($park_host, $target);
  135. #
  136. # We are on the right server.  Feed out the index.html or whatever
  137. # appropriate.
  138. #
  139.  
  140. #
  141. # Make sure we print MIME type
  142. #
  143. print "Content-Type: text/html\n\n";
  144.  
  145. #
  146. # Look for a right file.
  147. #
  148.  
  149. $target = &stripext($0) . ".html" ;
  150.  
  151. #print "target = $target\n" ;
  152.  
  153. unless (open(TGTFILE, $target)) {
  154.     print "<HTML><HEAD><TITLE>\n" ;
  155.     print "Directory Index Redirection Error\n" ;
  156.     print "</TITLE></HEAD><BODY>\n" ;
  157.     print "<H1>Directory Index Redirection Error</H1>\n" ;
  158.     print "Could not find target directory index file.<BR>\n" ;
  159.     print "Please contact shinoda\@jaist.ac.jp<BR>\n" ;
  160.     print "</BODY></HTML>\n" ;
  161.     exit 0 ;
  162. }
  163.  
  164. while (<TGTFILE>) {
  165.     print $_ ;
  166. }
  167.  
  168. exit 0;
  169.  
  170. #
  171. # redirect to specified URL
  172. #
  173. sub redirect {
  174.     local($redirhost, $redirfile) = @_;
  175.     local($logfile) = '/var/log/park-redirect.log';
  176.  
  177.     $url = "http://" . $redirhost . $redirfile ;
  178.  
  179.     # keep track of redirected hosts for debugging
  180.     system("/bin/echo $ENV{'SCRIPT_NAME'} $ENV{'QUERY_STRING'} >> $logfile");
  181.     system("/bin/echo \"[`date`]: $rem_host -> $url\" >> $logfile");
  182.  
  183.     print "Status: 302\n";       # redirect status code
  184.     print "Location: $url\n\n";  # where they should go...
  185.  
  186.     exit 0;
  187. }
  188.  
  189. sub basename {
  190.     local($path) = @_ ;
  191.     @pmem = split('/', $path) ;
  192.     @pmem[$#pmem];
  193. }
  194.  
  195. sub stripext {
  196.     local($name) = @_ ;
  197.     @elms = split('\.', $name) ;
  198.     pop(@elms) ;
  199.     join('.', @elms) ;
  200. }
  201.