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   94 use strict;
  13         28  
  13         6242  
4 13     13   78 use warnings;
  13         19  
  13         420  
5              
6 13     13   61 use base qw(Parse::Win32Registry::Key);
  13         23  
  13         985  
7              
8 13     13   74 use Carp;
  13         39  
  13         791  
9 13     13   66 use Encode;
  13         37  
  13         1166  
10 13     13   66 use Parse::Win32Registry::Base qw(:all);
  13         24  
  13         3587  
11 13     13   8302 use Parse::Win32Registry::WinNT::Value;
  13         35  
  13         398  
12 13     13   8344 use Parse::Win32Registry::WinNT::Security;
  13         41  
  13         392  
13              
14 13     13   77 use constant NK_HEADER_LENGTH => 0x50;
  13         24  
  13         617  
15 13     13   96 use constant OFFSET_TO_FIRST_HBIN => 0x1000;
  13         25  
  13         28885  
16              
17             sub new {
18 452     452 0 1438 my $class = shift;
19 452         601 my $regfile = shift;
20 452         527 my $offset = shift; # offset to nk record relative to start of file
21 452         819 my $parent_key_path = shift; # parent key path (optional)
22              
23 452 50       985 croak 'Missing registry file' if !defined $regfile;
24 452 50       784 croak 'Missing offset' if !defined $offset;
25              
26 452         1365 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         2224 sysseek($fh, $offset, 0);
54 452         2656 my $bytes_read = sysread($fh, my $nk_header, NK_HEADER_LENGTH);
55 452 100       1022 if ($bytes_read != NK_HEADER_LENGTH) {
56 1         4 warnf('Could not read key at 0x%x', $offset);
57 1         871 return;
58             }
59              
60 451         2989 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       1282 $offset_to_parent += OFFSET_TO_FIRST_HBIN
76             if $offset_to_parent != 0xffffffff;
77 451 100       896 $offset_to_subkey_list += OFFSET_TO_FIRST_HBIN
78             if $offset_to_subkey_list != 0xffffffff;
79 451 100       987 $offset_to_value_list += OFFSET_TO_FIRST_HBIN
80             if $offset_to_value_list != 0xffffffff;
81 451 100       847 $offset_to_security += OFFSET_TO_FIRST_HBIN
82             if $offset_to_security != 0xffffffff;
83 451 100       872 $offset_to_class_name += OFFSET_TO_FIRST_HBIN
84             if $offset_to_class_name != 0xffffffff;
85              
86 451         556 my $allocated = 0;
87 451 50       1010 if ($length > 0x7fffffff) {
88 451         494 $allocated = 1;
89 451         699 $length = (0xffffffff - $length) + 1;
90             }
91             # allocated should be true
92              
93 451 50       898 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       915 if ($sig ne 'nk') {
99 1         4 warnf('Invalid signature for key at 0x%x', $offset);
100 1         14 return;
101             }
102              
103 450         2427 $bytes_read = sysread($fh, my $name, $name_length);
104 450 100       942 if ($bytes_read != $name_length) {
105 1         5 warnf('Could not read name for key at 0x%x', $offset);
106 1         15 return;
107             }
108              
109 449 100       873 if ($flags & 0x20) {
110 436         1308 $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name);
111             }
112             else {
113 13         36 $name = decode('UCS-2LE', $name);
114             }
115              
116 449 100       16885 my $key_path = (defined $parent_key_path)
117             ? "$parent_key_path\\$name"
118             : "$name";
119              
120 449         619 my $class_name;
121 449 100       983 if ($offset_to_class_name != 0xffffffff) {
122 231         866 sysseek($fh, $offset_to_class_name + 4, 0);
123 231         1182 $bytes_read = sysread($fh, $class_name, $class_name_length);
124 231 100       423 if ($bytes_read != $class_name_length) {
125 1         4 warnf('Could not read class name at 0x%x', $offset_to_class_name);
126 1         6 $class_name = undef;
127             }
128             else {
129 230         581 $class_name = decode('UCS-2LE', $class_name);
130             }
131             }
132              
133 449         11826 my $self = {};
134 449         968 $self->{_regfile} = $regfile;
135 449         699 $self->{_offset} = $offset;
136 449         823 $self->{_length} = $length;
137 449         721 $self->{_allocated} = $allocated;
138 449         812 $self->{_tag} = $sig;
139 449         1173 $self->{_name} = $name;
140 449         1031 $self->{_name_length} = $name_length;
141 449         1393 $self->{_key_path} = $key_path;
142 449         730 $self->{_flags} = $flags;
143 449         645 $self->{_offset_to_parent} = $offset_to_parent;
144 449         597 $self->{_num_subkeys} = $num_subkeys;
145 449         687 $self->{_offset_to_subkey_list} = $offset_to_subkey_list;
146 449         959 $self->{_num_values} = $num_values;
147 449         819 $self->{_offset_to_value_list} = $offset_to_value_list;
148 449         1434 $self->{_timestamp} = unpack_windows_time($timestamp);
149 449         1361 $self->{_offset_to_security} = $offset_to_security;
150 449         1079 $self->{_offset_to_class_name} = $offset_to_class_name;
151 449         666 $self->{_class_name_length} = $class_name_length;
152 449         776 $self->{_class_name} = $class_name;
153 449         1617 bless $self, $class;
154              
155 449         1714 return $self;
156             }
157              
158             sub get_timestamp {
159 112     112 0 9830 my $self = shift;
160              
161 112         527 return $self->{_timestamp};
162             }
163              
164             sub get_timestamp_as_string {
165 78     78 0 8891 my $self = shift;
166              
167 78         321 return iso8601($self->get_timestamp);
168             }
169              
170             sub get_class_name {
171 19     19 0 387 my $self = shift;
172              
173 19         110 return $self->{_class_name};
174             }
175              
176             sub is_root {
177 225     225 0 10749 my $self = shift;
178              
179 225         334 my $flags = $self->{_flags};
180 225   66     1313 return $flags & 4 || $flags & 8;
181             }
182              
183             sub get_parent {
184 91     91 0 141 my $self = shift;
185              
186 91         160 my $regfile = $self->{_regfile};
187 91         147 my $offset_to_parent = $self->{_offset_to_parent};
188 91         145 my $key_path = $self->{_key_path};
189              
190 91 50       191 return if $self->is_root;
191              
192 91         135 my $grandparent_key_path;
193 91         413 my @keys = split /\\/, $key_path, -1;
194 91 100       279 if (@keys > 2) {
195 30         135 $grandparent_key_path = join('\\', @keys[0..$#keys-2]);
196             }
197              
198 91         306 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 1317 my $self = shift;
205              
206 1         12 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       5 if ($offset_to_security == 0xffffffff) {
211 0         0 return;
212             }
213              
214 1         11 return Parse::Win32Registry::WinNT::Security->new($regfile,
215             $offset_to_security,
216             $key_path);
217             }
218              
219             sub as_string {
220 42     42 0 8638 my $self = shift;
221              
222 42         189 my $string = $self->get_path . ' [' . $self->get_timestamp_as_string . ']';
223 42         229 return $string;
224             }
225              
226             sub parse_info {
227 0     0 0 0 my $self = shift;
228              
229 0         0 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             $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   307 my $self = shift;
247              
248             # Offset is passed as a parameter for recursive lists such as 'ri'
249 233   66     839 my $offset_to_subkey_list = shift || $self->{_offset_to_subkey_list};
250              
251 233         353 my $regfile = $self->{_regfile};
252 233         731 my $fh = $regfile->get_filehandle;
253              
254 233 50 33     1141 return if $offset_to_subkey_list == 0xffffffff
255             || $self->{_num_subkeys} == 0;
256              
257 233         949 sysseek($fh, $offset_to_subkey_list, 0);
258 233         1365 my $bytes_read = sysread($fh, my $subkey_list_header, 8);
259 233 100       548 if ($bytes_read != 8) {
260 1         5 warnf('Could not read subkey list header at 0x%x',
261             $offset_to_subkey_list);
262 1         5 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         351 my @offsets_to_subkeys = ();
301              
302 232         24630 my ($length,
303             $sig,
304             $num_entries,
305             ) = unpack('Va2v', $subkey_list_header);
306              
307 232         320 my $subkey_list_length;
308 232 100 100     1120 if ($sig eq 'lf' || $sig eq 'lh') {
    100 100        
309 143         211 $subkey_list_length = 2 * 4 * $num_entries;
310             }
311             elsif ($sig eq 'ri' || $sig eq 'li') {
312 88         129 $subkey_list_length = 4 * $num_entries;
313             }
314             else {
315 1         4 warnf('Invalid signature for subkey list at 0x%x',
316             $offset_to_subkey_list);
317 1         5 return;
318             }
319              
320 231         1296 $bytes_read = sysread($fh, my $subkey_list, $subkey_list_length);
321 231 100       531 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         8 return;
325             }
326              
327 230 100       687 if ($sig eq 'lf') {
    100          
    100          
    50          
328 112         421 foreach my $offset (unpack("(Vx4)$num_entries", $subkey_list)) {
329 378         847 push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset;
330             }
331             }
332             elsif ($sig eq 'lh') {
333 30         125 foreach my $offset (unpack("(Vx4)$num_entries", $subkey_list)) {
334 72         163 push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset;
335             }
336             }
337             elsif ($sig eq 'ri') {
338 26         79 foreach my $offset (unpack("V$num_entries", $subkey_list)) {
339 52         146 my $offsets_ref =
340             $self->_get_offsets_to_subkeys(OFFSET_TO_FIRST_HBIN + $offset);
341 52 50 33     273 if (defined $offsets_ref && ref $offsets_ref eq 'ARRAY') {
342 52         77 push @offsets_to_subkeys, @{ $offsets_ref };
  52         183  
343             }
344             }
345             }
346             elsif ($sig eq 'li') {
347 62         172 foreach my $offset (unpack("V$num_entries", $subkey_list)) {
348 176         401 push @offsets_to_subkeys, OFFSET_TO_FIRST_HBIN + $offset;
349             }
350             }
351              
352 230         844 return \@offsets_to_subkeys;
353             }
354              
355             sub get_subkey_iterator {
356 135     135 0 196 my $self = shift;
357              
358 135         271 my $regfile = $self->{_regfile};
359 135         270 my $key_path = $self->{_key_path};
360              
361 135         227 my @offsets_to_subkeys = ();
362 135 100       393 if ($self->{_num_subkeys} > 0) {
363 92         252 my $offsets_to_subkeys_ref = $self->_get_offsets_to_subkeys;
364 92 100       251 if (defined $offsets_to_subkeys_ref) {
365 89         127 @offsets_to_subkeys = @{$self->_get_offsets_to_subkeys};
  89         206  
366             }
367             }
368              
369             return Parse::Win32Registry::Iterator->new(sub {
370 448     448   1160 while (defined(my $offset_to_subkey = shift @offsets_to_subkeys)) {
371 313         990 my $subkey = Parse::Win32Registry::WinNT::Key->new($regfile,
372             $offset_to_subkey, $key_path);
373 313 50       929 if (defined $subkey) {
374 313         1201 return $subkey;
375             }
376             }
377 135         433 return; # no more offsets to subkeys
378 135         1074 });
379             }
380              
381             sub _get_offsets_to_values {
382 289     289   444 my $self = shift;
383              
384 289         409 my $regfile = $self->{_regfile};
385 289         961 my $fh = $regfile->get_filehandle;
386 289         493 my $offset_to_value_list = $self->{_offset_to_value_list};
387              
388 289         385 my $num_values = $self->{_num_values};
389 289 50       852 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         404 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         1290 sysseek($fh, $offset_to_value_list, 0);
403 289         524 my $value_list_length = 0x4 + $num_values * 4;
404 289         1934 my $bytes_read = sysread($fh, my $value_list, $value_list_length);
405 289 100       643 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         6 return;
409             }
410              
411 288         1771 foreach my $offset (unpack("x4V$num_values", $value_list)) {
412 12246         16045 push @offsets_to_values, OFFSET_TO_FIRST_HBIN + $offset;
413             }
414              
415 288         2308 return \@offsets_to_values;
416             }
417              
418             sub get_value_iterator {
419 174     174 0 321 my $self = shift;
420              
421 174         409 my $regfile = $self->{_regfile};
422 174         413 my $key_path = $self->{_key_path};
423              
424 174         342 my @offsets_to_values = ();
425 174 100       617 if ($self->{_num_values} > 0) {
426 145         422 my $offsets_to_values_ref = $self->_get_offsets_to_values;
427 145 100       410 if (defined $offsets_to_values_ref) {
428 144         180 @offsets_to_values = @{$self->_get_offsets_to_values};
  144         325  
429             }
430             }
431              
432             return Parse::Win32Registry::Iterator->new(sub {
433 6276     6276   15945 while (defined(my $offset_to_value = shift @offsets_to_values)) {
434 6109         19439 my $value = Parse::Win32Registry::WinNT::Value->new($regfile,
435             $offset_to_value);
436 6109 50       13717 if (defined $value) {
437 6109         22280 return $value;
438             }
439             }
440 167         544 return; # no more offsets to values
441 174         1554 });
442             }
443              
444             1;