Integrate:

[ 20134]
Check PERL_HASH_SEED even when tainted.

[ 20135]
Chicken out: the hash randomisation is not on by default.
We switch over to the explicit mode: in other words, if
the $ENV{PERL_HASH_SEED} is on, we randomise.  Also, we
randomise only if PL_hash_seed_set is FALSE (this means
one can use PERL_HASH() before perl_run.)  Also, since
now PERL_HASH_SEED is okay even under -T, all should be fine.
(Ha!)
p4raw-link: @20135 on //depot/perl: bed601927f5ca7f54b544d9e5ce1f77461311b68
p4raw-link: @20134 on //depot/perl: 183c3da10ba46f0626790e1aa75f641397137480

p4raw-id: //depot/maint-5.8/perl@20136
p4raw-integrated: from //depot/perl@20133 'ignore' pod/perldiag.pod
	(@20034..) 'merge in' pod/perlrun.pod (@19929..) proto.h
	(@20081..) util.c (@20084..) intrpvar.h (@20114..) embed.fnc
	embed.h (@20116..) perl.h perlapi.h (@20117..) embedvar.h
	(@20125..) perl.c (@20129..)

diff --git a/embed.fnc b/embed.fnc
index d2159ca..c4095a3 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -854,6 +854,7 @@ p   |void   |vivify_ref     |SV* sv|U32 to_what
 p      |I32    |wait4pid       |Pid_t pid|int* statusp|int flags
 p      |U32    |parse_unicode_opts|char **popt
 p      |U32    |seed
+p      |UV     |get_seed
 p      |void   |report_evil_fh |GV *gv|IO *io|I32 op
 pd     |void   |report_uninit
 Afpd   |void   |warn           |const char* pat|...

diff --git a/embed.h b/embed.h
index 485d60b..ccd0352 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1135,6 +1135,9 @@
 #define seed                   Perl_seed
 #endif
 #ifdef PERL_CORE
+#define get_seed               Perl_get_seed
+#endif
+#ifdef PERL_CORE
 #define report_evil_fh         Perl_report_evil_fh
 #endif
 #ifdef PERL_CORE
@@ -3646,6 +3649,9 @@
 #define seed()                 Perl_seed(aTHX)
 #endif
 #ifdef PERL_CORE
+#define get_seed()             Perl_get_seed(aTHX)
+#endif
+#ifdef PERL_CORE
 #define report_evil_fh(a,b,c)  Perl_report_evil_fh(aTHX_ a,b,c)
 #endif
 #ifdef PERL_CORE

diff --git a/embedvar.h b/embedvar.h
index 73ce206..d9f0a67 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -593,6 +593,7 @@
 #define PL_glob_index          (vTHX->Iglob_index)
 #define PL_globalstash         (vTHX->Iglobalstash)
 #define PL_hash_seed           (vTHX->Ihash_seed)
+#define PL_hash_seed_set       (vTHX->Ihash_seed_set)
 #define PL_he_arenaroot                (vTHX->Ihe_arenaroot)
 #define PL_he_root             (vTHX->Ihe_root)
 #define PL_hintgv              (vTHX->Ihintgv)
@@ -913,6 +914,7 @@
 #define PL_Iglob_index         PL_glob_index
 #define PL_Iglobalstash                PL_globalstash
 #define PL_Ihash_seed          PL_hash_seed
+#define PL_Ihash_seed_set      PL_hash_seed_set
 #define PL_Ihe_arenaroot       PL_he_arenaroot
 #define PL_Ihe_root            PL_he_root
 #define PL_Ihintgv             PL_hintgv

diff --git a/intrpvar.h b/intrpvar.h
index 0fb1351..fe1efce 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -558,6 +558,8 @@ PERLVARI(Ippid,             IV,             0)
 
 PERLVARI(Ihash_seed, UV, 0)            /* Hash initializer */
 
+PERLVARI(Ihash_seed_set, bool, FALSE)          /* Hash initialized? */
+
 /* New variables must be added to the very end, before this comment,
  * for binary compatibility (the offsets of the old members must not change).
  * (Don't forget to add your variable also to perl_clone()!)

diff --git a/perl.c b/perl.c
index 5328621..cbed497 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1030,35 +1030,18 @@ 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. */
+    if (!PL_hash_seed_set)
+        PL_hash_seed = get_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)
-          /* 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 /* #ifndef 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) */
 

diff --git a/perl.h b/perl.h
index 0b34830..d08425a 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2310,7 +2310,7 @@ typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
 
 /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0 */
 #if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT)
