File Coverage

blib/lib/Parse/Win32Registry/WinNT/Key.pm
Criterion Covered Total %
statement 203 211 96.2
branch 62 76 81.5
condition 12 18 66.6
subroutine 24 25 96.0
pod 0 11 0.0
total 301 341 88.2


line stmt bran cond sub pod time code
1             package Parse::Win32Registry::WinNT::Key;
2              
3 13     13   92 use strict;
  13         28  
  13         373  
4 13     13   77 use warnings;
  13         27  
  13         347  
5              
6 13     13   68 use base qw(Parse::Win32Registry::Key);
  13         30  
  13         1279  
7              
8 13     13   90 use Carp;
  13         27  
  13         696  
9 13     13   79 use Encode;
  13         23  
  13         1022  
10 13     13   91 use Parse::Win32Registry::Base qw(:all);
  13         33  
  13         2772  
11 13     13   6542 use Parse::Win32Registry::WinNT::Value;
  13         53  
  13         422  
12 13     13   5557 use Parse::Win32Registry::WinNT::Security;
  13         39  
  13         407  
13              
14 13     13   93 use constant NK_HEADER_LENGTH => 0x50;
  13         29  
  13         680  
15 13     13   77 use constant OFFSET_TO_FIRST_HBIN => 0x1000;
  13         28  
  13         25096  
