#!/usr/bin/perl
################################################################
# pskkserv(perl5) version 5.0                         1996.12.18
#
# This software is placed in the public domain.
#
# pskkserv version 0.1                          1995.6.15
#         Written by Masaaki Sato <msatoh@mrit.mei.co.jp>
#               Matsushita Research Institute Tokyo, Inc. 
#                      Human Interface Research Laboratry
#                                     Tel    044-911-6351
#                                     Fax    044-911-8760
#
# pskkserv version 0.2                          1996.9.27
#  Modified by Mikio Nakajima <GY2M-NKJM@asahi-net.or.jp>
#   $B!&(Bskk-server-version $B$KBP1~$G$-$F$$$J$+$C$?$N$G!"$3$l$r=$@5!#(B
#   $B!&(Bskkserv $B$H%*%W%7%g%s$N<h$jJ}$r9g$o$;$?!#(B
#   $B!&@55,I=8=%^%C%A$r;HMQ$7$J$/$H$b:Q$`8D=j$r=$@5!#(B
#   $B!&$=$NB>:Y$+$$:GE,2=!#(B
#
# pskkserv version 0.3	                         1996.10.14
#  Modified by Masaaki Sato
#   $B!&(Bzombie process $B$N@8@.$rM^;_!#(B
#   $B!&(B-B $B%*%W%7%g%s$G(B perl5 (Berkeley DB) $BBP1~!#(B
#   $B!&(B-G $B%*%W%7%g%s$G(B perl5 (GDBM) $BBP1~!#(B
#
# pskkserv version 0.4	                         1996.10.15
#  Modified by Masaaki Sato
#	$B!&(B-G $B;~$N(B use $B$rK:$l$F$$$?$N$G=$@5!#(B
#
# pskkserv version 0.5	                         1996.10.16
#  Modified by Masaaki Sato
#	$B!&(Bsetsockopt $BDI2C!#(B
#
# pskkserv version 5.0                           1996.12.18
#  Modified by Masaaki Sato
#   $B!&(B-p $B$r;XDj$;$:!"$+$D(B /etc/services $B$K(B skkserv $B$N(B
#     $B9`L\$,$J$$>l9g$O%G%U%)%k%H$H$7$F(B 1178 $B$rMxMQ!#(B
#   $B!&(BNOT FOUND $B;~$NF0:n$r(B skkserv $B$K9g$o$;$k!#(B
#   $B!&(Bdeamon like $B$JF0:n$K9g$o$;$k!#(B
#       thanks to $B;3K\(B@$BElBg>pJs2J3X2J(B<ymmt@is.s.u-tokyo.ac.jp>$BEB(B
#   $B!&(BSocket.pm $B;HMQ$KH<$&ITMW$JJQ?t$N:o=|!#(B
#   $B!&<u?.%3%^%s%I$NHf3S$r?tCM$+$iJ8;zNs$KJQ99!#(B
#       thanks to $BFA20(B<tokuya@crab.fuji-ric.co.jp>$BEB(B
################################################################

require "getopts.pl";
&Getopts('p:dBG');

use Socket;

if (defined $opt_B){
	use DB_File;
	use Fcntl;
}elsif (defined $opt_G){
	use GDBM_File;
}

$version="pskkserv-5.0 of 1996.12.18";

$opt_p = "skkserv" unless $opt_p;
$port = $opt_p;
($dicname) = @ARGV;
$dicname = $ENV{'SKK_JISYO'} unless $dicname;
die "Usage: pskkserv [-p port] [-d] [-B|G] dic-file-name\n" unless $dicname;
$sockaddr = 'S n a4 x8';

($name, $aliases, $proto) = getprotobyname('tcp');

if ($port !~ /^\d+$/){
  ($name, $aliases, $port) = getservbyname($port, 'tcp');
  $port = 1178 unless defined $port;
}

$hostname=$ENV{"HOST"};
if ( $hostname ){
  ($hostname, $haliases, $haddrtype, $hlength,@haddr) = gethostbyname($hostname);
  ($a,$b,$c,$d)=unpack('C4',$haddr[0]);
  $hostaddr="$hostname:$a.$b.$c.$d:";
}

$local = pack($sockaddr, AF_INET, $port, "\0\0\0\0");

if ($opt_d) {
  print "\npskkserv version ", substr($version, 9), " by msatoh\@mrit.mei.co.jp\n";
  print "and GY2M-NKJM\@asahi-net.or.jp\n\n";
  print "Host: ", $hostaddr, "\nPort: ", $port, "\nDic: ", $dicname, "\n\n";
}

select(NS); $| = 1; select(stdout);

socket(S, AF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(S, $proto, SO_REUSEADDR, 1);
bind(S, $local) || die "bind: $!";
listen(S, 5) || die "listen: $!";

select(S); $| = 1; select(stdout);

if (defined $opt_B){
	tie %DIC, DB_File, $dicname, O_RDONLY, 0440, $DB_HASH;
}elsif (defined $opt_G){
	tie %DIC, GDBM_File, $dicname, GDBM_READER, 0440, 0;
}else{
	dbmopen(%DIC,$dicname,0444);
}

unless ($opt_d){
  if (fork() != 0){
  	exit;
  }
}

for ($con = 1;  ; $con++){
  printf("Listening for connection %d ...\n", $con) if $opt_d;
  ($addr = accept(NS, S)) || die $!;
  
  if (($mid = fork()) == 0){
   if (($child = fork()) == 0){
    print "accept OK\n" if $opt_d;
    ($af, $port, $inetaddr) = unpack($sockaddr, $addr);
    @inetaddr = unpack('C4', $inetaddr);
    print $con, ": ", $af, $port, @inetaddr, "\n" if $opt_d;
    
    while(read(NS, $command, 1) != 0){
      (($command eq "\n") || ($command eq "\r")) && next;
      print "Command received: ", $command, " --\n" if $opt_d;
      if ($command eq '1'){
        $char="";
        $key="";
        while(read(NS, $char, 1) != 0){
          last if ($char eq " ");
          $key .= $char;
        }
        print "<<", $key, ">>\n" if $opt_d;
        $ans=$DIC{$key};
        if (defined($ans)){
            print "-- ", $ans, " --\n" if $opt_d;
            print NS "1", $ans, "\n";
          }else{
            print "-- Not found --\n" if $opt_d;
            print NS "4",$key,"\n";
          }
      }
      elsif ($command eq '2'){
        print NS $version, " ";
      }
      elsif ($command eq '3'){
        print NS $hostaddr, " ";
      }
      elsif ($command eq '0'){
        close(NS);
        exit;
      }
      else {
        print NS "0";
      }
    }
   }
   exit;
  }
  wait;
  close(NS);
}

if (defined $opt_B || defined $opt_G){
	untie(%DIC);
}else{
	dbmclose(%DIC);
}
