#!/usr/bin/perl -w

use strict;
use POSIX ;
use Socket;
use IO::Socket;
use IO::Select;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK O_NDELAY);

my $done=0;
my $select;
my $server;
my $connections=0;

sub print_log {
    print strftime("%b %e %T", localtime)." ";
    print @_;
    print "\n";
}

sub nonblock {
    my $socket = shift;
    my $flags;
    
    $flags = fcntl($socket, F_GETFL, 0)
        or print_log "Can't get flags for socket: $!\n";
    fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
        or print_log "Can't make socket nonblocking: $!\n";
}

######################################################################
+####################

$| = 1;
$done=0;

for my $sig (keys %SIG) {
    $SIG{$sig} = sub { print_log('Signal '.$_[0].' caught!'); };
}

$SIG{__WARN__} = sub { print_log('WARNING: ' . $_[0]); };
$SIG{__DIE__} = sub { print_log('DIE: ' . $_[0]); };
$SIG{PIPE} = 'IGNORE';
$SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{ABRT} = sub { $done = 1; };
    
$server = IO::Socket::INET->new(LocalAddr => "192.168.100.50", LocalPo
+rt => 1024, Listen => 10,
                Proto => "TCP", ReuseAddr => 1 )
    or die "Can't create a server socket: $@";
setsockopt($server,SOL_SOCKET,SO_LINGER,pack("l*",0,0)) || return unde
+f;
nonblock($server);
$select = IO::Select->new($server);
      
print_log "Started";

while(!$done) {
    my $client;
    my $rv;
    my $data;
    
    foreach $client ($select->can_read(1)) {
        if ($client == $server) {
            if( $connections < 5 ) {
                $client = $server->accept();
                $connections++;
                $select->add($client);
                nonblock($client);
                print_log("Connected: ".$client->peerhost.":".$client-
+>peerport);
            } else {
                print_log("The maximum number of simultaneous connecti
+ons reached");
                $client = $server->accept();
                $client->shutdown(2);
                close($client);
            }
        } else {
            $data = '';
            $rv   = $client->recv($data, POSIX::BUFSIZ, 0);
            
            unless (defined($rv) && length $data) {
                print_log("Disconnected: ".$client->peerhost.":".$clie
+nt->peerport);
                $select->remove($client);
                $client->shutdown(2);
                close $client;
                $connections--;
                next;
            }
            
            $data =~ s/\r//go;
            print $data;
        }
        }
}

print_log "Exit";

$server->shutdown(2);
close($server);
[download]