16              
17             sub new {
18 452     452 0 1472 my $class = shift;
19 452         666 my $regfile = shift;
20 452         666 my $offset = shift; # offset to nk record relative to start of file
21 452         679 my $parent_key_path = shift; # parent key path (optional)
22              
23 452 50       911 croak 'Missing registry file' if !defined $regfile;
24 452 50       797 croak 'Missing offset' if !defined $offset;
25              
26 452         1326 my $fh = $regfile->get_filehandle;
27              
28             # 0x00 dword = key length (negative = allocated)
29             # 0x04 word = 'nk' signature
30             # 0x06 word = flags
31             # 0x08 qword = timestamp
32             # 0x10
33             # 0x14 dword = offset to parent
34             # 0x18 dword = number of subkeys
35             # 0x1c
36             # 0x20 dword = offset to subkey list (lf, lh, ri, li)
37             # 0x24
38             # 0x28 dword = number of values
39             # 0x2c dword = offset to value list
40             # 0x30 dword = offset to security
41             # 0x34 dword = offset to class name
42             # 0x38 dword = max subkey name length
43             # 0x3c dword = max class name length
44             # 0x40 dword = max value name length
45             # 0x44 dword = max value data length
46             # 0x48
47             # 0x4c word = key name length
48             # 0x4e word = class name length
49             # 0x50 = key name [for key name length bytes]
50              
51             # Extracted offsets are always relative to first hbin
52              
53 452         3124 sysseek($fh, $offset, 0);
54 452         3710 my $bytes_read = sysread($fh, my $nk_header, NK_HEADER_LENGTH);
55 452 100       1346 if ($bytes_read != NK_HEADER_LENGTH) {
56 1         6 warnf('Could not read key at 0x%x', $offset);
57 1         16 return;
58             }
59              
60 451         2808 my ($length,
61             $sig,
62             $flags,
63             $timestamp,
64             $offset_to_parent,
65             $num_subkeys,
66             $offset_to_subkey_list,
67             $num_values,
68             $offset_to_value_list,
69             $offset_to_security,
70             $offset_to_class_name,
71             $name_length,
72             $class_name_length,
73             ) = unpack('Va2va8x4VVx4Vx4VVVVx20vv', $nk_header);
74              
75 451 100       1381 $offset_to_parent += OFFSET_TO_FIRST_HBIN
76             if $offset_to_parent != 0xffffffff;
77 451 100       912 $offset_to_subkey_list += OFFSET_TO_FIRST_HBIN
78             if $offset_to_subkey_list != 0xffffffff;
79 451 100       946 $offset_to_value_list += OFFSET_TO_FIRST_HBIN
80             if $offset_to_value_list != 0xffffffff;
81 451 100       843 $offset_to_security += OFFSET_TO_FIRST_HBIN
82             if $offset_to_security != 0xffffffff;
83 451 100       805 $offset_to_class_name += OFFSET_TO_FIRST_HBIN
84             if $offset_to_class_name != 0xffffffff;
85              
86 451         645 my $allocated = 0;
87 451 50       862 if ($length > 0x7fffffff) {
88 451         645 $allocated = 1;
89 451         805 $length = (0xffffffff - $length) + 1;
90             }
91             # allocated should be true
92              
93 451 50       862 if ($length < NK_HEADER_LENGTH) {
94 0         0 warnf('Invalid value entry length at 0x%x', $offset);
95 0         0 return;
96             }
97              
98 451 100       894 if ($sig ne 'nk') {
99 1         5 warnf('Invalid signature for key at 0x%x', $offset);
100 1         16 return;
101             }
102              
103 450         2884 $bytes_read = sysread($fh, my $name, $name_length);
104 450 100       1466 if ($bytes_read != $name_length) {
105 1         5 warnf('Could not read name for key at 0x%x', $offset);
106 1         28 return;
107             }
108              
109 449 100       1128 if ($flags & 0x20) {
110 436         1540 $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name);
111             }
112             else {
113 13         46 $name = decode('UCS-2LE', $name);
114             }
115              
116 449 100       15473 my $key_path = (defined $parent_key_path)
117             ? "$parent_key_path\\$name"
118             : "$name";
119              
120 449         769 my $class_name;
121 449 100       982 if ($offset_to_class_name != 0xffffffff) {
122 231         1280 sysseek($fh, $offset_to_class_name + 4, 0);
123 231         1657 $bytes_read = sysread($fh, $class_name, $class_name_length);
124 231 100       694 if ($bytes_read != $class_name_length) {
125 1         6 warnf('Could not read class name at 0x%x', $offset_to_class_name);
126 1         8 $class_name = undef;
127             }
128             else {
129 230         625 $class_name = decode('UCS-2LE', $class_name);
130             }
131             }
132              
133 449         10276 my $self = {};
134 449         1018 $self->{_regfile} = $regfile;
135 449         798 $self->{_offset} = $offset;
136 449         726 $self->{_length} = $length;
137 449         730 $self->{_allocated} = $allocated;
138 449         876 $self->{_tag} = $sig;
139 449         785 $self->{_name} = $name;
140 449         787 $self->{_name_length} = $name_length;
141 449         1081 $self->{_key_path} = $key_path;
142 449         677 $self->{_flags} = $flags;
143 449         772 $self->{_offset_to_parent} = $offset_to_parent;
144 449         681 $self->{_num_subkeys} = $num_subkeys;
145 449         739 $self->{_offset_to_subkey_list} = $offset_to_subkey_list;
146 449         719 $self->{_num_values} = $num_values;
147 449         741 $self->{_offset_to_value_list} = $offset_to_value_list;
148 449         1256 $self->{_timestamp} = unpack_windows_time($timestamp);
149 449         1329 $self->{_offset_to_security} = $offset_to_security;
150 449         812 $self->{_offset_to_class_name} = $offset_to_class_name;
151 449         749 $self->{_class_name_length} = $class_name_length;
152 449         806 $self->{_class_name} = $class_name;
153 449         838 bless $self, $class;
154              
155 449         1463 return $self;
156             }
157              
158             sub get_timestamp {
159 112     112 0 9856 my $self = shift;
160              
161 112         435 return $self->{_timestamp};
162             }
163              
164             sub get_timestamp_as_string {
165 78     78 0 8434 my $self = shift;
166              
167 78         176 return iso8601($self->get_timestamp);
168             }
169              
170             sub get_class_name {
171 19     19 0 658 my $self = shift;
172              
173 19         89 return $self->{_class_name};
174             }
175              
176             sub is_root {
177 225     225 0 7012 my $self = shift;
178              
179 225         345 my $flags = $self->{_flags};
180 225   66     978 return $flags & 4 || $flags & 8;
181             }
182              
183             sub get_parent {
184 91     91 0 209 my $self = shift;
185              
186 91         151 my $regfile = $self->{_regfile};
187 91         146 my $offset_to_parent = $self->{_offset_to_parent};
188 91         173 my $key_path = $self->{_key_path};
189              
190 91 50       193 return if $self->is_root;
191              
192 91         142 my $grandparent_key_path;
193 91         405 my @keys = split /\\/, $key_path, -1;
194 91 100       233 if (@keys > 2) {
195 30         123 $grandparent_key_path = join('\\', @keys[0..$#keys-2]);
196             }
197              
198 91         332 return Parse::Win32Registry::WinNT::Key->new($regfile,
199             $offset_to_parent,
200             $grandparent_key_path);
201             }
202              
203             sub get_security {
204 1     1 0 793 my $self = shift;
205              
206 1         10 my $regfile = $self->{_regfile};
207 1         3 my $offset_to_security = $self->{_offset_to_security};
208 1         3 my $key_path = $self->{_key_path};
209              
210 1 50       4 if ($offset_to_security == 0xffffffff) {
211 0         0 return;
212             }
213              
214 1         12 return Parse::Win32Registry::WinNT::Security->new($regfile,
215             $offset_to_security,
216             $key_path);
217             }
218              
219             sub as_string {
220 42     42 0 7564 my $self = shift;
221              
222 42         139 my $string = $self->get_path . ' [' . $self->get_timestamp_as_string . ']';
223 42         193 return $string;
224             }
225              
226             sub parse_info {
227 0     0 0 0 my $self = shift;
228              
229             my $info = sprintf '0x%x nk len=0x%x alloc=%d "%s" par=0x%x keys=%d,0x%x vals=%d,0x%x sec=0x%x class=0x%x',
230             $self->{_offset},
231             $self->{_length},
232             $self->{_allocated},
233             $self->{_name},
234             $self->{_offset_to_parent},
235             $self->{_num_subkeys}, $self->{_offset_to_subkey_list},
236             $self->{_num_values}, $self->{_offset_to_value_list},
237             $self->{_offset_to_security},
238 0         0 $self->{_offset_to_class_name};
239 0 0       0 if (defined $self->{_class_name}) {
240 0         0 $info .= sprintf ',len=0x%x', $self->{_class_name_length};
241             }
242 0         0 return $info;
243             }
244              
245             sub _get_offsets_to_subkeys {
246 233     233   362 my $self = shift;
247              
248             # Offset is passed as a parameter for recursive lists such as 'ri'
249 233   66     782 my $offset_to_subkey_list = shift || $self->{_offset_to_subkey_list};
250              
251 233         390 my $regfile = $self->{_regfile};
252 233         755 my $fh = $regfile->get_filehandle;
253              
254             return if $offset_to_subkey_list == 0xffffffff
255 233 50 33     834 || $self->{_num_subkeys} == 0;
256              
257 233         1424 sysseek($fh, $offset_to_subkey_list, 0);
258 233         1854 my $bytes_read = sysread($fh, my $subkey_list_header, 8);
259 233 100       695 if ($bytes_read != 8) {
260 1         5 warnf('Could not read subkey list header at 0x%x',
261             $offset_to_subkey_list);
262 1         9 return;
263             }
264              
265             # 0x00 dword = subkey list length (negative = allocated)
266             # 0x04 word = 'lf' signature
267             # 0x06 word = number of entries
268             # 0x08 dword = offset to 1st subkey
269             # 0x0c dword = first four characters of the key name
270             # 0x10 dword = offset to 2nd subkey
271             # 0x14 dword = first four characters of the key name
272             # ...
273              
274             # 0x00 dword = subkey list length (negative = allocated)
275             # 0x04 word = 'lh' signature
276             # 0x06 word = number of entries
277             # 0x08 dword = offset to 1st subkey
278             # 0x0c dword = hash of the key name
279             # 0x10 dword = offset to 2nd subkey
280             # 0x14 dword = hash of the key name
281             # ...
282              
283             # 0x00 dword = subkey list length (negative = allocated)
284             # 0x04 word = 'ri' signature
285             # 0x06 word = number of entries in ri list
286             # 0x08 dword = offset to 1st lf/lh/li list
287             # 0x0c dword = offset to 2nd lf/lh/li list
288             # 0x10 dword = offset to 3rd lf/lh/li list
289             # ...
290              
291             # 0x00 dword = subkey list length (negative = allocated)
292             # 0x04 word = 'li' signature
293             # 0x06 word = number of entries in li list
294             # 0x08 dword = offset to 1st subkey
295             # 0x0c dword = offset to 2nd subkey
296             # ...
297              
298             # Extracted offsets are always relative to first hbin
299              
300 232         387 my @offsets_to_subkeys = ();
301              
302 232         1030 my ($length,
303             $sig,
304             $num_entries,
305             ) = unpack('Va2v', $subkey_list_header);
306              
307 232         434 my $subkey_list_length;
308 232 100 100     957 if ($sig eq 'lf' || $sig eq 'lh') {
    100 100        
309 143         251 $subkey_list_length = 2 * 4 * $num_entries;
310             }
311             elsif ($sig eq 'ri' || $sig eq 'li') {
312 88         228 $subkey_list_length = 4 * $num_entries;
313             }
314             else {
315 1         5 warnf('Invalid signature for subkey list at 0x%x',
316             $offset_to_subkey_list);
317 1         8 return;
318             }
319              
320 231         1542 $bytes_read = sysread($fh, my $subkey_list, $subkey_list_length);
321 231 100       671 if ($bytes_read != $subkey_list_length) {
322 1         6 warnf('Could not read subkey list at 0x%x',
323             $offset_to_subkey_list);
324 1         9 return;
325             }
326              
327 230 100       657 if ($sig eq 'lf') {
    100          
    100          
    50          
328 112         489 foreach my $offset (unpack("(Vx4)$num_entries", $subkey_list)) {
329 378         756 push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset;
330             }
331             }
332             elsif ($sig eq 'lh') {
333 30         121 foreach my $offset (unpack("(Vx4)$num_entries", $subkey_list)) {
334 72         154 push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset;
335             }
336             }
337             elsif ($sig eq 'ri') {
338 26         88 foreach my $offset (unpack("V$num_entries", $subkey_list)) {
339 52         137 my $offsets_ref =
340             $self->_get_offsets_to_subkeys(OFFSET_TO_FIRST_HBIN + $offset);
341 52 50 33     198 if (defined $offsets_ref && ref $offsets_ref eq 'ARRAY') {
342 52         73 push @offsets_to_subkeys, @{ $offsets_ref };
  52         180  
343             }
344             }
345             }
346             elsif ($sig eq 'li') {
347 62         186 foreach my $offset (unpack("V$num_entries", $subkey_list)) {
348 176         359 push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset;
349             }
350             }
351              
352 230         781 return \@offsets_to_subkeys;
353             }
354              
355             sub get_subkey_iterator {
356 135     135 0 216 my $self = shift;
357              
358 135         255 my $regfile = $self->{_regfile};
359 135         248 my $key_path = $self->{_key_path};
360              
361 135         233 my @offsets_to_subkeys = ();
362 135 100       347 if ($self->{_num_subkeys} > 0) {
363 92         203 my $offsets_to_subkeys_ref = $self->_get_offsets_to_subkeys;
364 92 100       229 if (defined $offsets_to_subkeys_ref) {
365 89         153 @offsets_to_subkeys = @{$self->_get_offsets_to_subkeys};
  89         203  
366             }
367             }
368              
369             return Parse::Win32Registry::Iterator->new(sub {
370 448     448   1116 while (defined(my $offset_to_subkey = shift @offsets_to_subkeys)) {
371 313         784 my $subkey = Parse::Win32Registry::WinNT::Key->new($regfile,
372             $offset_to_subkey, $key_path);
373 313 50       728 if (defined $subkey) {
374 313         1146 return $subkey;
375             }
376             }
377 135         348 return; # no more offsets to subkeys
378 135         990 });
379             }
380              
381             sub _get_offsets_to_values {
382 289     289   407 my $self = shift;
383              
384 289         526 my $regfile = $self->{_regfile};
385 289         790 my $fh = $regfile->get_filehandle;
386 289         495 my $offset_to_value_list = $self->{_offset_to_value_list};
387              
388 289         436 my $num_values = $self->{_num_values};
389 289 50       666 return if $num_values == 0;
390             # Actually, this could probably just fall through
391             # as unpack("x4V0", ...) would return an empty array.
392              
393 289         479 my @offsets_to_values = ();
394              
395             # 0x00 dword = value list length (negative = allocated)
396             # 0x04 dword = 1st offset
397             # 0x08 dword = 2nd offset
398             # ...
399              
400             # Extracted offsets are always relative to first hbin
401              
402 289         1805 sysseek($fh, $offset_to_value_list, 0);
403 289         851 my $value_list_length = 0x4 + $num_values * 4;
404 289         2064 my $bytes_read = sysread($fh, my $value_list, $value_list_length);
405 289 100       864 if ($bytes_read != $value_list_length) {
406 1         5 warnf("Could not read value list at 0x%x",
407             $offset_to_value_list);
408 1         9 return;
409             }
410              
411 288         1453 foreach my $offset (unpack("x4V$num_values", $value_list)) {
412 12246         18481 push @offsets_to_values, OFFSET_TO_FIRST_HBIN + $offset;
413             }
414              
415 288         1459 return \@offsets_to_values;
416             }
417              
418             sub get_value_iterator {
419 174     174 0 287 my $self = shift;
420              
421 174         334 my $regfile = $self->{_regfile};
422 174         297 my $key_path = $self->{_key_path};
423              
424 174         348 my @offsets_to_values = ();
425 174 100       470 if ($self->{_num_values} > 0) {
426 145         317 my $offsets_to_values_ref = $self->_get_offsets_to_values;
427 145 100       371 if (defined $offsets_to_values_ref) {
428 144         232 @offsets_to_values = @{$self->_get_offsets_to_values};
  144         357  
429             }
430             }
431              
432             return Parse::Win32Registry::Iterator->new(sub {
433 6276     6276   14539 while (defined(my $offset_to_value = shift @offsets_to_values)) {
434 6109         15226 my $value = Parse::Win32Registry::WinNT::Value->new($regfile,
435             $offset_to_value);
436 6109 50       12677 if (defined $value) {
437 6109         20269 return $value;
438             }
439             }
440 167         419 return; # no more offsets to values
441 174         1296 });
442             }
443              
444             1;