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

%{
#######################################################################
# Created on:  Dec 10, 2006
# Package:     HoneyClient::Agent::Integrity::Registry::Parser
# File:        Parser.pm
# Description: Parses static hive dumps of the Windows OS registry.
#
# CVS: $Id$
#
# @author kindlund
#
# Copyright (C) 2006 The MITRE Corporation.  All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation, using version 2
# of the License.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.
#
#######################################################################

=pod

=head1 NAME

HoneyClient::Agent::Integrity::Registry::Parser - Perl extension to parse
static hive dumps of the Windows OS registry.

=head1 VERSION

This documentation refers to HoneyClient::Agent::Integrity::Registry::Parser version 1.0.

=head1 SYNOPSIS

  use HoneyClient::Agent::Integrity::Registry::Parser;
  use IO::File;
  use Data::Dumper;

  # Initialize the parser object.
  my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(
                   input_file => "dump.reg",
               );

  # Print each registry group found, until there are no more left.
  my $registryGroup = $parser->nextGroup();
  while(scalar(keys(%{$registryGroup}))) {
      print Dumper($registryGroup);
      $registryGroup = $parser->nextGroup();
  }

  # $registryGroup refers to hashtable reference, which has the
  # following format:
  #
  # $registryGroup = {
  #     # The registry directory name.
  #     'key' => 'HKEY_LOCAL_MACHINE\Software...',
  #
  #     # An array containing the list of entries within the
  #     # registry directory.
  #     'entries'  => [ {
  #         'name' => "\"string\"",  # A (potentially) quoted string; 
  #                                  # "@" for default
  #         'value' => "data",
  #     }, ],
  # };

=head1 DESCRIPTION

This library allows the Registry module to easily parse and enumerate
each Windows OS registry hive.

=cut

use strict;
use warnings;
use Carp ();

# Include Global Configuration Processing Library 
use HoneyClient::Util::Config qw(getVar);

# Include Logging Library
use Log::Log4perl qw(:easy);

# Use Dumper Library.
use Data::Dumper;

# Use IO File Library.
use IO::File;

# Use Seek Library.
use Fcntl qw(:seek);

# Use Binary Search Library.
use Search::Binary;

# Use Progress Bar Library.
use Term::ProgressBar;

#######################################################################
# Module Initialization                                               #
#######################################################################

BEGIN {
    # Defines which functions can be called externally.
    require Exporter;
    our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);

    # Set our package version.
    $VERSION = 0.9;

    @ISA = qw(Exporter);

    # Symbols to export on request
    @EXPORT = qw( );

    # Items to export into callers namespace by default. Note: do not export
    # names by default without a very good reason. Use EXPORT_OK instead.
    # Do not simply export all your public functions/methods/constants.

    # This allows declaration use HoneyClient::Agent::Integrity::Registry ':all';
    # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
    # will save memory.

    %EXPORT_TAGS = (
        'all' => [ qw( ) ],
    );

    # Symbols to autoexport (:DEFAULT tag)
    @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

    $SIG{PIPE} = 'IGNORE'; # Do not exit on broken pipes.
}
our (@EXPORT_OK, $VERSION);

=pod

=begin testing

# Make sure Log::Log4perl loads
BEGIN { use_ok('Log::Log4perl', qw(:nowarn))
        or diag("Can't load Log::Log4perl package. Check to make sure the package library is correctly listed within the path.");
       
        # Suppress all logging messages, since we need clean output for unit testing.
        Log::Log4perl->init({
            "log4perl.rootLogger"                               => "DEBUG, Buffer",
            "log4perl.appender.Buffer"                          => "Log::Log4perl::Appender::TestBuffer",
            "log4perl.appender.Buffer.min_level"                => "fatal",
            "log4perl.appender.Buffer.layout"                   => "Log::Log4perl::Layout::PatternLayout",
            "log4perl.appender.Buffer.layout.ConversionPattern" => "%d{yyyy-MM-dd HH:mm:ss} %5p [%M] (%F:%L) - %m%n",
        });
}
require_ok('Log::Log4perl');
use Log::Log4perl qw(:easy);

# Make sure the module loads properly, with the exportable
# functions shared.
BEGIN { use_ok('HoneyClient::Util::Config', qw(getVar setVar)) 
        or diag("Can't load HoneyClient::Util::Config package.  Check to make sure the package library is correctly listed within the path."); }
