Yet Another Autoflush problem -- What's wrong with this code?

[John Chambers]

I've grabbed a number of perl TCP server/client pairs, and experimented with
getting them to do some simple request-response sequences. A bizarre flushing
failure has popped up in all of them, and no amount of futzing with $| and
autoflush seems to make them work.

Here's the code for one of the simplest pairs.

=====================================
The TCPserver.pl program is:

#!/usr/local/bin/perl -w
use IO::Socket;
use Net::hostent;
$port = 4217; # pick something not in use
select STDOUT; $| = 1;
($P = $0) =~ s".*/"";
$V = $ENV{"V_$P"} || 2; # Verbose level
$prompt = "Command? ";
$EOL = "\015\012"; # Paranoia

$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $port,
Listen => SOMAXCONN,
Reuse => 1);
die "can't setup server ($!)" unless $server;
print "[Server $0 accepting clients on port $port]$EOL";

while ($client = $server->accept()) {
$client->autoflush(1);
select $client; $| = 1; select STDOUT;
print $client "Welcome to $0; type help for command list.$EOL";
$hostinfo = gethostbyaddr($client->peeraddr);
printf "[Connect from %s]$EOL", $hostinfo->name || $client->peerhost;
select STDOUT;
print "SEND \"$prompt\"$EOL";
print $client $prompt;
print "SENT \"$prompt\"$EOL";
while ($line = <$client>) {
print "RCVD \"$line\"$EOL" if $V>1;
$line =~ s/[\r\n]+$//;
next unless $line; # blank line
# autoflush $client 1; # Does this help? Nope
if ($line =~ /quit|exit/i) { last; }
elsif ($line =~ /date|time/i) { printf $client "%s$EOL", scalar localtime; }
elsif ($line =~ /who/i ) { print $client `who 2>&1`; }
elsif ($line =~ /cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
elsif ($line =~ /motd/i ) { print $client `cat /etc/motd 2>&1`; }
else {
print $client "Commands: quit date who cookie motd$EOL";
}
} continue {
select STDOUT;
print "SEND \"$prompt\"$EOL";
print $client $prompt;
print "SENT \"$prompt\"$EOL";
}
close $client;
}

==============================

And here's the TCPclient.pl program:

#!/usr/local/bin/perl -w
use strict;
use IO::Socket;
my ($host, $port, $kidpid, $server, $line);
my $EOL = "\015\012"; # Paranoia

select STDOUT; $| = 1;
my $P = $0; $P =~ s".*/"";
my $V = $ENV{"V_$P"} || 2; # Verbose level

if (@ARGV <1) {push @ARGV, 'localhost'} # Default to local server
if (@ARGV <2) {push @ARGV, '4217'} # Default port for TCPserver.pl
($host, $port) = @ARGV;

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

$server->autoflush(1); # so output gets there right away
#autoflush $server 1;
select $server; $| = 1; select STDOUT;
print "[Connected to $host:$port]$EOL";

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

# the if{} block runs only in the parent process
if ($kidpid) { # copy the socket to standard output
print "READ ...$EOL" if $V>1;
while (defined ($line = <$server>)) {
print "RCVD \"$line\"$EOL" if $V>1;
print STDOUT $line;
}
kill("TERM", $kidpid); # send SIGTERM to child
} else { # the else{} block runs only in the child process
# copy standard input to the socket
while (defined ($line = <STDIN>)) {
print "SEND \"$line\"$EOL" if $V>1;
print $server $line;
print "SENT \"$line\"$EOL" if $V>1;
}
}

=====================================

Some readers may recognize these from online sources. Anyway, the Server's
"Command? " prompt is sent to the client, but the client doesn't receive it
at all until the server sends something that ends with a newline (which was
coded "\n" in an earlier version, and "\015" here as a variant). This despite
the setting of $| to 1 for every file in sight, and the use of autoflush(1)
for the sockets also. I tried the autoflush function, too, though it's
commented out here. None of these attempts to subvert the buffering works;
the server's prompt requires a newline for it to be read by the client.

For example, I started the two programs up in two windows, they both printed
their startup messages, the server produced a "SEND ..." and "SENT ..." message
for the prompt, and both were hung. In the client window, I hit Enter, and then
types a "date" command plus an Enter. On the server side, the output was:
=====================================
: ./TCPserver.pl
[Server ./TCPserver.pl accepting clients on port 4217]
[Connect from localhost]
SEND "Command? "
SENT "Command? "
RCVD "
"
SEND "Command? "
SENT "Command? "
RCVD "date
"
SEND "Command? "
SENT "Command? "
=====================================
That looks like exactly what you'd expect.
Meanwhile, over on the client side, what's on the screen is:
=====================================
: ./TCPclient.pl
[Connected to localhost:4217]
READ ...
RCVD "Welcome to ./TCPserver.pl; type help for command list.
"
Welcome to ./TCPserver.pl; type help for command list.
[Here I hit the Enter key]
SEND "
"
SENT "
"
date [Here I sent an actual command]
SEND "date
"
SENT "date
"
RCVD "Command? Command? Wed Jan 21 17:17:03 2004 <=== The prompts finally appear!!
"
Command? Command? Wed Jan 21 17:17:03 2004
=====================================
As you can see here, the client received no input at all until I sent the
"date\n" command. The server ran the "date" command, and sent the results
back to the client. The client recenved the date and time, preceded by
the two "Command? " prompts that it hadn't gotten earlier.

As you can see, I'm familiar with $| and the uses of autoflush. According
to the FAQs, any one of these should suffice to unblock the buffering. But
the data going from TCPserver to TCPclient is bufferred until a newline is
sent.

Is there any way to make the messaging work here?

 

[Ben Morrow]

I've grabbed a number of perl TCP server/client pairs, and
experimented with getting them to do some simple request-response
sequences. A bizarre flushing failure has popped up in all of them,
and no amount of futzing with $| and autoflush seems to make them
work.

==============================

And here's the TCPclient.pl program:

# the if{} block runs only in the parent process
if ($kidpid) { # copy the socket to standard output
print "READ ...$EOL" if $V>1;
while (defined ($line = <$server>)) {

Here is your problem. <$server> will not return until it reads a
newline. You either want to set $/ to \1 (which will read a byte at a
tyme: not very efficient) or set non-blobking mode and use

while (read $server, $line, 1024) {

; or maybe sysread instead.

print "RCVD \"$line\"$EOL" if $V>1;
print STDOUT $line;
}

Ben

 

[John Chambers]

Here is your problem. <$server> will not return until it reads a
newline. You either want to set $/ to \1 (which will read a byte at a
tyme: not very efficient) or set non-blobking mode and use

while (read $server, $line, 1024) {

; or maybe sysread instead.

Well, I was wondering about that. I grepped and googled for
everything I could find on the topic, and found lots and lots
of advice that !| or one of the autoflush() calls would solve
all my problems. I kept thinking that those undo the buffering
on the sending end, but I don't see any evidence that it can't
also be a problem on the receiving end.

So I guess all those FAQs and RTFMs are just red herrings, and
I was guessing right all along. I wonder why I never ran across
any comments about this? Others have had to stumbled across the
same problem. There's gotta be a lot of people trying to send
data across TCP links in perl, right? And data isn't always in
the form of ASCII text with newlines at the end of every data
object, right?

Anyway, thanks for the advice. I think I'll try setting nonblocking
and use sysread(). Maybe I can copy some of my C code, and add a
few $'s, to get the corresponding perl code. Or maybe I won't figure
out how to set nonblocking, and I'll be back with another dumb
question soon. ;-)