t/op/hash.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 use strict;
  10
  11 plan tests => 5;
  12
  13 my %h;
  14
  15 ok (!Internals::HvREHASH(%h), "hash doesn't start with rehash flag on");
  16
  17 foreach (1..10) {
  18   $h{"\0"x$_}++;
  19 }
  20
  21 ok (!Internals::HvREHASH(%h), "10 entries doesn't trigger rehash");
  22
  23 foreach (11..20) {
  24   $h{"\0"x$_}++;
  25 }
  26
  27 ok (Internals::HvREHASH(%h), "20 entries triggers rehash");
  28
  29
  30
  31
  32 # second part using an emulation of the PERL_HASH in perl, mounting an
  33 # attack on a prepopulated hash. This is also useful if you need normal
  34 # keys which don't contain \0 -- suitable for stashes
  35
  36 use constant MASK_U32  => 2**32;
  37 use constant HASH_SEED => 0;
  38 use constant THRESHOLD => 14;
  39 use constant START     => "a";
  40
  41 # some initial hash data
  42 my %h2 = map {$_ => 1} 'a'..'cc';
  43
  44 ok (!Internals::HvREHASH(%h2),
  45     "starting with pre-populated non-pathalogical hash (rehash flag if off)");
  46
  47 my @keys = get_keys(\%h2);
  48 $h2{$_}++ for @keys;
  49 ok (Internals::HvREHASH(%h2),
  50     scalar(@keys) . " colliding into the same bucket keys are triggerring rehash");
  51
  52 sub get_keys {
  53     my $hr = shift;
  54
  55     # the minimum of bits required to mount the attack on a hash
  56     my $min_bits = log(THRESHOLD)/log(2);
  57
  58     # if the hash has already been populated with a significant amount
  59     # of entries the number of mask bits can be higher
  60     my $keys = scalar keys %$hr;
  61     my $bits = $keys ? log($keys)/log(2) : 0;
  62     $bits = $min_bits if $min_bits > $bits;
  63
  64     $bits = int($bits) < $bits ? int($bits) + 1 : int($bits);
  65     # need to add 2 bits to cover the internal split cases
  66     $bits += 2;
  67     my $mask = 2**$bits-1;
  68     print "# using mask: $mask ($bits)\n";
  69
  70     my @keys;
  71     my $s = START;
  72     my $c = 0;
  73     # get 2 keys on top of the THRESHOLD
  74     my $hash;
  75     while (@keys < THRESHOLD+2) {
  76         # next if exists $hash->{$s};
  77         $hash = hash($s);
  78         next unless ($hash & $mask) == 0;
  79         $c++;
  80         printf "# %2d: %5s, %10s\n", $c, $s, $hash;
  81         push @keys, $s;
  82     } continue {
  83         $s++;
  84     }
  85
  86     return @keys;
  87 }
  88
  89
  90 # trying to provide the fastest equivalent of C macro's PERL_HASH in
  91 # Perl - the main complication is that it uses U32 integer, which we
  92 # can't do it perl, without doing some tricks
  93 sub hash {
  94     my $s = shift;
  95     my @c = split //, $s;
  96     my $u = HASH_SEED;
  97     for (@c) {
  98         # (A % M) + (B % M) == (A + B) % M
  99         # This works because '+' produces a NV, which is big enough to hold
 100         # the intermidiate result. We only need the % before any "^" and "&"
 101         # to get the result in the range for an I32.
 102         # and << doesn't work on NV, so using 1 << 10
 103         $u += ord;
 104         $u += $u * (1 << 10); $u %= MASK_U32;
 105         $u ^= $u >> 6;
 106     }
 107     $u += $u << 3;  $u %= MASK_U32;
 108     $u ^= $u >> 11; $u %= MASK_U32;
 109     $u += $u << 15; $u %= MASK_U32;
 110     $u;
 111 }