package # hide from PAUSE
Win32::EventLog;
use strict;
use warnings;
use Carp;
use Exporter ();
{
no strict;
$VERSION = "0.01";
@ISA = qw(Exporter);
@EXPORT = qw(
EVENTLOG_AUDIT_FAILURE
EVENTLOG_AUDIT_SUCCESS
EVENTLOG_BACKWARDS_READ
EVENTLOG_END_ALL_PAIRED_EVENTS
EVENTLOG_END_PAIRED_EVENT
EVENTLOG_ERROR_TYPE
EVENTLOG_FORWARDS_READ
EVENTLOG_INFORMATION_TYPE
EVENTLOG_PAIRED_EVENT_ACTIVE
EVENTLOG_PAIRED_EVENT_INACTIVE
EVENTLOG_SEEK_READ
EVENTLOG_SEQUENTIAL_READ
EVENTLOG_START_PAIRED_EVENT
EVENTLOG_SUCCESS
EVENTLOG_WARNING_TYPE
);
}
use vars qw($GetMessageText);
use constant {
TRUE => !!1,
FALSE => !!0,
ELF_LOG_SIGNATURE => 0x654c664c,
# Event Types
EVENTLOG_SUCCESS => 0x0000,
EVENTLOG_ERROR_TYPE => 0x0001,
EVENTLOG_WARNING_TYPE => 0x0002,
EVENTLOG_INFORMATION_TYPE => 0x0004,
EVENTLOG_AUDIT_SUCCESS => 0x0008,
EVENTLOG_AUDIT_FAILURE => 0x0010,
# ReadEventLog() flags
EVENTLOG_SEQUENTIAL_READ => 0x0001,
EVENTLOG_SEEK_READ => 0x0002,
EVENTLOG_FORWARDS_READ => 0x0004,
EVENTLOG_BACKWARDS_READ => 0x0008,
# don't know what these are, and can't find the actual values
EVENTLOG_START_PAIRED_EVENT => 0x0001,
EVENTLOG_PAIRED_EVENT_ACTIVE => 0x0002,
EVENTLOG_PAIRED_EVENT_INACTIVE => 0x0004,
EVENTLOG_END_PAIRED_EVENT => 0x0008,
EVENTLOG_END_ALL_PAIRED_EVENTS => 0x0010,
};
# singleton for storing events
my %main_eventlog = (
# HOSTNAME => {
# SOURCE => [
# {
# Category => ...,
# EventType => ...,
# EventID => ...,
# Data => ...,
# Strings => ...,
# },
# {
# ...
# },
# ]
# }
);
# index of last read record
my $last_read_record = 0;
#use XXX; END { YYY \%main_eventlog }
#
# new()
# ---
sub new {
my ($class, $source, $computer) = @_;
$class = ref $class if ref $class;
croak "error: missing source" unless $source;
my $handle;
# create new handle
if ($source =~ /\\/) {
OpenBackupEventLog($handle, $computer, $source);
}
else {
OpenEventLog($handle, $computer, $source)
}
#$handle ||= ( $main_eventlog{$computer}{$source} ||= [] );
my $self = bless {
handle => $handle, Source => $source, Computer => $computer
}, $class;
return $self
}
sub DESTROY {
shift->Close
}
#
# Open()
# ----
sub Open {
$_[0] = Win32::EventLog->new($_[1], $_[2]);
}
#
# OpenBackup()
# ----------
sub OpenBackup {
my ($class, $source, $computer) = @_;
OpenBackupEventLog(my $handle, $computer, $source);
my $self = bless {
handle => $handle, Source => $source, Computer => $computer
}, $class;
return $self
}
#
# Backup()
# ------
sub Backup {
my ($self, $filename) = @_;
die " usage: OBJECT->Backup(FILENAME)\n" unless @_ == 2;
return BackupEventLog($self->{handle}, $filename);
}
#
# Close()
# -----
sub Close {
my ($self) = @_;
CloseEventLog($self->{handle});
$self->{handle} = 0;
}
#
# Read()
# ----
sub Read {
my ($self, $flags, $offset, $entry_r) = @_;
# fetch the event
my $rc = ReadEventLog(
$self->{handle}, $flags, $offset,
# these variables are set by ReadEventLog():
my $header, my $source, my $computer, my $sid, my $data, my $strings
);
# decode the header
my ($length, $reserved, $record_number, $time_generated, $time_written,
$event_id, $event_type, $num_strings, $event_category, $reserved_flags,
$closing_record_number, $string_offset, $user_sid_length, $user_sid_offset,
$data_length, $data_offset) = unpack("l6s4l6", $header);
# make a hash out of the values returned from ReadEventLog()
my %record = (
Source => $source,
Computer => $computer,
RecordNumber => $record_number,
TimeGenerated => $time_generated,
Timewritten => $time_written,
Category => $event_category,
EventType => $event_type,
EventID => $event_id,
User => $sid,
Strings => $strings,
Data => $data,
Length => $data_length,
ClosingRecordNumber => $closing_record_number,
);
# get the text message here
if ($rc and $GetMessageText) {
GetEventLogText($source, $event_id, $strings, $num_strings, my $message);
$record{Message} = $message;
}
if (ref $entry_r eq 'HASH') {
%{$entry_r} = %record # needed for the Read(..., \%foo) case
}
else {
$_[2] = \%record
}
return $rc
}
#
# GetMessageText()
# --------------
sub GetMessageText {
my ($self) = @_;
GetEventLogText(
$self->{Source}, $self->{EventID}, $self->{Strings},
$self->{Strings} =~ tr/\0/\0/, my $message
);
$self->{Message} = $message;
return $message
}
#
# Report()
# ------
sub Report {
my ($self, $EventInfo) = @_;
die "usage: OBJECT->Report( HASHREF )\n" unless @_ == 2;
die "Win32::EventLog::Report requires a hash reference as arg 2\n"
unless ref($EventInfo) eq "HASH";
my $computer = $EventInfo->{Computer} ? $EventInfo->{Computer}
: $self->{Computer};
my $source = exists($EventInfo->{Source}) ? $EventInfo->{Source}
: $self->{Source};
return WriteEventLog(
$computer, $source, $EventInfo->{EventType},
$EventInfo->{Category}, $EventInfo->{EventID}, 0,
$EventInfo->{Data}, split(/\0/, $EventInfo->{Strings})
);
}
#
# GetOldest()
# ---------
sub GetOldest {
my ($self, $event_r) = @_;
die "usage: OBJECT->GetOldest( SCALAREF )\n" unless @_ == 2;
return GetOldestEventLogRecord($self->{handle}, $event_r);
}
#
# GetNumber()
# ---------
sub GetNumber {
my ($self, $event_r) = @_;
die "usage: OBJECT->GetNumber( SCALARREF )\n" unless @_ == 2;
return GetNumberOfEventLogRecords($self->{handle}, $event_r);
}
#
# Clear()
# -----
sub Clear {
my ($self, $file) = @_;
die "usage: OBJECT->Clear( FILENAME )\n" unless @_ == 2;
return ClearEventLog($self->{handle}, $file);
}
# =========================================================================
# Mocked XS Functions
# =========================================================================
#
# ReadEventLog()
# ------------
# http://msdn2.microsoft.com/en-us/library/aa363674.aspx
#
sub ReadEventLog ($$$\$\$\$\$\$\$) {
my ($eventlog, $flags, $offset, $event_header_r, $source_r, $computer_r,
$sid_r, $data_r, $strings_r) = @_;
# set all these variables as some are not used even under real Win32::EventLog
$$event_header_r = $$source_r = $$computer_r = $$data_r = $$sid_r = $$strings_r = "";
# find the record number to read
my $record_num = $last_read_record;
if ($flags & EVENTLOG_SEEK_READ) {
$record_num = $offset
}
else { # default to EVENTLOG_SEQUENTIAL_READ
if ($flags & EVENTLOG_BACKWARDS_READ) {
$record_num--
}
else { # default to EVENTLOG_FORWARDS_READ
$record_num++
}
}
# read the record
my $record = $eventlog->[$record_num];
my $user_sid = "$<-$("; # UID-GID
my $strings_num = $record->{Strings} =~ tr/\0/\0/;
# construct the event header
$$event_header_r = pack("l6s4l6" =>
0, # length
ELF_LOG_SIGNATURE, # reserved
$record->{RecordNumber}, # record number
$record->{TimeGenerated}, # time generated
$record->{Timewritten}, # time written
$record->{EventID}, # event ID
$record->{EventType}, # event type
$strings_num, # number of strings
$record->{Category}, # event category
0, # reserved flags
0, # closing record number
0, # string offset
length $user_sid, # user sid length
0, # user sid offset
0, # data length
0, # data offset
);
# set the variables
$$source_r = $record->{Source};
$$computer_r = $record->{Computer};
$$sid_r = $user_sid;
$$data_r = $record->{Data};
$$strings_r = $record->{Strings};
return TRUE
}
#
# WriteEventLog()
# -------------
sub WriteEventLog {
my ($computer, $source, $event_type, $category, $event_id, $reserved,
$data, @strings) = @_;
# get the singleton
my $eventlog = $main_eventlog{$computer}{$source};
# prepare fields
$reserved ||= ELF_LOG_SIGNATURE;
my $now = time();
# store the event
push @$eventlog, {
Computer => $computer,
Source => $source,
RecordNumber => $#{$eventlog}+1,
TimeGenerated => $now,
Timewritten => $now,
Category => $category,
EventType => $event_type,
EventID => $event_id,
Reserved => $reserved,
Data => $data,
Strings => \@strings,
};
return TRUE
}
#
# GetEventLogText()
# ---------------
sub GetEventLogText ($$$$\$) {
my ($source, $event_id, $strings, $strings_num, $message_r) = @_;
$$message_r = join "", "[$source/EventId:$event_id] ", split /\0/, $strings;
return TRUE
}
#
# BackupEventLog()
# --------------
sub BackupEventLog {
my ($eventlog, $filename) = @_;
require YAML;
return YAML::DumpFile($filename => $eventlog)
}
#
# ClearEventLog()
# -------------
sub ClearEventLog {
my ($eventlog, $filename) = @_;
my $rc = BackupEventLog($eventlog, $filename);
if ($rc) { %main_eventlog = (); $last_read_record = 0 }
return $rc
}
#
# CloseEventLog()
# -------------
sub CloseEventLog {
my ($eventlog) = @_;
$last_read_record = 0;
return TRUE
}
#
# DeregisterEventSource()
# ---------------------
sub DeregisterEventSource {
my ($eventlog) = @_;
return TRUE
}
#
# GetNumberOfEventLogRecords()
# --------------------------
sub GetNumberOfEventLogRecords ($\$) {
my ($eventlog, $nb_records_r) = @_;
print STDERR "GetNumberOfEventLogRecords(): @_\n";
$$nb_records_r = scalar @$eventlog;
return TRUE
}
#
# GetOldestEventLogRecord()
# -----------------------
sub GetOldestEventLogRecord {
my ($eventlog, $oldest_record_r) = @_;
print STDERR "GetOldestEventLogRecord(): @_\n";
$$oldest_record_r = $#{$eventlog};
return TRUE
}
#
# OpenBackupEventLog()
# ------------------
# http://msdn2.microsoft.com/en-us/library/aa363671.aspx
#
sub OpenBackupEventLog (\$$$) {
my ($eventlog_r, $computer, $filename) = @_;
require YAML;
$$eventlog_r = YAML::LoadFile($filename);
return TRUE
}
#
# OpenEventLog()
# ------------
# http://msdn2.microsoft.com/en-us/library/aa363672.aspx
#
sub OpenEventLog (\$$$) {
my ($eventlog_r, $computer, $source) = @_;
print STDERR "OpenEventLog(): @_\n";
$main_eventlog{$computer}{$source} ||= [];
$$eventlog_r = $main_eventlog{$computer}{$source};
return TRUE
}
#
# RegisterEventSource()
# -------------------
sub RegisterEventSource {
my ($computer, $source) = @_;
return $main_eventlog{$computer}{$source}
}
1
__END__
=head1 NAME
Win32::EventLog - Mocked Win32 event log functions
=head1 SYNOPSIS
use Win32::Mock;
use Win32::EventLog;
=head1 DESCRIPTION
This module is a mock/emulation of C<Win32::EventLog>.
See the documentation of the real module for more details.
=head1 SEE ALSO
L<Win32>
L<Win32::EventLog>
L<Win32::Mock>
=head1 AUTHOR
SE<eacute>bastien Aperghis-Tramoni E<lt>sebastien@aperghis.netE<gt>
=head1 COPYRIGHT & LICENSE
Copyright 2007, 2008 SE<eacute>bastien Aperghis-Tramoni, All Rights Reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut