|
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 |