nikos has asked for the wisdom of the Perl Monks concerning the following question:

Hi monks!

I've got a problem here. I wrote a simple non-blocking TCP server. The code listed below is extracted from the server's code. Actually, it's based on the code from O'Reilly books. It listens for incoming connections and prints everything it receives. It can process several clients at the same time. The server is written using IO::Socket and IO::Select. The problem is that $select->can_read(1) returns only when I have a newline character in the string received. How do I receive data character-by-character? I mean like a typewriter when I can see what the client is typing. The code is:

#!/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]

Thank you!

Replies are listed 'Best First'.
Re: A non-blocking server using 'select' calls
by tachyon (Chancellor) on Nov 11, 2004 at 10:06 UTC

    See IO::Socket::INET -- Jettero verses non-blocking in windows for lots of stuff. That is raw socket code but your problem is simply that you need to read one byte at a time if you want to do *teletype mode*. At the moment you read POSIX::BUFSIZ which is probably 512 bytes, thus the blocking while it waits for the rest of the data. s/POSIX::BUFSIZ/1/ and all should be happy.

    cheers

    tachyon

[reply]
[d/l]
      Thank you for a reply. I'll read it. It seems like can_read waits for a newline character before it sees something like it's buffering the input.
[reply]

        Sorry that aint necessarily so. Here is some trivial code that does the teletype thing. The client(s) have no way to disconnect BTW, that is left as an exercise for the reader yada yade. 

        #!/usr/bin/perl
$|++;
use IO::Socket;
use IO::Select;
my $lsn = IO::Socket::INET->new( 
    Listen    => 10,
    LocalAddr => 'localhost',
    LocalPort => 9000
);
my $client = new IO::Select( $lsn );
while( my @ready = $client->can_read ) {
    for my $fh (@ready) {
        if($fh == $lsn) {
            warn "Accepted new socket\n";
            my $new = $lsn->accept;
            $client->add($new);
        }
        else {
            # process socket
            sysread($fh, $_, 1 );
            print;   # NB syswrite(STDOUT,$_,1) will be unbuffered by 
+default
        }
    }
}

        [download]

        Note that sysread bypasses STDIO and all buffering. Read will sort of buffer (newlines only in this one byte reading config). I never use recv so really have NFI what it does.

        cheers

        tachyon

[reply]
[d/l]
Re: A non-blocking server using 'select' calls
by nikos (Scribe) on Nov 11, 2004 at 12:47 UTC
    Telnet and Netcat on Unix do not send the user's input unless it's terminated with a newline character. Vandyke SecureCRT (Telnet) does the same. Telnet in Windows sends character-by-character. BTW SSH in SecureCRT works fine symbol-by-symbol. It looks to me it depends on terminal emulation mode. Any ideas? Thanks
[reply]

      As you and tachyon eventually discovered, this is a client thing. Different clients use different ways to determine when to send single characters or wait for an entire line. If you need a client that does exactly what you want, then you will probably have to write your own.

[reply]

Back to Seekers of Perl Wisdom