In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4388f261169c7e6f89c979e37485e69889f1481b?hp=316a4c4b02869cef6dd06804e1676d77fb35a979>
- Log ----------------------------------------------------------------- commit 4388f261169c7e6f89c979e37485e69889f1481b Author: Tony Cook <[email protected]> Date: Thu Jan 15 16:52:21 2015 +1100 PerlIO::scalar write() at large file position Prevents treating a large file position as negative (or even wrapped). ----------------------------------------------------------------------- Summary of changes: 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 ebfca35..c2c4a5c 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 -- Perl5 Master Repository
