Add Hash::Util::hash_seed() which answers among

other things the question whether our hashes are
"randomised".  (They always were...)

p4raw-id: //depot/perl@21087

diff --git a/lib/Hash/Util.pm b/lib/Hash/Util.pm
index 658fd86..8e8c952 100644 (file)
--- a/lib/Hash/Util.pm
+++ b/lib/Hash/Util.pm
@@ -7,7 +7,7 @@ use Carp;
 require Exporter;
 our @ISA        = qw(Exporter);
 our @EXPORT_OK  = qw(lock_keys unlock_keys lock_value unlock_value
-                     lock_hash unlock_hash
+                     lock_hash unlock_hash hash_seed
                     );
 our $VERSION    = 0.05;
 
@@ -19,7 +19,8 @@ Hash::Util - A selection of general-utility hash subroutines
 
   use Hash::Util qw(lock_keys   unlock_keys
                     lock_value  unlock_value
-                    lock_hash   unlock_hash);
+                    lock_hash   unlock_hash
+                    hash_seed);
 
   %hash = (foo => 42, bar => 23);
   lock_keys(%hash);
@@ -32,6 +33,8 @@ Hash::Util - A selection of general-utility hash subroutines
   lock_hash  (%hash);
   unlock_hash(%hash);
 
+  my $hashes_are_randomised = hash_seed() != 0;
+
 =head1 DESCRIPTION
 
 C<Hash::Util> contains special functions for manipulating hashes that
@@ -176,6 +179,20 @@ sub unlock_hash (\%) {
 }
 
 
+=item B<hash_seed>
+
+    my $hash_seed = hash_seed();
+
+hash_seed() returns the seed number used to randomise hash ordering.
+Zero means the "traditional" random hash ordering, non-zero means the
+new even more random hash ordering introduced in Perl 5.8.1.
+
+=cut
+
+sub hash_seed () {
+    Internals::hash_seed();
+}
+
 =back
 
 =head1 CAVEATS
@@ -194,7 +211,8 @@ Ing-Simmons and Jeffrey Friedl.
 
 =head1 SEE ALSO
 
-L<Scalar::Util>, L<List::Util>, L<Hash::Util>
+L<Scalar::Util>, L<List::Util>, L<Hash::Util>,
+and L<perlsec/"Algorithmic Complexity Attacks">.
 
 =cut
 

diff --git a/lib/Hash/Util.t b/lib/Hash/Util.t
index ae5e7c9..7cffcbe 100644 (file)
--- a/lib/Hash/Util.t
+++ b/lib/Hash/Util.t
@@ -6,7 +6,7 @@ BEGIN {
         chdir 't';
     }
 }
-use Test::More tests => 155;
+use Test::More tests => 157;
 use strict;
 
 my @Exported_Funcs;
@@ -14,6 +14,7 @@ BEGIN {
     @Exported_Funcs = qw(lock_keys   unlock_keys
                          lock_value  unlock_value
                          lock_hash   unlock_hash
+                        hash_seed
                         );
     use_ok 'Hash::Util', @Exported_Funcs;
 }
@@ -272,3 +273,6 @@ like( $@, qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted ha
     }
   }
 }
+
+my $hash_seed = hash_seed();
+ok($hash_seed >= 0, "hash_seed $hash_seed");

diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index 3ddb2f8..f8a0ae6 100644 (file)
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -1139,12 +1139,14 @@ the pseudorandom seed supplied by the operating system and libraries.
 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.
+See L<perlsec/"Algorithmic Complexity Attacks"> for more information,
+and also L</PERL_HASH_SEED>.
 
 =item PERL_HASH_SEED_DEBUG
 
 (Since Perl 5.8.1.)  Set to "1" to display (to STDERR) the value of
 the hash seed at the beginning of execution.
+See also hash_seed() of L<Hash::Util>.
 
 =item PERL_ROOT (specific to the VMS port)
 

diff --git a/universal.c b/universal.c
index 6ba5a13..15c408d 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -187,6 +187,7 @@ XS(XS_Internals_SvREFCNT);
 XS(XS_Internals_hv_clear_placehold);
 XS(XS_PerlIO_get_layers);
 XS(XS_Regexp_DESTROY);
+XS(XS_Internals_hash_seed);
 
 void
 Perl_boot_core_UNIVERSAL(pTHX)
@@ -230,6 +231,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
     newXSproto("PerlIO::get_layers",
                XS_PerlIO_get_layers, file, "*;@");
     newXS("Regexp::DESTROY", XS_Regexp_DESTROY, file);
+    newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
 }
 
 
@@ -906,3 +908,9 @@ XS(XS_PerlIO_get_layers)
     XSRETURN(0);
 }
 
+XS(XS_Internals_hash_seed)
+{
+    dXSARGS;
+    XSRETURN_UV(PL_hash_seed);
+}
+