Re^5: Does IO::Select work? Anywhere?

[zentara]

in reply to Re^4: Does IO::Select work? Anywhere?
in thread Does IO::Select work? Anywhere?

And this is teaching material??

Sure, it taught me alot. To get away from your obsession on readline, try this slightly modified version. I can kill the client's xterm, before I send any newline, and the server stays responsive to new and other connections.

Server:

#!/usr/bin/perl
######################################################################
+####
#
# Slightly hacked and heavily documented Server example from
# the book Programming Perl, 1st Edition.   I don't use the module sup
+port
# for sockets much because I want the details to be out in the open 
# (primarily so people can take their Perl sockets knowledge and move 
+to
# other languages easily).
#
# I've rearranged some of the source to put related things side-by-sid
+e,
# too (The 'pack' and 'bind', for example).
#
# Hacking and documentation by Prof. Golden G. Richard III, Dept. of 
# Computer Science, University of New Orleans, April 1996-March 1998.
#
# Command line arguments expected are:    port
#
######################################################################
+####
#
# Preliminary notes:
# 
# You see the $! thing all over the place.  Perl special variables beg
+in
# with $ and there are a LOT of them!   $! stands for "the current sys
+tem
# error".  So if something goes wrong with a system call, $! provides 
+a
# diagnosis.  If you've ever used 'errno' or 'perror' in C or C++, thi
+s
# is similar.

# Perl socket stuff is based on, and very similar to, C socket stuff. 
+ 
# The Unix man pages for the various socket system calls such as 
# 'listen', 'bind', etc. may be very useful to you.  To get 
# information on a particular call, such as 'accept', use the followin
+g
# command:
# 
#  % man -s3N accept
#
# The -s3N tells man to look in 3N section of the Unix manual, a secti
+on
# that's not searched by default.
#
# For the assignments, use port addresses in the range 5000-6000.   
# If you get an "address already in use" error, try a different port.
#
######################################################################
+####

# In Perl 5 and above, the Socket module contains Perl definitions for
+ 
# the stuff in the C include file "/usr/include/sys/socket.h".  
# Rather than manually poking through that include file to get values
# for each architecture, a "use Socket" assures that you'll get the ri
+ght
# values.  This replaces the following lines in the example in the boo
+k:
# 
# $AF_INET = 2;
# $SOCK_STREAM = 1;
#
# which turn out to be wrong for Solaris, anyway 
# ($SOCK_STREAM should be 2)

use Socket;

# Sucks in the command line arguments (resident in the array variable 
+ARGV)
# and assigns them to the variables listed in ().  In this case, the f
+irst
# command line argument is the port [more on this later] and it's
# placed into the variable 'port'.

($port) = @ARGV;

# This checks to see if 'port' has been assigned a value and if it has
+n't, 
# assigns the default port value 2345

$port = 2345 unless $port;

# Looks up important information related to the network protocol you w
+ish
# to use.   'tcp' is a connection-oriented protocol.  Look in 
# /etc/protocols for examples of others.   Don't change this unless yo
+u
# know what you're doing.

($name, $aliases, $protocol) = getprotobyname('tcp');

# The following line illustrates both how terse Perl can be AND how co
+ol
# Perl can be.   $port is the port the user specified either on the
# command line or by default.   =~ is the Perl regular expression bind
+ing
# operator and !~ is the negation of =~.    Regular expressions are
# enclosed between / / characters in Perl.   \d matches a single digit
+, 
# \d+ matches a string of 1 or more digits, ^ specifies "beginning of 
# string", and $ specifies "end of string".    /^\d+$/ as a regular
# expression, therefore, matches integers of arbitrary length.
# SO...   The following line says:  "If the port contains any non-digi
+t
# characters, look up the port number associated with the symbolic
# name specified by the user.   The lookup is done against /etc/servic
+es.

if ($port !~ /^\d+$/) {
     ($name, $aliases, $port) = getservbyport($port, 'tcp');
}

# Let the user know what port we're listening on, just in case (s)he
# accidentally typed an incorrect port.