require_ok('HoneyClient::Util::Config');
can_ok('HoneyClient::Util::Config', 'getVar');
can_ok('HoneyClient::Util::Config', 'setVar');
use HoneyClient::Util::Config qw(getVar setVar);

# Suppress all logging messages, since we need clean output for unit testing.
Log::Log4perl->init({
    "log4perl.rootLogger"                               => "DEBUG, Buffer",
    "log4perl.appender.Buffer"                          => "Log::Log4perl::Appender::TestBuffer",
    "log4perl.appender.Buffer.min_level"                => "fatal",
    "log4perl.appender.Buffer.layout"                   => "Log::Log4perl::Layout::PatternLayout",
    "log4perl.appender.Buffer.layout.ConversionPattern" => "%d{yyyy-MM-dd HH:mm:ss} %5p [%M] (%F:%L) - %m%n",
});

# Make sure Data::Dumper loads
BEGIN { use_ok('Data::Dumper')
        or diag("Can't load Data::Dumper package. Check to make sure the package library is correctly listed within the path."); }
require_ok('Data::Dumper');
use Data::Dumper;

# Make sure IO::File loads
BEGIN { use_ok('IO::File')
        or diag("Can't load IO::File package. Check to make sure the package library is correctly listed within the path."); }
require_ok('IO::File');
use IO::File;

# Make sure Fcntl loads
BEGIN { use_ok('Fcntl')
        or diag("Can't load Fcntl package. Check to make sure the package library is correctly listed within the path."); }
require_ok('Fcntl');
use Fcntl qw(:seek);

# Make sure Search::Binary loads
BEGIN { use_ok('Search::Binary')
        or diag("Can't load Search::Binary package. Check to make sure the package library is correctly listed within the path."); }
require_ok('Search::Binary');
can_ok('Search::Binary', 'binary_search');
use Search::Binary;

# Make sure Term::ProgressBar loads
BEGIN { use_ok('Term::ProgressBar')
        or diag("Can't load Term::ProgressBar package. Check to make sure the package library is correctly listed within the path."); }
require_ok('Term::ProgressBar');
use Term::ProgressBar;

# Make sure HoneyClient::Agent::Integrity::Registry::Parser loads
BEGIN { use_ok('HoneyClient::Agent::Integrity::Registry::Parser')
        or diag("Can't load HoneyClient::Agent::Integrity::Registry::Parser package. Check to make sure the package library is correctly listed within the path."); }
require_ok('HoneyClient::Agent::Integrity::Registry::Parser');
use HoneyClient::Agent::Integrity::Registry::Parser;

=end testing

=cut

#######################################################################
# Global Configuration Variables
#######################################################################

# The global logging object.
our $LOG = get_logger();

# Make Dumper format more terse.
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 1;

%}

%token DIR_NAME
%token KEY_NAME
%token KEY_VALUE
%token HEADER
%token NEWLINE

%%

# A registry can be thought of as a header, along with 1 or more
# groups.
registry:
               {
            $LOG->debug("Reached end of input stream.");
            # Finished parsing the entire file, return empty hash ref.
            return { };
        }
    |   groups {
            $LOG->debug("Reached end of input stream.");
            # Finished parsing the entire file, return empty hash ref.
            return { };
        }
    |   HEADER groups {
            $LOG->debug("Reached end of input stream.");
            # Finished parsing the entire file, return empty hash ref.
            return { };
        }
;

# Define 1 or more groups.
groups:
        group
    |   NEWLINE group
    |   NEWLINE group NEWLINE
    |   NEWLINE group groups
;

