1package Sys::Syslog::Win32;
2use strict;
3use warnings;
4use Carp;
5use 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
19our $Source;
20my $logger;
21my $Registry;
22
23use Win32::EventLog;
24use 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
42my $is_Cygwin = $^O =~ /Cygwin/i;
43my $is_Win32  = $^O =~ /Win32/i;
44
45my %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
113my %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
147my @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#
164sub _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#
231sub _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
259Sys::Syslog::Win32 - Win32 support for Sys::Syslog
260
261=head1 DESCRIPTION
262
263This module is a back-end plugin for C<Sys::Syslog>, for supporting the Win32
264event log. It is not expected to be directly used by any module other than
265C<Sys::Syslog> therefore it's API may change at any time and no warranty is
266made with regards to backward compatibility. You Have Been Warned.
267
268=head1 SEE ALSO
269
270L<Sys::Syslog>
271
272=head1 AUTHORS
273
274SE<eacute>bastien Aperghis-Tramoni and Yves Orton
275
276=head1 LICENSE
277
278This program is free software; you can redistribute it and/or modify it
279under the same terms as Perl itself.
280
281=cut
282
2831;
284