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, for supporting the Win32 event log. It is not expected to be directly used by any module other than C 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 =head1 AUTHORS SEbastien 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;