# A group consists of a group_header and 0 or more entries.
group:
        DIR_NAME entries {
            my $ret = { };
            $_[0]->YYData->{'latest_group'}->{'key'} = $_[1];
            if (!exists($_[0]->YYData->{'latest_group'}->{'entries'})) {
                # Make sure the 'entries' key exists.
                $_[0]->YYData->{'latest_group'}->{'entries'} = [];
            }
            $ret = $_[0]->YYData->{'latest_group'};
            $_[0]->YYData->{'latest_group'} = { };
            $_[0]->YYData->{'dir_count'}++;
            $_[0]->YYAccept; # Terminate the parse, early.

            return $ret;
        }
    |   DIR_NAME {
            my $ret = { };
            $_[0]->YYData->{'latest_group'}->{'key'} = $_[1];
            if (!exists($_[0]->YYData->{'latest_group'}->{'entries'})) {
                # Make sure the 'entries' key exists.
                $_[0]->YYData->{'latest_group'}->{'entries'} = [];
            }
            $ret = $_[0]->YYData->{'latest_group'};
            $_[0]->YYData->{'latest_group'} = { };
            $_[0]->YYData->{'dir_count'}++;
            $_[0]->YYAccept; # Terminate the parse, early.

            return $ret;
        }
;

# Define 1 or more entries.
entries:
        entry
    |   entry entries
;

# Define an entry.
entry:
        KEY_NAME KEY_VALUE {
            my $entry = {
                name  => $_[1],
                value => $_[2],
            };
            push(@{$_[0]->YYData->{'latest_group'}->{entries}}, $entry);
            $_[0]->YYData->{'entry_count'}++;
        }
;

%%

#######################################################################
# Private Methods Implemented                                         #
#######################################################################

