The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

Net::Server::NonBlocking - An object interface to non-blocking I/O server engine

VERSION

0.48

SYNOPSIS

        use Net::Server::NonBlocking;
        $|=1;

        $obj=Net::Server::NonBlocking->new();
        $obj->add({
                server_name => 'tic tac toe',
                local_port => 10000,
                timeout => 60,
                delimiter => "\n",
                on_connected => \&ttt_connected,
                on_disconnected => \&ttt_disconnected,
                on_recv_msg => \&ttt_message
        });
        $obj->add({
                server_name => 'chess',
                local_port => 10001,
                timeout => 120,
                delimiter => "\r\n",
                on_connected => \&chess_connected,
                on_disconnected => \&chess_disconnected,
                on_recv_msg => \&chess_message
        });

        $obj->start;

DESCRIPTION

You can use this module to establish non-blocking style TCP servers without being messy with the hard monotonous routine work.

This module is not state-of-the-art of non-blocking server, it consumes some additional memories and executes some extra lines to support features which can be consider wasting if you do not plan to use. However, at present, programming time is often more expensive than RAM and CPU clocks.

LIMITATION

At present, the module handles concurrency with "select"(to eschew waste polling), which limits the number of clients that it can hold(In my linux box(kernel 2.4.18-14) the number is approximately 512). There are 3 choices I'm thinking of, use poll instead, handle multiple of IO::Select objects, or leave this limititation unchange.

FEATURES

*Capable of handling multiple server in a single process

It is possible since it uses "select" to determine which server has events, then delivers them to some appropriate methods.

*Timer

You can tell the module to execute some functions every N seconds.

*Timeout

Clients that are idle(sending nothing) in server for a configurable period will be disconnected.

*Turn timeout

The meaning of this feature is hard to explain without stimulating a case. Supposing that you write a multi-player turn-based checker server, you have to limit the times that each users spend before sending their move which can easily achieve by client side clock, however, it is not secure. That's why I have to write this feature.

METHOD

new ([$hash_ref])

$hash_ref->{pidfile} location where pid will be kept default is /tmp/anonymous_server

add ($hash_ref)

