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;