print "Listening on port $port...\n";

# 'socket' creates one endpoint for a communication link (think of it 
+as 
# creating a telephone. Later, someone else will create another teleph
+one
# and wires will be attached between them).   The S parameter is the h
+andle
# associated with the created communication endpoint.    AF_INET speci
+fies
# that we're talking using ports.   AF_UNIX would specify that we'd be
# communicating through special files created in the filesystem.  This
# is very attractive because then you can do away with the port number
+ 
# business, but unfortunately AF_UNIX sockets only work on the same 
# machine. SOCK_STREAM sockets communicate using streams of characters
+.
# Another possibility is unreliable datagram communication using 
# SOCK_DGRAM. Just stick with the parameters used here unless you 
# know what you're doing, because there are other implications you nee
+d
# to understand for datagram communication.

# In case you're wondering, the AF_INET and SOCK_STREAM symbols are
# provided by the 'use Socket;' statement at the top of the file. 
# You do NOT want to put $'s in front of these symbols.  

# The 'die' causes execution to terminate with an error message ( whic
+h is
# stored in $_) if the 'socket' call fails.

socket(S,AF_INET,SOCK_STREAM,$protocol) || die "socket : $!";

# so we can restart our server quickly
# The setsockopt function used in the Solution allows you to 
# avoid waiting two minutes after killing your server before you 
# restart it again (valuable in testing)
# setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
setsockopt(S, SOL_SOCKET, SO_REUSEADDR, 1);


# The 'bind' hooks your phone to the port number that was specified.
# Think of all the ports as a telephone switchboard.  'bind' requires 
+its
# parameters to be in a C structure format.  'pack' smooshes things
# together into a form that 'bind' can stomach.  The $sockaddr thing b
+elow
# says "An unsigned short, followed by a short in 'network order',
# followed by a null-padded 4 character string, followed by 8 null
# bytes."  It's magic.  Don't worry too much about it.

$sockaddr = 'S n a4 x8';
$this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
bind(S, $this) || die "bind : $!";

# The following arranges to queue up as many as 10 clients until we
# have a chance to service them.  If more than 10 clients "get in line
+",
# the excess may receive "connection refused" errors.

listen(S,10) || die "listen: $!";

# Select S temporarily as the default output channel, turn on 
# autoflushing, then select standard output again.

select(S);
$| = 1;
select(STDOUT);

# Create connections as clients "arrive".  $con maintains the connecti
+on 
# number of the last client

for ($con = 1; ; $con++) {

     # Let the user know we're waiting for a connection...

     printf("Waiting for connection %d....\n", $con);

     # 'accept' blocks until it notices that a connection has been mad
+e
     # to our socket S.  When this occurs, the incoming connection is
     # actually attached to the socket NS rather than S, thus leaving 
     # S free for other incoming connections.

     # One more time, said another way:
     #
     # When we hear the the telephone S ringing,  we quickly transfer
     # the call to a different phone (NS) to accept the call.
     # This allows S to stay free for the next call.  Make sense?

     # The value that's returned (in $addr) gives some information abo
+ut
     # the address of the caller.

     ($addr = accept(NS,S)) || die $!;

     # Temporarily set default output to the handle NS so...
 
     select(NS);

     # ...so we can set autoflushing.  Setting $| to a non-zero value 
+causes 
     # output to the currently selected output channel to be immediate
+ly
     # flushed.

     $| = 1;

     # Set default output back to the standard output channel

     select(STDOUT);

     # The 'fork' creates a child process to handle this client.
     # Remember that 'fork' returns 0 for the child and a positive num
+ber
     # for the parent.

     if (($child = fork()) == 0) {

       # We're the child...

           # unpack the information returned by 'accept' to get some
           # (readable) information about the client we're serving and
       # print it to standard output

           ($af,$port, $inetaddr) = unpack($sockaddr, $addr);
           @inetaddr = unpack('C4', $inetaddr);

           print "Serving connection $con @ Internet address @inetaddr
+\n";

           # NS is the handle for the socket we're listening to;
           # it's connected to the current client.
           # <NS> reads and returns the next line of input from the 
           # handle NS.   The following while loop form is a special P
+erl
           # construct that reads input from the handle NS line by lin
+e
           # until the end of file is reached.   Each line is placed i
+nto
           # the special Perl variable $_ (the Perl "default value"
       # variable).

           while (<NS>) {
              # output stuff from client here and...

              print "Received from client $con: $_";

          # ...and echo it back to the client, too.

          print NS "Server $con: $_";
           }

           # Close the socket connection when the client goes away

           close(NS);
 
           # The forked server dies here
           print "Client went away.  Forked server $con exiting...\n";
           exit;
     }
  
     # this is where the parent returns; all we do is close the socket
     # connection (it's being handled by the child we fork'ed) and the
+n
     # enter another iteration of the big for loop.

     close(NS);
} 

