Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm
Precedence: bulk
Reply-To: dev@perl.apache.org
Date: 3 Nov 2003 09:29:50 -0000
Message-ID: <20031103092950.53274.qmail@minotaur.apache.org>
From: stas@apache.org
To: modperl-2.0-cvs@apache.org
Subject: cvs commit: modperl-2.0 Changes

stas        2003/11/03 01:29:50

  Modified:    src/modules/perl mod_perl.c modperl_perl_includes.h
                        modperl_util.c
               .        Changes
  Added:       t/perl   hash_attack.t
               t/response/TestPerl hash_attack.pm
  Log:
  Adjust the source to properly work with 5.8.2's new algorithm of dynamic
  re-hashing of hashes on hash collision attack. Add a test that mounts such
  an attack so we can verify that we can survive this rehashing.
  
  Revision  Changes    Path
  1.202     +7 -2      modperl-2.0/src/modules/perl/mod_perl.c
  
  Index: mod_perl.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
  retrieving revision 1.201
  retrieving revision 1.202
  diff -u -u -r1.201 -r1.202
  --- mod_perl.c	23 Oct 2003 05:57:46 -0000	1.201
  +++ mod_perl.c	3 Nov 2003 09:29:49 -0000	1.202
  @@ -68,8 +68,13 @@
   {
   #ifdef MP_NEED_HASH_SEED_FIXUP
       if (MP_init_hash_seed_set) {
  -        PL_hash_seed_set = TRUE;
  -        PL_hash_seed = MP_init_hash_seed;
  +#if PERL_REVISION == 5 && PERL_VERSION == 8 && PERL_SUBVERSION == 1
  +        PL_hash_seed       = MP_init_hash_seed;
  +        PL_hash_seed_set   = MP_init_hash_seed_set;
  +#else
  +        PL_rehash_seed     = MP_init_hash_seed;
  +        PL_rehash_seed_set = MP_init_hash_seed_set;
  +#endif
       }
   #endif
   }
  
  
  
  1.18      +4 -0      modperl-2.0/src/modules/perl/modperl_perl_includes.h
  
  Index: modperl_perl_includes.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_includes.h,v
  retrieving revision 1.17
  retrieving revision 1.18
  diff -u -u -r1.17 -r1.18
  --- modperl_perl_includes.h	25 Nov 2002 01:31:00 -0000	1.17
  +++ modperl_perl_includes.h	3 Nov 2003 09:29:49 -0000	1.18
  @@ -42,6 +42,10 @@
   #   endif
   #endif
   
  +/* needed starting from 5.8.2 to access the PERL_HASH_INTERNAL macro
  + * in hv.h. we use it in modperl_util.c */
  +#define PERL_HASH_INTERNAL_ACCESS
  +
   #include "EXTERN.h"
   #include "perl.h"
   #include "XSUB.h"
  
  
  
  1.56      +6 -0      modperl-2.0/src/modules/perl/modperl_util.c
  
  Index: modperl_util.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
  retrieving revision 1.55
  retrieving revision 1.56
  diff -u -u -r1.55 -r1.56
  --- modperl_util.c	9 Oct 2003 23:56:52 -0000	1.55
  +++ modperl_util.c	3 Nov 2003 09:29:49 -0000	1.56
  @@ -473,6 +473,12 @@
           return 0;
       }
   
  +#ifdef HvREHASH
  +    if (HvREHASH(hv)) {
  +	PERL_HASH_INTERNAL(hash, key, klen);
  +    }
  +    else
  +#endif
       if (!hash) {
   	PERL_HASH(hash, key, klen);
       }
  
  
  
  1.1                  modperl-2.0/t/perl/hash_attack.t
  
  Index: hash_attack.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestTrace;
  
  use Apache::TestRequest 'GET_BODY_ASSERT';
  
  plan tests => 1, 
      have { "relevant only for perl 5.8.2 and higher" => ($] >= 5.008002) };
  
  my $expected = "ok";
  my $received = GET_BODY_ASSERT "/TestPerl__hash_attack";
  ok($expected eq $received);
  
  
  
  1.1                  modperl-2.0/t/response/TestPerl/hash_attack.pm
  
  Index: hash_attack.pm
  ===================================================================
  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_SPLIT keys
  # find themselves in the same hash bucket, 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 Apache::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
  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;
  
      return Apache::DECLINED;
  }
  
  sub fixup { return Apache::OK; }
  sub handler {
      my $r = shift;
      $r->print("ok");
      return Apache::OK;
  }
  
  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 = int($bits) < $bits ? int($bits) + 1 : int($bits);
      # need to add 2 bits to cover the internal split cases
      $bits += 2;
      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, %10s, %s", $c, $s, $h, scalar(%$stash);
          push @keys, $s;
          debug "The hash collision attack has been successful" 
              if Internals::HvREHASH(%$stash);
      } continue {
          $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;
  }
  
  # 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 = 0;
      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
  
  
  
  
  1.243     +7 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.242
  retrieving revision 1.243
  diff -u -u -r1.242 -r1.243
  --- Changes	20 Oct 2003 19:58:56 -0000	1.242
  +++ Changes	3 Nov 2003 09:29:50 -0000	1.243
  @@ -12,6 +12,13 @@
   
   =item 1.99_11-dev - 
   
  +Adjust the source to properly work with 5.8.2's new algorithm of
  +dynamic re-hashing of hashes on hash collision attack. [Nicholas Clark
  +<nick@ccl4.org>, Stas]. Add a test that mounts such an attack so we
  +can verify that we can survive this rehashing. [Scott A Crosby
  +<scrosby@cs.rice.edu>, Nicholas Clark <nick@ccl4.org>, Tels
  +<perl_dummy@bloodgate.com>, Mark Jason Dominus <mjd@plover.com>, Stas]
  +
   Standardize the Apache::PerlSections package name to it's plural form for
   clarity and so that the pod gets glued in it's proper place.
   [Philippe M. Chiasson <gozer@cpan.org>]