File Coverage

blib/lib/Parse/Win32Registry/Win95/File.pm
Criterion Covered Total %
statement 287 310 92.5
branch 62 88 70.4
condition 3 8 37.5
subroutine 49 52 94.2
pod 0 9 0.0
total 401 467 85.8


line stmt bran cond sub pod time code
1             package Parse::Win32Registry::Win95::File;
2              
3 13     13   98 use strict;
  13         21  
  13         512  
4 13     13   69 use warnings;
  13         25  
  13         453  
5              
6 13     13   68 use base qw(Parse::Win32Registry::File);
  13         23  
  13         7915  
7              
8 13     13   93 use Carp;
  13         24  
  13         782  
9 13     13   67 use File::Basename;
  13         21  
  13         1399  
10 13     13   66 use Parse::Win32Registry::Base qw(:all);
  13         24  
  13         3560  
11 13     13   13830 use Parse::Win32Registry::Win95::Key;
  13         46  
  13         473  
12              
13 13     13   114 use constant CREG_HEADER_LENGTH => 0x20;
  13         25  
  13         2165  
14 13     13   91 use constant OFFSET_TO_RGKN_BLOCK => 0x20;
  13         26  
  13         14647  
15              
16             sub new {
17 22     22 0 6004 my $class = shift;
18 22 100       237 my $filename = shift or croak 'No filename specified';
19              
20 21 100       872 open my $fh, '<', $filename or croak "Unable to open '$filename': $!";
21              
22             # CREG Header
23             # 0x00 dword = 'CREG' signature
24             # 0x04
25             # 0x08 dword = offset to first rgdb block
26             # 0x0c
27             # 0x10 word = number of rgdb blocks
28              
29 20         139 my $bytes_read = sysread($fh, my $creg_header, CREG_HEADER_LENGTH);
30 20 100       67 if ($bytes_read != CREG_HEADER_LENGTH) {
31 1         5 warnf('Could not read registry file header');
32 1         26 return;
33             }
34              
35 19         128 my ($creg_sig,
36             $offset_to_first_rgdb_block,
37             $num_rgdb_blocks) = unpack('a4x4Vx4v', $creg_header);
38              
39 19 100       115 if ($creg_sig ne 'CREG') {
40 1         5 warnf('Invalid registry file signature');
41 1         26 return;
42             }
43              
44 18         40 my $self = {};
45 18         57 $self->{_filehandle} = $fh;
46 18         50 $self->{_filename} = $filename;
47 18         330 $self->{_length} = (stat $fh)[7];
48 18         48 $self->{_offset_to_first_rgdb_block} = $offset_to_first_rgdb_block;
49 18         39 $self->{_num_rgdb_blocks} = $num_rgdb_blocks;
50 18         52 bless $self, $class;
51              
52             # get_rgkn will cache the rgkn block for subsequent calls
53 18         73 my $rgkn_block = $self->get_rgkn;
54 18 100       109 return if !defined $rgkn_block; # warning will already have been made
55              
56             # Index the rgdb entries by id for faster look up
57 16         64 $self->_index_rgdb_entries;
58              
59 16         136 return $self;
60             }
61              
62             sub get_timestamp {
63 1     1 0 6 return undef;
64             }
65              
66             sub get_timestamp_as_string {
67 1     1 0 7 return iso8601(undef);
68             }
69              
70             sub get_embedded_filename {
71 1     1 0 5 return undef;
72             }
73              
74             sub get_root_key {
75 9     9 0 5026 my $self = shift;
76              
77 9         37 return $self->get_rgkn->get_root_key;
78             }
79              
80             sub get_virtual_root_key {
81 2     2 0 1281 my $self = shift;
82 2         4 my $fake_root = shift;
83              
84 2         9 my $root_key = $self->get_root_key;
85 2 50       10 return if !defined $root_key;
86              
87 2 50       5 if (!defined $fake_root) {
88             # guess virtual root from filename
89 2         96 my $filename = basename $self->{_filename};
90              
91 2 100       12 if ($filename =~ /USER/i) {
    50          
92 1         2 $fake_root = 'HKEY_USERS';
93             }
94             elsif ($filename =~ /SYSTEM/i) {
95 1         3 $fake_root = 'HKEY_LOCAL_MACHINE';
96             }
97             else {
98 0         0 $fake_root = 'HKEY_UNKNOWN';
99             }
100             }
101              
102 2         5 $root_key->{_name} = $fake_root;
103 2         2 $root_key->{_key_path} = $fake_root;
104              
105 2         5 return $root_key;
106             }
107              
108             sub _index_rgdb_entries {
109 16     16   28 my $self = shift;
110              
111 16         36 my %index = ();
112              
113             # Build index of rgdb key entries
114             # Entries are only included if $key_block_num matches $rgdb_block_num
115 16         25 my $rgdb_block_num = 0;
116 16         55 my $rgdb_iter = $self->get_rgdb_iterator;
117 16         86 while (my $rgdb = $rgdb_iter->()) {
118 18         66 my $rgdb_key_iter = $rgdb->get_key_iterator;
119 18         52 while (my $rgdb_key = $rgdb_key_iter->()) {
120 88         133 my $key_id = $rgdb_key->{_id};
121 88         108 my $key_block_num = $key_id >> 16;
122 88 50       181 if ($rgdb_block_num == $key_block_num) {
123 88         326 $index{$key_id} = $rgdb_key;
124             }
125             }
126 18         333 $rgdb_block_num++;
127             }
128              
129 16         110 $self->{_rgdb_index} = \%index;
130             }
131              
132             sub _dump_rgdb_index {
133 0     0   0 my $self = shift;
134              
135 0         0 my $rgdb_index = $self->{_rgdb_index};
136              
137 0         0 foreach my $key_id (sort { $a <=> $b } keys %$rgdb_index) {
  0         0  
138 0         0 my $rgdb_key = $rgdb_index->{$key_id};
139 0         0 printf qq{id=0x%x 0x%x,%d/%d "%s" vals=%d\n},
140             $key_id,
141             $rgdb_key->{_offset},
142             $rgdb_key->{_length_used},
143             $rgdb_key->{_length},
144             $rgdb_key->{_name},
145             $rgdb_key->{_num_values};
146             }
147             }
148              
149             sub get_rgkn {
150 301     301 0 431 my $self = shift;
151              
152             # Return cached rgkn block if present
153 301 100       939 if (defined $self->{_rgkn}) {
154 283         913 return $self->{_rgkn};
155             }
156              
157 18         33 my $offset = OFFSET_TO_RGKN_BLOCK;
158 18         131 my $rgkn_block = Parse::Win32Registry::Win95::RGKN->new($self, $offset);
159 18         54 $self->{_rgkn} = $rgkn_block;
160 18         37 return $rgkn_block;
161             }
162              
163             sub get_rgdb_iterator {
164 18     18 0 30 my $self = shift;
165              
166 18         40 my $offset_to_next_rgdb_block = $self->{_offset_to_first_rgdb_block};
167 18         38 my $num_rgdb_blocks = $self->{_num_rgdb_blocks};
168              
169 18         35 my $end_of_file = $self->{_length};
170              
171 18         27 my $rgdb_block_num = 0;
172              
173             return Parse::Win32Registry::Iterator->new(sub {
174 38 100   38   114 if ($offset_to_next_rgdb_block > $end_of_file) {
175 5         14 return; # no more rgdb blocks
176             }
177 33 100       108 if ($rgdb_block_num >= $num_rgdb_blocks) {
178 13         41 return; # no more rgdb blocks
179             }
180 20         30 $rgdb_block_num++;
181 20 50       160 if (my $rgdb_block = Parse::Win32Registry::Win95::RGDB->new($self,
182             $offset_to_next_rgdb_block))
183             {
184 20 50       119 return unless $rgdb_block->get_length > 0;
185 20         60 $offset_to_next_rgdb_block += $rgdb_block->get_length;
186 20         111 return $rgdb_block;
187             }
188 18         249 });
189             }
190              
191             sub get_block_iterator {
192 2     2 0 3 my $self = shift;
193              
194 2         3 my $rgdb_iter;
195              
196             return Parse::Win32Registry::Iterator->new(sub {
197 6 100   6   21 if (!defined $rgdb_iter) {
198 2         19 $rgdb_iter = $self->get_rgdb_iterator;
199 2         11 return $self->get_rgkn;
200             }
201 4         14 return $rgdb_iter->();
202 2         24 });
203             }
204              
205             *get_hbin_iterator = \&get_block_iterator;
206              
207              
208             package Parse::Win32Registry::Win95::RGKN;
209              
210 13     13   90 use strict;
  13         25  
  13         449  
