Re: multiplexed TCP server with client socket handles stored in hash

[WC -Sx- Jones]

Peterson, Darren - Contractor.Westar wrote:

I need to write a multiplexed TCP server to handle multiple client
connections simultaneously.  It doesn't help that I'm new to perl and even
newer to TCP.  If this helps, I'm basing my code on an example on pp.
352-358 of Network Programming with Perl, Lincoln D. Stein, 2001.  I need to
store the socket handles in a hash with the IP of the client as the index,
because the traffic to be sent to the clients will come prefaced by the
recipient IP.  How do I retrieve the client IP after or from the "$connect =
$listen_socket->accept();" statement? I've seen it done with other connect
and bind methods.
Attached is some really OLD code that will like get me into trouble.

Enjoy!  :)

--
_Sx_ http://youve-reached-the.endoftheinternet.org/ _____
     http://jaxpm.insecurity.org/
     http://cis4dl.insecurity.org/
#! /usr/bin/perl
require 5.004; # Will not work with prior versions...

use strict;
use warnings;

use Sys::Syslog;
use IO::Socket;
use IO::Select;

# create a socket to listen to a port
my $listen = IO::Socket::INET->new(Proto     =>        'tcp',
                                   LocalPort =>        12000,
                                   Listen    =>          255,
                                   Reuse     => 1) or die $!;

# to start with, $select contains only the socket we're listening on
my $select = IO::Select->new($listen);

my @ready;
my $socket;
my $iline="";
my $oline="";

# wait until there's something to do 
while(@ready = $select->can_read) {

    # handle each socket that's ready
    for $socket (@ready) {

# identify my (localhost side) port and address...
my $sockname       = getsockname($socket) or die "Couldn't identify myself: $!\n";
my ($port, $iaddr) = sockaddr_in($sockname);
my $my_address     = inet_ntoa($iaddr);
            
# get name of the service we are interested in...
my $service        = (getservbyport ($port, "tcp"))[0] || $port;

my $ex_address     = '';
my $ex_hostname    = '';

        # if the listening socket is ready, accept a new connection
        if($socket == $listen) {
            my $new = $listen->accept;
            $select->add($new);

# now identify the REMOTE (alien) address...
$sockname       = getpeername($new) or die "Couldn't identify the PROBING system: 
$!\n";
($port, $iaddr) = sockaddr_in($sockname);
$ex_address     = inet_ntoa($iaddr);
$ex_hostname    = gethostbyaddr($iaddr, AF_INET);

# Debugging ...
#       print $new->fileno . ": connected on " . localtime() . "\n";
#       print "$ex_address ($ex_hostname): connected on " . localtime() . "\n";
#       print "$ex_address ($ex_hostname): connected on " . localtime() . 
"\n-----Sx-----\n$iline\n-----Sx-----\n";

# and finally - log the Connection request...
openlog("artemis", "ndelay", "daemon");
syslog("notice", "Connection from %s (%s) to %s:%s\n",
        $ex_address, $ex_hostname, $my_address, $service);
closelog();

        } else {

            # otherwise, read and process a complete input stream, which appears as a 
line of text...
            $socket->recv($iline,8192); # Not sure what the actual 'real' limit is...

            $iline =~ s/^\s+//; # no leading whitespace...
            $iline =~ s/\s+$//; # no trailing whitespace...

            # Here is the 'Logical' short-circuit...
            $iline ne "" and &sub_req($iline) and $socket->send($oline) or do {
                        # either can't send or can't receive, so they must have hung up

# now identify the REMOTE (alien) address...
$sockname       = getpeername($socket) or die "Couldn't identify the PROBING system: 
$!\n";
($port, $iaddr) = sockaddr_in($sockname);
$ex_address     = inet_ntoa($iaddr);
$ex_hostname    = gethostbyaddr($iaddr, AF_INET);

#       print $socket->fileno . ": disconnected on " . localtime() . "\n";
#       print "$ex_address ($ex_hostname): disconnected on " . localtime() . "\n\n\n";

# and finally - log the Disconnection event...
openlog("artemis", "ndelay", "daemon");
syslog("notice", "%s (%s) disconnected from %s:%s\n",
        $ex_address, $ex_hostname, $my_address, $service);
closelog();

                # Clean up after ourselves...
                $select->remove($socket);
                $socket->close;
            };
        }
    }
}


sub sub_req {
my $target = shift;
my $tarray = localtime();

$oline = "\n[ok]\n"; # Normally would contain error messages, etc; but not currently 
used on EPOS end...

  my $mailAdmin   = '[EMAIL PROTECTED]'; # Send Reports to?
  my $mailProject = '[EMAIL PROTECTED]'; # Responsible for Project?
  my $SENDMAIL    = '/usr/lib/sendmail'; # The location of your sendmail binary...

  $| = 1;  # Use unbuffered I/O...

# Get dates and stuff...  For finger-printing...
my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime;
my $lt = sprintf("%02d%02d%02d%02d%02d%4d%d", $sec, $min, $hour, $mday, ++$mon, ($year 
+ 1900), $wday);
my $slt  = scalar localtime;

# open (MAIL, "| $SENDMAIL -t -v") || die ("$0:  Fatal Error!  Cannot open sendmail: 
$!\n");
 open (MAIL, "| $SENDMAIL -t") || die ("$0:  Fatal Error!  Cannot open sendmail: 
$!\n");

# !!!
# Sx:  NOTE Below change to the Date: $tarray line...

  print MAIL<<EndOfMailer;
User-Agent: Artemis ReMailer Gateway v1.5b Production: Sx 12/07/2001 @ 14:25PM
Date: $slt
X-Sender: artemis project
X-Sx-Date-Stamp: $slt
X-Sx-Date-Serial: $lt
X-Comments: A message from the $0 script...
$target

=End of Mail=
EndOfMailer

  close (MAIL);


# Now, finally - display the TARGET Data ... for debugging...
# Sx -- print "Got ---------- \n\n$target\n\n ---------- \n\n";

  return($oline); # Required to keep Logical 'Short-Circuit' happy; see calling code...
}

__END__

-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>