Sys-Syslog-0.27 diff -urN perl-5.10.0.orig/MANIFEST perl-5.10.0/MANIFEST --- perl-5.10.0.orig/MANIFEST 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/MANIFEST 2009-02-10 11:14:14.000000000 +0100 @@ -1081,6 +1081,7 @@ ext/Sys/Syslog/Changes Changlog for Sys::Syslog ext/Sys/Syslog/fallback/const-c.inc Sys::Syslog constants fallback file ext/Sys/Syslog/fallback/const-xs.inc Sys::Syslog constants fallback file +ext/Sys/Syslog/fallback/syslog.h Sys::Syslog fallback file ext/Sys/Syslog/Makefile.PL Sys::Syslog extension makefile writer ext/Sys/Syslog/README README for Sys::Syslog ext/Sys/Syslog/README.win32 README for Sys::Syslog on Windows @@ -1088,6 +1089,7 @@ ext/Sys/Syslog/Syslog.xs Sys::Syslog extension external subroutines ext/Sys/Syslog/t/00-load.t test for Sys::Syslog ext/Sys/Syslog/t/constants.t test for Sys::Syslog +ext/Sys/Syslog/t/data-validation.t test for Sys::Syslog ext/Sys/Syslog/t/syslog.t See if Sys::Syslog works ext/Sys/Syslog/win32/compile.pl Sys::Syslog extension Win32 related file ext/Sys/Syslog/win32/PerlLog_dll.uu Sys::Syslog extension Win32 related file diff -urN perl-5.10.0.orig/ext/Sys/Syslog/Changes perl-5.10.0/ext/Sys/Syslog/Changes --- perl-5.10.0.orig/ext/Sys/Syslog/Changes 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/Changes 2009-02-10 11:10:19.000000000 +0100 @@ -1,5 +1,41 @@ Revision history for Sys-Syslog +0.27 -- 2008.09.21 -- Sebastien Aperghis-Tramoni (SAPER) + [BUGFIX] Fixed compilation on Win32, thanks to Serguei Trouchelle. + Also added stubs so calling the XS functions will never fail. + [TESTS] t/pod.t now also uses Pod::Checker. + +0.26 -- 2008.06.16 -- Sebastien Aperghis-Tramoni (SAPER) + [BUGFIX] Make Sys::Syslog works with Perl 5.10.0 (because of + ExtUtils::Constant::ProxySubs). + [CODE] setlogsock() is now a little more strict about its arguments. + +0.25 -- 2008.05.17 -- Sebastien Aperghis-Tramoni (SAPER) + [BUGFIX] CPAN-RT#34691: Fixed an incorrect call to sysopen() which + prevented Sys::Syslog from working on some Solaris systems. + Thanks to Paul Townsend. + [BUGFIX] CPAN-RT#34753: Fixed a slowness introduced in v0.19 (which + was to work around OSX syslog own slowness). Thanks to Alex Efros. + [BUGFIX] CPAN-RT#35952: Fixed a bug with the "nofatal" option. + [BUGFIX] CPAN-RT#35189: Fixed a bug in xlate(). + [BUGFIX] Fixed build on Win32, thanks to Adam Kennedy. + [FEATURE] setlogsock() now interprets the second argument as the + hostname for network mechanisms. + [DIST] Add AUTHOR to WriteMakefile() in order to fix the META.yml + generated by ExtUtils::MakeMaker. + [TESTS] Improved t/pod.t with Pod::Checker. + +0.24 -- 2007.12.31 -- Sebastien Aperghis-Tramoni (SAPER) + [BUGFIX] CPANT-RT#32001: Skip the setlogsock('stream') tests when + /dev/log is unavailable (Brendan O'Dea). + +0.23 -- 2007.11.12 -- Sebastien Aperghis-Tramoni (SAPER) + [BUGFIX] Fixed a too liberal test in the "pipe" mechanism, thanks + to Jan Dubois. + [DIST] fallback/syslog.h was missing from MANIFEST (thanks to CPAN + Tester Matthew Musgrove). + [TESTS] Better handling of Perl 5.005, thanks to CPAN Tester Slaven Rezic. + 0.22 -- 2007.11.08 -- Sebastien Aperghis-Tramoni (SAPER) [BUGFIX] CPAN-RT#29875: Added workaround SpamAssassin overzealous logging features. @@ -33,6 +69,8 @@ via syslog(). [BUGFIX] Rewrote the constants generation code in order to provide fallback value for non-standard macros. + [BUGFIX] Mark Blackman and Edmund von der Burg identified and fixed the + random failures appearing on OSX, caused by a UDP timeout. [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. diff -urN perl-5.10.0.orig/ext/Sys/Syslog/Makefile.PL perl-5.10.0/ext/Sys/Syslog/Makefile.PL --- perl-5.10.0.orig/ext/Sys/Syslog/Makefile.PL 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/Makefile.PL 2009-02-10 11:10:19.000000000 +0100 @@ -29,11 +29,14 @@ print " * Win32::EventLog detected.\n"; my $name = "PerlLog"; - push @extra_prereqs, "Win32::TieRegistry" => 0, "Win32::EventLog" => 0; + push @extra_prereqs, + Win32 => 0, "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'; + push @extra_params, CCFLAGS => "-Ifallback"; + # recreate the DLL from its uuencoded form if it's not here if (! -f File::Spec->catfile("win32", "$name.dll")) { # read the uuencoded data @@ -70,22 +73,37 @@ DEFINE => '-DUSE_PPPORT_H'; } +# on pre-5.6 Perls, add warnings::compat to the prereq modules +push @extra_prereqs, "warnings::compat" => "0.06" if $] < 5.006; + WriteMakefile( NAME => 'Sys::Syslog', LICENSE => 'perl', + AUTHOR => 'Sebastien Aperghis-Tramoni ', VERSION_FROM => 'Syslog.pm', ABSTRACT_FROM => 'Syslog.pm', INSTALLDIRS => 'perl', XSPROTOARG => '-noprototypes', PM => \%virtual_path, PREREQ_PM => { - 'Test::More' => 0, - 'XSLoader' => 0, + # run prereqs + 'Carp' => 0, + 'Fcntl' => 0, + 'File::Basename' => 0, + 'File::Spec' => 0, + 'POSIX' => 0, + 'Socket' => 0, + 'XSLoader' => 0, @extra_prereqs, + + # build/test prereqs + 'Test::More' => 0, }, + PL_FILES => {}, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Sys-Syslog-*' }, - realclean => { FILES => 'lib const-c.inc const-xs.inc macros.all PerlLog.h *.bak *.bin *.rc' }, + realclean => { FILES => 'lib const-c.inc const-xs.inc macros.all ' + .'PerlLog.h typemap *.bak *.bin *.rc win32/PerlLog_dll' }, @extra_params ); @@ -160,9 +178,9 @@ ); ExtUtils::Constant::WriteConstants( - ($] > 5.009002 ? (PROXYSUBS => 1) : ()), NAME => 'Sys::Syslog', NAMES => [ @levels, @facilities, @options, @others_macros ], + ($] > 5.009002 ? (PROXYSUBS => 1) : ()), ); my @names = map { ref $_ ? $_->{name} : $_ } @levels, @facilities, @options; diff -urN perl-5.10.0.orig/ext/Sys/Syslog/README perl-5.10.0/ext/Sys/Syslog/README --- perl-5.10.0.orig/ext/Sys/Syslog/README 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/README 2009-02-10 11:10:19.000000000 +0100 @@ -63,5 +63,7 @@ COPYRIGHT AND LICENCE + Copyright (C) 1990-2008 by Larry Wall and others. + This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff -urN perl-5.10.0.orig/ext/Sys/Syslog/Syslog.pm perl-5.10.0/ext/Sys/Syslog/Syslog.pm --- perl-5.10.0.orig/ext/Sys/Syslog/Syslog.pm 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/Syslog.pm 2009-02-10 11:10:19.000000000 +0100 @@ -1,16 +1,17 @@ package Sys::Syslog; use strict; +use warnings; use warnings::register; use Carp; +use Exporter (); use Fcntl qw(O_WRONLY); use File::Basename; use POSIX qw(strftime setlocale LC_TIME); use Socket ':all'; require 5.005; -require Exporter; { no strict 'vars'; - $VERSION = '0.22'; + $VERSION = '0.27'; @ISA = qw(Exporter); %EXPORT_TAGS = ( @@ -76,6 +77,11 @@ # use vars qw($host); # host to send syslog messages to (see notes at end) +# +# Prototypes +# +sub silent_eval (&); + # # Global variables # @@ -85,6 +91,7 @@ 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 $sock_timeout = 0; # socket timeout, see below my $current_proto = undef; # current mechanism used to transmit messages my $ident = ''; # identifiant prepended to each message $facility = ''; # current facility @@ -105,15 +112,12 @@ @connectMethods = grep { $_ ne 'udp' } @connectMethods; } +# And on Win32 systems, we try to use the native mechanism for this +# platform, the events logger, available through Win32::EventLog. EVENTLOG: { - # use EventLog on Win32 my $is_Win32 = $^O =~ /Win32/i; - # some applications are trying to be too smart - # yes I'm speaking of YOU, SpamAssassin, grr.. - local($SIG{__DIE__}, $SIG{__WARN__}, $@); - - if (eval "use Sys::Syslog::Win32; 1") { + if (can_load("Sys::Syslog::Win32")) { unshift @connectMethods, 'eventlog'; } elsif ($is_Win32) { @@ -124,6 +128,18 @@ my @defaultMethods = @connectMethods; my @fallbackMethods = (); +# The timeout in connection_ok() was pushed up to 0.25 sec in +# Sys::Syslog v0.19 in order to address a heisenbug on MacOSX: +# http://london.pm.org/pipermail/london.pm/Week-of-Mon-20061211/005961.html +# +# However, this also had the effect of slowing this test for +# all other operating systems, which apparently impacted some +# users (cf. CPAN-RT #34753). So, in order to make everybody +# happy, the timeout is now zero by default on all systems +# except on OSX where it is set to 250 msec, and can be set +# with the infamous setlogsock() function. +$sock_timeout = 0.25 if $^O =~ /darwin/; + # coderef for a nicer handling of errors my $err_sub = $options{nofatal} ? \&warnings::warnif : \&croak; @@ -155,7 +171,7 @@ $options{$opt} = 1 if exists $options{$opt} } - $err_sub = $options{nofatal} ? \&warnings::warnif : \&croak; + $err_sub = delete $options{nofatal} ? \&warnings::warnif : \&croak; return 1 unless $options{ndelay}; connect_log(); } @@ -172,8 +188,18 @@ } sub setlogsock { - my $setsock = shift; - $syslog_path = shift; + my ($setsock, $setpath, $settime) = @_; + + # check arguments + my $diag_invalid_arg + = "Invalid argument passed to setlogsock; must be 'stream', 'pipe', " + . "'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'"; + croak $diag_invalid_arg unless defined $setsock; + croak "Invalid number of arguments" unless @_ >= 1 and @_ <= 3; + + $syslog_path = $setpath if defined $setpath; + $sock_timeout = $settime if defined $settime; + disconnect_log() if $connected; $transmit_ok = 0; @fallbackMethods = (); @@ -221,7 +247,7 @@ } elsif (lc $setsock eq 'pipe') { for my $path ($syslog_path, &_PATH_LOG, "/dev/log") { - next unless defined $path and length $path and -w $path; + next unless defined $path and length $path and -p $path and -w _; $syslog_path = $path; last } @@ -237,7 +263,7 @@ @connectMethods = qw(native); } elsif (lc $setsock eq 'eventlog') { - if (eval "use Win32::EventLog; 1") { + if (can_load("Win32::EventLog")) { @connectMethods = qw(eventlog); } else { warnings::warnif "eventlog passed to setlogsock, but no Win32 API available"; @@ -248,6 +274,7 @@ } elsif (lc $setsock eq 'tcp') { if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) { @connectMethods = qw(tcp); + $host = $syslog_path; } else { warnings::warnif "tcp passed to setlogsock, but tcp service unavailable"; return undef; @@ -256,6 +283,7 @@ } elsif (lc $setsock eq 'udp') { if (getservbyname('syslog', 'udp')) { @connectMethods = qw(udp); + $host = $syslog_path; } else { warnings::warnif "udp passed to setlogsock, but udp service unavailable"; return undef; @@ -268,8 +296,7 @@ @connectMethods = qw(console); } else { - croak "Invalid argument passed to setlogsock; must be 'stream', 'pipe', ", - "'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'" + croak $diag_invalid_arg } return 1; @@ -293,25 +320,29 @@ croak "syslog: expecting argument \$priority" unless defined $priority; croak "syslog: expecting argument \$format" unless defined $mask; + croak "syslog: invalid level/facility: $priority" if $priority =~ /^-\d+$/; @words = split(/\W+/, $priority, 2); # Allow "level" or "level|facility". undef $numpri; undef $numfac; - foreach (@words) { - $num = xlate($_); # Translate word to number. - if ($num < 0) { - croak "syslog: invalid level/facility: $_" - } - elsif ($num <= &LOG_PRIMASK) { - croak "syslog: too many levels given: $_" if defined $numpri; - $numpri = $num; - return 0 unless LOG_MASK($numpri) & $maskpri; - } - else { - croak "syslog: too many facilities given: $_" if defined $numfac; - $facility = $_; - $numfac = $num; - } + for my $word (@words) { + next if length $word == 0; + + $num = xlate($word); # Translate word to number. + + if ($num < 0) { + croak "syslog: invalid level/facility: $word" + } + elsif ($num <= &LOG_PRIMASK) { + croak "syslog: too many levels given: $word" if defined $numpri; + $numpri = $num; + return 0 unless LOG_MASK($numpri) & $maskpri; + } + else { + croak "syslog: too many facilities given: $word" if defined $numfac; + $facility = $word; + $numfac = $num; + } } croak "syslog: level must be given" unless defined $numpri; @@ -464,14 +495,28 @@ # private function to translate names to numeric values # sub xlate { - my($name) = @_; + my ($name) = @_; + return $name+0 if $name =~ /^\s*\d+\s*$/; $name = uc $name; $name = "LOG_$name" unless $name =~ /^LOG_/; - $name = "Sys::Syslog::$name"; - # Can't have just eval { &$name } || -1 because some LOG_XXX may be zero. - my $value = eval { no strict 'refs'; &$name }; - $@ = ""; + + # ExtUtils::Constant 0.20 introduced a new way to implement + # constants, called ProxySubs. When it was used to generate + # the C code, the constant() function no longer returns the + # correct value. Therefore, we first try a direct call to + # constant(), and if the value is an error we try to call the + # constant by its full name. + my $value = constant($name); + + if (index($value, "not a valid") >= 0) { + $name = "Sys::Syslog::$name"; + $value = eval { no strict "refs"; &$name }; + $value = $@ unless defined $value; + } + + $value = -1 if index($value, "not a valid") >= 0; + return defined $value ? $value : -1; } @@ -546,11 +591,10 @@ } setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1); - if (eval { IPPROTO_TCP() }) { + if (silent_eval { IPPROTO_TCP() }) { # These constants don't exist in 5.005. They were added in 1999 setsockopt(SYSLOG, IPPROTO_TCP(), TCP_NODELAY(), 1); } - $@ = ""; if (!connect(SYSLOG, $addr)) { push @$errs, "tcp connect: $!"; return 0; @@ -619,7 +663,7 @@ push @$errs, "stream $syslog_path is not writable"; return 0; } - if (!sysopen(SYSLOG, $syslog_path, 0400, O_WRONLY)) { + if (!sysopen(SYSLOG, $syslog_path, O_WRONLY, 0400)) { push @$errs, "stream can't open $syslog_path: $!"; return 0; } @@ -697,12 +741,7 @@ $logopt += xlate($opt) if $options{$opt} } - eval { openlog_xs($ident, $logopt, xlate($facility)) }; - if ($@) { - push @$errs, $@; - return 0; - } - + openlog_xs($ident, $logopt, xlate($facility)); $syslog_send = \&_syslog_send_native; return 1; @@ -741,7 +780,7 @@ my $rin = ''; vec($rin, fileno(SYSLOG), 1) = 1; - my $ret = select $rin, undef, $rin, 0.25; + my $ret = select $rin, undef, $rin, $sock_timeout; return ($ret ? 0 : 1); } @@ -761,7 +800,26 @@ return close SYSLOG; } -1; + +# +# Wrappers around eval() that makes sure that nobody, and I say NOBODY, +# ever knows that I wanted to test if something was here or not. +# It is needed because some applications are trying to be too smart, +# do it wrong, and it ends up in EPIC FAIL. +# Yes I'm speaking of YOU, SpamAssassin. +# +sub silent_eval (&) { + local($SIG{__DIE__}, $SIG{__WARN__}, $@); + return eval { $_[0]->() } +} + +sub can_load { + local($SIG{__DIE__}, $SIG{__WARN__}, $@); + return eval "use $_[0]; 1" +} + + +"Eighth Rule: read the documentation." __END__ @@ -771,7 +829,7 @@ =head1 VERSION -Version 0.22 +Version 0.27 =head1 SYNOPSIS @@ -965,6 +1023,8 @@ =item B (added in Perl 5.004_02) +=item B (added in 0.25) + Sets the socket type to be used for the next call to C or C and returns true on success, C on failure. The available mechanisms are: @@ -984,15 +1044,18 @@ =item * C<"tcp"> - connect to a TCP socket, on the C or C -service. +service. If defined, the second parameter is used as a hostname to connect to. =item * C<"udp"> - connect to a UDP socket, on the C service. +If defined, the second parameter is used as a hostname to connect to, +and the third parameter as the timeout used to check for UDP response. =item * -C<"inet"> - connect to an INET socket, either TCP or UDP, tried in that order. +C<"inet"> - connect to an INET socket, either TCP or UDP, tried in that +order. If defined, the second parameter is used as a hostname to connect to. =item * @@ -1026,7 +1089,8 @@ When this calling method is used, the array should contain a list of mechanisms which are attempted in order. -The default is to try C, C, C, C, C, C. +The default is to try C, C, C, C, C, C, +C. Under systems with the Win32 API, C will be added as the first mechanism to try if C is available. @@ -1113,8 +1177,7 @@ Log to UDP port on C<$remotehost> instead of logging locally: - setlogsock('udp'); - $Sys::Syslog::host = $remotehost; + setlogsock("udp", $remotehost); openlog($program, 'ndelay', 'user'); syslog('info', 'something happened over here'); @@ -1342,16 +1405,19 @@ L Solaris 10 documentation on syslog, -L +L -IRIX 6.4 documentation on syslog, -L +Mac OS X documentation on syslog, +L + +IRIX 6.5 documentation on syslog, +L AIX 5L 5.3 documentation on syslog, L HP-UX 11i documentation on syslog, -L +L Tru64 5.1 documentation on syslog, L @@ -1455,7 +1521,7 @@ =head1 COPYRIGHT -Copyright (C) 1990-2007 by Larry Wall and others. +Copyright (C) 1990-2008 by Larry Wall and others. =head1 LICENSE @@ -1518,6 +1584,9 @@ Links ----- +Linux Fast-STREAMS +- L + II12021: SYSLOGD HOWTO TCPIPINFO (z/OS, OS/390, MVS) - L diff -urN perl-5.10.0.orig/ext/Sys/Syslog/Syslog.xs perl-5.10.0/ext/Sys/Syslog/Syslog.xs --- perl-5.10.0.orig/ext/Sys/Syslog/Syslog.xs 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/Syslog.xs 2009-02-10 11:10:19.000000000 +0100 @@ -1,3 +1,7 @@ +#if defined(_WIN32) +# include +#endif + #include "EXTERN.h" #include "perl.h" #include "XSUB.h" @@ -9,13 +13,13 @@ #define HAVE_SYSLOG 1 #endif -#if defined(I_SYSLOG) || PATCHLEVEL < 6 -#include -#endif - #if defined(_WIN32) && !defined(__CYGWIN__) -#undef HAVE_SYSLOG -#include "fallback/syslog.h" +# undef HAVE_SYSLOG +# include "fallback/syslog.h" +#else +# if defined(I_SYSLOG) || PATCHLEVEL < 6 +# include +# endif #endif static SV *ident_svptr; @@ -126,7 +130,9 @@ INPUT: int mask CODE: - setlogmask(mask); + RETVAL = setlogmask(mask); + OUTPUT: + RETVAL void closelog_xs() @@ -135,4 +141,31 @@ if (SvREFCNT(ident_svptr)) SvREFCNT_dec(ident_svptr); +#else /* HAVE_SYSLOG */ + +void +openlog_xs(ident, option, facility) + INPUT: + SV* ident + int option + int facility + CODE: + +void +syslog_xs(priority, message) + INPUT: + int priority + const char * message + CODE: + +int +setlogmask_xs(mask) + INPUT: + int mask + CODE: + +void +closelog_xs() + CODE: + #endif /* HAVE_SYSLOG */ diff -urN perl-5.10.0.orig/ext/Sys/Syslog/fallback/syslog.h perl-5.10.0/ext/Sys/Syslog/fallback/syslog.h --- perl-5.10.0.orig/ext/Sys/Syslog/fallback/syslog.h 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/fallback/syslog.h 2009-02-10 11:10:19.000000000 +0100 @@ -0,0 +1,111 @@ +/* + * Copyright (c) 1982, 1986, 1988, 1993 + * The Regents of the University of California. All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 4. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + * + * @(#)syslog.h 8.1 (Berkeley) 6/2/93 + */ + +#ifndef _SYS_SYSLOG_H +#define _SYS_SYSLOG_H 1 + +#define _PATH_LOG "" + +/* + * priorities/facilities are encoded into a single 32-bit quantity, where the + * bottom 3 bits are the priority (0-7) and the top 28 bits are the facility + * (0-big number). Both the priorities and the facilities map roughly + * one-to-one to strings in the syslogd(8) source code. This mapping is + * included in this file. + * + * priorities (these are ordered) + */ +#define LOG_EMERG 0 /* system is unusable */ +#define LOG_ALERT 1 /* action must be taken immediately */ +#define LOG_CRIT 2 /* critical conditions */ +#define LOG_ERR 3 /* error conditions */ +#define LOG_WARNING 4 /* warning conditions */ +#define LOG_NOTICE 5 /* normal but significant condition */ +#define LOG_INFO 6 /* informational */ +#define LOG_DEBUG 7 /* debug-level messages */ + +#define LOG_PRIMASK 0x07 /* mask to extract priority part (internal) */ + /* extract priority */ +#define LOG_PRI(p) ((p) & LOG_PRIMASK) +#define LOG_MAKEPRI(fac, pri) (((fac) << 3) | (pri)) + +/* facility codes */ +#define LOG_KERN (0<<3) /* kernel messages */ +#define LOG_USER (1<<3) /* random user-level messages */ +#define LOG_MAIL (2<<3) /* mail system */ +#define LOG_DAEMON (3<<3) /* system daemons */ +#define LOG_AUTH (4<<3) /* security/authorization messages */ +#define LOG_SYSLOG (5<<3) /* messages generated internally by syslogd */ +#define LOG_LPR (6<<3) /* line printer subsystem */ +#define LOG_NEWS (7<<3) /* network news subsystem */ +#define LOG_UUCP (8<<3) /* UUCP subsystem */ +#define LOG_CRON (9<<3) /* clock daemon */ +#define LOG_AUTHPRIV (10<<3) /* security/authorization messages (private) */ +#define LOG_FTP (11<<3) /* ftp daemon */ +#define LOG_NETINFO (12<<3) /* NetInfo */ +#define LOG_REMOTEAUTH (13<<3) /* remote authentication/authorization */ +#define LOG_INSTALL (14<<3) /* installer subsystem */ +#define LOG_RAS (15<<3) /* Remote Access Service (VPN / PPP) */ +#define LOG_LOCAL0 (16<<3) /* reserved for local use */ +#define LOG_LOCAL1 (17<<3) /* reserved for local use */ +#define LOG_LOCAL2 (18<<3) /* reserved for local use */ +#define LOG_LOCAL3 (19<<3) /* reserved for local use */ +#define LOG_LOCAL4 (20<<3) /* reserved for local use */ +#define LOG_LOCAL5 (21<<3) /* reserved for local use */ +#define LOG_LOCAL6 (22<<3) /* reserved for local use */ +#define LOG_LOCAL7 (23<<3) /* reserved for local use */ +#define LOG_LAUNCHD (24<<3) /* launchd - general bootstrap daemon */ + +#define LOG_NFACILITIES 25 /* current number of facilities */ +#define LOG_FACMASK 0x03f8 /* mask to extract facility part */ + /* facility of pri */ +#define LOG_FAC(p) (((p) & LOG_FACMASK) >> 3) + +/* + * arguments to setlogmask. + */ +#define LOG_MASK(pri) (1 << (pri)) /* mask for one priority */ +#define LOG_UPTO(pri) ((1 << ((pri)+1)) - 1) /* all priorities through pri */ + +/* + * Option flags for openlog. + * + * LOG_ODELAY no longer does anything. + * LOG_NDELAY is the inverse of what it used to be. + */ +#define LOG_PID 0x01 /* log the pid with each message */ +#define LOG_CONS 0x02 /* log on the console if errors in sending */ +#define LOG_ODELAY 0x04 /* delay open until first syslog() (default) */ +#define LOG_NDELAY 0x08 /* don't delay open */ +#define LOG_NOWAIT 0x10 /* don't wait for console forks: DEPRECATED */ +#define LOG_PERROR 0x20 /* log to stderr as well */ + +#endif /* sys/syslog.h */ diff -urN perl-5.10.0.orig/ext/Sys/Syslog/t/00-load.t perl-5.10.0/ext/Sys/Syslog/t/00-load.t --- perl-5.10.0.orig/ext/Sys/Syslog/t/00-load.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/t/00-load.t 2009-02-10 11:10:19.000000000 +0100 @@ -2,9 +2,7 @@ use strict; use Test::More tests => 1; -BEGIN { - use_ok( 'Sys::Syslog' ); -} +use_ok( 'Sys::Syslog' ); diag( "Testing Sys::Syslog $Sys::Syslog::VERSION, Perl $], $^X" ) unless $ENV{PERL_CORE}; diff -urN perl-5.10.0.orig/ext/Sys/Syslog/t/data-validation.t perl-5.10.0/ext/Sys/Syslog/t/data-validation.t --- perl-5.10.0.orig/ext/Sys/Syslog/t/data-validation.t 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/t/data-validation.t 2009-02-10 11:10:19.000000000 +0100 @@ -0,0 +1,114 @@ +#!perl -w +# -------------------------------------------------------------------- +# The aim of this test is to start a syslog server (TCP or UDP) using +# the one available in POE, make Sys::Syslog connect to it by manually +# select the corresponding mechanism, send some messages and, inside +# the POE syslog server, check that these message are correctly crafted. +# -------------------------------------------------------------------- +use strict; + +my $port; +BEGIN { + # override getservbyname() + *CORE::GLOBAL::getservbyname = sub ($$) { + my @v = CORE::getservbyname($_[0], $_[1]); + + if (@v) { + $v[2] = $port; + } else { + @v = ($_[0], "", $port, $_[1]); + } + + return wantarray ? @v : $port + } +} + +use File::Spec; +use Test::More; +use Socket; +use Sys::Syslog qw(:standard :extended :macros); + + +# check than POE is available +plan skip_all => "POE is not available" unless eval "use POE; 1"; + +# check than POE::Component::Server::Syslog is available +plan skip_all => "POE::Component::Server::Syslog is not available" + unless eval "use POE::Component::Server::Syslog; 1"; + +plan tests => 1; + + $port = 5140; +my $proto = "tcp"; + +my $ident = "pocosyslog"; +my $text = "Close the world, txEn eht nepO."; + + +$SIG{ALRM} = sub { + ok( 0, "test took too much time to execute" ); + exit +}; +alarm 30; + +my $pid = fork(); + +if ($pid) { + # parent: setup a syslog server + POE::Component::Server::Syslog->spawn( + Alias => 'syslog', + Type => $proto, + BindAddress => '127.0.0.1', + BindPort => $port, + InputState => \&client_input, + ErrorState => \&client_error, + ); + + $SIG{CHLD} = sub { wait() }; + + POE::Kernel->run; +} +else { + # child: send a message to the syslog server setup in the parent + sleep 2; + openlog($ident, "ndelay,pid", "local0"); + setlogsock($proto); + syslog(info => $text); + closelog(); + exit +} + +sub client_input { + my $message = $_[&ARG0]; + delete $message->{'time'}; # too hazardous to test + my $nl = $^O =~ /darwin/ ? "" : "\n"; + + is_deeply( + $message, + { + host => scalar gethostbyaddr(inet_aton('127.0.0.1'), AF_INET), + pri => &LOG_LOCAL0 + &LOG_INFO, + facility => &LOG_LOCAL0 >> 3, + severity => &LOG_INFO, + msg => "$ident\[$pid]: $text$nl\0", + }, + "checking syslog message" + ); + + POE::Kernel->post(syslog => "shutdown"); + POE::Kernel->stop; +} + +sub client_error { + my $message = $_[&ARG0]; + + require Data::Dumper; + $Data::Dumper::Indent = 0; $Data::Dumper::Indent = 0; + $Data::Dumper::Sortkeys = 1; $Data::Dumper::Sortkeys = 1; + fail "checking syslog message"; + diag "[client_error] message = ", Data::Dumper::Dumper($message); + + POE::Kernel->post(syslog => "shutdown"); + POE::Kernel->stop; +} + diff -urN perl-5.10.0.orig/ext/Sys/Syslog/t/syslog.t perl-5.10.0/ext/Sys/Syslog/t/syslog.t --- perl-5.10.0.orig/ext/Sys/Syslog/t/syslog.t 2007-12-18 11:47:07.000000000 +0100 +++ perl-5.10.0/ext/Sys/Syslog/t/syslog.t 2009-02-10 11:10:19.000000000 +0100 @@ -19,6 +19,10 @@ pack portable recursion redefine regexp severe signal substr syntax taint uninitialized unpack untie utf8 void); +# if someone is using warnings::compat, the previous trick won't work, so we +# must manually disable warnings +$^W = 0 if $] < 5.006; + my $is_Win32 = $^O =~ /win32/i; my $is_Cygwin = $^O =~ /cygwin/i; @@ -111,35 +115,35 @@ } -BEGIN { $tests += 20 * 8 } +BEGIN { $tests += 22 * 8 } # try to open a syslog using all the available connection methods my @passed = (); for my $sock_type (qw(native eventlog unix pipe stream inet tcp udp)) { SKIP: { - skip "the 'stream' mechanism because a previous mechanism with similar interface succeeded", 20 + skip "the 'stream' mechanism because a previous mechanism with similar interface succeeded", 22 if $sock_type eq 'stream' and grep {/pipe|unix/} @passed; # setlogsock() called with an arrayref $r = eval { setlogsock([$sock_type]) } || 0; - skip "can't use '$sock_type' socket", 20 unless $r; + skip "can't use '$sock_type' socket", 22 unless $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; + skip "can't use '$sock_type' socket", 20 unless $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/; + skip "can't connect to syslog", 18 if $@ =~ /^no connection to syslog available/; 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/; + skip "can't connect to syslog", 16 if $@ =~ /^no connection to syslog available/; is( $@, '', "[$sock_type] openlog() called with facility 'local0' with option 'ndelay'" ); ok( $r, "[$sock_type] openlog() should return true: '$r'" ); @@ -148,6 +152,11 @@ like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level -1" ); ok( !$r, "[$sock_type] syslog() should return false: '$r'" ); + # syslog() with invalid level, should fail + $r = eval { syslog("plonk", "$test_string by connecting to a $sock_type socket") } || 0; + like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level plonk" ); + 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/', "[$sock_type] syslog() called with level 'info,notice'" ); @@ -189,6 +198,9 @@ skip "the 'unix' mechanism works, so the tests will likely fail with the 'stream' mechanism", 10 if grep {/unix/} @passed; + skip "not testing setlogsock('stream'): _PATH_LOG unavailable", 10 + unless -e Sys::Syslog::_PATH_LOG(); + # setlogsock() with "stream" and an undef path $r = eval { setlogsock("stream", undef ) } || ''; is( $@, '', "setlogsock() called, with 'stream' and an undef path" );