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