284 lines
7.8 KiB
Perl
284 lines
7.8 KiB
Perl
package Sys::Syslog::Win32;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use File::Spec;
|
|
|
|
# === WARNING === WARNING === WARNING === WARNING === WARNING === WARNING ===
|
|
#
|
|
# This file was generated by Sys-Syslog/win32/compile.pl on Wed Aug 22 01:33:58 2007
|
|
# Any changes being made here will be lost the next time Sys::Syslog
|
|
# is installed.
|
|
#
|
|
# Do NOT USE THIS MODULE DIRECTLY: this is a utility module for Sys::Syslog.
|
|
# It may change at any time to fit the needs of Sys::Syslog therefore no
|
|
# warranty is made WRT to its API. You Have Been Warned.
|
|
#
|
|
# === WARNING === WARNING === WARNING === WARNING === WARNING === WARNING ===
|
|
|
|
our $Source;
|
|
my $logger;
|
|
my $Registry;
|
|
|
|
use Win32::EventLog;
|
|
use Win32::TieRegistry 0.20 (
|
|
TiedRef => \$Registry,
|
|
Delimiter => "/",
|
|
ArrayValues => 1,
|
|
SplitMultis => 1,
|
|
AllowLoad => 1,
|
|
qw(
|
|
REG_SZ
|
|
REG_EXPAND_SZ
|
|
REG_DWORD
|
|
REG_BINARY
|
|
REG_MULTI_SZ
|
|
KEY_READ
|
|
KEY_WRITE
|
|
KEY_ALL_ACCESS
|
|
),
|
|
);
|
|
|
|
my $is_Cygwin = $^O =~ /Cygwin/i;
|
|
my $is_Win32 = $^O =~ /Win32/i;
|
|
|
|
my %const = (
|
|
CAT_KERN => 1,
|
|
CAT_USER => 2,
|
|
CAT_MAIL => 3,
|
|
CAT_DAEMON => 4,
|
|
CAT_AUTH => 5,
|
|
CAT_SYSLOG => 6,
|
|
CAT_LPR => 7,
|
|
CAT_NEWS => 8,
|
|
CAT_UUCP => 9,
|
|
CAT_CRON => 10,
|
|
CAT_AUTHPRIV => 11,
|
|
CAT_FTP => 12,
|
|
CAT_LOCAL0 => 13,
|
|
CAT_LOCAL1 => 14,
|
|
CAT_LOCAL2 => 15,
|
|
CAT_LOCAL3 => 16,
|
|
CAT_LOCAL4 => 17,
|
|
CAT_LOCAL5 => 18,
|
|
CAT_LOCAL6 => 19,
|
|
CAT_LOCAL7 => 20,
|
|
CAT_NETINFO => 21,
|
|
CAT_REMOTEAUTH => 22,
|
|
CAT_RAS => 23,
|
|
CAT_INSTALL => 24,
|
|
CAT_LAUNCHD => 25,
|
|
CAT_CONSOLE => 26,
|
|
CAT_NTP => 27,
|
|
CAT_SECURITY => 28,
|
|
CAT_AUDIT => 29,
|
|
CAT_LFMT => 30,
|
|
MSG_KERNEL => 128,
|
|
MSG_USER => 129,
|
|
MSG_MAIL => 130,
|
|
MSG_DAEMON => 131,
|
|
MSG_AUTH => 132,
|
|
MSG_SYSLOG => 133,
|
|
MSG_LPR => 134,
|
|
MSG_NEWS => 135,
|
|
MSG_UUCP => 136,
|
|
MSG_CRON => 137,
|
|
MSG_AUTHPRIV => 138,
|
|
MSG_FTP => 139,
|
|
MSG_LOCAL0 => 140,
|
|
MSG_LOCAL1 => 141,
|
|
MSG_LOCAL2 => 142,
|
|
MSG_LOCAL3 => 143,
|
|
MSG_LOCAL4 => 144,
|
|
MSG_LOCAL5 => 145,
|
|
MSG_LOCAL6 => 146,
|
|
MSG_LOCAL7 => 147,
|
|
MSG_NETINFO => 148,
|
|
MSG_REMOTEAUTH => 149,
|
|
MSG_RAS => 150,
|
|
MSG_INSTALL => 151,
|
|
MSG_LAUNCHD => 152,
|
|
MSG_CONSOLE => 153,
|
|
MSG_NTP => 154,
|
|
MSG_SECURITY => 155,
|
|
MSG_AUDIT => 156,
|
|
MSG_LFMT => 157,
|
|
STATUS_SEVERITY_SUCCESS => 0,
|
|
STATUS_SEVERITY_INFORMATIONAL => 1,
|
|
STATUS_SEVERITY_WARNING => 2,
|
|
STATUS_SEVERITY_ERROR => 3,
|
|
|
|
);
|
|
|
|
my %id2name = (
|
|
Sys::Syslog::LOG_KERN() => 'KERN',
|
|
Sys::Syslog::LOG_USER() => 'USER',
|
|
Sys::Syslog::LOG_MAIL() => 'MAIL',
|
|
Sys::Syslog::LOG_DAEMON() => 'DAEMON',
|
|
Sys::Syslog::LOG_AUTH() => 'AUTH',
|
|
Sys::Syslog::LOG_SYSLOG() => 'SYSLOG',
|
|
Sys::Syslog::LOG_LPR() => 'LPR',
|
|
Sys::Syslog::LOG_NEWS() => 'NEWS',
|
|
Sys::Syslog::LOG_UUCP() => 'UUCP',
|
|
Sys::Syslog::LOG_CRON() => 'CRON',
|
|
Sys::Syslog::LOG_AUTHPRIV() => 'AUTHPRIV',
|
|
Sys::Syslog::LOG_FTP() => 'FTP',
|
|
Sys::Syslog::LOG_LOCAL0() => 'LOCAL0',
|
|
Sys::Syslog::LOG_LOCAL1() => 'LOCAL1',
|
|
Sys::Syslog::LOG_LOCAL2() => 'LOCAL2',
|
|
Sys::Syslog::LOG_LOCAL3() => 'LOCAL3',
|
|
Sys::Syslog::LOG_LOCAL4() => 'LOCAL4',
|
|
Sys::Syslog::LOG_LOCAL5() => 'LOCAL5',
|
|
Sys::Syslog::LOG_LOCAL6() => 'LOCAL6',
|
|
Sys::Syslog::LOG_LOCAL7() => 'LOCAL7',
|
|
Sys::Syslog::LOG_NETINFO() => 'NETINFO',
|
|
Sys::Syslog::LOG_REMOTEAUTH() => 'REMOTEAUTH',
|
|
Sys::Syslog::LOG_RAS() => 'RAS',
|
|
Sys::Syslog::LOG_INSTALL() => 'INSTALL',
|
|
Sys::Syslog::LOG_LAUNCHD() => 'LAUNCHD',
|
|
Sys::Syslog::LOG_CONSOLE() => 'CONSOLE',
|
|
Sys::Syslog::LOG_NTP() => 'NTP',
|
|
Sys::Syslog::LOG_SECURITY() => 'SECURITY',
|
|
Sys::Syslog::LOG_AUDIT() => 'AUDIT',
|
|
Sys::Syslog::LOG_LFMT() => 'LFMT',
|
|
|
|
);
|
|
|
|
my @priority2eventtype = (
|
|
EVENTLOG_ERROR_TYPE(), # LOG_EMERG
|
|
EVENTLOG_ERROR_TYPE(), # LOG_ALERT
|
|
EVENTLOG_ERROR_TYPE(), # LOG_CRIT
|
|
EVENTLOG_ERROR_TYPE(), # LOG_ERR
|
|
EVENTLOG_WARNING_TYPE(), # LOG_WARNING
|
|
EVENTLOG_WARNING_TYPE(), # LOG_NOTICE
|
|
EVENTLOG_INFORMATION_TYPE(), # LOG_INFO
|
|
EVENTLOG_INFORMATION_TYPE(), # LOG_DEBUG
|
|
);
|
|
|
|
|
|
#
|
|
# _install()
|
|
# --------
|
|
# Used to set up a connection to the eventlog.
|
|
#
|
|
sub _install {
|
|
return $logger if $logger;
|
|
|
|
# can't just use basename($0) here because Win32 path often are a
|
|
# a mix of / and \, and File::Basename::fileparse() can't handle that,
|
|
# while File::Spec::splitpath() can.. Go figure..
|
|
my (undef, undef, $basename) = File::Spec->splitpath($0);
|
|
($Source) ||= $basename;
|
|
|
|
$Source.=" [SSW:1.0.1]";
|
|
|
|
#$Registry->Delimiter("/"); # is this needed?
|
|
my $root = 'LMachine/SYSTEM/CurrentControlSet/Services/Eventlog/Application/';
|
|
my $dll = 'Sys/Syslog/PerlLog.dll';
|
|
|
|
if (!$Registry->{$root.$Source} ||
|
|
!$Registry->{$root.$Source.'/CategoryMessageFile'}[0] ||
|
|
!-e $Registry->{$root.$Source.'/CategoryMessageFile'}[0] )
|
|
{
|
|
|
|
# find the resource DLL, which should be along Syslog.dll
|
|
my ($file) = grep { -e $_ } map { ("$_/$dll" => "$_/auto/$dll") } @INC;
|
|
$dll = $file if $file;
|
|
|
|
# on Cygwin, convert the Unix path into absolute Windows path
|
|
if ($is_Cygwin) {
|
|
if ($] > 5.009005) {
|
|
chomp($file = Cygwin::posix_to_win_path($file, 1));
|
|
}
|
|
else {
|
|
local $ENV{PATH} = '';
|
|
chomp($dll = `/usr/bin/cygpath --absolute --windows "$dll"`);
|
|
}
|
|
}
|
|
|
|
$dll =~ s![\\/]+!\\!g; # must be backslashes!
|
|
die "fatal: Can't find resource DLL for Sys::Syslog\n" if !$dll;
|
|
|
|
$Registry->{$root.$Source} = {
|
|
'/EventMessageFile' => [ $dll, REG_EXPAND_SZ ],
|
|
'/CategoryMessageFile' => [ $dll, REG_EXPAND_SZ ],
|
|
'/CategoryCount' => [ '0x0000001e', REG_DWORD ],
|
|
#'/TypesSupported' => [ '0x0000001e', REG_DWORD ],
|
|
};
|
|
|
|
warn "Configured eventlog to use $dll for $Source\n" if $Sys::Syslog::DEBUG;
|
|
}
|
|
|
|
#Carp::confess("Registry has the wrong value for '$Source', possibly mismatched dll!\nMine:$dll\nGot :$Registry->{$root.$Source.'/CategoryMessageFile'}[0]\n")
|
|
# if $Registry->{$root.$Source.'/CategoryMessageFile'}[0] ne $dll;
|
|
|
|
# we really should do something useful with this but for now
|
|
# we set it to "" to prevent Win32::EventLog from warning
|
|
my $host = "";
|
|
|
|
$logger = Win32::EventLog->new($Source, $host)
|
|
or Carp::confess("Failed to connect to the '$Source' event log");
|
|
|
|
return $logger;
|
|
}
|
|
|
|
|
|
#
|
|
# _syslog_send()
|
|
# ------------
|
|
# Used to convert syslog messages into eventlog messages
|
|
#
|
|
sub _syslog_send {
|
|
my ($buf, $numpri, $numfac) = @_;
|
|
$numpri ||= EVENTLOG_INFORMATION_TYPE();
|
|
$numfac ||= Sys::Syslog::LOG_USER();
|
|
my $name = $id2name{$numfac};
|
|
|
|
my $opts = {
|
|
EventType => $priority2eventtype[$numpri],
|
|
EventID => $const{"MSG_$name"},
|
|
Category => $const{"CAT_$name"},
|
|
Strings => "$buf\0",
|
|
Data => "",
|
|
};
|
|
|
|
if ($Sys::Syslog::DEBUG) {
|
|
require Data::Dumper;
|
|
warn Data::Dumper->Dump(
|
|
[$numpri, $numfac, $name, $opts],
|
|
[qw(numpri numfac name opts)]
|
|
);
|
|
}
|
|
|
|
return $logger->Report($opts);
|
|
}
|
|
|
|
|
|
=head1 NAME
|
|
|
|
Sys::Syslog::Win32 - Win32 support for Sys::Syslog
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module is a back-end plugin for C<Sys::Syslog>, for supporting the Win32
|
|
event log. It is not expected to be directly used by any module other than
|
|
C<Sys::Syslog> therefore it's API may change at any time and no warranty is
|
|
made with regards to backward compatibility. You Have Been Warned.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Sys::Syslog>
|
|
|
|
=head1 AUTHORS
|
|
|
|
SE<eacute>bastien Aperghis-Tramoni and Yves Orton
|
|
|
|
=head1 LICENSE
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
under the same terms as Perl itself.
|
|
|
|
=cut
|
|
|
|
1;
|