Author: stevehay Date: Mon Mar 18 02:07:50 2013 New Revision: 1457619 URL: http://svn.apache.org/r1457619 Log: 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] 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.
Modified: perl/modperl/trunk/Changes perl/modperl/trunk/t/response/TestPerl/hash_attack.pm Modified: perl/modperl/trunk/Changes URL: http://svn.apache.org/viewvc/perl/modperl/trunk/Changes?rev=1457619&r1=1457618&r2=1457619&view=diff ============================================================================== --- perl/modperl/trunk/Changes (original) +++ perl/modperl/trunk/Changes Mon Mar 18 02:07:50 2013 @@ -12,6 +12,11 @@ Also refer to the Apache::Test changes l =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] Modified: perl/modperl/trunk/t/response/TestPerl/hash_attack.pm URL: http://svn.apache.org/viewvc/perl/modperl/trunk/t/response/TestPerl/hash_attack.pm?rev=1457619&r1=1457618&r2=1457619&view=diff ============================================================================== --- perl/modperl/trunk/t/response/TestPerl/hash_attack.pm (original) +++ perl/modperl/trunk/t/response/TestPerl/hash_attack.pm Mon Mar 18 02:07:50 2013 @@ -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.