1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestPerl::hash_attack;
# if the rehashing of the keys in the stash happens due to the hash attack,
# mod_perl must not fail to find the previously cached stash entry (response
# and fixup handlers in this test). Moreover it must not fail to find
# that entry on the subsequent requests.
#
# the hash attack is detected when HV_MAX_LENGTH_BEFORE_REHASH keys find
# themselves in the same hash bucket on splitting (which happens when the
# number of keys crosses the threshold of a power of 2), in which case
# starting from 5.8.2 the hash will rehash all its keys using a random hash
# seed (PL_new_hash_seed, set in mod_perl or via PERL_HASH_SEED environment
# variable)
#
# Prior to the attack condition hashes use the PL_hash_seed, which is
# always 0.
#
# only in 5.8.1 hashes always use a non-zero PL_hash_seed (unless set
# to 0 via PERL_HASH_SEED environment variable or compiled without
# -DUSE_HASH_SEED or -DUSE_HASH_SEED_EXPLICIT
use strict;
use warnings FATAL => 'all';
use Apache::TestTrace;
use Apache2::Const -compile => 'OK';
use Math::BigInt;
use constant MASK_U32 => 2**32;
use constant HASH_SEED => 0; # 5.8.2: always zero before the rehashing
use constant THRESHOLD => 14; #define HV_MAX_LENGTH_BEFORE_(SPLIT|REHASH)
use constant START => "a";
# create conditions which will trigger a rehash on the current stash
# (__PACKAGE__::). Relevant for perl 5.8.2 and higher.
sub init {
my $r = shift;
no strict 'refs';
my @attack_keys = attack(\%{__PACKAGE__ . "::"}) if $] >= 5.008002;
# define a new symbol (sub) after the attack has caused a re-hash
# check that mod_perl finds that symbol (fixup2) in the stash
no warnings 'redefine';
eval qq[sub fixup2 { return Apache2::Const::OK; }];
$r->push_handlers(PerlFixupHandler => \&fixup2);
return Apache2::Const::DECLINED;
}
sub fixup { return Apache2::Const::OK; }
sub handler {
my $r = shift;
$r->print("ok");
return Apache2::Const::OK;
}
sub buckets { scalar(%{$_[0]}) =~ m#/([0-9]+)\z# ? 0+$1 : 8 }
sub attack {
my $stash = shift;
#require Hash::Util; # avail since 5.8.0
debug "starting attack (it may take a long time!)";
my @keys;
# the minimum of bits required to mount the attack on a hash
my $min_bits = log(THRESHOLD)/log(2);
# if the hash has already been populated with a significant amount
# of entries the number of mask bits can be higher
my $keys = scalar keys %$stash;
my $bits = $keys ? log($keys)/log(2) : 0;
$bits = $min_bits if $min_bits > $bits;
$bits = ceil($bits);
# need to add 3 bits to cover the internal split cases
$bits += 3;
my $mask = 2**$bits-1;
debug "mask: $mask ($bits)";
my $s = START;
my $c = 0;
# get 2 keys on top of the THRESHOLD
my $h;
while (@keys < THRESHOLD+2) {
next if exists $stash->{$s};
$h = hash($s);
next unless ($h & $mask) == 0;
$c++;
$stash->{$s}++;
debug sprintf "%2d: %5s, %08x %s", $c, $s, $h, scalar(%$stash);
push @keys, $s;
debug "The hash collision attack has been successful"
if Internals::HvREHASH(%$stash);
} continue {
$s++;
}
# If the rehash hasn't been triggered yet, it's being delayed until the
# next bucket split. Add keys until a split occurs.
unless (Internals::HvREHASH(%$stash)) {
debug "Will add padding keys until hash split";
my $old_buckets = buckets($stash);
while (buckets($stash) == $old_buckets) {
next if exists $stash->{$s};
$h = hash($s);
$c++;
$stash->{$s}++;
debug sprintf "%2d: %5s, %08x %s", $c, $s, $h, scalar(%$stash);
push @keys, $s;
debug "The hash collision attack has been successful"
if Internals::HvREHASH(%$stash);
$s++;
}
}
# this verifies that the attack was mounted successfully. If
# HvREHASH is on it is. Otherwise the sequence wasn't successful.
die "Failed to mount the hash collision attack"
unless Internals::HvREHASH(%$stash);
debug "ending attack";
return @keys;
}
# least integer >= n
sub ceil {
my $value = shift;
return int($value) < $value ? int($value) + 1 : int($value);
}
# trying to provide the fastest equivalent of C macro's PERL_HASH in
# Perl - the main complication is that the C macro uses U32 integer
# (unsigned int), which we can't do it Perl (it can do I32, with 'use
# integer'). So we outsmart Perl and take modules 2*32 after each
# calculation, emulating overflows that happen in C.
sub hash {
my $s = shift;
my @c = split //, $s;
my $u = HASH_SEED;
for (@c) {
# (A % M) + (B % M) == (A + B) % M
# This works because '+' produces a NV, which is big enough to hold
# the intermidiate result. We only need the % before any "^" and "&"
# to get the result in the range for an I32.
# and << doesn't work on NV, so using 1 << 10
$u += ord;
$u += $u * (1 << 10); $u %= MASK_U32;
$u ^= $u >> 6;
}
$u += $u << 3; $u %= MASK_U32;
$u ^= $u >> 11; $u %= MASK_U32;
$u += $u << 15; $u %= MASK_U32;
$u;
}
# a bit slower but simpler version
sub hash_original {
my $s = shift;
my @c = split //, $s;
my $u = HASH_SEED;
for (@c) {
$u += ord; $u %= MASK_U32;
$u += $u << 10; $u %= MASK_U32;
$u ^= $u >> 6; $u %= MASK_U32;
}
$u += $u << 3; $u %= MASK_U32;
$u ^= $u >> 11; $u %= MASK_U32;
$u += $u << 15; $u %= MASK_U32;
$u;
}
1;
__END__
PerlModule TestPerl::hash_attack
PerlInitHandler TestPerl::hash_attack::init
# call twice to verify an access to the same hash value after the rehash
PerlFixupHandler TestPerl::hash_attack::fixup TestPerl::hash_attack::fixup
|
