Skip Menu |
 
Report information
Id: 75156
Status: resolved
Priority: 0/
Queue: perl5

Owner: tonyc <tony [at] develop-help.com>
Requestors: bre [at] klaki.net
Cc:
AdminCc:

Operating System: Linux
PatchStatus: (no value)
Severity: medium
Type:
  • library
  • OS-interaction
Perl Version: 5.10.1
Fixed In: (no value)



CC: bre [...] klaki.net
Subject: Closing file handles early breaks IO::Select
Date: Tue, 18 May 2010 07:34:02 +0000
To: perlbug [...] perl.org
From: bre [...] klaki.net
Download (untitled) / with headers
text/plain 4.9k
This is a bug report for perl from bre@klaki.net, generated with the help of perlbug 1.39 running under perl 5.10.1. ----------------------------------------------------------------- [Please describe your issue here] (re-posting what I sent to perl5-porters: the IO::Select perldoc should probably recommend perlbug and not perl5-porters as a venue for bug-reports). I write to you, because I think I have found and fixed a rather nasty (and old) bug in IO::Select: The bug is: IO::Select currently assumes that an IO::Handle will always have a valid file descriptor, which is not actually the case. If you add a handle and the handle later loses its file descriptor (for whatever reason, this appears to be out of the control of the programmer), then IO::Select will stop working and there is no way to remove the broken descriptor, because the add/remove code assumes fileno() will return something useful. The workaround in my code today is to throw away the IO::Select object and build a new one. Attached is a sample program which triggers the bug, and a proposed modification to IO::Select (NewSelect.pm) which I think should fix the problem. In case I fail to attach the files correctly, they can also be found here: http://bre.klaki.net/programs/Perl-IO-Select-Bug/ Addition: The real-world impact of this bug, is to cause most servers written using IO::Select to go into infinite CPU-sucking loops when a watched file-handle is closed without being removed from IO::Select first. My fix does not actually prevent that entirely, but it does give the programmer a mechanism for dealing with the problem and makes code slightly more resiliant - as long as the file handle closure is detected *somewhere* and removed from IO::Select *sometime* the system will recover. [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=library severity=high module=IO::Select --- Site configuration information for perl 5.10.1: Configured by Debian Project at Fri Apr 23 07:59:14 UTC 2010. Summary of my perl5 (revision 5 version 10 subversion 1) configuration: Platform: osname=linux, osvers=2.6.24-27-server, archname=i486-linux-gnu-thread-multi uname='linux vernadsky 2.6.24-27-server #1 smp fri mar 12 01:45:06 utc 2010 i686 gnulinux ' config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.10 -Darchlib=/usr/lib/perl/5.10 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.10.1 -Dsitearch=/usr/local/lib/perl/5.10.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=-g -Doptimize=-O2 -Duseshrplib -Dlibperl=libperl.so.5.10.1 -Dd_dosuid -des' hint=recommended, useposix=true, d_sigaction=define useithreads=define, usemultiplicity=define useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2 -g', cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.4.3', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='cc', ldflags =' -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib /usr/lib64 libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt perllibs=-ldl -lm -lpthread -lc -lcrypt libc=/lib/libc-2.11.1.so, so=so, useshrplib=true, libperl=libperl.so.5.10.1 gnulibc_version='2.11.1' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib -fstack-protector' Locally applied patches: --- @INC for perl 5.10.1: /etc/perl /usr/local/lib/perl/5.10.1 /usr/local/share/perl/5.10.1 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.10 /usr/share/perl/5.10 /usr/local/lib/site_perl . --- Environment for perl 5.10.1: HOME=/home/bre LANG=en_IE.utf8 LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/bre/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games PERL_BADLANG (unset) SHELL=/bin/bash
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.3k
On Tue May 18 00:35:01 2010, bre@klaki.net wrote: Show quoted text
> This is a bug report for perl from bre@klaki.net, > generated with the help of perlbug 1.39 running under perl 5.10.1. > > > ----------------------------------------------------------------- > [Please describe your issue here] > > (re-posting what I sent to perl5-porters: the IO::Select perldoc > should probably recommend perlbug and not perl5-porters as a venue > for bug-reports). > > I write to you, because I think I have found and fixed a rather > nasty (and old) bug in IO::Select: > > The bug is: IO::Select currently assumes that an IO::Handle will > always have a valid file descriptor, which is not actually the case. > If you add a handle and the handle later loses its file descriptor > (for whatever reason, this appears to be out of the control of the > programmer), then IO::Select will stop working and there is no way > to remove the broken descriptor, because the add/remove code > assumes fileno() will return something useful. The workaround in > my code today is to throw away the IO::Select object and build a > new one. > > Attached is a sample program which triggers the bug, and a proposed > modification to IO::Select (NewSelect.pm) which I think should fix > the problem. In case I fail to attach the files correctly, they > can also be found here: > > http://bre.klaki.net/programs/Perl-IO-Select-Bug/ > > > Addition: > > The real-world impact of this bug, is to cause most servers written > using IO::Select to go into infinite CPU-sucking loops when a > watched file-handle is closed without being removed from IO::Select > first. My fix does not actually prevent that entirely, but it does > give the programmer a mechanism for dealing with the problem and > makes code slightly more resiliant - as long as the file handle > closure is detected *somewhere* and removed from IO::Select > *sometime* the system will recover. > >
This older ticket is difficult to evaluate because the attachments the author intended to attach never made it. I went to the web site provided and downloaded those files. With slight modifications, I tried them out and am attaching them. Nevertheless, I can't reproduce the poster's complaint about IO::Select, that is, the 'remove' method seems to be succeeding, whereas the poster's comments suggest that it should be failing. See my attachment, 75156_select.t. Thank you very much. Jim Keenan
Download 75156_select.t
text/plain 954b
#!/usr/bin/perl push @INC, '.'; use strict; use IO::Select; use IO::Socket::INET; use Test::More qw( no_plan ); # First just create a couple of sockets to play with. my $port = 10000+($$ % 500); my $bad_server = IO::Socket::INET->new( LocalAddr => '127.0.0.1', LocalPort => $port, Type => SOCK_STREAM, Listen => 5, ); my $dumb_client = IO::Socket::INET->new( PeerAddr => '127.0.0.1', PeerPort => $port, Type => SOCK_STREAM, ); # Add them to our select objects... my $oldSel = IO::Select->new(); $oldSel->add($bad_server); $oldSel->add($dumb_client); # Make $dumb_client->fileno return undef. $dumb_client->close(); ok(! defined($dumb_client->fileno()), "fileno now returns undef"); # Trigger and test the bug: we cannot remove $dumb_client ! my $before = $oldSel->as_string(); $oldSel->remove($dumb_client); my $after = $oldSel->as_string(); isnt($before, $after, "After remove(), two lines are not the same");
#!/usr/bin/perl push @INC, '.'; use strict; use NewSelect; use IO::Select; use IO::Socket::INET; # First just create a couple of sockets to play with. my $port = 10000+($$ % 500); my $bad_server = IO::Socket::INET->new( LocalAddr => '127.0.0.1', LocalPort => $port, Type => SOCK_STREAM, Listen => 5, ); my $dumb_client = IO::Socket::INET->new( PeerAddr => '127.0.0.1', PeerPort => $port, Type => SOCK_STREAM, ); # Add them to our select objects... my $oldSel = IO::Select->new(); $oldSel->add($bad_server); $oldSel->add($dumb_client); my $newSel = NewSelect->new(); $newSel->add($bad_server); $newSel->add($dumb_client); # Verify that things are sane and agree my $fn1 = $oldSel->_fileno($dumb_client); my $fn2 = $newSel->_fileno($dumb_client); die "newSel is broken, $fn1 != $fn2\n" unless ($fn1 eq $fn2); print "Our dumb client has fd $fn1 ($fn2)\n"; # Make $dumb_client->fileno return undef. $dumb_client->close(); #my $rv = $dumb_client->fileno(); #defined $rv ? print "Defined\n" : print "Not defined\n"; # Trigger and test the bug: we cannot remove $dumb_client ! print "The following two lines should not be the same: (old)\n"; print "\t", $oldSel->as_string(), "\n"; $oldSel->remove($dumb_client); print "\t", $oldSel->as_string(), "\n"; print "\n"; # Make sure that my fixed code actually fixes this problem. print "The following two lines should not be the same: (new)\n"; print "\t", $newSel->as_string(), "\n"; $newSel->remove($dumb_client); print "\t", $newSel->as_string(), "\n"; # Tah dah!
Download NewSelect.pm
text/x-perl 4.1k
# IO::Select.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package NewSelect; use strict; use warnings::register; use vars qw($VERSION @ISA); require Exporter; $VERSION = "1.17"; @ISA = qw(Exporter); # This is only so we can do version checking sub VEC_BITS () {0} sub FD_COUNT () {1} sub FIRST_FD () {2} sub new { my $self = shift; my $type = ref($self) || $self; my $vec = bless [undef,0], $type; $vec->add(@_) if @_; $vec; } sub add { shift->_update('add', @_); } sub remove { shift->_update('remove', @_); } sub exists { my $vec = shift; my $fno = $vec->_fileno(shift); return undef unless defined $fno; $vec->[$fno + FIRST_FD]; } sub _fileno { my($self, $f) = @_; return unless defined $f; $f = $f->[0] if ref($f) eq 'ARRAY'; my $fno = ($f =~ /^\d+$/) ? $f : fileno($f); return $fno if (defined $fno); # If the above test returns undef, then do a linear search. for (my $i = FIRST_FD; $i++; $i < @$self) { return ($i - FIRST_FD) if ($self->[$i] == $f); } return; } sub _update { my $vec = shift; my $add = shift eq 'add'; my $bits = $vec->[VEC_BITS]; $bits = '' unless defined $bits; my $count = 0; my $f; foreach $f (@_) { my $fn = $vec->_fileno($f); next unless defined $fn; my $i = $fn + FIRST_FD; if ($add) { if (defined $vec->[$i]) { $vec->[$i] = $f; # if array rest might be different, so we update next; } $vec->[FD_COUNT]++; vec($bits, $fn, 1) = 1; $vec->[$i] = $f; } else { # remove next unless defined $vec->[$i]; $vec->[FD_COUNT]--; vec($bits, $fn, 1) = 0; $vec->[$i] = undef; } $count++; } $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef; $count; } sub can_read { my $vec = shift; my $timeout = shift; my $r = $vec->[VEC_BITS]; defined($r) && (select($r,undef,undef,$timeout) > 0) ? handles($vec, $r) : (); } sub can_write { my $vec = shift; my $timeout = shift; my $w = $vec->[VEC_BITS]; defined($w) && (select(undef,$w,undef,$timeout) > 0) ? handles($vec, $w) : (); } sub has_exception { my $vec = shift; my $timeout = shift; my $e = $vec->[VEC_BITS]; defined($e) && (select(undef,undef,$e,$timeout) > 0) ? handles($vec, $e) : (); } sub has_error { warnings::warn("Call to deprecated method 'has_error', use 'has_exception'") if warnings::enabled(); goto &has_exception; } sub count { my $vec = shift; $vec->[FD_COUNT]; } sub bits { my $vec = shift; $vec->[VEC_BITS]; } sub as_string # for debugging { my $vec = shift; my $str = ref($vec) . ": "; my $bits = $vec->bits; my $count = $vec->count; $str .= defined($bits) ? unpack("b*", $bits) : "undef"; $str .= " $count"; my @handles = @$vec; splice(@handles, 0, FIRST_FD); for (@handles) { $str .= " " . (defined($_) ? "$_" : "-"); } $str; } sub _max { my($a,$b,$c) = @_; $a > $b ? $a > $c ? $a : $c : $b > $c ? $b : $c; } sub select { shift if defined $_[0] && !ref($_[0]); my($r,$w,$e,$t) = @_; my @result = (); my $rb = defined $r ? $r->[VEC_BITS] : undef; my $wb = defined $w ? $w->[VEC_BITS] : undef; my $eb = defined $e ? $e->[VEC_BITS] : undef; if(select($rb,$wb,$eb,$t) > 0) { my @r = (); my @w = (); my @e = (); my $i = _max(defined $r ? scalar(@$r)-1 : 0, defined $w ? scalar(@$w)-1 : 0, defined $e ? scalar(@$e)-1 : 0); for( ; $i >= FIRST_FD ; $i--) { my $j = $i - FIRST_FD; push(@r, $r->[$i]) if defined $rb && defined $r->[$i] && vec($rb, $j, 1); push(@w, $w->[$i]) if defined $wb && defined $w->[$i] && vec($wb, $j, 1); push(@e, $e->[$i]) if defined $eb && defined $e->[$i] && vec($eb, $j, 1); } @result = (\@r, \@w, \@e); } @result; } sub handles { my $vec = shift; my $bits = shift; my @h = (); my $i; my $max = scalar(@$vec) - 1; for ($i = FIRST_FD; $i <= $max; $i++) { next unless defined $vec->[$i]; push(@h, $vec->[$i]) if !defined($bits) || vec($bits, $i - FIRST_FD, 1); } @h; } 1; __END__
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 506b
On Tue May 18 00:35:01 2010, bre@klaki.net wrote: Show quoted text
> This is a bug report for perl from bre@klaki.net, > generated with the help of perlbug 1.39 running under perl 5.10.1. > > > ----------------------------------------------------------------- > [Please describe your issue here] > > (re-posting what I sent to perl5-porters: the IO::Select perldoc > should probably recommend perlbug and not perl5-porters as a venue > for bug-reports).
I’ve fixed that with commit 9f7d1e4. -- Father Chrysostomos
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.5k
On Tue Jan 03 19:06:13 2012, jkeenan wrote: Show quoted text
> On Tue May 18 00:35:01 2010, bre@klaki.net wrote:
> > (re-posting what I sent to perl5-porters: the IO::Select perldoc > > should probably recommend perlbug and not perl5-porters as a venue > > for bug-reports). > > > > I write to you, because I think I have found and fixed a rather > > nasty (and old) bug in IO::Select: > > > > The bug is: IO::Select currently assumes that an IO::Handle will > > always have a valid file descriptor, which is not actually the case. > > If you add a handle and the handle later loses its file descriptor > > (for whatever reason, this appears to be out of the control of the > > programmer), then IO::Select will stop working and there is no way > > to remove the broken descriptor, because the add/remove code > > assumes fileno() will return something useful. The workaround in > > my code today is to throw away the IO::Select object and build a > > new one. > > > > Attached is a sample program which triggers the bug, and a proposed > > modification to IO::Select (NewSelect.pm) which I think should fix > > the problem. In case I fail to attach the files correctly, they > > can also be found here: > > > > http://bre.klaki.net/programs/Perl-IO-Select-Bug/ > > > > > > Addition: > > > > The real-world impact of this bug, is to cause most servers written > > using IO::Select to go into infinite CPU-sucking loops when a > > watched file-handle is closed without being removed from IO::Select > > first. My fix does not actually prevent that entirely, but it does > > give the programmer a mechanism for dealing with the problem and > > makes code slightly more resiliant - as long as the file handle > > closure is detected *somewhere* and removed from IO::Select > > *sometime* the system will recover. > > > >
> > This older ticket is difficult to evaluate because the attachments the > author intended to attach never made it. I went to the web site > provided and downloaded those files. With slight modifications, I tried > them out and am attaching them. > > Nevertheless, I can't reproduce the poster's complaint about IO::Select, > that is, the 'remove' method seems to be succeeding, whereas the > poster's comments suggest that it should be failing. See my attachment, > 75156_select.t.
There's a partial fix for this issue in 2e6546ca, unfortunately that fix has a couple of bugs: - it doesn't update the bit vector ($bits) so the next can_read() will attempt to wait on a closed selector - it doesn't update $count, so remove returns failure even though the FH was (buggily) removed Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 434b
On Tue Sep 17 19:11:58 2013, tonyc wrote: Show quoted text
> There's a partial fix for this issue in 2e6546ca, unfortunately that fix > has a couple of bugs: > > - it doesn't update the bit vector ($bits) so the next can_read() will > attempt to wait on a closed selector > > - it doesn't update $count, so remove returns failure even though the FH > was (buggily) removed
Tests and fixes attached, which I'll apply in a couple of days or so. Tony
From b58d6c0df55563f960c7413cd97662e2c38870dc Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Wed, 18 Sep 2013 15:55:12 +1000 Subject: [PATCH 2/2] [perl #75156] fix the return value and bits for removing a closed fh --- dist/IO/lib/IO/Select.pm | 27 ++++++++++++++++++--------- dist/IO/t/io_sel.t | 4 ++-- 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/dist/IO/lib/IO/Select.pm b/dist/IO/lib/IO/Select.pm index 756a299..994f896 100644 --- a/dist/IO/lib/IO/Select.pm +++ b/dist/IO/lib/IO/Select.pm @@ -11,7 +11,7 @@ use warnings::register; use vars qw($VERSION @ISA); require Exporter; -$VERSION = "1.21"; +$VERSION = "1.22"; @ISA = qw(Exporter); # This is only so we can do version checking @@ -86,15 +86,24 @@ sub _update $vec->[$i] = $f; } else { # remove if ( ! defined $fn ) { # remove if fileno undef'd - defined($_) && $_ == $f and do { $vec->[FD_COUNT]--; $_ = undef; } - for @{$vec}[FIRST_FD .. $#$vec]; - next; + $fn = 0; + for my $fe (@{$vec}[FIRST_FD .. $#$vec]) { + if (defined($fe) && $fe == $f) { + $vec->[FD_COUNT]--; + $fe = undef; + vec($bits, $fn, 1) = 0; + last; + } + ++$fn; + } + } + else { + my $i = $fn + FIRST_FD; + next unless defined $vec->[$i]; + $vec->[FD_COUNT]--; + vec($bits, $fn, 1) = 0; + $vec->[$i] = undef; } - my $i = $fn + FIRST_FD; - next unless defined $vec->[$i]; - $vec->[FD_COUNT]--; - vec($bits, $fn, 1) = 0; - $vec->[$i] = undef; } $count++; } diff --git a/dist/IO/t/io_sel.t b/dist/IO/t/io_sel.t index bd61b68..34af03a 100644 --- a/dist/IO/t/io_sel.t +++ b/dist/IO/t/io_sel.t @@ -143,9 +143,9 @@ print "ok 23\n" ; print "ok 24 - added socket\n"; close $fh; print "not " unless $sel->remove($fh) == 1; - print "ok 25 - removed closed socket # TODO code doesn't update count\n"; + print "ok 25 - removed closed socket\n"; print "not " unless $sel->count == 1; print "ok 26 - count() updated\n"; print "not " unless $sel->bits ne $oldbits; - print "ok 27 - bits() updated # TODO code doesn't update bits\n"; + print "ok 27 - bits() updated\n"; } -- 1.7.10.4
From a78df7b89b5bca007c58dac456521d5b61ff8553 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Wed, 18 Sep 2013 15:20:19 +1000 Subject: [PATCH 1/2] [perl #75156] tests for deleting a closed handle from IO::Select --- dist/IO/t/io_sel.t | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/dist/IO/t/io_sel.t b/dist/IO/t/io_sel.t index eb4bb90..bd61b68 100644 --- a/dist/IO/t/io_sel.t +++ b/dist/IO/t/io_sel.t @@ -3,7 +3,7 @@ select(STDERR); $| = 1; select(STDOUT); $| = 1; -print "1..23\n"; +print "1..27\n"; use IO::Select 1.09; @@ -129,3 +129,23 @@ IO::Select::has_error(); print "not " unless $w == 1 ; $w = 0 ; print "ok 23\n" ; + +{ + # perl #75156 - test we can delete a closed handle + require IO::Socket::INET; + my $fh = IO::Socket::INET->new( + Listen => 5, + ); + my $sel = IO::Select->new(\*STDIN); + $sel->add($fh); + my $oldbits = $sel->bits; + print "not " unless $sel->count == 2; + print "ok 24 - added socket\n"; + close $fh; + print "not " unless $sel->remove($fh) == 1; + print "ok 25 - removed closed socket # TODO code doesn't update count\n"; + print "not " unless $sel->count == 1; + print "ok 26 - count() updated\n"; + print "not " unless $sel->bits ne $oldbits; + print "ok 27 - bits() updated # TODO code doesn't update bits\n"; +} -- 1.7.10.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 598b
On Tue Sep 17 22:56:31 2013, tonyc wrote: Show quoted text
> On Tue Sep 17 19:11:58 2013, tonyc wrote:
> > There's a partial fix for this issue in 2e6546ca, unfortunately that fix > > has a couple of bugs: > > > > - it doesn't update the bit vector ($bits) so the next can_read() will > > attempt to wait on a closed selector > > > > - it doesn't update $count, so remove returns failure even though the FH > > was (buggily) removed
> > Tests and fixes attached, which I'll apply in a couple of days or so.
Applied as 3bfb0615ce07345b2bdefdd1acbd343f4dfa21d7 and ff4a442c79158c7df99be693a8f8559a09cf6df7. Tony


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org