Permalink
Browse files

Perl 5.16.3's fix for a rehash-based DoS makes it more difficult to i…

…nvoke the workaround for the old hash collision attack, which breaks mod_perl's t/perl/hash_attack.t. Patch from rt.cpan.org #83916 improves the fix previously applied as revision 1455340. [Zefram]

Tested by the committer on Windows 7 x64 using Perls 5.8.1, 5.8.2 (VC++ 6.0), 5.10.1, 5.12.5 (VC++ 2008), 5.14.2, 5.16.3, 5.17.5, 5.17.6 and 5.17.9 (VC++ 2010), all against Apache 2.2.22.

git-svn-id: https://svn.apache.org/repos/asf/perl/modperl/trunk@1457619 13f79535-47bb-0310-9956-ffa450edef68
  • Loading branch information...
1 parent 466c39f commit 5af64d7160200b4fe42c78814b8bc6e6f646c1eb Steve Hay committed Mar 18, 2013
Showing with 25 additions and 8 deletions.
  1. +5 −0 Changes
  2. +20 −8 t/response/TestPerl/hash_attack.pm
View
@@ -12,6 +12,11 @@ Also refer to the Apache::Test changes log file, at Apache-Test/Changes
=item 2.0.8-dev
+Perl 5.16.3's fix for a rehash-based DoS makes it more difficult to invoke
+the workaround for the old hash collision attack, which breaks mod_perl's
+t/perl/hash_attack.t. Patch from rt.cpan.org #83916 improves the fix
+previously applied as revision 1455340. [Zefram]
+
On Perl 5.17.6 and above, hash seeding has changed, and HvREHASH has
disappeared. Patch to update mod_perl accordingly from rt.cpan.org #83921.
[Zefram]
@@ -30,7 +30,7 @@ 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_REHASH
+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
@@ -58,6 +58,8 @@ sub handler {
return Apache2::Const::OK;
}
+sub buckets { scalar(%{$_[0]}) =~ m#/([0-9]+)\z# ? 0+$1 : 8 }
+
sub attack {
my $stash = shift;
@@ -99,13 +101,23 @@ sub attack {
$s++;
}
- # Now add more keys until we reach a power of 2, to force the number
- # of buckets to be doubled (at which point the longest chain is checked).
- $keys = scalar keys %$stash;
- $bits = log($keys)/log(2);
- my $limit = 2 ** ceil($bits);
- debug "pad keys from $keys to $limit";
- $stash->{$s++}++ while keys(%$stash) <= $limit;
+ # 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.

0 comments on commit 5af64d7

Please sign in to comment.