It seems that accept on a inherited handle is no good.

Works:

use strict;
use warnings;

$|=1;

if (fork() == 0) {
   print("$$: Child 1.$/");
   sleep(3);
} elsif (fork() == 0) {
   print("$$: Child 2.$/");
   sleep(3);
} else {
   print("$$: Parent.$/");
   sleep(3);
}

print("$$: oye.$/");
[download]

Works:

use strict;
use warnings;

use IO::Socket::INET;

$|=1;

if (fork() == 0) {
   print("$$: Child 1.$/");
   my $server = IO::Socket::INET->new( 
      Type => SOCK_STREAM, 
      Proto => 'TCP', 
      LocalPort => 2500, 
      Reuse => 1, 
      Listen => 10
   );
   $server->accept();
} else {
   sleep(1);   # Make sure accept is reached.
   if (fork() == 0) {
      print("$$: Child 2.$/");
      sleep(3);
   } else {
      print("$$: Parent.$/");
      sleep(3);
   }
}

print("$$: oye.$/");
[download]

Doesn't Work:

use strict;
use warnings;

use IO::Socket::INET;

$|=1;

my $server = IO::Socket::INET->new( 
   Type => SOCK_STREAM, 
   Proto => 'TCP', 
   LocalPort => 2500, 
   Reuse => 1, 
   Listen => 10
);

if (fork() == 0) {
   print("$$: Child 1.$/");
   $server->accept();
} else {
   sleep(1);   # Make sure accept is reached.
   if (fork() == 0) {  # <------ Doesn't returns until accept returns.
      print("$$: Child 2.$/");
      sleep(3);
   } else {
      print("$$: Parent.$/");
      sleep(3);
   }
}

print("$$: oye.$/");
[download]

Could this be related to the fact that fork doesn't actually fork in Win32? (It just starts a new thread.)

I can easily make your code work, just by adding a Timeout to your socket, which you should have any way. A server socket without timeout can run into many problems. Other than the problem you demo'd here, it could also become a dead socket (a socket that cannot be awakened by accept()), if you leave it idle for long enough.

use strict;
use warnings;

use IO::Socket::INET;

$|=1;

my $server = IO::Socket::INET->new( 
   Proto => 'TCP', 
   LocalPort => 2500, 
   Reuse => 1, 
   Listen => 10,
Timeout=>1
);

if (fork() == 0) {
   print("$$: Child 1.$/");
   $server->accept();
} else {
   sleep(1);   # Make sure accept is reached.
   if (fork() == 0) {  # <------ Doesn't returns until accept returns.
      print("$$: Child 2.$/");
      sleep(3);
   } else {
      print("$$: Parent.$/");
      sleep(3);
   }
}

print("$$: oye.$/");
[download]

But why would accept in one pseudo-process (thread) tie up a function (fork) in another pseudo-process (thread)? Does any other function have the same effect?

I'm definitely interested in hearing how "a server socket without timeout can run into many problems". Could you elaborate?

Same treatment as I mentioned above: add Timeout, which is always good to have.

use POSIX;
use strict;
$|++;

my $server = IO::Socket::INET->new( 
    Type => SOCK_STREAM, 
    Proto => 'TCP', 
    LocalPort => 2500, 
    Reuse => 1, 
    Listen => 10,
    Timeout=>1
);

my $max_children = 3;
my $current_children;
my %children;


sub interrupt
{
    $SIG{CHLD}  = 'IGNORE';
    for( keys %children )
    {
        kill KILL => $_
    }
    exit;
}

sub chld
{
    $SIG{CHLD} = \&chld;
    my $pid = wait;
    $current_children--;
    delete $children{ $pid };
    
    print "Called\n";
}

print "before preforking\n";
for( 0 .. $max_children )
{
    print "forking\n";
    make_child();
    print "after forking\n";
}

print "----AFTER PRE-FORKING---------\n";

$SIG{CHLD} = \&chld;
$SIG{INT} = \&interrupt unless $^O =~ /Win32/i;

interrupt();
exit;
while( 0 )
{
    sleep;
    
    my $i = $current_children;
    while( $i++ < $max_children )
    {
        make_child();
    }
}

sub make_child
{
    my $pid;
    my $sigset;
        
    die "Error forking: $!" unless defined( $pid = fork );
    
    print "After fork: $pid\n";
    if( $pid )
    {
        $children{ $pid }++;
        $current_children++;
        
        print "if(\$pid); returning\n";
        return;
    }
    
    else
    {
        print "Else\n";
        
        $SIG{INT} = 'DEFAULT';
        
        while( 1 )
        {
            #comment out these lines to prevent freezeing
            my $client = $server->accept() or last;
            handle( $client );
            $client->shutdown(2);
            #here
        }
        
        print "exiting else\n";
        exit;
    }
    
    print "never reached\n";
}

sub handle
{
    my $client = shift;
    
    my %headers;
    
    while( <$client> )
    {
        s/\r\n$//;
        my( $k, $v ) = split/:/,$_,2;
        $headers{ $k } = $v;
        last if( length $_ == 0 );
    }
    print "After headers\n";
    
    print $client "HTTP/1.1 200 OK\nContent-Type: text/plain\n\nhi";
    $client->shutdown(2);
}
[download]