dark

A simple TCP server written in Perl

blank
blank

The below example is a very simple TCP server script written in Perl, which uses the AnyEvent module.
It will create a separate process for each connections and has the ability to return data to the parent process.
The below example allows 15 child processes to be created, which results in 15 simultaneous client connections.

The script itself is pretty straight-forward: it creates a server object using IO::Socket::INET and attaches that socket to an AnyEvent IO eventloop. Furthermore, upon every connection, it will call the subroutine fork_call (which is in the AnyEvent::Util module) to open up a client socket.

 
#!/usr/bin/env perl 
use strict;
use warnings;
use utf8;

use IO::Socket::INET;
use AnyEvent;
use AnyEvent::Util;
$AnyEvent::Util::MAX_FORKS = 15;

my $handled = 0;
$|++;

my $server = IO::Socket::INET->new(
    'Proto'     => 'tcp',
    'LocalAddr' => 'localhost',
    'LocalPort' => 1234,
    'Listen'    => SOMAXCONN,
    'Reuse'     => 1,
) or die "can't setup server: $!\n";
print "Listening on localhost:1234\n";

my $cv = AnyEvent->condvar;
my $w; $w = AnyEvent->io(
        fh   => \*{ $server }, 
        poll => 'r', 
        cb   => sub { 
                   $handled++;
                   $cv->begin; 
                   fork_call &handle_connections, 
                             $server->accept, 
                             sub { 
                               my ($client) = @_ ;
                               print " - Client $client closed\n"
                             } 
                    }
);
$cv->recv;

#
# Subroutines
# 
sub handle_connections {
    my ($client) =  @_;

    my $host = $client->peerhost;
    print "[Accepted connection from $host]\n";

    print $client "Hi, you're client #$handled\n";
    chomp ( my $input = <$client> );
    my $output = reverse $input;
    print $client $output, "\n";
    print $client "Bye, bye.\n";

    $cv->end;
    return $host;
}
1 comment
Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Previous Post

OpenSSH 6.2.x and LDAP authentication

Next Post
blank

Google GeoChart, JSON and Perl

Related Posts