Very large seek in a read-only scalar variable filehandle segfaults #14342
Comments
From @eserteThe attached script is causing a segmentation fault on FreeBSD and Linux systems with newer perls (5.16 .. 5.21) or may consume lots of memory with older perls (5.8 .. 5.14). The script is basically doing a huge seek() with a subsequent read(). Doing the same with a read-only file is not causing any problems, because Unix does not extend the file and treats the huge seek position as an eof position. Also it seems that the CPAN module IO::Scalar does not have any problems. valgrind says the following: ==32540== Process terminating with default action of signal 11 (SIGSEGV) The original problem was reported for the CPAN module Image::Info: Regards, |
From @tonycozOn Tue Dec 16 13:00:59 2014, slaven@rezic.de wrote:
Please try the attached patches. The first fixes your test cases, the second prevents the stored file Tony |
From @tonycoz0001-perl-123443-avoid-overflowing-got-into-a-negative-nu.patchFrom 8800bfd6ddc89d521140c034b3c07646e6e8da7c Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 17 Dec 2014 13:32:43 +1100
Subject: [perl #123443] avoid overflowing got into a negative number
---
ext/PerlIO-scalar/scalar.pm | 2 +-
ext/PerlIO-scalar/scalar.xs | 12 +++++++++---
ext/PerlIO-scalar/t/scalar.t | 11 ++++++++++-
3 files changed, 20 insertions(+), 5 deletions(-)
diff --git a/ext/PerlIO-scalar/scalar.pm b/ext/PerlIO-scalar/scalar.pm
index 2dca6b0..03f60b2 100644
--- a/ext/PerlIO-scalar/scalar.pm
+++ b/ext/PerlIO-scalar/scalar.pm
@@ -1,5 +1,5 @@
package PerlIO::scalar;
-our $VERSION = '0.20';
+our $VERSION = '0.21';
require XSLoader;
XSLoader::load();
1;
diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index 67e9ae3..f130c0c 100644
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -152,7 +152,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
SV *sv = s->var;
char *p;
STRLEN len;
- I32 got;
+ STRLEN got;
p = SvPV(sv, len);
if (SvUTF8(sv)) {
if (sv_utf8_downgrade(sv, TRUE)) {
@@ -165,9 +165,15 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
return -1;
}
}
- got = len - (STRLEN)(s->posn);
- if (got <= 0)
+ /* I assume that Off_t is at least as large as len (which
+ * seems safe) and that the size of the buffer in our SV is
+ * always less than half the size of the address space
+ */
+ assert(sizeof(Off_t) >= sizeof(len));
+ assert((Off_t)len >= 0);
+ if ((Off_t)len <= s->posn)
return 0;
+ got = len - (STRLEN)(s->posn);
if ((STRLEN)got > (STRLEN)count)
got = (STRLEN)count;
Copy(p + (STRLEN)(s->posn), vbuf, got, STDCHAR);
diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t
index 9bc1abe..547ecea 100644
--- a/ext/PerlIO-scalar/t/scalar.t
+++ b/ext/PerlIO-scalar/t/scalar.t
@@ -16,7 +16,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere.
$| = 1;
-use Test::More tests => 114;
+use Test::More tests => 118;
my $fh;
my $var = "aaa\n";
@@ -491,3 +491,12 @@ my $byte_warning = "Strings with code points over 0xFF may not be mapped into in
print $refh "boo\n";
is $x, $as_string."boo\n", 'string gets appended to ref';
}
+
+{ # [perl #123443]
+ my $buf0 = "hello";
+ open my $fh, "<", \$buf0 or die $!;
+ ok(seek($fh, 2**32, SEEK_SET), "seek to a large position");
+ is(read($fh, my $tmp, 1), 0, "read from a large offset");
+ is($tmp, "", "should have read nothing");
+ ok(eof($fh), "fh should be eof");
+}
--
1.7.10.4
|
From @tonycoz0002-don-t-allow-a-negative-file-position-on-a-PerlIO-sca.patchFrom 56967151c5b8559b443a0b5fbb8d7331e3277d20 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 17 Dec 2014 13:15:53 +1100
Subject: don't allow a negative file position on a PerlIO::scalar handle
previosly seek() would produce an error, but would still make the\
file position negative.
---
ext/PerlIO-scalar/scalar.xs | 10 ++++++----
ext/PerlIO-scalar/t/scalar.t | 9 ++++++++-
2 files changed, 14 insertions(+), 5 deletions(-)
diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index f130c0c..9e9f7c2 100644
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -103,28 +103,30 @@ IV
PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+ Off_t new_posn = -1;
switch (whence) {
case SEEK_SET:
- s->posn = offset;
+ new_posn = offset;
break;
case SEEK_CUR:
- s->posn = offset + s->posn;
+ new_posn = offset + s->posn;
break;
case SEEK_END:
{
STRLEN oldcur;
(void)SvPV(s->var, oldcur);
- s->posn = offset + oldcur;
+ new_posn = offset + oldcur;
break;
}
}
- if (s->posn < 0) {
+ if (new_posn < 0) {
if (ckWARN(WARN_LAYER))
Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string");
SETERRNO(EINVAL, SS_IVCHAN);
return -1;
}
+ s->posn = new_posn;
return 0;
}
diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t
index 547ecea..f1156d6 100644
--- a/ext/PerlIO-scalar/t/scalar.t
+++ b/ext/PerlIO-scalar/t/scalar.t
@@ -16,7 +16,7 @@ use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); # Not 0, 1, 2 everywhere.
$| = 1;
-use Test::More tests => 118;
+use Test::More tests => 120;
my $fh;
my $var = "aaa\n";
@@ -500,3 +500,10 @@ my $byte_warning = "Strings with code points over 0xFF may not be mapped into in
is($tmp, "", "should have read nothing");
ok(eof($fh), "fh should be eof");
}
+
+{
+ my $buf0 = "hello";
+ open my $fh, "<", \$buf0 or die $!;
+ ok(!seek($fh, -10, SEEK_CUR), "seek to negative position");
+ is(tell($fh), 0, "shouldn't change the position");
+}
--
1.7.10.4
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @eserteDana Uto 16. Pro 2014, 18:50:47, tonyc reče:
Thanks, seems to work fine. The segfault from the CPAN RT 100847 test case does not happen with this patch. Regards, |
From @tonycozOn Tue Dec 16 22:56:43 2014, slaven@rezic.de wrote:
Thanks. I've applied the first patch as 63d073d and a variant of the second as 1d050e5. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @cpansproutOn Wed Dec 17 15:08:14 2014, tonyc wrote:
Even after v5.21.6-601-gaa67537, the Windows smokes are still failing. See <nntp://nntp.perl.org/20141219145203.7AAA34E01CC@zwei> for instance. Is there any chance you could look into it before tomorrow’s release? -- Father Chrysostomos |
From @tonycozOn Fri, Dec 19, 2014 at 07:57:03AM -0800, Father Chrysostomos via RT wrote:
Strange, I tested it on 32-bit windows. Trying again with blead. Tony |
From @tonycozOn Fri Dec 19 18:15:11 2014, tonyc wrote:
Looks like the smokes build with a 32-bit Off_t. Fixed in 9745959, I hope. Tony Tony |
|
@tonycoz - Status changed from 'pending release' to 'open' |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThanks for submitting this ticket The issue should be resolved with the release today of Perl v5.22, available at http://www.perl.org/get.html -- |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#123443 (status was 'resolved')
Searchable as RT123443$
The text was updated successfully, but these errors were encountered: