cpan/Sys-Syslog/win32/Win32.pm

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