In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0374b0a2a50c6e91951723a4d9ee1d7f534b03eb?hp=ab2a3ce27dfc911941e11f1e1905dfd528cb562b>
- Log ----------------------------------------------------------------- commit 0374b0a2a50c6e91951723a4d9ee1d7f534b03eb Author: Steve Hay <[email protected]> Date: Sun Aug 19 12:53:47 2012 +0100 Upgrade to Sys-Syslog-0.31 ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + Porting/Maintainers.pl | 2 +- cpan/Sys-Syslog/Changes | 16 ++++ cpan/Sys-Syslog/Makefile.PL | 5 + cpan/Sys-Syslog/Syslog.pm | 39 ++++++--- cpan/Sys-Syslog/t/facilities-routing.t | 143 ++++++++++++++++++++++++++++++++ cpan/Sys-Syslog/t/syslog.t | 41 +++++++++ pod/perldelta.pod | 7 +- 8 files changed, 236 insertions(+), 18 deletions(-) create mode 100644 cpan/Sys-Syslog/t/facilities-routing.t diff --git a/MANIFEST b/MANIFEST index cd8023b..23fb602 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2246,6 +2246,7 @@ cpan/Sys-Syslog/Syslog.pm Sys::Syslog extension Perl module cpan/Sys-Syslog/Syslog.xs Sys::Syslog extension external subroutines cpan/Sys-Syslog/t/00-load.t test for Sys::Syslog cpan/Sys-Syslog/t/constants.t test for Sys::Syslog +cpan/Sys-Syslog/t/facilities-routing.t test for Sys::Syslog cpan/Sys-Syslog/t/syslog.t See if Sys::Syslog works cpan/Sys-Syslog/win32/compile.pl Sys::Syslog extension Win32 related file cpan/Sys-Syslog/win32/PerlLog_dll.uu Sys::Syslog extension Win32 related file diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 5b23e82..5f8893c 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1657,7 +1657,7 @@ use File::Glob qw(:case); 'Sys::Syslog' => { 'MAINTAINER' => 'saper', - 'DISTRIBUTION' => 'SAPER/Sys-Syslog-0.30.tar.gz', + 'DISTRIBUTION' => 'SAPER/Sys-Syslog-0.31.tar.gz', 'FILES' => q[cpan/Sys-Syslog], 'EXCLUDED' => [ qr{^eg/}, diff --git a/cpan/Sys-Syslog/Changes b/cpan/Sys-Syslog/Changes index d1b0bd0..c1a8795 100644 --- a/cpan/Sys-Syslog/Changes +++ b/cpan/Sys-Syslog/Changes @@ -1,5 +1,21 @@ Revision history for Sys-Syslog +0.31 -- 2012.08.18 -- Sebastien Aperghis-Tramoni (SAPER) + [BUGFIX] Level 'emerg' could not be used since v0.29. + [BUGFIX] Setting a message facility with syslog() was broken since v0.29 + (Noel Butler). + [BUGFIX] CPAN-RT#69992: Make setlogsock() only use the requested mechanism, + restoring way it worked in v0.27 and before (Niko Tyni). + [BUGFIX] CPAN-RT#69986: setlogsock() doesn't return undef on failure + (Niko Tyni). + [BUGFIX] CPAN-RT#69997: Use the default UDP socket timeout on GNU/kFreeBSD + as well, and lower it to a more sensible value (Niko Tyni). + [BUGFIX] CPAN-RT#75827: syslog() logging everything regardless of log + mask when using using numeric LOG_* macros (Bryan Thale). + [TESTS] Added t/facilities-routing.t + [DOC] Don't highlight "the Rules of Sys::Syslog" from the Description. + [DIST] Add meta-information in Makefile.PL + 0.30 -- 2012.08.15 -- Sebastien Aperghis-Tramoni (SAPER) [BUGFIX] CPAN-RT#69310: Avoid a POSIX::strftime issue on Windows (Michael Ludwig). diff --git a/cpan/Sys-Syslog/Makefile.PL b/cpan/Sys-Syslog/Makefile.PL index a402896..347197a 100644 --- a/cpan/Sys-Syslog/Makefile.PL +++ b/cpan/Sys-Syslog/Makefile.PL @@ -89,6 +89,11 @@ WriteMakefile( # build/test prereqs 'Test::More' => 0, }, + META_MERGE => { + resources => { + repository => "https://github.com/maddingue/Sys-Syslog.git";, + }, + }, PL_FILES => {}, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Sys-Syslog-*' }, diff --git a/cpan/Sys-Syslog/Syslog.pm b/cpan/Sys-Syslog/Syslog.pm index 48ea904..3d0c00d 100644 --- a/cpan/Sys-Syslog/Syslog.pm +++ b/cpan/Sys-Syslog/Syslog.pm @@ -12,7 +12,7 @@ require 5.005; { no strict 'vars'; - $VERSION = '0.30'; + $VERSION = '0.31'; @ISA = qw< Exporter >; %EXPORT_TAGS = ( @@ -139,7 +139,13 @@ my @fallbackMethods = (); # 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/; +# +# Update 2011-08: this issue is also been seen on multiprocessor +# Debian GNU/kFreeBSD systems. See http://bugs.debian.org/627821 +# and https://rt.cpan.org/Ticket/Display.html?id=69997 +# Also, lowering the delay to 1 ms, which should be enough. + +$sock_timeout = 0.001 if $^O =~ /darwin|gnukfreebsd/; # coderef for a nicer handling of errors my $err_sub = $options{nofatal} ? \&warnings::warnif : \&croak; @@ -288,7 +294,7 @@ sub setlogsock { @opt{qw< type path timeout >} = @_; } - # check socket type, remove + # check socket type, remove invalid ones my $diag_invalid_type = "setlogsock(): Invalid type%s; must be one of " . join ", ", map { "'$_'" } sort keys %mechanism; croak sprintf $diag_invalid_type, "" unless defined $opt{type}; @@ -313,11 +319,14 @@ sub setlogsock { disconnect_log() if $connected; $transmit_ok = 0; @fallbackMethods = (); - @connectMethods = @defaultMethods; + @connectMethods = (); + my $found = 0; + # check each given mechanism and test if it can be used on the current system for my $sock_type (@sock_types) { if ( $mechanism{$sock_type}{check}->() ) { - unshift @connectMethods, $sock_type; + push @connectMethods, $sock_type; + $found = 1; } else { warnings::warnif "setlogsock(): type='$sock_type': " @@ -325,7 +334,10 @@ sub setlogsock { } } - return 1; + # if no mechanism worked from the given ones, use the default ones + @connectMethods = @defaultMethods unless @connectMethods; + + return $found; } sub syslog { @@ -348,7 +360,7 @@ sub syslog { if ($priority =~ /^\d+$/) { $numpri = LOG_PRI($priority); - $numfac = LOG_FAC($priority); + $numfac = LOG_FAC($priority) << 3; } elsif ($priority =~ /^\w+/) { # Allow "level" or "level|facility". @@ -366,17 +378,16 @@ sub syslog { if ($num < 0) { croak "syslog: invalid level/facility: $word" } - elsif (my $pri = LOG_PRI($num)) { + elsif ($num <= LOG_PRIMASK() and $word ne "kern") { 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 if $word =~ /^[A-Za-z]/; - $numfac = LOG_FAC($num); + $numfac = $num; } } } @@ -386,6 +397,9 @@ sub syslog { croak "syslog: level must be given" unless defined $numpri; + # don't log if priority is below mask level + return 0 unless LOG_MASK($numpri) & $maskpri; + if (not defined $numfac) { # Facility not specified in this call. $facility = 'user' unless $facility; $numfac = xlate($facility); @@ -879,7 +893,7 @@ Sys::Syslog - Perl interface to the UNIX syslog(3) calls =head1 VERSION -This is the documentation of version 0.30 +This is the documentation of version 0.31 =head1 SYNOPSIS @@ -898,9 +912,6 @@ 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 diff --git a/cpan/Sys-Syslog/t/facilities-routing.t b/cpan/Sys-Syslog/t/facilities-routing.t new file mode 100644 index 0000000..ce0a5b1 --- /dev/null +++ b/cpan/Sys-Syslog/t/facilities-routing.t @@ -0,0 +1,143 @@ +#!perl -w +# -------------------------------------------------------------------- +# Try to send messages with all combinations of facilities and levels +# to a POE syslog server. +# -------------------------------------------------------------------- +use strict; +use warnings; + +use Test::More; +use Socket; +use Sys::Syslog 0.30 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 and recent enough +plan skip_all => "POE::Component::Server::Syslog is not available" + unless eval "use POE::Component::Server::Syslog; 1"; +plan skip_all => "POE::Component::Server::Syslog is too old" + if POE::Component::Server::Syslog->VERSION < 1.14; + + +my $host = "127.0.0.1"; +my $port = 5140; +my $proto = "udp"; +my $ident = "pocosyslog"; + +my @levels = qw< emerg alert crit err warning notice info debug >; +my @facilities = qw< + auth cron daemon ftp kern lpr mail news syslog user uucp + local0 local1 local2 local3 local4 local5 local6 local7 +>; + +my %received; +my $parent_pid = $$; +my $child_pid = fork(); + +if ($child_pid) { + # parent: setup a syslog server + POE::Component::Server::Syslog->spawn( + Alias => 'syslog', + Type => $proto, + BindAddress => $host, + BindPort => $port, + + InputState => \&client_input, + ErrorState => \&client_error, + ); + + # signal handlers + POE::Kernel->sig_child($child_pid, sub { wait() }); + $SIG{TERM} = sub { + POE::Kernel->post(syslog => "shutdown"); + POE::Kernel->stop; + }; + + # run everything + plan tests => @facilities * @levels * 2; + POE::Kernel->run; + + # check if some messages are missing + my @miss = grep { $received{$_} < 2 } keys %received; + diag "@miss" if @miss; +} +else { + # child: send messages to the syslog server + sleep 2; + setlogsock({ host => $host, type => $proto, port => $port }); + + # first way, set the facility each time with openlog() + for my $facility (@facilities) { + openlog($ident, "ndelay,pid", $facility); + + for my $level (@levels) { + eval { syslog($level => "<$facility\:$level>") } + or warn "error: syslog($level => '<$facility\:$level>'): $@"; + } + } + + # second way, set the facility once with openlog(), then set + # the message facility with syslog() + openlog($ident, "ndelay,pid", "user"); + + for my $facility (@facilities) { + for my $level (@levels) { + eval { syslog("$facility.$level" => "<$facility\:$level>") } + or warn "error: syslog('$facility.$level' => '<$facility\:$level>'): $@"; + } + } + + sleep 2; + + # send SIGTERM to the parent + kill 15 => $parent_pid; +} + + +sub client_input { + my $message = $_[&ARG0]; + + # extract the sent facility and level from the message text + my ($sent_facility, $sent_level) = $message->{msg} =~ /<(\w+):(\w+)>/; + $received{"$sent_facility\:$sent_level"}++; + + # resolve their numeric values + my ($sent_fac_num, $sent_lev_num); + { + no strict "refs"; + $sent_fac_num = eval { my $n = uc "LOG_$sent_facility"; &$n } >> 3; + $sent_lev_num = eval { my $n = uc "LOG_$sent_level"; &$n }; + } + + is_deeply( + { # received message + facility => $message->{facility}, + severity => $message->{severity}, + }, + { # sent message + facility => $sent_fac_num, + severity => $sent_lev_num, + }, + "sent<facility=$sent_facility($sent_fac_num), level=$sent_level" . + "($sent_lev_num)> - rcvd<facility=$message->{facility}, " . + "level=$message->{severity}>" + ); +} + + +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); + + kill 15 => $child_pid; + POE::Kernel->post(syslog => "shutdown"); + POE::Kernel->stop; +} + diff --git a/cpan/Sys-Syslog/t/syslog.t b/cpan/Sys-Syslog/t/syslog.t index ee136d5..d69c6e3 100644 --- a/cpan/Sys-Syslog/t/syslog.t +++ b/cpan/Sys-Syslog/t/syslog.t @@ -276,3 +276,44 @@ BEGIN { $tests += 3 + 4 * 3 } setlogmask($oldmask); } } + +BEGIN { $tests += 4 } +SKIP: { + # case: test the return value of setlogsock() + + # setlogsock("stream") on a non-existent file must fail + eval { $r = setlogsock("stream", "plonk/log") }; + is( $@, '', "setlogsock() didn't croak"); + ok( !$r, "setlogsock() correctly failed with a non-existent stream path"); + + # setlogsock("tcp") must fail if the service is not declared + my $service = getservbyname("syslog", "tcp") || getservbyname("syslogng", "tcp"); + skip "can't test setlogsock() tcp failure", 2 if $service; + eval { $r = setlogsock("tcp") }; + is( $@, '', "setlogsock() didn't croak"); + ok( !$r, "setlogsock() correctly failed when tcp services can't be resolved"); +} + +BEGIN { $tests += 3 } +SKIP: { + # case: configure Sys::Syslog to use the stream mechanism on a + # given file, but remove the file before openlog() is called, + # so it fails. + + # create the log file + my $log = "t/stream"; + open my $fh, ">$log" or skip "can't write file '$log': $!", 3; + close $fh; + + # configure Sys::Syslog to use it + $r = eval { setlogsock("stream", $log) }; + is( $@, "", "setlogsock('stream', '$log') -> $r" ); + skip "can't test openlog() failure with a missing stream", 2 if !$r; + + # remove the log and check that openlog() fails + unlink $log; + $r = eval { openlog('perl', 'ndelay', 'local0') }; + ok( !$r, "openlog() correctly failed with a non-existent stream" ); + like( $@, '/not writable/', "openlog() correctly croaked with a non-existent stream" ); +} + diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 892e7aa..2e8c4fd 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -243,9 +243,10 @@ storage format, so the format version has increased to 2.9. =item * -L<Sys::Syslog> has been upgraded from version 0.29 to 0.30. An issue with -C<POSIX::strftime()> on Windows and a build problem on Haiku-OS have been -resolved, and <getservbyname()> is no longer called when the port is specified. +L<Sys::Syslog> has been upgraded from version 0.29 to 0.31. This contains +several bug fixes relating to C<getservbyname()>, C<setlogsock()>and log levels +in C<syslog()>, together with fixes for Windows, Haiku-OS and GNU/kFreeBSD. +See F<cpan/Sys-Syslog/Changes> for the full details. =item * -- Perl5 Master Repository
