Ray.Zachary has asked for the wisdom of the Perl Monks concerning the following question:

Yesterday I wrote a multi-threads perl script, codes below is it.

#!perl

use IO::Socket::INET;
use threads;

$server = IO::Socket::INET->new(
        LocalPort        => 90,
        Type             => SOCK_STREAM,
        Reus             => 1,
        Listen           => 10) or die "Server Failed.\n";

$thread_A = threads->new(\&server);
$thread_B = threads->new(\&server);
$thread_C = threads->new(\&server);

@result = ($thread_A->join, $thread_B->join, $thread_C->join);
print "All threads returned, with codes @result\n";

sub server {
        while ($client=$server->accept) {
                for ($second=60; $second>0; --$second) {
                        sleep 1;
                        print $client "$second\n";
                }
                close $client;
        }
        print "Thread: loop while(\$client=\$server->accept) was broke
+n with reason \"unknown\", going to return.\n";
        return 1;
}

[download]

Codes below is the client:

#!perl
use IO::Socket::INET;

$server = IO::Socket::INET->new("127.0.0.1:90");

while (<$server>) {
    print;
}

close $server;

[download]

It's a multi-threads server test, while I run it on my windows with active-perl 5.10.1, I make 3 clients connected to it, and it was working fine, just like what these codes means literally, but on my linux with perl 5.10.0, it's odd, while I interrupted one client with CTRL+C, the server process(I mean whole process with every thread) was quit with neither warning nor error.

This problem was SOLVED with handling $SIG{PIPE} like almut said. Server codes has changed to:

#!perl
use IO::Socket::INET;
use threads;

$SIG{PIPE} = 'IGNORE";

$server = IO::Socket::INET->new(
        LocalPort        => 90,
        Type             => SOCK_STREAM,
        Reus             => 1,
        Listen           => 10) or die "Server Failed.\n";

$thread_A = threads->new(\&server);
$thread_B = threads->new(\&server);
$thread_C = threads->new(\&server);

@result = ($thread_A->join, $thread_B->join, $thread_C->join);
print "All threads returned, with codes @result\n";

sub server {
        while ($client=$server->accept) {
                for ($second=60; $second; --$second) {
                        sleep 1;
                        print $client "$second\n" or last;
                }
                close $client;
        }
        print "Thread: loop while(\$client=\$server->accept) was broke
+n with reason \"unknown\", going to return.\n";
        return 1;
}

[download]

While we attempt to write things to read-side through socket, if the socket of read-side already closed, the write-side would got a signal SIGPIPE, that causes write-side killed by SIGPIPE.

strace is cool.

Replies are listed 'Best First'.
Re: Is this a bug of perl threads?
by almut (Canon) on Mar 12, 2010 at 03:34 UTC

    I can reproduce the problem with your client/server combo.  Running the server part under strace indicated the process had been "killed by SIGPIPE": 

    ...
[pid 27966] write(4, "58\n", 3)         = -1 EPIPE (Broken pipe)
[pid 27966] --- SIGPIPE (Broken pipe) @ 0 (0) ---
Process 27966 detached
[pid 27967] <... accept resumed> 0x4219cef0, [4096]) = ? ERESTARTSYS (
+To be restarted)
[pid 27967] +++ killed by SIGPIPE +++
Process 27967 detached
[pid 27968] <... accept resumed> 0x4299def0, [4096]) = ? ERESTARTSYS (
+To be restarted)
[pid 27968] +++ killed by SIGPIPE +++
Process 27968 detached
<... futex resumed> )                   = ? ERESTARTSYS (To be restart
+ed)
+++ killed by SIGPIPE +++

    [download]

    Adding $SIG{PIPE} = 'IGNORE' to the server code solved the issue for me.  You probably also want to check if the print $client "$second\n" failed, in which case you should close the connection properly (otherwise, the respective threads will remain busy for 60 seconds printing to nowhere...): 

        ...
        for ($second=60; $second>0; --$second) {
                sleep 1;
                last unless print $client "$second\n";
        }
        close $client;
    ...

    [download]
[reply]
[d/l]
[select]

      WOOOOOW, That's awesome! You are right!

      Thank you almut, and thanks everybody, that problem was solved with handling $SIG{PIPE}.

      Seems I need going to read some papers about signals.

[reply]
        That particular signal occurs when you attempt to write to a pipe or socket that's been disconnected. The default action is to kill the process. You can safely ignore the signal. In exchange, you should check if print succeeds, and exit the loop if not. 
        sub server {
    local $SIG{PIPE} = 'IGNORE';
    while (my $client = $server->accept()) {
        for my $sec (1..60) {
            sleep 1;
            print $client "$sec\n"
                or last;
        }
    }
}

        [download]
[reply]
[d/l]
[select]
Re: Is this a bug of perl threads?
by ikegami (Patriarch) on Mar 12, 2010 at 01:40 UTC

    You seem to be think you can send a signal to a thread ("I interrupted one client with CTRL+C"). That's not the case. The signal is sent to the whole process, and the default action of most signals and SIGINT specifically is to kill the process.

    If anything, the bug is on the Windows side. One could say Perl is handling the Ctrl-C as if it was emulating a process even when it's not.

[reply]
      If anything, the bug is on the Windows side. One could say Perl is handling the Ctrl-C as if it was emulating a process even when it's not.

      I read the OP to mean that he was interupting a client with ^C and that was having the side-effect of causing the server to terminate.

      With the only connection between the interupted client and the threaded server being a socket, I doubt that the ^C is being 'forwarded' to it.

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]

        I read the OP to mean that he was interupting a client with ^C and that was having the side-effect of causing the server to terminate.

        Yes, that's what I mean.

[reply]
        No idea what I was thinking.
[reply]

      "The signal is sent to the whole process"? Is this mean that when I interrupt a client process, the signal SIG_INT will be send to the whole server process through the socket?

[reply]

        No, I was just thoroughly confused.

        What's the exit status of the server (server.pl ; echo $?)? ( According to almut below, this would have indicated the server died from SIGPIPE. Have a problem? Check for errors! )

        Is there a parent-child relationship between the server and the clients?

        The fact that the same socket is being used by multiple threads is odd...

[reply]
[d/l]

Back to Seekers of Perl Wisdom