This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Warn more about disclosing the hash seed, from Scott A. Crosby.
[perl5.git] / lib / Hash / Util.pm
CommitLineData
49293501
MS
1package Hash::Util;
2
3require 5.007003;
4use strict;
49293501
MS
5use Carp;
6
7require Exporter;
8our @ISA = qw(Exporter);
9our @EXPORT_OK = qw(lock_keys unlock_keys lock_value unlock_value
9a7034eb 10 lock_hash unlock_hash hash_seed
49293501 11 );
2af1ab88 12our $VERSION = 0.05;
49293501 13
49293501
MS
14=head1 NAME
15
16Hash::Util - A selection of general-utility hash subroutines
17
18=head1 SYNOPSIS
19
0082b4c8 20 use Hash::Util qw(lock_keys unlock_keys
49293501 21 lock_value unlock_value
c910b28a 22 lock_hash unlock_hash
9a7034eb 23 hash_seed);
49293501
MS
24
25 %hash = (foo => 42, bar => 23);
26 lock_keys(%hash);
27 lock_keys(%hash, @keyset);
28 unlock_keys(%hash);
29
30 lock_value (%hash, 'foo');
31 unlock_value(%hash, 'foo');
32
33 lock_hash (%hash);
34 unlock_hash(%hash);
35
9a7034eb 36 my $hashes_are_randomised = hash_seed() != 0;
c910b28a 37
49293501
MS
38=head1 DESCRIPTION
39
40C<Hash::Util> contains special functions for manipulating hashes that
41don't really warrant a keyword.
42
43By default C<Hash::Util> does not export anything.
44
45=head2 Restricted hashes
46
475.8.0 introduces the ability to restrict a hash to a certain set of
48keys. No keys outside of this set can be added. It also introduces
49the ability to lock an individual key so it cannot be deleted and the
50value cannot be changed.
51
52This is intended to largely replace the deprecated pseudo-hashes.
53
54=over 4
55
56=item lock_keys
57
58=item unlock_keys
59
60 lock_keys(%hash);
61 lock_keys(%hash, @keys);
62
49293501
MS
63Restricts the given %hash's set of keys to @keys. If @keys is not
64given it restricts it to its current keyset. No more keys can be
641c4430
A
65added. delete() and exists() will still work, but will not alter
66the set of allowed keys. B<Note>: the current implementation prevents
67the hash from being bless()ed while it is in a locked state. Any attempt
68to do so will raise an exception. Of course you can still bless()
69the hash before you call lock_keys() so this shouldn't be a problem.
49293501 70
0082b4c8 71 unlock_keys(%hash);
7767c512 72
49293501
MS
73Removes the restriction on the %hash's keyset.
74
75=cut
76
77sub lock_keys (\%;@) {
78 my($hash, @keys) = @_;
79
dfd4ef2f 80 Internals::hv_clear_placeholders %$hash;
49293501
MS
81 if( @keys ) {
82 my %keys = map { ($_ => 1) } @keys;
83 my %original_keys = map { ($_ => 1) } keys %$hash;
84 foreach my $k (keys %original_keys) {
85 die sprintf "Hash has key '$k' which is not in the new key ".
86 "set at %s line %d\n", (caller)[1,2]
87 unless $keys{$k};
88 }
89
90 foreach my $k (@keys) {
91 $hash->{$k} = undef unless exists $hash->{$k};
92 }
29569577 93 Internals::SvREADONLY %$hash, 1;
49293501
MS
94
95 foreach my $k (@keys) {
96 delete $hash->{$k} unless $original_keys{$k};
97 }
98 }
99 else {
29569577 100 Internals::SvREADONLY %$hash, 1;
49293501
MS
101 }
102
95d43b76 103 return;
49293501
MS
104}
105
106sub unlock_keys (\%) {
107 my($hash) = shift;
108
29569577 109 Internals::SvREADONLY %$hash, 0;
95d43b76 110 return;
49293501
MS
111}
112
113=item lock_value
114
115=item unlock_value
116
0082b4c8
SR
117 lock_value (%hash, $key);
118 unlock_value(%hash, $key);
49293501
MS
119
120Locks and unlocks an individual key of a hash. The value of a locked
121key cannot be changed.
122
123%hash must have already been locked for this to have useful effect.
124
125=cut
126
127sub lock_value (\%$) {
128 my($hash, $key) = @_;
129 carp "Cannot usefully lock values in an unlocked hash"
29569577
JH
130 unless Internals::SvREADONLY %$hash;
131 Internals::SvREADONLY $hash->{$key}, 1;
49293501
MS
132}
133
134sub unlock_value (\%$) {
135 my($hash, $key) = @_;
29569577 136 Internals::SvREADONLY $hash->{$key}, 0;
49293501
MS
137}
138
139
140=item B<lock_hash>
141
142=item B<unlock_hash>
143
144 lock_hash(%hash);
49293501
MS
145
146lock_hash() locks an entire hash, making all keys and values readonly.
147No value can be changed, no keys can be added or deleted.
148
7767c512
JH
149 unlock_hash(%hash);
150
151unlock_hash() does the opposite of lock_hash(). All keys and values
152are made read/write. All values can be changed and keys can be added
153and deleted.
49293501
MS
154
155=cut
156
157sub lock_hash (\%) {
158 my($hash) = shift;
159
160 lock_keys(%$hash);
161
162 foreach my $key (keys %$hash) {
163 lock_value(%$hash, $key);
164 }
165
166 return 1;
167}
168
169sub unlock_hash (\%) {
170 my($hash) = shift;
171
172 foreach my $key (keys %$hash) {
173 unlock_value(%$hash, $key);
174 }
175
176 unlock_keys(%$hash);
177
178 return 1;
179}
180
181
9a7034eb 182=item B<hash_seed>
c910b28a 183
9a7034eb 184 my $hash_seed = hash_seed();
c910b28a 185
9a7034eb
JH
186hash_seed() returns the seed number used to randomise hash ordering.
187Zero means the "traditional" random hash ordering, non-zero means the
188new even more random hash ordering introduced in Perl 5.8.1.
c910b28a 189
26a2d347
JH
190B<Note that the hash seed is sensitive information>: by knowing it one
191can craft a denial-of-service attack against Perl code, even remotely,
192see L<perlsec/"Algorithmic Complexity Attacks"> for more information.
193B<Do not disclose the hash seed> to people who don't need to know it.
194See also L<perlrun/PERL_HASH_SEED_DEBUG>.
195
c910b28a
JH
196=cut
197
9a7034eb
JH
198sub hash_seed () {
199 Internals::hash_seed();
c910b28a
JH
200}
201
49293501
MS
202=back
203
13cd9115
JH
204=head1 CAVEATS
205
206Note that the trapping of the restricted operations is not atomic:
207for example
208
209 eval { %hash = (illegal_key => 1) }
210
211leaves the C<%hash> empty rather than with its original contents.
212
49293501
MS
213=head1 AUTHOR
214
215Michael G Schwern <schwern@pobox.com> on top of code by Nick
216Ing-Simmons and Jeffrey Friedl.
217
218=head1 SEE ALSO
219
c910b28a
JH
220L<Scalar::Util>, L<List::Util>, L<Hash::Util>,
221and L<perlsec/"Algorithmic Complexity Attacks">.
49293501
MS
222
223=cut
224
2251;