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

My server was working fine on version 5.6, but when I tried the same code on a machine runing version 5.8 it didn't.

The working server version waited for clients, made connections, closed connections and then waited from more clients. The non-working version now waits for clients, makes the connections, and then dies when the first client breaks the connection.

The print "IN 7" deal only prints when I give the ctrl-c on the 5.6 box. On the 5.8 box it prints (and the program exits) as soon as the first client exits.

Here is the actual server and client code:

#!/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;
        wait;
          return $?;
}

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;
                }
        }
}




#!/usr/bin/perl
require "getopts.pl";
&Getopts('p:r:h:cwhsd');        # -b filename -r resultsfile [c=comput
+er ouput||w=web output ||h= print header]
                        # -s socket
                        # -p pipe
                        # -D daemon
                        # -h host to use
use IO::Socket;
$version=".00";
$hostname="quark";
$debug=0;
$runcount=0;

if ($opt_h eq ""){
        $serverip='192.168.0.2';
}else{
        $serverip=$opt_h;
}

&do_socket;

sub do_socket {
        $host = shift || $serverip;
        $port = shift || 8721;
        $sock = new IO::Socket::INET(
                  PeerAddr => $host,
                  PeerPort => $port,
                  Proto    => 'tcp');
        $sock or die "no socket :$!";
        STDOUT->autoflush(1);
# send message to server
        print "Socket created, now waiting on command\n";
        if (defined($str = <$sock>)) { print "received: $str"; }
        if (defined($str = <$sock>)) { print "received: $str"; }
        if (defined($str = <$sock>)) { print "received: $str"; }
        if (defined($str = <$sock>)) { print "received: $str"; }
        print $sock "usernamex\n";
        print "sent usernamex\n";
        if (defined($str = <$sock>)) { print "received: $str"; }
        print $sock "start\n";
        print "sent passwdx\n";
        if (defined($str = <$sock>)) { print "received: $str"; }
        if (defined($str = <$sock>)) { print "received: $str"; }
        #print $sock "BET-GET\n";
        if (defined($str = <$sock>) && $str eq "Accepted\n") {
                &do_loop;
        }
        else {print "str=$str"};

        print "closing socket\n";
        close $sock;
}

sub do_loop{
        print "starting do_loop with str=$str";
        while(){
                while ($str ne "EOF\n"){
                        print "a_received: $str";
                        if (defined($str = <$sock>)) {}
                        #print "xreceived: $str";
                }
                if ($str eq "EOF\n"){
                        print "str=$str\n";
                        print "sent: start\n";
                        print $sock "start\n";
                        if (defined($str = <$sock>)) {}
                }
        }
}

sub S_print {
        if ($opt_s) {
                print $sock @_;
        }else {
                print @_;
        }
}

sub S_EOF_print {
        print $sock "EOF\n";
}

[download]

Of course I'm a newbie to perl so speak very slowly:)

Edit by tye to add READMORE

Replies are listed 'Best First'.
Re: perl 5.8 killed my socket!
by tall_man (Parson) on Dec 11, 2002 at 00:24 UTC
    I believe your problem may be the same as mentioned in this message.

    The essential problem is that the reaper seems to interrupt the accept loop in perl 5.8, which didn't happen in 5.6.1.

    Here is how I handled it in one of my scripts: 

    REDO:
while (my $ns = $server->accept) {
  # Normal accept loop here.
}
print "Got an interruption: $!\n";
goto REDO;

    [download]
[reply]
[d/l]

      goto LABEL is generally frowned upon. instead, try:

      ## bare block with redo to catch perl 5.008 accept loop interrupts 
## (see http://archive.develooper.com/macosx@perl.org/msg03022.html fo
+r details)
{
  while ( my $ns = $server->accept() ) 
  {
    # Normal accept loop here.
  }
  print "Got an interruption: $!\n";
  redo;
}

      [download]

      ~Particle *accelerates*

[reply]
[d/l]
[select]
        Problem solved! Thanks guys:)
[reply]
        while(1) {
    while ( my $ns = $server->accept() ) {
        # Normal accept loop here.
    }
    print "Got an interruption: $!\n";
}

        [download]

        Makeshifts last the longest.

[reply]
[d/l]

Back to Seekers of Perl Wisdom