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

Discussion in 'Perl Misc' started by John Chambers, Jan 21, 2004.

  1. 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?
     
    John Chambers, Jan 21, 2004
    #1
    1. Advertising

  2. John Chambers

    Ben Morrow Guest

    John Chambers <> wrote:
    > 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.

    <snip>
    > ==============================
    >
    > And here's the TCPclient.pl program:
    >

    <snip>
    > # 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

    --
    EAT
    KIDS (...er, whoops...)
    FOR
    99p
     
    Ben Morrow, Jan 21, 2004
    #2
    1. Advertising

  3. Ben Morrow wrote:

    >># 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.


    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. ;-)
     
    John Chambers, Jan 23, 2004
    #3
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Herman Chan

    CGI autoflush in Window

    Herman Chan, Oct 9, 2003, in forum: Perl
    Replies:
    0
    Views:
    581
    Herman Chan
    Oct 9, 2003
  2. dede
    Replies:
    0
    Views:
    588
  3. Gianluca Trombetta

    Autoflush in python cgi

    Gianluca Trombetta, Jun 1, 2004, in forum: Python
    Replies:
    1
    Views:
    1,001
    Andrew Dalke
    Jun 2, 2004
  4. Berehem
    Replies:
    4
    Views:
    562
    Lawrence Kirby
    Apr 28, 2005
  5. Axel Boldt
    Replies:
    1
    Views:
    137
    Dan Wilga
    Apr 7, 2004
Loading...

Share This Page