ESUCCESS = 0 is not true, but exists.
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 6000f1c..fb9fd20 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -181,6 +181,9 @@ perl_construct(pTHXx)
            SvNV(&PL_sv_yes);
            SvREADONLY_on(&PL_sv_yes);
            SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+
+           SvREADONLY_on(&PL_sv_placeholder);
+           SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
        }
 
        PL_sighandlerp = Perl_sighandler;
@@ -783,6 +786,9 @@ perl_destruct(pTHXx)
     SvREFCNT(&PL_sv_undef) = 0;
     SvREADONLY_off(&PL_sv_undef);
 
+    SvREFCNT(&PL_sv_placeholder) = 0;
+    SvREADONLY_off(&PL_sv_placeholder);
+
     Safefree(PL_origfilename);
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
@@ -899,36 +905,22 @@ setuid perl scripts securely.\n");
 
 #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
     /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0
-     * This MUST be done before any hash stores or fetches take place. */
+     * This MUST be done before any hash stores or fetches take place.
+     * If you set PL_hash_seed (and assumedly also PL_hash_seed_set) yourself,
+     * it is your responsibility to provide a good random seed!
+     * You can also define PERL_HASH_SEED in compile time, see hv.h. */
+    if (!PL_hash_seed_set)
+        PL_hash_seed = get_hash_seed();
     {
-       bool earlytaint = doing_taint(argc, argv, env);
-       char *s = NULL;
-
-       if (!earlytaint)
-          s = PerlEnv_getenv("PERL_HASH_SEED");
-       if (s)
-           while (isSPACE(*s)) s++;
-       if (s && isDIGIT(*s))
-           PL_hash_seed = (UV)Atoul(s);
-#ifndef USE_HASH_SEED_EXPLICIT
-       else {
-           /* Compute a random seed */
-           (void)seedDrand01((Rand_seed_t)seed());
-           PL_srand_called = TRUE;
-           PL_hash_seed = (UV)(Drand01() * (NV)UV_MAX);
-#if RANDBITS < (UVSIZE * 8)
-           {
-               int skip = (UVSIZE * 8) - RANDBITS;
-               PL_hash_seed >>= skip;
-               /* The low bits might need extra help. */
-               PL_hash_seed += (UV)(Drand01() * ((1 << skip) - 1));
-           }
-#endif /* RANDBITS < (UVSIZE * 8) */
-       }
-#endif /* USE_HASH_SEED_EXPLICIT */
-       if (s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"))
-          PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n",
-                        PL_hash_seed);
+        char *s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
+
+        if (s) {
+             int i = atoi(s);
+
+             if (i == 1)
+                  PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n",
+                                PL_hash_seed);
+        }
     }
 #endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
 
@@ -943,7 +935,7 @@ setuid perl scripts securely.\n");
         * the area we are able to modify is limited to the size of
         * the original argv[0].  (See below for 'contiguous', though.)
         * --jhi */
-        char *s;
+        char *s = NULL;
         int i;
         UV mask =
           ~(UV)(PTRSIZE == 4 ? 3 : PTRSIZE == 8 ? 7 : PTRSIZE == 16 ? 15 : 0);
@@ -960,26 +952,27 @@ setuid perl scripts securely.\n");
          * PTRSIZE bytes.  As long as no system has something bizarre
          * like the argv[] interleaved with some other data, we are
          * fine.  (Did I just evoke Murphy's Law?)  --jhi */
-        s = PL_origargv[0];
-        while (*s) s++;
-        for (i = 1; i < PL_origargc; i++) {
-             if ((PL_origargv[i] == s + 1
+        if (PL_origargv && PL_origargc >= 1 && (s = PL_origargv[0])) {
+             while (*s) s++;
+             for (i = 1; i < PL_origargc; i++) {
+                  if ((PL_origargv[i] == s + 1
 #ifdef OS2
-                  || PL_origargv[i] == s + 2
+                       || PL_origargv[i] == s + 2
 #endif 
-                 )
-                 ||
-                 (aligned &&
-                  (PL_origargv[i] >  s &&
-                   PL_origargv[i] <=
-                   INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
-                )
-             {
-                  s = PL_origargv[i];
-                  while (*s) s++;
+                           )
+                      ||
+                      (aligned &&
+                       (PL_origargv[i] >  s &&
+                        PL_origargv[i] <=
+                        INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)))
+                       )
+                  {
+                       s = PL_origargv[i];
+                       while (*s) s++;
+                  }
+                  else
+                       break;
              }
-             else
-                  break;
         }
         /* Can we grab env area too to be used as the area for $0? */
         if (PL_origenviron) {
@@ -1672,7 +1665,7 @@ S_run_body(pTHX_ I32 oldscope)
 
     if (!PL_restartop) {
        DEBUG_x(dump_all());
-       DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
+       PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
        DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n",
                              PTR2UV(thr)));
 
@@ -2641,7 +2634,7 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 #ifdef MPE
        PerlIO_printf(PerlIO_stdout(),
-                     "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2002\n");
+                     "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2003\n");
 #endif
 #ifdef OEMVS
        PerlIO_printf(PerlIO_stdout(),
@@ -2982,10 +2975,12 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
                 PL_statbuf.st_mode & (S_ISUID|S_ISGID))
             {
                 /* try again */
+                PERL_FPU_PRE_EXEC
                 PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT,
                                          BIN_EXP, (int)PERL_REVISION,
                                          (int)PERL_VERSION,
                                          (int)PERL_SUBVERSION), PL_origargv);
+                PERL_FPU_POST_EXEC
                 Perl_croak(aTHX_ "Can't do setuid\n");
             }
 #       endif
@@ -3242,9 +3237,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
            (void)PerlIO_close(PL_rsfp);
 #ifndef IAMSUID
            /* try again */
+           PERL_FPU_PRE_EXEC
            PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
                                     (int)PERL_REVISION, (int)PERL_VERSION,
                                     (int)PERL_SUBVERSION), PL_origargv);
+           PERL_FPU_POST_EXEC
 #endif
            Perl_croak(aTHX_ "Can't do setuid\n");
        }
@@ -3326,9 +3323,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);   /* ensure no close-on-exec */
 #endif
+    PERL_FPU_PRE_EXEC
     PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
                             (int)PERL_REVISION, (int)PERL_VERSION,
                             (int)PERL_SUBVERSION), PL_origargv);/* try again */
+    PERL_FPU_POST_EXEC
     Perl_croak(aTHX_ "Can't do setuid\n");
 #endif /* IAMSUID */
 #else /* !DOSUID */
@@ -3483,17 +3482,17 @@ Perl_init_debugger(pTHX)
     HV *ostash = PL_curstash;
 
     PL_curstash = PL_debstash;
-    PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
+    PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("DB::args", GV_ADDMULTI, SVt_PVAV))));
     AvREAL_off(PL_dbargs);
-    PL_DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV);
-    PL_DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV);
-    PL_DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV));
+    PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
+    PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
+    PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
     sv_upgrade(GvSV(PL_DBsub), SVt_IV);        /* IVX accessed if PERLDB_SUB_NN */
-    PL_DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV)));
+    PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsingle, 0);
-    PL_DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV)));
+    PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBtrace, 0);
-    PL_DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV)));
+    PL_DBsignal = GvSV((gv_fetchpv("DB::signal", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsignal, 0);
     PL_DBassertion = GvSV((gv_fetchpv("assertion", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBassertion, 0);