There is no SSize_t_size.

[perl5.git] / ext / PerlIO-scalar / scalar.xs

diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs
index a104887..49bbff1 100644 (file)
--- a/ext/PerlIO-scalar/scalar.xs
+++ b/ext/PerlIO-scalar/scalar.xs
@@ -46,7 +46,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
        }
     }
     else {
-       s->var = newSVpvn("", 0);
+       s->var = newSVpvs("");
     }
     SvUPGRADE(s->var, SVt_PV);
 
@@ -103,28 +103,33 @@ IV
 PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    Off_t new_posn;
 
     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;
       }
+    default:
+        SETERRNO(EINVAL, SS_IVCHAN);
+        return -1;
     }
-    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;
 }
 
@@ -144,6 +149,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
        PerlIOBase(f)->flags |= PERLIO_F_ERROR;
        SETERRNO(EBADF, SS_IVCHAN);
+       Perl_PerlIO_save_errno(aTHX_ f);
        return 0;
     }
     {
@@ -151,7 +157,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)) {
@@ -164,9 +170,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);
@@ -199,7 +211,22 @@ PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
        }
        else {
            STRLEN const cur = SvCUR(sv);
-           if (s->posn > cur) {
+
+            /* ensure we don't try to create ridiculously large
+             * SVs on small platforms
+             */
+#if Size_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);
            }
@@ -265,7 +292,7 @@ PerlIOScalar_get_cnt(pTHX_ PerlIO * f)
        PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
        STRLEN len;
        (void)SvPV(s->var,len);
-       if (len > (STRLEN) s->posn)
+       if ((Off_t)len > s->posn)
            return len - (STRLEN)s->posn;
        else
            return 0;
@@ -340,7 +367,7 @@ PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
        ing the cloned scalar to be set to the empty string by
        PerlIOScalar_pushed.  So set aside our scalar temporarily. */
     PerlIOScalar * const os = PerlIOSelf(o, PerlIOScalar);
-    PerlIOScalar *fs;
+    PerlIOScalar *fs = NULL; /* avoid "may be used uninitialized" warning */
     SV * const var = os->var;
     os->var = newSVpvs("");
     if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) {