1 Patch origin: upstream

     2 Patch status: will be part of next version

     3 

     4 Synthesis of:

     5 http://svn.apache.org/viewvc?view=revision&revision=1455340

     6 http://svn.apache.org/viewvc?view=revision&revision=1457619

     7 

     8 See also:

     9 https://rt.cpan.org/Public/Bug/Display.html?id=83916

    10 https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=702821

    11 

    12 --- a/t/response/TestPerl/hash_attack.pm	2013-03-15 13:35:14.000000000 +0000

    13 +++ b/t/response/TestPerl/hash_attack.pm	2013-03-15 13:38:29.000000000 +0000

    14 @@ -5,10 +5,11 @@

    15  # and fixup handlers in this test). Moreover it must not fail to find

    16  # that entry on the subsequent requests.

    17  #

    18 -# the hash attack is detected when HV_MAX_LENGTH_BEFORE_SPLIT keys

    19 -# find themselves in the same hash bucket, in which case starting from

    20 -# 5.8.2 the hash will rehash all its keys using a random hash seed

    21 -# (PL_new_hash_seed, set in mod_perl or via PERL_HASH_SEED environment

    22 +# the hash attack is detected when HV_MAX_LENGTH_BEFORE_REHASH keys find

    23 +# themselves in the same hash bucket on splitting (which happens when the

    24 +# number of keys crosses the threshold of a power of 2), in which case

    25 +# starting from 5.8.2 the hash will rehash all its keys using a random hash

    26 +# seed (PL_new_hash_seed, set in mod_perl or via PERL_HASH_SEED environment

    27  # variable)

    28  #

    29  # Prior to the attack condition hashes use the PL_hash_seed, which is

    30 @@ -29,7 +30,7 @@

    31  

    32  use constant MASK_U32  => 2**32;

    33  use constant HASH_SEED => 0; # 5.8.2: always zero before the rehashing

    34 -use constant THRESHOLD => 14; #define HV_MAX_LENGTH_BEFORE_SPLIT

    35 +use constant THRESHOLD => 14; #define HV_MAX_LENGTH_BEFORE_(SPLIT|REHASH)

    36  use constant START     => "a";

    37  

    38  # create conditions which will trigger a rehash on the current stash

    39 @@ -57,6 +58,8 @@

    40      return Apache2::Const::OK;

    41  }

    42  

    43 +sub buckets { scalar(%{$_[0]}) =~ m#/([0-9]+)\z# ? 0+$1 : 8 }

    44 +

    45  sub attack {

    46      my $stash = shift;

    47  

    48 @@ -74,9 +77,9 @@

    49      my $bits = $keys ? log($keys)/log(2) : 0;

    50      $bits = $min_bits if $min_bits > $bits;

    51  

    52 -    $bits = int($bits) < $bits ? int($bits) + 1 : int($bits);

    53 -    # need to add 2 bits to cover the internal split cases

    54 -    $bits += 2;

    55 +    $bits = ceil($bits);

    56 +    # need to add 3 bits to cover the internal split cases

    57 +    $bits += 3;

    58      my $mask = 2**$bits-1;

    59      debug "mask: $mask ($bits)";

    60  

    61 @@ -90,7 +93,7 @@

    62          next unless ($h & $mask) == 0;

    63          $c++;

    64          $stash->{$s}++;

    65 -        debug sprintf "%2d: %5s, %10s, %s", $c, $s, $h, scalar(%$stash);

    66 +        debug sprintf "%2d: %5s, %08x %s", $c, $s, $h, scalar(%$stash);

    67          push @keys, $s;

    68          debug "The hash collision attack has been successful"

    69              if Internals::HvREHASH(%$stash);

    70 @@ -98,6 +101,24 @@

    71          $s++;

    72      }

    73  

    74 +    # If the rehash hasn't been triggered yet, it's being delayed until the

    75 +    # next bucket split.  Add keys until a split occurs.

    76 +    unless (Internals::HvREHASH(%$stash)) {

    77 +        debug "Will add padding keys until hash split";

    78 +        my $old_buckets = buckets($stash);

    79 +        while (buckets($stash) == $old_buckets) {

    80 +            next if exists $stash->{$s};

    81 +            $h = hash($s);

    82 +            $c++;

    83 +            $stash->{$s}++;

    84 +            debug sprintf "%2d: %5s, %08x %s", $c, $s, $h, scalar(%$stash);

    85 +            push @keys, $s;

    86 +            debug "The hash collision attack has been successful"

    87 +                if Internals::HvREHASH(%$stash);

    88 +            $s++;

    89 +        }

    90 +    }

    91 +

    92      # this verifies that the attack was mounted successfully. If

    93      # HvREHASH is on it is. Otherwise the sequence wasn't successful.

    94      die "Failed to mount the hash collision attack"

    95 @@ -108,6 +129,12 @@

    96      return @keys;

    97  }

    98  

    99 +# least integer >= n

   100 +sub ceil {

   101 +    my $value = shift;

   102 +    return int($value) < $value ? int($value) + 1 : int($value);

   103 +}

   104 +

   105  # trying to provide the fastest equivalent of C macro's PERL_HASH in

   106  # Perl - the main complication is that the C macro uses U32 integer

   107  # (unsigned int), which we can't do it Perl (it can do I32, with 'use