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 / WIDE / listup < prev    next >
Text File  |  2017-09-21  |  6KB  |  293 lines
  1. #! /usr/local/bin/perl
  2.  
  3. require '/usr/local/lib/perl/chat2.pl';
  4.  
  5. $persondb = '~suna/db/members';
  6. $companydb = '~suna/db/company';
  7.  
  8. # check the validity of the environment variables
  9. #&checkvalid;
  10.  
  11. # obtain query argument
  12. #if ($ENV{'REQUEST_METHOD'} eq 'GET') {
  13. #    $query = $ENV{'QUERY_STRING'};
  14. #} else {
  15. #    $query = <STDIN>;
  16. #}
  17. $query = $ENV{'QUERY_STRING'};
  18. #$query = $ARGV[0];
  19.  
  20. ## separate parameters
  21. foreach $i (split(/\+/, $query)) {
  22.     foreach $hex ($i =~ /\%([0-9A-F][0-9A-F])/g) {
  23.         eval '$i =~ ' . "s/\\%$hex/\\x$hex/g";
  24.     }
  25.     $i =~ s:/:\\x2F:g;
  26.     $i =~ s/\`/\\x60/g;
  27.     $i =~ s/\</\<\;/g;
  28.     $i =~ s/\>/\>\;/g;
  29.     $i =~ s/\&/\&\;/g;
  30.     $i =~ s/\$/\\x24/g;
  31.     push(@keywords, $i);
  32. }
  33.  
  34. $keywords[0] = $ARGV[0];
  35. if ($ARGV[1]) {
  36.     $keywords[1] = $ARGV[1];
  37. }
  38.  
  39. if (scalar(@keywords) == 0 || scalar(@keywords) > 2) {
  40.     exit 1;
  41. }
  42. $mailinglist = $keywords[0];
  43. $japanese = 0;
  44. if ($keywords[1] eq 'japanese') {
  45.     $japanese = 1;
  46. }
  47.  
  48. &readdb;
  49.  
  50. $ok = 0;
  51. if ($mailinglist eq 'board'
  52.  || $mailinglist eq 'wide'
  53.  || $mailinglist =~ /-?tf$/
  54.  || $mailinglist =~ /-?wg$/) {
  55.     $ok = 1;
  56. }
  57. if (! $ok) {
  58.     exit 1;
  59. }
  60.  
  61. @members = &expn($mailinglist, 'sh.wide.ad.jp');
  62.  
  63. print "Content-type: text/html\n\n";
  64. print "<HTML>\n";
  65. print "<HEAD><TITLE>WIDE mailing list $mailinglist@wide.ad.jp</TITLE></HEAD>\n";
  66. print "<BODY>\n";
  67. print "<H1>Member of $mailinglist@wide.ad.jp</H1>\n";
  68. print "<UL>\n";
  69. foreach $i (@members) {
  70.     $name = $mailaddr = $homepage = $companyaddr = $company = $companyhomepage = '';
  71.     if ($i =~ /<([^>]*)>/) {
  72.         $mailaddr = $1;
  73.         $i =~ s/<([^>]*)>//;
  74.         $i =~ s/\s+/ /g;
  75.         $i =~ s/^\s+//;
  76.         $i =~ s/\s+$//;
  77.         $name = $i;
  78.     } else {
  79.         $mailaddr = $i;
  80.         $name = '';
  81.     }
  82.  
  83.     # special rule
  84.     next if ($mailaddr =~ /^\\wide/);
  85.  
  86.     # search for the name
  87.     $tmp = $mailaddr;
  88. nameloop:
  89.     while (&domainlen($tmp) >= 3) {
  90.         if ($name{$tmp}) {
  91.             $mailaddr = $tmp;
  92.             $name = $name{$mailaddr};
  93.             last nameloop;
  94.         }
  95.         $tmp = &shorten($tmp);
  96.     }
  97.  
  98.     # search for the company
  99.     $tmp = $mailaddr;
  100. companyloop:
  101.     while (&domainlen($tmp) >= 2) {
  102.         if ($company{&domainname($tmp)}) {
  103.             $companyaddr = &domainname($tmp);
  104.             $company = $company{$companyaddr};
  105.             last companyloop;
  106.         }
  107.         $tmp = &shorten($tmp);
  108.     }
  109.  
  110.     if ($japanese && $jname{$mailaddr}) {
  111.         $name = $jname{$mailaddr};
  112.     }
  113.     if ($homepage{$mailaddr}) {
  114.         $homepage = $homepage{$mailaddr};
  115.     }
  116.  
  117.     if ($japanese && $jcompany{$companyaddr}) {
  118.         $company = $jcompany{$companyaddr};
  119.     }
  120.     if ($companyhomepage{$companyaddr}) {
  121.         $companyhomepage = $companyhomepage{$companyaddr};
  122.     }
  123.  
  124.     # pretty print
  125.     print "<LI> ";
  126.     if ($name) {
  127.         if ($homepage) {
  128.             print "<A HREF=$homepage>$name</A>: ";
  129.         } else {
  130.             print "$name: ";
  131.         }
  132.     }
  133.     print $mailaddr;
  134.     if ($company) {
  135.         if ($companyhomepage) {
  136.             print ", <A HREF=$companyhomepage>$company</A>\n";
  137.         } else {
  138.             print ", $company\n";
  139.         }
  140.     }
  141. }
  142. print "</UL>\n";
  143. print "</BODY></HTML>\n";
  144.  
  145. exit 0;
  146.  
  147. #------------------------------------------------------------
  148. sub shorten {
  149.     local($addr) = @_;
  150.     local($user, $domain, @tmp);
  151.  
  152.     ($user, $domain) = split('@', $addr);
  153.     @tmp = split(/\./, $domain);
  154.     shift(@tmp);
  155.     return $user . '@' . join('.', @tmp);
  156. }
  157.  
  158. sub domainlen {
  159.     local($addr) = @_;
  160.     local($user, $domain, @tmp);
  161.  
  162.     ($user, $domain) = split('@', $addr);
  163.     @tmp = split(/\./, $domain);
  164.     return scalar(@tmp);
  165. }
  166.  
  167. sub domainname {
  168.     local($addr) = @_;
  169.     local($user, $domain);
  170.     ($user, $domain) = split('@', $addr);
  171.     return $domain;
  172. }
  173.  
  174. #------------------------------------------------------------
  175. sub readdb {
  176.     local($account);
  177.  
  178.     undef %name;
  179.     undef %jname;
  180.     undef %homepage;
  181.     undef %company;
  182.     undef %jcompany;
  183.     undef %companyhomepage;
  184.     if (! open(DB, $persondb)) {
  185.         return;
  186.     }
  187.     while (<DB>) {
  188.         chop;
  189.         split(/\t+/);
  190.         next if (! ($_[0] && $_[0] ne '-'));
  191.  
  192.         $account = $_[0];
  193.         if ($_[1] && $_[1] ne '-') {
  194.             $name{$account} = $_[1];
  195.         }
  196.         if ($_[2] && $_[2] ne '-') {
  197.             $jname{$account} = $_[2];
  198.         }
  199.         if ($_[3] && $_[3] ne '-') {
  200.             $homepage{$account} = $_[3];
  201.         }
  202.     }
  203.     close(DB);
  204.  
  205.     if (! open(DB, $companydb)) {
  206.         return;
  207.     }
  208.     while (<DB>) {
  209.         chop;
  210.         split(/\t+/);
  211.         next if (! ($_[0] && $_[0] ne '-'));
  212.         if ($_[1] && $_[1] ne '-') {
  213.             $company{$_[0]} = $_[1];
  214.         }
  215.         if ($_[2] && $_[2] ne '-') {
  216.             $jcompany{$_[0]} = $_[2];
  217.         }
  218.         if ($_[3] && $_[3] ne '-') {
  219.             $companyhomepage{$_[0]} = $_[3];
  220.         }
  221.     }
  222.     close(DB);
  223. }
  224.     
  225. #------------------------------------------------------------
  226. sub expn {
  227.     local($list, $host) = @_;
  228.     local(@ret, @result);
  229.  
  230.     &chat'open_port($host, 25);
  231.  
  232.     &expectexpn('220');
  233.     &chat'print("helo\n");
  234.     &expectexpn('250');
  235.     &chat'print("expn $list\n");
  236.     @ret = &expectexpn('250');
  237.  
  238.     @result = ();
  239.     foreach $i (@ret) {
  240.         $i =~ s/^250[- ]//;
  241.         push(@result, $i);
  242.     }
  243.     &finishexpn;
  244.     return @result;
  245. }
  246.  
  247. sub expectexpn {
  248.     local($arg) = @_;
  249.     local(@result);
  250.     $timeout = 30;
  251.     @expectarg = ('TIMEOUT', 'exit 1;',
  252.               'EOF', 'exit 1;');
  253.  
  254.     $pre = '^';
  255.     if( $arg =~ /^\d+$/ ){
  256.         $pre = "[.|\n]*^";
  257.     }
  258.  
  259.     push(@expectarg, "$pre(" . $arg . "-.*)\\015\\012");
  260.     push(@expectarg, 'push(@result, $1); 10;');
  261.     push(@expectarg, "$pre(" . $arg . " .*)\\015\\012");
  262.     push(@expectarg, 'push(@result, $1); 0;');
  263.     push(@expectarg, "^(.*)\\015\\012");
  264.     push(@expectarg, 'print $1; 5;');
  265.  
  266.     while (1) {
  267.         $ret = &chat'expect($timeout, @expectarg);
  268.  
  269.         return @result if ($ret == 0);
  270.         &finishexpn if ($ret == 5);
  271.         next if ($ret == 10);
  272.     }
  273. }
  274.  
  275. sub finishexpn {
  276.     &chat'print("quit\n");
  277.     &chat'close;
  278. }
  279.  
  280. sub checkvalid {
  281.     if (! defined($ENV{'REQUEST_METHOD'})) {
  282.         exit 1;
  283.     }
  284.     if (! defined($ENV{'PATH_INFO'})) {
  285.         exit 1;
  286.     }
  287.     if ($ENV{'REQUEST_METHOD'} eq 'GET') {
  288.         if (! defined($ENV{'QUERY_STRING'})) {
  289.             exit 1;
  290.         }
  291.     }
  292. }
  293.