root/honeyclient/branches/bug/42/lib/HoneyClient/Agent/Integrity/Registry/Parser.pm

Revision 123, 50.2 kB (checked in by kindlund, 4 years ago)

Completed alpha version of bug fix. Still have to test it out on our test VM network.

  • Property svn:keywords set to Id "$file"
Line 
1 ####################################################################
2 #
3 #    This file was generated using Parse::Yapp version 1.05.
4 #
5 #        Don't edit this file, use source file instead.
6 #
7 #             ANY CHANGE MADE HERE WILL BE LOST !
8 #
9 ####################################################################
10 package HoneyClient::Agent::Integrity::Registry::Parser;
11 use vars qw ( @ISA );
12 use strict;
13
14 @ISA= qw ( Parse::Yapp::Driver );
15 use Parse::Yapp::Driver;
16
17 #line 1 "Parser.yp"
18
19 #######################################################################
20 # Created on:  Dec 10, 2006
21 # Package:     HoneyClient::Agent::Integrity::Registry::Parser
22 # File:        Parser.pm
23 # Description: Parses static hive dumps of the Windows OS registry.
24 #
25 # CVS: $Id$
26 #
27 # @author kindlund
28 #
29 # Copyright (C) 2006 The MITRE Corporation.  All rights reserved.
30 #
31 # This program is free software; you can redistribute it and/or
32 # modify it under the terms of the GNU General Public License
33 # as published by the Free Software Foundation, using version 2
34 # of the License.
35 #
36 # This program is distributed in the hope that it will be useful,
37 # but WITHOUT ANY WARRANTY; without even the implied warranty of
38 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
39 # GNU General Public License for more details.
40 #
41 # You should have received a copy of the GNU General Public License
42 # along with this program; if not, write to the Free Software
43 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
44 # 02110-1301, USA.
45 #
46 #######################################################################
47
48 =pod
49
50 =head1 NAME
51
52 HoneyClient::Agent::Integrity::Registry::Parser - Perl extension to parse
53 static hive dumps of the Windows OS registry.
54
55 =head1 VERSION
56
57 This documentation refers to HoneyClient::Agent::Integrity::Registry::Parser version 1.0.
58
59 =head1 SYNOPSIS
60
61   use HoneyClient::Agent::Integrity::Registry::Parser;
62   use IO::File;
63   use Data::Dumper;
64
65   # Initialize the parser object.
66   my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(
67                    input_file => "dump.reg",
68                );
69
70   # Print each registry group found, until there are no more left.
71   my $registryGroup = $parser->nextGroup();
72   while(scalar(keys(%{$registryGroup}))) {
73       print Dumper($registryGroup);
74       $registryGroup = $parser->nextGroup();
75   }
76
77   # $registryGroup refers to hashtable reference, which has the
78   # following format:
79   #
80   # $registryGroup = {
81   #     # The registry directory name.
82   #     'key' => 'HKEY_LOCAL_MACHINE\Software...',
83   #
84   #     # An array containing the list of entries within the
85   #     # registry directory.
86   #     'entries'  => [ {
87   #         'name' => "\"string\"",  # A (potentially) quoted string;
88   #                                  # "@" for default
89   #         'value' => "data",
90   #     }, ],
91   # };
92
93 =head1 DESCRIPTION
94
95 This library allows the Registry module to easily parse and enumerate
96 each Windows OS registry hive.
97
98 =cut
99
100 use strict;
101 use warnings;
102 use Carp ();
103
104 # Include Global Configuration Processing Library
105 use HoneyClient::Util::Config qw(getVar);
106
107 # Include Logging Library
108 use Log::Log4perl qw(:easy);
109
110 # Use Dumper Library.
111 use Data::Dumper;
112
113 # Use IO File Library.
114 use IO::File;
115
116 # Use Seek Library.
117 use Fcntl qw(:seek);
118
119 # Use Binary Search Library.
120 use Search::Binary;
121
122 # Use Progress Bar Library.
123 use Term::ProgressBar;
124
125 #######################################################################
126 # Module Initialization                                               #
127 #######################################################################
128
129 BEGIN {
130     # Defines which functions can be called externally.
131     require Exporter;
132     our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
133
134     # Set our package version.
135     $VERSION = 0.9;
136
137     @ISA = qw(Exporter);
138
139     # Symbols to export on request
140     @EXPORT = qw( );
141
142     # Items to export into callers namespace by default. Note: do not export
143     # names by default without a very good reason. Use EXPORT_OK instead.
144     # Do not simply export all your public functions/methods/constants.
145
146     # This allows declaration use HoneyClient::Agent::Integrity::Registry ':all';
147     # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
148     # will save memory.
149
150     %EXPORT_TAGS = (
151         'all' => [ qw( ) ],
152     );
153
154     # Symbols to autoexport (:DEFAULT tag)
155     @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
156
157     $SIG{PIPE} = 'IGNORE'; # Do not exit on broken pipes.
158 }
159 our (@EXPORT_OK, $VERSION);
160
161 =pod
162
163 =begin testing
164
165 # Make sure Log::Log4perl loads
166 BEGIN { use_ok('Log::Log4perl', qw(:nowarn))
167         or diag("Can't load Log::Log4perl package. Check to make sure the package library is correctly listed within the path.");
168        
169         # Suppress all logging messages, since we need clean output for unit testing.
170         Log::Log4perl->init({
171             "log4perl.rootLogger"                               => "DEBUG, Buffer",
172             "log4perl.appender.Buffer"                          => "Log::Log4perl::Appender::TestBuffer",
173             "log4perl.appender.Buffer.min_level"                => "fatal",
174             "log4perl.appender.Buffer.layout"                   => "Log::Log4perl::Layout::PatternLayout",
175             "log4perl.appender.Buffer.layout.ConversionPattern" => "%d{yyyy-MM-dd HH:mm:ss} %5p [%M] (%F:%L) - %m%n",
176         });
177 }
178 require_ok('Log::Log4perl');
179 use Log::Log4perl qw(:easy);
180
181 # Make sure the module loads properly, with the exportable
182 # functions shared.
183 BEGIN { use_ok('HoneyClient::Util::Config', qw(getVar setVar))
184         or diag("Can't load HoneyClient::Util::Config package.  Check to make sure the package library is correctly listed within the path."); }
185 require_ok('HoneyClient::Util::Config');
186 can_ok('HoneyClient::Util::Config', 'getVar');
187 can_ok('HoneyClient::Util::Config', 'setVar');
188 use HoneyClient::Util::Config qw(getVar setVar);
189
190 # Suppress all logging messages, since we need clean output for unit testing.
191 Log::Log4perl->init({
192     "log4perl.rootLogger"                               => "DEBUG, Buffer",
193     "log4perl.appender.Buffer"                          => "Log::Log4perl::Appender::TestBuffer",
194     "log4perl.appender.Buffer.min_level"                => "fatal",
195     "log4perl.appender.Buffer.layout"                   => "Log::Log4perl::Layout::PatternLayout",
196     "log4perl.appender.Buffer.layout.ConversionPattern" => "%d{yyyy-MM-dd HH:mm:ss} %5p [%M] (%F:%L) - %m%n",
197 });
198
199 # Make sure Data::Dumper loads
200 BEGIN { use_ok('Data::Dumper')
201         or diag("Can't load Data::Dumper package. Check to make sure the package library is correctly listed within the path."); }
202 require_ok('Data::Dumper');
203 use Data::Dumper;
204
205 # Make sure IO::File loads
206 BEGIN { use_ok('IO::File')
207         or diag("Can't load IO::File package. Check to make sure the package library is correctly listed within the path."); }
208 require_ok('IO::File');
209 use IO::File;
210
211 # Make sure Fcntl loads
212 BEGIN { use_ok('Fcntl')
213         or diag("Can't load Fcntl package. Check to make sure the package library is correctly listed within the path."); }
214 require_ok('Fcntl');
215 use Fcntl qw(:seek);
216
217 # Make sure Search::Binary loads
218 BEGIN { use_ok('Search::Binary')
219         or diag("Can't load Search::Binary package. Check to make sure the package library is correctly listed within the path."); }
220 require_ok('Search::Binary');
221 can_ok('Search::Binary', 'binary_search');
222 use Search::Binary;
223
224 # Make sure Term::ProgressBar loads
225 BEGIN { use_ok('Term::ProgressBar')
226         or diag("Can't load Term::ProgressBar package. Check to make sure the package library is correctly listed within the path."); }
227 require_ok('Term::ProgressBar');
228 use Term::ProgressBar;
229
230 # Make sure HoneyClient::Agent::Integrity::Registry::Parser loads
231 BEGIN { use_ok('HoneyClient::Agent::Integrity::Registry::Parser')
232         or diag("Can't load HoneyClient::Agent::Integrity::Registry::Parser package. Check to make sure the package library is correctly listed within the path."); }
233 require_ok('HoneyClient::Agent::Integrity::Registry::Parser');
234 use HoneyClient::Agent::Integrity::Registry::Parser;
235
236 =end testing
237
238 =cut
239
240 #######################################################################
241 # Global Configuration Variables
242 #######################################################################
243
244 # The global logging object.
245 our $LOG = get_logger();
246
247 # Make Dumper format more terse.
248 $Data::Dumper::Terse = 1;
249 $Data::Dumper::Indent = 1;
250
251
252
253 sub new {
254         my($class)=shift;
255         ref($class)
256     and $class=ref($class);
257
258     my($self)=$class->SUPER::new( yyversion => '1.05',
259                                   yystates =>
260 [
261     {#State 0
262         ACTIONS => {
263             'DIR_NAME' => 2,
264             'HEADER' => 5,
265             'NEWLINE' => 6
266         },
267         DEFAULT => -1,
268         GOTOS => {
269             'group' => 1,
270             'registry' => 3,
271             'groups' => 4
272         }
273     },
274     {#State 1
275         DEFAULT => -4
276     },
277     {#State 2
278         ACTIONS => {
279             'KEY_NAME' => 7
280         },
281         DEFAULT => -9,
282         GOTOS => {
283             'entry' => 8,
284             'entries' => 9
285         }
286     },
287     {#State 3
288         ACTIONS => {
289             '' => 10
290         }
291     },
292     {#State 4
293         DEFAULT => -2
294     },
295     {#State 5
296         ACTIONS => {
297             'DIR_NAME' => 2,
298             'NEWLINE' => 6
299         },
300         GOTOS => {
301             'group' => 1,
302             'groups' => 11
303         }
304     },
305     {#State 6
306         ACTIONS => {
307             'DIR_NAME' => 2
308         },
309         GOTOS => {
310             'group' => 12
311         }
312     },
313     {#State 7
314         ACTIONS => {
315             'KEY_VALUE' => 13
316         }
317     },
318     {#State 8
319         ACTIONS => {
320             'KEY_NAME' => 7
321         },
322         DEFAULT => -10,
323         GOTOS => {
324             'entry' => 8,
325             'entries' => 14
326         }
327     },
328     {#State 9
329         DEFAULT => -8
330     },
331     {#State 10
332         DEFAULT => 0
333     },
334     {#State 11
335         DEFAULT => -3
336     },
337     {#State 12
338         ACTIONS => {
339             'DIR_NAME' => 2,
340             'NEWLINE' => 16
341         },
342         DEFAULT => -5,
343         GOTOS => {
344             'group' => 1,
345             'groups' => 15
346         }
347     },
348     {#State 13
349         DEFAULT => -12
350     },
351     {#State 14
352         DEFAULT => -11
353     },
354     {#State 15
355         DEFAULT => -7
356     },
357     {#State 16
358         ACTIONS => {
359             'DIR_NAME' => 2
360         },
361         DEFAULT => -6,
362         GOTOS => {
363             'group' => 12
364         }
365     }
366 ],
367                                   yyrules  =>
368 [
369     [#Rule 0
370          '$start', 2, undef
371     ],
372     [#Rule 1
373          'registry', 0,
374 sub
375 #line 247 "Parser.yp"
376 {
377             $LOG->debug("Reached end of input stream.");
378             # Finished parsing the entire file, return empty hash ref.
379             return { };
380         }
381     ],
382     [#Rule 2
383          'registry', 1,
384 sub
385 #line 252 "Parser.yp"
386 {
387             $LOG->debug("Reached end of input stream.");
388             # Finished parsing the entire file, return empty hash ref.
389             return { };
390         }
391     ],
392     [#Rule 3
393          'registry', 2,
394 sub
395 #line 257 "Parser.yp"
396 {
397             $LOG->debug("Reached end of input stream.");
398             # Finished parsing the entire file, return empty hash ref.
399             return { };
400         }
401     ],
402     [#Rule 4
403          'groups', 1, undef
404     ],
405     [#Rule 5
406          'groups', 2, undef
407     ],
408     [#Rule 6
409          'groups', 3, undef
410     ],
411     [#Rule 7
412          'groups', 3, undef
413     ],
414     [#Rule 8
415          'group', 2,
416 sub
417 #line 274 "Parser.yp"
418 {
419             my $ret = { };
420             $_[0]->YYData->{'latest_group'}->{'key'} = $_[1];
421             if (!exists($_[0]->YYData->{'latest_group'}->{'entries'})) {
422                 # Make sure the 'entries' key exists.
423                 $_[0]->YYData->{'latest_group'}->{'entries'} = [];
424             }
425             $ret = $_[0]->YYData->{'latest_group'};
426             $_[0]->YYData->{'latest_group'} = { };
427             $_[0]->YYData->{'dir_count'}++;
428             $_[0]->YYAccept; # Terminate the parse, early.
429
430             return $ret;
431         }
432     ],
433     [#Rule 9
434          'group', 1,
435 sub
436 #line 288 "Parser.yp"
437 {
438             my $ret = { };
439             $_[0]->YYData->{'latest_group'}->{'key'} = $_[1];
440             if (!exists($_[0]->YYData->{'latest_group'}->{'entries'})) {
441                 # Make sure the 'entries' key exists.
442                 $_[0]->YYData->{'latest_group'}->{'entries'} = [];
443             }
444             $ret = $_[0]->YYData->{'latest_group'};
445             $_[0]->YYData->{'latest_group'} = { };
446             $_[0]->YYData->{'dir_count'}++;
447             $_[0]->YYAccept; # Terminate the parse, early.
448
449             return $ret;
450         }
451     ],
452     [#Rule 10
453          'entries', 1, undef
454     ],
455     [#Rule 11
456          'entries', 2, undef
457     ],
458     [#Rule 12
459          'entry', 2,
460 sub
461 #line 312 "Parser.yp"
462 {
463             my $entry = {
464                 name  => $_[1],
465                 value => $_[2],
466             };
467             push(@{$_[0]->YYData->{'latest_group'}->{entries}}, $entry);
468             $_[0]->YYData->{'entry_count'}++;
469         }
470     ]
471 ],
472                                   @_);
473     bless($self,$class);
474 }
475
476 #line 322 "Parser.yp"
477
478
479 #######################################################################
480 # Private Methods Implemented                                         #
481 #######################################################################
482
483 # Helper function, designed to tokenize specific data from the input stream.
484 #
485 # Inputs: parser
486 # Outputs: (token_id, data) pair
487 sub _lexer {
488     # Identify NEWLINE token.
489     if ($_[0]->YYData->{DATA} =~ m/\G\n/cg) {
490         $_[0]->YYData->{'in_group'} = 0;
491         $LOG->debug("Found NEWLINE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
492         $_[0]->YYData->{'line_count'}++;
493         return ("NEWLINE", "\n");
494     }
495
496     # Check to see if we're inside a group block...
497     if (!$_[0]->YYData->{'in_group'}) {
498
499         $_[0]->YYData->{'input_pos'} = pos($_[0]->YYData->{DATA});
500         $_[0]->YYData->{'input_pos'} = $_[0]->YYData->{'input_pos'} ?
501                                        $_[0]->YYData->{'input_pos'} : 0;
502         $_[0]->YYData->{'input_pos'} = $_[0]->YYData->{'input_pos'} +
503                                        $_[0]->YYData->{'abs_offset'};
504
505         # Update progress bar, if defined.
506         if (defined($_[0]->YYData->{'progress'}) &&
507             ($_[0]->YYData->{'input_pos'} > $_[0]->YYData->{'progress_next_update'})) {
508             $_[0]->YYData->{'progress_next_update'} =
509                 $_[0]->YYData->{'progress'}->update($_[0]->YYData->{'input_pos'});
510         }
511
512         # Identify DIR_NAME token.
513         if ($_[0]->YYData->{DATA} =~ m/\G\[(.*)\]\n/cg) {
514             $_[0]->YYData->{'in_group'} = 1;
515             $LOG->debug("Found DIR_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
516             $_[0]->YYData->{'last_group_line_number'} = $_[0]->YYData->{'line_count'};
517             $_[0]->YYData->{'line_count'}++;
518             return ("DIR_NAME", $1);
519         }
520
521         # Identify HEADER token. It's always only at the beginning.
522         if ($_[0]->YYData->{DATA} =~ m/\GREGEDIT4\n/cg) {
523             $LOG->debug("Found HEADER token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
524             $_[0]->YYData->{'line_count'}++;
525             return ("HEADER", "REGEDIT4\n");
526         }
527
528     } else {
529
530         # Check to see if we're in a value segment...
531         if (!$_[0]->YYData->{'in_value'}) {
532
533             # Identify KEY_NAME token.
534             if ($_[0]->YYData->{DATA} =~ m/\G\"(|[^\\]|.*(?:\\[^\\]|\\\\|[^\\][^\\]))\"(?==)/cg) {
535                 $_[0]->YYData->{'in_value'} = 1;
536                 $LOG->debug("Found KEY_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
537                 return ("KEY_NAME", $1);
538             }
539
540             # Identify default KEY_NAME token (@).
541             if ($_[0]->YYData->{DATA} =~ m/\G\@(?==)/cg) {
542                 $_[0]->YYData->{'in_value'} = 1;
543                 $LOG->debug("Found KEY_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
544                 return ("KEY_NAME", "@");
545             }
546
547         } else {
548
549             # Identify string KEY_VALUE token.
550             if ($_[0]->YYData->{DATA} =~ m/\G=\"(|[^\\]|.*?(?:\\[^\\]|\\\\|[^\\][^\\]))\"\n/cgs) {
551                 $_[0]->YYData->{'in_value'} = 0;
552                 $LOG->debug("Found KEY_VALUE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
553                 $_[0]->YYData->{'line_count'} += 1 + @{[$1 =~ /\n/g]};
554                 return ("KEY_VALUE", $1);
555             }
556
557             # Identify binary KEY_VALUE token.
558             if ($_[0]->YYData->{DATA} =~ m/\G=(|.*?[^\\])\n/cgs) {
559                 $_[0]->YYData->{'in_value'} = 0;
560                 $LOG->debug("Found KEY_VALUE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
561                 $_[0]->YYData->{'line_count'} += 1 + @{[$1 =~ /\n/g]};
562                 return ("KEY_VALUE", $1);
563             }
564         }
565     }
566    
567     # Croak if encountered a token error.
568     if ($_[0]->YYData->{DATA} =~ m/\G(.*\n)/cg) {
569         $_[0]->YYData->{'input_pos'} = pos($_[0]->YYData->{DATA});
570         $LOG->fatal("Error: Unknown token (" . $1 . ") at offset (". $_[0]->YYData->{'input_pos'} .")");
571         Carp::croak("Error: Unknown token (" . $1 . ") at offset (". $_[0]->YYData->{'input_pos'} .")");
572     }
573     return ('', undef);
574 }
575
576 # Helper function, designed to report when any parsing error
577 # occurs.
578 #
579 # Inputs: parser
580 # Outputs: None
581 sub _error {
582
583     $LOG->fatal("Error: Malformed input found at offset (" . $_[0]->YYData->{'input_pos'} . ").");
584     Carp::croak("Error: Malformed input found at offset (" . $_[0]->YYData->{'input_pos'} . ").");
585 }
586
587 # Helper function, designed to reset the parser's file stream back to the
588 # beginning, allowing the parser to reparse from the beginning.  Or, if
589 # specified, the function will seek the parser to the specified offset.
590 #
591 # Inputs: parser, absolute offset (optional)
592 # Outputs: none
593 sub _reset {
594     # Extract arguments.
595     my ($self, $offset) = @_;
596
597     $LOG->debug("Resetting parser.");
598
599     $self->YYData->{'file_handle'} = undef;
600
601     my $fh = new IO::File($self->YYData->{'filename'}, "r");
602     if (!defined($fh)) {
603         $LOG->fatal("Error: Unable to read file '" . $self->YYData->{'filename'} . "'!");
604         Carp::croak("Error: Unable to read file '" . $self->YYData->{'filename'} . "'!");
605     }
606
607     $self->YYData->{'file_handle'} = $fh;
608
609     # Check the offset.
610     if (!defined($offset)) {
611         $offset = 0;
612     }
613     seek($fh, $offset, SEEK_SET);
614
615     undef $/;
616     $self->YYData->{DATA} = <$fh>;
617
618     # Strip all CRs.
619     $self->YYData->{DATA} =~ s/\r//g;
620
621     # Total size of input file.
622     $self->YYData->{'file_size'} = (stat($fh))[7];
623
624     # Reinitialize helper variables.
625     # Hashtable, to represent the latest, extracted group chunk.
626     $self->YYData->{'latest_group'} = { };
627
628     # Boolean, to indicate when we're parsing inside a group chunk.
629     $self->YYData->{'in_group'} = 0;
630
631     # Boolean, to indicate when we're parsing inside a value segment.
632     $self->YYData->{'in_value'} = 0;
633    
634     # Regexp offset, used to record where the parser is within
635     # the file (relative position).
636     $self->YYData->{'input_pos'} = 0;
637
638     # Absolute offset, recording where the parser initially seeked to.
639     $self->YYData->{'abs_offset'} = $offset;
640
641     # Initialize statistics.
642     # Total number of directories parsed.
643     $self->YYData->{'dir_count'} = 0;
644
645     # Total number of key/value pairs parsed.
646     $self->YYData->{'entry_count'} = 0;
647
648     # Total number of lines parsed.
649     $self->YYData->{'line_count'} = 0;
650
651     # Last line number that corresponded to a group separation point.
652     $self->YYData->{'last_group_line_number'} = 0;
653
654     # Progress bar information.
655     if ($self->YYData->{'show_progress'}) {
656         $self->YYData->{'progress'} = Term::ProgressBar->new({ name  => 'Progress',
657                                                                count => $self->YYData->{'file_size'},
658                                                                ETA   => 'linear', });
659         $self->YYData->{'progress'}->minor(0);
660         $self->YYData->{'progress'}->max_update_rate(1);
661         $self->YYData->{'progress_next_update'} = $self->YYData->{'progress'}->update($offset);
662     } else {
663         $self->YYData->{'progress'} = undef;
664     }
665 }
666
667 # Helper function, designed to index all groups, based upon beginning file
668 # offsets.
669 #
670 # Inputs: parser
671 # Outputs: None
672 sub _index {
673     # Extract arguments.
674     my $self = shift;
675
676     $LOG->debug("Starting group index process.");
677
678     $self->YYData->{'group_index_offsets'} = [0, ];
679     $self->YYData->{'group_index_linenums'} = [0, ];
680
681     my $registryGroup = $self->nextGroup();
682     while(scalar(keys(%{$registryGroup}))) {
683         push (@{$self->YYData->{'group_index_offsets'}}, $self->YYData->{'input_pos'});
684         push (@{$self->YYData->{'group_index_linenums'}}, $self->YYData->{'last_group_line_number'});
685         $registryGroup = $self->nextGroup();
686     }
687
688     # Reset the parser.
689     $self->_reset();
690
691     $LOG->debug("Finished group index process.");
692 }
693
694 # Helper function, designed to be called from within the
695 # Search::Binary::binary_search() function, in order to allow
696 # the binary_search to properly read in group index data from
697 # the default parser reference.
698 #
699 # For more information about how this function operates, please
700 # see the Search::Binary POD documentation.
701 #
702 # Inputs: parser, value_to_compare, current_array_index
703 # Outputs: comparison, last_valid_array_index
704 sub _search {
705     # Extract arguments.
706     my ($parser, $value_to_compare, $current_array_index) = @_;
707
708     # Increment the search index, if the current one is undef.
709     if (defined($current_array_index)) {
710         $parser->YYData->{'last_search_index'} = $current_array_index;
711     } else {
712         $parser->YYData->{'last_search_index'}++;
713     }
714
715     # Perform a comparison, if the array entry is defined.
716     # Check to see if the search is for line numbers or offsets.
717     if ($parser->YYData->{'search_is_linenum'}) {
718         if (defined(@{$parser->YYData->{'group_index_linenums'}}[$parser->YYData->{'last_search_index'}])) {
719             return($value_to_compare <=> @{$parser->YYData->{'group_index_linenums'}}[$parser->YYData->{'last_search_index'}],
720                    $parser->YYData->{'last_search_index'});
721         }
722     } else {
723         if (defined(@{$parser->YYData->{'group_index_offsets'}}[$parser->YYData->{'last_search_index'}])) {
724             return($value_to_compare <=> @{$parser->YYData->{'group_index_offsets'}}[$parser->YYData->{'last_search_index'}],
725                    $parser->YYData->{'last_search_index'});
726         }
727     }
728
729     # Array entry not found, return undef with this position.
730     return (undef, $parser->YYData->{'last_search_index'});
731 }
732
733 #######################################################################
734 # Public Methods Implemented                                          #
735 #######################################################################
736
737 =pod
738
739 =head1 METHODS IMPLEMENTED
740
741 The following functions have been implemented by any Parser object.
742
743 =head2 HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $filename,
744                                                              index_groups => $perform_index,
745                                                              show_progress => $progress)
746
747 =over 4
748
749 Creates a new Parser object, using the specified input file as its data
750 source.
751
752 I<Inputs>:
753  B<$filename> is an required parameter, specifying the file to open for parsing.
754  B<$perform_index> is an optional parameter.  1 specifies that the parser should go
755 ahead and scan the entire file, indexing the file offsets of where groups start and
756 end.  Otherwise, this indexing process is not performed.
757  B<$progress> is an optional parameter.  1 specifies that the parser should display
758 a progress bar, as it scans through a specified file.  Otherwise, a progress bar
759 is not displayed.
760  
761 I<Output>: The instantiated Parser B<$object>, fully initialized.
762
763 =back
764
765 =begin testing
766
767 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
768                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
769
770 # Create a generic Parser object, with test state data.
771 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);
772 isa_ok($parser, 'HoneyClient::Agent::Integrity::Registry::Parser', "init(input_file => $test_registry_file)") or diag("The init() call failed.");
773
774 =end testing
775
776 =cut
777
778 sub init {
779
780     # Extract arguments.
781     my ($self, %args) = @_;
782
783     # Log resolved arguments.
784     # Make Dumper format more terse.
785     $Data::Dumper::Terse = 1;
786     $Data::Dumper::Indent = 0;
787     $LOG->debug(Dumper(\%args));
788
789     # Sanity check, don't initialize, unless input_file_handle
790     # was provided.
791     my $argsExist = scalar(%args);
792     if (!$argsExist ||
793         !exists($args{'input_file'}) ||
794         !defined($args{'input_file'})) {
795         $LOG->fatal("Error: Unable to create parser - no 'input_file' specified!");
796         Carp::croak("Error: Unable to create parser - no 'input_file' specified!");
797     }
798
799     my $parser = HoneyClient::Agent::Integrity::Registry::Parser->new();
800     my $fh = new IO::File($args{'input_file'}, "r");
801     if (!defined($fh)) {
802         $LOG->fatal("Error: Unable to read file '" . $args{'input_file'} . "'!");
803         Carp::croak("Error: Unable to read file '" . $args{'input_file'} . "'!");
804     }
805    
806     # Check if show progress was specified.
807     if ($argsExist &&
808         exists($args{'show_progress'}) &&
809         defined($args{'show_progress'}) &&
810         $args{'show_progress'}) {
811         $parser->YYData->{'show_progress'} = 1;
812     } else {
813         $parser->YYData->{'show_progress'} = 0;
814     }
815
816     # Save the file name.
817     $parser->YYData->{'filename'} = $args{'input_file'};
818
819     # Save the file handle.
820     $parser->YYData->{'file_handle'} = $fh;
821
822     # Reset the parser.
823     $parser->_reset();
824
825     # Perform group indexing, if specified.
826     if ($argsExist &&
827         exists($args{'index_groups'}) &&
828         defined($args{'index_groups'}) &&
829         $args{'index_groups'}) {
830         $parser->_index();
831     } else {
832         $parser->YYData->{'group_index_offsets'} = [0, ];
833         $parser->YYData->{'group_index_linenums'} = [0, ];
834     }
835
836     # Return parser object.
837     return $parser;
838 }
839
840 =pod
841
842 =head2 $object->nextGroup()
843
844 =over 4
845
846 Provides the next registry group, in the form of a hashtable reference.
847 This hashtable has the following format:
848
849   {
850       # The registry directory name.
851       'key' => 'HKEY_LOCAL_MACHINE\Software...',
852  
853       # An array containing the list of entries within the
854       # registry directory.
855       'entries'  => [ {
856           'name' => "\"string\"",  # A (potentially) quoted string;
857                                    # "@" for default
858           'value' => "data",
859       }, ],
860   };
861
862 I<Output>: A hashtable reference if the next group was parsed successfully;
863 returns an empty hash ref, if the Parser B<$object> has reached the end of
864 the input stream.
865
866 =back
867
868 =begin testing
869
870 my ($nextGroup, $expectedGroup);
871 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
872                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
873
874 # Create a generic Parser object, with test state data.
875 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file, index_groups => 1);
876
877 # Verify Test Group #1
878 $nextGroup = $parser->nextGroup();
879 $expectedGroup = {
880     key     => 'HKEY_CURRENT_USER\]Testing Group 1[',
881     entries => [ {
882         name  => '@',
883         value => 'Default',
884     }, {
885         name  => 'Foo',
886         value => 'Bar',
887     }, ],
888 };
889 is_deeply($nextGroup, $expectedGroup, "nextGroup() - 1") or diag("The nextGroup() call failed.");
890
891 # Verify Test Group #2
892 $nextGroup = $parser->nextGroup();
893 $expectedGroup = {
894     key     => 'HKEY_CURRENT_USER\Testing Group 2',
895     entries => [ {
896         name  => '@',
897         value => '\\"Annoying=Value\\"',
898     }, {
899         name  => '\\"Annoying=Key\\"',
900         value => 'Bar',
901     }, {
902         name  => 'Multiline',
903         value => 'This
904 value spans
905 multiple lines
906 ',
907     }, {
908         name  => 'Sane_Key',
909         value => '\\"Wierd=\\"Value',
910     }, ],
911 };
912 is_deeply($nextGroup, $expectedGroup, "nextGroup() - 2") or diag("The nextGroup() call failed.");
913
914 # Verify Test Group #3
915 $nextGroup = $parser->nextGroup();
916 $expectedGroup = {
917     key     => 'HKEY_CURRENT_USER\Testing Group 3',
918     entries => [ {
919         name  => 'Test_Bin_1',
920         value => 'hex:f4,ff,ff,ff,00,00,00,00,00,00,00,00,00,00,00,00,bc,02,00,00,00,\
921   00,00,00,00,00,00,00,54,00,61,00,68,00,6f,00,6d,00,61,00,00,00,f0,77,3f,00,\
922   3f,00,3f,00,3f,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,78,00,1c,10,fc,\
923   7f,22,14,fc,7f,b0,fe,12,00,00,00,00,00,00,00,00,00,98,23,eb,77'
924     }, {
925         name  => 'Test_Bin_2',
926         value => 'hex:f5,ff,ff,ff,00,00,00,00,00,00,00,00,00,00,00,00,90,01,00,00,00,\
927   00,00,00,00,00,00,00,4d,00,69,00,63,00,72,00,6f,00,73,00,6f,00,66,00,74,00,\
928   20,00,53,00,61,00,6e,00,73,00,20,00,53,00,65,00,72,00,69,00,66,00,00,00,f0,\
929   77,00,20,14,00,00,00,00,10,80,05,14,00,f0,1f,14,00,00,00,14,00'
930     }, ],
931 };
932 is_deeply($nextGroup, $expectedGroup, "nextGroup() - 3") or diag("The nextGroup() call failed.");
933
934 # Verify Test Group #4
935 $nextGroup = $parser->nextGroup();
936 $expectedGroup = {
937     key     => 'HKEY_CURRENT_USER\Testing Group 4',
938     entries => [],
939 };
940 is_deeply($nextGroup, $expectedGroup, "nextGroup() - 4") or diag("The nextGroup() call failed.");
941
942 # Verify Test Group #5
943 $nextGroup = $parser->nextGroup();
944 $expectedGroup = {
945     key     => 'HKEY_CURRENT_USER\Testing Group 5',
946     entries => [ {
947         name  => '@',
948         value => '',
949     }, ],
950 };
951 is_deeply($nextGroup, $expectedGroup, "nextGroup() - 5") or diag("The nextGroup() call failed.");
952
953 # Verify Test Group #6
954 $nextGroup = $parser->nextGroup();
955 $expectedGroup = {
956     key     => 'HKEY_CURRENT_USER\Testing Group 6\With\Really\Deep\Nested\Directory\Structure',
957     entries => [ {
958         name  => 'InstallerLocation',
959         value => 'C:\\\\WINDOWS\\\\system32\\\\',
960     }, ],
961 };
962 is_deeply($nextGroup, $expectedGroup, "nextGroup() - 6") or diag("The nextGroup() call failed.");
963
964 # Verify Test Group #7
965 $nextGroup = $parser->nextGroup();
966 $expectedGroup = {
967     key     => 'HKEY_CURRENT_USER\Testing Group 7',
968     entries => [ {
969         name  => 'C:\\\\Program Files\\\\Common Files\\\\Microsoft Shared\\\\Web Folders\\\\',
970         value => '',
971     }, {
972         name  => 'C:\\\\WINDOWS\\\\Installer\\\\{350C97B0-3D7C-4EE8-BAA9-00BCB3D54227}\\\\',
973         value => '',
974     }, {
975         name  => 'C:\\\\Program Files\\\\Support Tools\\\\',
976         value => '',
977     }, {
978         name  => 'C:\\\\Documents and Settings\\\\All Users\\\\Start Menu\\\\Programs\\\\Windows Support Tools\\\\',
979         value => '',
980     }, {
981         name  => 'C:\\\\WINDOWS\\\\Installer\\\\{6855CCDD-BDF9-48E4-B80A-80DFB96FE36C}\\\\',
982         value => '',
983     }, {
984         name  => 'C:\\\\WINDOWS\\\\Installer\\\\{F251B999-08A9-4704-999C-9962F0DFD88E}\\\\',
985         value => '',
986     }, {
987         name  => 'C:\\\\WINDOWS\\\\Installer\\\\{1CB92574-96F2-467B-B793-5CEB35C40C29}\\\\',
988         value => '',
989     }, {
990         name  => 'C:\\\\WINDOWS\\\\Installer\\\\{B37C842A-B624-46B8-A727-654E72F1C91A}\\\\',
991         value => '',
992     }, ],
993 };
994 is_deeply($nextGroup, $expectedGroup, "nextGroup() - 7") or diag("The nextGroup() call failed.");
995
996 # Verify Test Group #8
997 $nextGroup = $parser->nextGroup();
998 $expectedGroup = {
999     key     => 'HKEY_CURRENT_USER\Testing Group 8\{00021492-0000-0000-C000-000000000046}',
1000     entries => [ {
1001         name  => '000',
1002         value => 'String Value',
1003     }, ],
1004 };
1005 is_deeply($nextGroup, $expectedGroup, "nextGroup() - 8") or diag("The nextGroup() call failed.");
1006
1007 # Verify Test Group #9
1008 $nextGroup = $parser->nextGroup();
1009 is_deeply($nextGroup, { }, "nextGroup() - 9") or diag("The nextGroup() call failed.");
1010
1011 =end testing
1012
1013 =cut
1014
1015 sub nextGroup {
1016     # Extract arguments.
1017     my ($self, %args) = @_;
1018
1019     # Log resolved arguments.
1020     # Make Dumper format more terse.
1021     $Data::Dumper::Terse = 1;
1022     $Data::Dumper::Indent = 0;
1023     $LOG->debug(Dumper(\%args));
1024
1025     # Reopen the file_handle, if it's been closed.
1026     if (!defined($self->YYData->{'file_handle'})) {
1027         $self->_reset();   
1028     }
1029
1030     if ($self->YYData->{'input_pos'} == 0) {
1031         $LOG->debug("Beginning parse of input stream.");
1032     }
1033
1034     # Update progress bar, if defined.
1035     if (defined($_[0]->YYData->{'progress'}) &&
1036         ($_[0]->YYData->{'file_size'} <= $_[0]->YYData->{'progress_next_update'})) {
1037
1038         $_[0]->YYData->{'progress'}->update($_[0]->YYData->{'file_size'});
1039     }
1040
1041     # Return the next group parsed.
1042     return $self->YYParse(yylex   => \&_lexer,
1043                           yyerror => \&_error);
1044 }
1045
1046 =pod
1047
1048 =head2 $object->dirsParsed()
1049
1050 =over 4
1051
1052 Indicates how many registry directories the Parser B<$object> has
1053 parsed within the specified file, so far.
1054
1055 I<Output>: Returns the number of directory groups parsed so far;
1056 returns 0, if none parsed yet.
1057
1058 =back
1059
1060 =begin testing
1061
1062 my ($nextGroup);
1063 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
1064                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
1065
1066 # Create a generic Parser object, with test state data.
1067 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);
1068
1069 $nextGroup = $parser->nextGroup();
1070 while(scalar(keys(%{$nextGroup}))) {
1071     $nextGroup = $parser->nextGroup();
1072 }
1073
1074 is($parser->dirsParsed(), 8, "dirsParsed()") or diag("The dirsParsed() call failed.");
1075
1076 =end testing
1077
1078 =cut
1079
1080 sub dirsParsed {
1081     # Extract arguments.
1082     my ($self, %args) = @_;
1083    
1084     # Log resolved arguments.
1085     # Make Dumper format more terse.
1086     $Data::Dumper::Terse = 1;
1087     $Data::Dumper::Indent = 0;
1088     $LOG->debug(Dumper(\%args));
1089
1090     return $self->YYData->{'dir_count'};
1091 }
1092
1093 =pod
1094
1095 =head2 $object->entriesParsed()
1096
1097 =over 4
1098
1099 Indicates how many registry key/value pairs the Parser B<$object> has
1100 parsed within the specified file, so far.
1101
1102 I<Output>: Returns the number of key/value pairs parsed so far;
1103 returns 0, if none parsed yet.
1104
1105 =back
1106
1107 =begin testing
1108
1109 my ($nextGroup);
1110 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
1111                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
1112
1113 # Create a generic Parser object, with test state data.
1114 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);
1115
1116 $nextGroup = $parser->nextGroup();
1117 while(scalar(keys(%{$nextGroup}))) {
1118     $nextGroup = $parser->nextGroup();
1119 }
1120
1121 is($parser->entriesParsed(), 19, "entriesParsed()") or diag("The entriesParsed() call failed.");
1122
1123 =end testing
1124
1125 =cut
1126
1127 sub entriesParsed {
1128     # Extract arguments.
1129     my ($self, %args) = @_;
1130
1131     # Log resolved arguments.
1132     # Make Dumper format more terse.
1133     $Data::Dumper::Terse = 1;
1134     $Data::Dumper::Indent = 0;
1135     $LOG->debug(Dumper(\%args));
1136
1137     return $self->YYData->{'entry_count'};
1138 }
1139
1140 =pod
1141
1142 =head2 $object->getFileHandle()
1143
1144 =over 4
1145
1146 Returns the file handle associated with the current Parser B<$object>.
1147
1148 I<Output>: Returns the file handle in use.
1149
1150 =back
1151
1152 =begin testing
1153
1154 my ($handle);
1155 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
1156                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
1157
1158 # Create a generic Parser object, with test state data.
1159 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);
1160
1161 $handle = $parser->getFileHandle();
1162
1163 isa_ok($handle, 'IO::File', "getFileHandle()") or diag("The getFileHandle() call failed.");
1164
1165 =end testing
1166
1167 =cut
1168
1169 sub getFileHandle {
1170     # Extract arguments.
1171     my ($self, %args) = @_;
1172
1173     # Log resolved arguments.
1174     # Make Dumper format more terse.
1175     $Data::Dumper::Terse = 1;
1176     $Data::Dumper::Indent = 0;
1177     $LOG->debug(Dumper(\%args));
1178
1179     return $self->YYData->{'file_handle'};
1180 }
1181
1182 =pod
1183
1184 =head2 $object->getFilename()
1185
1186 =over 4
1187
1188 Returns the file name associated with the current Parser B<$object>.
1189
1190 I<Output>: Returns the file name in use.
1191
1192 =back
1193
1194 =begin testing
1195
1196 my ($filename);
1197 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
1198                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
1199
1200 # Create a generic Parser object, with test state data.
1201 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);
1202
1203 $filename = $parser->getFilename();
1204
1205 is($filename, $test_registry_file, "getFilename()") or diag("The getFilename() call failed.");
1206
1207 =end testing
1208
1209 =cut
1210
1211 sub getFilename {
1212     # Extract arguments.
1213     my ($self, %args) = @_;
1214
1215     # Log resolved arguments.
1216     # Make Dumper format more terse.
1217     $Data::Dumper::Terse = 1;
1218     $Data::Dumper::Indent = 0;
1219     $LOG->debug(Dumper(\%args));
1220
1221     return $self->YYData->{'filename'};
1222 }
1223
1224 =pod
1225
1226 =head2 $object->closeFileHandle()
1227
1228 =over 4
1229
1230 Closes the file handle associated with the current Parser B<$object>.
1231
1232 =back
1233
1234 =begin testing
1235
1236 my ($handle);
1237 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
1238                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
1239
1240 # Create a generic Parser object, with test state data.
1241 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);
1242 $parser->closeFileHandle();
1243
1244 # Verify Test Group #1
1245 my $nextGroup = $parser->nextGroup();
1246 my $expectedGroup = {
1247     key     => 'HKEY_CURRENT_USER\]Testing Group 1[',
1248     entries => [ {
1249         name  => '@',
1250         value => 'Default',
1251     }, {
1252         name  => 'Foo',
1253         value => 'Bar',
1254     }, ],
1255 };
1256 is_deeply($nextGroup, $expectedGroup, "closeFileHandle()") or diag("The closeFileHandle() call failed.");
1257
1258 =end testing
1259
1260 =cut
1261
1262 sub closeFileHandle {
1263     # Extract arguments.
1264     my ($self, %args) = @_;
1265
1266     # Log resolved arguments.
1267     # Make Dumper format more terse.
1268     $Data::Dumper::Terse = 1;
1269     $Data::Dumper::Indent = 0;
1270     $LOG->debug(Dumper(\%args));
1271
1272     $self->YYData->{'file_handle'} = undef;
1273 }
1274
1275 =pod
1276
1277 =head2 $object->getCurrentLineCount()
1278
1279 =over 4
1280
1281 Returns the number of lines parsed by the Parser B<$object>
1282 within the specified file and resets the counter back to
1283 zero.
1284
1285 I<Output>: Returns the current line count of the parser.
1286
1287 B<Note>: Calling this function will reset the parser's
1288 line count.
1289
1290 =back
1291
1292 =begin testing
1293
1294 my ($handle);
1295 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
1296                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
1297
1298 # Create a generic Parser object, with test state data.
1299 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file, index_groups => 1);
1300
1301 $parser->seekToNearestGroup(absolute_offset => 84);
1302 my $nextGroup = $parser->nextGroup();
1303
1304 is($parser->getCurrentLineCount(), 9, "getCurrentLineCount()") or diag("The getCurrentLineCount() call failed.");
1305
1306 =end testing
1307
1308 =cut
1309
1310 sub getCurrentLineCount {
1311     # Extract arguments.
1312     my ($self, %args) = @_;
1313
1314     # Log resolved arguments.
1315     # Make Dumper format more terse.
1316     $Data::Dumper::Terse = 1;
1317     $Data::Dumper::Indent = 0;
1318     $LOG->debug(Dumper(\%args));
1319
1320     my $ret = $self->YYData->{'line_count'};
1321     $self->YYData->{'line_count'} = 0;
1322     return $ret;
1323 }
1324
1325 =pod
1326
1327 =head2 $object->seekToNearestGroup(absolute_offset => $offset, absolute_linenum => $linenum, adjust_index => $index)
1328
1329 =over 4
1330
1331 Given an absolute offset or line number within the file, this function
1332 will seek the parser to the nearest group found B<before>
1333 the specified offset.
1334
1335 I<Inputs>:
1336  B<$offset> is an required parameter, specifying the absolute offset
1337 within the file to seek to.
1338  B<$linenum> is a required parameter, specifying the absolute line
1339 number within the file to seek to.
1340  B<$index> is an optional parameter, specifying to seek to a group
1341 before or after the target group.  If unspecified, $index = 0.
1342
1343 I<Outputs>: None.
1344
1345 B<Notes>: Either B<$offset> or B<$linnum> must be specified.  To seek to the
1346 target group, specify $index = 0 or leave undefined.  To seek to the previous
1347 group before the target group, specify $index = -1.  To seek to the next
1348 group after the target group, specify $index = 1.
1349
1350 Once called, B<all> corresponding statistical counters will be reset.  This means,
1351 that the output from $object->dirsParsed() and $object->entriesParsed() will be
1352 zero, if called immediately after this function.
1353
1354 =back
1355
1356 =begin testing
1357
1358 my ($nextGroup, $expectedGroup);
1359 my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
1360                                                   namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");
1361
1362 # Create a generic Parser object, with test state data.
1363 my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file, index_groups => 1);
1364
1365 # Verify Test Group #2
1366 $expectedGroup = {
1367     key     => 'HKEY_CURRENT_USER\Testing Group 2',
1368     entries => [ {
1369         name  => '@',
1370         value => '\\"Annoying=Value\\"',
1371     }, {
1372         name  => '\\"Annoying=Key\\"',
1373         value => 'Bar',
1374     }, {
1375         name  => 'Multiline',
1376         value => 'This
1377 value spans
1378 multiple lines
1379 ',
1380     }, {
1381         name  => 'Sane_Key',
1382         value => '\\"Wierd=\\"Value',
1383     }, ],
1384 };
1385 is($parser->seekToNearestGroup(absolute_offset => 84), 73, "seekToNearestGroup(absolute_offset => 84)") or diag("The seekToNearestGroup() call failed.");
1386 $nextGroup = $parser->nextGroup();
1387 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_offset => 84)") or diag("The seekToNearestGroup() call failed.");
1388
1389 is($parser->seekToNearestGroup(absolute_linenum => 7), 6, "seekToNearestGroup(absolute_linenum => 7)") or diag("The seekToNearestGroup() call failed.");
1390 $nextGroup = $parser->nextGroup();
1391 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_linenum => 7)") or diag("The seekToNearestGroup() call failed.");
1392
1393 # Verify Test Group #3
1394 $expectedGroup = {
1395     key     => 'HKEY_CURRENT_USER\Testing Group 3',
1396     entries => [ {
1397         name  => 'Test_Bin_1',
1398         value => 'hex:f4,ff,ff,ff,00,00,00,00,00,00,00,00,00,00,00,00,bc,02,00,00,00,\
1399   00,00,00,00,00,00,00,54,00,61,00,68,00,6f,00,6d,00,61,00,00,00,f0,77,3f,00,\
1400   3f,00,3f,00,3f,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,78,00,1c,10,fc,\
1401   7f,22,14,fc,7f,b0,fe,12,00,00,00,00,00,00,00,00,00,98,23,eb,77'
1402     }, {
1403         name  => 'Test_Bin_2',
1404         value => 'hex:f5,ff,ff,ff,00,00,00,00,00,00,00,00,00,00,00,00,90,01,00,00,00,\
1405   00,00,00,00,00,00,00,4d,00,69,00,63,00,72,00,6f,00,73,00,6f,00,66,00,74,00,\
1406   20,00,53,00,61,00,6e,00,73,00,20,00,53,00,65,00,72,00,69,00,66,00,00,00,f0,\
1407   77,00,20,14,00,00,00,00,10,80,05,14,00,f0,1f,14,00,00,00,14,00'
1408     }, ],
1409 };
1410
1411 is($parser->seekToNearestGroup(absolute_offset => 301), 234, "seekToNearestGroup(absolute_offset => 301)") or diag("The seekToNearestGroup() call failed.");
1412 $nextGroup = $parser->nextGroup();
1413 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_offset => 301)") or diag("The seekToNearestGroup() call failed.");
1414
1415 is($parser->seekToNearestGroup(absolute_linenum => 16), 15, "seekToNearestGroup(absolute_linenum => 16)") or diag("The seekToNearestGroup() call failed.");
1416 $nextGroup = $parser->nextGroup();
1417 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_linenum => 16)") or diag("The seekToNearestGroup() call failed.");
1418
1419 is($parser->seekToNearestGroup(absolute_linenum => 26, adjust_index => -1), 15, "seekToNearestGroup(absolute_linenum => 26, adjust_index => -1)") or diag("The seekToNearestGroup() call failed.");
1420 $nextGroup = $parser->nextGroup();
1421 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_linenum => 26, adjust_index => -1)") or diag("The seekToNearestGroup() call failed.");
1422
1423 # Verify Test Group #4
1424 $expectedGroup = {
1425     key     => 'HKEY_CURRENT_USER\Testing Group 4',
1426     entries => [],
1427 };
1428
1429 is($parser->seekToNearestGroup(absolute_offset => 898), 881, "seekToNearestGroup(absolute_offset => 898)") or diag("The seekToNearestGroup() call failed.");
1430 $nextGroup = $parser->nextGroup();
1431 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_offset => 898)") or diag("The seekToNearestGroup() call failed.");
1432
1433 is($parser->seekToNearestGroup(absolute_linenum => 26), 25, "seekToNearestGroup(absolute_linenum => 26)") or diag("The seekToNearestGroup() call failed.");
1434 $nextGroup = $parser->nextGroup();
1435 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_linenum => 26)") or diag("The seekToNearestGroup() call failed.");
1436
1437 # Verify Test Group #8
1438 $expectedGroup = {
1439     key     => 'HKEY_CURRENT_USER\Testing Group 8\{00021492-0000-0000-C000-000000000046}',
1440     entries => [ {
1441         name  => '000',
1442         value => 'String Value',
1443     }, ],
1444 };
1445 is($parser->seekToNearestGroup(absolute_offset => 898, adjust_index => 99), 1674, "seekToNearestGroup(absolute_offset => 898, adjust_index => 99)") or diag("The seekToNearestGroup() call failed.");
1446 $nextGroup = $parser->nextGroup();
1447 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_offset => 898, adjust_index => 99)") or diag("The seekToNearestGroup() call failed.");
1448
1449 # Verify Test Group #1
1450 $expectedGroup = {
1451     key     => 'HKEY_CURRENT_USER\]Testing Group 1[',
1452     entries => [ {
1453         name  => '@',
1454         value => 'Default',
1455     }, {
1456         name  => 'Foo',
1457         value => 'Bar',
1458     }, ],
1459 };
1460 is($parser->seekToNearestGroup(absolute_offset => 898, adjust_index => -99), 0, "seekToNearestGroup(absolute_offset => 898, adjust_index => -99)") or diag("The seekToNearestGroup() call failed.");
1461 $nextGroup = $parser->nextGroup();
1462 is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup(absolute_offset => 898, adjust_index => -99)") or diag("The seekToNearestGroup() call failed.");
1463
1464 =end testing
1465
1466 =cut
1467
1468 sub seekToNearestGroup {
1469     # Extract arguments.
1470     my ($self, %args) = @_;
1471
1472     # Log resolved arguments.
1473     # Make Dumper format more terse.
1474     $Data::Dumper::Terse = 1;
1475     $Data::Dumper::Indent = 0;
1476     $LOG->debug(Dumper(\%args));
1477
1478     # Sanity check, don't continue, unless absolute_offset or absolute_linennum
1479     # was provided.
1480     my $argsExist = scalar(%args);
1481     if (!$argsExist) {
1482         $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!");
1483         Carp::croak("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!");
1484     }
1485
1486     # Check if adjust_index was provided.
1487     my $adjust_index = 0;
1488     if (exists($args{'adjust_index'})) {
1489         if(!defined($args{'adjust_index'})) {
1490             $LOG->fatal("Error: Unable to seek parser - invalid 'adjust_index' specified!");
1491             Carp::croak("Error: Unable to seek parser - invalid 'adjust_index' specified!");
1492         } else {
1493             $adjust_index = $args{'adjust_index'};
1494         }
1495     }
1496  
1497     # Define helper variables.
1498     my $search_arrayref = undef;
1499     my $search_target = undef;
1500
1501     # Specify the search type.
1502     $self->YYData->{'search_is_linenum'} = 0;
1503
1504     # Check if absolute_offset was provided.
1505     if (exists($args{'absolute_offset'})) {
1506         if (!defined($args{'absolute_offset'})) {
1507             $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!");
1508             Carp::croak("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!");
1509         }
1510         $search_arrayref = $self->YYData->{'group_index_offsets'};
1511         $search_target = $args{'absolute_offset'};
1512     } else {
1513     # Check if absolute_linenum was provided.
1514         if (!defined($args{'absolute_linenum'})) {
1515             $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!");
1516             Carp::croak("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!");
1517         }
1518         $search_arrayref = $self->YYData->{'group_index_linenums'};
1519         $search_target = $args{'absolute_linenum'};
1520         $self->YYData->{'search_is_linenum'} = 1;
1521     }
1522
1523     # Final sanity check.
1524     if (!defined($search_target)) {
1525         $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!");
1526         Carp::croak("Error: Unable to seek parser - no 'absolute_offset' or 'absolute_linenum' specified!");
1527     }
1528
1529     # Check to see if the $search_arrayref has been initialized.
1530     # We assume that if it has [0, ], then this has not been
1531     # done.
1532     my $numIndices = scalar(@{$search_arrayref});
1533     if ($numIndices < 2) {
1534         $self->_index();
1535     }
1536     $numIndices = scalar(@{$search_arrayref});
1537
1538     # Find the nearest index after the offset.
1539     my $found_index = binary_search(0, $numIndices - 1, $search_target, \&_search, $self);
1540
1541     # Now, find the nearest index before the offset.
1542     if ($found_index > 0) {
1543         $found_index--;
1544         # Adjust the index, if specified.
1545         if ($found_index > 0) {
1546             my $test_index = ($found_index + $adjust_index);
1547             # Make sure the adjustment doesn't exceed the min or max.
1548             if ($test_index >= $numIndices) {
1549                 $found_index = $numIndices - 1;
1550             } elsif ($test_index < 0) {
1551                 $found_index = 0;
1552             } else {
1553                 $found_index = $test_index;
1554             }
1555         }
1556     }
1557
1558     my $found_offset = @{$self->YYData->{'group_index_offsets'}}[$found_index];
1559
1560     # Seek the parser, to the specified offset.
1561     $self->_reset($found_offset);
1562    
1563     if($self->YYData->{'search_is_linenum'}) {
1564         my $found_linenum = @{$self->YYData->{'group_index_linenums'}}[$found_index];
1565         $LOG->debug("Seeking parser to nearest earlier group line number (" . $found_linenum . ").");
1566         return $found_linenum;
1567     } else {
1568         $LOG->debug("Seeking parser to nearest earlier group offset (" . $found_offset . ").");
1569         return $found_offset;
1570     }
1571 }
1572
1573 #######################################################################
1574 # Additional Module Documentation                                     #
1575 #######################################################################
1576
1577 =head1 BUGS & ASSUMPTIONS
1578
1579 The Parser B<$object> expects to scan the specified file as an input stream.
1580 Subsequent calls to $object->nextGroup() will advance the parser through
1581 the input stream.
1582
1583 =head1 SEE ALSO
1584
1585 L<http://www.honeyclient.org/trac>
1586
1587 =head1 REPORTING BUGS
1588
1589 L<http://www.honeyclient.org/trac/newticket>
1590
1591 =head1 ACKNOWLEDGEMENTS
1592
1593 Francois Desarmenien E<lt>francois@fdesar.netE<gt> for his
1594 work in developing the Parse::Yapp module.
1595
1596 =head1 AUTHORS
1597
1598 Darien Kindlund, E<lt>kindlund@mitre.orgE<gt>
1599
1600 =head1 COPYRIGHT & LICENSE
1601
1602 Copyright (C) 2006 The MITRE Corporation.  All rights reserved.
1603
1604 This program is free software; you can redistribute it and/or
1605 modify it under the terms of the GNU General Public License
1606 as published by the Free Software Foundation, using version 2
1607 of the License.
1608
1609 This program is distributed in the hope that it will be useful,
1610 but WITHOUT ANY WARRANTY; without even the implied warranty of
1611 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1612 GNU General Public License for more details.
1613
1614 You should have received a copy of the GNU General Public License
1615 along with this program; if not, write to the Free Software
1616 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
1617 02110-1301, USA.
1618
1619
1620 =cut
1621
1622 1;
Note: See TracBrowser for help on using the browser.