| Subject: | accept() closes socket after first connection if non-forked |
A code like that:
<<<<<<<<<<<<<<<
my $server = io("localhost:$port");
while (1)
{
my $connection = $server->accept();
# Do something with $connection
...
$connection->close();
}
Show quoted text
>>>>>>>>>>>>>>>
Will fail after the first connection. The attached patch fixes this problem and adds a regression test. (it was a one line fix).
Note that the patch also fixes http://rt.cpan.org/NoAuth/Bug.html?id=7448 because it prevented the package from passing all tests.
--- ./lib/IO/All/Socket.pm.orig 2005-02-18 03:16:10.433981496 +0200
+++ ./lib/IO/All/Socket.pm 2005-02-18 03:16:32.868570920 +0200
@@ -46,7 +46,7 @@
close $socket;
undef $socket;
}
- close $server;
+ close $server if $self->_fork;
my $io = ref($self)->new->socket_handle($socket);
$io->io_handle($socket);
$io->is_open(1);
--- ./t/accept.t.orig 2005-02-18 02:23:37.582287808 +0200
+++ ./t/accept.t 2005-02-18 03:15:20.543565992 +0200
@@ -0,0 +1,83 @@
+use lib 't', 'lib';
+use strict;
+use warnings;
+use Test::More tests => 20;
+use IO::All;
+use IO_All_Test;
+use IO::Socket::INET;
+
+# This test tests for the ability of a non-forking socket to handle more
+# than one connection.
+
+my $pid = fork();
+if (! $pid)
+{
+ # Let the child process listen on a port
+ my $port = 5555;
+ my $accepted = 0;
+ while (1)
+ {
+ # Log the port to a file.
+ open my $out, ">t/output/server-port.t";
+ print {$out} $port;
+ close($out);
+
+ my $server = io("localhost:$port");
+
+ eval {
+ for my $count (1 .. 10)
+ {
+ my $connection = $server->accept();
+ $accepted = 1;
+ $connection->print(sprintf("Ingy-%.2d", $count));
+ $connection->close();
+ }
+ };
+ if ($accepted)
+ {
+ # We have a listening socket on a port, so we can continue
+ last;
+ }
+ }
+ continue
+ {
+ # Try a different port.
+ $port++;
+ }
+ exit(0);
+}
+# Let the parent process handle the testing.
+
+# Wait a little for the client to find a port.
+sleep(1);
+
+open my $in, "<t/output/server-port.t";
+my $port = <$in>;
+close($in);
+
+# TEST*2*10
+for my $c (1 .. 10)
+{
+ my $sock = IO::Socket::INET->new(
+ PeerAddr => "localhost",
+ PeerPort => $port,
+ Proto => "tcp"
+ );
+
+ ok(defined($sock), "Checking for validity of sock No. $c");
+
+ if (!defined($sock))
+ {
+ last;
+ }
+
+ my $data;
+ $sock->recv($data, 7);
+
+ $sock->close();
+
+ is ($data, sprintf("Ingy-%.2d", $c), "Checking for connection No. $c.");
+}
+
+waitpid($pid, 0);
+
--- ./t/synopsis2.t.orig 2005-02-18 11:20:13.834713464 +0200
+++ ./t/synopsis2.t 2005-02-18 11:20:48.301473720 +0200
@@ -8,16 +8,26 @@
# Print name and first line of all files in a directory
my $dir = io('t/mydir');
ok($dir->is_dir);
+my @entries;
while (my $io = $dir->next) {
if ($io->is_file) {
- my $line = $io->name . ' - ' . $io->getline;
- is($line, flip_slash scalar <DATA>);
+ push @entries,
+ +{
+ 'n' => $io->name,
+ 'v' => ($io->name . ' - ' . $io->getline)
+ };
}
}
+for my $file (sort { $a->{'n'} cmp $b->{'n'} } @entries)
+{
+ my $line = $file->{'v'};
+ is($line, flip_slash scalar <DATA>);
+}
+
# Print name of all files recursively
is("$_\n", flip_slash scalar <DATA>)
- for grep {! /CVS|\.svn/} io('t/mydir')->all_files(0);
+ for sort { "$a" cmp "$b" } grep {! /CVS|\.svn/} io('t/mydir')->all_files(0);
__END__
t/mydir/file1 - file1 is fun
--- ./MANIFEST.orig 2005-02-18 03:19:18.132446992 +0200
+++ ./MANIFEST 2005-02-18 03:19:33.267146168 +0200
@@ -27,6 +27,7 @@
t/absolute.t
t/all.t
t/all2.t
+t/accept.t
t/assert.t
t/assert2.t
t/autotie.t