This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fcntl receiving -1 from fileno, fcntl failing.
authorJarkko Hietaniemi <jhi@iki.fi>
Thu, 29 May 2014 16:36:28 +0000 (12:36 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Thu, 29 May 2014 16:37:38 +0000 (12:37 -0400)
(Also very few spots of negative numgroups for getgroups(),
and fgetc() return, but almost all checking is for fcntl.)

(merged fix for perl #121743 and perl #121745: hopefully
picked up all the fixes-to-fixes from the ticket...)

Fix for Coverity perl5 CIDs 28990..29003,29005..29011,29013,
45354,45363,49926:

Argument cannot be negative (NEGATIVE_RETURNS) fd is
passed to a parameter that cannot be negative.

and CIDs 29004, 29012:
Argument cannot be negative (NEGATIVE_RETURNS)
num_groups is passed to a parameter that cannot be negative

and because of CIDs 29005 and 29006 also CID 28924.

In the first set of issues a fd is retrieved from PerlIO_fileno, and
that is then used in places like fstat(), fchown(), dup(), etc.,
without checking whether the fd is valid (>=0).

In the second set of issues a potentially negative
number is potentially passed to getgroups().

The CIDs 29005 and 29006 were a bit messy: fixing them needed also
resolving CID 28924 where the return value of fstat() was ignored,
and for completeness adding two croak calls (with perldiag updates):
a bit of a waste since it's suidperl code.

dist/IO/IO.xs
dist/threads/threads.xs
doio.c
ext/PerlIO-mmap/mmap.xs
mg.c
perl.c
perlio.c
pod/perldiag.pod
pp_sys.c
util.c

index 9056cb6..eed7139 100644 (file)
@@ -102,13 +102,19 @@ not_here(const char *s)
 static int
 io_blocking(pTHX_ InputStream f, int block)
 {
+    int fd = -1;
 #if defined(HAS_FCNTL)
     int RETVAL;
-    if(!f) {
+    if (!f) {
        errno = EBADF;
        return -1;
     }
-    RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
+    fd = PerlIO_fileno(f);
+    if (fd < 0) {
+      errno = EBADF;
+      return -1;
+    }
+    RETVAL = fcntl(fd, F_GETFL, 0);
     if (RETVAL >= 0) {
        int mode = RETVAL;
        int newmode = mode;
@@ -143,7 +149,7 @@ io_blocking(pTHX_ InputStream f, int block)
        }
 #endif
        if (newmode != mode) {
-           const int ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode);
+            const int ret = fcntl(fd, F_SETFL, newmode);
            if (ret < 0)
                RETVAL = ret;
        }
@@ -154,7 +160,7 @@ io_blocking(pTHX_ InputStream f, int block)
     if (block >= 0) {
        unsigned long flags = !block;
        /* ioctl claims to take char* but really needs a u_long sized buffer */
-       const int ret = ioctl(PerlIO_fileno(f), FIONBIO, (char*)&flags);
+       const int ret = ioctl(fd, FIONBIO, (char*)&flags);
        if (ret != 0)
            return -1;
        /* Win32 has no way to get the current blocking status of a socket.
@@ -524,9 +530,15 @@ fsync(arg)
        handle = IoOFP(sv_2io(arg));
        if (!handle)
            handle = IoIFP(sv_2io(arg));
-       if(handle)
-           RETVAL = fsync(PerlIO_fileno(handle));
-       else {
+       if (handle) {
+           int fd = PerlIO_fileno(handle);
+           if (fd >= 0) {
+               RETVAL = fsync(fd);
+           } else {
+               RETVAL = -1;
+               errno = EBADF;
+           }
+       } else {
            RETVAL = -1;
            errno = EINVAL;
        }
@@ -557,9 +569,14 @@ sockatmark (sock)
      int fd;
    CODE:
    {
-     fd = PerlIO_fileno(sock);
 #ifdef HAS_SOCKATMARK
-     RETVAL = sockatmark(fd);
+     int fd = PerlIO_fileno(sock);
+     if (fd < 0) {
+       errno = EBADF;
+       RETVAL = -1;
+     } else {
+       RETVAL = sockatmark(fd);
+     }
 #else
      {
        int flag = 0;
index 8537165..182cd37 100644 (file)
@@ -713,11 +713,12 @@ S_ithread_create(
     }
     PERL_SET_CONTEXT(aTHX);
     if (!thread) {
-        int rc;
         MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
-        rc = PerlLIO_write(PerlIO_fileno(Perl_error_log),
-                            PL_no_mem, strlen(PL_no_mem));
-        PERL_UNUSED_VAR(rc);
+        int fd = PerlIO_fileno(Perl_error_log);
+        if (fd >= 0) {
+          /* If there's no error_log, we cannot scream about it missing. */
+          PERL_UNUSED_RESULT(PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)));
+        }
         my_exit(1);
     }
     Zero(thread, 1, ithread);
