In perl.git, the branch yves/hv_h_split has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c2669ab8fb2498011780806aa2073f809a3d61ab?hp=f06d65f6bfe67affa8060b7efaecb108f57ceed8>
- Log ----------------------------------------------------------------- commit c2669ab8fb2498011780806aa2073f809a3d61ab Author: Yves Orton <[email protected]> Date: Mon Feb 18 08:11:18 2013 +0100 Enable hash traversal order randomization This patch causes Perl to use a random order per hash when traversing hashes via keys(), values() and each(). The random order is determined by add a new property xhv_rand to struct xpvhv. This property is calculated on per traverse of the hash by using a pointer/integer hash function on the address of the bucket array, and then XORing it with the bucket index counter during traverse. This causes each hash to have a different order for traversing the buckets. The purpose of this change is to make hash seed discovery attacks harder. An attacker loses a lot of information when the keys are "randomized". M hv.c M hv.h M t/op/smartkve.t commit 9e7b62a91521411e68934310e57f7737119c45ef Author: Yves Orton <[email protected]> Date: Mon Feb 18 07:56:25 2013 +0100 Fix test fails due to hash traversal randomization One cannot assume two hashes with the same keys will have the the same key order. And after hash traversal randomization one can assume they WONT. M cpan/Pod-Simple/t/closeys.t commit 3de8f6566a419504551f35063c2bfeb560ac019b Author: Yves Orton <[email protected]> Date: Mon Feb 18 06:37:29 2013 +0100 Fix tests that fail due to hash traversal randomization One cannot assume two hashes with the same keys will have the the same key order. And after hash traversal randomization one can assume they WONT. M cpan/JSON-PP/t/019_incr.t commit d6998a16edfcd657911312b7a2b5ec7ca27cab42 Author: Yves Orton <[email protected]> Date: Sun Feb 17 16:39:23 2013 +0100 Fix failing porting tests by bumping version number and tweaking pod M ext/Hash-Util/lib/Hash/Util.pm ----------------------------------------------------------------------- Summary of changes: cpan/JSON-PP/t/019_incr.t | 13 ++++---- cpan/Pod-Simple/t/closeys.t | 1 + ext/Hash-Util/lib/Hash/Util.pm | 8 +++-- hv.c | 30 +++++++++++++++++++- hv.h | 2 + t/op/smartkve.t | 61 ++++++++++++++++++++++++++++------------ 6 files changed, 86 insertions(+), 29 deletions(-) diff --git a/cpan/JSON-PP/t/019_incr.t b/cpan/JSON-PP/t/019_incr.t index c5fab96..dc84c55 100644 --- a/cpan/JSON-PP/t/019_incr.t +++ b/cpan/JSON-PP/t/019_incr.t @@ -13,11 +13,13 @@ use JSON::PP; if ( $] >= 5.006 ) { -eval <<'TEST'; +eval <<'TEST' or die "Failed to eval test code for version $]: $@"; sub splitter { my ($coder, $text) = @_; + $coder->canonical(1) if $] >= 5.017009; + for (0 .. length $text) { my $a = substr $text, 0, $_; my $b = substr $text, $_; @@ -27,7 +29,7 @@ sub splitter { my $data = $coder->incr_parse; ok ($data); - ok ($coder->encode ($data) eq $coder->encode ($coder->decode ($text)), "data"); + is ($coder->encode ($data), $coder->encode ($coder->decode ($text)), "data"); ok ($coder->incr_text =~ /^\s*$/, "tailws"); } } @@ -75,16 +77,15 @@ splitter +JSON::PP->new->allow_nonref, ' "5" '; ok ('[5]' eq $coder->encode (scalar $coder->incr_parse), "sparse3"); } - +1 TEST -print $@; } else { -eval <<'TEST'; +eval <<'TEST' or die "Failed to eval test code for version $]: $@"; my $incr_text; @@ -148,8 +149,6 @@ splitter +JSON::PP->new->allow_nonref, ' "5" '; TEST -print $@; - } # for 5.005 diff --git a/cpan/Pod-Simple/t/closeys.t b/cpan/Pod-Simple/t/closeys.t index 683ce13..0adf05a 100644 --- a/cpan/Pod-Simple/t/closeys.t +++ b/cpan/Pod-Simple/t/closeys.t @@ -24,6 +24,7 @@ sub nowhine { # $_[0]->{'no_whining'} = 1; $_[0]->accept_targets("*"); } +local $Pod::Simple::XMLOutStream::SORT_ATTRS= 1; &ok(e( "=begin :foo\n\n=begin :bar\n\nZaz\n\n", diff --git a/ext/Hash-Util/lib/Hash/Util.pm b/ext/Hash-Util/lib/Hash/Util.pm index c6ced75..050f926 100644 --- a/ext/Hash-Util/lib/Hash/Util.pm +++ b/ext/Hash-Util/lib/Hash/Util.pm @@ -32,7 +32,7 @@ our @EXPORT_OK = qw( bucket_stats bucket_info bucket_array lock_hash_recurse unlock_hash_recurse ); -our $VERSION = '0.14'; +our $VERSION = '0.15'; require XSLoader; XSLoader::load(); @@ -540,8 +540,10 @@ close to and below 1 indicate good hashing, and number significantly above indicate a poor score. In practice it should be around 0.95 to 1.05. It is defined as: - $score= sum( $count[$length] * ($length * ($length + 1) / 2) ) / - ( ( $keys / 2 * $buckets ) * ( $keys + ( 2 * $buckets ) - 1 ) ) + $score= sum( $count[$length] * ($length * ($length + 1) / 2) ) + / + ( ( $keys / 2 * $buckets ) * + ( $keys + ( 2 * $buckets ) - 1 ) ) The formula is from the Red Dragon book (reformulated to use the data available) and is documented at L<http://www.strchr.com/hash_functions> diff --git a/hv.c b/hv.c index 5f7ae85..98be634 100644 --- a/hv.c +++ b/hv.c @@ -1831,6 +1831,34 @@ S_hv_auxinit(HV *hv) { Renew(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1) + sizeof(struct xpvhv_aux), char); } + if (!HvRAND(hv)) { + PTRV u= (PTRV)array; +#if PTRSIZE == 8 + /* + * This is one of Thomas Wang's hash functions for 64-bit integers from: + * http://www.concentric.net/~Ttwang/tech/inthash.htm + */ + u = (~u) + (u << 18); + u = u ^ (u >> 31); + u = u * 21; + u = u ^ (u >> 11); + u = u + (u << 6); + u = u ^ (u >> 22); +#else + /* + * This is one of Bob Jenkins' hash functions for 32-bit integers + * from: http://burtleburtle.net/bob/hash/integer.html + */ + u = (u + 0x7ed55d16) + (u << 12); + u = (u ^ 0xc761c23c) ^ (u >> 19); + u = (u + 0x165667b1) + (u << 5); + u = (u + 0xd3a2646c) ^ (u << 9); + u = (u + 0xfd7046c5) + (u << 3); + u = (u ^ 0xb55a4f09) ^ (u >> 16); +#endif + HvRAND(hv)= (U32)u; + } + HvARRAY(hv) = (HE**) array; SvOOK_on(hv); iter = HvAUX(hv); @@ -2351,7 +2379,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ break; } - entry = (HvARRAY(hv))[iter->xhv_riter]; + entry = (HvARRAY(hv))[(iter->xhv_riter ^ xhv->xhv_rand) & xhv->xhv_max]; if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { /* If we have an entry, but it's a placeholder, don't count it. diff --git a/hv.h b/hv.h index dddeb02..ebd6ca5 100644 --- a/hv.h +++ b/hv.h @@ -101,6 +101,7 @@ struct xpvhv { union _xmgu xmg_u; STRLEN xhv_keys; /* total keys, including placeholders */ STRLEN xhv_max; /* subscript of last element of xhv_array */ + U32 xhv_rand; /* random value for hash traversal */ }; /* @@ -214,6 +215,7 @@ C<SV*>. #define HvARRAY(hv) ((hv)->sv_u.svu_hash) #define HvFILL(hv) Perl_hv_fill(aTHX_ (const HV *)(hv)) #define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max +#define HvRAND(hv) ((XPVHV*) SvANY(hv))->xhv_rand /* This quite intentionally does no flag checking first. That's your responsibility. */ #define HvAUX(hv) ((struct xpvhv_aux*)&(HvARRAY(hv)[HvMAX(hv)+1])) diff --git a/t/op/smartkve.t b/t/op/smartkve.t index 7e5d67e..abd6abf 100644 --- a/t/op/smartkve.t +++ b/t/op/smartkve.t @@ -23,12 +23,19 @@ sub j { join(":",@_) } # match the inserted order. So we declare one hash # and then make all our copies from that, which should # mean all the copies have the same internal structure. +# +# And these days, even if all that weren't true, we now +# per-hash randomize keys/values. So, we cant expect two +# hashes with the same internal structure to return the +# same thing at all. All we *can* expect is that keys() +# and values() use the same ordering. our %base_hash; BEGIN { # in BEGIN for "use constant ..." later - %base_hash= ( pi => 3.14, e => 2.72, i => -1 ); + # values match keys here so we can easily check that keys(%hash) == values(%hash) + %base_hash= ( pi => 'pi', e => 'e', i => 'i' ); $array = [ qw(pi e i) ]; - $values = [ 3.14, 2.72, -1 ]; + $values = [ qw(pi e i) ]; $hash = { %base_hash } ; $data = { hash => { %base_hash }, @@ -118,16 +125,25 @@ is(keys $obj->array ,3, 'Scalar: keys $obj->array'); # Keys -- list -$h_expect = j(keys %$hash); +$h_expect = j(sort keys %base_hash); $a_expect = j(keys @$array); -is(j(keys $hash) ,$h_expect, 'List: keys $hash'); -is(j(keys $data->{hash}) ,$h_expect, 'List: keys $data->{hash}'); -is(j(keys CONST_HASH) ,$h_expect, 'List: keys CONST_HASH'); -is(j(keys CONST_HASH()) ,$h_expect, 'List: keys CONST_HASH()'); -is(j(keys hash_sub) ,$h_expect, 'List: keys hash_sub'); -is(j(keys hash_sub()) ,$h_expect, 'List: keys hash_sub()'); -is(j(keys $obj->hash) ,$h_expect, 'List: keys $obj->hash'); +is(j(sort keys $hash) ,$h_expect, 'List: sort keys $hash'); +is(j(sort keys $data->{hash}) ,$h_expect, 'List: sort keys $data->{hash}'); +is(j(sort keys CONST_HASH) ,$h_expect, 'List: sort keys CONST_HASH'); +is(j(sort keys CONST_HASH()) ,$h_expect, 'List: sort keys CONST_HASH()'); +is(j(sort keys hash_sub) ,$h_expect, 'List: sort keys hash_sub'); +is(j(sort keys hash_sub()) ,$h_expect, 'List: sort keys hash_sub()'); +is(j(sort keys $obj->hash) ,$h_expect, 'List: sort keys $obj->hash'); + +is(j(keys $hash) ,j(values $hash), 'List: keys $hash == values $hash'); +is(j(keys $data->{hash}) ,j(values $data->{hash}), 'List: keys $data->{hash} == values $data->{hash}'); +is(j(keys CONST_HASH) ,j(values CONST_HASH), 'List: keys CONST_HASH == values CONST_HASH'); +is(j(keys CONST_HASH()) ,j(values CONST_HASH()), 'List: keys CONST_HASH() == values CONST_HASH()'); +is(j(keys hash_sub) ,j(values hash_sub), 'List: keys hash_sub == values hash_sub'); +is(j(keys hash_sub()) ,j(values hash_sub()), 'List: keys hash_sub() == values hash_sub()'); +is(j(keys $obj->hash) ,j(values $obj->hash), 'List: keys $obj->hash == values obj->hash'); + is(j(keys $array) ,$a_expect, 'List: keys $array'); is(j(keys $data->{array}) ,$a_expect, 'List: keys $data->{array}'); is(j(keys CONST_ARRAY) ,$a_expect, 'List: keys CONST_ARRAY'); @@ -221,16 +237,25 @@ is(values $obj->array ,3, 'Scalar: values $obj->array'); # Values -- list -$h_expect = j(values %$hash); +$h_expect = j(sort values %base_hash); $a_expect = j(values @$array); -is(j(values $hash) ,$h_expect, 'List: values $hash'); -is(j(values $data->{hash}) ,$h_expect, 'List: values $data->{hash}'); -is(j(values CONST_HASH) ,$h_expect, 'List: values CONST_HASH'); -is(j(values CONST_HASH()) ,$h_expect, 'List: values CONST_HASH()'); -is(j(values hash_sub) ,$h_expect, 'List: values hash_sub'); -is(j(values hash_sub()) ,$h_expect, 'List: values hash_sub()'); -is(j(values $obj->hash) ,$h_expect, 'List: values $obj->hash'); +is(j(sort values $hash) ,$h_expect, 'List: sort values $hash'); +is(j(sort values $data->{hash}) ,$h_expect, 'List: sort values $data->{hash}'); +is(j(sort values CONST_HASH) ,$h_expect, 'List: sort values CONST_HASH'); +is(j(sort values CONST_HASH()) ,$h_expect, 'List: sort values CONST_HASH()'); +is(j(sort values hash_sub) ,$h_expect, 'List: sort values hash_sub'); +is(j(sort values hash_sub()) ,$h_expect, 'List: sort values hash_sub()'); +is(j(sort values $obj->hash) ,$h_expect, 'List: sort values $obj->hash'); + +is(j(values $hash) ,j(keys $hash), 'List: values $hash == keys $hash'); +is(j(values $data->{hash}) ,j(keys $data->{hash}), 'List: values $data->{hash} == keys $data->{hash}'); +is(j(values CONST_HASH) ,j(keys CONST_HASH), 'List: values CONST_HASH == keys CONST_HASH'); +is(j(values CONST_HASH()) ,j(keys CONST_HASH()), 'List: values CONST_HASH() == keys CONST_HASH()'); +is(j(values hash_sub) ,j(keys hash_sub), 'List: values hash_sub == keys hash_sub'); +is(j(values hash_sub()) ,j(keys hash_sub()), 'List: values hash_sub() == keys hash_sub()'); +is(j(values $obj->hash) ,j(keys $obj->hash), 'List: values $obj->hash == keys $obj->hash'); + is(j(values $array) ,$a_expect, 'List: values $array'); is(j(values $data->{array}) ,$a_expect, 'List: values $data->{array}'); is(j(values CONST_ARRAY) ,$a_expect, 'List: values CONST_ARRAY'); -- Perl5 Master Repository
