#!/usr/local/bin/perl

use lib qw( /home/1/motchie/lib );
use Jcode;
require 'oops.pl';
require 'head.pl';
require 'foot.pl';
require 'tcp.pl';
require 'chkemail.pl';
require 'cgi.pl';

&cgi'Decode;
$query = $cgi'TAGS{'keyword'};

$service = "79";

  $cur = << "EOF";
<a href="http://www.motchie.com/internet/index.html" accesskey="P">Internet Resource Center</a>
&gt; finger &gt; 
<a href="http://www.motchie.com/internet/finger/gateway.html" accesskey="B">WWW to finger Gateway</a> 
&gt; Oops
EOF

  $con = << "EOF";
<p class="Title" align="center">
入力されたE-Mailアドレスが不正です。<br>
E-Mailアドレスを入力し直しておためし下さい。</p>
<p class="Title" align="center">
<a href="http://www.motchie.com/internet/finger/gateway.html" accesskey="B">WWW to finger Gatewayへ戻る</a>
</p>
EOF

print $query;

if (substr($query,0,1) ne "@") {

  unless (&email_check($query)) {
    &cgi'Header;

    &oops($cur, $con);
    exit(0);
  }
}

($username, $remote_host) = split (/@/, $query, 2);

&open_TCP(FINGER, $remote_host, $service)
   || die &oops($cur, $con);
  print FINGER $username, "\n";
  while (<FINGER>) {
    @lines = <FINGER>;
  }
close(FINGER);

unless ( $#lines == -1 ) {
  &cgi'Header;

  $des = "finger gatewayの検索結果のページです。";

  $cur = <<"EOF";
<a href="http://www.motchie.com/internet/index.html" accesskey="P">Internet Resource Center</a> 
&gt; finger &gt; 
<a href="http://www.motchie.com/internet/finger/gateway.html" accesskey="B">WWW to finger Gateway</a> 
&gt; finger query: 
<a href="mailto:$username\@$remote_host">$username\@$remote_host</a>
EOF

  $tit = "finger query: $username\@$remote_host";

  $hea = "WWW to finger Gateway";

  &head($des, $cur, $tit, $hea);

print << "EOF";
<h2 class="Menu">finger query: <a href="mailto:$username\@$remote_host">$username\@$remote_host</a></h2>
<pre>
EOF

$mail_regex =
q{(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\} .
q{\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][} .
q{^\\\x80-\xff\n\015"]*)*")(?:\.(?:[^(\040)<>@,;:".\\\[\]\000-\037\x} .
q{80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\\} .
q{xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*"))*@(?:[^(\0} .
q{40)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000} .
q{-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])} .
q{(?:\.(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;} .
q{:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x} .
q{80-\xff])*\]))*};

foreach $line (@lines) {
   $line = Jcode -> new( $line ) -> euc;
   $line = Jcode -> new( $line ) -> tr('０-９Ａ-Ｚａ-ｚ−', '0-9A-Za-z-');
  $line =~ s/</\&lt;/g;
  $line =~ s/>/\&gt;/g;
  $line =~s#(http://[^()<>\[\]{}"'\x7F-\xFF\x00-\x20]+)#<a href="$1">$1</a>#g;
  $line =~s#($mail_regex)#<a href="mailto:$1">$1</a>#g;
  $line =~ s/\"/\&quot;/g;
  $line =~ s/href\=\&quot;/href\=\"/g;
  $line =~ s/\&quot;\>/\">/g;
  $line =~ s/\t/    /g;
  print $line;
}

print "</pre>\n";

  &foot();

exit(0);
}