xref: /openbsd-src/gnu/usr.bin/perl/cpan/Sys-Syslog/win32/Win32.pm (revision b39c515898423c8d899e35282f4b395f7cad3298)
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