Client:

#!/usr/bin/perl
######################################################################
+####
#
# Slightly hacked and heavily documented simple Client example from
# the book Programming Perl, 1st Edition. I don't use the module suppo
+rt
# for sockets much because I want the details to be out in the open 
# (primarily so people can take their Perl sockets knowledge and move 
+to
# other languages easily).
#
# Some things are done a little differently than in the server example
+s
# to give you a little more experience with Perl constructs.
#
# This client accepts input from standard input, sends the input to a
# server, and sends responses from the server to standard output.
#
# Hacking and documentation by Prof. Golden G. Richard III, Dept. of 
# Computer Science, University of New Orleans, April 1996-March 1998.
#
# Command line arguments expected are:    serverIPaddress, port
#
######################################################################
+####
#
# Perl socket stuff is based on, and very similar to, C socket stuff. 
+ 
# The Unix man pages for the various socket system calls such as 
# 'listen', 'bind', etc. may be very useful to you.  To get 
# information on a particular call, such as 'accept', use the followin
+g
# command:
# 
#  % man -s3N accept
#
# The -s3N tells man to look in 3N section of the Unix manual, a secti
+on
# that's not searched by default.
#
# Use port addresses in the range 5000-6000 for the assignments.
# If you get an "address already in use" error, try a different port.
#
######################################################################
+####
    
# In Perl 5 and above, the Socket module contains Perl definitions for
+ 
# the stuff in the C include file "/usr/include/sys/socket.h".  
# Rather than manually poking through that include file to get values
# for each architecture, a "use Socket" assures that you'll get the ri
+ght
# values.  This replaces the following lines in the example in the boo
+k:
# 
# $AF_INET = 2;
# $SOCK_STREAM = 1;
#
# which turn out to be wrong for Solaris, anyway... 
# ($SOCK_STREAM should be 2)
    
use Socket;

# Sucks in the command line arguments (resident in the array variable 
+ARGV)
# and assigns them to the variables listed in ().  In this case, the f
+irst
# is the IP address of the machine on which the server is
# (hopefully) running.  The second is the port on which the server is 
# listening. 
    
($them,$port) = @ARGV;

# This checks to see if 'port' has been assigned a value and if it has
+n't, 
# assigns the default port value 2345.   If 'them' (the machine on whi
+ch
# the server is running) hasn't been assigned a value, 'localhost' is
# assumed.  This means that the server is on the same machine as the 
# client (us).

$port = 2345 unless $port;
$them = 'localhost' unless $them;

# This sets up a signal handler to kill the child we'll create later 
# in the event that we die

$SIG{'Int'} = 'dokill';

# This is a subprogram that does the killing.   The variable $child is
# initially undefined, so we won't try to kill a non-existant child.
# Later it will be the PID of the child we create.

sub dokill {
    kill 9, $child if $child;
}

# Strings in back quotes like `ls` run the Unix command inside the quo
+tes
# and return the output.   The hostname command returns the name of th
+e
# machine we're running on.   'chop' removes the newline character in 
+the
# output from the hostname command.

chop($hostname = `hostname`);