diff --git a/doio.c b/doio.c
index 0eec22c..7ef0206 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -646,9 +646,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
     }
 
     fd = PerlIO_fileno(fp);
-    /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a
-     * socket - this covers PerlIO::scalar - otherwise unless we "know" the
-     * type probe for socket-ness.
+    /* Do NOT do: "if (fd < 0) goto say_false;" here.  If there is no
+     * fd assume it isn't a socket - this covers PerlIO::scalar -
+     * otherwise unless we "know" the type probe for socket-ness.
      */
     if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) {
        if (PerlLIO_fstat(fd,&PL_statbuf) < 0) {
@@ -696,7 +696,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
               is assigned to (say) STDOUT - for now let dup2() fail
               and provide the error
             */
-           if (PerlLIO_dup2(fd, savefd) < 0) {
+           if (fd < 0) {
+                SETERRNO(EBADF,RMS_IFI);
+               goto say_false;
+            } else if (PerlLIO_dup2(fd, savefd) < 0) {
                (void)PerlIO_close(fp);
                goto say_false;
            }
@@ -732,13 +735,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
            if (was_fdopen) {
                 /* need to close fp without closing underlying fd */
                 int ofd = PerlIO_fileno(fp);
-                int dupfd = PerlLIO_dup(ofd);
+                int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1;
 #if defined(HAS_FCNTL) && defined(F_SETFD)
                /* Assume if we have F_SETFD we have F_GETFD */
-                int coe = fcntl(ofd,F_GETFD);
+                int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1;
+                if (coe < 0) {
+                    if (dupfd >= 0)
+                        PerlLIO_close(dupfd);
+                    goto say_false;
+                }
 #endif
+                if (ofd < 0 || dupfd < 0) {
+                    if (dupfd >= 0)
+                        PerlLIO_close(dupfd);
+                    goto say_false;
+                }
                 PerlIO_close(fp);
-                PerlLIO_dup2(dupfd,ofd);
+                PerlLIO_dup2(dupfd, ofd);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
                /* The dup trick has lost close-on-exec on ofd */
                fcntl(ofd,F_SETFD, coe);
@@ -754,9 +767,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     if (fd >= 0) {
-       dSAVE_ERRNO;
-       fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */
-       RESTORE_ERRNO;
+        if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) {
+            PerlLIO_close(fd);
+            goto say_false;
+        }
     }
 #endif
     IoIFP(io) = fp;
@@ -956,23 +970,25 @@ Perl_nextargv(pTHX_ GV *gv)
                }
                setdefout(PL_argvoutgv);
                PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
-               (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf);
+                if (PL_lastfd >= 0) {
+                    (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf);
 #ifdef HAS_FCHMOD
-               (void)fchmod(PL_lastfd,PL_filemode);
+                    (void)fchmod(PL_lastfd,PL_filemode);
 #else
-               (void)PerlLIO_chmod(PL_oldname,PL_filemode);
+                    (void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #endif
-               if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
-                    int rc = 0;
+                    if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
+                        int rc = 0;
 #ifdef HAS_FCHOWN
-                   rc = fchown(PL_lastfd,fileuid,filegid);
+                        rc = fchown(PL_lastfd,fileuid,filegid);
 #else
 #ifdef HAS_CHOWN
-                   rc = PerlLIO_chown(PL_oldname,fileuid,filegid);
+                        rc = PerlLIO_chown(PL_oldname,fileuid,filegid);
 #endif
 #endif
-                    /* XXX silently ignore failures */
-                    PERL_UNUSED_VAR(rc);
+                        /* XXX silently ignore failures */
+                        PERL_UNUSED_VAR(rc);
+                    }
                }
                 return IoIFP(GvIOp(gv));
            }
@@ -1169,8 +1185,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
 
     PERL_ARGS_ASSERT_DO_SYSSEEK;
 
-    if (io && (fp = IoIFP(io)))
-       return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
+    if (io && (fp = IoIFP(io))) {
+        int fd = PerlIO_fileno(fp);
+        if (fd >= 0) {
+            return PerlLIO_lseek(fd, pos, whence);
+        }
+    }
     report_evil_fh(gv);
     SETERRNO(EBADF,RMS_IFI);
     return (Off_t)-1;
@@ -1376,7 +1396,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
         sv_setpvs(PL_statname, "");
         if(io) {
            if (IoIFP(io)) {
-               return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
+                int fd = PerlIO_fileno(IoIFP(io));
+                if (fd >= 0) {
+                    return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache));
+                }
             } else if (IoDIRP(io)) {
                 return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache));
             }