211 13     13   802 use warnings;
  13         31  
  13         485  
212              
213 13     13   69 use base qw(Parse::Win32Registry::Entry);
  13         23  
  13         1235  
214              
215 13     13   3432 use Carp;
  13         24  
  13         4890  
216 13     13   86 use Parse::Win32Registry::Base qw(:all);
  13         21  
  13         4506  
217              
218 13     13   113 use constant RGKN_HEADER_LENGTH => 0x20;
  13         1400  
  13         6104  
219 13     13   94 use constant OFFSET_TO_RGKN_BLOCK => 0x20;
  13         23  
  13         6292  
220              
221             sub new {
222 18     18   34 my $class = shift;
223 18         36 my $regfile = shift;
224 18   50     55 my $offset = shift || OFFSET_TO_RGKN_BLOCK;
225              
226 18 50       51 croak 'Missing registry file' if !defined $regfile;
227 18 50       48 croak 'Missing offset' if !defined $offset;
228              
229 18         123 my $fh = $regfile->get_filehandle;
230              
231             # RGKN Block Header
232             # 0x0 dword = 'RGKN' signature
233             # 0x4 dword = length of rgkn block
234             # 0x8 dword = offset to root key entry (relative to start of rgkn block)
235              
236 18         82 sysseek($fh, $offset, 0);
237 18         108 my $bytes_read = sysread($fh, my $rgkn_header, RGKN_HEADER_LENGTH);
238 18 100       59 if ($bytes_read != RGKN_HEADER_LENGTH) {
239 1         5 warnf('Could not read RGKN header at 0x%x', $offset);
240 1         6 return;
241             }
242              
243 17         63 my ($sig,
244             $rgkn_block_length,
245             $offset_to_root_key) = unpack('a4VV', $rgkn_header);
246              
247 17 100       56 if ($sig ne 'RGKN') {
248 1         5 warnf('Invalid RGKN block signature at 0x%x', $offset);
249 1         7 return;
250             }
251              
252 16         28 $offset_to_root_key += $offset;
253              
254 16         33 my $self = {};
255 16         44 $self->{_regfile} = $regfile;
256 16         37 $self->{_offset} = $offset;
257 16         65 $self->{_length} = $rgkn_block_length;
258 16         38 $self->{_header_length} = RGKN_HEADER_LENGTH;
259 16         34 $self->{_allocated} = 1;
260 16         38 $self->{_tag} = 'rgkn block';
261 16         30 $self->{_offset_to_root_key} = $offset_to_root_key;
262 16         43 bless $self, $class;
263              
264 16         42 return $self;
265             }
266              
267             sub get_root_key {
268 11     11   32 my $self = shift;
269              
270 11         69 my $regfile = $self->{_regfile};
271 11         25 my $offset_to_root_key = $self->{_offset_to_root_key};
272              
273 11         93 my $root_key = Parse::Win32Registry::Win95::Key->new($regfile,
274             $offset_to_root_key);
275 11         44 return $root_key;
276             }
277              
278             sub get_entry_iterator {
279 2     2   3 my $self = shift;
280              
281 2         17 my $root_key = $self->get_root_key;
282              
283             # In the unlikely event there is no root key, return an empty iterator
284 2 50       7 if (defined $root_key) {
285 2         14 return $root_key->get_subtree_iterator;
286             }
287             else {
288 0     0   0 return Parse::Win32Registry::Iterator->new(sub {});
  0         0  
289             }
290             }
291              
292              
293             package Parse::Win32Registry::Win95::RGDB;
294              
295 13     13   69 use base qw(Parse::Win32Registry::Entry);
  13         21  
  13         1235  
