File: server

package info (click to toggle)
plum 2.33.1-9
  • links: PTS
  • area: main
  • in suites: sarge, woody
  • size: 908 kB
  • ctags: 128
  • sloc: perl: 4,442; makefile: 51
file content (138 lines) | stat: -rwxr-xr-x 3,235 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#!/usr/bin/perl -w
# $Id: server,v 2.10 1999/01/20 15:06:31 hasegawa Exp $
# copyright (c)1997-1999 Yoshinori Hasegawa <hasegawa@madoka.org>

if ($] < 5) {
  foreach $inc (@INC) {
    if (-r "$inc/sys/socket.ph") {
      eval 'require "sys/socket.ph"';
      $SOCKET = "$inc/sys/socket.ph" unless $@;
      last;
    }
    if (-r "$inc/socket.ph") {
      eval 'require "socket.ph"';
      $SOCKET = "$inc/socket.ph" unless $@;
      last;
    }
  }
} else {
  eval 'use Socket';
  $SOCKET = 'Socket.pm' unless $@;
}

$NIL = $;;

$READSIZE = 1024;
$SOCKADDR = 'S n N x8';

$PROTO = (getprotobyname('tcp'))[2];

$AF_INET = eval '&AF_INET' || 2;
$PF_INET = eval '&PF_INET' || 2;
$SOCK_STREAM = eval '&SOCK_STREAM' || 1;
$SOMAXCONN = eval '&SOMAXCONN' || 16;
$INADDR_ANY = eval '&INADDR_ANY' || "\0\0\0\0";
$SOL_SOCKET = eval '&SOL_SOCKET';
$SO_REUSEADDR = eval '&SO_REUSEADDR';

$'rin = '';

$handle = 0;

select((select(STDOUT), $| = 1)[0]);

$SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');

&main(@ARGV);

sub main {
  local(@args) = @_;
  local($rout, $lno, $sno, $stdin, $socket, $nf, $tmp);
  if (@args < 1) {
    &usage();
    exit(1);
  }
  $lno = &'listen(@args) || die "cannot listen port\n";
  $sno = &'accept($lno) || die "cannot accept client\n";
  $socket = $'socket[$sno];
  $stdin = fileno(STDIN);
  vec($'rin, $stdin, 1) = 1;
  for (;;) {
    $nf = select($rout = $'rin, undef, undef, undef);
    if (vec($rout, $sno, 1)) {
      $tmp = '';
      if (sysread($socket, $tmp, $READSIZE)) {
        print STDOUT $tmp;
      } else {
        &'close($sno);
        exit(0);
      }
    } elsif (vec($rout, $stdin, 1)) {
      $tmp = '';
      if (sysread(STDIN, $tmp, $READSIZE)) {
        print $socket $tmp;
      } else {
        &'close($sno);
        exit(0);
      }
    }
  }
}

sub usage {
  print 'usage: perl server <port>', "\n";
}

sub 'listen {
  local($port, $count) = @_;
  local($listenno, $socket, $name);
  $socket = '\'L' . ++$handle;
  socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  if (defined($SOL_SOCKET) && defined($SO_REUSEADDR)) {
    setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1));
  }
  $name = pack($SOCKADDR, $AF_INET, $port, unpack('N', $INADDR_ANY));
  bind($socket, $name) || return 0;
  listen($socket, $count || $SOMAXCONN) || return 0;
  $listenno = fileno($socket);
  vec($'rin, $listenno, 1) = 1;
  $'socket[$listenno] = $socket;
  select((select($socket), $| = 1)[0]);
  $'access[$listenno] = time();
  return $listenno;
}

sub 'accept {
  local($listenno) = @_;
  local($clientno, $socket);
  $socket = '\'C' . ++$handle;
  accept($socket, $'socket[$listenno]) || return 0;
  binmode($socket);
  $clientno = fileno($socket);
  vec($'rin, $clientno, 1) = 1;
  $'socket[$clientno] = $socket;
  select((select($socket), $| = 1)[0]);
  $'access[$clientno] = time();
  return $clientno;
}

sub 'close {
  local($no) = @_;
  close($'socket[$no]);
  vec($'rin, $no, 1) = 0;
}

sub 'exist {
  local($list, @items) = @_;
  return 0 unless $list;
  $list .= $NIL;
  foreach $item (@items) {
    return 1 if index("\L$list\E", $NIL . "\L$item\E" . $NIL) != -1;
  }
  return 0;
}

sub 'list {
  local(@array) = @_;
  return join($NIL, '', @array);
}