@@ -1739,9 +1762,13 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
                 if ((gv = MAYBE_DEREF_GV(*mark))) {
                    if (GvIO(gv) && IoIFP(GvIOp(gv))) {
 #ifdef HAS_FCHMOD
+                        int fd = PerlIO_fileno(IoIFP(GvIOn(gv)));
                        APPLY_TAINT_PROPER();
-                       if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val))
-                           tot--;
+                        if (fd < 0) {
+                            SETERRNO(EBADF,RMS_IFI);
+                            tot--;
+                        } else if (fchmod(fd, val))
+                            tot--;
 #else
                        Perl_die(aTHX_ PL_no_func, "fchmod");
 #endif
@@ -1775,8 +1802,12 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
                if ((gv = MAYBE_DEREF_GV(*mark))) {
                    if (GvIO(gv) && IoIFP(GvIOp(gv))) {
 #ifdef HAS_FCHOWN
+                        int fd = PerlIO_fileno(IoIFP(GvIOn(gv)));
                        APPLY_TAINT_PROPER();
-                       if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2))
+                        if (fd < 0) {
+                            SETERRNO(EBADF,RMS_IFI);
+                           tot--;
+                        } else if (fchown(fd, val, val2))
                            tot--;
 #else
                        Perl_die(aTHX_ PL_no_func, "fchown");
@@ -1965,9 +1996,12 @@ nothing in the core.
                 if ((gv = MAYBE_DEREF_GV(*mark))) {
                    if (GvIO(gv) && IoIFP(GvIOp(gv))) {
 #ifdef HAS_FUTIMES
+                        int fd =  PerlIO_fileno(IoIFP(GvIOn(gv)));
                        APPLY_TAINT_PROPER();
-                       if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))),
-                            (struct timeval *) utbufp))
+                        if (fd < 0) {
+                            SETERRNO(EBADF,RMS_IFI);
+                            tot--;
+                       } else if (futimes(fd, (struct timeval *) utbufp))
                            tot--;
 #else
                        Perl_die(aTHX_ PL_no_func, "futimes");
@@ -2082,15 +2116,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective)
         bool rc = FALSE;
 
        anum = getgroups(0, gary);
-        Newx(gary, anum, Groups_t);
-        anum = getgroups(anum, gary);
-       while (--anum >= 0)
-           if (gary[anum] == testgid) {
-                rc = TRUE;
-                break;
-            }
+        if (anum > 0) {
+            Newx(gary, anum, Groups_t);
+            anum = getgroups(anum, gary);
+            while (--anum >= 0)
+                if (gary[anum] == testgid) {
+                    rc = TRUE;
+                    break;
+                }
 
-        Safefree(gary);
+            Safefree(gary);
+        }
         return rc;
     }
 #else