# Helper function, designed to tokenize specific data from the input stream.
#
# Inputs: parser
# Outputs: (token_id, data) pair 
sub _lexer {
    # Identify NEWLINE token.
    if ($_[0]->YYData->{DATA} =~ m/\G\n/cg) {
        $_[0]->YYData->{'in_group'} = 0;
        $LOG->debug("Found NEWLINE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
        return ("NEWLINE", "\n");
    }

    # Check to see if we're inside a group block...
    if (!$_[0]->YYData->{'in_group'}) {

        $_[0]->YYData->{'input_pos'} = pos($_[0]->YYData->{DATA});
        $_[0]->YYData->{'input_pos'} = $_[0]->YYData->{'input_pos'} ?
                                       $_[0]->YYData->{'input_pos'} : 0;
        $_[0]->YYData->{'input_pos'} = $_[0]->YYData->{'input_pos'} +
                                       $_[0]->YYData->{'abs_offset'};

        # Update progress bar, if defined.
        if (defined($_[0]->YYData->{'progress'}) &&
            ($_[0]->YYData->{'input_pos'} > $_[0]->YYData->{'progress_next_update'})) {
            $_[0]->YYData->{'progress_next_update'} =
                $_[0]->YYData->{'progress'}->update($_[0]->YYData->{'input_pos'});
        }

        # Identify DIR_NAME token.
        if ($_[0]->YYData->{DATA} =~ m/\G\[(.*)\]\n/cg) {
            $_[0]->YYData->{'in_group'} = 1;
            $LOG->debug("Found DIR_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
            return ("DIR_NAME", $1);
        }

        # Identify HEADER token. It's always only at the beginning.
        if ($_[0]->YYData->{DATA} =~ m/\GREGEDIT4\n/cg) {
            $LOG->debug("Found HEADER token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
            return ("HEADER", "REGEDIT4\n");
        }

    } else {

        # Check to see if we're in a value segment...
        if (!$_[0]->YYData->{'in_value'}) {

            # Identify KEY_NAME token.
            if ($_[0]->YYData->{DATA} =~ m/\G\"(|[^\\]|.*(?:\\[^\\]|\\\\|[^\\][^\\]))\"(?==)/cg) {
                $_[0]->YYData->{'in_value'} = 1;
                $LOG->debug("Found KEY_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
                return ("KEY_NAME", $1);
            }

            # Identify default KEY_NAME token (@).
            if ($_[0]->YYData->{DATA} =~ m/\G\@(?==)/cg) {
                $_[0]->YYData->{'in_value'} = 1;
                $LOG->debug("Found KEY_NAME token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
                return ("KEY_NAME", "@");
            }

        } else {

            # Identify string KEY_VALUE token.
            if ($_[0]->YYData->{DATA} =~ m/\G=\"(|[^\\]|.*?(?:\\[^\\]|\\\\|[^\\][^\\]))\"\n/cgs) {
                $_[0]->YYData->{'in_value'} = 0;
                $LOG->debug("Found KEY_VALUE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
                return ("KEY_VALUE", $1);
            }

            # Identify binary KEY_VALUE token.
            if ($_[0]->YYData->{DATA} =~ m/\G=(|.*?[^\\])\n/cgs) {
                $_[0]->YYData->{'in_value'} = 0;
                $LOG->debug("Found KEY_VALUE token ending at offset (" . pos($_[0]->YYData->{DATA}) . ").");
                return ("KEY_VALUE", $1);
            }
        }
    }
   
    # Croak if encountered a token error.
    if ($_[0]->YYData->{DATA} =~ m/\G(.*\n)/cg) {
        $_[0]->YYData->{'input_pos'} = pos($_[0]->YYData->{DATA});
        $LOG->fatal("Error: Unknown token (" . $1 . ") at offset (". $_[0]->YYData->{'input_pos'} .")");
        Carp::croak("Error: Unknown token (" . $1 . ") at offset (". $_[0]->YYData->{'input_pos'} .")");
    }
    return ('', undef);
}

# Helper function, designed to report when any parsing error
# occurs.
#
# Inputs: parser
# Outputs: None
sub _error {

    $LOG->fatal("Error: Malformed input found at offset (" . $_[0]->YYData->{'input_pos'} . ").");
    Carp::croak("Error: Malformed input found at offset (" . $_[0]->YYData->{'input_pos'} . ").");
}

# Helper function, designed to reset the parser's file stream back to the
# beginning, allowing the parser to reparse from the beginning.  Or, if
# specified, the function will seek the parser to the specified offset.
#
# Inputs: parser, absolute offset (optional)
# Outputs: none
sub _reset {
    # Extract arguments.
    my ($self, $offset) = @_;

    $LOG->debug("Resetting parser.");

    my $fh = $self->YYData->{'file_handle'};

    # Check the offset.
    if (!defined($offset)) {
        $offset = 0;
    }
    seek($fh, $offset, SEEK_SET);

    undef $/;
    $self->YYData->{DATA} = <$fh>;

    # Strip all CRs.
    $self->YYData->{DATA} =~ s/\r//g;

    # Total size of input file.
    $self->YYData->{'file_size'} = (stat($fh))[7];

    # Reinitialize helper variables.
    # Hashtable, to represent the latest, extracted group chunk.
    $self->YYData->{'latest_group'} = { };

    # Boolean, to indicate when we're parsing inside a group chunk.
    $self->YYData->{'in_group'} = 0;

    # Boolean, to indicate when we're parsing inside a value segment.
    $self->YYData->{'in_value'} = 0;
    
    # Regexp offset, used to record where the parser is within
    # the file (relative position).
    $self->YYData->{'input_pos'} = 0;

    # Absolute offset, recording where the parser initially seeked to.
    $self->YYData->{'abs_offset'} = $offset;

    # Initialize statistics.
    # Total number of directories parsed.
    $self->YYData->{'dir_count'} = 0;

    # Total number of key/value pairs parsed.
    $self->YYData->{'entry_count'} = 0;

    # Progress bar information.
    if ($self->YYData->{'show_progress'}) {
        $self->YYData->{'progress'} = Term::ProgressBar->new({ name  => 'Progress',
                                                               count => $self->YYData->{'file_size'},
                                                               ETA   => 'linear', });
        $self->YYData->{'progress'}->minor(0);
        $self->YYData->{'progress'}->max_update_rate(1);
        $self->YYData->{'progress_next_update'} = $self->YYData->{'progress'}->update($offset);
    } else {
        $self->YYData->{'progress'} = undef;
    }
}

# Helper function, designed to index all groups, based upon beginning file
# offsets.
#
# Inputs: parser
# Outputs: None
sub _index {
    # Extract arguments.
    my $self = shift;

    $LOG->debug("Starting group index process.");

    $self->YYData->{'group_index'} = [0, ];

    my $registryGroup = $self->nextGroup();
    while(scalar(keys(%{$registryGroup}))) {
        $registryGroup = $self->nextGroup();
        push (@{$self->YYData->{'group_index'}}, $self->YYData->{'input_pos'});
    }

    # Reset the parser.
    $self->_reset();

    $LOG->debug("Finished group index process.");
}

# Helper function, designed to be called from within the
# Search::Binary::binary_search() function, in order to allow
# the binary_search to properly read in group index data from
# the default array reference.
#
# For more information about how this function operates, please
# see the Search::Binary POD documentation.
#
# Inputs: parser, value_to_compare, current_array_index
# Outputs: comparison, last_valid_array_index
sub _search {
    # Extract arguments.
    my ($parser, $value_to_compare, $current_array_index) = @_;

    # Increment the search index, if the current one is undef.
    if (defined($current_array_index)) {
        $parser->YYData->{'last_search_index'} = $current_array_index;
    } else {
        $parser->YYData->{'last_search_index'}++;
    }

    # Perform a comparison, if the array entry is defined.
    if (defined(@{$parser->YYData->{'group_index'}}[$parser->YYData->{'last_search_index'}])) {
        return($value_to_compare <=> @{$parser->YYData->{'group_index'}}[$parser->YYData->{'last_search_index'}],
               $parser->YYData->{'last_search_index'});
    }

    # Array entry not found, return undef with this position.
    return (undef, $parser->YYData->{'last_search_index'});
}

#######################################################################
# Public Methods Implemented                                          #
#######################################################################

=pod

=head1 METHODS IMPLEMENTED

The following functions have been implemented by any Parser object.

=head2 HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $filename,
                                                             index_groups => $perform_index,
                                                             show_progress => $progress)

=over 4

Creates a new Parser object, using the specified input file as its data
source.

I<Inputs>:
 B<$filename> is an required parameter, specifying the file to open for parsing.
 B<$perform_index> is an optional parameter.  1 specifies that the parser should go
ahead and scan the entire file, indexing the file offsets of where groups start and
end.  Otherwise, this indexing process is not performed.
 B<$progress> is an optional parameter.  1 specifies that the parser should display
a progress bar, as it scans through a specified file.  Otherwise, a progress bar
is not displayed.
 
I<Output>: The instantiated Parser B<$object>, fully initialized.

=back

=begin testing

my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
                                                  namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");

# Create a generic Parser object, with test state data.
my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);
isa_ok($parser, 'HoneyClient::Agent::Integrity::Registry::Parser', "init(input_file => $test_registry_file)") or diag("The init() call failed.");

=end testing

=cut

sub init {

    # Extract arguments.
    my ($self, %args) = @_;

    # Log resolved arguments.
    # Make Dumper format more terse.
    $Data::Dumper::Terse = 1;
    $Data::Dumper::Indent = 0;
    $LOG->debug(Dumper(\%args));

    # Sanity check, don't initialize, unless input_file_handle
    # was provided.
    my $argsExist = scalar(%args);
    if (!$argsExist ||
        !exists($args{'input_file'}) ||
        !defined($args{'input_file'})) {
        $LOG->fatal("Error: Unable to create parser - no 'input_file' specified!");
        Carp::croak("Error: Unable to create parser - no 'input_file' specified!");
    }

    my $parser = HoneyClient::Agent::Integrity::Registry::Parser->new();
    my $fh = new IO::File($args{'input_file'}, "r");
    if (!defined($fh)) {
        $LOG->fatal("Error: Unable to read file '" . $args{'input_file'} . "'!");
        Carp::croak("Error: Unable to read file '" . $args{'input_file'} . "'!");
    }
    
    # Check if show progress was specified.
    if ($argsExist && 
        exists($args{'show_progress'}) && 
        defined($args{'show_progress'}) &&
        $args{'show_progress'}) {
        $parser->YYData->{'show_progress'} = 1;
    } else {
        $parser->YYData->{'show_progress'} = 0;
    }

    # Save the file handle.
    $parser->YYData->{'file_handle'} = $fh;

    # Reset the parser.
    $parser->_reset();

    # Perform group indexing, if specified.
    if ($argsExist && 
        exists($args{'index_groups'}) && 
        defined($args{'index_groups'}) &&
        $args{'index_groups'}) {
        $parser->_index();
    } else {
        $parser->YYData->{'group_index'} = [0, ];
    }

    # Return parser object.
    return $parser;
}

=pod

=head2 $object->nextGroup()

=over 4

Provides the next registry group, in the form of a hashtable reference.
This hashtable has the following format:

  {
      # The registry directory name.
      'key' => 'HKEY_LOCAL_MACHINE\Software...',
  
      # An array containing the list of entries within the
      # registry directory.
      'entries'  => [ {
          'name' => "\"string\"",  # A (potentially) quoted string; 
                                   # "@" for default
          'value' => "data",
      }, ],
  };

I<Output>: A hashtable reference if the next group was parsed successfully;
returns an empty hash ref, if the Parser B<$object> has reached the end of
the input stream.

=back

=begin testing

my ($nextGroup, $expectedGroup);
my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
                                                  namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");

# Create a generic Parser object, with test state data.
my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file, index_groups => 1);

# Verify Test Group #1
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\]Testing Group 1[',
    entries => [ {
        name  => '@',
        value => 'Default',
    }, {
        name  => 'Foo',
        value => 'Bar',
    }, ],
};
is_deeply($nextGroup, $expectedGroup, "nextGroup() - 1") or diag("The nextGroup() call failed.");

# Verify Test Group #2
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\Testing Group 2',
    entries => [ {
        name  => '@',
        value => '\\"Annoying=Value\\"',
    }, {
        name  => '\\"Annoying=Key\\"',
        value => 'Bar',
    }, {
        name  => 'Multiline',
        value => 'This
value spans
multiple lines
',
    }, {
        name  => 'Sane_Key',
        value => '\\"Wierd=\\"Value',
    }, ],
};
is_deeply($nextGroup, $expectedGroup, "nextGroup() - 2") or diag("The nextGroup() call failed.");

# Verify Test Group #3
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\Testing Group 3',
    entries => [ {
        name  => 'Test_Bin_1',
        value => 'hex:f4,ff,ff,ff,00,00,00,00,00,00,00,00,00,00,00,00,bc,02,00,00,00,\
  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,\
  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,\
  7f,22,14,fc,7f,b0,fe,12,00,00,00,00,00,00,00,00,00,98,23,eb,77'
    }, {
        name  => 'Test_Bin_2',
        value => 'hex:f5,ff,ff,ff,00,00,00,00,00,00,00,00,00,00,00,00,90,01,00,00,00,\
  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,\
  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,\
  77,00,20,14,00,00,00,00,10,80,05,14,00,f0,1f,14,00,00,00,14,00'
    }, ],
};
is_deeply($nextGroup, $expectedGroup, "nextGroup() - 3") or diag("The nextGroup() call failed.");