-#  define USE_HASH_SEED
+#  define USE_HASH_SEED_EXPLICIT
 #endif
 
 #include "regexp.h"

diff --git a/perlapi.h b/perlapi.h
index 3707985..82b0e72 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -276,6 +276,8 @@ END_EXTERN_C
 #define PL_globalstash         (*Perl_Iglobalstash_ptr(aTHX))
 #undef  PL_hash_seed
 #define PL_hash_seed           (*Perl_Ihash_seed_ptr(aTHX))
+#undef  PL_hash_seed_set
+#define PL_hash_seed_set       (*Perl_Ihash_seed_set_ptr(aTHX))
 #undef  PL_he_arenaroot
 #define PL_he_arenaroot                (*Perl_Ihe_arenaroot_ptr(aTHX))
 #undef  PL_he_root

diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 1694bf3..a77cbe0 100644 (file)
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -1101,12 +1101,11 @@ PERL_ENCODING environment variable is consulted for an encoding name.
 
 =item PERL_HASH_SEED
 
-(Since Perl 5.8.1.)
-
-Used to randomise Perl's internal hash function.  To emulate the
-pre-5.8.1 behaviour, set to an integer (zero means exactly the same
-order as 5.8.0).  "Pre-5.8.1" means, among other things, that hash
-keys will be ordered the same between different runs of Perl.
+(Since Perl 5.8.1.)  Used to randomise Perl's internal hash function.
+To emulate the pre-5.8.1 behaviour, set to an integer (zero means
+exactly the same order as 5.8.0).  "Pre-5.8.1" means, among other
+things, that hash keys will be ordered the same between different runs
+of Perl.
 
 The default behaviour is to randomise unless the PERL_HASH_SEED is set.
 If Perl has been compiled with C<-DUSE_HASH_SEED_EXPLICIT>, the default
@@ -1114,14 +1113,15 @@ behaviour is B<not> to randomise unless the PERL_HASH_SEED is set.
 
 If PERL_HASH_SEED is unset or set to a non-numeric string, Perl uses
 the pseudorandom seed supplied by the operating system and libraries.
-If unset, each different run of Perl will have different ordering of
-the outputs of keys(), values(), and each().
+This means that each different run of Perl will have a different
+ordering of the results of keys(), values(), and each().
 
 See L<perlsec/"Algorithmic Complexity Attacks"> for more information.
 
 =item PERL_HASH_SEED_DEBUG
 
-Set to (anything) to display the value of the hash seed.
+(Since Perl 5.8.1.)  Set to "1" to display (to STDERR) the value of
+the hash seed at the beginning of execution.
 
 =item PERL_ROOT (specific to the VMS port)
 

diff --git a/proto.h b/proto.h
index a3fa67a..190d2e6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -814,6 +814,7 @@ PERL_CALLCONV void  Perl_vivify_ref(pTHX_ SV* sv, U32 to_what);
 PERL_CALLCONV I32      Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags);
 PERL_CALLCONV U32      Perl_parse_unicode_opts(pTHX_ char **popt);
 PERL_CALLCONV U32      Perl_seed(pTHX);
+PERL_CALLCONV UV       Perl_get_seed(pTHX);
 PERL_CALLCONV void     Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op);
 PERL_CALLCONV void     Perl_report_uninit(pTHX);
 PERL_CALLCONV void     Perl_warn(pTHX_ const char* pat, ...)

diff --git a/util.c b/util.c
index 50c7ec3..cf2d21e 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4359,3 +4359,35 @@ Perl_seed(pTHX)
     return u;
 }
 
+UV
+Perl_get_seed(void)
+{
+     char *s = PerlEnv_getenv("PERL_HASH_SEED");
+     UV myseed = 0;
+
+     if (s)
+         while (isSPACE(*s)) s++;
+     if (s && isDIGIT(*s))
+         myseed = (UV)Atoul(s);
+     else
+#ifdef USE_HASH_SEED_EXPLICIT
+     if (s)
+#endif
+     {
+         /* Compute a random seed */
+         (void)seedDrand01((Rand_seed_t)seed());
+         PL_srand_called = TRUE;
+         myseed = (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. */
+         myseed +=
+              (UV)(Drand01() * (NV)((1 << ((UVSIZE * 8 - RANDBITS))) - 1));
+#endif /* RANDBITS < (UVSIZE * 8) */
+     }
+     PL_hash_seed_set = TRUE;
+
+     return myseed;
+}