home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_15_4.lzh / support / pserver < prev    next >
Text File  |  1997-12-19  |  2KB  |  82 lines
  1. #!/bin/perl -w
  2. # $Id: pserver,v 2.4 1997/12/19 20:54:07 hasegawa Exp $
  3. # copyright (c)1997 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. $SOCKADDR = 'S n a4 x8';
  6. $PROTO = getprotobyname('tcp');
  7.  
  8. if ($] < 5) {
  9.   foreach $inc (@INC) {
  10.     if (-r "$inc/sys/socket.ph") {
  11.       eval 'require "sys/socket.ph"';
  12.       $SOCKET = "$inc/sys/socket.ph" unless $@;
  13.       last;
  14.     }
  15.   }
  16. } else {
  17.   eval 'use Socket';
  18.   $SOCKET = 'Socket.pm' unless $@;
  19. }
  20.  
  21. $AF_INET = eval { &AF_INET } || 2;
  22. $PF_INET = eval { &PF_INET } || 2;
  23. $SOCK_STREAM = eval { &SOCK_STREAM } || 1;
  24. $SOMAXCONN = eval { &SOMAXCONN } || 16;
  25. $INADDR_ANY = eval { &INADDR_ANY } || "\0\0\0\0";
  26. $SOL_SOCKET = eval { &SOL_SOCKET};
  27. $SO_REUSEADDR = eval { &SO_REUSEADDR };
  28. $SO_KEEPALIVE = eval { &SO_KEEPALIVE };
  29.  
  30. &main(@ARGV);
  31.  
  32. sub main {
  33.   local(@args) = @_;
  34.   local($port, $rin, $rout, $serv, $stdin, $nf, $left, $cbuf, $sbuf, $tmp);
  35.   if (@args < 1) {
  36.     &usage();
  37.     exit(1);
  38.   }
  39.   ($port) = @args;
  40.   socket(LISTEN, $PF_INET, $SOCK_STREAM, $PROTO) || die "cannot create socket\n";
  41.   if (defined($SOL_SOCKET)) {
  42.     setsockopt(LISTEN, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1)) if defined($SO_REUSEADDR);
  43.     setsockopt(LISTEN, $SOL_SOCKET, $SO_KEEPALIVE, pack('l', 1)) if defined($SO_KEEPALIVE);
  44.   }
  45.   bind(LISTEN, pack($SOCKADDR, $AF_INET, $port, $INADDR_ANY)) || die "cannot bind address\n";
  46.   listen(LISTEN, 1) || die "cannot listen\n";
  47.   accept(SOCKET, LISTEN);
  48.   $serv = fileno(SOCKET);
  49.   $stdin = fileno(STDIN);
  50.   $rin = '';
  51.   vec($rin, $serv, 1) = 1;
  52.   vec($rin, $stdin, 1) = 1;
  53.   select((select(SOCKET), $| = 1)[0]);
  54.   select((select(STDIN), $| = 1)[0]);
  55.   select((select(STDOUT), $| = 1)[0]);
  56.   $cbuf = $sbuf = $tmp = '';
  57.   for (;;) {
  58.     ($nf, $left) = select($rout = $rin, undef, undef, undef);
  59.     if (vec($rout, $serv, 1)) {
  60.       sysread(SOCKET, $tmp, 1024) || die "connection closed\n";
  61.       $sbuf .= $tmp;
  62.       while ((($next, $rest) = split(/[\r\n]+/, $sbuf, 2)) == 2) {
  63.         print STDOUT $next, "\n";
  64.         $sbuf = $rest || '';
  65.       }
  66.       $sbuf = $next || '';
  67.     } elsif (vec($rout, $stdin, 1)) {
  68.       sysread(STDIN, $tmp, 1024) || die "connection closed\n";
  69.       $cbuf .= $tmp;
  70.       while ((($next, $rest) = split(/[\r\n]+/, $cbuf, 2)) == 2) {
  71.         print SOCKET $next, "\n";
  72.         $cbuf = $rest || '';
  73.       }
  74.       $cbuf = $next || '';
  75.     }
  76.   }
  77. }
  78.  
  79. sub usage {
  80.   print 'usage: perl pserver <port>', "\n";
  81. }
  82.