# Looks up important information related to the network protocol you w
+ish
# to use.   'tcp' is a connection-oriented protocol.  Look in 
# /etc/protocols for examples of others. Do NOT change this unless you
# know what you're doing.
    
($name, $aliases, $proto) = getprotobyname('tcp');

# This is a slightly different way of doing the service lookup that wa
+s
# done in the Server code.  Basically, if the specified port is an int
+eger,
# the port number lookup isn't done, otherwise it is.

($name, $aliases, $port) = getservbyname($port,'tcp')
    unless $port =~ /^\d+$/;

# Let the user know what port we're using and where the server
# is expected to be, just in case (s)he accidentally typed an 
# incorrect port or machine name.

print "Using port $port to connect to server on host $them...\n";


# This looks up numeric IP address information corresponding to the 
# hostname for the current machine.

($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);

# This looks up numeric IP address information corresponding to the
# hostname where the server is expected to be running.

($name, $aliases,$type,$len,$thataddr) = gethostbyname($them);

# Create one endpoint of the communication link (our end).  See the Se
+rver
# code for a more complete explanation of what 'socket' does.  If we
# fail to create a socket, 'die' causes execution to terminate and 
# display the reason ( stored in $! ) for the failure.

# Remember that AF_INET and SOCK_STREAM are symbols provided by the 
# "use Socket;" line.  Don't put $ in front of them!!

if (socket(S,AF_INET, SOCK_STREAM, $proto)) {
    print "Socket creation succeeded.\n";
}
else {
    die $!;
}

# 'bind' connects our socket (just created) to the specified port.  As
# in the Server code, the $sockaddr thing is just some magic that allo
+ws
# the parameters to 'bind' and (later) 'connect' to be smooshed togeth
+er
# in the correct way.  For most cases this will be "cut and paste" cod
+e.
# 'this' gives information about who we are; 'that' refers to the serv
+er.

$sockaddr = 'S n a4 x8';
$this = pack($sockaddr, AF_INET, 0, $thisaddr);
$that = pack($sockaddr, AF_INET, $port, $thataddr);

if (bind(S, $this)) {
    print "Bind succeeded.\n";
}
else  {
    die $!;
}

# This is similar to the 'accept' in the server, except the server is 
# waiting for a call and we're actively initiating the conversation.
# 'connect' connects our socket to the server's socket on the other en
+d.

if (connect(S, $that)) {
    print "Connect succeeded.\n";
}
else {
    die $!;
}

# Force our socket to flush output immediately after a print

select(S);
$| = 1;

# Make standard output the default again

select(STDOUT);

# The interaction we want is to type lines of input and have them echo
+ed
# back by the server.  But how can we both wait for input AND be recep
+tive
# to the server's output?   Answer:  By forking a process to accept in
+put
# from standard input (the keyboard) and send it to the server and usi
+ng
# our current process to receive and display input from the server.

if ($child = fork) {
    
# We're the parent.  Read lines of input from the standard input and
# send them to the server until end of file is seen.
    
    while (<STDIN>) {
    print S;
    }
    # Sleep for 3 seconds then...
    sleep 3;
    
    #...then kill ourselves and the child
    do dokill();
}
else {
    # We're the child.  Read lines of input from the server over the 
    # socket S and output them.   Stop if end of file is seen.
    
    while (<S>) {
    print "Server: $_";
    }
}

[BrowserUk]

To get away from your obsession on readline,

Observation is not obsession.

I can kill the client's xterm, before I send any newline, and the server stays responsive to new and other connections.

Sure you can if you fork, but that's a different solution. Ie. a forking server not a multiplexing server.

Here is a perfectly serviceable equivalent using threads:

#! perl -sw
use strict;
use threads stack_size => 4096;
use threads::shared;
use IO::Socket;

use constant CRLF => chr( 13 ) . chr( 10 );
$/ = $\ = CRLF;

my $server = IO::Socket::INET->new(
    LocalHost => 'localhost',
    LocalPort => 1025, Listen => SOMAXCONN, Reuse => 1,
) or die "Couldn't create listening socket";

