Bi directional Socket question

[rbc]

Dear Monks,

I am soooo confused ...

I am trying to write a client that writes
to a server and then reads from that server.

Here's what I have that works but does not do quite what
I want.
SERVER ONE

#!/usr/bin/perl -Tw
use strict;
use Socket;
use Carp;

my $EOL = "\015\012";

sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

my $port = shift || 2111;
my $proto = getprotobyname('tcp');
$port = $1 if $port =~ /(\d+)/; # untaint port number

socket(Server, PF_INET, SOCK_STREAM, $proto) 
          || die "socket: $!";

setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))   
          || die "setsockopt: $!";

bind(Server, sockaddr_in($port, INADDR_ANY))
          || die "bind: $!";

listen(Server,SOMAXCONN)|| die "listen: $!";

logmsg "server started on port $port";

my $paddr;

$SIG{CHLD} = \&REAPER;

for(;$paddr = accept(Client,Server); close Client) {
     my($port,$iaddr) = sockaddr_in($paddr);
     my $name = gethostbyaddr($iaddr,AF_INET) || 'Unknown';

     my $C = 'DUH';
     logmsg "conn from $name [", inet_ntoa($iaddr), "] port $port";
     print Client "Hi, [$C], it's now ", scalar localtime, $EOL;
}

This works fine with the below client ... Its bit slow but I ain't in a hurry
The Client

#!/usr/bin/perl -w
# biclient - bidirectional forking client
use strict;
use IO::Socket;
my ($host, $port, $kidpid, $handle, $line);

unless (@ARGV == 2) { die "usage: $0 host port" }
($host, $port) = @ARGV;

# create a tcp connection to the specified host and port
$handle = IO::Socket::INET->new(Proto     => "tcp",
                                PeerAddr  => $host,
                                PeerPort  => $port)
or die "can't connect to port $port on $host: $!";

$handle->autoflush();              # so output gets there right away
print STDERR "[Connected to $host:$port]\n";

# split the program into two processes, identical twins
die "can't fork: $!" unless defined($kidpid = fork());

if ($kidpid) {                      
    # parent copies the socket to standard output
    while (defined ($line = <$handle>)) { print STDOUT "$0:$line"; }
    kill("TERM" => $kidpid);        # send SIGTERM to child
} else {                              
    # child copies standard input to the socket
    while (<STDIN>) {
        print "child write to handle line= [$_]\n";
        print $handle $_ . "\015\012"; 
    }
}
print "$kidpid exitting\n";
exit;

... now when I chane the server to be like so ...
SERVER TWO

#!/usr/bin/perl -Tw
use strict;
use Socket;
use Carp;

my $EOL = "\015\012";

sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

my $port = shift || 2111;
my $proto = getprotobyname('tcp');
$port = $1 if $port =~ /(\d+)/; # untaint port number

socket(Server, PF_INET, SOCK_STREAM, $proto)        
      || die "socket: $!";

setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
      || die "setsockopt: $!";

bind(Server, sockaddr_in($port, INADDR_ANY))
      || die "bind: $!";

listen(Server,SOMAXCONN)
      || die "listen: $!";

logmsg "server started on port $port";

my $paddr;

$SIG{CHLD} = \&REAPER;

while (1) {
    for (;$paddr = accept(Client,Server); close Client) {
        my($port,$iaddr) = sockaddr_in($paddr);
        my $name = gethostbyaddr($iaddr,AF_INET) || 'Unknown';
        my $C = join ('', <Client>);
        logmsg "conn from $name [", inet_ntoa($iaddr), "] port $port";
        print Client "Hi, [$C], it's now ", scalar localtime, $EOL;
    }
}

... everything hangs. I suspect that server is hanging on this line ...

    my $C = join ('', <Client>);

Why is it hanging and how do I stop it from hanging?

[ferrency]

rbc conjectures:

I suspect that server is hanging on this line ...


       my $C = join ('', <Client>);

Why is it hanging and how do I stop it from hanging?

You're doing a blocking read from <Client> in an array context. That tries to slurp every line until EOF into memory, before doing the join. This makes the socket wait for the Client to close its connection, before joining and then trying to write something back to the Client. This is most likely not what you want.

You probably want to try something more like this:


my $C = <Client>;

If you want to get multiple lines, you need to tell the server how many lines to expect, or it'll wait until it gets "all the lines" which probably just means "hang forever."

Update: You may also want to turn on autoflush in the server (if it's not on already; I'm not up to speed with traditional socket() calls instead of IO::Socket) or your client might hang waiting for the unflushed server output.

Alan

[perlplexer]

Absolutely agree with ferrency's comments.

In addition to that:
1) Your client program fork()s and then both parent and child use the same socket handle. Do not do that. At best, you are going to get unpredictable results.
2) Whenever you are dealing with networks, never ever assume that you will always get what you expect. Add some sort of timeout logic. You can use either select() or IO::Select for that.

--perlplexer

[ferrency]

perlplexer perplexed me with:
1) Your client program fork()s and then both parent and child use the same socket handle. Do not do that. At best, you are going to get unpredictable results.

I disagree with this.

Yes, when dealing with a single socket handle in multiple processes, you need to be careful. For example, don't have both processes reading from it, or you'll get unpredictable results as you state.

However, the technique being used here is safe. Actually, it's pretty much straight out of the Perl Cookbook. One of the processes always only reads from the socket, the other process always only writes to it. This is safe, and it's an easy way to avoid needing to use select() and/or non-blocking reads/writes for bidirectional socket communication, in certain circumstances. It certainly can't be used in every case: for example, if you need to know what was just read in order to determine what you're going to write next. But for writing what's essentially a telnet client, it's perfect.

Alan

[pizza_milkshake]

Buy/steal the perl cookbook... good examples perl -MLWP::Simple -e'getprint "http://parseerror.com/p"' |less

[Dogma]

There are some really good examples in the Perl CookBook that certainly help me out with a similar problem. I would suggest sticking to one socket programming method. I like IO::Socket and it's pretty easy to handle.

Something that can really screw you is buffering. Make sure you turn buffering off for your script and flush your sockets when your done writting to them. Another advantage of IO::Socket(::INET) is that autoflush() is an option (and it's turned on my default). Good luck.