PerlIO_read() can return negative.

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 73f3273..ba112a2 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -274,39 +274,6 @@ perl_construct(pTHXx)
 
     PL_stashcache = newHV();
 
-#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
-    /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0 */
-    {
-       char *s = NULL;
-
-       if (!PL_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 (!PL_earlytaint && (s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG")))
-          PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n",
-                        PL_hash_seed);
-    }
-#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
-
     ENTER;
 }
 
@@ -930,6 +897,41 @@ setuid perl scripts securely.\n");
 #endif
 #endif
 
+#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. */
+    {
+       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)
+          /* Since there are not enough randbits to to reach all
+           * the bits of a UV, the low bits might need extra
+           * help.  Sum in another random number that will
+           * fill in the low bits. */
+          PL_hash_seed +=
+            (UV)(Drand01() * (NV)((1 << ((UVSIZE * 8 - RANDBITS))) - 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);
+    }
+#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
+
     PL_origargc = argc;
     PL_origargv = argv;
 
@@ -3432,8 +3434,7 @@ S_init_ids(pTHX)
 
 /* This is used very early in the lifetime of the program,
  * before even the options are parsed, so PL_tainting has
- * not been initialized properly.  The variable PL_earlytaint
- * is set early in main() to the result of this function. */
+ * not been initialized properly.  */
 bool
 Perl_doing_taint(int argc, char *argv[], char *envp[])
 {
@@ -3482,17 +3483,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);