line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Devel::PatchPerl::Plugin::Legacy; |
2
|
1
|
|
|
1
|
|
5
|
use base 'Devel::PatchPerl'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1149
|
|
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
178323
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
28
|
|
5
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
621
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub patchperl { |
10
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
11
|
0
|
|
|
|
|
|
my %args = @_; |
12
|
0
|
|
|
|
|
|
my ($vers, $source, $patch_exe) = @args{qw(version source patchexe)}; |
13
|
0
|
|
|
|
|
|
for my $p ( grep { Devel::PatchPerl::_is( $_->{perl}, $vers ) } @Devel::PatchPerl::patch ) { |
|
0
|
|
|
|
|
|
|
14
|
0
|
|
|
|
|
|
for my $s (@{$p->{subs}}) { |
|
0
|
|
|
|
|
|
|
15
|
0
|
|
|
|
|
|
my ($sub, @args) = @$s; |
16
|
0
|
0
|
|
|
|
|
push @args, $vers unless scalar @args; |
17
|
0
|
|
|
|
|
|
$sub->(@args); |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
package |
23
|
|
|
|
|
|
|
Devel::PatchPerl; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our @patch = ( |
26
|
|
|
|
|
|
|
{ |
27
|
|
|
|
|
|
|
perl => [ qr/^5\.8\.8$/ ], |
28
|
|
|
|
|
|
|
subs => [ [ \&_legacy_patch_no_debugging ] ], |
29
|
|
|
|
|
|
|
}, |
30
|
|
|
|
|
|
|
{ |
31
|
|
|
|
|
|
|
perl => [ qr/^5\.8\.[89]$/ ], |
32
|
|
|
|
|
|
|
subs => [ [ \&_legacy_patch_hsplit_rehash_58 ] ], |
33
|
|
|
|
|
|
|
}, |
34
|
|
|
|
|
|
|
{ |
35
|
|
|
|
|
|
|
perl => [ |
36
|
|
|
|
|
|
|
qr/^5\.10\.1$/, |
37
|
|
|
|
|
|
|
qr/^5\.12\.5$/, |
38
|
|
|
|
|
|
|
], |
39
|
|
|
|
|
|
|
subs => [ [ \&_legacy_patch_hsplit_rehash_510 ] ], |
40
|
|
|
|
|
|
|
}, |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub _legacy_patch_no_debugging { |
44
|
0
|
|
|
0
|
|
|
_patch(<<'END'); |
45
|
|
|
|
|
|
|
--- Configure |
46
|
|
|
|
|
|
|
+++ Configure |
47
|
|
|
|
|
|
|
@@ -4707,9 +4707,6 @@ |
48
|
|
|
|
|
|
|
case "$gccversion" in |
49
|
|
|
|
|
|
|
1*) dflt='-fpcc-struct-return' ;; |
50
|
|
|
|
|
|
|
esac |
51
|
|
|
|
|
|
|
- case "$optimize" in |
52
|
|
|
|
|
|
|
- *-g*) dflt="$dflt -DDEBUGGING";; |
53
|
|
|
|
|
|
|
- esac |
54
|
|
|
|
|
|
|
case "$gccversion" in |
55
|
|
|
|
|
|
|
2*) if test -d /etc/conf/kconfig.d && |
56
|
|
|
|
|
|
|
$contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1 |
57
|
|
|
|
|
|
|
END |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# http://perl5.git.perl.org/perl.git/commit/2674b61957c26a4924831d5110afa454ae7ae5a6 |
61
|
|
|
|
|
|
|
sub _legacy_patch_hsplit_rehash_58 |
62
|
|
|
|
|
|
|
{ |
63
|
0
|
|
|
0
|
|
|
my $perl = shift; |
64
|
0
|
0
|
|
|
|
|
return if $Devel::PatchPerl::VERSION >= 0.86; |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
|
my $patch = <<'END'; |
67
|
|
|
|
|
|
|
--- hv.c |
68
|
|
|
|
|
|
|
+++ hv.c |
69
|
|
|
|
|
|
|
@@ -31,7 +31,8 @@ holds the key and hash value. |
70
|
|
|
|
|
|
|
#define PERL_HASH_INTERNAL_ACCESS |
71
|
|
|
|
|
|
|
#include "perl.h" |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
-#define HV_MAX_LENGTH_BEFORE_SPLIT 14 |
74
|
|
|
|
|
|
|
+#define HV_MAX_LENGTH_BEFORE_REHASH 14 |
75
|
|
|
|
|
|
|
+#define SHOULD_DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */ |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
STATIC void |
78
|
|
|
|
|
|
|
S_more_he(pTHX) |
79
|
|
|
|
|
|
|
@@ -705,23 +706,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, |
80
|
|
|
|
|
|
|
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ |
81
|
|
|
|
|
|
|
if (!counter) { /* initial entry? */ |
82
|
|
|
|
|
|
|
xhv->xhv_fill++; /* HvFILL(hv)++ */ |
83
|
|
|
|
|
|
|
- } else if (xhv->xhv_keys > (IV)xhv->xhv_max) { |
84
|
|
|
|
|
|
|
+ } else if ( SHOULD_DO_HSPLIT(xhv) ) { |
85
|
|
|
|
|
|
|
hsplit(hv); |
86
|
|
|
|
|
|
|
- } else if(!HvREHASH(hv)) { |
87
|
|
|
|
|
|
|
- U32 n_links = 1; |
88
|
|
|
|
|
|
|
- |
89
|
|
|
|
|
|
|
- while ((counter = HeNEXT(counter))) |
90
|
|
|
|
|
|
|
- n_links++; |
91
|
|
|
|
|
|
|
- |
92
|
|
|
|
|
|
|
- if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) { |
93
|
|
|
|
|
|
|
- /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit |
94
|
|
|
|
|
|
|
- bucket splits on a rehashed hash, as we're not going to |
95
|
|
|
|
|
|
|
- split it again, and if someone is lucky (evil) enough to |
96
|
|
|
|
|
|
|
- get all the keys in one list they could exhaust our memory |
97
|
|
|
|
|
|
|
- as we repeatedly double the number of buckets on every |
98
|
|
|
|
|
|
|
- entry. Linear search feels a less worse thing to do. */ |
99
|
|
|
|
|
|
|
- hsplit(hv); |
100
|
|
|
|
|
|
|
- } |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
@@ -1048,7 +1034,7 @@ S_hsplit(pTHX_ HV *hv) |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
/* Pick your policy for "hashing isn't working" here: */ |
108
|
|
|
|
|
|
|
- if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked? */ |
109
|
|
|
|
|
|
|
+ if (longest_chain <= HV_MAX_LENGTH_BEFORE_REHASH /* split worked? */ |
110
|
|
|
|
|
|
|
|| HvREHASH(hv)) { |
111
|
|
|
|
|
|
|
return; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
@@ -1966,8 +1952,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) |
114
|
|
|
|
|
|
|
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ |
115
|
|
|
|
|
|
|
if (!next) { /* initial entry? */ |
116
|
|
|
|
|
|
|
xhv->xhv_fill++; /* HvFILL(hv)++ */ |
117
|
|
|
|
|
|
|
- } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) { |
118
|
|
|
|
|
|
|
- hsplit(PL_strtab); |
119
|
|
|
|
|
|
|
+ } else if ( SHOULD_DO_HSPLIT(xhv) ) { |
120
|
|
|
|
|
|
|
+ hsplit(PL_strtab); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
--- t/op/hash.t |
125
|
|
|
|
|
|
|
+++ t/op/hash.t |
126
|
|
|
|
|
|
|
@@ -39,22 +39,36 @@ use constant THRESHOLD => 14; |
127
|
|
|
|
|
|
|
use constant START => "a"; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# some initial hash data |
130
|
|
|
|
|
|
|
-my %h2 = map {$_ => 1} 'a'..'cc'; |
131
|
|
|
|
|
|
|
+my %h2; |
132
|
|
|
|
|
|
|
+my $counter= "a"; |
133
|
|
|
|
|
|
|
+$h2{$counter++}++ while $counter ne 'cd'; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
ok (!Internals::HvREHASH(%h2), |
136
|
|
|
|
|
|
|
"starting with pre-populated non-pathological hash (rehash flag if off)"); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
my @keys = get_keys(\%h2); |
139
|
|
|
|
|
|
|
+my $buckets= buckets(\%h2); |
140
|
|
|
|
|
|
|
$h2{$_}++ for @keys; |
141
|
|
|
|
|
|
|
+$h2{$counter++}++ while buckets(\%h2) == $buckets; # force a split |
142
|
|
|
|
|
|
|
ok (Internals::HvREHASH(%h2), |
143
|
|
|
|
|
|
|
- scalar(@keys) . " colliding into the same bucket keys are triggering rehash"); |
144
|
|
|
|
|
|
|
+ scalar(@keys) . " colliding into the same bucket keys are triggering rehash after split"); |
145
|
|
|
|
|
|
|
+ |
146
|
|
|
|
|
|
|
+# returns the number of buckets in a hash |
147
|
|
|
|
|
|
|
+sub buckets { |
148
|
|
|
|
|
|
|
+ my $hr = shift; |
149
|
|
|
|
|
|
|
+ my $keys_buckets= scalar(%$hr); |
150
|
|
|
|
|
|
|
+ if ($keys_buckets=~m!/([0-9]+)\z!) { |
151
|
|
|
|
|
|
|
+ return 0+$1; |
152
|
|
|
|
|
|
|
+ } else { |
153
|
|
|
|
|
|
|
+ return 8; |
154
|
|
|
|
|
|
|
+ } |
155
|
|
|
|
|
|
|
+} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub get_keys { |
158
|
|
|
|
|
|
|
my $hr = shift; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# the minimum of bits required to mount the attack on a hash |
161
|
|
|
|
|
|
|
my $min_bits = log(THRESHOLD)/log(2); |
162
|
|
|
|
|
|
|
- |
163
|
|
|
|
|
|
|
# if the hash has already been populated with a significant amount |
164
|
|
|
|
|
|
|
# of entries the number of mask bits can be higher |
165
|
|
|
|
|
|
|
my $keys = scalar keys %$hr; |
166
|
|
|
|
|
|
|
-- |
167
|
|
|
|
|
|
|
1.7.4.1 |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
END |
170
|
|
|
|
|
|
|
|
171
|
0
|
0
|
|
|
|
|
if ($perl =~ qr/^5\.8\.8$/) { |
172
|
0
|
|
|
|
|
|
$patch =~ s/non-pathological/non-pathalogical/; |
173
|
0
|
|
|
|
|
|
$patch =~ s/triggering/triggerring/; |
174
|
|
|
|
|
|
|
} |
175
|
0
|
|
|
|
|
|
_patch($patch); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# http://perl5.git.perl.org/perl.git/commit/f14269908e5f8b4cab4b55643d7dd9de577e7918 |
179
|
|
|
|
|
|
|
# http://perl5.git.perl.org/perl.git/commit/9d83adcdf9ab3c1ac7d54d76f3944e57278f0e70 |
180
|
|
|
|
|
|
|
sub _legacy_patch_hsplit_rehash_510 { |
181
|
0
|
0
|
|
0
|
|
|
return if $Devel::PatchPerl::VERSION >= 0.86; |
182
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
_patch(<<'END'); |
184
|
|
|
|
|
|
|
--- ext/Hash-Util-FieldHash/t/10_hash.t |
185
|
|
|
|
|
|
|
+++ ext/Hash-Util-FieldHash/t/10_hash.t |
186
|
|
|
|
|
|
|
@@ -46,15 +46,29 @@ use constant START => "a"; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# some initial hash data |
189
|
|
|
|
|
|
|
fieldhash my %h2; |
190
|
|
|
|
|
|
|
-%h2 = map {$_ => 1} 'a'..'cc'; |
191
|
|
|
|
|
|
|
+my $counter= "a"; |
192
|
|
|
|
|
|
|
+$h2{$counter++}++ while $counter ne 'cd'; |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
ok (!Internals::HvREHASH(%h2), |
195
|
|
|
|
|
|
|
"starting with pre-populated non-pathological hash (rehash flag if off)"); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
my @keys = get_keys(\%h2); |
198
|
|
|
|
|
|
|
+my $buckets= buckets(\%h2); |
199
|
|
|
|
|
|
|
$h2{$_}++ for @keys; |
200
|
|
|
|
|
|
|
+$h2{$counter++}++ while buckets(\%h2) == $buckets; # force a split |
201
|
|
|
|
|
|
|
ok (Internals::HvREHASH(%h2), |
202
|
|
|
|
|
|
|
- scalar(@keys) . " colliding into the same bucket keys are triggering rehash"); |
203
|
|
|
|
|
|
|
+ scalar(@keys) . " colliding into the same bucket keys are triggering rehash after split"); |
204
|
|
|
|
|
|
|
+ |
205
|
|
|
|
|
|
|
+# returns the number of buckets in a hash |
206
|
|
|
|
|
|
|
+sub buckets { |
207
|
|
|
|
|
|
|
+ my $hr = shift; |
208
|
|
|
|
|
|
|
+ my $keys_buckets= scalar(%$hr); |
209
|
|
|
|
|
|
|
+ if ($keys_buckets=~m!/([0-9]+)\z!) { |
210
|
|
|
|
|
|
|
+ return 0+$1; |
211
|
|
|
|
|
|
|
+ } else { |
212
|
|
|
|
|
|
|
+ return 8; |
213
|
|
|
|
|
|
|
+ } |
214
|
|
|
|
|
|
|
+} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub get_keys { |
217
|
|
|
|
|
|
|
my $hr = shift; |
218
|
|
|
|
|
|
|
--- hv.c |
219
|
|
|
|
|
|
|
+++ hv.c |
220
|
|
|
|
|
|
|
@@ -35,7 +35,8 @@ holds the key and hash value. |
221
|
|
|
|
|
|
|
#define PERL_HASH_INTERNAL_ACCESS |
222
|
|
|
|
|
|
|
#include "perl.h" |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
-#define HV_MAX_LENGTH_BEFORE_SPLIT 14 |
225
|
|
|
|
|
|
|
+#define HV_MAX_LENGTH_BEFORE_REHASH 14 |
226
|
|
|
|
|
|
|
+#define SHOULD_DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */ |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
static const char S_strtab_error[] |
229
|
|
|
|
|
|
|
= "Cannot modify shared string table in hv_%s"; |
230
|
|
|
|
|
|
|
@@ -818,23 +819,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, |
231
|
|
|
|
|
|
|
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ |
232
|
|
|
|
|
|
|
if (!counter) { /* initial entry? */ |
233
|
|
|
|
|
|
|
xhv->xhv_fill++; /* HvFILL(hv)++ */ |
234
|
|
|
|
|
|
|
- } else if (xhv->xhv_keys > (IV)xhv->xhv_max) { |
235
|
|
|
|
|
|
|
+ } else if ( SHOULD_DO_HSPLIT(xhv) ) { |
236
|
|
|
|
|
|
|
hsplit(hv); |
237
|
|
|
|
|
|
|
- } else if(!HvREHASH(hv)) { |
238
|
|
|
|
|
|
|
- U32 n_links = 1; |
239
|
|
|
|
|
|
|
- |
240
|
|
|
|
|
|
|
- while ((counter = HeNEXT(counter))) |
241
|
|
|
|
|
|
|
- n_links++; |
242
|
|
|
|
|
|
|
- |
243
|
|
|
|
|
|
|
- if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) { |
244
|
|
|
|
|
|
|
- /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit |
245
|
|
|
|
|
|
|
- bucket splits on a rehashed hash, as we're not going to |
246
|
|
|
|
|
|
|
- split it again, and if someone is lucky (evil) enough to |
247
|
|
|
|
|
|
|
- get all the keys in one list they could exhaust our memory |
248
|
|
|
|
|
|
|
- as we repeatedly double the number of buckets on every |
249
|
|
|
|
|
|
|
- entry. Linear search feels a less worse thing to do. */ |
250
|
|
|
|
|
|
|
- hsplit(hv); |
251
|
|
|
|
|
|
|
- } |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
@@ -1180,7 +1166,7 @@ S_hsplit(pTHX_ HV *hv) |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
/* Pick your policy for "hashing isn't working" here: */ |
259
|
|
|
|
|
|
|
- if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked? */ |
260
|
|
|
|
|
|
|
+ if (longest_chain <= HV_MAX_LENGTH_BEFORE_REHASH /* split worked? */ |
261
|
|
|
|
|
|
|
|| HvREHASH(hv)) { |
262
|
|
|
|
|
|
|
return; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
@@ -2506,8 +2492,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) |
265
|
|
|
|
|
|
|
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ |
266
|
|
|
|
|
|
|
if (!next) { /* initial entry? */ |
267
|
|
|
|
|
|
|
xhv->xhv_fill++; /* HvFILL(hv)++ */ |
268
|
|
|
|
|
|
|
- } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) { |
269
|
|
|
|
|
|
|
- hsplit(PL_strtab); |
270
|
|
|
|
|
|
|
+ } else if ( SHOULD_DO_HSPLIT(xhv) ) { |
271
|
|
|
|
|
|
|
+ hsplit(PL_strtab); |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
diff --git a/t/op/hash.t b/t/op/hash.t |
276
|
|
|
|
|
|
|
index 9bde518..45eb782 100644 |
277
|
|
|
|
|
|
|
--- t/op/hash.t |
278
|
|
|
|
|
|
|
+++ t/op/hash.t |
279
|
|
|
|
|
|
|
@@ -39,22 +39,36 @@ use constant THRESHOLD => 14; |
280
|
|
|
|
|
|
|
use constant START => "a"; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# some initial hash data |
283
|
|
|
|
|
|
|
-my %h2 = map {$_ => 1} 'a'..'cc'; |
284
|
|
|
|
|
|
|
+my %h2; |
285
|
|
|
|
|
|
|
+my $counter= "a"; |
286
|
|
|
|
|
|
|
+$h2{$counter++}++ while $counter ne 'cd'; |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
ok (!Internals::HvREHASH(%h2), |
289
|
|
|
|
|
|
|
"starting with pre-populated non-pathological hash (rehash flag if off)"); |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
my @keys = get_keys(\%h2); |
292
|
|
|
|
|
|
|
+my $buckets= buckets(\%h2); |
293
|
|
|
|
|
|
|
$h2{$_}++ for @keys; |
294
|
|
|
|
|
|
|
+$h2{$counter++}++ while buckets(\%h2) == $buckets; # force a split |
295
|
|
|
|
|
|
|
ok (Internals::HvREHASH(%h2), |
296
|
|
|
|
|
|
|
- scalar(@keys) . " colliding into the same bucket keys are triggering rehash"); |
297
|
|
|
|
|
|
|
+ scalar(@keys) . " colliding into the same bucket keys are triggering rehash after split"); |
298
|
|
|
|
|
|
|
+ |
299
|
|
|
|
|
|
|
+# returns the number of buckets in a hash |
300
|
|
|
|
|
|
|
+sub buckets { |
301
|
|
|
|
|
|
|
+ my $hr = shift; |
302
|
|
|
|
|
|
|
+ my $keys_buckets= scalar(%$hr); |
303
|
|
|
|
|
|
|
+ if ($keys_buckets=~m!/([0-9]+)\z!) { |
304
|
|
|
|
|
|
|
+ return 0+$1; |
305
|
|
|
|
|
|
|
+ } else { |
306
|
|
|
|
|
|
|
+ return 8; |
307
|
|
|
|
|
|
|
+ } |
308
|
|
|
|
|
|
|
+} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub get_keys { |
311
|
|
|
|
|
|
|
my $hr = shift; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# the minimum of bits required to mount the attack on a hash |
314
|
|
|
|
|
|
|
my $min_bits = log(THRESHOLD)/log(2); |
315
|
|
|
|
|
|
|
- |
316
|
|
|
|
|
|
|
# if the hash has already been populated with a significant amount |
317
|
|
|
|
|
|
|
# of entries the number of mask bits can be higher |
318
|
|
|
|
|
|
|
my $keys = scalar keys %$hr; |
319
|
|
|
|
|
|
|
-- |
320
|
|
|
|
|
|
|
1.7.4.1 |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
END |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
1; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
__END__ |