while( 1 ) {
    my $client = $server->accept;
    async {
        my $peerhost = $client->peerhost .':'. $client->peerport;
        while( <$client> ){
            chomp;
            print $client $_;
            print "$peerhost:$_";
        }
    }->detach;
}

close $server;

That will (has) run all day and night without problems.

And here is a 'one-liner' that will launch 1000 clients at it each time:

perl -Mthreads=stack_size,4096 -MIO::Socket 
-E"
async{ 
    my$s=new IO::Socket::INET('localhost:1025') or warn $^E, return; 
    say $s 'Hello'; 
    print scalar <$s>; 
    shutdown $s, 2; 
    close $s; 
}->detach for 1 .. 1e6"

But as with all forking servers, it is ridiculously resource intensive for an echo daemon.

[zentara]

This is the simplest usage of IO::Select I can produce. It too, on Linux anyways, is very solid. I can kill -9 clients, and the server dosn't get hung. What do you have to do to make your symptoms appear using this script? You know I'm sure, that multiplexing with IO::Select is only meant for use with short messages; if you are doing large data transfers, you need to use fork or threads. This thread could be also be improved to use sysread instead of <>, but it generally works fine as is.

#!/usr/bin/perl
use IO::Socket;
use IO::Select;

my @sockets;
my $machine_addr = 'localhost';
$main_sock = new IO::Socket::INET(LocalAddr=>$machine_addr,
      LocalPort=>1200,
      Proto=>'tcp',
      Listen=>3,
            Reuse=>1,
            );

die "Could not connect: $!" unless $main_sock;
print "Starting Server\n";

$readable_handles = new IO::Select();
$readable_handles->add($main_sock);

while (1)
{
  ($new_readable) = IO::Select->select($readable_handles, undef, undef
+, 0);

  foreach $sock (@$new_readable)
  {
    if ($sock == $main_sock)
    {
      $new_sock = $sock->accept();
      $readable_handles->add($new_sock);
    }
    else
    {
      $buf = <$sock>;
      if ($buf)
      { 
        print "$buf\n";
        my @sockets = $readable_handles->can_write();
    #print $sock "You sent $buf\n";
    foreach my $sck(@sockets){print $sck "$buf\n";}
        
      }
      else
      {
        $readable_handles->remove($sock);
        close($sock);
      }
    }
  }

}


print "Terminating Server\n";
close $main_sock;
getc();

[BrowserUk]

What do you have to do to make your symptoms appear using this script?

Okay. I'll play :)

1. Start your server in one session.
2. Run this in a second session:

   perl -MIO::Socket -E ' $s=IO::Socket::INET->new("localhost:1200"); $s-
   +>send( "a" ); sleep 1e6 '
   

3. Now start a third session and telnet into your server.

   You'll get a connection and be able to type stuff; but you'll get no replies and none of your telnet input will be displayed on your server's console.

4. Start as many more clients -- telnet or otherwise -- as you like.

   Your server will never see anything from any of them until you kill that perl one-liner. (Or you wait the 11.57 hours DAYS for the sleep to time out.)

The reason is that the send('a') caused select to return a readable file handle. Your server then attempted a readline from that client; but the client never sends a newline, so the readline never returns and your server is dead in the water. The tcpip stack will service connections, but your server will never loop back to accept them.

One bad client and your server is DOS'd. This is the exact scenario that I described above with that "teaching material"; the source of my "obsession with readline".

You know I'm sure, that multiplexing with IO::Select is only meant for use with short messages; if you are doing large data transfers, you need to use fork or threads.

Absolutely not!

If you use recv (or sysread), thus avoiding line-based and buffered IO, you can service huge data packets and small ones; you simply accumulate partial packets in buffers and only process input once you've accumulated enough to satisfy the comms protocol requirements. Whether that is newline (or other character sequence) terminated records or length pre-fixed; or any other mechanism.

(Oh. And don't forget to set the sockets non-blocking!)