index 4c96da8..6632544 100644 (file)
@@ -40,8 +40,12 @@ PerlIOMmap_map(pTHX_ PerlIO *f)
        abort();
     if (flags & PERLIO_F_CANREAD) {
        PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
-       const int fd = PerlIO_fileno(f);
        Stat_t st;
+       const int fd = PerlIO_fileno(f);
+        if (fd < 0) {
+          SETERRNO(EBADF,RMS_IFI);
+          return -1;
+        }
        code = Fstat(fd, &st);
        if (code == 0 && S_ISREG(st.st_mode)) {
            SSize_t len = st.st_size - b->posn;
diff --git a/mg.c b/mg.c
index 7f3339a..699c970 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #ifdef HAS_GETGROUPS
        {
            Groups_t *gary = NULL;
-           I32 i, num_groups = getgroups(0, gary);
-            Newx(gary, num_groups, Groups_t);
-            num_groups = getgroups(num_groups, gary);
-           for (i = 0; i < num_groups; i++)
-               Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]);
-            Safefree(gary);
+           I32 i;
+            I32 num_groups = getgroups(0, gary);
+            if (num_groups > 0) {
+                Newx(gary, num_groups, Groups_t);
+                num_groups = getgroups(num_groups, gary);
+                for (i = 0; i < num_groups; i++)
+                    Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]);
+                Safefree(gary);
+            }
        }
        (void)SvIOK_on(sv);     /* what a wonderful hack! */
 #endif
diff --git a/perl.c b/perl.c
index 51deabd..8480a5d 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3690,6 +3690,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
     PerlIO *rsfp = NULL;
     dVAR;
     Stat_t tmpstatbuf;
+    int fd;
 
     PERL_ARGS_ASSERT_OPEN_SCRIPT;
 
@@ -3797,13 +3798,20 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
            Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
                    CopFILE(PL_curcop), Strerror(errno));
     }
+    fd = PerlIO_fileno(rsfp);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    /* ensure close-on-exec */
-    fcntl(PerlIO_fileno(rsfp), F_SETFD, 1);
+    if (fd >= 0) {
+        /* ensure close-on-exec */
+        if (fcntl(fd, F_SETFD, 1) < 0) {
+            Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+                       CopFILE(PL_curcop), Strerror(errno));
+        }
+    }
 #endif
 
-    if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0
-        && S_ISDIR(tmpstatbuf.st_mode))
+    if (fd < 0 ||
+        (PerlLIO_fstat(fd, &tmpstatbuf) >= 0
+         && S_ISDIR(tmpstatbuf.st_mode)))
         Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
             CopFILE(PL_curcop),
             Strerror(EISDIR));
@@ -3834,12 +3842,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp)
 
     if (my_euid != my_uid || my_egid != my_gid) {      /* (suidperl doesn't exist, in fact) */
        dVAR;
-
-       PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */
-       if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
-           ||
-           (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
-          )
+        int fd = PerlIO_fileno(rsfp);
+        if (fd < 0) {
+            Perl_croak(aTHX_ "Illegal suidscript");
+        } else {
+            if (PerlLIO_fstat(fd, &PL_statbuf) < 0) {  /* may be either wrapped or real suid */
+                Perl_croak(aTHX_ "Illegal suidscript");
+            }
+        }
+        if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
+            ||
+            (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
+            )
            if (!PL_do_undump)
                Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
 FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
index 2ce8ac1..29c4bf7 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -2928,6 +2928,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode)
     PerlIO *f = NULL;
     if (stdio) {
        PerlIOStdio *s;
+        int fd0 = fileno(stdio);
+        if (fd0 < 0) {
+            return NULL;
+        }
        if (!mode || !*mode) {
            /* We need to probe to see how we can open the stream
               so start with read/write and then try write and read
@@ -2936,8 +2940,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode)
               Note that the errno value set by a failing fdopen
               varies between stdio implementations.
             */
-           const int fd = PerlLIO_dup(fileno(stdio));
-           FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+"));
+            const int fd = PerlLIO_dup(fd0);
+           FILE *f2;
+            if (fd < 0) {
+                return f;
+            }
+           f2 = PerlSIO_fdopen(fd, (mode = "r+"));
            if (!f2) {
                f2 = PerlSIO_fdopen(fd, (mode = "w"));
            }
@@ -3357,8 +3365,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
            }
            if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) {
                /* Did not change pointer as expected */
-               fgetc(s);  /* get char back again */
-               break;
+               if (fgetc(s) != EOF)  /* get char back again */
+                    break;
            }
            /* It worked ! */
            count--;
