File Coverage

blib/lib/Parse/Win32Registry/Win95/Key.pm
Criterion Covered Total %
statement 103 109 94.5
branch 26 32 81.2
condition n/a
subroutine 19 21 90.4
pod 0 11 0.0
total 148 173 85.5


line stmt bran cond sub pod time code
1             package Parse::Win32Registry::Win95::Key;
2              
3 13     13   91 use strict;
  13         31  
  13         411  
4 13     13   69 use warnings;
  13         25  
  13         377  
5              
6 13     13   67 use base qw(Parse::Win32Registry::Key);
  13         41  
  13         5942  
7              
8 13     13   96 use Carp;
  13         30  
  13         813  
9 13     13   88 use Parse::Win32Registry::Base qw(:all);
  13         26  
  13         2918  
10 13     13   5988 use Parse::Win32Registry::Win95::Value;
  13         35  
  13         384  
11              
12 13     13   90 use constant RGKN_ENTRY_LENGTH => 0x1c;
  13         28  
  13         732  
13 13     13   78 use constant OFFSET_TO_RGKN_BLOCK => 0x20;
  13         26  
  13         13017  
14              
15             sub new {
16 332     332 0 786 my $class = shift;
17 332         480 my $regfile = shift;
18 332         474 my $offset = shift; # offset to RGKN key entry relative to start of RGKN
19 332         472 my $parent_key_path = shift; # parent key path (optional)
20              
21 332 50       644 croak 'Missing registry file' if !defined $regfile;
22 332 50       583 croak 'Missing offset' if !defined $offset;
23              
24 332         821 my $fh = $regfile->get_filehandle;
25              
26             # RGKN Key Entry
27             # 0x00 dword
28             # 0x04 dword
29             # 0x08 dword
30             # 0x0c dword = offset to parent RGKN entry
31             # 0x10 dword = offset to first child RGKN entry
32             # 0x14 dword = offset to next sibling RGKN entry
33             # 0x18 dword = entry id of RGDB entry
34              
35             # Extracted offsets are relative to the start of the RGKN block
36              
37             # Any offset of 0xffffffff marks the end of a list.
38             # An entry id of 0xffffffff means the RGKN entry has no RGDB entry.
39             # This occurs for the root key of the registry file.
40              
41 332         2127 sysseek($fh, $offset, 0);
42 332         2642 my $bytes_read = sysread($fh, my $rgkn_entry, RGKN_ENTRY_LENGTH);
43 332 100       966 if ($bytes_read != RGKN_ENTRY_LENGTH) {
44 1         6 warnf('Could not read RGKN key at 0x%x', $offset);
45 1         15 return;
46             }
47              
48 331         1222 my ($offset_to_parent,
49             $offset_to_first_child,
50             $offset_to_next_sibling,
51             $key_id) = unpack('x12VVVV', $rgkn_entry);
52              
53 331 100       771 $offset_to_parent += OFFSET_TO_RGKN_BLOCK
54             if $offset_to_parent != 0xffffffff;
55 331 100       660 $offset_to_first_child += OFFSET_TO_RGKN_BLOCK
56             if $offset_to_first_child != 0xffffffff;
57 331 100       607 $offset_to_next_sibling += OFFSET_TO_RGKN_BLOCK
58             if $offset_to_next_sibling != 0xffffffff;
59              
60 331         628 my $self = {};
61 331         819 $self->{_regfile} = $regfile;
62 331         607 $self->{_offset} = $offset;
63 331         540 $self->{_length} = RGKN_ENTRY_LENGTH;
64 331         547 $self->{_allocated} = 1;
65 331         562 $self->{_tag} = 'rgkn key';
66 331         490 $self->{_offset_to_parent} = $offset_to_parent;
67 331         540 $self->{_offset_to_first_child} = $offset_to_first_child;
68 331         806 $self->{_offset_to_next_sibling} = $offset_to_next_sibling;
69 331         576 $self->{_id} = $key_id;
70 331         587 bless $self, $class;
71              
72             # Look up corresponding rgdb entry
73 331         546 my $index = $regfile->{_rgdb_index};
74 331 50       677 croak 'Missing rgdb index' if !defined $index;
75 331 100       814 if (exists $index->{$key_id}) {
76 299         531 my $rgdb_key = $index->{$key_id};
77 299         496 $self->{_rgdb_key} = $rgdb_key;
78 299         931 $self->{_name} = $rgdb_key->get_name;
79             }
80             else {
81 32         118 $self->{_name} = '';
82             # Only the root key should have no matching RGDB entry
83 32 100       92 if (!$self->is_root) {
84 1         14 warnf('Could not find RGDB entry for RGKN key at 0x%x', $offset);
85             }
86             }
87              
88 331         623 my $name = $self->{_name};
89 331 100       1034 $self->{_key_path} = defined($parent_key_path)
90             ? "$parent_key_path\\$name"
91             : $name;
92              
93 331         1085 return $self;
94             }
95              
96             sub get_timestamp {
97 33     33 0 9294 return undef;
98             }
99              
100             sub get_timestamp_as_string {
101 34     34 0 5109 return iso8601(undef);
102             }
103              
104             sub get_class_name {
105 17     17 0 62 return undef;
106             }
107              
108             sub is_root {
109 146     146 0 6205 my $self = shift;
110              
111 146         232 my $offset = $self->{_offset};
112 146         228 my $regfile = $self->{_regfile};
113              
114 146         389 my $rgkn_block = $regfile->get_rgkn;
115 146         253 my $offset_to_root_key = $rgkn_block->{_offset_to_root_key};
116              
117             # This gives better results than checking id == 0xffffffff
118 146         471 return $offset == $offset_to_root_key;
119             }
120              
121             sub get_parent {
122 48     48 0 83 my $self = shift;
123              
124 48         94 my $regfile = $self->{_regfile};
125 48         76 my $offset_to_parent = $self->{_offset_to_parent};
126 48         80 my $key_path = $self->{_key_path};
127              
128 48 50       103 return if $self->is_root;
129              
130 48         81 my $grandparent_key_path;
131 48         223 my @keys = split(/\\/, $key_path, -1);
132 48 100       124 if (@keys > 2) {
133 28         109 $grandparent_key_path = join("\\", @keys[0..$#keys-2]);
134             }
135              
136 48         132 return Parse::Win32Registry::Win95::Key->new($regfile,
137             $offset_to_parent,
138             $grandparent_key_path);
139             }
140              
141             sub get_security {
142 0     0 0 0 return undef;
143             }
144              
145             sub as_string {
146 23     23 0 5009 my $self = shift;
147              
148 23         100 return $self->get_path;
149             }
150              
151             sub parse_info {
152 0     0 0 0 my $self = shift;
153              
154             my $info = sprintf '0x%x rgkn key len=0x%x par=0x%x,child=0x%x,next=0x%x id=0x%x',
155             $self->{_offset},
156             $self->{_length},
157             $self->{_offset_to_parent},
158             $self->{_offset_to_first_child},
159             $self->{_offset_to_next_sibling},
160 0         0 $self->{_id};
161 0         0 return $info;
162             }
163              
164             sub get_subkey_iterator {
165 126     126 0 200 my $self = shift;
166              
167 126         226 my $regfile = $self->{_regfile};
168 126         233 my $key_path = $self->{_key_path};
169              
170 126         209 my $offset_to_next_key = $self->{_offset_to_first_child};
171              
172 126         433 my $end_of_file = $regfile->get_length;
173 126         411 my $rgkn_block = $regfile->get_rgkn;
174 126         352 my $end_of_rgkn_block = $rgkn_block->get_offset + $rgkn_block->get_length;
175              
176             return Parse::Win32Registry::Iterator->new(sub {
177 397 100   397   833 if ($offset_to_next_key == 0xffffffff) {
178 126         368 return; # no more subkeys
179             }
180 271 50       499 if ($offset_to_next_key > $end_of_rgkn_block) {
181 0         0 return;
182             }
183 271 50       637 if (my $key = Parse::Win32Registry::Win95::Key->new($regfile,
184             $offset_to_next_key, $key_path))
185             {
186 271         452 $offset_to_next_key = $key->{_offset_to_next_sibling};
187 271         876 return $key;
188             }
189             else {
190 0         0 return; # no more subkeys
191             }
192 126         844 });
193             }
194              
195             sub get_value_iterator {
196 151     151 0 254 my $self = shift;
197              
198 151         290 my $rgdb_key = $self->{_rgdb_key};
199 151 100       334 if (defined $rgdb_key) {
200 140         440 return $rgdb_key->get_value_iterator;
201             }
202             else {
203 11     8   63 return Parse::Win32Registry::Iterator->new(sub {});
204             }
205             }
206              
207             1;