# Verify Test Group #4
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\Testing Group 4',
    entries => [],
};
is_deeply($nextGroup, $expectedGroup, "nextGroup() - 4") or diag("The nextGroup() call failed.");

# Verify Test Group #5
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\Testing Group 5',
    entries => [ {
        name  => '@',
        value => '',
    }, ],
};
is_deeply($nextGroup, $expectedGroup, "nextGroup() - 5") or diag("The nextGroup() call failed.");

# Verify Test Group #6
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\Testing Group 6\With\Really\Deep\Nested\Directory\Structure',
    entries => [ {
        name  => 'InstallerLocation',
        value => 'C:\\\\WINDOWS\\\\system32\\\\',
    }, ],
};
is_deeply($nextGroup, $expectedGroup, "nextGroup() - 6") or diag("The nextGroup() call failed.");

# Verify Test Group #7
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\Testing Group 7',
    entries => [ {
        name  => 'C:\\\\Program Files\\\\Common Files\\\\Microsoft Shared\\\\Web Folders\\\\',
        value => '',
    }, {
        name  => 'C:\\\\WINDOWS\\\\Installer\\\\{350C97B0-3D7C-4EE8-BAA9-00BCB3D54227}\\\\',
        value => '',
    }, {
        name  => 'C:\\\\Program Files\\\\Support Tools\\\\',
        value => '',
    }, {
        name  => 'C:\\\\Documents and Settings\\\\All Users\\\\Start Menu\\\\Programs\\\\Windows Support Tools\\\\',
        value => '',
    }, {
        name  => 'C:\\\\WINDOWS\\\\Installer\\\\{6855CCDD-BDF9-48E4-B80A-80DFB96FE36C}\\\\',
        value => '',
    }, {
        name  => 'C:\\\\WINDOWS\\\\Installer\\\\{F251B999-08A9-4704-999C-9962F0DFD88E}\\\\',
        value => '',
    }, {
        name  => 'C:\\\\WINDOWS\\\\Installer\\\\{1CB92574-96F2-467B-B793-5CEB35C40C29}\\\\',
        value => '',
    }, {
        name  => 'C:\\\\WINDOWS\\\\Installer\\\\{B37C842A-B624-46B8-A727-654E72F1C91A}\\\\',
        value => '',
    }, ],
};
is_deeply($nextGroup, $expectedGroup, "nextGroup() - 7") or diag("The nextGroup() call failed.");

# Verify Test Group #8
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\Testing Group 8\{00021492-0000-0000-C000-000000000046}',
    entries => [ {
        name  => '000',
        value => 'String Value',
    }, ],
};
is_deeply($nextGroup, $expectedGroup, "nextGroup() - 8") or diag("The nextGroup() call failed.");

# Verify Test Group #9
$nextGroup = $parser->nextGroup();
is_deeply($nextGroup, { }, "nextGroup() - 9") or diag("The nextGroup() call failed.");

=end testing

=cut

sub nextGroup {
    # Extract arguments.
    my ($self, %args) = @_;

    # Log resolved arguments.
    # Make Dumper format more terse.
    $Data::Dumper::Terse = 1;
    $Data::Dumper::Indent = 0;
    $LOG->debug(Dumper(\%args));

    if ($self->YYData->{'input_pos'} == 0) {
        $LOG->debug("Beginning parse of input stream.");
    }

    # Update progress bar, if defined.
    if (defined($_[0]->YYData->{'progress'}) &&
        ($_[0]->YYData->{'file_size'} <= $_[0]->YYData->{'progress_next_update'})) {

        $_[0]->YYData->{'progress'}->update($_[0]->YYData->{'file_size'});
    }

    # Return the next group parsed.
    return $self->YYParse(yylex   => \&_lexer,
                          yyerror => \&_error);
}

