summaryrefslogtreecommitdiff
path: root/ext/Sys
diff options
context:
space:
mode:
authorSébastien Aperghis-Tramoni <sebastien@aperghis.net>2007-08-23 18:04:46 +0200
committerSteve Peters <steve@fisharerojo.org>2007-08-23 15:15:07 +0000
commita650b8419c25651c98cefeaefad81b6e7d4e4c4a (patch)
tree6830ec51b37bd45a1c5772261ef741a82be0afb3 /ext/Sys
parentef0f5379aae78ce5ed92be8dd4d9792b01fc6879 (diff)
downloadperl-a650b8419c25651c98cefeaefad81b6e7d4e4c4a.tar.gz
Upgrade Sys::Syslog to 0.19_01
Message-ID: <1187877886.46cd93fe13b12@imp.free.fr> p4raw-id: //depot/perl@31750
Diffstat (limited to 'ext/Sys')
-rw-r--r--ext/Sys/Syslog/Changes26
-rw-r--r--ext/Sys/Syslog/Makefile.PL178
-rw-r--r--ext/Sys/Syslog/README16
-rw-r--r--ext/Sys/Syslog/Syslog.pm354
-rw-r--r--ext/Sys/Syslog/Syslog.xs11
-rw-r--r--ext/Sys/Syslog/fallback/const-c.inc209
-rw-r--r--ext/Sys/Syslog/t/00-load.t6
-rw-r--r--ext/Sys/Syslog/t/constants.t2
-rwxr-xr-xext/Sys/Syslog/t/syslog.t156
-rw-r--r--ext/Sys/Syslog/win32/PerlLog.mc602
-rw-r--r--ext/Sys/Syslog/win32/PerlLog_RES.uu130
-rw-r--r--ext/Sys/Syslog/win32/PerlLog_dll.uu171
-rw-r--r--ext/Sys/Syslog/win32/Win32.pm283
-rw-r--r--ext/Sys/Syslog/win32/compile.pl277
14 files changed, 2150 insertions, 271 deletions
diff --git a/ext/Sys/Syslog/Changes b/ext/Sys/Syslog/Changes
index 27b2631d5a..fdb71a31db 100644
--- a/ext/Sys/Syslog/Changes
+++ b/ext/Sys/Syslog/Changes
@@ -1,5 +1,28 @@
Revision history for Sys-Syslog
+0.19 -- 2007.08.xx -- Sebastien Aperghis-Tramoni (SAPER)
+ [BUGFIX] CPAN-RT#20635: Fix tests to avoid problems related to the
+ "stream" mechanism which occured on Debian and Cygwin.
+ [BUGFIX] CPAN-RT#20780: Facility could not be temporarily changed.
+ Also fixes the syslog() before openlog() bug.
+ [BUGFIX] CPAN-RT#21333: Makefile.PL now creates a typemap for Perl 5.6.1
+ [BUGFIX] CPAN-RT#21516: disconnect_log() now correctly calls closelog_xs().
+ [BUGFIX] CPAN-RT#21866: Silence warnings in openlog().
+ [BUGFIX] CPAN-RT#25488: Silence warnings in disconnect_log().
+ via syslog().
+ [BUGFIX] Rewrote the constants generation code in order to provide
+ fallback value for non-standard macros.
+ [FEATURE] Added Win32 event log support thanks to Yves Orton.
+ [FEATURE] Added new macros from modern BSD and IRIX.
+ [FEATURE] Each non-standard macro now fall backs to a standard macro.
+ [CODE] Merged changes from Jerry D. Hedden to use ppport.h only when not
+ built from core distribution (blead@30657).
+ [TESTS] t/syslog.t now generates a more detailled TAP output.
+ [TESTS] Merged change blead@29176: suppress taint mode from t/constants.t
+ [TESTS] Added regression tests for CPAN-RT#21866 and #25488.
+ [EG] Added example script eg/syslog.pl
+ [DOC] Added the Sys::Syslog Rules.
+
0.18 -- 2006.08.28 -- Sebastien Aperghis-Tramoni (SAPER)
[BUGFIX] Rewrote the way the default identifiant is constructed.
[TESTS] CPAN-RT#20946: Removed the console mechanism from the main
@@ -12,7 +35,7 @@ Revision history for Sys-Syslog
some dead code.
[CODE] Actually added the macros from Mac OS X that were announced in
the 0.14 version.
- [DOC] CPAN-RT#20545: Rewrote the documentation about setlogksock().
+ [DOC] CPAN-RT#20545: Rewrote the documentation about setlogsock().
0.16 -- 2006.06.20 -- Sebastien Aperghis-Tramoni (SAPER)
[BUGFIX] Perl-RT#20557: Save errno before trying to connect.
@@ -24,7 +47,6 @@ Revision history for Sys-Syslog
[DOC] Added documentation about the "native" mechanism.
[DOC] Now indicates whether tickets are from CPAN or Perl RT.
-
0.15 -- 2006.06.10 -- Sebastien Aperghis-Tramoni (SAPER)
[FEATURE] CPAN-RT#17316: Added a "nofatal" option to openlog().
[FEATURE] Sys::Syslog warnings can now be controled by the warnings
diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL
index f56e7ba669..679a2ff2f3 100644
--- a/ext/Sys/Syslog/Makefile.PL
+++ b/ext/Sys/Syslog/Makefile.PL
@@ -1,90 +1,174 @@
use strict;
+use Config;
use ExtUtils::MakeMaker;
eval 'use ExtUtils::MakeMaker::Coverage';
+use File::Copy;
+use File::Path;
+use File::Spec;
require 5.006;
+
+# create a typemap for Perl 5.6
+if ($] < 5.008) {
+ open(TYPEMAP, ">typemap") or die "fatal: can't write typemap: $!";
+ print TYPEMAP "const char *\t\tT_PV\n";
+ close(TYPEMAP);
+}
+
+# create a lib/ dir in order to avoid warnings in Test::Distribution
+mkdir "lib";
+
+# virtual paths given to EU::MM
+my %virtual_path = ( 'Syslog.pm' => '$(INST_LIBDIR)/Syslog.pm' );
+
+# detect when to use Win32::EvenLog
+my (@extra_params, @extra_prereqs);
+my $use_eventlog = eval "use Win32::EventLog; 1";
+
+if ($use_eventlog) {
+ print " * Win32::EventLog detected.\n";
+ my $name = "PerlLog";
+
+ push @extra_prereqs, "Win32::TieRegistry" => 0, "Win32::EventLog" => 0;
+
+ $virtual_path{'win32/Win32.pm' } = '$(INST_LIBDIR)/Syslog/Win32.pm';
+ $virtual_path{'win32/PerlLog.dll'} = '$(INST_ARCHAUTODIR)/PerlLog.dll';
+
+ # recreate the DLL from its uuencoded form if it's not here
+ if (! -f File::Spec->catfile("win32", "$name.dll")) {
+ # read the uuencoded data
+ open(UU, '<' . File::Spec->catfile("win32", "$name\_dll.uu"))
+ or die "fatal: Can't read file '$name\_dll.uu': $!";
+ my $uudata = do { local $/; <UU> };
+ close(UU);
+
+ # write the DLL
+ open(DLL, '>' . File::Spec->catfile("win32", "$name.dll"))
+ or die "fatal: Can't write DLL '$name.dll': $!";
+ binmode(DLL);
+ print DLL unpack "u", $uudata;
+ close(DLL);
+ }
+}
+elsif ($^O =~ /Win32/) {
+ print <<"NOTICE"
+ *** You're running on a Win32 system, but you lack the Win32::EventLog\a
+ *** module, part of the libwin32 distribution. Although Sys::Syslog can
+ *** be used without Win32::EventLog, it won't be very useful except for
+ *** sending remote syslog messages. If you want to log messages on the
+ *** local host as well, please install libwin32 then Sys::Syslog again.
+NOTICE
+}
+
+# detect when being built in Perl core
+if (grep { $_ eq 'PERL_CORE=1' } @ARGV) {
+ push @extra_params,
+ MAN3PODS => {}; # Pods will be built by installman.
+}
+else {
+ push @extra_params,
+ DEFINE => '-DUSE_PPPORT_H';
+}
+
WriteMakefile(
NAME => 'Sys::Syslog',
LICENSE => 'perl',
VERSION_FROM => 'Syslog.pm',
ABSTRACT_FROM => 'Syslog.pm',
INSTALLDIRS => 'perl',
- MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes',
+ PM => \%virtual_path,
PREREQ_PM => {
'Test::More' => 0,
'XSLoader' => 0,
+ @extra_prereqs,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Sys-Syslog-*' },
- realclean => { FILES => 'const-c.inc const-xs.inc macros.all' },
- (
- (grep { $_ eq 'PERL_CORE=1' } @ARGV)
- ? ()
- : ('DEFINE' => '-DUSE_PPPORT_H')
- ),
+ realclean => { FILES => 'lib const-c.inc const-xs.inc macros.all PerlLog.h *.bak *.bin *.rc' },
+ @extra_params
);
+
+# find a default value for _PATH_LOG
my $_PATH_LOG;
-if (-S "/dev/log" and -w "/dev/log") {
- # Most unixes have a unix domain socket /dev/log.
- $_PATH_LOG = "/dev/log";
-} elsif (-c "/dev/conslog" and -w "/dev/conslog") {
+if (-c "/dev/conslog" and -w _) {
# SunOS 5.8 has a worldwritable /dev/conslog STREAMS log driver.
# The /dev/log STREAMS log driver on this platform has permissions
# and ownership `crw-r----- root sys'. /dev/conslog has more liberal
# permissions.
$_PATH_LOG = "/dev/conslog";
-} else {
+}
+elsif (-S "/dev/log" and -w _) {
+ # Most unixes have a unix domain socket /dev/log.
+ $_PATH_LOG = "/dev/log";
+}
+elsif (-S "/var/run/syslog" and -w _) {
+ # Mac OS X puts it at a different path.
+ $_PATH_LOG = "/var/run/syslog";
+}
+else {
$_PATH_LOG = "";
}
+
+# if possible, generate the code that handles the constants with
+# ExtUtils::Constant, otherwise use cached copy in fallback/
if(eval {require ExtUtils::Constant; 1}) {
- my @names = (
- # levels
- qw(
- LOG_ALERT LOG_CRIT LOG_DEBUG LOG_EMERG LOG_ERR
- LOG_INFO LOG_NOTICE LOG_WARNING
- ),
-
- # facilities
- qw(
- LOG_AUTH LOG_AUTHPRIV LOG_CRON LOG_DAEMON LOG_FTP
- LOG_INSTALL LOG_KERN LOG_LAUNCHD LOG_LFMT LOG_LOCAL0
- LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5
- LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL LOG_NETINFO
- LOG_NEWS LOG_RAS LOG_REMOTEAUTH LOG_SYSLOG LOG_USER LOG_UUCP
- ),
-
- # options
- qw(
- LOG_CONS LOG_PID LOG_NDELAY LOG_NOWAIT LOG_ODELAY LOG_PERROR
- ),
-
- # others macros
- qw(
- LOG_FACMASK LOG_NFACILITIES
- ),
- { name => "LOG_PRIMASK", type => "IV", default => [ "IV", 7] },
- { name => "_PATH_LOG", type => "PV", default => [ "PV", qq("$_PATH_LOG") ] },
+ my @levels = qw(
+ LOG_ALERT LOG_CRIT LOG_DEBUG LOG_EMERG LOG_ERR
+ LOG_INFO LOG_NOTICE LOG_WARNING
+ );
+
+ my @facilities = (
+ # standard facilities
+ qw(
+ LOG_AUTH LOG_AUTHPRIV LOG_CRON LOG_DAEMON LOG_FTP LOG_KERN
+ LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4
+ LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL LOG_NEWS
+ LOG_SYSLOG LOG_USER LOG_UUCP
+ ),
+ # Mac OS X specific facilities
+ { name => "LOG_INSTALL", type => "IV", default => [ "IV", "LOG_USER" ] },
+ { name => "LOG_LAUNCHD", type => "IV", default => [ "IV", "LOG_DAEMON"] },
+ { name => "LOG_NETINFO", type => "IV", default => [ "IV", "LOG_DAEMON"] },
+ { name => "LOG_RAS", type => "IV", default => [ "IV", "LOG_AUTH" ] },
+ { name => "LOG_REMOTEAUTH", type => "IV", default => [ "IV", "LOG_AUTH" ] },
+ # modern BSD specific facilities
+ { name => "LOG_CONSOLE", type => "IV", default => [ "IV", "LOG_USER" ] },
+ { name => "LOG_NTP", type => "IV", default => [ "IV", "LOG_DAEMON"] },
+ { name => "LOG_SECURITY", type => "IV", default => [ "IV", "LOG_AUTH" ] },
+ # IRIX specific facilities
+ { name => "LOG_AUDIT", type => "IV", default => [ "IV", "LOG_AUTH" ] },
+ { name => "LOG_LFMT", type => "IV", default => [ "IV", "LOG_USER" ] },
+ );
+
+ my @options = qw(
+ LOG_CONS LOG_PID LOG_NDELAY LOG_NOWAIT LOG_ODELAY LOG_PERROR
+ );
+
+ my @others_macros = (
+ qw(LOG_FACMASK),
+ { name => "_PATH_LOG", type => "PV", default => [ "PV", qq("$_PATH_LOG") ] },
+ { name => "LOG_PRIMASK", type => "IV", default => [ "IV", 7] },
+ { name => "LOG_NFACILITIES", type => "IV", default => [ "IV", scalar @facilities] },
);
ExtUtils::Constant::WriteConstants(
($] > 5.009002 ? (PROXYSUBS => 1) : ()),
NAME => 'Sys::Syslog',
- NAMES => \@names,
+ NAMES => [ @levels, @facilities, @options, @others_macros ],
);
- open(MACROS, '>macros.all') or warn "can't write 'macros.all': $!\n";
- print MACROS join $/, grep {!ref} @names;
+ my @names = map { ref $_ ? $_->{name} : $_ } @levels, @facilities, @options;
+ open(MACROS, '>macros.all') or warn "warning: Can't write 'macros.all': $!\n";
+ print MACROS join $/, @names;
close(MACROS);
-
-} else {
- require File::Copy;
- require File::Spec;
+}
+else {
foreach my $file ('const-c.inc', 'const-xs.inc') {
my $fallback = File::Spec->catfile('fallback', $file);
- File::Copy::copy($fallback, $file) or die "Can't copy $fallback to $ $!";
+ copy($fallback, $file) or die "fatal: Can't copy $fallback to $file: $!";
}
}
diff --git a/ext/Sys/Syslog/README b/ext/Sys/Syslog/README
index a6b4fc399f..e3e693c916 100644
--- a/ext/Sys/Syslog/README
+++ b/ext/Sys/Syslog/README
@@ -21,16 +21,16 @@ INSTALLATION
An ANSI-compliant compiler is required to compile the extension.
- Sys::Syslog should on any Perl since 5.6.0. This module has been
- tested by the author on the following Perl and system versions
+ Sys::Syslog should work on any Perl since 5.6.0. This module has
+ been tested by the author on the following Perl and system versions
but is likely to run on many more:
- - Perl 5.6.2 i686-linux gcc-3.4.1 (custom build)
- - Perl 5.8.5 i386-linux-thread-multi gcc-3.4.1 (vendor build)
- - Perl 5.8.7 i386-linux gcc-3.4.1 (custom build)
- - Perl 5.8.8 i386-freebsd-64int gcc-3.4.4 (custom build)
- - Perl 5.8.8 i386-linux gcc-3.4.1 (custom build)
- - Perl 5.8.6 darwin-thread-multi-2level gcc-4.0.1 (PowerPC) (vendor build)
+ Perl Architecture GCC
+ -----------------------------------------------------
+ 5.6.2 i686-linux 3.4.1
+ 5.8.5 i386-linux-thread-multi 3.4.1
+ 5.8.8 i386-freebsd-64int 3.4.4
+ 5.8.6 darwin-thread-multi-2level (PowerPC) 4.0.1
See also the corresponding CPAN Testers page:
http://testers.cpan.org/show/Sys-Syslog.html
diff --git a/ext/Sys/Syslog/Syslog.pm b/ext/Sys/Syslog/Syslog.pm
index 6dc3c853f4..957c22acfb 100644
--- a/ext/Sys/Syslog/Syslog.pm
+++ b/ext/Sys/Syslog/Syslog.pm
@@ -2,6 +2,7 @@ package Sys::Syslog;
use strict;
use warnings::register;
use Carp;
+use Fcntl qw(O_WRONLY);
use File::Basename;
use POSIX qw(strftime setlocale LC_TIME);
use Socket ':all';
@@ -9,7 +10,7 @@ require 5.006;
require Exporter;
{ no strict 'vars';
- $VERSION = '0.18_01';
+ $VERSION = '0.19_01';
@ISA = qw(Exporter);
%EXPORT_TAGS = (
@@ -22,14 +23,19 @@ require Exporter;
LOG_INFO LOG_NOTICE LOG_WARNING
),
- # facilities
+ # standard facilities
qw(
- LOG_AUTH LOG_AUTHPRIV LOG_CRON LOG_DAEMON LOG_FTP
- LOG_INSTALL LOG_KERN LOG_LAUNCHD LOG_LFMT LOG_LOCAL0
- LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5
- LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL LOG_NETINFO
- LOG_NEWS LOG_RAS LOG_REMOTEAUTH LOG_SYSLOG LOG_USER LOG_UUCP
- ),
+ LOG_AUTH LOG_AUTHPRIV LOG_CRON LOG_DAEMON LOG_FTP LOG_KERN
+ LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4
+ LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL LOG_NEWS
+ LOG_SYSLOG LOG_USER LOG_UUCP
+ ),
+ # Mac OS X specific facilities
+ qw( LOG_INSTALL LOG_LAUNCHD LOG_NETINFO LOG_RAS LOG_REMOTEAUTH ),
+ # modern BSD specific facilities
+ qw( LOG_CONSOLE LOG_NTP LOG_SECURITY ),
+ # IRIX specific facilities
+ qw( LOG_AUDIT LOG_LFMT ),
# options
qw(
@@ -68,18 +74,20 @@ require Exporter;
#
# Public variables
#
-our $host; # host to send syslog messages to
+use vars qw($host); # host to send syslog messages to (see notes at end)
#
# Global variables
#
+use vars qw($facility);
my $connected = 0; # flag to indicate if we're connected or not
my $syslog_send; # coderef of the function used to send messages
my $syslog_path = undef; # syslog path for "stream" and "unix" mechanisms
+my $syslog_xobj = undef; # if defined, holds the external object used to send messages
my $transmit_ok = 0; # flag to indicate if the last message was transmited
my $current_proto = undef; # current mechanism used to transmit messages
my $ident = ''; # identifiant prepended to each message
-my $facility = ''; # current facility
+$facility = ''; # current facility
my $maskpri = LOG_UPTO(&LOG_DEBUG); # current log mask
my %options = (
@@ -89,12 +97,23 @@ my %options = (
pid => 0,
);
-# it would be nice to try stream/unix first, since that will be
-# most efficient. However streams are dodgy - see _syslog_send_stream
+# Default is now to first use the native mechanism, so Perl programs
+# behave like other normal C programs, then try other mechanisms.
my @connectMethods = qw(native tcp udp unix stream console);
if ($^O =~ /^(freebsd|linux)$/) {
@connectMethods = grep { $_ ne 'udp' } @connectMethods;
}
+
+# use EventLog on Win32
+my $is_Win32 = $^O =~ /Win32/i;
+eval "use Sys::Syslog::Win32";
+
+if (not $@) {
+ unshift @connectMethods, 'eventlog';
+} elsif ($is_Win32) {
+ warn $@;
+}
+
my @defaultMethods = @connectMethods;
my @fallbackMethods = ();
@@ -110,7 +129,7 @@ sub AUTOLOAD {
($constname = $AUTOLOAD) =~ s/.*:://;
croak "Sys::Syslog::constant() not defined" if $constname eq 'constant';
my ($error, $val) = constant($constname);
- croak $error if $error;
+ croak $error if $error;
no strict 'refs';
*$AUTOLOAD = sub { $val };
goto &$AUTOLOAD;
@@ -120,6 +139,11 @@ sub AUTOLOAD {
sub openlog {
($ident, my $logopt, $facility) = @_;
+ # default values
+ $ident ||= basename($0) || getlogin() || getpwuid($<) || 'syslog';
+ $logopt ||= '';
+ $facility ||= LOG_USER();
+
for my $opt (split /\b/, $logopt) {
$options{$opt} = 1 if exists $options{$opt}
}
@@ -152,42 +176,55 @@ sub setlogsock {
@connectMethods = @$setsock;
} elsif (lc $setsock eq 'stream') {
- unless (defined $syslog_path) {
+ if (not defined $syslog_path) {
my @try = qw(/dev/log /dev/conslog);
- if (length &_PATH_LOG) { # Undefined _PATH_LOG is "".
+
+ if (length &_PATH_LOG) { # Undefined _PATH_LOG is "".
unshift @try, &_PATH_LOG;
}
+
for my $try (@try) {
if (-w $try) {
$syslog_path = $try;
last;
}
}
- warnings::warnif "stream passed to setlogsock, but could not find any device"
- unless defined $syslog_path
+
+ if (not defined $syslog_path) {
+ warnings::warnif "stream passed to setlogsock, but could not find any device";
+ return undef
+ }
}
- unless (-w $syslog_path) {
+
+ if (not -w $syslog_path) {
warnings::warnif "stream passed to setlogsock, but $syslog_path is not writable";
return undef;
} else {
- @connectMethods = ( 'stream' );
+ @connectMethods = qw(stream);
}
} elsif (lc $setsock eq 'unix') {
if (length _PATH_LOG() || (defined $syslog_path && -w $syslog_path)) {
$syslog_path = _PATH_LOG() unless defined $syslog_path;
- @connectMethods = ( 'unix' );
+ @connectMethods = qw(unix);
} else {
warnings::warnif 'unix passed to setlogsock, but path not available';
return undef;
}
} elsif (lc $setsock eq 'native') {
- @connectMethods = ( 'native' );
+ @connectMethods = qw(native);
+
+ } elsif (lc $setsock eq 'eventlog') {
+ if (eval "use Win32::EventLog; 1") {
+ @connectMethods = qw(eventlog);
+ } else {
+ warnings::warnif "eventlog passed to setlogsock, but operating system isn't Win32-compatible"
+ }
} elsif (lc $setsock eq 'tcp') {
if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) {
- @connectMethods = ( 'tcp' );
+ @connectMethods = qw(tcp);
} else {
warnings::warnif "tcp passed to setlogsock, but tcp service unavailable";
return undef;
@@ -195,7 +232,7 @@ sub setlogsock {
} elsif (lc $setsock eq 'udp') {
if (getservbyname('syslog', 'udp')) {
- @connectMethods = ( 'udp' );
+ @connectMethods = qw(udp);
} else {
warnings::warnif "udp passed to setlogsock, but udp service unavailable";
return undef;
@@ -205,10 +242,10 @@ sub setlogsock {
@connectMethods = ( 'tcp', 'udp' );
} elsif (lc $setsock eq 'console') {
- @connectMethods = ( 'console' );
+ @connectMethods = qw(console);
} else {
- croak "Invalid argument passed to setlogsock; must be 'stream', 'unix', 'native', 'tcp', 'udp' or 'inet'"
+ croak "Invalid argument passed to setlogsock; must be 'stream', 'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'"
}
return 1;
@@ -223,7 +260,11 @@ sub syslog {
my $fail_time = undef;
my $error = $!;
- my $facility = $facility; # may need to change temporarily.
+ # if $ident is undefined, it means openlog() wasn't previously called
+ # so do it now in order to have sensible defaults
+ openlog() unless $ident;
+
+ local $facility = $facility; # may need to change temporarily.
croak "syslog: expecting argument \$priority" unless defined $priority;
croak "syslog: expecting argument \$format" unless defined $mask;
@@ -256,15 +297,12 @@ sub syslog {
$numfac = xlate($facility);
}
- # if no identifiant, set up a default one
- $ident ||= basename($0) || getlogin() || getpwuid($<) || 'syslog';
-
connect_log() unless $connected;
if ($mask =~ /%m/) {
# escape percent signs for sprintf()
$error =~ s/%/%%/g if @_;
- # replace %m with $err, if preceded by an even number of percent signs
+ # replace %m with $error, if preceded by an even number of percent signs
$mask =~ s/(?<!%)((?:%%)*)%m/$1$error/g;
}
@@ -274,7 +312,11 @@ sub syslog {
if($current_proto eq 'native') {
$buf = $message;
- } else {
+ }
+ elsif ($current_proto eq 'eventlog') {
+ $buf = $message;
+ }
+ else {
my $whoami = $ident;
$whoami .= "[$$]" if $options{pid};
@@ -312,7 +354,7 @@ sub syslog {
$failed = undef if ($current_proto && $failed && $current_proto eq $failed);
if ($syslog_send) {
- if ($syslog_send->($buf, $numpri)) {
+ if ($syslog_send->($buf, $numpri, $numfac)) {
$transmit_ok++;
return 1;
}
@@ -371,8 +413,8 @@ sub _syslog_send_socket {
sub _syslog_send_native {
my ($buf, $numpri) = @_;
- eval { syslog_xs($numpri, $buf) };
- return $@ ? 0 : 1;
+ syslog_xs($numpri, $buf);
+ return 1;
}
@@ -420,7 +462,7 @@ sub connect_log {
$transmit_ok = 0;
if ($connected) {
$current_proto = $proto;
- my($old) = select(SYSLOG); $| = 1; select($old);
+ my ($old) = select(SYSLOG); $| = 1; select($old);
} else {
@fallbackMethods = ();
$err_sub->(join "\n\t- ", "no connection to syslog available", @errs);
@@ -460,8 +502,9 @@ sub connect_tcp {
push @$errs, "tcp socket: $!";
return 0;
}
+
setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1);
- setsockopt(SYSLOG, &IPPROTO_TCP, &TCP_NODELAY, 1);
+ setsockopt(SYSLOG, IPPROTO_TCP, TCP_NODELAY, 1);
if (!connect(SYSLOG, $addr)) {
push @$errs, "tcp connect: $!";
return 0;
@@ -530,7 +573,7 @@ sub connect_stream {
push @$errs, "stream $syslog_path is not writable";
return 0;
}
- if (!open(SYSLOG, ">" . $syslog_path)) {
+ if (!sysopen(SYSLOG, $syslog_path, 0400, O_WRONLY)) {
push @$errs, "stream can't open $syslog_path: $!";
return 0;
}
@@ -562,6 +605,7 @@ sub connect_unix {
push @$errs, "unix stream socket: $!";
return 0;
}
+
if (!connect(SYSLOG, $addr)) {
if (!socket(SYSLOG, AF_UNIX, SOCK_DGRAM, 0)) {
push @$errs, "unix dgram socket: $!";
@@ -598,6 +642,15 @@ sub connect_native {
return 1;
}
+sub connect_eventlog {
+ my ($errs) = @_;
+
+ $syslog_xobj = Sys::Syslog::Win32::_install();
+ $syslog_send = \&Sys::Syslog::Win32::_syslog_send;
+
+ return 1;
+}
+
sub connect_console {
my ($errs) = @_;
if (!-w '/dev/console') {
@@ -608,7 +661,7 @@ sub connect_console {
return 1;
}
-# to test if the connection is still good, we need to check if any
+# To test if the connection is still good, we need to check if any
# errors are present on the connection. The errors will not be raised
# by a write. Instead, sockets are made readable and the next read
# would cause the error to be returned. Unfortunately the syslog
@@ -617,10 +670,12 @@ sub connect_console {
sub connection_ok {
return 1 if defined $current_proto and (
$current_proto eq 'native' or $current_proto eq 'console'
+ or $current_proto eq 'eventlog'
);
+
my $rin = '';
vec($rin, fileno(SYSLOG), 1) = 1;
- my $ret = select $rin, undef, $rin, 0;
+ my $ret = select $rin, undef, $rin, 0.25;
return ($ret ? 0 : 1);
}
@@ -628,8 +683,12 @@ sub disconnect_log {
$connected = 0;
$syslog_send = undef;
- if($current_proto eq 'native') {
- eval { close_xs() };
+ if (defined $current_proto and $current_proto eq 'native') {
+ closelog_xs();
+ return 1;
+ }
+ elsif (defined $current_proto and $current_proto eq 'eventlog') {
+ $syslog_xobj->Close();
return 1;
}
@@ -646,7 +705,7 @@ Sys::Syslog - Perl interface to the UNIX syslog(3) calls
=head1 VERSION
-Version 0.18
+Version 0.19
=head1 SYNOPSIS
@@ -654,7 +713,6 @@ Version 0.18
use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock()
use Sys::Syslog qw(:standard :macros); # standard functions, plus macros
- setlogsock $sock_type;
openlog $ident, $logopt, $facility; # don't forget this
syslog $priority, $format, @args;
$oldmask = setlogmask $mask_priority;
@@ -667,6 +725,9 @@ C<Sys::Syslog> is an interface to the UNIX C<syslog(3)> program.
Call C<syslog()> with a string priority and a list of C<printf()> args
just like C<syslog(3)>.
+You can find a kind of FAQ in L<"THE RULES OF SYS::SYSLOG">. Please read
+it before coding, and again before asking questions.
+
=head1 EXPORTS
@@ -770,7 +831,10 @@ with the addition that C<%m> in $message or C<$format> is replaced with
C<"$!"> (the latest error message).
C<$priority> can specify a level, or a level and a facility. Levels and
-facilities can be given as strings or as macros.
+facilities can be given as strings or as macros. When using the C<eventlog>
+mechanism, priorities C<DEBUG> and C<INFO> are mapped to event type
+C<informational>, C<NOTICE> and C<WARNIN> to C<warning> and C<ERR> to
+C<EMERG> to C<error>.
If you didn't use C<openlog()> before using C<syslog()>, C<syslog()> will
try to guess the C<$ident> by extracting the shortest prefix of
@@ -873,6 +937,11 @@ For example Solaris and IRIX system may prefer C<"stream"> instead of C<"unix">.
C<"console"> - send messages directly to the console, as for the C<"cons">
option of C<openlog()>.
+=item *
+
+C<"eventlog"> - send messages to the Win32 events logger (Win32 only;
+added in C<Sys::Syslog> 0.19).
+
=back
A reference to an array can also be passed as the first parameter.
@@ -914,8 +983,37 @@ Closes the log file and returns true on success.
=back
+=head1 THE RULES OF SYS::SYSLOG
+
+I<The First Rule of Sys::Syslog is:>
+You do not call C<setlogsock>.
+
+I<The Second Rule of Sys::Syslog is:>
+You B<do not> call C<setlogsock>.
+
+I<The Third Rule of Sys::Syslog is:>
+The program crashes, C<die>s, calls C<closelog>, the log is over.
+
+I<The Fourth Rule of Sys::Syslog is:>
+One facility, one priority.
+
+I<The Fifth Rule of Sys::Syslog is:>
+One log at a time.
+
+I<The Sixth Rule of Sys::Syslog is:>
+No C<syslog> before C<openlog>.
+
+I<The Seventh Rule of Sys::Syslog is:>
+Logs will go on as long as they have to.
+
+I<The Eighth, and Final Rule of Sys::Syslog is:>
+If this is your first use of Sys::Syslog, you must read the doc.
+
+
=head1 EXAMPLES
+An example:
+
openlog($program, 'cons,pid', 'user');
syslog('info', '%s', 'this is another test');
syslog('mail|warning', 'this is a better test: %d', time);
@@ -923,11 +1021,13 @@ Closes the log file and returns true on success.
syslog('debug', 'this is the last test');
- setlogsock('unix');
+Another example:
+
openlog("$program $$", 'ndelay', 'user');
syslog('notice', 'fooprogram: this is really done');
- setlogsock('inet');
+Example of use of C<%m>:
+
$! = 55;
syslog('info', 'problem was %m'); # %m == $! in syslog(3)
@@ -947,6 +1047,10 @@ Log to UDP port on C<$remotehost> instead of logging locally:
=item *
+C<LOG_AUDIT> - audit daemon (IRIX); falls back to C<LOG_AUTH>
+
+=item *
+
C<LOG_AUTH> - security/authorization messages
=item *
@@ -955,6 +1059,10 @@ C<LOG_AUTHPRIV> - security/authorization messages (private)
=item *
+C<LOG_CONSOLE> - C</dev/console> output (FreeBSD); falls back to C<LOG_USER>
+
+=item *
+
C<LOG_CRON> - clock daemons (B<cron> and B<at>)
=item *
@@ -971,11 +1079,16 @@ C<LOG_KERN> - kernel messages
=item *
-C<LOG_INSTALL> - installer subsystem
+C<LOG_INSTALL> - installer subsystem (Mac OS X); falls back to C<LOG_USER>
=item *
-C<LOG_LAUNCHD> - launchd - general bootstrap daemon (Mac OS X)
+C<LOG_LAUNCHD> - launchd - general bootstrap daemon (Mac OS X);
+falls back to C<LOG_DAEMON>
+
+=item *
+
+C<LOG_LFMT> - logalert facility; falls back to C<LOG_USER>
=item *
@@ -991,7 +1104,7 @@ C<LOG_MAIL> - mail subsystem
=item *
-C<LOG_NETINFO> - NetInfo subsystem (Mac OS X)
+C<LOG_NETINFO> - NetInfo subsystem (Mac OS X); falls back to C<LOG_DAEMON>
=item *
@@ -999,11 +1112,22 @@ C<LOG_NEWS> - USENET news subsystem
=item *
-C<LOG_RAS> - Remote Access Service (VPN / PPP) (Mac OS X)
+C<LOG_NTP> - NTP subsystem (FreeBSD, NetBSD); falls back to C<LOG_DAEMON>
+
+=item *
+
+C<LOG_RAS> - Remote Access Service (VPN / PPP) (Mac OS X);
+falls back to C<LOG_AUTH>
=item *
-C<LOG_REMOTEAUTH> - remote authentication/authorization (Mac OS X)
+C<LOG_REMOTEAUTH> - remote authentication/authorization (Mac OS X);
+falls back to C<LOG_AUTH>
+
+=item *
+
+C<LOG_SECURITY> - security subsystems (firewalling, etc.) (FreeBSD);
+falls back to C<LOG_AUTH>
=item *
@@ -1061,57 +1185,63 @@ C<LOG_DEBUG> - debug-level message
=head1 DIAGNOSTICS
-=over 4
+=over
-=item Invalid argument passed to setlogsock
+=item C<Invalid argument passed to setlogsock>
B<(F)> You gave C<setlogsock()> an invalid value for C<$sock_type>.
-=item no connection to syslog available
+=item C<eventlog passed to setlogsock, but operating system isn't Win32-compatible>
+
+B<(W)> You asked C<setlogsock()> to use the Win32 event logger but the
+operating system running the program isn't Win32 or does not provides Win32
+facilities.
+
+=item C<no connection to syslog available>
B<(F)> C<syslog()> failed to connect to the specified socket.
-=item stream passed to setlogsock, but %s is not writable
+=item C<stream passed to setlogsock, but %s is not writable>
B<(W)> You asked C<setlogsock()> to use a stream socket, but the given
path is not writable.
-=item stream passed to setlogsock, but could not find any device
+=item C<stream passed to setlogsock, but could not find any device>
B<(W)> You asked C<setlogsock()> to use a stream socket, but didn't
provide a path, and C<Sys::Syslog> was unable to find an appropriate one.
-=item tcp passed to setlogsock, but tcp service unavailable
+=item C<tcp passed to setlogsock, but tcp service unavailable>
B<(W)> You asked C<setlogsock()> to use a TCP socket, but the service
is not available on the system.
-=item syslog: expecting argument %s
+=item C<syslog: expecting argument %s>
B<(F)> You forgot to give C<syslog()> the indicated argument.
-=item syslog: invalid level/facility: %s
+=item C<syslog: invalid level/facility: %s>
B<(F)> You specified an invalid level or facility.
-=item syslog: too many levels given: %s
+=item C<syslog: too many levels given: %s>
B<(F)> You specified too many levels.
-=item syslog: too many facilities given: %s
+=item C<syslog: too many facilities given: %s>
B<(F)> You specified too many facilities.
-=item syslog: level must be given
+=item C<syslog: level must be given>
B<(F)> You forgot to specify a level.
-=item udp passed to setlogsock, but udp service unavailable
+=item C<udp passed to setlogsock, but udp service unavailable>
B<(W)> You asked C<setlogsock()> to use a UDP socket, but the service
is not available on the system.
-=item unix passed to setlogsock, but path not available
+=item C<unix passed to setlogsock, but path not available>
B<(W)> You asked C<setlogsock()> to use a UNIX socket, but C<Sys::Syslog>
was unable to find an appropriate an appropriate device.
@@ -1121,6 +1251,8 @@ was unable to find an appropriate an appropriate device.
=head1 SEE ALSO
+=head2 Manual Pages
+
L<syslog(3)>
SUSv3 issue 6, IEEE Std 1003.1, 2004 edition,
@@ -1132,6 +1264,9 @@ L<http://www.gnu.org/software/libc/manual/html_node/Syslog.html>
Solaris 10 documentation on syslog,
L<http://docs.sun.com/app/docs/doc/816-5168/6mbb3hruo?a=view>
+IRIX 6.4 documentation on syslog,
+L<http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=0640&db=man&fname=3c+syslog>
+
AIX 5L 5.3 documentation on syslog,
L<http://publib.boulder.ibm.com/infocenter/pseries/v5r3/index.jsp?topic=/com.ibm.aix.doc/libs/basetrf2/syslog.htm>
@@ -1144,43 +1279,58 @@ L<http://h30097.www3.hp.com/docs/base_doc/DOCUMENTATION/V51_HTML/MAN/MAN3/0193__
Stratus VOS 15.1,
L<http://stratadoc.stratus.com/vos/15.1.1/r502-01/wwhelp/wwhimpl/js/html/wwhelp.htm?context=r502-01&file=ch5r502-01bi.html>
+=head2 RFCs
+
I<RFC 3164 - The BSD syslog Protocol>, L<http://www.faqs.org/rfcs/rfc3164.html>
-- Please note that this is an informational RFC, and therefore does not
specify a standard of any kind.
I<RFC 3195 - Reliable Delivery for syslog>, L<http://www.faqs.org/rfcs/rfc3195.html>
+=head2 Articles
+
I<Syslogging with Perl>, L<http://lexington.pm.org/meetings/022001.html>
+=head2 Event Log
-=head1 AUTHORS
+Windows Event Log,
+L<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wes/wes/windows_event_log.asp>
-Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall
-E<lt>F<larry@wall.org>E<gt>.
+
+=head1 AUTHORS & ACKNOWLEDGEMENTS
+
+Tom Christiansen E<lt>F<tchrist (at) perl.com>E<gt> and Larry Wall
+E<lt>F<larry (at) wall.org>E<gt>.
UNIX domain sockets added by Sean Robinson
-E<lt>F<robinson_s@sc.maricopa.edu>E<gt> with support from Tim Bunce
-E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and the C<perl5-porters> mailing list.
+E<lt>F<robinson_s (at) sc.maricopa.edu>E<gt> with support from Tim Bunce
+E<lt>F<Tim.Bunce (at) ig.co.uk>E<gt> and the C<perl5-porters> mailing list.
Dependency on F<syslog.ph> replaced with XS code by Tom Hughes
-E<lt>F<tom@compton.nu>E<gt>.
+E<lt>F<tom (at) compton.nu>E<gt>.
-Code for C<constant()>s regenerated by Nicholas Clark E<lt>F<nick@ccl4.org>E<gt>.
+Code for C<constant()>s regenerated by Nicholas Clark E<lt>F<nick (at) ccl4.org>E<gt>.
Failover to different communication modes by Nick Williams
-E<lt>F<Nick.Williams@morganstanley.com>E<gt>.
+E<lt>F<Nick.Williams (at) morganstanley.com>E<gt>.
+
+Extracted from core distribution for publishing on the CPAN by
+SE<eacute>bastien Aperghis-Tramoni E<lt>sebastien (at) aperghis.netE<gt>.
XS code for using native C functions borrowed from C<L<Unix::Syslog>>,
-written by Marcus Harnisch E<lt>F<marcus.harnisch@gmx.net>E<gt>.
+written by Marcus Harnisch E<lt>F<marcus.harnisch (at) gmx.net>E<gt>.
-Extracted from core distribution for publishing on the CPAN by
-SE<eacute>bastien Aperghis-Tramoni E<lt>sebastien@aperghis.netE<gt>.
+Yves Orton suggested and helped for making C<Sys::Syslog> use the native
+event logger under Win32 systems.
+
+Jerry D. Hedden and Reini Urban provided greatly appreciated help to
+debug and polish C<Sys::Syslog> under Cygwin.
=head1 BUGS
Please report any bugs or feature requests to
-C<bug-sys-syslog at rt.cpan.org>, or through the web interface at
+C<bug-sys-syslog (at) rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Sys-Syslog>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
@@ -1229,3 +1379,55 @@ This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
+
+=begin comment
+
+Notes for the future maintainer (even if it's still me..)
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+Using Google Code Search, I search who on Earth was relying on $host being
+public. It found 5 hits:
+
+* First was inside Indigo Star Perl2exe documentation. Just an old version
+of Sys::Syslog.
+
+
+* One real hit was inside DalWeathDB, a weather related program. It simply
+does a
+
+ $Sys::Syslog::host = '127.0.0.1';
+
+- L<http://www.gallistel.net/nparker/weather/code/>
+
+
+* Two hits were in TPC, a fax server thingy. It does a
+
+ $Sys::Syslog::host = $TPC::LOGHOST;
+
+but also has this strange piece of code:
+
+ # work around perl5.003 bug
+ sub Sys::Syslog::hostname {}
+
+I don't know what bug the author referred to.
+
+- L<http://www.tpc.int/>
+- L<ftp://ftp.tpc.int/tpc/server/UNIX/>
+- L<ftp://ftp-usa.tpc.int/pub/tpc/server/UNIX/>
+
+
+* Last hit was in Filefix, which seems to be a FIDOnet mail program (!).
+This one does not use $host, but has the following piece of code:
+
+ sub Sys::Syslog::hostname
+ {
+ use Sys::Hostname;
+ return hostname;
+ }
+
+I guess this was a more elaborate form of the previous bit, maybe because
+of a bug in Sys::Syslog back then?
+
+- L<ftp://ftp.kiae.su/pub/unix/fido/>
+
+=end comment
diff --git a/ext/Sys/Syslog/Syslog.xs b/ext/Sys/Syslog/Syslog.xs
index 61712d4612..7d72c64bdc 100644
--- a/ext/Sys/Syslog/Syslog.xs
+++ b/ext/Sys/Syslog/Syslog.xs
@@ -5,10 +5,19 @@
# include "ppport.h"
#endif
+#ifndef HAVE_SYSLOG
+#define HAVE_SYSLOG 1
+#endif
+
#ifdef I_SYSLOG
#include <syslog.h>
#endif
+#if defined(_WIN32) && !defined(__CYGWIN__)
+#undef HAVE_SYSLOG
+#include "fallback/syslog.h"
+#endif
+
static SV *ident_svptr;
#include "const-c.inc"
@@ -88,6 +97,7 @@ LOG_UPTO(pri)
OUTPUT:
RETVAL
+#ifdef HAVE_SYSLOG
void
openlog_xs(ident, option, facility)
@@ -125,3 +135,4 @@ closelog_xs()
if (SvREFCNT(ident_svptr))
SvREFCNT_dec(ident_svptr);
+#endif /* HAVE_SYSLOG */
diff --git a/ext/Sys/Syslog/fallback/const-c.inc b/ext/Sys/Syslog/fallback/const-c.inc
index b0bd77207b..8fb8cb6b98 100644
--- a/ext/Sys/Syslog/fallback/const-c.inc
+++ b/ext/Sys/Syslog/fallback/const-c.inc
@@ -24,7 +24,7 @@ static int
constant_7 (pTHX_ const char *name, IV *iv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
- LOG_ERR LOG_FTP LOG_LPR LOG_PID LOG_RAS */
+ LOG_ERR LOG_FTP LOG_LPR LOG_NTP LOG_PID LOG_RAS */
/* Offset 4 gives the best switch position. */
switch (name[4]) {
case 'E':
@@ -60,6 +60,18 @@ constant_7 (pTHX_ const char *name, IV *iv_return) {
#endif
}
break;
+ case 'N':
+ if (memEQ(name, "LOG_NTP", 7)) {
+ /* ^ */
+#ifdef LOG_NTP
+ *iv_return = LOG_NTP;
+ return PERL_constant_ISIV;
+#else
+ *iv_return = LOG_DAEMON;
+ return PERL_constant_ISIV;
+#endif
+ }
+ break;
case 'P':
if (memEQ(name, "LOG_PID", 7)) {
/* ^ */
@@ -78,7 +90,8 @@ constant_7 (pTHX_ const char *name, IV *iv_return) {
*iv_return = LOG_RAS;
return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ *iv_return = LOG_AUTH;
+ return PERL_constant_ISIV;
#endif
}
break;
@@ -154,7 +167,8 @@ constant_8 (pTHX_ const char *name, IV *iv_return) {
*iv_return = LOG_LFMT;
return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ *iv_return = LOG_USER;
+ return PERL_constant_ISIV;
#endif
}
break;
@@ -221,34 +235,34 @@ static int
constant_9 (pTHX_ const char *name, IV *iv_return, const char **pv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
- LOG_ALERT LOG_DEBUG LOG_EMERG _PATH_LOG */
- /* Offset 4 gives the best switch position. */
- switch (name[4]) {
- case 'A':
- if (memEQ(name, "LOG_ALERT", 9)) {
- /* ^ */
-#ifdef LOG_ALERT
- *iv_return = LOG_ALERT;
+ LOG_ALERT LOG_AUDIT LOG_DEBUG LOG_EMERG _PATH_LOG */
+ /* Offset 5 gives the best switch position. */
+ switch (name[5]) {
+ case 'E':
+ if (memEQ(name, "LOG_DEBUG", 9)) {
+ /* ^ */
+#ifdef LOG_DEBUG
+ *iv_return = LOG_DEBUG;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
- case 'D':
- if (memEQ(name, "LOG_DEBUG", 9)) {
- /* ^ */
-#ifdef LOG_DEBUG
- *iv_return = LOG_DEBUG;
+ case 'L':
+ if (memEQ(name, "LOG_ALERT", 9)) {
+ /* ^ */
+#ifdef LOG_ALERT
+ *iv_return = LOG_ALERT;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
- case 'E':
+ case 'M':
if (memEQ(name, "LOG_EMERG", 9)) {
- /* ^ */
+ /* ^ */
#ifdef LOG_EMERG
*iv_return = LOG_EMERG;
return PERL_constant_ISIV;
@@ -257,14 +271,26 @@ constant_9 (pTHX_ const char *name, IV *iv_return, const char **pv_return) {
#endif
}
break;
- case 'H':
+ case 'U':
+ if (memEQ(name, "LOG_AUDIT", 9)) {
+ /* ^ */
+#ifdef LOG_AUDIT
+ *iv_return = LOG_AUDIT;
+ return PERL_constant_ISIV;
+#else
+ *iv_return = LOG_AUTH;
+ return PERL_constant_ISIV;
+#endif
+ }
+ break;
+ case '_':
if (memEQ(name, "_PATH_LOG", 9)) {
- /* ^ */
+ /* ^ */
#ifdef _PATH_LOG
*pv_return = _PATH_LOG;
return PERL_constant_ISPV;
#else
- *pv_return = "";
+ *pv_return = "/var/run/syslog";
return PERL_constant_ISPV;
#endif
}
@@ -453,12 +479,13 @@ static int
constant_11 (pTHX_ const char *name, IV *iv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
- LOG_FACMASK LOG_INSTALL LOG_LAUNCHD LOG_NETINFO LOG_PRIMASK LOG_WARNING */
- /* Offset 4 gives the best switch position. */
- switch (name[4]) {
- case 'F':
+ LOG_CONSOLE LOG_FACMASK LOG_INSTALL LOG_LAUNCHD LOG_NETINFO LOG_PRIMASK
+ LOG_WARNING */
+ /* Offset 6 gives the best switch position. */
+ switch (name[6]) {
+ case 'C':
if (memEQ(name, "LOG_FACMASK", 11)) {
- /* ^ */
+ /* ^ */
#ifdef LOG_FACMASK
*iv_return = LOG_FACMASK;
return PERL_constant_ISIV;
@@ -468,57 +495,73 @@ constant_11 (pTHX_ const char *name, IV *iv_return) {
}
break;
case 'I':
- if (memEQ(name, "LOG_INSTALL", 11)) {
- /* ^ */
-#ifdef LOG_INSTALL
- *iv_return = LOG_INSTALL;
+ if (memEQ(name, "LOG_PRIMASK", 11)) {
+ /* ^ */
+#ifdef LOG_PRIMASK
+ *iv_return = LOG_PRIMASK;
return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ *iv_return = 7;
+ return PERL_constant_ISIV;
#endif
}
break;
- case 'L':
- if (memEQ(name, "LOG_LAUNCHD", 11)) {
- /* ^ */
-#ifdef LOG_LAUNCHD
- *iv_return = LOG_LAUNCHD;
+ case 'N':
+ if (memEQ(name, "LOG_CONSOLE", 11)) {
+ /* ^ */
+#ifdef LOG_CONSOLE
+ *iv_return = LOG_CONSOLE;
return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ *iv_return = LOG_USER;
+ return PERL_constant_ISIV;
#endif
}
break;
- case 'N':
- if (memEQ(name, "LOG_NETINFO", 11)) {
- /* ^ */
-#ifdef LOG_NETINFO
- *iv_return = LOG_NETINFO;
+ case 'R':
+ if (memEQ(name, "LOG_WARNING", 11)) {
+ /* ^ */
+#ifdef LOG_WARNING
+ *iv_return = LOG_WARNING;
return PERL_constant_ISIV;
#else
return PERL_constant_NOTDEF;
#endif
}
break;
- case 'P':
- if (memEQ(name, "LOG_PRIMASK", 11)) {
- /* ^ */
-#ifdef LOG_PRIMASK
- *iv_return = LOG_PRIMASK;
+ case 'S':
+ if (memEQ(name, "LOG_INSTALL", 11)) {
+ /* ^ */
+#ifdef LOG_INSTALL
+ *iv_return = LOG_INSTALL;
return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ *iv_return = LOG_USER;
+ return PERL_constant_ISIV;
#endif
}
break;
- case 'W':
- if (memEQ(name, "LOG_WARNING", 11)) {
- /* ^ */
-#ifdef LOG_WARNING
- *iv_return = LOG_WARNING;
+ case 'T':
+ if (memEQ(name, "LOG_NETINFO", 11)) {
+ /* ^ */
+#ifdef LOG_NETINFO
+ *iv_return = LOG_NETINFO;
return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ *iv_return = LOG_DAEMON;
+ return PERL_constant_ISIV;
+#endif
+ }
+ break;
+ case 'U':
+ if (memEQ(name, "LOG_LAUNCHD", 11)) {
+ /* ^ */
+#ifdef LOG_LAUNCHD
+ *iv_return = LOG_LAUNCHD;
+ return PERL_constant_ISIV;
+#else
+ *iv_return = LOG_DAEMON;
+ return PERL_constant_ISIV;
#endif
}
break;
@@ -545,13 +588,23 @@ use ExtUtils::Constant qw (constant_types C_constant XS_constant);
my $types = {map {($_, 1)} qw(IV PV)};
my @names = (qw(LOG_ALERT LOG_AUTH LOG_AUTHPRIV LOG_CONS LOG_CRIT LOG_CRON
LOG_DAEMON LOG_DEBUG LOG_EMERG LOG_ERR LOG_FACMASK LOG_FTP
- LOG_INFO LOG_INSTALL LOG_KERN LOG_LAUNCHD LOG_LFMT LOG_LOCAL0
- LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5
- LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL LOG_NDELAY LOG_NETINFO
- LOG_NEWS LOG_NFACILITIES LOG_NOTICE LOG_NOWAIT LOG_ODELAY
- LOG_PERROR LOG_PID LOG_PRIMASK LOG_RAS LOG_REMOTEAUTH LOG_SYSLOG
- LOG_USER LOG_UUCP LOG_WARNING),
- {name=>"_PATH_LOG", type=>"PV", default=>["PV", "\"\""]});
+ LOG_INFO LOG_KERN LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3
+ LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL
+ LOG_NDELAY LOG_NEWS LOG_NOTICE LOG_NOWAIT LOG_ODELAY LOG_PERROR
+ LOG_PID LOG_SYSLOG LOG_USER LOG_UUCP LOG_WARNING),
+ {name=>"LOG_AUDIT", type=>"IV", default=>["IV", "LOG_AUTH"]},
+ {name=>"LOG_CONSOLE", type=>"IV", default=>["IV", "LOG_USER"]},
+ {name=>"LOG_INSTALL", type=>"IV", default=>["IV", "LOG_USER"]},
+ {name=>"LOG_LAUNCHD", type=>"IV", default=>["IV", "LOG_DAEMON"]},
+ {name=>"LOG_LFMT", type=>"IV", default=>["IV", "LOG_USER"]},
+ {name=>"LOG_NETINFO", type=>"IV", default=>["IV", "LOG_DAEMON"]},
+ {name=>"LOG_NFACILITIES", type=>"IV", default=>["IV", "30"]},
+ {name=>"LOG_NTP", type=>"IV", default=>["IV", "LOG_DAEMON"]},
+ {name=>"LOG_PRIMASK", type=>"IV", default=>["IV", "7"]},
+ {name=>"LOG_RAS", type=>"IV", default=>["IV", "LOG_AUTH"]},
+ {name=>"LOG_REMOTEAUTH", type=>"IV", default=>["IV", "LOG_AUTH"]},
+ {name=>"LOG_SECURITY", type=>"IV", default=>["IV", "LOG_AUTH"]},
+ {name=>"_PATH_LOG", type=>"PV", default=>["PV", "\"/var/run/syslog\""]});
print constant_types(); # macro defs
foreach (C_constant ("Sys::Syslog", 'constant', 'IV', $types, undef, 3, @names) ) {
@@ -579,13 +632,33 @@ __END__
return constant_11 (aTHX_ name, iv_return);
break;
case 12:
- if (memEQ(name, "LOG_AUTHPRIV", 12)) {
+ /* Names all of length 12. */
+ /* LOG_AUTHPRIV LOG_SECURITY */
+ /* Offset 8 gives the best switch position. */
+ switch (name[8]) {
+ case 'P':
+ if (memEQ(name, "LOG_AUTHPRIV", 12)) {
+ /* ^ */
#ifdef LOG_AUTHPRIV
- *iv_return = LOG_AUTHPRIV;
- return PERL_constant_ISIV;
+ *iv_return = LOG_AUTHPRIV;
+ return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ return PERL_constant_NOTDEF;
#endif
+ }
+ break;
+ case 'R':
+ if (memEQ(name, "LOG_SECURITY", 12)) {
+ /* ^ */
+#ifdef LOG_SECURITY
+ *iv_return = LOG_SECURITY;
+ return PERL_constant_ISIV;
+#else
+ *iv_return = LOG_AUTH;
+ return PERL_constant_ISIV;
+#endif
+ }
+ break;
}
break;
case 14:
@@ -594,7 +667,8 @@ __END__
*iv_return = LOG_REMOTEAUTH;
return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ *iv_return = LOG_AUTH;
+ return PERL_constant_ISIV;
#endif
}
break;
@@ -604,7 +678,8 @@ __END__
*iv_return = LOG_NFACILITIES;
return PERL_constant_ISIV;
#else
- return PERL_constant_NOTDEF;
+ *iv_return = 30;
+ return PERL_constant_ISIV;
#endif
}
break;
diff --git a/ext/Sys/Syslog/t/00-load.t b/ext/Sys/Syslog/t/00-load.t
index 35d9042680..188ab125d2 100644
--- a/ext/Sys/Syslog/t/00-load.t
+++ b/ext/Sys/Syslog/t/00-load.t
@@ -1,9 +1,9 @@
-#!perl -T
-
+#!perl -wT
+use strict;
use Test::More tests => 1;
BEGIN {
use_ok( 'Sys::Syslog' );
}
-#diag( "Testing Sys::Syslog $Sys::Syslog::VERSION, Perl $], $^X" );
+diag( "Testing Sys::Syslog $Sys::Syslog::VERSION, Perl $], $^X" );
diff --git a/ext/Sys/Syslog/t/constants.t b/ext/Sys/Syslog/t/constants.t
index b484295b29..c2002fb374 100644
--- a/ext/Sys/Syslog/t/constants.t
+++ b/ext/Sys/Syslog/t/constants.t
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!perl -wT
use strict;
use File::Spec;
use Test::More;
diff --git a/ext/Sys/Syslog/t/syslog.t b/ext/Sys/Syslog/t/syslog.t
index 7e9e2ad2de..5a2fc3e5a1 100755
--- a/ext/Sys/Syslog/t/syslog.t
+++ b/ext/Sys/Syslog/t/syslog.t
@@ -1,7 +1,7 @@
-#!/usr/bin/perl -T
+#!perl -T
BEGIN {
- if( $ENV{PERL_CORE} ) {
+ if ($ENV{PERL_CORE}) {
chdir 't';
@INC = '../lib';
}
@@ -19,18 +19,26 @@ use warnings qw(closure deprecated exiting glob io misc numeric once overflow
pack portable recursion redefine regexp severe signal substr
syntax taint uninitialized unpack untie utf8 void);
-# check that the module is at least available
-plan skip_all => "Sys::Syslog was not build"
- unless $Config{'extensions'} =~ /\bSyslog\b/;
+my $is_Win32 = $^O =~ /win32/i;
+my $is_Cygwin = $^O =~ /cygwin/i;
+
+# if testing in core, check that the module is at least available
+if ($ENV{PERL_CORE}) {
+ plan skip_all => "Sys::Syslog was not build"
+ unless $Config{'extensions'} =~ /\bSyslog\b/;
+}
# we also need Socket
plan skip_all => "Socket was not build"
- unless $Config{'extensions'} =~ /\bSocket\b/;
+ unless $Config{'extensions'} =~ /\bSocket\b/;
my $tests;
plan tests => $tests;
-BEGIN { $tests = 1 }
+# any remaining warning should be severly punished
+BEGIN { eval "use Test::NoWarnings"; $tests = $@ ? 0 : 1; }
+
+BEGIN { $tests += 1 }
# ok, now loads them
eval 'use Socket';
use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
@@ -103,110 +111,124 @@ SKIP: {
}
-BEGIN { $tests += 20 * 6 }
+BEGIN { $tests += 20 * 7 }
# try to open a syslog using all the available connection methods
-for my $sock_type (qw(native stream unix inet tcp udp)) {
+my @passed = ();
+for my $sock_type (qw(native eventlog unix stream inet tcp udp)) {
SKIP: {
+ skip "the 'unix' mechanism works, so the tests will likely fail with the 'stream' mechanism", 20
+ if $sock_type eq 'stream' and grep {/unix/} @passed;
+
# setlogsock() called with an arrayref
$r = eval { setlogsock([$sock_type]) } || 0;
skip "can't use '$sock_type' socket", 20 unless $r;
- is( $@, '', "setlogsock() called with ['$sock_type']" );
- ok( $r, "setlogsock() should return true: '$r'" );
+ is( $@, '', "[$sock_type] setlogsock() called with ['$sock_type']" );
+ ok( $r, "[$sock_type] setlogsock() should return true: '$r'" );
# setlogsock() called with a single argument
$r = eval { setlogsock($sock_type) } || 0;
skip "can't use '$sock_type' socket", 18 unless $r;
- is( $@, '', "setlogsock() called with '$sock_type'" );
- ok( $r, "setlogsock() should return true: '$r'" );
+ is( $@, '', "[$sock_type] setlogsock() called with '$sock_type'" );
+ ok( $r, "[$sock_type] setlogsock() should return true: '$r'" );
# openlog() without option NDELAY
$r = eval { openlog('perl', '', 'local0') } || 0;
skip "can't connect to syslog", 16 if $@ =~ /^no connection to syslog available/;
- is( $@, '', "openlog() called with facility 'local0' and without option 'ndelay'" );
- ok( $r, "openlog() should return true: '$r'" );
+ is( $@, '', "[$sock_type] openlog() called with facility 'local0' and without option 'ndelay'" );
+ ok( $r, "[$sock_type] openlog() should return true: '$r'" );
# openlog() with the option NDELAY
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
skip "can't connect to syslog", 14 if $@ =~ /^no connection to syslog available/;
- is( $@, '', "openlog() called with facility 'local0' with option 'ndelay'" );
- ok( $r, "openlog() should return true: '$r'" );
+ is( $@, '', "[$sock_type] openlog() called with facility 'local0' with option 'ndelay'" );
+ ok( $r, "[$sock_type] openlog() should return true: '$r'" );
# syslog() with negative level, should fail
$r = eval { syslog(-1, "$test_string by connecting to a $sock_type socket") } || 0;
- like( $@, '/^syslog: invalid level\/facility: /', "syslog() called with level -1" );
- ok( !$r, "syslog() should return false: '$r'" );
+ like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level -1" );
+ ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
# syslog() with levels "info" and "notice" (as a strings), should fail
$r = eval { syslog('info,notice', "$test_string by connecting to a $sock_type socket") } || 0;
- like( $@, '/^syslog: too many levels given: notice/', "syslog() called with level 'info,notice'" );
- ok( !$r, "syslog() should return false: '$r'" );
+ like( $@, '/^syslog: too many levels given: notice/', "[$sock_type] syslog() called with level 'info,notice'" );
+ ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
# syslog() with facilities "local0" and "local1" (as a strings), should fail
$r = eval { syslog('local0,local1', "$test_string by connecting to a $sock_type socket") } || 0;
- like( $@, '/^syslog: too many facilities given: local1/', "syslog() called with level 'info,notice'" );
- ok( !$r, "syslog() should return false: '$r'" );
+ like( $@, '/^syslog: too many facilities given: local1/', "[$sock_type] syslog() called with level 'info,notice'" );
+ ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
# syslog() with level "info" (as a string), should pass
- $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
- is( $@, '', "syslog() called with level 'info' (string)" );
- ok( $r, "syslog() should return true: '$r'" );
+ $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
+ is( $@, '', "[$sock_type] syslog() called with level 'info' (string)" );
+ ok( $r, "[$sock_type] syslog() should return true: '$r'" );
# syslog() with level "info" (as a macro), should pass
- $r = eval { syslog(LOG_INFO(), "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
- is( $@, '', "syslog() called with level 'info' (macro)" );
- ok( $r, "syslog() should return true: '$r'" );
-
- # syslog() with facility "kern" (as a string), should fail
- #$r = eval { syslog('kern', "$test_string by connecting to a $sock_type socket") } || 0;
- #like( $@, '/^syslog: invalid level/facility: kern/', "syslog() called with facility 'kern'" );
- #ok( !$r, "syslog() should return false: '$r'" );
+ { local $! = 1;
+ $r = eval { syslog(LOG_INFO(), "$test_string by connecting to a $sock_type socket, setting a fake errno: %m") } || 0;
+ }
+ is( $@, '', "[$sock_type] syslog() called with level 'info' (macro)" );
+ ok( $r, "[$sock_type] syslog() should return true: '$r'" );
- # syslog() with facility "kern" (as a macro), should fail
- #$r = eval { syslog(LOG_KERN, "$test_string by connecting to a $sock_type socket") } || 0;
- #like( $@, '/^syslog: invalid level/facility: 0/', "syslog() called with facility 'kern'" );
- #ok( !$r, "syslog() should return false: '$r'" );
+ push @passed, $sock_type;
SKIP: {
skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
# closelog()
$r = eval { closelog() } || 0;
- is( $@, '', "closelog()" );
- ok( $r, "closelog() should return true: '$r'" );
+ is( $@, '', "[$sock_type] closelog()" );
+ ok( $r, "[$sock_type] closelog() should return true: '$r'" );
}
}
}
BEGIN { $tests += 10 }
-# setlogsock() with "stream" and an undef path
-$r = eval { setlogsock("stream", undef ) } || '';
-is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
-ok( $r, "setlogsock() should return true: '$r'" );
-
-# setlogsock() with "stream" and an empty path
-$r = eval { setlogsock("stream", '' ) } || '';
-is( $@, '', "setlogsock() called, with 'stream' and an empty path" );
-ok( !$r, "setlogsock() should return false: '$r'" );
-
-# setlogsock() with "stream" and /dev/null
-$r = eval { setlogsock("stream", '/dev/null' ) } || '';
-is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" );
-ok( $r, "setlogsock() should return true: '$r'" );
-
-# setlogsock() with "stream" and a non-existing file
-$r = eval { setlogsock("stream", 'test.log' ) } || '';
-is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" );
-ok( !$r, "setlogsock() should return false: '$r'" );
-
-# setlogsock() with "stream" and a local file
SKIP: {
- my $logfile = "test.log";
- open(LOG, ">$logfile") or skip "can't create file '$logfile': $!", 2;
- close(LOG);
- $r = eval { setlogsock("stream", $logfile ) } || '';
- is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" );
+ skip "not testing setlogsock('stream') on Win32", 10 if $is_Win32;
+ skip "the 'unix' mechanism works, so the tests will likely fail with the 'stream' mechanism", 10
+ if grep {/unix/} @passed;
+
+ # setlogsock() with "stream" and an undef path
+ $r = eval { setlogsock("stream", undef ) } || '';
+ is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
+ if ($is_Cygwin) {
+ if (-x "/usr/sbin/syslog-ng") {
+ ok( $r, "setlogsock() on Cygwin with syslog-ng should return true: '$r'" );
+ }
+ else {
+ ok( !$r, "setlogsock() on Cygwin without syslog-ng should return false: '$r'" );
+ }
+ }
+ else {
+ ok( $r, "setlogsock() should return true: '$r'" );
+ }
+
+ # setlogsock() with "stream" and an empty path
+ $r = eval { setlogsock("stream", '' ) } || '';
+ is( $@, '', "setlogsock() called, with 'stream' and an empty path" );
+ ok( !$r, "setlogsock() should return false: '$r'" );
+
+ # setlogsock() with "stream" and /dev/null
+ $r = eval { setlogsock("stream", '/dev/null' ) } || '';
+ is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" );
ok( $r, "setlogsock() should return true: '$r'" );
- unlink($logfile);
+
+ # setlogsock() with "stream" and a non-existing file
+ $r = eval { setlogsock("stream", 'test.log' ) } || '';
+ is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" );
+ ok( !$r, "setlogsock() should return false: '$r'" );
+
+ # setlogsock() with "stream" and a local file
+ SKIP: {
+ my $logfile = "test.log";
+ open(LOG, ">$logfile") or skip "can't create file '$logfile': $!", 2;
+ close(LOG);
+ $r = eval { setlogsock("stream", $logfile ) } || '';
+ is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" );
+ ok( $r, "setlogsock() should return true: '$r'" );
+ unlink($logfile);
+ }
}
diff --git a/ext/Sys/Syslog/win32/PerlLog.mc b/ext/Sys/Syslog/win32/PerlLog.mc
new file mode 100644
index 0000000000..3a7c1fdd06
--- /dev/null
+++ b/ext/Sys/Syslog/win32/PerlLog.mc
@@ -0,0 +1,602 @@
+; // Sys::Syslog Message File 1.0.0
+
+MessageIdTypedef = DWORD
+
+SeverityNames = (
+ Success = 0x0:STATUS_SEVERITY_SUCCESS
+ Informational = 0x1:STATUS_SEVERITY_INFORMATIONAL
+ Warning = 0x2:STATUS_SEVERITY_WARNING
+ Error = 0x3:STATUS_SEVERITY_ERROR
+)
+
+LanguageNames = ( English = 0x0409:MSG00409 )
+LanguageNames = ( French = 0x040C:MSG0040C )
+
+
+; // =================================================================
+; // The following are facility name definitions
+
+MessageId = 0x0001
+SymbolicName = CAT_KERN
+Language = English
+Kernel
+.
+Language = French
+Kernel
+.
+
+MessageId = 0x0002
+SymbolicName = CAT_USER
+Language = English
+User
+.
+Language = French
+User
+.
+
+MessageId = 0x0003
+SymbolicName = CAT_MAIL
+Language = English
+Mail
+.
+Language = French
+Mail
+.
+
+MessageId = 0x0004
+SymbolicName = CAT_DAEMON
+Language = English
+Daemon
+.
+Language = French
+Daemon
+.
+
+MessageId = 0x0005
+SymbolicName = CAT_AUTH
+Language = English
+Auth
+.
+Language = French
+Auth
+.
+
+MessageId = 0x0006
+SymbolicName = CAT_SYSLOG
+Language = English
+Syslog
+.
+Language = French
+Syslog
+.
+
+MessageId = 0x0007
+SymbolicName = CAT_LPR
+Language = English
+LPR
+.
+Language = French
+LPR
+.
+
+MessageId = 0x0008
+SymbolicName = CAT_NEWS
+Language = English
+News
+.
+Language = French
+News
+.
+
+MessageId = 0x0009
+SymbolicName = CAT_UUCP
+Language = English
+UUCP
+.
+Language = French
+UUCP
+.
+
+MessageId = 0x000a
+SymbolicName = CAT_CRON
+Language = English
+Cron
+.
+Language = French
+Cron
+.
+
+MessageId = 0x000b
+SymbolicName = CAT_AUTHPRIV
+Language = English
+AuthPrivate
+.
+Language = French
+AuthPrivate
+.
+
+MessageId = 0x000c
+SymbolicName = CAT_FTP
+Language = English
+FTP
+.
+Language = French
+FTP
+.
+
+MessageId = 0x000d
+SymbolicName = CAT_LOCAL0
+Language = English
+Local0
+.
+Language = French
+Local0
+.
+
+MessageId = 0x000e
+SymbolicName = CAT_LOCAL1
+Language = English
+Local1
+.
+Language = French
+Local1
+.
+
+MessageId = 0x000f
+SymbolicName = CAT_LOCAL2
+Language = English
+Local2
+.
+Language = French
+Local2
+.
+
+MessageId = 0x0010
+SymbolicName = CAT_LOCAL3
+Language = English
+Local3
+.
+Language = French
+Local3
+.
+
+MessageId = 0x0011
+SymbolicName = CAT_LOCAL4
+Language = English
+Local4
+.
+Language = French
+Local4
+.
+
+MessageId = 0x0012
+SymbolicName = CAT_LOCAL5
+Language = English
+Local5
+.
+Language = French
+Local5
+.
+
+MessageId = 0x0013
+SymbolicName = CAT_LOCAL6
+Language = English
+Local6
+.
+Language = French
+Local6
+.
+
+MessageId = 0x0014
+SymbolicName = CAT_LOCAL7
+Language = English
+Local7
+.
+Language = French
+Local7
+.
+
+; // Mac OS X specific facilities ------------------------------------
+
+MessageId = 0x0015
+SymbolicName = CAT_NETINFO
+Language = English
+NetInfo
+.
+Language = French
+NetInfo
+.
+
+MessageId = 0x0016
+SymbolicName = CAT_REMOTEAUTH
+Language = English
+RemoteAuth
+.
+Language = French
+RemoteAuth
+.
+
+MessageId = 0x0017
+SymbolicName = CAT_RAS
+Language = English
+RAS
+.
+Language = French
+RAS
+.
+
+MessageId = 0x0018
+SymbolicName = CAT_INSTALL
+Language = English
+Install
+.
+Language = French
+Install
+.
+
+MessageId = 0x0019
+SymbolicName = CAT_LAUNCHD
+Language = English
+Launchd
+.
+Language = French
+Launchd
+.
+
+; //modern BSD specific facilities ----------------------------------
+
+MessageId = 0x001a
+SymbolicName = CAT_CONSOLE
+Language = English
+Console
+.
+Language = French
+Console
+.
+
+MessageId = 0x001b
+SymbolicName = CAT_NTP
+Language = English
+NTP
+.
+Language = French
+NTP
+.
+
+MessageId = 0x001c
+SymbolicName = CAT_SECURITY
+Language = English
+Security
+.
+Language = French
+Sécurité
+.
+
+; // IRIX specific facilities ----------------------------------------
+
+MessageId = 0x001d
+SymbolicName = CAT_AUDIT
+Language = English
+Audit
+.
+Language = French
+Audit
+.
+
+MessageId = 0x001e
+SymbolicName = CAT_LFMT
+Language = English
+LogAlert
+.
+Language = French
+LogAlert
+.
+
+
+; // =================================================================
+; // The following are message definitions.
+
+MessageId = 0x0080
+SymbolicName = MSG_KERNEL
+Language = English
+Kernel message: %1
+.
+Language = French
+Message du noyau : %1
+.
+
+
+MessageId = 0x0081
+SymbolicName = MSG_USER
+Language = English
+User message: %1
+.
+Language = French
+Message utilisateur : %1
+.
+
+
+MessageId = 0x0082
+SymbolicName = MSG_MAIL
+Language = English
+Mail subsystem message: %1
+.
+Language = French
+Message du sous-système de courrier : %1
+.
+
+
+MessageId = 0x0083
+SymbolicName = MSG_DAEMON
+Language = English
+Message from a system daemon without separate facility value: %1
+.
+Language = French
+Message d'un daemon sans catégorie spécifique : %1
+.
+
+
+MessageId = 0x0084
+SymbolicName = MSG_AUTH
+Language = English
+Security/authorization message: %1
+.
+Language = French
+Message de sécurite ou d'authorisation : %1
+.
+
+
+MessageId = 0x0085
+SymbolicName = MSG_SYSLOG
+Language = English
+Message generated internally by syslogd: %1
+.
+Language = French
+Message interne généré par le daemon syslogd : %1
+.
+
+
+MessageId = 0x0086
+SymbolicName = MSG_LPR
+Language = English
+Line printer subsystem message: %1
+.
+Language = French
+Message du sous-système d'impression : %1
+.
+
+
+MessageId = 0x0087
+SymbolicName = MSG_NEWS
+Language = English
+USENET news subsystem message: %1
+.
+Language = French
+Message du sous-système de nouvelles USENET : %1
+.
+
+
+MessageId = 0x0088
+SymbolicName = MSG_UUCP
+Language = English
+UUCP subsystem message: %1
+.
+Language = French
+Message du sous-système UUCP : %1
+.
+
+
+MessageId = 0x0089
+SymbolicName = MSG_CRON
+Language = English
+Message generated by the clock daemons (cron and at): %1
+.
+Language = French
+Message généré par les daemons d'exécution programmée (cron et at) : %1
+.
+
+
+MessageId = 0x008A
+SymbolicName = MSG_AUTHPRIV
+Language = English
+Security or authorization private message: %1
+.
+Language = French
+Message privé de sécurité ou d'authorisation : %1
+.
+
+
+MessageId = 0x008B
+SymbolicName = MSG_FTP
+Language = English
+FTP daemon message: %1
+.
+Language = French
+Message du daemon FTP : %1
+.
+
+
+MessageId = 0x008C
+SymbolicName = MSG_LOCAL0
+Language = English
+Local message on channel 0: %1
+.
+Language = French
+Message local sur le canal 0 : %1
+.
+
+
+MessageId = 0x008D
+SymbolicName = MSG_LOCAL1
+Language = English
+Local message on channel 1: %1
+.
+Language = French
+Message local sur le canal 1 : %1
+.
+
+
+MessageId = 0x008E
+SymbolicName = MSG_LOCAL2
+Language = English
+Local message on channel 2: %1
+.
+Language = French
+Message local sur le canal 2 : %1
+.
+
+
+MessageId = 0x008F
+SymbolicName = MSG_LOCAL3
+Language = English
+Local message on channel 3: %1
+.
+Language = French
+Message local sur le canal 3 : %1
+.
+
+
+MessageId = 0x0090
+SymbolicName = MSG_LOCAL4
+Language = English
+Local message on channel 4: %1
+.
+Language = French
+Message local sur le canal 4 : %1
+.
+
+
+MessageId = 0x0091
+SymbolicName = MSG_LOCAL5
+Language = English
+Local message on channel 5: %1
+.
+Language = French
+Message local sur le canal 5 : %1
+.
+
+
+MessageId = 0x0092
+SymbolicName = MSG_LOCAL6
+Language = English
+Local message on channel 6: %1
+.
+Language = French
+Message local sur le canal 6 : %1
+.
+
+
+MessageId = 0x0093
+SymbolicName = MSG_LOCAL7
+Language = English
+Local message on channel 7: %1
+.
+Language = French
+Message local sur le canal 7 : %1
+.
+
+
+; // Mac OS X specific facilities ------------------------------------
+
+MessageId = 0x0094
+SymbolicName = MSG_NETINFO
+Language = English
+NetInfo subsystem message: %1
+.
+Language = French
+Message du sous-système NetInfo : %1
+.
+
+
+MessageId = 0x0095
+SymbolicName = MSG_REMOTEAUTH
+Language = English
+Remote authentication or authorization message: %1
+.
+Language = French
+Message d'authentification ou d'authorisation distante : %1
+.
+
+
+MessageId = 0x0096
+SymbolicName = MSG_RAS
+Language = English
+Message generated by the Remote Access Service (VPN / PPP): %1
+.
+Language = French
+Message généré par le Service d'Accès Distant (Remote Access Service) (VPN / PPP) : %1
+.
+
+
+MessageId = 0x0097
+SymbolicName = MSG_INSTALL
+Language = English
+Installer subsystem message: %1
+.
+Language = French
+Message du sous-système d'installation : %1
+.
+
+
+MessageId = 0x0098
+SymbolicName = MSG_LAUNCHD
+Language = English
+Message generated by launchd, the general bootstrap daemon: %1
+.
+Language = French
+Message généré par launchd, le daemon générique de démarrage : %1
+.
+
+; //modern BSD specific facilities ----------------------------------
+
+MessageId = 0x0099
+SymbolicName = MSG_CONSOLE
+Language = English
+Message for the console: %1
+.
+Language = French
+Message pour la console : %1
+.
+
+
+MessageId = 0x009a
+SymbolicName = MSG_NTP
+Language = English
+NTP subsystem message: %1
+.
+Language = French
+Message du sous-système NTP : %1
+.
+
+
+MessageId = 0x009b
+SymbolicName = MSG_SECURITY
+Language = English
+Security subsystem message (firewalling, etc.): %1
+.
+Language = French
+Message du sous-système de sécurité (pare-feu, etc.) : %1
+.
+
+
+; // IRIX specific facilities ----------------------------------------
+
+MessageId = 0x009c
+SymbolicName = MSG_AUDIT
+Language = English
+Audit daemon message: %1
+.
+Language = French
+Message du daemon d'audit NTP : %1
+.
+
+
+MessageId = 0x009d
+SymbolicName = MSG_LFMT
+Language = English
+Logalert facility: %1
+.
+Language = French
+Message de logalert : %1
+.
+
diff --git a/ext/Sys/Syslog/win32/PerlLog_RES.uu b/ext/Sys/Syslog/win32/PerlLog_RES.uu
new file mode 100644
index 0000000000..036cecf5e9
--- /dev/null
+++ b/ext/Sys/Syslog/win32/PerlLog_RES.uu
@@ -0,0 +1,130 @@
+M`````"````#__P``__\```````````````````````"\"P``(````/__"P#_
+M_P$``````#``#`0```````````8````!````&0```$P```"`````B````(0"
+M``",````F````*`%``":"```F@@``'@*``"K"```JP@``!`+``"\"```O`@`
+M`'P+```8``$`2P!E`'(`;@!E`&P`#0`*```````4``$`50!S`&4`<@`-``H`
+M`````!0``0!-`&$`:0!L``T`"@``````&``!`$0`80!E`&T`;P!N``T`"@``
+M````%``!`$$`=0!T`&@`#0`*```````8``$`4P!Y`',`;`!O`&<`#0`*````
+M```0``$`3`!0`%(`#0`*````%``!`$X`90!W`',`#0`*```````4``$`50!5
+M`$,`4``-``H``````!0``0!#`'(`;P!N``T`"@``````(``!`$$`=0!T`&@`
+M4`!R`&D`=@!A`'0`90`-``H````0``$`1@!4`%``#0`*````&``!`$P`;P!C
+M`&$`;``P``T`"@``````&``!`$P`;P!C`&$`;``Q``T`"@``````&``!`$P`
+M;P!C`&$`;``R``T`"@``````&``!`$P`;P!C`&$`;``S``T`"@``````&``!
+M`$P`;P!C`&$`;``T``T`"@``````&``!`$P`;P!C`&$`;``U``T`"@``````
+M&``!`$P`;P!C`&$`;``V``T`"@``````&``!`$P`;P!C`&$`;``W``T`"@``
+M````&``!`$X`90!T`$D`;@!F`&\`#0`*````(``!`%(`90!M`&\`=`!E`$$`
+M=0!T`&@`#0`*```````0``$`4@!!`%,`#0`*````&``!`$D`;@!S`'0`80!L
+M`&P`#0`*````&``!`$P`80!U`&X`8P!H`&0`#0`*````-``!`$T`90!S`',`
+M80!G`&4`(`!D`'4`(`!N`&\`>0!A`'4`(``Z`"``)0`Q``T`"@```#P``0!-
+M`&4`<P!S`&$`9P!E`"``=0!T`&D`;`!I`',`80!T`&4`=0!R`"``.@`@`"4`
+M,0`-``H``````%P``0!-`&4`<P!S`&$`9P!E`"``9`!U`"``<P!O`'4`<P`M
+M`',`>0!S`'0`I@-M`&4`(`!D`&4`(`!C`&\`=0!R`'(`:0!E`'(`(``Z`"``
+M)0`Q``T`"@``````<``!`$T`90!S`',`80!G`&4`(`!D`"<`=0!N`"``9`!A
+M`&4`;0!O`&X`(`!S`&$`;@!S`"``8P!A`'0`F`-G`&\`<@!I`&4`(`!S`'``
+MF`-C`&D`9@!I`'$`=0!E`"``.@`@`"4`,0`-``H``````&```0!-`&4`<P!S
+M`&$`9P!E`"``9`!E`"``<P"8`V,`=0!R`&D`=`!E`"``;P!U`"``9``G`&$`
+M=0!T`&@`;P!R`&D`<P!A`'0`:0!O`&X`(``Z`"``)0`Q``T`"@```&P``0!-
+M`&4`<P!S`&$`9P!E`"``:0!N`'0`90!R`&X`90`@`&<`F`-N`)@#<@"8`R``
+M<`!A`'(`(`!L`&4`(`!D`&$`90!M`&\`;@`@`',`>0!S`&P`;P!G`&0`(``Z
+M`"``)0`Q``T`"@```%P``0!-`&4`<P!S`&$`9P!E`"``9`!U`"``<P!O`'4`
+M<P`M`',`>0!S`'0`I@-M`&4`(`!D`"<`:0!M`'``<@!E`',`<P!I`&\`;@`@
+M`#H`(``E`#$`#0`*````;``!`$T`90!S`',`80!G`&4`(`!D`'4`(`!S`&\`
+M=0!S`"T`<P!Y`',`=`"F`VT`90`@`&0`90`@`&X`;P!U`'8`90!L`&P`90!S
+M`"``50!3`$4`3@!%`%0`(``Z`"``)0`Q``T`"@``````3``!`$T`90!S`',`
+M80!G`&4`(`!D`'4`(`!S`&\`=0!S`"T`<P!Y`',`=`"F`VT`90`@`%4`50!#
+M`%``(``Z`"``)0`Q``T`"@```$P``0!-`&4`<P!S`&$`9P!E`"``;`!O`&,`
+M80!L`"``<P!U`'(`(`!L`&4`(`!C`&$`;@!A`&P`(``P`"``.@`@`"4`,0`-
+M``H```!,``$`30!E`',`<P!A`&<`90`@`&P`;P!C`&$`;``@`',`=0!R`"``
+M;`!E`"``8P!A`&X`80!L`"``,0`@`#H`(``E`#$`#0`*````3``!`$T`90!S
+M`',`80!G`&4`(`!L`&\`8P!A`&P`(`!S`'4`<@`@`&P`90`@`&,`80!N`&$`
+M;``@`#(`(``Z`"``)0`Q``T`"@```$P``0!-`&4`<P!S`&$`9P!E`"``;`!O
+M`&,`80!L`"``<P!U`'(`(`!L`&4`(`!C`&$`;@!A`&P`(``S`"``.@`@`"4`
+M,0`-``H```!,``$`30!E`',`<P!A`&<`90`@`&P`;P!C`&$`;``@`',`=0!R
+M`"``;`!E`"``8P!A`&X`80!L`"``-``@`#H`(``E`#$`#0`*````3``!`$T`
+M90!S`',`80!G`&4`(`!L`&\`8P!A`&P`(`!S`'4`<@`@`&P`90`@`&,`80!N
+M`&$`;``@`#4`(``Z`"``)0`Q``T`"@```$P``0!-`&4`<P!S`&$`9P!E`"``
+M;`!O`&,`80!L`"``<P!U`'(`(`!L`&4`(`!C`&$`;@!A`&P`(``V`"``.@`@
+M`"4`,0`-``H```!,``$`30!E`',`<P!A`&<`90`@`&P`;P!C`&$`;``@`',`
+M=0!R`"``;`!E`"``8P!A`&X`80!L`"``-P`@`#H`(``E`#$`#0`*````5``!
+M`$T`90!S`',`80!G`&4`(`!D`'4`(`!S`&\`=0!S`"T`<P!Y`',`=`"F`VT`
+M90`@`$X`90!T`$D`;@!F`&\`(``Z`"``)0`Q``T`"@``````@``!`$T`90!S
+M`',`80!G`&4`(`!D`"<`80!U`'0`:`!E`&X`=`!I`&8`:0!C`&$`=`!I`&\`
+M;@`@`&\`=0`@`&0`)P!A`'4`=`!H`&\`<@!I`',`80!T`&D`;P!N`"``9`!I
+M`',`=`!A`&X`=`!E`"``.@`@`"4`,0`-``H```"X``$`30!E`',`<P!A`&<`
+M90`@`&<`F`-N`)@#<@"8`R``<`!A`'(`(`!L`&4`(`!3`&4`<@!V`&D`8P!E
+M`"``9``G`$$`8P!C`*8#<P`@`$0`:0!S`'0`80!N`'0`(``H`%(`90!M`&\`
+M=`!E`"``00!C`&,`90!S`',`(`!3`&4`<@!V`&D`8P!E`"D`(``H`%8`4`!.
+M`"``+P`@`%``4`!0`"D`(``Z`"``)0`Q``T`"@``````8``!`$T`90!S`',`
+M80!G`&4`(`!D`'4`(`!S`&\`=0!S`"T`<P!Y`',`=`"F`VT`90`@`&0`)P!I
+M`&X`<P!T`&$`;`!L`&$`=`!I`&\`;@`@`#H`(``E`#$`#0`*````C``!`$T`
+M90!S`',`80!G`&4`(`!G`)@#;@"8`W(`F`,@`'``80!R`"``;`!A`'4`;@!C
+M`&@`9``L`"``;`!E`"``9`!A`&4`;0!O`&X`(`!G`)@#;@"8`W(`:0!Q`'4`
+M90`@`&0`90`@`&4`;0!A`'(`<@!A`&<`90`@`#H`(``E`#$`#0`*``````"8
+M``$`30!E`',`<P!A`&<`90`@`&<`F`-N`)@#<@"8`R``<`!A`'(`(`!L`&4`
+M<P`@`&0`80!E`&T`;P!N`',`(`!D`"<`90!X`)@#8P!U`'0`:0!O`&X`(`!P
+M`'(`;P!G`'(`80!M`&T`F`-E`"``*`!C`'(`;P!N`"``90!T`"``80!T`"D`
+M(``Z`"``)0`Q``T`"@```&P``0!-`&4`<P!S`&$`9P!E`"``<`!R`&D`=@"8
+M`R``9`!E`"``<P"8`V,`=0!R`&D`=`"8`R``;P!U`"``9``G`&$`=0!T`&@`
+M;P!R`&D`<P!A`'0`:0!O`&X`(``Z`"``)0`Q``T`"@```$```0!-`&4`<P!S
+M`&$`9P!E`"``9`!U`"``9`!A`&4`;0!O`&X`(`!&`%0`4``@`#H`(``E`#$`
+M#0`*``````"<"@``(````/__"P#__P$``````#``"00```````````8````!
+M````&0```$P```"`````B````(0"``",````F````#@%``":"```F@@``(0)
+M``"K"```JP@````*``"\"```O`@``&0*```8``$`2P!E`'(`;@!E`&P`#0`*
+M```````4``$`50!S`&4`<@`-``H``````!0``0!-`&$`:0!L``T`"@``````
+M&``!`$0`80!E`&T`;P!N``T`"@``````%``!`$$`=0!T`&@`#0`*```````8
+M``$`4P!Y`',`;`!O`&<`#0`*```````0``$`3`!0`%(`#0`*````%``!`$X`
+M90!W`',`#0`*```````4``$`50!5`$,`4``-``H``````!0``0!#`'(`;P!N
+M``T`"@``````(``!`$$`=0!T`&@`4`!R`&D`=@!A`'0`90`-``H````0``$`
+M1@!4`%``#0`*````&``!`$P`;P!C`&$`;``P``T`"@``````&``!`$P`;P!C
+M`&$`;``Q``T`"@``````&``!`$P`;P!C`&$`;``R``T`"@``````&``!`$P`
+M;P!C`&$`;``S``T`"@``````&``!`$P`;P!C`&$`;``T``T`"@``````&``!
+M`$P`;P!C`&$`;``U``T`"@``````&``!`$P`;P!C`&$`;``V``T`"@``````
+M&``!`$P`;P!C`&$`;``W``T`"@``````&``!`$X`90!T`$D`;@!F`&\`#0`*
+M````(``!`%(`90!M`&\`=`!E`$$`=0!T`&@`#0`*```````0``$`4@!!`%,`
+M#0`*````&``!`$D`;@!S`'0`80!L`&P`#0`*````&``!`$P`80!U`&X`8P!H
+M`&0`#0`*````,``!`$L`90!R`&X`90!L`"``;0!E`',`<P!A`&<`90`Z`"``
+M)0`Q``T`"@``````+``!`%4`<P!E`'(`(`!M`&4`<P!S`&$`9P!E`#H`(``E
+M`#$`#0`*``````!```$`30!A`&D`;``@`',`=0!B`',`>0!S`'0`90!M`"``
+M;0!E`',`<P!A`&<`90`Z`"``)0`Q``T`"@``````C``!`$T`90!S`',`80!G
+M`&4`(`!F`'(`;P!M`"``80`@`',`>0!S`'0`90!M`"``9`!A`&4`;0!O`&X`
+M(`!W`&D`=`!H`&\`=0!T`"``<P!E`'``80!R`&$`=`!E`"``9@!A`&,`:0!L
+M`&D`=`!Y`"``=@!A`&P`=0!E`#H`(``E`#$`#0`*``````!0``$`4P!E`&,`
+M=0!R`&D`=`!Y`"\`80!U`'0`:`!O`'(`:0!Z`&$`=`!I`&\`;@`@`&T`90!S
+M`',`80!G`&4`.@`@`"4`,0`-``H``````&```0!-`&4`<P!S`&$`9P!E`"``
+M9P!E`&X`90!R`&$`=`!E`&0`(`!I`&X`=`!E`'(`;@!A`&P`;`!Y`"``8@!Y
+M`"``<P!Y`',`;`!O`&<`9``Z`"``)0`Q``T`"@```%```0!,`&D`;@!E`"``
+M<`!R`&D`;@!T`&4`<@`@`',`=0!B`',`>0!S`'0`90!M`"``;0!E`',`<P!A
+M`&<`90`Z`"``)0`Q``T`"@``````3``!`%4`4P!%`$X`10!4`"``;@!E`'<`
+M<P`@`',`=0!B`',`>0!S`'0`90!M`"``;0!E`',`<P!A`&<`90`Z`"``)0`Q
+M``T`"@```$```0!5`%4`0P!0`"``<P!U`&(`<P!Y`',`=`!E`&T`(`!M`&4`
+M<P!S`&$`9P!E`#H`(``E`#$`#0`*``````!(``$`3`!O`&,`80!L`"``;0!E
+M`',`<P!A`&<`90`@`&\`;@`@`&,`:`!A`&X`;@!E`&P`(``P`#H`(``E`#$`
+M#0`*``````!(``$`3`!O`&,`80!L`"``;0!E`',`<P!A`&<`90`@`&\`;@`@
+M`&,`:`!A`&X`;@!E`&P`(``Q`#H`(``E`#$`#0`*``````!(``$`3`!O`&,`
+M80!L`"``;0!E`',`<P!A`&<`90`@`&\`;@`@`&,`:`!A`&X`;@!E`&P`(``R
+M`#H`(``E`#$`#0`*``````!(``$`3`!O`&,`80!L`"``;0!E`',`<P!A`&<`
+M90`@`&\`;@`@`&,`:`!A`&X`;@!E`&P`(``S`#H`(``E`#$`#0`*``````!(
+M``$`3`!O`&,`80!L`"``;0!E`',`<P!A`&<`90`@`&\`;@`@`&,`:`!A`&X`
+M;@!E`&P`(``T`#H`(``E`#$`#0`*``````!(``$`3`!O`&,`80!L`"``;0!E
+M`',`<P!A`&<`90`@`&\`;@`@`&,`:`!A`&X`;@!E`&P`(``U`#H`(``E`#$`
+M#0`*``````!(``$`3`!O`&,`80!L`"``;0!E`',`<P!A`&<`90`@`&\`;@`@
+M`&,`:`!A`&X`;@!E`&P`(``V`#H`(``E`#$`#0`*``````!(``$`3`!O`&,`
+M80!L`"``;0!E`',`<P!A`&<`90`@`&\`;@`@`&,`:`!A`&X`;@!E`&P`(``W
+M`#H`(``E`#$`#0`*``````!$``$`3@!E`'0`20!N`&8`;P`@`',`=0!B`',`
+M>0!S`'0`90!M`"``;0!E`',`<P!A`&<`90`Z`"``)0`Q``T`"@```'```0!2
+M`&4`;0!O`'0`90`@`&$`=0!T`&@`90!N`'0`:0!C`&$`=`!I`&\`;@`@`&\`
+M<@`@`&$`=0!T`&@`;P!R`&D`>@!A`'0`:0!O`&X`(`!M`&4`<P!S`&$`9P!E
+M`#H`(``E`#$`#0`*``````"(``$`30!E`',`<P!A`&<`90`@`&<`90!N`&4`
+M<@!A`'0`90!D`"``8@!Y`"``=`!H`&4`(`!2`&4`;0!O`'0`90`@`$$`8P!C
+M`&4`<P!S`"``4P!E`'(`=@!I`&,`90`@`"@`5@!0`$X`(``O`"``4`!0`%``
+M*0`Z`"``)0`Q``T`"@``````2``!`$D`;@!S`'0`80!L`&P`90!R`"``<P!U
+M`&(`<P!Y`',`=`!E`&T`(`!M`&4`<P!S`&$`9P!E`#H`(``E`#$`#0`*````
+MB``!`$T`90!S`',`80!G`&4`(`!G`&4`;@!E`'(`80!T`&4`9``@`&(`>0`@
+M`&P`80!U`&X`8P!H`&0`+``@`'0`:`!E`"``9P!E`&X`90!R`&$`;``@`&(`
+M;P!O`'0`<P!T`'(`80!P`"``9`!A`&4`;0!O`&X`.@`@`"4`,0`-``H`````
+M`'P``0!-`&4`<P!S`&$`9P!E`"``9P!E`&X`90!R`&$`=`!E`&0`(`!B`'D`
+M(`!T`&@`90`@`&,`;`!O`&,`:P`@`&0`80!E`&T`;P!N`',`(``H`&,`<@!O
+M`&X`(`!A`&X`9``@`&$`=``I`#H`(``E`#$`#0`*``````!D``$`4P!E`&,`
+M=0!R`&D`=`!Y`"``;P!R`"``80!U`'0`:`!O`'(`:0!Z`&$`=`!I`&\`;@`@
+M`'``<@!I`'8`80!T`&4`(`!M`&4`<P!S`&$`9P!E`#H`(``E`#$`#0`*````
+M.``!`$8`5`!0`"``9`!A`&4`;0!O`&X`(`!M`&4`<P!S`&$`9P!E`#H`(``E
++`#$`#0`*````````
diff --git a/ext/Sys/Syslog/win32/PerlLog_dll.uu b/ext/Sys/Syslog/win32/PerlLog_dll.uu
new file mode 100644
index 0000000000..2661a9c173
--- /dev/null
+++ b/ext/Sys/Syslog/win32/PerlLog_dll.uu
@@ -0,0 +1,171 @@
+M35J0``,````$````__\``+@`````````0```````````````````````````
+M````````````````````L`````X?N@X`M`G-(;@!3,TA5&AI<R!P<F]G<F%M
+M(&-A;FYO="!B92!R=6X@:6X@1$]3(&UO9&4N#0T*)`````````"?JCW:V\M3
+MB=O+4XG;RU.)(>\6B=K+4XDX[6Z)VLM3B5)I8VC;RU.)``````````!010``
+M3`$"`!LK3D4``````````.``#B$+`0<````````<```````````````0````
+M$```````8``0`````@``!``````````$``````````!``````@``IAX```(`
+M`````!```!``````$```$````````!```````````````````````````!``
+M`+`8`````````````````````````#````@`````````````````````````
+M````````````````````````````````````````````````````````````
+M`````````````````````````"YR<W)C````L!@````0````&@````(`````
+M`````````````$```$`N<F5L;V,```@`````,`````(````<````````````
+M``````!```!"``````````````````````````````$`"P```!@``(``````
+M``````````````$``0```#```(````````````````````(`"00``%`````,
+M!```8````"`=``","P````````````!P$```K`P`````````````&@````$`
+M```9````/`$``(```0"```$`=`,``($``@"!``(`J`,``((``P""``,`Y`,`
+M`(,`!`"#``0`0`0``(0`!0"$``4`L`0``(4`!@"%``8`$`4``(8`!P"&``<`
+M?`4``(<`"`"'``@`V`4``(@`"0"(``D`1`8``)H("@":"`H`D`8``*L("P"K
+M"`L`*`<``+P(#`"\"`P`E`<``(P`$`",`!``U`<``(T`$0"-`!$`(`@``(X`
+M$@".`!(`;`@``(\`$P"/`!,`N`@``)``%`"0`!0`!`D``)$`%0"1`!4`4`D`
+M`)(`%@"2`!8`G`D``),`%P"3`!<`Z`D``)0`(`"4`"``-`H``)4`(0"5`"$`
+MB`H``)8`(@"6`"(`"`L``)<`(P"7`",`P`L``)@`)`"8`"0`(`P``!@``0!+
+M`&4`<@!N`&4`;``-``H``````!0``0!5`',`90!R``T`"@``````%``!`$T`
+M80!I`&P`#0`*```````8``$`1`!A`&4`;0!O`&X`#0`*```````4``$`00!U
+M`'0`:``-``H``````!@``0!3`'D`<P!L`&\`9P`-``H``````!```0!,`%``
+M4@`-``H````4``$`3@!E`'<`<P`-``H``````!0``0!5`%4`0P!0``T`"@``
+M````%``!`$,`<@!O`&X`#0`*```````@``$`00!U`'0`:`!0`'(`:0!V`&$`
+M=`!E``T`"@```!```0!&`%0`4``-``H````8``$`3`!O`&,`80!L`#``#0`*
+M```````8``$`3`!O`&,`80!L`#$`#0`*```````8``$`3`!O`&,`80!L`#(`
+M#0`*```````8``$`3`!O`&,`80!L`#,`#0`*```````8``$`3`!O`&,`80!L
+M`#0`#0`*```````8``$`3`!O`&,`80!L`#4`#0`*```````8``$`3`!O`&,`
+M80!L`#8`#0`*```````8``$`3`!O`&,`80!L`#<`#0`*```````8``$`3@!E
+M`'0`20!N`&8`;P`-``H````@``$`4@!E`&T`;P!T`&4`00!U`'0`:``-``H`
+M`````!```0!2`$$`4P`-``H````8``$`20!N`',`=`!A`&P`;``-``H````8
+M``$`3`!A`'4`;@!C`&@`9``-``H````T``$`30!E`',`<P!A`&<`90`@`&0`
+M=0`@`&X`;P!Y`&$`=0`@`#H`(``E`#$`#0`*````/``!`$T`90!S`',`80!G
+M`&4`(`!U`'0`:0!L`&D`<P!A`'0`90!U`'(`(``Z`"``)0`Q``T`"@``````
+M7``!`$T`90!S`',`80!G`&4`(`!D`'4`(`!S`&\`=0!S`"T`<P!Y`',`=`"F
+M`VT`90`@`&0`90`@`&,`;P!U`'(`<@!I`&4`<@`@`#H`(``E`#$`#0`*````
+M``!P``$`30!E`',`<P!A`&<`90`@`&0`)P!U`&X`(`!D`&$`90!M`&\`;@`@
+M`',`80!N`',`(`!C`&$`=`"8`V<`;P!R`&D`90`@`',`<`"8`V,`:0!F`&D`
+M<0!U`&4`(``Z`"``)0`Q``T`"@``````8``!`$T`90!S`',`80!G`&4`(`!D
+M`&4`(`!S`)@#8P!U`'(`:0!T`&4`(`!O`'4`(`!D`"<`80!U`'0`:`!O`'(`
+M:0!S`&$`=`!I`&\`;@`@`#H`(``E`#$`#0`*````;``!`$T`90!S`',`80!G
+M`&4`(`!I`&X`=`!E`'(`;@!E`"``9P"8`VX`F`-R`)@#(`!P`&$`<@`@`&P`
+M90`@`&0`80!E`&T`;P!N`"``<P!Y`',`;`!O`&<`9``@`#H`(``E`#$`#0`*
+M````7``!`$T`90!S`',`80!G`&4`(`!D`'4`(`!S`&\`=0!S`"T`<P!Y`',`
+M=`"F`VT`90`@`&0`)P!I`&T`<`!R`&4`<P!S`&D`;P!N`"``.@`@`"4`,0`-
+M``H```!L``$`30!E`',`<P!A`&<`90`@`&0`=0`@`',`;P!U`',`+0!S`'D`
+M<P!T`*8#;0!E`"``9`!E`"``;@!O`'4`=@!E`&P`;`!E`',`(`!5`%,`10!.
+M`$4`5``@`#H`(``E`#$`#0`*``````!,``$`30!E`',`<P!A`&<`90`@`&0`
+M=0`@`',`;P!U`',`+0!S`'D`<P!T`*8#;0!E`"``50!5`$,`4``@`#H`(``E
+M`#$`#0`*````F``!`$T`90!S`',`80!G`&4`(`!G`)@#;@"8`W(`F`,@`'``
+M80!R`"``;`!E`',`(`!D`&$`90!M`&\`;@!S`"``9``G`&4`>`"8`V,`=0!T
+M`&D`;P!N`"``<`!R`&\`9P!R`&$`;0!M`)@#90`@`"@`8P!R`&\`;@`@`&4`
+M=``@`&$`=``I`"``.@`@`"4`,0`-``H```!L``$`30!E`',`<P!A`&<`90`@
+M`'``<@!I`'8`F`,@`&0`90`@`',`F`-C`'4`<@!I`'0`F`,@`&\`=0`@`&0`
+M)P!A`'4`=`!H`&\`<@!I`',`80!T`&D`;P!N`"``.@`@`"4`,0`-``H```!`
+M``$`30!E`',`<P!A`&<`90`@`&0`=0`@`&0`80!E`&T`;P!N`"``1@!4`%``
+M(``Z`"``)0`Q``T`"@``````3``!`$T`90!S`',`80!G`&4`(`!L`&\`8P!A
+M`&P`(`!S`'4`<@`@`&P`90`@`&,`80!N`&$`;``@`#``(``Z`"``)0`Q``T`
+M"@```$P``0!-`&4`<P!S`&$`9P!E`"``;`!O`&,`80!L`"``<P!U`'(`(`!L
+M`&4`(`!C`&$`;@!A`&P`(``Q`"``.@`@`"4`,0`-``H```!,``$`30!E`',`
+M<P!A`&<`90`@`&P`;P!C`&$`;``@`',`=0!R`"``;`!E`"``8P!A`&X`80!L
+M`"``,@`@`#H`(``E`#$`#0`*````3``!`$T`90!S`',`80!G`&4`(`!L`&\`
+M8P!A`&P`(`!S`'4`<@`@`&P`90`@`&,`80!N`&$`;``@`#,`(``Z`"``)0`Q
+M``T`"@```$P``0!-`&4`<P!S`&$`9P!E`"``;`!O`&,`80!L`"``<P!U`'(`
+M(`!L`&4`(`!C`&$`;@!A`&P`(``T`"``.@`@`"4`,0`-``H```!,``$`30!E
+M`',`<P!A`&<`90`@`&P`;P!C`&$`;``@`',`=0!R`"``;`!E`"``8P!A`&X`
+M80!L`"``-0`@`#H`(``E`#$`#0`*````3``!`$T`90!S`',`80!G`&4`(`!L
+M`&\`8P!A`&P`(`!S`'4`<@`@`&P`90`@`&,`80!N`&$`;``@`#8`(``Z`"``
+M)0`Q``T`"@```$P``0!-`&4`<P!S`&$`9P!E`"``;`!O`&,`80!L`"``<P!U
+M`'(`(`!L`&4`(`!C`&$`;@!A`&P`(``W`"``.@`@`"4`,0`-``H```!4``$`
+M30!E`',`<P!A`&<`90`@`&0`=0`@`',`;P!U`',`+0!S`'D`<P!T`*8#;0!E
+M`"``3@!E`'0`20!N`&8`;P`@`#H`(``E`#$`#0`*``````"```$`30!E`',`
+M<P!A`&<`90`@`&0`)P!A`'4`=`!H`&4`;@!T`&D`9@!I`&,`80!T`&D`;P!N
+M`"``;P!U`"``9``G`&$`=0!T`&@`;P!R`&D`<P!A`'0`:0!O`&X`(`!D`&D`
+M<P!T`&$`;@!T`&4`(``Z`"``)0`Q``T`"@```+@``0!-`&4`<P!S`&$`9P!E
+M`"``9P"8`VX`F`-R`)@#(`!P`&$`<@`@`&P`90`@`%,`90!R`'8`:0!C`&4`
+M(`!D`"<`00!C`&,`I@-S`"``1`!I`',`=`!A`&X`=``@`"@`4@!E`&T`;P!T
+M`&4`(`!!`&,`8P!E`',`<P`@`%,`90!R`'8`:0!C`&4`*0`@`"@`5@!0`$X`
+M(``O`"``4`!0`%``*0`@`#H`(``E`#$`#0`*``````!@``$`30!E`',`<P!A
+M`&<`90`@`&0`=0`@`',`;P!U`',`+0!S`'D`<P!T`*8#;0!E`"``9``G`&D`
+M;@!S`'0`80!L`&P`80!T`&D`;P!N`"``.@`@`"4`,0`-``H```",``$`30!E
+M`',`<P!A`&<`90`@`&<`F`-N`)@#<@"8`R``<`!A`'(`(`!L`&$`=0!N`&,`
+M:`!D`"P`(`!L`&4`(`!D`&$`90!M`&\`;@`@`&<`F`-N`)@#<@!I`'$`=0!E
+M`"``9`!E`"``90!M`&$`<@!R`&$`9P!E`"``.@`@`"4`,0`-``H`````````
+M```:`````0```!D````\`0``@``!`(```0!T`P``@0`"`($``@"D`P``@@`#
+M`((``P#0`P``@P`$`(,`!``0!```A``%`(0`!0"<!```A0`&`(4`!@#L!```
+MA@`'`(8`!P!,!0``AP`(`(<`"`"<!0``B``)`(@`"0#H!0``F@@*`)H("@`H
+M!@``JP@+`*L("P"D!@``O`@,`+P(#``(!P``C``0`(P`$`!`!P``C0`1`(T`
+M$0"(!P``C@`2`(X`$@#0!P``CP`3`(\`$P`8"```D``4`)``%`!@"```D0`5
+M`)$`%0"H"```D@`6`)(`%@#P"```DP`7`),`%P`X"0``E``@`)0`(`"`"0``
+ME0`A`)4`(0#$"0``E@`B`)8`(@`T"@``EP`C`)<`(P"\"@``F``D`)@`)``$
+M"P``&``!`$L`90!R`&X`90!L``T`"@``````%``!`%4`<P!E`'(`#0`*````
+M```4``$`30!A`&D`;``-``H``````!@``0!$`&$`90!M`&\`;@`-``H`````
+M`!0``0!!`'4`=`!H``T`"@``````&``!`%,`>0!S`&P`;P!G``T`"@``````
+M$``!`$P`4`!2``T`"@```!0``0!.`&4`=P!S``T`"@``````%``!`%4`50!#
+M`%``#0`*```````4``$`0P!R`&\`;@`-``H``````"```0!!`'4`=`!H`%``
+M<@!I`'8`80!T`&4`#0`*````$``!`$8`5`!0``T`"@```!@``0!,`&\`8P!A
+M`&P`,``-``H``````!@``0!,`&\`8P!A`&P`,0`-``H``````!@``0!,`&\`
+M8P!A`&P`,@`-``H``````!@``0!,`&\`8P!A`&P`,P`-``H``````!@``0!,
+M`&\`8P!A`&P`-``-``H``````!@``0!,`&\`8P!A`&P`-0`-``H``````!@`
+M`0!,`&\`8P!A`&P`-@`-``H``````!@``0!,`&\`8P!A`&P`-P`-``H`````
+M`!@``0!.`&4`=`!)`&X`9@!O``T`"@```"```0!2`&4`;0!O`'0`90!!`'4`
+M=`!H``T`"@``````$``!`%(`00!3``T`"@```!@``0!)`&X`<P!T`&$`;`!L
+M``T`"@```!@``0!,`&$`=0!N`&,`:`!D``T`"@```#```0!+`&4`<@!N`&4`
+M;``@`&T`90!S`',`80!G`&4`.@`@`"4`,0`-``H``````"P``0!5`',`90!R
+M`"``;0!E`',`<P!A`&<`90`Z`"``)0`Q``T`"@``````0``!`$T`80!I`&P`
+M(`!S`'4`8@!S`'D`<P!T`&4`;0`@`&T`90!S`',`80!G`&4`.@`@`"4`,0`-
+M``H``````(P``0!-`&4`<P!S`&$`9P!E`"``9@!R`&\`;0`@`&$`(`!S`'D`
+M<P!T`&4`;0`@`&0`80!E`&T`;P!N`"``=P!I`'0`:`!O`'4`=``@`',`90!P
+M`&$`<@!A`'0`90`@`&8`80!C`&D`;`!I`'0`>0`@`'8`80!L`'4`90`Z`"``
+M)0`Q``T`"@``````4``!`%,`90!C`'4`<@!I`'0`>0`O`&$`=0!T`&@`;P!R
+M`&D`>@!A`'0`:0!O`&X`(`!M`&4`<P!S`&$`9P!E`#H`(``E`#$`#0`*````
+M``!@``$`30!E`',`<P!A`&<`90`@`&<`90!N`&4`<@!A`'0`90!D`"``:0!N
+M`'0`90!R`&X`80!L`&P`>0`@`&(`>0`@`',`>0!S`&P`;P!G`&0`.@`@`"4`
+M,0`-``H```!0``$`3`!I`&X`90`@`'``<@!I`&X`=`!E`'(`(`!S`'4`8@!S
+M`'D`<P!T`&4`;0`@`&T`90!S`',`80!G`&4`.@`@`"4`,0`-``H``````$P`
+M`0!5`%,`10!.`$4`5``@`&X`90!W`',`(`!S`'4`8@!S`'D`<P!T`&4`;0`@
+M`&T`90!S`',`80!G`&4`.@`@`"4`,0`-``H```!```$`50!5`$,`4``@`',`
+M=0!B`',`>0!S`'0`90!M`"``;0!E`',`<P!A`&<`90`Z`"``)0`Q``T`"@``
+M````?``!`$T`90!S`',`80!G`&4`(`!G`&4`;@!E`'(`80!T`&4`9``@`&(`
+M>0`@`'0`:`!E`"``8P!L`&\`8P!K`"``9`!A`&4`;0!O`&X`<P`@`"@`8P!R
+M`&\`;@`@`&$`;@!D`"``80!T`"D`.@`@`"4`,0`-``H``````&0``0!3`&4`
+M8P!U`'(`:0!T`'D`(`!O`'(`(`!A`'4`=`!H`&\`<@!I`'H`80!T`&D`;P!N
+M`"``<`!R`&D`=@!A`'0`90`@`&T`90!S`',`80!G`&4`.@`@`"4`,0`-``H`
+M```X``$`1@!4`%``(`!D`&$`90!M`&\`;@`@`&T`90!S`',`80!G`&4`.@`@
+M`"4`,0`-``H``````$@``0!,`&\`8P!A`&P`(`!M`&4`<P!S`&$`9P!E`"``
+M;P!N`"``8P!H`&$`;@!N`&4`;``@`#``.@`@`"4`,0`-``H``````$@``0!,
+M`&\`8P!A`&P`(`!M`&4`<P!S`&$`9P!E`"``;P!N`"``8P!H`&$`;@!N`&4`
+M;``@`#$`.@`@`"4`,0`-``H``````$@``0!,`&\`8P!A`&P`(`!M`&4`<P!S
+M`&$`9P!E`"``;P!N`"``8P!H`&$`;@!N`&4`;``@`#(`.@`@`"4`,0`-``H`
+M`````$@``0!,`&\`8P!A`&P`(`!M`&4`<P!S`&$`9P!E`"``;P!N`"``8P!H
+M`&$`;@!N`&4`;``@`#,`.@`@`"4`,0`-``H``````$@``0!,`&\`8P!A`&P`
+M(`!M`&4`<P!S`&$`9P!E`"``;P!N`"``8P!H`&$`;@!N`&4`;``@`#0`.@`@
+M`"4`,0`-``H``````$@``0!,`&\`8P!A`&P`(`!M`&4`<P!S`&$`9P!E`"``
+M;P!N`"``8P!H`&$`;@!N`&4`;``@`#4`.@`@`"4`,0`-``H``````$@``0!,
+M`&\`8P!A`&P`(`!M`&4`<P!S`&$`9P!E`"``;P!N`"``8P!H`&$`;@!N`&4`
+M;``@`#8`.@`@`"4`,0`-``H``````$@``0!,`&\`8P!A`&P`(`!M`&4`<P!S
+M`&$`9P!E`"``;P!N`"``8P!H`&$`;@!N`&4`;``@`#<`.@`@`"4`,0`-``H`
+M`````$0``0!.`&4`=`!)`&X`9@!O`"``<P!U`&(`<P!Y`',`=`!E`&T`(`!M
+M`&4`<P!S`&$`9P!E`#H`(``E`#$`#0`*````<``!`%(`90!M`&\`=`!E`"``
+M80!U`'0`:`!E`&X`=`!I`&,`80!T`&D`;P!N`"``;P!R`"``80!U`'0`:`!O
+M`'(`:0!Z`&$`=`!I`&\`;@`@`&T`90!S`',`80!G`&4`.@`@`"4`,0`-``H`
+M`````(@``0!-`&4`<P!S`&$`9P!E`"``9P!E`&X`90!R`&$`=`!E`&0`(`!B
+M`'D`(`!T`&@`90`@`%(`90!M`&\`=`!E`"``00!C`&,`90!S`',`(`!3`&4`
+M<@!V`&D`8P!E`"``*`!6`%``3@`@`"\`(`!0`%``4``I`#H`(``E`#$`#0`*
+M``````!(``$`20!N`',`=`!A`&P`;`!E`'(`(`!S`'4`8@!S`'D`<P!T`&4`
+M;0`@`&T`90!S`',`80!G`&4`.@`@`"4`,0`-``H```"(``$`30!E`',`<P!A
+M`&<`90`@`&<`90!N`&4`<@!A`'0`90!D`"``8@!Y`"``;`!A`'4`;@!C`&@`
+M9``L`"``=`!H`&4`(`!G`&4`;@!E`'(`80!L`"``8@!O`&\`=`!S`'0`<@!A
+M`'``(`!D`&$`90!M`&\`;@`Z`"``)0`Q``T`"@``````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M```````````````````````(````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+M````````````````````````````````````````````````````````````
+>````````````````````````````````````````
diff --git a/ext/Sys/Syslog/win32/Win32.pm b/ext/Sys/Syslog/win32/Win32.pm
new file mode 100644
index 0000000000..70caf33143
--- /dev/null
+++ b/ext/Sys/Syslog/win32/Win32.pm
@@ -0,0 +1,283 @@
+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<Sys::Syslog>, for supporting the Win32
+event log. It is not expected to be directly used by any module other than
+C<Sys::Syslog> 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<Sys::Syslog>
+
+=head1 AUTHORS
+
+SE<eacute>bastien 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;
diff --git a/ext/Sys/Syslog/win32/compile.pl b/ext/Sys/Syslog/win32/compile.pl
new file mode 100644
index 0000000000..8502309bc7
--- /dev/null
+++ b/ext/Sys/Syslog/win32/compile.pl
@@ -0,0 +1,277 @@
+#!perl
+use strict;
+use warnings;
+use File::Basename;
+use File::Copy;
+use File::Path;
+
+my $name = shift || 'PerlLog';
+
+# get the version from the message file
+open(my $msgfh, '<', "$name.mc") or die "fatal: Can't read file '$name.mc': $!\n";
+my $top = <$msgfh>;
+close($msgfh);
+
+my ($version) = $top =~ /Sys::Syslog Message File (\d+\.\d+\.\d+)/
+ or die "error: File '$name.mc' doesn't have a version number\n";
+
+# compile the message text files
+system("mc -d $name.mc");
+system("rc $name.rc");
+system(qq{ link -nodefaultlib -incremental:no -release /nologo -base:0x60000000 }
+ .qq{ -comment:"Perl Syslog Message File v$version" }
+ .qq{ -machine:i386 -dll -noentry -out:$name.dll $name.res });
+
+# uuencode the resource file
+open(my $rsrc, '<', "$name.RES") or die "fatal: Can't read resource file '$name.RES': $!";
+binmode($rsrc);
+my $uudata = pack "u", do { local $/; <$rsrc> };
+close($rsrc);
+
+open(my $uufh, '>', "$name\_RES.uu") or die "fatal: Can't write file '$name\_RES.uu': $!";
+print $uufh $uudata;
+close($uufh);
+
+# uuencode the DLL
+open(my $dll, '<', "$name.dll") or die "fatal: Can't read DLL '$name.dll': $!";
+binmode($dll);
+$uudata = pack "u", do { local $/; <$dll> };
+close($dll);
+
+open($uufh, '>', "$name\_dll.uu") or die "fatal: Can't write file '$name\_dll.uu': $!";
+print $uufh $uudata;
+close($uufh);
+
+# parse the generated header to extract the constants
+open(my $header, '<', "$name.h") or die "fatal: Can't read header file '$name.h': $!";
+my %vals;
+my $max = 0;
+
+while (<$header>) {
+ if (/^#define\s+(\w+)\s+(\d+)$/ || /^#define\s+(\w+)\s+\(\(DWORD\)(\d+)L\)/) {
+ $vals{$1} = $2;
+ if (substr($1, 0, 1) eq 'C') {
+ $max = $2 if $max < $2;
+ }
+ }
+}
+
+close($header);
+
+my ($hash, $f2c, %fac);
+
+for my $name (sort { substr($a,0,1) cmp substr($b,0,1) || $vals{$a} <=> $vals{$b} } keys %vals) {
+ $hash .= " $name => $vals{$name},\n" ;
+ if ($name =~ /^CAT_(\w+)$/) {
+ $fac{$1} = $vals{$name};
+ }
+}
+
+for my $name (sort {$fac{$a} <=> $fac{$b}} keys %fac) {
+ $f2c .= " Sys::Syslog::LOG_$name() => '$name',\n";
+}
+
+# write the Sys::Syslog::Win32 module
+open my $out, '>', "Win32.pm" or die "fatal: Can't write Win32.pm: $!";
+my $template = join '', <DATA>;
+$template =~ s/__CONSTANT__/$hash/;
+$template =~ s/__F2C__/$f2c/;
+$template =~ s/__NAME_VER__/$name/;
+$template =~ s/__VER__/$version/;
+$max = sprintf "0x%08x", $max;
+$template =~ s/__MAX__/'$max'/g;
+$template =~ s/__TIME__/localtime()/ge;
+print $out $template;
+close $out;
+print "Updated Win32.pm and relevent message files\n";
+
+__END__
+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 __TIME__
+# 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 = (
+__CONSTANT__
+);
+
+my %id2name = (
+__F2C__
+);
+
+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:__VER__]";
+
+ #$Registry->Delimiter("/"); # is this needed?
+ my $root = 'LMachine/SYSTEM/CurrentControlSet/Services/Eventlog/Application/';
+ my $dll = 'Sys/Syslog/__NAME_VER__.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' => [ __MAX__, REG_DWORD ],
+ #'/TypesSupported' => [ __MAX__, 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<Sys::Syslog>, for supporting the Win32
+event log. It is not expected to be directly used by any module other than
+C<Sys::Syslog> 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<Sys::Syslog>
+
+=head1 AUTHORS
+
+SE<eacute>bastien 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;
View Lorry Controller Status