fd closes for failure paths.

[perl5.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index ec19bfe..aa9a932 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -310,6 +310,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
     return NULL;
 }
 
+XS(XS_PerlIO__Layer__find); /* prototype to pass -Wmissing-prototypes */
 XS(XS_PerlIO__Layer__find)
 {
     dXSARGS;
@@ -818,6 +819,7 @@ MGVTBL perlio_vtab = {
     perlio_mg_free
 };
 
+XS(XS_io_MODIFY_SCALAR_ATTRIBUTES); /* prototype to pass -Wmissing-prototypes */
 XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
 {
     dXSARGS;
@@ -858,6 +860,7 @@ PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
     return sv;
 }
 
+XS(XS_PerlIO__Layer__NoWarnings); /* prototype to pass -Wmissing-prototypes */
 XS(XS_PerlIO__Layer__NoWarnings)
 {
     /* This is used as a %SIG{__WARN__} handler to suppress warnings
@@ -871,6 +874,7 @@ XS(XS_PerlIO__Layer__NoWarnings)
     XSRETURN(0);
 }
 
+XS(XS_PerlIO__Layer__find); /* prototype to pass -Wmissing-prototypes */
 XS(XS_PerlIO__Layer__find)
 {
     dVAR;
@@ -2657,6 +2661,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        }
        if (!PerlIOValid(f)) {
            if (!(f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) {
+               PerlLIO_close(fd);
                return NULL;
            }
        }
@@ -2692,6 +2697,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
            PerlIOUnix_setfd(aTHX_ f, fd, os->oflags);
            return f;
        }
+        PerlLIO_close(fd);
     }
     return NULL;
 }
@@ -2901,6 +2907,7 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab
                PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
                /* We never call down so do any pending stuff now */
                PerlIO_flush(PerlIONext(f));
+                return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
            }
            else {
                return -1;
@@ -3045,6 +3052,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                }
                return f;
            }
+            PerlLIO_close(fd);
        }
     }
     return NULL;
@@ -4957,6 +4965,7 @@ PerlIO_tmpfile(void)
      char tempname[] = "/tmp/PerlIO_XXXXXX";
      const char * const tmpdir = TAINTING_get ? NULL : PerlEnv_getenv("TMPDIR");
      SV * sv = NULL;
+     int old_umask = umask(0600);
      /*
       * I have no idea how portable mkstemp() is ... NI-S
       */
@@ -4967,6 +4976,7 @@ PerlIO_tmpfile(void)
         fd = mkstemp(SvPVX(sv));
      }
      if (fd < 0) {
+        SvREFCNT_dec(sv);
         sv = NULL;
         /* else we try /tmp */
         fd = mkstemp(tempname);
@@ -4977,6 +4987,7 @@ PerlIO_tmpfile(void)
          sv_catpv(sv, tempname + 4);
          fd = mkstemp(SvPVX(sv));
      }
+     umask(old_umask);
      if (fd >= 0) {
          f = PerlIO_fdopen(fd, "w+");
          if (f)