296              
297 13     13   67 use Carp;
  13         21  
  13         845  
298 13     13   90 use Parse::Win32Registry::Base qw(:all);
  13         22  
  13         3791  
299              
300 13     13   123 use constant RGDB_HEADER_LENGTH => 0x20;
  13         24  
  13         8235  
301              
302             sub new {
303 20     20   216 my $class = shift;
304 20         33 my $regfile = shift;
305 20         34 my $offset = shift;
306              
307 20 50       81 croak 'Missing registry file' if !defined $regfile;
308 20 50       61 croak 'Missing offset' if !defined $offset;
309              
310 20         68 my $fh = $regfile->get_filehandle;
311              
312             # RGDB Block Header
313             # 0x0 dword = 'RDGB' signature
314             # 0x4 dword = length of rgdb block
315              
316 20         95 sysseek($fh, $offset, 0);
317 20         139 my $bytes_read = sysread($fh, my $rgdb_header, RGDB_HEADER_LENGTH);
318 20 50       68 if ($bytes_read != RGDB_HEADER_LENGTH) {
319 0         0 return;
320             }
321              
322 20         78 my ($sig,
323             $rgdb_block_length) = unpack('a4V', $rgdb_header);
324              
325 20 50       68 if ($sig ne 'RGDB') {
326 0         0 return;
327             }
328              
329 20         41 my $self = {};
330 20         56 $self->{_regfile} = $regfile;
331 20         45 $self->{_offset} = $offset;
332 20         50 $self->{_length} = $rgdb_block_length;
333 20         46 $self->{_header_length} = RGDB_HEADER_LENGTH;
334 20         35 $self->{_allocated} = 1;
335 20         40 $self->{_tag} = 'rgdb block';
336 20         56 bless $self, $class;
337              
338 20         185 return $self;
339             }
340              
341             sub get_key_iterator {
342 20     20   31 my $self = shift;
343              
344 20         39 my $regfile = $self->{_regfile};
345 20         46 my $offset = $self->{_offset};
346 20         37 my $length = $self->{_length};
347              
348 20         45 my $offset_to_next_rgdb_key = $offset + RGDB_HEADER_LENGTH;
349 20         30 my $end_of_rgdb_block = $offset + $length;
350              
351             return Parse::Win32Registry::Iterator->new(sub {
352 112 100   112   243 if ($offset_to_next_rgdb_key >= $end_of_rgdb_block) {
353 20         61 return;
354             }
355 92 50       341 if (my $rgdb_key = Parse::Win32Registry::Win95::RGDBKey->new($regfile,
356             $offset_to_next_rgdb_key))
357             {
358 92 50       326 return unless $rgdb_key->get_length > 0;
359 92         233 $offset_to_next_rgdb_key += $rgdb_key->get_length;
360              
361             # Check rgdb key has not run past end of rgdb block
362 92 50       198 if ($offset_to_next_rgdb_key > $end_of_rgdb_block) {
363 0         0 return;
364             }
365 92         260 return $rgdb_key;
366             }
367 20         148 });
368             }
369              
370             sub get_entry_iterator {
371 2     2   6 my $self = shift;
372              
373 2         7 my $value_iter;
374 2         9 my $key_iter = $self->get_key_iterator;
375              
376             return Parse::Win32Registry::Iterator->new(sub {
377 14 100   14   36 if (defined $value_iter) {
378 12         32 my $value = $value_iter->();
379 12 100       29 if (defined $value) {
380 8         20 return $value;
381             }
382             }
383              
384 6         16 my $key = $key_iter->();
385 6 100       18 if (!defined $key) {
386 2         6 return; # key iterator finished
387             }
388              
389 4         13 $value_iter = $key->get_value_iterator;
390 4         21 return $key;
391 2         12 });
392             }
393              
394              
395             package Parse::Win32Registry::Win95::RGDBKey;
396              
397 13     13   76 use base qw(Parse::Win32Registry::Entry);
  13         25  
  13         1072  