@@ -3674,6 +3682,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode)
     FILE *stdio = NULL;
     if (PerlIOValid(f)) {
        char buf[8];
+        int fd = PerlIO_fileno(f);
+        if (fd < 0) {
+            return NULL;
+        }
        PerlIO_flush(f);
        if (!mode || !*mode) {
            mode = PerlIO_modestr(f, buf);
index 530bc47..635acb6 100644 (file)
@@ -2290,6 +2290,10 @@ The C<"+"> is valid only when followed by digits, indicating a
 capturing group.  See
 L<C<(?I<PARNO>)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>.
 
+=item Illegal suidscript
+
+(F) The script run under suidperl was somehow illegal.
+
 =item Illegal switch in PERL5OPT: -%c
 
 (X) The PERL5OPT environment variable may only be used to set the
index d954f8b..1ee3ba2 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -715,8 +715,10 @@ PP(pp_pipe_op)
        goto badexit;
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd);  /* ensure close-on-exec */
-    fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd);  /* ensure close-on-exec */
+    /* ensure close-on-exec */
+    if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) ||
+        (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0))
+        goto badexit;
 #endif
     RETPUSHYES;
 
@@ -1627,8 +1629,9 @@ PP(pp_sysread)
     bool charstart = FALSE;
     STRLEN charskip = 0;
     STRLEN skip = 0;
-
     GV * const gv = MUTABLE_GV(*++MARK);
+    int fd;
+
     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
        && gv && (io = GvIO(gv)) )
     {
@@ -1659,6 +1662,10 @@ PP(pp_sysread)
        SETERRNO(EBADF,RMS_IFI);
        goto say_undef;
     }
+
+    /* Note that fd can here validly be -1, don't check it yet. */
+    fd = PerlIO_fileno(IoIFP(io));
+
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
        buffer = SvPVutf8_force(bufsv, blen);
        /* UTF-8 may not have been set if they are all low bytes */
@@ -1682,6 +1689,10 @@ PP(pp_sysread)
     if (PL_op->op_type == OP_RECV) {
        Sock_size_t bufsize;
        char namebuf[MAXPATHLEN];
+        if (fd < 0) {
+            SETERRNO(EBADF,SS_IVCHAN);
+            RETPUSHUNDEF;
+        }
 #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
        bufsize = sizeof (struct sockaddr_in);
 #else
@@ -1693,7 +1704,7 @@ PP(pp_sysread)
 #endif
        buffer = SvGROW(bufsv, (STRLEN)(length+1));
        /* 'offset' means 'flags' here */
-       count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
+       count = PerlSock_recvfrom(fd, buffer, length, offset,
                                  (struct sockaddr *)namebuf, &bufsize);
        if (count < 0)
            RETPUSHUNDEF;
@@ -1735,7 +1746,11 @@ PP(pp_sysread)
        else
            offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
     }
+
  more_bytes:
+    /* Reestablish the fd in case it shifted from underneath us. */
+    fd = PerlIO_fileno(IoIFP(io));
+
     orig_size = SvCUR(bufsv);
     /* Allocating length + offset + 1 isn't perfect in the case of reading
        bytes from a byte file handle into a UTF8 buffer, but it won't harm us
@@ -1765,14 +1780,22 @@ PP(pp_sysread)
     if (PL_op->op_type == OP_SYSREAD) {
 #ifdef PERL_SOCK_SYSREAD_IS_RECV
        if (IoTYPE(io) == IoTYPE_SOCKET) {
-           count = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
-                                  buffer, length, 0);
+            if (fd < 0) {
+                SETERRNO(EBADF,SS_IVCHAN);
+                count = -1;
+            }
+            else
+                count = PerlSock_recv(fd, buffer, length, 0);
        }
        else
 #endif
        {
-           count = PerlLIO_read(PerlIO_fileno(IoIFP(io)),
-                                 buffer, length);
+            if (fd < 0) {
+                SETERRNO(EBADF,RMS_IFI);
+                count = -1;
+            }
+            else
+                count = PerlLIO_read(fd, buffer, length);
        }
     }
     else
@@ -1856,6 +1879,7 @@ PP(pp_syswrite)
     U8 *tmpbuf = NULL;
     GV *const gv = MUTABLE_GV(*++MARK);
     IO *const io = GvIO(gv);
+    int fd;
 
     if (op_type == OP_SYSWRITE && io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
@@ -1886,6 +1910,12 @@ PP(pp_syswrite)
        SETERRNO(EBADF,RMS_IFI);
        goto say_undef;
     }
+    fd = PerlIO_fileno(IoIFP(io));
+    if (fd < 0) {
+        SETERRNO(EBADF,SS_IVCHAN);
+        retval = -1;
+        goto say_undef;
+    }
 
     /* Do this first to trigger any overloading.  */
     buffer = SvPV_const(bufsv, blen);
@@ -1920,12 +1950,11 @@ PP(pp_syswrite)
        if (SP > MARK) {
            STRLEN mlen;
            char * const sockbuf = SvPVx(*++MARK, mlen);
-           retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen,
+           retval = PerlSock_sendto(fd, buffer, blen,
                                     flags, (struct sockaddr *)sockbuf, mlen);
        }
        else {
-           retval
-               = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags);
+           retval = PerlSock_send(fd, buffer, blen, flags);
        }
     }
     else
@@ -2008,15 +2037,13 @@ PP(pp_syswrite)
        }
 #ifdef PERL_SOCK_SYSWRITE_IS_SEND
        if (IoTYPE(io) == IoTYPE_SOCKET) {
-           retval = PerlSock_send(PerlIO_fileno(IoIFP(io)),
-                                  buffer, length, 0);
+           retval = PerlSock_send(fd, buffer, length, 0);
        }
        else
 #endif
        {
            /* See the note at doio.c:do_print about filesize limits. --jhi */
-           retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
-                                  buffer, length);
+            retval = PerlLIO_write(fd, buffer, length);
        }
     }
 
@@ -2224,13 +2251,19 @@ PP(pp_truncate)
                    result = 0;
                }
                else {
-                   PerlIO_flush(fp);
+                    int fd = PerlIO_fileno(fp);
+                    if (fd < 0) {
+                        SETERRNO(EBADF,RMS_IFI);
+                        result = 0;
+                    } else {
+                        PerlIO_flush(fp);
 #ifdef HAS_TRUNCATE
-                   if (ftruncate(PerlIO_fileno(fp), len) < 0)
+                        if (ftruncate(fd, len) < 0)
 #else
-                   if (my_chsize(PerlIO_fileno(fp), len) < 0)
+                        if (my_chsize(fd, len) < 0)
 #endif
-                       result = 0;
+                            result = 0;
+                    }
                }
            }
        }
@@ -2248,9 +2281,10 @@ PP(pp_truncate)
            {
                const int tmpfd = PerlLIO_open(name, O_RDWR);
 
-               if (tmpfd < 0)
+               if (tmpfd < 0) {
+                    SETERRNO(EBADF,RMS_IFI);
                    result = 0;
-               else {
+               else {
                    if (my_chsize(tmpfd, len) < 0)
                        result = 0;
                    PerlLIO_close(tmpfd);
@@ -2388,8 +2422,10 @@ PP(pp_socket)
 
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);
-    if (fd < 0)
+    if (fd < 0) {
+        SETERRNO(EBADF,RMS_IFI);
        RETPUSHUNDEF;
+    }
     IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);        /* stdio gets confused about sockets */
     IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
     IoTYPE(io) = IoTYPE_SOCKET;
@@ -2400,7 +2436,8 @@ PP(pp_socket)
        RETPUSHUNDEF;
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(fd, F_SETFD, fd > PL_maxsysfd);      /* ensure close-on-exec */
+    if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0)      /* ensure close-on-exec */
+       RETPUSHUNDEF;
 #endif
 
     RETPUSHYES;
@@ -2445,8 +2482,10 @@ PP(pp_sockpair)
        RETPUSHUNDEF;
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd);  /* ensure close-on-exec */
-    fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd);  /* ensure close-on-exec */
+    /* ensure close-on-exec */
+    if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) ||
+        (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0))
+       RETPUSHUNDEF;
 #endif
 
     RETPUSHYES;
@@ -2467,16 +2506,20 @@ PP(pp_bind)
     IO * const io = GvIOn(gv);
     STRLEN len;
     int op_type;
+    int fd;
 
     if (!IoIFP(io))
        goto nuts;
+    fd = PerlIO_fileno(IoIFP(io));
+    if (fd < 0)
+        goto nuts;
 
     addr = SvPV_const(addrsv, len);
     op_type = PL_op->op_type;
     TAINT_PROPER(PL_op_desc[op_type]);
     if ((op_type == OP_BIND
-        ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)
-        : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len))
+        ? PerlSock_bind(fd, (struct sockaddr *)addr, len)
+        : PerlSock_connect(fd, (struct sockaddr *)addr, len))
        >= 0)
        RETPUSHYES;
     else
@@ -2554,7 +2597,8 @@ PP(pp_accept)
        goto badexit;
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(fd, F_SETFD, fd > PL_maxsysfd);      /* ensure close-on-exec */
+    if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0)      /* ensure close-on-exec */
+        goto badexit;
 #endif
 
 #ifdef __SCO_VERSION__
@@ -2608,6 +2652,8 @@ PP(pp_ssockopt)
        goto nuts;
 
     fd = PerlIO_fileno(IoIFP(io));
