New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
PerlIO::scalar write() at large file position writes to wrong location #14415
Comments
From @tonycozOn a 32-bit system, code like: my $foo = ""; will set $foo to "test". This should be treated as an error instead. Fix attached for review. Related to #123443 Tony |
From @tonycoz0001-PerlIO-scalar-write-at-large-file-position.patchFrom 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
|
From @jkeenanOn Wed Jan 14 21:56:28 2015, tonyc wrote:
Let's smoke it:
-- |
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Wed Jan 14 21:56:28 2015, tonyc wrote:
Applied as 4388f26. Tony |
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#123600 (status was 'resolved')
Searchable as RT123600$
The text was updated successfully, but these errors were encountered: