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

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

Operating System: (no value)
PatchStatus: (no value)
Severity: low
Type: unknown
Perl Version: (no value)
Fixed In: (no value)

Attachments
0001-PerlIO-scalar-write-at-large-file-position.patch



Subject: PerlIO::scalar write() at large file position writes to wrong location
Download (untitled) / with headers
text/plain 273b
On a 32-bit system, code like: my $foo = ""; open my $fh, "+<", $foo or die; seek $fh, 2**32, 0 or die; $fh->autoflush(1) print $fh "test"; will set $foo to "test". This should be treated as an error instead. Fix attached for review. Related to #123443 Tony
Subject: 0001-PerlIO-scalar-write-at-large-file-position.patch
From 60190716766253ab48226c33d99f0ffcb62d9e26 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Thu, 15 Jan 2015 16:52:21 +1100 Subject: [PATCH] PerlIO::scalar write() at large file position Prevents treating a large file position as negative (or even wrapped). --- ext/PerlIO-scalar/scalar.pm | 2 +- ext/PerlIO-scalar/scalar.xs | 15 +++++++++++++++ ext/PerlIO-scalar/t/scalar.t | 13 ++++++++++++- perl.h | 2 ++ 4 files changed, 30 insertions(+), 2 deletions(-) diff --git a/ext/PerlIO-scalar/scalar.pm b/ext/PerlIO-scalar/scalar.pm index 03f60b2..89ee946 100644 --- a/ext/PerlIO-scalar/scalar.pm +++ b/ext/PerlIO-scalar/scalar.pm @@ -1,5 +1,5 @@ package PerlIO::scalar; -our $VERSION = '0.21'; +our $VERSION = '0.22'; require XSLoader; XSLoader::load(); 1; diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs index 7f429d5..eec2de9 100644 --- a/ext/PerlIO-scalar/scalar.xs +++ b/ext/PerlIO-scalar/scalar.xs @@ -211,6 +211,21 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count) } else { STRLEN const cur = SvCUR(sv); + + /* ensure we don't try to create ridiculously large + * SVs on small platforms + */ +#if SSize_t_size < Off_t_size + if (s->posn > SSize_t_MAX) { +#ifdef EFBIG + SETERRNO(EFBIG, SS_BUFFEROVF); +#else + SETERRNO(ENOSPC, SS_BUFFEROVF); +#endif + return 0; + } +#endif + if ((STRLEN)s->posn > cur) { dst = SvGROW(sv, (STRLEN)s->posn + count + 1); Zero(SvPVX(sv) + cur, (STRLEN)s->posn - cur, char); diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t index f4cfbef..3dfcced 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 => 120; +use Test::More tests => 122; my $fh; my $var = "aaa\n"; @@ -510,3 +510,14 @@ SKIP: ok(!seek($fh, -10, SEEK_CUR), "seek to negative position"); is(tell($fh), 0, "shouldn't change the position"); } + +SKIP: +{ # write() beyond SSize_t limit + skip "Can't overflow SSize_t with Off_t", 2 + if $Config::Config{lseeksize} <= $Config::Config{sizesize}; + my $buf0 = "hello"; + open my $fh, "+<", \$buf0 or die $!; + ok(seek($fh, 2**32, SEEK_SET), "seek to a large position"); + select((select($fh), ++$|)[0]); + ok(!(print $fh "x"), "write to a large offset"); +} diff --git a/perl.h b/perl.h index 09a1de2..bd1d82b 100644 --- a/perl.h +++ b/perl.h @@ -1226,6 +1226,7 @@ EXTERN_C char *crypt(const char *, const char *); # define SS_IVCHAN SS$_IVCHAN # define SS_NORMAL SS$_NORMAL # define SS_NOPRIV SS$_NOPRIV +# define SS_BUFFEROVF SS$_BUFFEROVF #else # define LIB_INVARG 0 # define RMS_DIR 0 @@ -1240,6 +1241,7 @@ EXTERN_C char *crypt(const char *, const char *); # define SS_IVCHAN 0 # define SS_NORMAL 0 # define SS_NOPRIV 0 +# define SS_BUFFEROVF 0 #endif #ifdef WIN32 -- 1.7.10.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 450b
On Wed Jan 14 21:56:28 2015, tonyc wrote: Show quoted text
> On a 32-bit system, code like: > > my $foo = ""; > open my $fh, "+<", $foo or die; > seek $fh, 2**32, 0 or die; > $fh->autoflush(1) > print $fh "test"; > > will set $foo to "test". > > This should be treated as an error instead. > > Fix attached for review. >
Let's smoke it: smoke-me/jkeenan/tonyc/123600-perlio-scalar Show quoted text
> Related to #123443 > > Tony
-- James E Keenan (jkeenan@cpan.org)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 375b
On Wed Jan 14 21:56:28 2015, tonyc wrote: Show quoted text
> On a 32-bit system, code like: > > my $foo = ""; > open my $fh, "+<", $foo or die; > seek $fh, 2**32, 0 or die; > $fh->autoflush(1) > print $fh "test"; > > will set $foo to "test". > > This should be treated as an error instead. > > Fix attached for review.
Applied as 4388f261169c7e6f89c979e37485e69889f1481b. 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