Front page | perl.perl5.changes |
Postings from August 2012
[perl.git] branch blead, updated. v5.17.2-394-g0374b0a
From:
Steve Hay
Date:
August 19, 2012 05:30
Subject:
[perl.git] branch blead, updated. v5.17.2-394-g0374b0a
Message ID:
E1T34dw-0001oX-JP@camel.ams6.corp.booking.com
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 <steve.m.hay@googlemail.com>
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
-
[perl.git] branch blead, updated. v5.17.2-394-g0374b0a
by Steve Hay