Fix umask for mkstemp(3) calls

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index bf4d549..1d94b38 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3,7 +3,7 @@
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
  *    2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
- *     by Larry Wall and others
+ *    2013, 2014, 2015, 2016 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -392,6 +392,7 @@ perl_construct(pTHXx)
     PL_GCB_invlist = _new_invlist_C_array(_Perl_GCB_invlist);
     PL_SB_invlist = _new_invlist_C_array(_Perl_SB_invlist);
     PL_WB_invlist = _new_invlist_C_array(_Perl_WB_invlist);
+    PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
 
     ENTER;
 }
@@ -1070,6 +1071,7 @@ perl_destruct(pTHXx)
         PL_XPosix_ptrs[i] = NULL;
     }
     PL_GCB_invlist = NULL;
+    PL_LB_invlist = NULL;
     PL_SB_invlist = NULL;
     PL_WB_invlist = NULL;
 
@@ -1485,8 +1487,8 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
         const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
 
         if (s && strEQ(s, "1")) {
-            unsigned char *seed= PERL_HASH_SEED;
-            unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES;
+            const unsigned char *seed= PERL_HASH_SEED;
+            const unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES;
             PerlIO_printf(Perl_debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC);
             while (seed < seed_end) {
                 PerlIO_printf(Perl_debug_log, "%02x", *seed++);
@@ -1806,15 +1808,20 @@ S_Internals_V(pTHX_ CV *cv)
     PUSHs(Perl_newSVpvn_flags(aTHX_ non_bincompat_options,
                              sizeof(non_bincompat_options) - 1, SVs_TEMP));
 
-#ifdef __DATE__
-#  ifdef __TIME__
+#ifndef PERL_BUILD_DATE
+#  ifdef __DATE__
+#    ifdef __TIME__
+#      define PERL_BUILD_DATE __DATE__ " " __TIME__
+#    else
+#      define PERL_BUILD_DATE __DATE__
+#    endif
+#  endif
+#endif
+
+#ifdef PERL_BUILD_DATE
     PUSHs(Perl_newSVpvn_flags(aTHX_
-                             STR_WITH_LEN("Compiled at " __DATE__ " " __TIME__),
-                             SVs_TEMP));
-#  else
-    PUSHs(Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN("Compiled on " __DATE__),
+                             STR_WITH_LEN("Compiled at " PERL_BUILD_DATE),
                              SVs_TEMP));
-#  endif
 #else
     PUSHs(&PL_sv_undef);
 #endif
@@ -2729,13 +2736,11 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
     SAVEOP();
     PL_op = (OP*)&myop;
 
-    {
+    if (!(flags & G_METHOD_NAMED)) {
        dSP;
        EXTEND(SP, 1);
-       if (!(flags & G_METHOD_NAMED)) {
-           PUSHs(sv);
-           PUTBACK;
-       }
+       PUSHs(sv);
+       PUTBACK;
     }
     oldmark = TOPMARK;
     oldscope = PL_scopestack_ix;
@@ -2773,9 +2778,9 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
     }
     else {
        myop.op_other = (OP*)&myop;
-       PL_markstack_ptr--;
+       (void)POPMARK;
        create_eval_scope(flags|G_FAKINGEVAL);
-       PL_markstack_ptr++;
+       (void)INCMARK;
 
        JMPENV_PUSH(ret);
 
@@ -3530,7 +3535,7 @@ S_minus_v(pTHX)
 #endif
 
        PerlIO_printf(PIO_stdout,
-                     "\n\nCopyright 1987-2015, Larry Wall\n");
+                     "\n\nCopyright 1987-2016, Larry Wall\n");
 #ifdef MSDOS
        PerlIO_printf(PIO_stdout,
                      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -3780,7 +3785,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
        const char * const err = "Failed to create a fake bit bucket";
        if (strEQ(scriptname, BIT_BUCKET)) {
 #ifdef HAS_MKSTEMP /* Hopefully mkstemp() is safe here. */
-            int old_umask = umask(0600);
+            int old_umask = umask(0177);
            int tmpfd = mkstemp(tmpname);
             umask(old_umask);
            if (tmpfd > -1) {
@@ -3836,6 +3841,14 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
     return rsfp;
 }
 
+/* Mention
+ * I_SYSSTATVFS        HAS_FSTATVFS
+ * I_SYSMOUNT
+ * I_STATFS    HAS_FSTATFS     HAS_GETFSSTAT
+ * I_MNTENT    HAS_GETMNTENT   HAS_HASMNTOPT
+ * here so that metaconfig picks them up. */
+
+
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 /* Don't even need this function.  */
 #else
@@ -4373,12 +4386,12 @@ S_init_perllib(pTHX)
         */
        char buf[256];
        int idx = 0;
-       if (my_trnlnm("PERL5LIB",buf,0))
+       if (vmstrnenv("PERL5LIB",buf,0,NULL,0))
            do {
                incpush_use_sep(buf, 0, INCPUSH_ADD_SUB_DIRS);
-           } while (my_trnlnm("PERL5LIB",buf,++idx));
+           } while (vmstrnenv("PERL5LIB",buf,++idx,NULL,0));
        else {
-           while (my_trnlnm("PERLLIB",buf,idx++))
+           while (vmstrnenv("PERLLIB",buf,idx++,NULL,0))
                incpush_use_sep(buf, 0, 0);
        }
 #endif /* VMS */
@@ -4484,11 +4497,11 @@ S_init_perllib(pTHX)
         */
        char buf[256];
        int idx = 0;
-       if (my_trnlnm("PERL5LIB",buf,0))
+       if (vmstrnenv("PERL5LIB",buf,0,NULL,0))
            do {
                incpush_use_sep(buf, 0,
                                INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR);
-           } while (my_trnlnm("PERL5LIB",buf,++idx));
+           } while (vmstrnenv("PERL5LIB",buf,++idx,NULL,0));
 #endif /* VMS */
     }