home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_26_1.lzh / support / server < prev   
Text File  |  1998-07-31  |  3KB  |  144 lines
  1. #!/bin/perl -w
  2. # $Id: server,v 2.5 1998/07/31 09:39:44 hasegawa Exp $
  3. # copyright (c)1997-1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. if ($] < 5) {
  6.   foreach $inc (@INC) {
  7.     if (-r "$inc/sys/socket.ph") {
  8.       eval { require 'sys/socket.ph' };
  9.       $SOCKET = "$inc/sys/socket.ph" unless $@;
  10.       last;
  11.     }
  12.     if (-r "$inc/socket.ph") {
  13.       eval { require 'socket.ph' };
  14.       $SOCKET = "$inc/socket.ph" unless $@;
  15.       last;
  16.     }
  17.   }
  18. } else {
  19.   eval 'use Socket';
  20.   $SOCKET = 'Socket.pm' unless $@;
  21. }
  22.  
  23. $NIL = $;;
  24.  
  25. $READSIZE = 1024;
  26. $SOCKADDR = 'S n a4 x8';
  27.  
  28. $PROTO = getprotobyname('tcp');
  29.  
  30. $AF_INET = eval { &AF_INET } || 2;
  31. $PF_INET = eval { &PF_INET } || 2;
  32. $SOCK_STREAM = eval { &SOCK_STREAM } || 1;
  33. $SOMAXCONN = eval { &SOMAXCONN } || 16;
  34. $INADDR_ANY = eval { &INADDR_ANY } || "\0\0\0\0";
  35. $SOL_SOCKET = eval { &SOL_SOCKET};
  36. $SO_REUSEADDR = eval { &SO_REUSEADDR };
  37. $SO_KEEPALIVE = eval { &SO_KEEPALIVE };
  38.  
  39. $'rin = '';
  40.  
  41. $handle = 0;
  42.  
  43. select((select(STDOUT), $| = 1)[0]);
  44.  
  45. $SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');
  46.  
  47. &main(@ARGV);
  48.  
  49. sub main {
  50.   local(@args) = @_;
  51.   local($rout, $lno, $sno, $stdin, $socket, $nf, $tmp);
  52.   if (@args < 1) {
  53.     &usage();
  54.     exit(1);
  55.   }
  56.   $lno = &'listen(@args) || die "cannot listen port\n";
  57.   $sno = &'accept($lno) || die "cannot accept client\n";
  58.   $socket = $'socket[$sno];
  59.   $stdin = fileno(STDIN);
  60.   vec($'rin, $stdin, 1) = 1;
  61.   for (;;) {
  62.     $nf = select($rout = $'rin, undef, undef, undef);
  63.     if (vec($rout, $sno, 1)) {
  64.       $tmp = '';
  65.       if (sysread($socket, $tmp, $READSIZE)) {
  66.         print STDOUT $tmp;
  67.       } else {
  68.         &'close($sno);
  69.         exit(0);
  70.       }
  71.     } elsif (vec($rout, $stdin, 1)) {
  72.       $tmp = '';
  73.       if (sysread(STDIN, $tmp, $READSIZE)) {
  74.         print $socket $tmp;
  75.       } else {
  76.         &'close($sno);
  77.         exit(0);
  78.       }
  79.     }
  80.   }
  81. }
  82.  
  83. sub usage {
  84.   print 'usage: perl server <port>', "\n";
  85. }
  86.  
  87. sub 'listen {
  88.   local($port, $count) = @_;
  89.   local($listenno, $socket);
  90.   $socket = '\'L' . ++$handle;
  91.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  92.   if (defined($SOL_SOCKET)) {
  93.     setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1)) if defined($SO_REUSEADDR);
  94.     setsockopt($socket, $SOL_SOCKET, $SO_KEEPALIVE, pack('l', 1)) if defined($SO_KEEPALIVE);
  95.   }
  96.   bind($socket, pack($SOCKADDR, $AF_INET, $port, $INADDR_ANY)) || return 0;
  97.   listen($socket, $count || $SOMAXCONN) || return 0;
  98.   $listenno = fileno($socket);
  99.   vec($'rin, $listenno, 1) = 1;
  100.   $'socket[$listenno] = $socket;
  101.   select((select($socket), $| = 1)[0]);
  102.   $'access[$listenno] = time();
  103.   return $listenno;
  104. }
  105.  
  106. sub 'accept {
  107.   local($listenno) = @_;
  108.   local($clientno, $socket);
  109.   $socket = '\'C' . ++$handle;
  110.   accept($socket, $'socket[$listenno]) || return 0;
  111.   $clientno = fileno($socket);
  112.   vec($'rin, $clientno, 1) = 1;
  113.   $'socket[$clientno] = $socket;
  114.   select((select($socket), $| = 1)[0]);
  115.   $'access[$clientno] = time();
  116.   return $clientno;
  117. }
  118.  
  119. sub 'close {
  120.   local($no) = @_;
  121.   close($'socket[$no]);
  122.   vec($'rin, $no, 1) = 0;
  123. }
  124.  
  125. sub 'exist {
  126.   local($list, @items) = @_;
  127.   return 0 unless $list;
  128.   foreach $item (@items) {
  129.     return 1 if index("\L$list\E", $NIL . "\L$item\E" . $NIL) != -1;
  130.   }
  131.   return 0;
  132. }
  133.  
  134. sub 'list {
  135.   local(@array) = @_;
  136.   local($list);
  137.   if (scalar(@array)) {
  138.     $list = $NIL . join($NIL, @array) . $NIL;
  139.   } else {
  140.     $list = '';
  141.   }
  142.   return $list;
  143. }
  144.