1*b39c5158Smillertpackage Sys::Syslog::Win32; 2*b39c5158Smillertuse strict; 3*b39c5158Smillertuse warnings; 4*b39c5158Smillertuse Carp; 5*b39c5158Smillertuse File::Spec; 6*b39c5158Smillert 7*b39c5158Smillert# === WARNING === WARNING === WARNING === WARNING === WARNING === WARNING === 8*b39c5158Smillert# 9*b39c5158Smillert# This file was generated by Sys-Syslog/win32/compile.pl on Wed Aug 22 01:33:58 2007 10*b39c5158Smillert# Any changes being made here will be lost the next time Sys::Syslog 11*b39c5158Smillert# is installed. 12*b39c5158Smillert# 13*b39c5158Smillert# Do NOT USE THIS MODULE DIRECTLY: this is a utility module for Sys::Syslog. 14*b39c5158Smillert# It may change at any time to fit the needs of Sys::Syslog therefore no 15*b39c5158Smillert# warranty is made WRT to its API. You Have Been Warned. 16*b39c5158Smillert# 17*b39c5158Smillert# === WARNING === WARNING === WARNING === WARNING === WARNING === WARNING === 18*b39c5158Smillert 19*b39c5158Smillertour $Source; 20*b39c5158Smillertmy $logger; 21*b39c5158Smillertmy $Registry; 22*b39c5158Smillert 23*b39c5158Smillertuse Win32::EventLog; 24*b39c5158Smillertuse Win32::TieRegistry 0.20 ( 25*b39c5158Smillert TiedRef => \$Registry, 26*b39c5158Smillert Delimiter => "/", 27*b39c5158Smillert ArrayValues => 1, 28*b39c5158Smillert SplitMultis => 1, 29*b39c5158Smillert AllowLoad => 1, 30*b39c5158Smillert qw( 31*b39c5158Smillert REG_SZ 32*b39c5158Smillert REG_EXPAND_SZ 33*b39c5158Smillert REG_DWORD 34*b39c5158Smillert REG_BINARY 35*b39c5158Smillert REG_MULTI_SZ 36*b39c5158Smillert KEY_READ 37*b39c5158Smillert KEY_WRITE 38*b39c5158Smillert KEY_ALL_ACCESS 39*b39c5158Smillert ), 40*b39c5158Smillert); 41*b39c5158Smillert 42*b39c5158Smillertmy $is_Cygwin = $^O =~ /Cygwin/i; 43*b39c5158Smillertmy $is_Win32 = $^O =~ /Win32/i; 44*b39c5158Smillert 45*b39c5158Smillertmy %const = ( 46*b39c5158Smillert CAT_KERN => 1, 47*b39c5158Smillert CAT_USER => 2, 48*b39c5158Smillert CAT_MAIL => 3, 49*b39c5158Smillert CAT_DAEMON => 4, 50*b39c5158Smillert CAT_AUTH => 5, 51*b39c5158Smillert CAT_SYSLOG => 6, 52*b39c5158Smillert CAT_LPR => 7, 53*b39c5158Smillert CAT_NEWS => 8, 54*b39c5158Smillert CAT_UUCP => 9, 55*b39c5158Smillert CAT_CRON => 10, 56*b39c5158Smillert CAT_AUTHPRIV => 11, 57*b39c5158Smillert CAT_FTP => 12, 58*b39c5158Smillert CAT_LOCAL0 => 13, 59*b39c5158Smillert CAT_LOCAL1 => 14, 60*b39c5158Smillert CAT_LOCAL2 => 15, 61*b39c5158Smillert CAT_LOCAL3 => 16, 62*b39c5158Smillert CAT_LOCAL4 => 17, 63*b39c5158Smillert CAT_LOCAL5 => 18, 64*b39c5158Smillert CAT_LOCAL6 => 19, 65*b39c5158Smillert CAT_LOCAL7 => 20, 66*b39c5158Smillert CAT_NETINFO => 21, 67*b39c5158Smillert CAT_REMOTEAUTH => 22, 68*b39c5158Smillert CAT_RAS => 23, 69*b39c5158Smillert CAT_INSTALL => 24, 70*b39c5158Smillert CAT_LAUNCHD => 25, 71*b39c5158Smillert CAT_CONSOLE => 26, 72*b39c5158Smillert CAT_NTP => 27, 73*b39c5158Smillert CAT_SECURITY => 28, 74*b39c5158Smillert CAT_AUDIT => 29, 75*b39c5158Smillert CAT_LFMT => 30, 76*b39c5158Smillert MSG_KERNEL => 128, 77*b39c5158Smillert MSG_USER => 129, 78*b39c5158Smillert MSG_MAIL => 130, 79*b39c5158Smillert MSG_DAEMON => 131, 80*b39c5158Smillert MSG_AUTH => 132, 81*b39c5158Smillert MSG_SYSLOG => 133, 82*b39c5158Smillert MSG_LPR => 134, 83*b39c5158Smillert MSG_NEWS => 135, 84*b39c5158Smillert MSG_UUCP => 136, 85*b39c5158Smillert MSG_CRON => 137, 86*b39c5158Smillert MSG_AUTHPRIV => 138, 87*b39c5158Smillert MSG_FTP => 139, 88*b39c5158Smillert MSG_LOCAL0 => 140, 89*b39c5158Smillert MSG_LOCAL1 => 141, 90*b39c5158Smillert MSG_LOCAL2 => 142, 91*b39c5158Smillert MSG_LOCAL3 => 143, 92*b39c5158Smillert MSG_LOCAL4 => 144, 93*b39c5158Smillert MSG_LOCAL5 => 145, 94*b39c5158Smillert MSG_LOCAL6 => 146, 95*b39c5158Smillert MSG_LOCAL7 => 147, 96*b39c5158Smillert MSG_NETINFO => 148, 97*b39c5158Smillert MSG_REMOTEAUTH => 149, 98*b39c5158Smillert MSG_RAS => 150, 99*b39c5158Smillert MSG_INSTALL => 151, 100*b39c5158Smillert MSG_LAUNCHD => 152, 101*b39c5158Smillert MSG_CONSOLE => 153, 102*b39c5158Smillert MSG_NTP => 154, 103*b39c5158Smillert MSG_SECURITY => 155, 104*b39c5158Smillert MSG_AUDIT => 156, 105*b39c5158Smillert MSG_LFMT => 157, 106*b39c5158Smillert STATUS_SEVERITY_SUCCESS => 0, 107*b39c5158Smillert STATUS_SEVERITY_INFORMATIONAL => 1, 108*b39c5158Smillert STATUS_SEVERITY_WARNING => 2, 109*b39c5158Smillert STATUS_SEVERITY_ERROR => 3, 110*b39c5158Smillert 111*b39c5158Smillert); 112*b39c5158Smillert 113*b39c5158Smillertmy %id2name = ( 114*b39c5158Smillert Sys::Syslog::LOG_KERN() => 'KERN', 115*b39c5158Smillert Sys::Syslog::LOG_USER() => 'USER', 116*b39c5158Smillert Sys::Syslog::LOG_MAIL() => 'MAIL', 117*b39c5158Smillert Sys::Syslog::LOG_DAEMON() => 'DAEMON', 118*b39c5158Smillert Sys::Syslog::LOG_AUTH() => 'AUTH', 119*b39c5158Smillert Sys::Syslog::LOG_SYSLOG() => 'SYSLOG', 120*b39c5158Smillert Sys::Syslog::LOG_LPR() => 'LPR', 121*b39c5158Smillert Sys::Syslog::LOG_NEWS() => 'NEWS', 122*b39c5158Smillert Sys::Syslog::LOG_UUCP() => 'UUCP', 123*b39c5158Smillert Sys::Syslog::LOG_CRON() => 'CRON', 124*b39c5158Smillert Sys::Syslog::LOG_AUTHPRIV() => 'AUTHPRIV', 125*b39c5158Smillert Sys::Syslog::LOG_FTP() => 'FTP', 126*b39c5158Smillert Sys::Syslog::LOG_LOCAL0() => 'LOCAL0', 127*b39c5158Smillert Sys::Syslog::LOG_LOCAL1() => 'LOCAL1', 128*b39c5158Smillert Sys::Syslog::LOG_LOCAL2() => 'LOCAL2', 129*b39c5158Smillert Sys::Syslog::LOG_LOCAL3() => 'LOCAL3', 130*b39c5158Smillert Sys::Syslog::LOG_LOCAL4() => 'LOCAL4', 131*b39c5158Smillert Sys::Syslog::LOG_LOCAL5() => 'LOCAL5', 132*b39c5158Smillert Sys::Syslog::LOG_LOCAL6() => 'LOCAL6', 133*b39c5158Smillert Sys::Syslog::LOG_LOCAL7() => 'LOCAL7', 134*b39c5158Smillert Sys::Syslog::LOG_NETINFO() => 'NETINFO', 135*b39c5158Smillert Sys::Syslog::LOG_REMOTEAUTH() => 'REMOTEAUTH', 136*b39c5158Smillert Sys::Syslog::LOG_RAS() => 'RAS', 137*b39c5158Smillert Sys::Syslog::LOG_INSTALL() => 'INSTALL', 138*b39c5158Smillert Sys::Syslog::LOG_LAUNCHD() => 'LAUNCHD', 139*b39c5158Smillert Sys::Syslog::LOG_CONSOLE() => 'CONSOLE', 140*b39c5158Smillert Sys::Syslog::LOG_NTP() => 'NTP', 141*b39c5158Smillert Sys::Syslog::LOG_SECURITY() => 'SECURITY', 142*b39c5158Smillert Sys::Syslog::LOG_AUDIT() => 'AUDIT', 143*b39c5158Smillert Sys::Syslog::LOG_LFMT() => 'LFMT', 144*b39c5158Smillert 145*b39c5158Smillert); 146*b39c5158Smillert 147*b39c5158Smillertmy @priority2eventtype = ( 148*b39c5158Smillert EVENTLOG_ERROR_TYPE(), # LOG_EMERG 149*b39c5158Smillert EVENTLOG_ERROR_TYPE(), # LOG_ALERT 150*b39c5158Smillert EVENTLOG_ERROR_TYPE(), # LOG_CRIT 151*b39c5158Smillert EVENTLOG_ERROR_TYPE(), # LOG_ERR 152*b39c5158Smillert EVENTLOG_WARNING_TYPE(), # LOG_WARNING 153*b39c5158Smillert EVENTLOG_WARNING_TYPE(), # LOG_NOTICE 154*b39c5158Smillert EVENTLOG_INFORMATION_TYPE(), # LOG_INFO 155*b39c5158Smillert EVENTLOG_INFORMATION_TYPE(), # LOG_DEBUG 156*b39c5158Smillert); 157*b39c5158Smillert 158*b39c5158Smillert 159*b39c5158Smillert# 160*b39c5158Smillert# _install() 161*b39c5158Smillert# -------- 162*b39c5158Smillert# Used to set up a connection to the eventlog. 163*b39c5158Smillert# 164*b39c5158Smillertsub _install { 165*b39c5158Smillert return $logger if $logger; 166*b39c5158Smillert 167*b39c5158Smillert # can't just use basename($0) here because Win32 path often are a 168*b39c5158Smillert # a mix of / and \, and File::Basename::fileparse() can't handle that, 169*b39c5158Smillert # while File::Spec::splitpath() can.. Go figure.. 170*b39c5158Smillert my (undef, undef, $basename) = File::Spec->splitpath($0); 171*b39c5158Smillert ($Source) ||= $basename; 172*b39c5158Smillert 173*b39c5158Smillert $Source.=" [SSW:1.0.1]"; 174*b39c5158Smillert 175*b39c5158Smillert #$Registry->Delimiter("/"); # is this needed? 176*b39c5158Smillert my $root = 'LMachine/SYSTEM/CurrentControlSet/Services/Eventlog/Application/'; 177*b39c5158Smillert my $dll = 'Sys/Syslog/PerlLog.dll'; 178*b39c5158Smillert 179*b39c5158Smillert if (!$Registry->{$root.$Source} || 180*b39c5158Smillert !$Registry->{$root.$Source.'/CategoryMessageFile'}[0] || 181*b39c5158Smillert !-e $Registry->{$root.$Source.'/CategoryMessageFile'}[0] ) 182*b39c5158Smillert { 183*b39c5158Smillert 184*b39c5158Smillert # find the resource DLL, which should be along Syslog.dll 185*b39c5158Smillert my ($file) = grep { -e $_ } map { ("$_/$dll" => "$_/auto/$dll") } @INC; 186*b39c5158Smillert $dll = $file if $file; 187*b39c5158Smillert 188*b39c5158Smillert # on Cygwin, convert the Unix path into absolute Windows path 189*b39c5158Smillert if ($is_Cygwin) { 190*b39c5158Smillert if ($] > 5.009005) { 191*b39c5158Smillert chomp($file = Cygwin::posix_to_win_path($file, 1)); 192*b39c5158Smillert } 193*b39c5158Smillert else { 194*b39c5158Smillert local $ENV{PATH} = ''; 195*b39c5158Smillert chomp($dll = `/usr/bin/cygpath --absolute --windows "$dll"`); 196*b39c5158Smillert } 197*b39c5158Smillert } 198*b39c5158Smillert 199*b39c5158Smillert $dll =~ s![\\/]+!\\!g; # must be backslashes! 200*b39c5158Smillert die "fatal: Can't find resource DLL for Sys::Syslog\n" if !$dll; 201*b39c5158Smillert 202*b39c5158Smillert $Registry->{$root.$Source} = { 203*b39c5158Smillert '/EventMessageFile' => [ $dll, REG_EXPAND_SZ ], 204*b39c5158Smillert '/CategoryMessageFile' => [ $dll, REG_EXPAND_SZ ], 205*b39c5158Smillert '/CategoryCount' => [ '0x0000001e', REG_DWORD ], 206*b39c5158Smillert #'/TypesSupported' => [ '0x0000001e', REG_DWORD ], 207*b39c5158Smillert }; 208*b39c5158Smillert 209*b39c5158Smillert warn "Configured eventlog to use $dll for $Source\n" if $Sys::Syslog::DEBUG; 210*b39c5158Smillert } 211*b39c5158Smillert 212*b39c5158Smillert #Carp::confess("Registry has the wrong value for '$Source', possibly mismatched dll!\nMine:$dll\nGot :$Registry->{$root.$Source.'/CategoryMessageFile'}[0]\n") 213*b39c5158Smillert # if $Registry->{$root.$Source.'/CategoryMessageFile'}[0] ne $dll; 214*b39c5158Smillert 215*b39c5158Smillert # we really should do something useful with this but for now 216*b39c5158Smillert # we set it to "" to prevent Win32::EventLog from warning 217*b39c5158Smillert my $host = ""; 218*b39c5158Smillert 219*b39c5158Smillert $logger = Win32::EventLog->new($Source, $host) 220*b39c5158Smillert or Carp::confess("Failed to connect to the '$Source' event log"); 221*b39c5158Smillert 222*b39c5158Smillert return $logger; 223*b39c5158Smillert} 224*b39c5158Smillert 225*b39c5158Smillert 226*b39c5158Smillert# 227*b39c5158Smillert# _syslog_send() 228*b39c5158Smillert# ------------ 229*b39c5158Smillert# Used to convert syslog messages into eventlog messages 230*b39c5158Smillert# 231*b39c5158Smillertsub _syslog_send { 232*b39c5158Smillert my ($buf, $numpri, $numfac) = @_; 233*b39c5158Smillert $numpri ||= EVENTLOG_INFORMATION_TYPE(); 234*b39c5158Smillert $numfac ||= Sys::Syslog::LOG_USER(); 235*b39c5158Smillert my $name = $id2name{$numfac}; 236*b39c5158Smillert 237*b39c5158Smillert my $opts = { 238*b39c5158Smillert EventType => $priority2eventtype[$numpri], 239*b39c5158Smillert EventID => $const{"MSG_$name"}, 240*b39c5158Smillert Category => $const{"CAT_$name"}, 241*b39c5158Smillert Strings => "$buf\0", 242*b39c5158Smillert Data => "", 243*b39c5158Smillert }; 244*b39c5158Smillert 245*b39c5158Smillert if ($Sys::Syslog::DEBUG) { 246*b39c5158Smillert require Data::Dumper; 247*b39c5158Smillert warn Data::Dumper->Dump( 248*b39c5158Smillert [$numpri, $numfac, $name, $opts], 249*b39c5158Smillert [qw(numpri numfac name opts)] 250*b39c5158Smillert ); 251*b39c5158Smillert } 252*b39c5158Smillert 253*b39c5158Smillert return $logger->Report($opts); 254*b39c5158Smillert} 255*b39c5158Smillert 256*b39c5158Smillert 257*b39c5158Smillert=head1 NAME 258*b39c5158Smillert 259*b39c5158SmillertSys::Syslog::Win32 - Win32 support for Sys::Syslog 260*b39c5158Smillert 261*b39c5158Smillert=head1 DESCRIPTION 262*b39c5158Smillert 263*b39c5158SmillertThis module is a back-end plugin for C<Sys::Syslog>, for supporting the Win32 264*b39c5158Smillertevent log. It is not expected to be directly used by any module other than 265*b39c5158SmillertC<Sys::Syslog> therefore it's API may change at any time and no warranty is 266*b39c5158Smillertmade with regards to backward compatibility. You Have Been Warned. 267*b39c5158Smillert 268*b39c5158Smillert=head1 SEE ALSO 269*b39c5158Smillert 270*b39c5158SmillertL<Sys::Syslog> 271*b39c5158Smillert 272*b39c5158Smillert=head1 AUTHORS 273*b39c5158Smillert 274*b39c5158SmillertSE<eacute>bastien Aperghis-Tramoni and Yves Orton 275*b39c5158Smillert 276*b39c5158Smillert=head1 LICENSE 277*b39c5158Smillert 278*b39c5158SmillertThis program is free software; you can redistribute it and/or modify it 279*b39c5158Smillertunder the same terms as Perl itself. 280*b39c5158Smillert 281*b39c5158Smillert=cut 282*b39c5158Smillert 283*b39c5158Smillert1; 284