Форум программистов [Powered by Invision Power Board]

Код

#!/usr/bin/perl
use Socket;

$rin =  '';
$|=1;

$LSOCK = &start_tcp_server ('tcp', '127.0.0.10', '55555');
select((select($LSOCK), $|=1)[0]);
vec ($rin, fileno($LSOCK), 1) = 1;

while (select ($rout=$rin, undef,undef,undef)) {
  if (vec ($rout, fileno($LSOCK), 1)) {
      accept (SOCKET, $LSOCK);
      select((select(SOCKET), $|=1)[0]);
      vec ($fh, fileno(SOCKET), 1) = 1;
      print vec ($rout, fileno($LSOCK), 1), vec ($rout, fileno(SOCKET), 1), "\n", "New connection...\n";
  }
  if (vec ($rout, fileno(SOCKET), 1)) {
      recv (SOCKET, $msg, 1024, 0);
      print  "recv:$msg\n";
  }
  print "Waiting new data in descriptors...\n";
}    


sub start_tcp_server {   
  my ($socket, $protocol, $ip_addr, $port, $binary_ip, $sockaddr_in);
    
  ($protocol, $ip_addr, $port) = @_;
      
  if ($protocol =~ /^tcp$/i) {print "Error! Code: $!" unless (socket($socket, 2, 1, 6));}    
  
  $binary_ip = inet_aton($ip_addr);
  $sockaddr_in = pack_sockaddr_in ($port, $binary_ip);
  
  bind ($socket, $sockaddr_in);
  listen ($socket, 128);
  return $socket if $socket;
}