1N/A#!./perl -w
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A require './test.pl';
1N/A}
1N/A
1N/Ause strict;
1N/A
1N/Aplan tests => 5;
1N/A
1N/Amy %h;
1N/A
1N/Aok (!Internals::HvREHASH(%h), "hash doesn't start with rehash flag on");
1N/A
1N/Aforeach (1..10) {
1N/A $h{"\0"x$_}++;
1N/A}
1N/A
1N/Aok (!Internals::HvREHASH(%h), "10 entries doesn't trigger rehash");
1N/A
1N/Aforeach (11..20) {
1N/A $h{"\0"x$_}++;
1N/A}
1N/A
1N/Aok (Internals::HvREHASH(%h), "20 entries triggers rehash");
1N/A
1N/A
1N/A
1N/A
1N/A# second part using an emulation of the PERL_HASH in perl, mounting an
1N/A# attack on a prepopulated hash. This is also useful if you need normal
1N/A# keys which don't contain \0 -- suitable for stashes
1N/A
1N/Ause constant MASK_U32 => 2**32;
1N/Ause constant HASH_SEED => 0;
1N/Ause constant THRESHOLD => 14;
1N/Ause constant START => "a";
1N/A
1N/A# some initial hash data
1N/Amy %h2 = map {$_ => 1} 'a'..'cc';
1N/A
1N/Aok (!Internals::HvREHASH(%h2),
1N/A "starting with pre-populated non-pathalogical hash (rehash flag if off)");
1N/A
1N/Amy @keys = get_keys(\%h2);
1N/A$h2{$_}++ for @keys;
1N/Aok (Internals::HvREHASH(%h2),
1N/A scalar(@keys) . " colliding into the same bucket keys are triggerring rehash");
1N/A
1N/Asub get_keys {
1N/A my $hr = shift;
1N/A
1N/A # the minimum of bits required to mount the attack on a hash
1N/A my $min_bits = log(THRESHOLD)/log(2);
1N/A
1N/A # if the hash has already been populated with a significant amount
1N/A # of entries the number of mask bits can be higher
1N/A my $keys = scalar keys %$hr;
1N/A my $bits = $keys ? log($keys)/log(2) : 0;
1N/A $bits = $min_bits if $min_bits > $bits;
1N/A
1N/A $bits = int($bits) < $bits ? int($bits) + 1 : int($bits);
1N/A # need to add 2 bits to cover the internal split cases
1N/A $bits += 2;
1N/A my $mask = 2**$bits-1;
1N/A print "# using mask: $mask ($bits)\n";
1N/A
1N/A my @keys;
1N/A my $s = START;
1N/A my $c = 0;
1N/A # get 2 keys on top of the THRESHOLD
1N/A my $hash;
1N/A while (@keys < THRESHOLD+2) {
1N/A # next if exists $hash->{$s};
1N/A $hash = hash($s);
1N/A next unless ($hash & $mask) == 0;
1N/A $c++;
1N/A printf "# %2d: %5s, %10s\n", $c, $s, $hash;
1N/A push @keys, $s;
1N/A } continue {
1N/A $s++;
1N/A }
1N/A
1N/A return @keys;
1N/A}
1N/A
1N/A
1N/A# trying to provide the fastest equivalent of C macro's PERL_HASH in
1N/A# Perl - the main complication is that it uses U32 integer, which we
1N/A# can't do it perl, without doing some tricks
1N/Asub hash {
1N/A my $s = shift;
1N/A my @c = split //, $s;
1N/A my $u = HASH_SEED;
1N/A for (@c) {
1N/A # (A % M) + (B % M) == (A + B) % M
1N/A # This works because '+' produces a NV, which is big enough to hold
1N/A # the intermidiate result. We only need the % before any "^" and "&"
1N/A # to get the result in the range for an I32.
1N/A # and << doesn't work on NV, so using 1 << 10
1N/A $u += ord;
1N/A $u += $u * (1 << 10); $u %= MASK_U32;
1N/A $u ^= $u >> 6;
1N/A }
1N/A $u += $u << 3; $u %= MASK_U32;
1N/A $u ^= $u >> 11; $u %= MASK_U32;
1N/A $u += $u << 15; $u %= MASK_U32;
1N/A $u;
1N/A}