1

I'm trying to put together a skeletal server (in Perl) that follows some of the guidelines I'm reading about in Network Programming with Perl by Lincoln Stein (c. 2001). What I have here is a simple echo server that forks a child for each connection and echoes back whatever it receives until it receives the termination token.

I had a primitive version working, and then added new features such as a $SIG{CHLD} handler and more closing of "unnecessary" file handles after forking, and now it's broken: it terminates the while() loop after a connection finishes. (I've tried selectively backing out changes but to no avail.)

Here are runnable versions of both the server and a client that illustrate the bug. The problem may be evident from simply inspecting the code. If you want to run it, you terminate the client by entering a single period (.) which is the termination token - that will trigger the bug in the server.

Server:

#!/usr/bin/perl 

# Template for a server.
#
use warnings;
use strict;
use Carp;
use Getopt::Std;
use File::Basename;
use IO::Socket;
use Net::hostent;    # for OO version of gethostbyaddr
use POSIX 'WNOHANG';
use Data::Dumper;
use 5.010;

my $program    = basename $0;
my $master_pid = $$;            # Master server's pid
$|             = 1;             # flush STDOUT buffer regularly

###############################################################################
#
# Initialize.
#
###############################################################################

my %opts;
getopts( 'hp:', \%opts );

if ( $opts{'h'} ) {    # no args, or the -h arg
    print <<EOF;

      Usage:  $program [-p port]

      Where:  -p port      advertised port number, > 1024 (default: 2000)

EOF
    exit(0);
}

my $server_port = $opts{p} || 2000;

croak "-p port omitted.\n" if !defined $server_port;
croak "port must be numeric.\n" if $server_port !~ /^[[:digit:]]+$/;
croak "port must be 1025 .. 65535.\n"
    if $server_port < 1025 || $server_port > 65535;

# Set up a child-reaping subroutine for SIGCHLD
#
$SIG{CHLD} = sub {
    while ( ( my $kid = waitpid(-1, WNOHANG )) > 0 ) {
    }
};





###############################################################################
#
# Become a server.
#
###############################################################################

# Open the server's advertised port for incoming connections
#
my $listen_socket = IO::Socket::INET->new(
    Proto     => 'tcp',
    LocalPort => $server_port,
    Listen    => SOMAXCONN,
    Reuse     => 1
);
croak "Can't set up listening port: $!\n" unless $listen_socket;
say "Server ready.";

# Block on accept() call until a new connection arrives
#
my $client_fh;
while ( $client_fh = $listen_socket->accept() ) {

    $client_fh->autoflush(1);                      # turn on frequent flushing
    my $hostinfo
        = gethostbyaddr( $client_fh->peeraddr );   # resolve ipaddr to name

    # Now that a connection is established, spawn a conversation.
    #
    defined (my $child_pid = fork())
                 or croak "Can't fork: $!\n";

    if ( $child_pid == 0 ) {    # if being run by the forked child

        # S T A R T   O F   C H I L D   C O N T E X T
        #
        conversate($client_fh); # run the child process
        #
        # E N D   O F   C H I L D   C O N T E X T
    }

    $client_fh->close;     # Parent immediately closes its copy 
}

say "Bummer - for some reason the socket->accept() failed.";


###############################################################################
#
#                          S U B R O U T I N E S
#
###############################################################################

# conversate ( client_fh )
#
# S T A R T   O F   C H I L D   P R O C E S S
#
sub conversate {

    my $client_fh = shift;    # connection to client
    $listen_socket->close;    # we don't need our copy of this
    my $child_pid = $$;       # get our new pid

    print $client_fh "READY\n";    # tell them we're here

 EXCHANGE:
    while (1) {

        # Let client talk first
        #
        my $line = <$client_fh>;   # ?? Isn't there an OO way?

        if ( !defined $line ) {
            last EXCHANGE;
        }

        chomp $line;

        last EXCHANGE if $line eq '.';

        # Now send a reply (echo) and close the connection.
        #
        print $client_fh "$line\n";  # ?? Isn't there an OO way?
    }
    exit 0;                 # child process exits
}
#
# E N D   O F   C H I L D   P R O C E S S

Client:

#!/usr/bin/perl 
#

use warnings;
use strict;
use Getopt::Std;
use Data::Dumper;
use File::Basename;
use 5.010;

#sub say { print "@_\n"; }

my $program = basename $0;

my %opts;
getopts( 'hvs:p:', \%opts );

if ( $opts{'h'} ) {    # -h arg
    print <<EOF;

      Usage:  $program [-v] [-s hostname [-p port]]

      Where:
              -s hostname   host name (default: localhost)
              -p port       port number (default: 2000)
              -v            verbose mode

EOF
    exit;
}

my $verbose  = $opts{v} || 0;
my $hostname = $opts{s} || 'localhost';    # hard coded for now
my $port     = $opts{p} || 2000;

###############################################################################
#
# Initialize
#
###############################################################################

# Initialize the ReadLine terminal
#
use Term::ReadLine;
my $term = Term::ReadLine->new($0);

###############################################################################
#
# Contact server and begin main loop
#
###############################################################################

use IO::Socket;
my $remote = IO::Socket::INET->new(
    Proto    => "tcp",
    PeerAddr => $hostname,
    PeerPort => $port,
) or die "Cannot connect to $hostname:$port";

my $line;
EXCHANGE:
while (1) {

    # Wait for server
    #
    $line = <$remote>;
    last EXCHANGE if !defined $line; # connection closed by remote?

    # Print server response
    #
    chomp $line;
    say "SERVER: $line";

    # Read from STDIN
    #
    $line = $term->readline("Enter something: ");

    chomp $line;

    # Send to server
    #
    print $remote "$line\n";

}

close $remote or die "Close failed: $!";

print "\n$program exiting normally.\n\n";
exit;
3
  • 2
    Tip of the day: use revision control, and remember to commit often. That way, you will be able to back out of troublesome changes, and find out exactly where things broke. Dec 26, 2012 at 19:47
  • It contains "No child processes".
    – Chap
    Dec 26, 2012 at 20:21
  • Add local $!; to your signal handler, then try again. But the fact that the signal handler is running (as indicated by this error message) is pretty good confirmation.
    – ikegami
    Dec 26, 2012 at 20:22

1 Answer 1

3

So what error is returned? Check $!.

I bet accept is being interrupted by SIGCHLD. A program cannot handle signals when it has ceded control to the OS, so to give your program a chance signals, blocking system calls return (with error EINTR) when a signal with a handler is raised.

Once your handler has handled the signal (which happens before you even notice accept returning), you can simply restart the accept. In other words, you can address this problem by writing your loop as follows:

while (1) {
    my $client_fh = $listen_socket->accept();
    if (!$client_fh) {
       redo if $!{EINTR};
       last;
    }

    ...
}

Note that you'll have to stop your signal handler from clobbering $! by adding the following to it:

local ( $!, $^E, $@ );
8
  • Before I saw your note about 'local', I modified the loop as follows: while ( 1 ) { $client_fh = $listen_socket->accept(); next if ! defined $client_fh; Which works. Still trying to absorb why....
    – Chap
    Dec 26, 2012 at 20:32
  • 1
    That would send your program in a 100% CPU infinite loop on a real error.
    – ikegami
    Dec 26, 2012 at 20:34
  • sorry for the formatting. i mean, i'm still trying to absorb why the accept() is completing when a SIGCHLD comes in.
    – Chap
    Dec 26, 2012 at 20:35
  • Sorry, the fix made no sense. Fixed.
    – ikegami
    Dec 26, 2012 at 20:37
  • 1
    @Chap: Yes, the only difference between next and redo in this case is that next retests the loop condition (and runs any continue blocks, if you have those). Of course, you could also check for it explicitly inside the if block, if you preferred. Dec 26, 2012 at 21:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.