+    if (fd < 0)
+        goto nuts;
     switch (optype) {
     case OP_GSOCKOPT:
        SvGROW(sv, 257);
@@ -2683,6 +2729,8 @@ PP(pp_getpeername)
     SvCUR_set(sv, len);
     *SvEND(sv) ='\0';
     fd = PerlIO_fileno(IoIFP(io));
+    if (fd < 0)
+        goto nuts;
     switch (optype) {
     case OP_GETSOCKNAME:
        if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0)
@@ -2764,9 +2812,14 @@ PP(pp_stat)
            }
             if (io) {
                     if (IoIFP(io)) {
-                        PL_laststatval = 
-                            PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
-                        havefp = TRUE;
+                        int fd = PerlIO_fileno(IoIFP(io));
+                        if (fd < 0) {
+                            PL_laststatval = -1;
+                            SETERRNO(EBADF,RMS_IFI);
+                        } else {
+                            PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
+                            havefp = TRUE;
+                        }
                     } else if (IoDIRP(io)) {
                         PL_laststatval =
                             PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
@@ -3256,9 +3309,13 @@ PP(pp_fttty)
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
        fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
     else if (name && isDIGIT(*name))
-           fd = atoi(name);
+        fd = atoi(name);
     else
        FT_RETURNUNDEF;
+    if (fd < 0) {
+        SETERRNO(EBADF,RMS_IFI);
+       FT_RETURNUNDEF;
+    }
     if (PerlLIO_isatty(fd))
        FT_RETURNYES;
     FT_RETURNNO;
@@ -3307,9 +3364,15 @@ PP(pp_fttext)
        PL_laststatval = -1;
        PL_laststype = OP_STAT;
        if (io && IoIFP(io)) {
+           int fd;
            if (! PerlIO_has_base(IoIFP(io)))
                DIE(aTHX_ "-T and -B not implemented on filehandles");
-           PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);
+           fd = PerlIO_fileno(IoIFP(io));
+           if (fd < 0) {
+                SETERRNO(EBADF,RMS_IFI);
+               FT_RETURNUNDEF;
+            }
+           PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
            if (PL_laststatval < 0)
                FT_RETURNUNDEF;
            if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */
@@ -3341,6 +3404,7 @@ PP(pp_fttext)
     }
     else {
         const char *file;
+        int fd; 
 
        sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
       really_filename:
@@ -3360,9 +3424,16 @@ PP(pp_fttext)
            FT_RETURNUNDEF;
        }
        PL_laststype = OP_STAT;
-       PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
+        fd = PerlIO_fileno(fp);
+        if (fd < 0) {
+           (void)PerlIO_close(fp);
+            SETERRNO(EBADF,RMS_IFI);
+           FT_RETURNUNDEF;
+        }
+       PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
        if (PL_laststatval < 0) {
            (void)PerlIO_close(fp);
+            SETERRNO(EBADF,RMS_IFI);
            FT_RETURNUNDEF;
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
@@ -3477,19 +3548,19 @@ PP(pp_chdir)
            if (IoDIRP(io)) {
                PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
            } else if (IoIFP(io)) {
-                PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
+                int fd = PerlIO_fileno(IoIFP(io));
+                if (fd < 0) {
+                    goto nuts;
+                }
+                PUSHi(fchdir(fd) >= 0);
            }
            else {
-               report_evil_fh(gv);
-               SETERRNO(EBADF, RMS_IFI);
-               PUSHi(0);
+                goto nuts;
            }
+        } else {
+            goto nuts;
         }
-       else {
-           report_evil_fh(gv);
-           SETERRNO(EBADF,RMS_IFI);
-           PUSHi(0);
-       }
+
 #else
        DIE(aTHX_ PL_no_func, "fchdir");
 #endif
@@ -3502,6 +3573,12 @@ PP(pp_chdir)
     hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD);
 #endif
     RETURN;
+
+ nuts:
+    report_evil_fh(gv);
+    SETERRNO(EBADF,RMS_IFI);
+    PUSHi(0);
+    RETURN;
 }
 
 PP(pp_chown)
@@ -4196,7 +4273,8 @@ PP(pp_system)
        if (did_pipes) {
            PerlLIO_close(pp[0]);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-           fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+           if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
+                RETPUSHUNDEF;
 #endif
        }
        if (PL_op->op_flags & OPf_STACKED) {
diff --git a/util.c b/util.c
index 42926b3..70c32e4 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1712,13 +1712,16 @@ void
 Perl_croak_no_mem(void)
 {
     dTHX;
-    int rc;
 
-    /* Can't use PerlIO to write as it allocates memory */
-    rc = PerlLIO_write(PerlIO_fileno(Perl_error_log),
-                 PL_no_mem, sizeof(PL_no_mem)-1);
-    /* silently ignore failures */
-    PERL_UNUSED_VAR(rc);
+    int fd = PerlIO_fileno(Perl_error_log);
+    if (fd < 0)
+        SETERRNO(EBADF,RMS_IFI);
+    else {
+        /* Can't use PerlIO to write as it allocates memory */
+        int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1);
+        /* silently ignore failures */
+        PERL_UNUSED_VAR(rc);
+    }
     my_exit(1);
 }
 
@@ -2310,7 +2313,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args)
            PerlLIO_close(pp[0]);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
            /* Close error pipe automatically if exec works */
-           fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+           if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
+                return NULL;
 #endif
        }
        /* Now dup our end of _the_ pipe to right position */
@@ -2455,7 +2459,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode)
        if (did_pipes) {
            PerlLIO_close(pp[0]);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-           fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+            if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
+                return NULL;
 #endif
        }
        if (p[THIS] != (*mode == 'r')) {