hash two mode. If $hash_ref->{localport} is given, the module will initialize a server socket binding to IO::Select object. If not the module initialize server information without creating server socket. (See USAGE for all $hash_ref's key & value)

bind ($server_name,$user_define_socket)

to bind a socket, which is not the client of your listening server, to the server_name.

The usage of this function is while you are processing some messages, you create a client socket to somewhere and you would like the module to handle this socket for you like server socket. For example:

$obj=Net::Server::NonBlocking->new;

$obj->add({ server_name => 'tic tac toe', local_port => 10000, timeout => 60, delimiter => "\r\n", on_connected => \&ttt_connected, on_disconnected => \&ttt_disconnected, on_recv_msg => \&ttt_message });

$obj->add({ server_name => 'user socket', timeout => 60, delimiter => "\0", on_disconnected => \&user_disconnected, on_recv_msg => \&user_message });

$obj->start;

sub ttt_message { my $self=shift; my $client=shift; my $data=shift;

    if ($data eq 'connect') {
        my $sock = IO::Socket::INET->new(PeerAddr => '192.168.3.209',
                                      PeerPort => '3456',
                                      Proto    => 'tcp');
        $self->bind('user socket',$sock);
    }
}  

sub user_message { my $self=shift; my $client=shift; my $data=shift;

    $self->enqueue($client,"send something to 192.168.3.209\0");
}

sub user_disconnected {

}

get_server_socket ($server_name)

return $socket of the given server_name

get_server_name ($client)

return server_name of the given $client

start_turn($client, $second, \&code)

start count down from $second to zero, if zero is reached the module will activate the code with $self and $client as parameters. (see usage for more information)

reset_turn($client)

stop the count down process

flush_output($client)

send all data in out buffer queue, this operation can be blocked, if the $client is not available for writing.

enqueue($client,$data)

to append the out buffer of the client with $data which will be transmit to the client later in the apropriate time.

start()

start listening all added socket server.

cron($second,$code,[@param])

to activate the $code every $second seconds.

erase_client($server_name,$client)

erase the $client from the responsibility of the module. It also activate on_disconnected callback and close $client socket.

close_client($server_name,$client)

erase the $client from the responsibility of the module. It closes $client socket without activate on_disconnected callback.

USAGE

Even though, the module make it easy to build a non-blocking I/O server, but I don't expect you to remeber all its usages. Here is the template to build a server:

        use Net::Server::NonBlocking;
        $SIG{PIPE}='IGNORE';
        $|=1;

        $obj=Net::Server::NonBlocking->new();
        $obj->add({
                server_name => 'tic tac toe',
                local_port => 10000,
                timeout => 60,
                delimiter => "\n",
                on_connected => \&ttt_connected,
                on_disconnected => \&ttt_disconnected,
                on_recv_msg => \&ttt_message
        });
        $obj->add({
                server_name => 'chess',
                local_port => 10001,
                timeout => 120,
                delimiter => "\r\n",
                on_connected => \&chess_connected,
                on_disconnected => \&chess_disconnected,
                on_recv_msg => \&chess_message
        });

        sub ttt_connected {
                my $self=shift;
                my $client=shift;

                print $client "welcome to tic tac toe\n";
        }
        sub ttt_disconnected {
                my $self=shift;
                my $client=shift;

                print "a client disconnects from tic tac toe\n";
        }
        sub ttt_message {
                my $self=shift;
                my $client=shift;
                my $message=shift;

                # process $message
        }

        sub chess_connected {
                my $self=shift;
                my $client=shift;

                print $client "welcome to chess server\r\n";
        }
        sub chess_disconnected {
                my $self=shift;
                my $client=shift;

                print "a client disconnects from chess server\n";
        }
        sub chess_message {
                my $self=shift;
                my $client=shift;
                my $message=shift;

                # process $message
        }

        $obj->start;

You can pass a parameter to the "new method". It is something like this:

        ->new({
                        pidfile => '/var/log/pidfile'
                });

However, when ignoring this parameter, the pidfile will be '/tmp/anonymous_server' by default.

The "add medthod" has various parameters which means:

*Mandatory parameter

        -server_name    different text string to distinguish a server from others

        -local_port     listening port of the added server

*Optional parameter

        -local_address: If your server has to listen all addresses in its machine, you must not pass this parameter, otherwise my internal logic will screw up. This parameter should be specify when you want to listen to a specific address. For example,

                local_address => '203.230.230.114'


    (** By Default, the module assumes that your TCP protocol has "message delimiter", unless you define your own buffer fetching mechanism, provided by a callback named "read_buffer". OK, I'll mention it later.)

        -delimiter: Every sane protocol should have a or some constant characters for splitting a chunk of texts to messages. If your protocol has inconsistent delimiters, you should write your own code.

                Default is "\0"

        -string_format: By default, string format is ".*?". In the parsing process, the module executes something like this "while ($buffer =~ s/($string_format)$delimiter//) {" and throw $1 to on_recv_msg. In the case that your protocol has no "delimiter" and each message is a single character, you might have to do this:

                        delimiter => '',
                        string_format => '.'

        -timeout: to set timeout for idle clients, the default value is 300 or 5 minutes

        -on_connected: callback method for an incoming client, parameters passed to this callback is illustrated with this code:

                sub {
                        my $self=shift;
                        my $client=shift;
                }

        - on_disconnected: callback method when a client disconnects

                sub {
                        my $self=shift;
                        my $client=shift;
                }

        - on_recv_msg: callback method when a client sends a message to server

                sub {
                        my $self=shift;
                        my $client=shift;
                        my $message=shift;
                }

The 'add' method creates a socket(derived from IO::Socket::INET) binding with the local_address, and local_port and also return the socket to caller to do other socket initializations.

A disadvange of the design is passing parameters to on_connected,on_disconnected and on_recv_msg. Since these callback function will be activated by this package namespace, the only way to use external parameters is by defining global variable which is not a good aspect to deal with OO Design. For example:

        sub chess_connected {
                my $self=shift;
                my $client=shift;

                #you have to define $move as a global variable..
                $move=$move+1
        }

However, if your chess server is written as a class, you might have "$self->{move}". It is generally accepted that $self is autometically pass to methods when they are called, thus it shouldn't defined as a global variable. Consider this:

        package ChessServer;

        sub new {
                my $class=shift;
                my $self={};
                $self->{server}=Net::Server::NonBlocking->new();
                $self->{move}=0;

                # blablabla

                bless $self,$class;
        }

You won't get $self->{move} or $self->{xxxxx}, since $self is not global. Nevertheless, you can build your class by inheriting from this module you can solve the problem, but someone might said "I do not want to inherit from this class", so I've provided three parameters of the "add methods" to be able to pass external parameters.

        - on_connected_param

        - on_disconnected_param

        _ on_recv_msg_param

For example:

        $self->{server}->add({
                                server_name => 'chess',
                                local_address => $public_ip,
                                local_port => $public_port,
                                timout => 60,
                                on_connected => \&chess_connected,
                                on_disconnected => \&chess_disconnected,
                                on_recv_msg => \&chess_msg,
                                on_connected_param => [\$self,\%blablabla],
                        });

And in the chess_connected, the parameters is passed like this

        sub chess_connected {
                my $self=shift;
                my $client=shift;
                my $chess=${$_[0]};
                my %blablalba=%{$_[1]};
        }

Does this approach mitigate the problem? I don't know !!!

Sending data back to clients could be implemented by --

        print $client "data\0"    #for small amount of data

or while (1) { #large data or slow connection my $sent=send($client, $data, 0);

              substr($data,0,$sent,'') if defined $sent;
              last unless $data;
        }

or $self->enqueue($client,$data); # put data to non-block output queue, most efficient !?

**caution: don't mix $self->enqueue with the other methods, unless unexpected results will occur.

**caution: enqueue doesn't send messages instantly, but queue messages to output queue. It can raise unexpected result, if you code something like this:

    $self->enqueue($client,$data);
    $self->erase_client($server_name,$client);
    # $data won't be sent to the $client, since after the data is put to the output queue, the client is disconnected.

which can be solve by flush_output method like this:

    $self->enqueue($client,$data);
    $self->flush_output($client);   #send all output_queue to $client
    $self->erase_client($server_name,$client);

Let's me introduce a callback function which make the module support broader TCP protocols. It is:

    sub read_buffer {
        my $self=shift;
        my $raw_input=shift;
        my $cooked_input=shift;
        my $server_name=shift;

        my $dm=$self->{listen}->{$server_name}->{delimiter};
        my $sf=$self->{listen}->{$server_name}->{string_format};

        while ($$raw_input =~ s/($sf)$dm//s) {
            push( @{$$cooked_input}, $1 );
        }
    }

By default, if you don't provide "read_buffer" parameter to the "add" function, your buffer_fetching mechanism will be the code above. The problem is that the default buffer fetching machanism is designed to work with protocols ended with some delimiters in each message, so if my protocol send a content-length appended with \r\n and the next is data which length is equal to the content-length, the subroutine will not work. It has to be modified something like this:

     $obj->add({
              ...,
              ...,
              read_buffer => \&my_buffer_reader
          });

     sub my_buffer_reader {
         my $self=shift;
         my $raw_input=shift;
         my $cooked_input=shift;
         my $server_name=shift;

         for (;;) {
             last unless $$raw_input =~ m/Content-length: (\d+)\r\n/;
             last unless $$raw_input =~ s/Content-length: $1\r\n(.{$1})//s;
             push (@{$$cooked_input}, $1);
         }
     }

** $raw_input is reference to input buffer the current client ** $cooked_input is reference to array reference of the current client incoming messages passed to on_recv_msg

Anyway, if you want to set a timer. You have to do something like this before calling "start" method:

        $obj->cron(30,sub {
                        my $self=shift;
                        #do something
                },@param);

30 is seconds that the CODE will be triggered. For setting turn timeout:

        $obj->start_turn($client,$limit_time, sub {
                                                my $self=shift;
                                                my $client=shift;
                                                my @param=@_;

                                                # mark this client as the loser
                                        };

        $obj->reset_turn($client); #to clear limit_timer for a client

Let's see another usage for turn timer:

        sub kuay {
                my $self=shift;
                my $client=shift;

                print "timeout !\n";
        }

        my $toggle=0;

        sub chess_message {
            my $self=shift;
            my $client=shift;
            my $request=shift;

            $toggle^=1;

            if ($toggle) {
                $self->start_turn($client,2*60,\&kuay);
            } else {
                $self->stop_time($client);
            }
        }

To disconnect a client from a server, just call

        $self->erase_client($server_name,$client);

To get socket from each added server, inorder to set its property, for example:

        $sock=$self->get_server_socket($server_name);
        setsockopt($sock,SOL_SOCKET,SO_KEEPALIVE,1);
        setsockopt($sock,IPPROTO_TCP,&TCP_KEEPALIVE,120);

EXPORT

None

SEE ALSO

There're always more than one way to do it, see "Perl Cook Book" in non-blocking I/O section.

POE -- a big module to do concurrent execution

IO::Multiplex -- I/O Multiplexing server style, the only little thing that differ to this module is that the module assumes that all clients' messages are arriving fast. Entire server will be slow down if there are a group of clients whose messages are delays which are generally caused by their internet connection.

Net::Server -- another server engine implementations such as forking, preforking or multiplexing

PLATFORM

Currently, only unix. It has been tested on Linux with perl5.8.0. Win32 platform should be supported in the future.

AUTHOR

Komtanoo Pinpimai <romerun@romerun.com>

COPYRIGHT AND LICENSE

Copyright 2002 (c) Komtanoo Pinpimai <romerun@romerun.com>. All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.