Hello community, here is the log from the commit of package perl-PerlIO-via-Timeout for openSUSE:Factory checked in at 2015-08-01 11:38:04 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-PerlIO-via-Timeout (Old) and /work/SRC/openSUSE:Factory/.perl-PerlIO-via-Timeout.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "perl-PerlIO-via-Timeout" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-PerlIO-via-Timeout/perl-PerlIO-via-Timeout.changes 2015-05-15 07:44:58.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-PerlIO-via-Timeout.new/perl-PerlIO-via-Timeout.changes 2015-08-01 11:38:05.000000000 +0200 @@ -1,0 +2,10 @@ +Wed Jul 29 09:01:07 UTC 2015 - coolo@suse.com + +- updated to 0.31 + see /usr/share/doc/packages/perl-PerlIO-via-Timeout/Changes + + 0.31 2015-07-29 07:59:46CEST+0200 Europe/Paris + . fixed a potential race condition case where read or write would be + blocking even with a timeout (thanks to Luciano Rocha) + +------------------------------------------------------------------- Old: ---- PerlIO-via-Timeout-0.30.tar.gz New: ---- PerlIO-via-Timeout-0.31.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-PerlIO-via-Timeout.spec ++++++ --- /var/tmp/diff_new_pack.jt8vbZ/_old 2015-08-01 11:38:05.000000000 +0200 +++ /var/tmp/diff_new_pack.jt8vbZ/_new 2015-08-01 11:38:05.000000000 +0200 @@ -17,7 +17,7 @@ Name: perl-PerlIO-via-Timeout -Version: 0.30 +Version: 0.31 Release: 0 %define cpan_name PerlIO-via-Timeout Summary: PerlIO layer that adds read & write timeout to a handle ++++++ PerlIO-via-Timeout-0.30.tar.gz -> PerlIO-via-Timeout-0.31.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/Changes new/PerlIO-via-Timeout-0.31/Changes --- old/PerlIO-via-Timeout-0.30/Changes 2015-05-13 20:33:15.000000000 +0200 +++ new/PerlIO-via-Timeout-0.31/Changes 2015-07-29 07:59:52.000000000 +0200 @@ -1,3 +1,7 @@ +0.31 2015-07-29 07:59:46CEST+0200 Europe/Paris + . fixed a potential race condition case where read or write would be + blocking even with a timeout (thanks to Luciano Rocha) + 0.30 2015-05-13 20:33:08CEST+0200 Europe/Amsterdam 0.29 2013-12-28 22:31:38 Europe/Paris diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/META.yml new/PerlIO-via-Timeout-0.31/META.yml --- old/PerlIO-via-Timeout-0.30/META.yml 2015-05-13 20:33:15.000000000 +0200 +++ new/PerlIO-via-Timeout-0.31/META.yml 2015-07-29 07:59:52.000000000 +0200 @@ -21,7 +21,7 @@ provides: PerlIO::via::Timeout: file: lib/PerlIO/via/Timeout.pm - version: 0.30 + version: 0.31 requires: Exporter: 5.57 PerlIO::via: 0 @@ -29,4 +29,4 @@ resources: bugtracker: https://github.com/dams/perlio-via-timeout/issues repository: git://github.com/dams/perlio-via-timeout.git -version: 0.30 +version: 0.31 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/Makefile.PL new/PerlIO-via-Timeout-0.31/Makefile.PL --- old/PerlIO-via-Timeout-0.30/Makefile.PL 2015-05-13 20:33:15.000000000 +0200 +++ new/PerlIO-via-Timeout-0.31/Makefile.PL 2015-07-29 07:59:52.000000000 +0200 @@ -92,7 +92,7 @@ "Test::More" => 0, "Test::TCP" => 0 }, - "VERSION" => "0.30", + "VERSION" => "0.31", "test" => { "TESTS" => "t/*.t" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/README new/PerlIO-via-Timeout-0.31/README --- old/PerlIO-via-Timeout-0.30/README 2015-05-13 20:33:15.000000000 +0200 +++ new/PerlIO-via-Timeout-0.31/README 2015-07-29 07:59:52.000000000 +0200 @@ -1,7 +1,7 @@ This archive contains the distribution PerlIO-via-Timeout, -version 0.30: +version 0.31: a PerlIO layer that adds read & write timeout to a handle diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/lib/PerlIO/via/Timeout.pm new/PerlIO-via-Timeout-0.31/lib/PerlIO/via/Timeout.pm --- old/PerlIO-via-Timeout-0.30/lib/PerlIO/via/Timeout.pm 2015-05-13 20:33:15.000000000 +0200 +++ new/PerlIO-via-Timeout-0.31/lib/PerlIO/via/Timeout.pm 2015-07-29 07:59:52.000000000 +0200 @@ -7,7 +7,7 @@ # the same terms as the Perl 5 programming language system itself. # package PerlIO::via::Timeout; -$PerlIO::via::Timeout::VERSION = '0.30'; +$PerlIO::via::Timeout::VERSION = '0.31'; # ABSTRACT: a PerlIO layer that adds read & write timeout to a handle require 5.008; @@ -15,7 +15,9 @@ use strict; use warnings; use Carp; -use Errno qw(EBADF EINTR ETIMEDOUT); +use Errno qw(EBADF EINTR ETIMEDOUT EAGAIN EWOULDBLOCK); +use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); + use Exporter 'import'; # gives you Exporter's import() method directly @@ -60,40 +62,75 @@ close $_[1] or -1; } +sub _set_flags { + # params: FH, FLAGS + local $!; + fcntl($_[0], F_SETFL, $_[1]) + or die "Can't set flags for the filehandle: $!\n"; + +} + +sub _get_flags { + # params: FH + local $!; + my $flags = fcntl($_[0], F_GETFL, 0) + or die "Can't get flags for the filehandle: $!\n"; + return $flags; +} + sub READ { # params: SELF, BUF, LEN, FH my ($self, undef, $len, $fh) = @_; - # There is a bug in PerlIO::via (possibly in PerlIO ?). We would like - # to return -1 to signify error, but doing so doesn't work (it usually - # segfault), it looks like the implementation is not complete. So we - # return 0. my ($prop, $fd) = __PACKAGE__->_fh2prop($fh); my $timeout_enabled = $prop->{timeout_enabled}; my $read_timeout = $prop->{read_timeout}; my $offset = 0; - while ($len) { - if ( $timeout_enabled && $read_timeout && $len && ! _can_read_write($fh, $fd, $read_timeout, 0)) { - $! ||= ETIMEDOUT; - return 0; - } - my $r = sysread($fh, $_[1], $len, $offset); - if (defined $r) { - last unless $r; - $len -= $r; - $offset += $r; - } - elsif ($! != EINTR) { - # There is a bug in PerlIO::via (possibly in PerlIO ?). We would like - # to return -1 to signify error, but doing so doesn't work (it usually - # segfault), it looks like the implementation is not complete. So we - # return 0. - return 0; + + if ( ! $timeout_enabled || ! $read_timeout) { + while ($len) { + my $r = sysread($fh, $_[1], $len, $offset); + if (defined $r) { + last unless $r; + $len -= $r; + $offset += $r; + } elsif ($! != EINTR) { + # There is a bug in PerlIO::via (possibly in PerlIO ?). We would + # like to return -1 to signify error, but doing so doesn't work (it + # usually segfaults), it looks like the implementation is not + # complete. So we return 0. + return 0; + } } + return $offset; + } else { + my $flags = _get_flags($fh); + _set_flags($fh, $flags | O_NONBLOCK); + while ($len) { + if ($len && ! _can_read_write($fh, $fd, $read_timeout, 0)) { + $! ||= ETIMEDOUT; + $offset = 0; + last; + } + my $r = sysread($fh, $_[1], $len, $offset); + if (defined $r) { + last unless $r; #EOF + $len -= $r; + $offset += $r; + } elsif ($! != EINTR && $! != EAGAIN && $! != EWOULDBLOCK) { + # There is a bug in PerlIO::via (possibly in PerlIO ?). We would + # like to return -1 to signify error, but doing so doesn't work (it + # usually segfaults), it looks like the implementation is not + # complete. So we return 0. + $offset = 0; + last; + } + } + _set_flags($fh, $flags); + return $offset; } - return $offset; } sub WRITE { @@ -107,22 +144,39 @@ my $len = length $_[1]; my $offset = 0; - while ($len) { - if ( $len && $timeout_enabled && $write_timeout && ! _can_read_write($fh, $fd, $write_timeout, 1)) { - $! ||= ETIMEDOUT; - return -1; - } - my $r = syswrite($fh, $_[1], $len, $offset); - if (defined $r) { - $len -= $r; - $offset += $r; - last unless $len; + + if ( ! $timeout_enabled || ! $write_timeout) { + while ($len) { + my $r = syswrite($fh, $_[1], $len, $offset); + if (defined $r) { + $len -= $r; + $offset += $r; + } elsif ($! != EINTR) { + return -1; + } } - elsif ($! != EINTR) { - return -1; + } else { + my $flags = _get_flags($fh); + _set_flags($fh, $flags | O_NONBLOCK); + while ($len) { + if ( $len && ! _can_read_write($fh, $fd, $write_timeout, 1)) { + $! ||= ETIMEDOUT; + $offset = -1; + last; + } + my $r = syswrite($fh, $_[1], $len, $offset); + if (defined $r) { + $len -= $r; + $offset += $r; + last unless $len; # EOF + } elsif ($! != EINTR && $! != EAGAIN && $! != EWOULDBLOCK) { + $offset = -1; + last + } } + _set_flags($fh, $flags); + return $offset; } - return $offset; } sub _can_read_write { @@ -145,8 +199,8 @@ if ($nfound == -1) { $! == EINTR or croak(qq/select(2): '$!'/); - redo if !$timeout || ($pending = $timeout - (Time::HiRes::time - - $initial)) > 0; + !$timeout || ($pending -= Time::HiRes::time - $initial) > 0 + and next; $nfound = 0; } last; @@ -209,7 +263,7 @@ =head1 VERSION -version 0.30 +version 0.31 =head1 SYNOPSIS