Skip to content
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

Closed
p5pRT opened this issue Jan 15, 2015 · 6 comments
Closed

PerlIO::scalar write() at large file position writes to wrong location #14415

p5pRT opened this issue Jan 15, 2015 · 6 comments

Comments

@p5pRT
Copy link

p5pRT commented Jan 15, 2015

Migrated from rt.perl.org#123600 (status was 'resolved')

Searchable as RT123600$

@p5pRT
Copy link
Author

p5pRT commented Jan 15, 2015

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Jan 15, 2015

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Jan 17, 2015

From @jkeenan

On Wed Jan 14 21​:56​:28 2015, tonyc wrote​:

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

Related to #123443

Tony

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Jan 17, 2015

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Jan 27, 2015

From @tonycoz

On Wed Jan 14 21​:56​:28 2015, tonyc wrote​:

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 4388f26.

Tony

@p5pRT
Copy link
Author

p5pRT commented Jan 27, 2015

@tonycoz - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant