drake50 has asked for the wisdom of the Perl Monks concerning the following question:

I've been working on a very simple server to learn how things work and I'm having one major problem that I can't get past. If I run more that one client at a time and either client is killed then the server won't accept any more connections until all clients are killed.

For example: client 1 connects, client 2 connects, client 2 is killed, client 3 tries to connect but hangs until client 1 is killed.

The server code is below: 
#!/usr/bin/perl 
use IO::Socket;
use Sys::Hostname;
use POSIX qw(:sys_wait_h);
#testserver
$version=".00";
$debug=0;
$myip='192.168.0.2';
$true=1;


#---------------------------------- BetQ.d Main ----------------------
+--------------------
&do_socket;
#---------------------------------- BetQ.d Main ----------------------
+--------------------


#---------------------------------- Subroutines ----------------------
+--------------------

sub S_print {
        print $new_sock (@_);
}


sub do_socket {
        $SIG{CHLD} = \&REAP;
        $sock = new IO::Socket::INET(
                   LocalHost => $myip,
                   LocalPort => 8721,
                   Proto     => 'tcp',
                   Listen    => SOMAXCONN,
                   Reuse     => 1);
        $sock or die "no socket :$!";
        STDOUT->autoflush(1);
        while (($new_sock, $c_addr) = $sock->accept()) {
                ($client_port, $c_ip) = sockaddr_in($c_addr);
                $client_ipnum = inet_ntoa($c_ip);
                $client_host = gethostbyaddr($c_ip, AF_INET);
        # execute a fork, if this is
        # the parent, its work is done,
        # go straight to continue
                $i=0;
                $done=0;
                $betsend=0;
                print "[$client_ipnum] $client_host connected\n";
                next if $kid = fork;
                die "fork: $!" unless defined $kid;
        # child now...
        # close the server - not needed
                #print "closing sock\n";
                close $sock;
                #print "Forked child printing CMDSTART to client\n";
                $date=`date`;
                print $new_sock "[$client_ipnum] $client_host $date co
+nnection attempt logged\n";
                print $new_sock "This is a private server.\n";
                print $new_sock "username:\n";
                if (defined($lineread = <$new_sock>)) {
                        print "un received: $lineread";
                        print $new_sock "$lineread";
                        print $new_sock "password:\n";
                }
                if (defined($lineread = <$new_sock>)) {
                        print "pw received: $lineread";
                        print $new_sock "$lineread";
                }
                if ($lineread eq "start\n"){
                        print $new_sock "Accepted\n";
                        $first=1;
                        &Send_Bets;
                }else{
                        sleep(5);
                        print $new_sock "Denied and logged\n";
                }
                print "lineread is -->$lineread<--\n";
                print "Breaking connection to [$client_ipnum] $client_
+host\n";
                exit;
        } continue {
        # parent closes the client since
        # it is not needed
                print "closing new sock\n";
                close $new_sock;
        }
        print "IN 7\n";
}

sub REAP {
        print "reaping\n";
    1 until (-1 == waitpid(-1, WNOHANG));
    $SIG{CHLD} = \&REAP;
}

sub Send_Bets {
        $done=0;
        while(!$done){
                if ($first || defined($lineread = <$new_sock>)) {
                        print "startcmd is $lineread";
                        $first=0;
                        for ($f=0;$f<=10;$f++) {
                                print "sending: $f";
                                &S_print (" sent $f\n");
                        }
                        print "sending: EOF\n";
                        &S_print ("EOF\n");
                }
                if ($lineread ne "start\n"){
                        $done=$true;
                }
        }
}

[download]

edited: Mon Nov 18 15:30:18 2002 by jeffa - s/pre/code/g

Replies are listed 'Best First'.
Re: Socket question Help!
by robartes (Priest) on Nov 17, 2002 at 22:25 UTC
    The problem seems to be in your SIGCHLD handling code. In it you do: 
    1 until (-1 == waitpid(-1, WNOHANG));

    [download]
    which is never if you already have a child, sending this into an endless loop. If you have client 1, and client 2 exits, the parent goes into this code, but waitpid will not return -1 (as client 1 is still there). This loop will only stop spinning once all clients are dead - which is exactly what you observe.

    You should just call waitpid, which will block until the child has delivered its status, but that is no problem as you are in your SIGCHLD handler, so a child has died per definition: 

    sub reap {
  waitpid(-1);
  return $?;
}

    [download]
    Judging by your code, you seem to want to avoid the parent blocking in the waitpid call, but as you waitpid() in the dead child signal handler, blocking will not happen. Ironically, by trying to avoid blocking, you send your server in an endless loop, thus blocking it :).

    CU
    Robartes-

[reply]
[d/l]
[select]
      Okay, I changed the code to read like:
      sub REAP {
        print "reaping\n";
        #1 until (-1 == waitpid(-1, WNOHANG));
        #$SIG{CHLD} = \&REAP;
        waitpid(-1);
          return $?;
}


      When I execute I get the following:
      Not enough arguments for waitpid at ./server.pl line 89, near "1)" Execution of ./server.pl aborted due to compilation errors.
[reply]
        Yes, I should have stated that the code is untested. If you use waitpid(), you have to specify some flags, even if they are 0: 
        waitpit(-1,0);

        [download]
        Or, alternatively, just use wait: 
        wait; # Yep, just like that :)

        [download]
        Sorry about the mistake.

        CU
        Robartes-

[reply]
[d/l]
[select]
Re: Socket question Help!
by pg (Canon) on Nov 17, 2002 at 23:01 UTC
    I wrote something for your, hope it helps:
    server.pl:

use IO::Socket;
use strict;
$| ++;

my $server = new IO::Socket::INET(Timeout => 7200,
                                  Proto => "tcp",
                                  LocalPort => 3000,
                                  Reuse => 1,
                                  Listen => 2);
my $num_of_client = -1;
while (1) {
    my $client;
    do {
        $client = $server->accept;
    } until (defined($client));
    print "accepted a clinet, id = ", ++ $num_of_client, "\n";
    if (!fork) {
        close($server);#this only closes the copy in the child process
        while (1) {
            my $msg;
            $client->recv($msg, 1000);
            if ($msg eq "") {
                die "child $num_of_client is inactive\n"; 
            } else {
                print "rcvd $msg from client ", $num_of_client, "\n";
                sleep(2);
                print $client $msg;
            }
        }
    } else {
        close($client); #this only closes the copy in the parent proce
+ss, assume the parent no longer need talk to the client
    }
}        


clinet.pl:

use IO::Socket;
use strict;

my $server = new IO::Socket::INET(Proto => "tcp",
                                  PeerAddr => "localhost",
                                  PeerPort => 3000,
                                  Reuse => 1,
                                  Timeout => 7200)
             || die "failed to connect to server\n";
while (1) {
    print $server "abcd";
    my $msg;
    $server->recv($msg, 1000);
    if ($msg eq "") {
        die "server is not responding";
    } else {
        print "recv'd ", $msg, "\n";
    }
}

    [download]
[reply]
[d/l]
      You guys are great! Thanks for the help! I've been thrashing my head over this for way too long:)

      I can't tell you how greatful I am.
[reply]
Re: Socket question Help!
by pg (Canon) on Nov 17, 2002 at 22:08 UTC
    use $| ++.
[reply]

Back to Seekers of Perl Wisdom