=pod

=head2 $object->dirsParsed()

=over 4

Indicates how many registry directories the Parser B<$object> has
parsed within the specified file, so far.

I<Output>: Returns the number of directory groups parsed so far;
returns 0, if none parsed yet.

=back

=begin testing

my ($nextGroup);
my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
                                                  namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");

# Create a generic Parser object, with test state data.
my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);

$nextGroup = $parser->nextGroup();
while(scalar(keys(%{$nextGroup}))) {
    $nextGroup = $parser->nextGroup();
}

is($parser->dirsParsed(), 8, "dirsParsed()") or diag("The dirsParsed() call failed.");

=end testing

=cut

sub dirsParsed {
    # Extract arguments.
    my ($self, %args) = @_;
    
    # Log resolved arguments.
    # Make Dumper format more terse.
    $Data::Dumper::Terse = 1;
    $Data::Dumper::Indent = 0;
    $LOG->debug(Dumper(\%args));

    return $self->YYData->{'dir_count'}; 
}

=pod

=head2 $object->entriesParsed()

=over 4

Indicates how many registry key/value pairs the Parser B<$object> has
parsed within the specified file, so far.

I<Output>: Returns the number of key/value pairs parsed so far;
returns 0, if none parsed yet.

=back

=begin testing

my ($nextGroup);
my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
                                                  namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");

# Create a generic Parser object, with test state data.
my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);

$nextGroup = $parser->nextGroup();
while(scalar(keys(%{$nextGroup}))) {
    $nextGroup = $parser->nextGroup();
}

is($parser->entriesParsed(), 19, "entriesParsed()") or diag("The entriesParsed() call failed.");

=end testing

=cut

sub entriesParsed {
    # Extract arguments.
    my ($self, %args) = @_;

    # Log resolved arguments.
    # Make Dumper format more terse.
    $Data::Dumper::Terse = 1;
    $Data::Dumper::Indent = 0;
    $LOG->debug(Dumper(\%args));

    return $self->YYData->{'entry_count'}; 
}

=pod

=head2 $object->getFileHandle()

=over 4

Returns the file handle associated with the current Parser B<$object>.

I<Output>: Returns the file handle in use.

=back

=begin testing

my ($handle);
my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
                                                  namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");

# Create a generic Parser object, with test state data.
my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file);

$handle = $parser->getFileHandle();

isa_ok($handle, 'IO::File', "getFileHandle()") or diag("The getFileHandle() call failed.");

=end testing

=cut