398              
399 13     13   73 use Carp;
  13         21  
  13         763  
400 13     13   72 use Encode;
  13         18  
  13         1266  
401 13     13   67 use Parse::Win32Registry::Base qw(:all);
  13         35  
  13         3526  
402              
403 13     13   83 use constant RGDB_ENTRY_HEADER_LENGTH => 0x14;
  13         28  
  13         9471  
404              
405             sub new {
406 92     92   112 my $class = shift;
407 92         110 my $regfile = shift;
408 92         106 my $offset = shift;
409              
410 92 50       180 croak 'Missing registry file' if !defined $regfile;
411 92 50       216 croak 'Missing offset' if !defined $offset;
412              
413 92         274 my $fh = $regfile->get_filehandle;
414              
415             # RGDB Key Entry
416             # 0x00 dword = length of rgdb entry / offset to next rgdb entry
417             # (this length includes any following value entries)
418             # 0x04 dword = id (top word = block num, bottom word = id)
419             # 0x08 dword = bytes used (unpacked, but not used)
420             # 0x0c word = key name length
421             # 0x0e word = number of values
422             # 0x10 dword
423             # 0x14 = key name [for key name length bytes]
424             # followed immediately by any RGDB Value Entries belonging to this key
425              
426 92         371 sysseek($fh, $offset, 0);
427 92         523 my $bytes_read = sysread($fh, my $rgdb_key_entry, RGDB_ENTRY_HEADER_LENGTH);
428 92 50       219 if ($bytes_read != RGDB_ENTRY_HEADER_LENGTH) {
429 0         0 return;
430             }
431              
432 92         347 my ($length,
433             $key_id,
434             $length_used,
435             $name_length,
436             $num_values) = unpack('VVVvv', $rgdb_key_entry);
437              
438 92         454 $bytes_read = sysread($fh, my $name, $name_length);
439 92 50       192 if ($bytes_read != $name_length) {
440 0         0 return;
441             }
442 92         287 $name = decode($Parse::Win32Registry::Base::CODEPAGE, $name);
443              
444             # Calculate the length of the entry's key header
445 92         42693 my $header_length = RGDB_ENTRY_HEADER_LENGTH + $name_length;
446              
447             # Check for invalid/unused entries
448 92 50 33     629 if ($key_id == 0xffffffff || $length_used == 0xffffffff
      33        
449             || $header_length > $length)
450             {
451 0         0 $name = '';
452 0         0 $header_length = RGDB_ENTRY_HEADER_LENGTH;
453             }
454              
455 92         156 my $self = {};
456 92         199 $self->{_regfile} = $regfile;
457 92         142 $self->{_offset} = $offset;
458 92         134 $self->{_length} = $length;
459 92         135 $self->{_length_used} = $length_used;
460 92         127 $self->{_header_length} = $header_length;
461 92         136 $self->{_allocated} = 1;
462 92         187 $self->{_tag} = 'rgdb key';
463 92         247 $self->{_id} = $key_id;
464 92         189 $self->{_name} = $name;
465 92         133 $self->{_name_length} = $name_length;
466 92         133 $self->{_num_values} = $num_values;
467 92         243 bless $self, $class;
468              
469 92         447 return $self;
470             }
471              
472             sub get_name {
473 299     299   370 my $self = shift;
474              
475 299         1501 return $self->{_name};
476             }
477              
478             sub parse_info {
479 0     0   0 my $self = shift;
480              
481 0         0 my $info = sprintf '0x%x rgdb key len=0x%x/0x%x "%s" id=0x%x vals=%d',
482             $self->{_offset},
483             $self->{_length_used},
484             $self->{_length},
485             $self->{_name},
486             $self->{_id},
487             $self->{_num_values};
488              
489 0         0 return $info;
490             }
491              
492             sub get_value_iterator {
493 144     144   205 my $self = shift;
494              
495 144         307 my $regfile = $self->{_regfile};
496              
497 144         280 my $num_values_remaining = $self->{_num_values};
498              
499 144         246 my $offset = $self->{_offset};
500              
501             # offset_to_next_rgdb_value can only be set to a valid offset
502             # if num_values_remaining > 0
503 144         190 my $offset_to_next_rgdb_value = 0xffffffff;
504 144 100       337 if ($num_values_remaining > 0) {
505 119         218 $offset_to_next_rgdb_value = $offset
506             + $self->{_header_length};
507             }
508              
509 144         336 my $end_of_rgdb_key = $offset + $self->{_length};
510              
511             # don't attempt to return values if id is invalid...
512 144 50       373 if ($self->{_id} == 0xffffffff) {
513 0         0 $num_values_remaining = 0;
514             }
515              
516             return Parse::Win32Registry::Iterator->new(sub {
517 3321 100   3321   6662 if ($num_values_remaining-- <= 0) {
518 134         455 return;
519             }
520 3187 50       5609 if ($offset_to_next_rgdb_value == 0xffffffff) {
521 0         0 return;
522             }
523 3187 50       5260 if ($offset_to_next_rgdb_value > $end_of_rgdb_key) {
524 0         0 return;
525             }
526 3187 50       9262 if (my $value = Parse::Win32Registry::Win95::Value->new($regfile,
527             $offset_to_next_rgdb_value))
528             {
529 3187 50       8050 return unless $value->get_length > 0;
530 3187         7917 $offset_to_next_rgdb_value += $value->get_length;
531 3187         13867 return $value;
532             }
533             else {
534 0           return; # no more values
535             }
536 144         1303 });
537             }
538              
539             1;
540