perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From steve...@apache.org
Subject svn commit: r1457619 - in /perl/modperl/trunk: Changes t/response/TestPerl/hash_attack.pm
Date Mon, 18 Mar 2013 02:07:51 GMT
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.



Mime
View raw message