hv.c - rework PL_hash_rand_bits update logic, add tests, -Dh debug mode

This moves all run time mutations of PL_hash_rand_bits into a set of
macros which allow us to debug what is happening. It also moves away
from our poor mans RNG based on mixing in various sources of data as
we go and switches to using an XORSHIFT RNG for generating the random
bits. This particular RNG is very efficient, using three xor operations
and three shift operations, so it shouldn't hurt us to use it. As a
bonus it also removes the conditional logic involved, as we use seed()
to initialize things at the very beginning when we are running under
RANDOMIZE mode, which should fix any problems with running on platforms
that do not use process space randomization like cygwin.

It adds support for -Dh under DEBUGGING to allow introspection of the
the state of PL_hash_rand_bits and source and cause of changes to it.
With -Dhv you can also get an idea of the keys which are triggering
these mutations as well. -Dh has also been changed to imply
PERL_HASH_SEED_DEBUG as a convenience.

This goes alongside a new test, based on one from Nicholas R (atoomic)
to test that the various PERL_PERTURB_KEYS options behave as expected
and that 1 bit mutations of the seed actually *do* affect the key order
and hashing of our strings. The test is run many times to ensure that
it passes under many different randomly generated hash seeds. Parts of
this test would fail without the preceding commit to this one adjusting
how SBOX32 is initialized.

1 files changed, 71 insertions, 10 deletions

diff --git a/util.c b/util.c
index b1da8e35c8..241e5f1847 100644
--- a/util.c
+++ b/util.c
@@ -4954,11 +4954,16 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer)
 
     PERL_ARGS_ASSERT_GET_HASH_SEED;
 
+    Zero(seed_buffer, PERL_HASH_SEED_BYTES, U8);
+    Zero((U8*)PL_hash_state_w, PERL_HASH_STATE_BYTES, U8);
+
 #ifndef NO_PERL_HASH_ENV
     env_pv= PerlEnv_getenv("PERL_HASH_SEED");
 
     if ( env_pv )
     {
+        if (DEBUG_h_TEST)
+            PerlIO_printf(Perl_debug_log,"Got PERL_HASH_SEED=<%s>\n", env_pv);
         /* ignore leading spaces */
         while (isSPACE(*env_pv))
             env_pv++;
@@ -4999,19 +5004,12 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer)
         }
     }
 #ifdef USE_PERL_PERTURB_KEYS
-    {   /* initialize PL_hash_rand_bits from the hash seed.
-         * This value is highly volatile, it is updated every
-         * hash insert, and is used as part of hash bucket chain
-         * randomization and hash iterator randomization. */
-        PL_hash_rand_bits= 0xbe49d17f; /* I just picked a number */
-        for( i = 0; i < sizeof(UV) ; i++ ) {
-            PL_hash_rand_bits += seed_buffer[i % PERL_HASH_SEED_BYTES];
-            PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,8);
-        }
-    }
 #  ifndef NO_PERL_HASH_ENV
     env_pv= PerlEnv_getenv("PERL_PERTURB_KEYS");
     if (env_pv) {
+        if (DEBUG_h_TEST)
+            PerlIO_printf(Perl_debug_log,
+                "Got PERL_PERTURB_KEYS=<%s>\n", env_pv);
         if (strEQ(env_pv,"0") || strEQ(env_pv,"NO")) {
             PL_hash_rand_bits_enabled= 0;
         } else if (strEQ(env_pv,"1") || strEQ(env_pv,"RANDOM")) {
@@ -5023,9 +5021,72 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer)
         }
     }
 #  endif
+    {   /* initialize PL_hash_rand_bits from the hash seed.
+         * This value is highly volatile, it is updated every
+         * hash insert, and is used as part of hash bucket chain
+         * randomization and hash iterator randomization. */
+        if (PL_hash_rand_bits_enabled == 1) {
+            /* random mode initialize from seed() like we would our RNG() */
+            PL_hash_rand_bits= seed();
+        }
+        else {
+            /* Use a constant */
+            PL_hash_rand_bits= 0xbe49d17f; /* I just picked a number */
+            /* and then mix in the leading bytes of the hash seed */
+            for( i = 0; i < sizeof(UV) ; i++ ) {
+                PL_hash_rand_bits ^= seed_buffer[i % PERL_HASH_SEED_BYTES];
+                PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,8);
+            }
+        }
+        if (!PL_hash_rand_bits) {
+            /* we use an XORSHIFT RNG to munge PL_hash_rand_bits,
+             * which means it cannot be 0 or it will stay 0 for the
+             * lifetime of the process, so if by some insane chance we
+             * ended up with a 0 after the above initialization
+             * then set it to this. This really should not happen, or
+             * very very very rarely.
+             */
+            PL_hash_rand_bits = 0x8110ba9d; /* a randomly chosen prime */
+        }
+    }
 #endif
 }
 
+void
+Perl_debug_hash_seed(pTHX_ bool via_debug_h)
+{
+    PERL_ARGS_ASSERT_DEBUG_HASH_SEED;
+#if (defined(USE_HASH_SEED) || defined(USE_HASH_SEED_DEBUG)) && !defined(NO_PERL_HASH_SEED_DEBUG)
+    {
+        const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
+        bool via_env = cBOOL(s && strNE(s, "0") && strNE(s,""));
+
+        if ( via_env != via_debug_h ) {
+            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++);
+            }
+#ifdef PERL_HASH_RANDOMIZE_KEYS
+            PerlIO_printf(Perl_debug_log, " PERTURB_KEYS = %d (%s)",
+                    PL_HASH_RAND_BITS_ENABLED,
+                    PL_HASH_RAND_BITS_ENABLED == 0 ? "NO" :
+                    PL_HASH_RAND_BITS_ENABLED == 1 ? "RANDOM"
+                                                   : "DETERMINISTIC");
+            if (DEBUG_h_TEST)
+                PerlIO_printf(Perl_debug_log,
+                        " RAND_BITS=0x%"UVxf, PL_hash_rand_bits);
+#endif
+            PerlIO_printf(Perl_debug_log, "\n");
+        }
+    }
+#endif /* #if (defined(USE_HASH_SEED) ... */
+}
+
+
+
+
 #ifdef PERL_MEM_LOG
 
 /* -DPERL_MEM_LOG: the Perl_mem_log_..() is compiled, including