sub getFileHandle {
    # Extract arguments.
    my ($self, %args) = @_;

    # Log resolved arguments.
    # Make Dumper format more terse.
    $Data::Dumper::Terse = 1;
    $Data::Dumper::Indent = 0;
    $LOG->debug(Dumper(\%args));

    return $self->YYData->{'file_handle'}; 
}

=pod

=head2 $object->seekToNearestGroup(absolute_offset => $offset)

=over 4

Given an absolute offset within the file, this function
will seek the parser to the nearest group found B<before>
the specified offset.

I<Inputs>:
 B<$offset> is an required parameter, specifying the absolute offset
within the file to seek to.

I<Outputs>: None.

=back

=begin testing

my ($nextGroup, $expectedGroup);
my $test_registry_file = $ENV{PWD} . "/" . getVar(name      => "registry_file",
                                                  namespace => "HoneyClient::Agent::Integrity::Registry::Parser::Test");

# Create a generic Parser object, with test state data.
my $parser = HoneyClient::Agent::Integrity::Registry::Parser->init(input_file => $test_registry_file, index_groups => 1);

$parser->seekToNearestGroup(absolute_offset => 84);

# Verify Test Group #2
$nextGroup = $parser->nextGroup();
$expectedGroup = {
    key     => 'HKEY_CURRENT_USER\Testing Group 2',
    entries => [ {
        name  => '@',
        value => '\\"Annoying=Value\\"',
    }, {
        name  => '\\"Annoying=Key\\"',
        value => 'Bar',
    }, {
        name  => 'Multiline',
        value => 'This
value spans
multiple lines
',
    }, {
        name  => 'Sane_Key',
        value => '\\"Wierd=\\"Value',
    }, ],
};
is_deeply($nextGroup, $expectedGroup, "seekToNearestGroup()") or diag("The seekToNearestGroup() call failed.");

=end testing

=cut

sub seekToNearestGroup {
    # Extract arguments.
    my ($self, %args) = @_;

    # Sanity check, don't continue, unless absolute_offset
    # was provided.
    my $argsExist = scalar(%args);
    if (!$argsExist ||
        !exists($args{'absolute_offset'}) ||
        !defined($args{'absolute_offset'})) {
        $LOG->fatal("Error: Unable to seek parser - no 'absolute_offset' specified!");
        Carp::croak("Error: Unable to seek parser - no 'absolute_offset' specified!");
    }

    # Check to see if the 'group_index' has been initialized.
    # We assume that if it has [0, ], then this has not been
    # done.
    my $numIndices = scalar(@{$self->YYData->{'group_index'}});
    if ($numIndices < 2) {
        $self->_index();
    }
    $numIndices = scalar(@{$self->YYData->{'group_index'}});

    # Find the nearest index after the offset.
    my $found_index = binary_search(0, $numIndices - 1, $args{'absolute_offset'}, \&_search, $self);

    # Now, find the nearest index before the offset.
    if ($found_index > 0) {
        $found_index--;
    }
    my $found_offset = @{$self->YYData->{'group_index'}}[$found_index];

    # XXX: Change this to debug, eventually.
    $LOG->info("Seeking parser to nearest earlier group offset (" . $found_offset . ").");

    # Seek the parser, to the specified offset.
    $self->_reset($found_offset);
}

#######################################################################
# Additional Module Documentation                                     #
#######################################################################

=head1 BUGS & ASSUMPTIONS

The Parser B<$object> expects to scan the specified file as an input stream.
Subsequent calls to $object->nextGroup() will advance the parser through
the input stream.

Currently, there is no way to reset a Parser's scan through an input stream.
If desired, simply create a new Parser object, to restart the scan process.

=head1 SEE ALSO

L<http://www.honeyclient.org/trac>

=head1 REPORTING BUGS

L<http://www.honeyclient.org/trac/newticket>

=head1 ACKNOWLEDGEMENTS

Francois Desarmenien E<lt>francois@fdesar.netE<gt> for his
work in developing the Parse::Yapp module.

=head1 AUTHORS

Darien Kindlund, E<lt>kindlund@mitre.orgE<gt>

=head1 COPYRIGHT & LICENSE

Copyright (C) 2006 The MITRE Corporation.  All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation, using version 2
of the License.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.


=cut