summaryrefslogtreecommitdiff
path: root/cpan
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2019-10-22 01:08:30 +0100
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2019-10-22 01:08:30 +0100
commit10934390253ed18c48f144735ad3c6a508caabc1 (patch)
tree3fcad4d4775b19591ecf09dc31fbdb79c51fba3b /cpan
parent9e337eb6c8f2d075b72c1c7ca6d12a0a1c05ff42 (diff)
downloadperl-10934390253ed18c48f144735ad3c6a508caabc1.tar.gz
Update Sys-Syslog to CPAN version 0.36
[DELTA] 0.36 -- 2019-10-22 -- Sebastien Aperghis-Tramoni (SAPER) [Tests] - RT #127454 / GitHub PR #8: Intermittent failures on OpenBSD and other platforms (Jim Keenan).
Diffstat (limited to 'cpan')
-rw-r--r--cpan/Sys-Syslog/.gitignore10
-rw-r--r--cpan/Sys-Syslog/Syslog.pm4
-rw-r--r--cpan/Sys-Syslog/t/cpan-rt-21516.t14
-rw-r--r--cpan/Sys-Syslog/t/cpan-rt-21866.t16
-rw-r--r--cpan/Sys-Syslog/t/cpan-rt-25488.t17
-rw-r--r--cpan/Sys-Syslog/t/cpan-rt-49877.pl19
-rw-r--r--cpan/Sys-Syslog/t/cpan-rt-55151.t19
-rw-r--r--cpan/Sys-Syslog/t/cpan-rt-64287.t29
-rw-r--r--cpan/Sys-Syslog/t/syslog-inet-udp.t205
-rw-r--r--cpan/Sys-Syslog/t/syslog.t11
10 files changed, 337 insertions, 7 deletions
diff --git a/cpan/Sys-Syslog/.gitignore b/cpan/Sys-Syslog/.gitignore
index 2f2399bced..d94e453f6c 100644
--- a/cpan/Sys-Syslog/.gitignore
+++ b/cpan/Sys-Syslog/.gitignore
@@ -1,2 +1,12 @@
*.inc
macros.all
+MYMETA.*
+Makefile
+Makefile.old
+Makefile.bak
+MANIFEST.bak
+Syslog.bs
+Syslog.c
+Syslog.o
+blib/
+pm_to_blib
diff --git a/cpan/Sys-Syslog/Syslog.pm b/cpan/Sys-Syslog/Syslog.pm
index 96e8632f6e..ebbac5db27 100644
--- a/cpan/Sys-Syslog/Syslog.pm
+++ b/cpan/Sys-Syslog/Syslog.pm
@@ -15,7 +15,7 @@ require 5.005;
{ no strict 'vars';
- $VERSION = '0.35';
+ $VERSION = '0.36';
%EXPORT_TAGS = (
standard => [qw(openlog syslog closelog setlogmask)],
@@ -935,7 +935,7 @@ Sys::Syslog - Perl interface to the UNIX syslog(3) calls
=head1 VERSION
-This is the documentation of version 0.35
+This is the documentation of version 0.36
=head1 SYNOPSIS
diff --git a/cpan/Sys-Syslog/t/cpan-rt-21516.t b/cpan/Sys-Syslog/t/cpan-rt-21516.t
new file mode 100644
index 0000000000..f895eda22f
--- /dev/null
+++ b/cpan/Sys-Syslog/t/cpan-rt-21516.t
@@ -0,0 +1,14 @@
+#!perl -wT
+use strict;
+use Test::More;
+
+plan tests => 1;
+
+# ----------
+# CPAN-RT#21516: closelog() wasn't correctly calling closelog_xs() when
+# using the native mechanism.
+#
+use Sys::Syslog;
+openlog("sys-syslog-test", 'pid,ndelay', 'user');
+closelog();
+is( $@, '', "was closelog_xs() correctly called?" );
diff --git a/cpan/Sys-Syslog/t/cpan-rt-21866.t b/cpan/Sys-Syslog/t/cpan-rt-21866.t
new file mode 100644
index 0000000000..12cc34a9e8
--- /dev/null
+++ b/cpan/Sys-Syslog/t/cpan-rt-21866.t
@@ -0,0 +1,16 @@
+#!perl -wT
+use strict;
+use Test::More;
+
+# any remaining warning should be severly punished
+eval "use Test::NoWarnings";
+my $tests = $@ ? 0 : 1;
+plan skip_all => "Test::NoWarnings not available" if !$tests;
+plan tests => $tests;
+
+# ----------
+# CPAN-RT#21866: openlog() produced a "use of uninitialized value in split"
+# warning when given undefined arguments.
+#
+use Sys::Syslog;
+openlog();
diff --git a/cpan/Sys-Syslog/t/cpan-rt-25488.t b/cpan/Sys-Syslog/t/cpan-rt-25488.t
new file mode 100644
index 0000000000..a8a8ed4d8b
--- /dev/null
+++ b/cpan/Sys-Syslog/t/cpan-rt-25488.t
@@ -0,0 +1,17 @@
+#!perl -wT
+use strict;
+use Test::More;
+
+# any remaining warning should be severly punished
+eval "use Test::NoWarnings";
+my $tests = $@ ? 0 : 1;
+plan skip_all => "Test::NoWarnings not available" if !$tests;
+plan tests => $tests;
+
+# ----------
+# CPAN-RT#25488: disconnect_log() produced a "uninitialized" warning
+# because $current_proto was used without being checked.
+#
+use Sys::Syslog qw(:standard :macros);
+openlog("sys-syslog-test", "", LOG_USER);
+closelog();
diff --git a/cpan/Sys-Syslog/t/cpan-rt-49877.pl b/cpan/Sys-Syslog/t/cpan-rt-49877.pl
new file mode 100644
index 0000000000..0ec26608e6
--- /dev/null
+++ b/cpan/Sys-Syslog/t/cpan-rt-49877.pl
@@ -0,0 +1,19 @@
+#!perl
+use strict;
+#use Test::More;
+
+#plan tests => 2;
+
+# --------------------
+# CPAN-RT #49877: Options not reset after closelog()
+#
+use Sys::Syslog qw< :standard :macros >;
+
+openlog("Sys::Syslog", "pid,ndelay,perror", "user");
+syslog(info => "Lorem ipsum dolor sit amet");
+closelog();
+
+openlog("Sys::Syslog", "ndelay,perror", "user");
+syslog(info => "Lorem ipsum dolor sit amet");
+closelog();
+
diff --git a/cpan/Sys-Syslog/t/cpan-rt-55151.t b/cpan/Sys-Syslog/t/cpan-rt-55151.t
new file mode 100644
index 0000000000..bf6c792fe1
--- /dev/null
+++ b/cpan/Sys-Syslog/t/cpan-rt-55151.t
@@ -0,0 +1,19 @@
+#!perl
+use strict;
+use Test::More;
+
+plan tests => 2;
+
+# --------------------
+# CPAN-RT #55151: Allow temporary facility in syslog() for native mechanism
+#
+use Sys::Syslog qw< :standard :macros >;
+
+openlog("Sys::Syslog", "pid,ndelay", "user");
+
+eval { syslog("local0|info", "Lorem ipsum dolor sit amet") };
+is($@, "", "syslog('local0|info', ...)");
+
+eval { syslog(LOG_LOCAL0|LOG_INFO, "Lorem ipsum dolor sit amet") };
+is($@, "", "syslog(LOG_LOCAL0|LOG_INFO, ...)");
+
diff --git a/cpan/Sys-Syslog/t/cpan-rt-64287.t b/cpan/Sys-Syslog/t/cpan-rt-64287.t
new file mode 100644
index 0000000000..bacb021d95
--- /dev/null
+++ b/cpan/Sys-Syslog/t/cpan-rt-64287.t
@@ -0,0 +1,29 @@
+#!perl
+use strict;
+use Test::More;
+
+plan tests => 4;
+
+# --------------------
+# CPAN-RT #64287: Avoid memory corruption when closelog() is called twice.
+#
+use Sys::Syslog;
+
+openlog("Sys::Syslog", "pid", "user");
+syslog(debug => "Lorem ipsum dolor sit amet");
+
+# first call to closelog()
+eval { closelog() };
+is($@, "", "closelog()");
+
+# create a variable with a reference to something
+$a = {};
+isa_ok($a, "HASH");
+
+# second call to closelog()
+eval { closelog() };
+is($@, "", "closelog()");
+
+# check that the variable still is what it's supposed to be
+isa_ok($a, "HASH");
+
diff --git a/cpan/Sys-Syslog/t/syslog-inet-udp.t b/cpan/Sys-Syslog/t/syslog-inet-udp.t
new file mode 100644
index 0000000000..707e3ce9ce
--- /dev/null
+++ b/cpan/Sys-Syslog/t/syslog-inet-udp.t
@@ -0,0 +1,205 @@
+#!perl -T
+
+use strict;
+use Config;
+use FileHandle;
+use File::Spec;
+use Test::More;
+
+# we enable all Perl warnings, but we don't "use warnings 'all'" because
+# we want to disable the warnings generated by Sys::Syslog
+no warnings;
+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);
+
+# 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;
+
+# 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/;
+
+my $tests;
+plan tests => $tests;
+
+# 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');
+
+BEGIN { $tests += 1 }
+# check that the documented functions are correctly provided
+can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
+
+
+BEGIN { $tests += 4 }
+# check the diagnostics
+# setlogsock()
+eval { setlogsock() };
+like( $@, qr/^setlogsock\(\): Invalid number of arguments/,
+ "calling setlogsock() with no argument" );
+
+eval { setlogsock(undef) };
+like( $@, qr/^setlogsock\(\): Invalid type; must be one of /,
+ "calling setlogsock() with undef" );
+
+eval { setlogsock(\"") };
+like( $@, qr/^setlogsock\(\): Unexpected scalar reference/,
+ "calling setlogsock() with a scalar reference" );
+
+eval { setlogsock({}) };
+like( $@, qr/^setlogsock\(\): No argument given/,
+ "calling setlogsock() with an empty hash reference" );
+
+BEGIN { $tests += 3 }
+# syslog()
+eval { syslog() };
+like( $@, qr/^syslog: expecting argument \$priority/,
+ "calling syslog() with no argument" );
+
+eval { syslog(undef) };
+like( $@, qr/^syslog: expecting argument \$priority/,
+ "calling syslog() with one undef argument" );
+
+eval { syslog('') };
+like( $@, qr/^syslog: expecting argument \$format/,
+ "calling syslog() with one empty argument" );
+
+
+my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
+my $r = 0;
+
+BEGIN { $tests += 8 }
+# try to open a syslog using a Unix or stream socket
+SKIP: {
+ skip "can't connect to Unix socket: _PATH_LOG unavailable", 8
+ unless -e Sys::Syslog::_PATH_LOG();
+
+ # The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
+ # but assuming 'stream' in SVR4 is probably not that bad.
+ my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
+
+ eval { setlogsock($sock_type) };
+ is( $@, '', "setlogsock() called with '$sock_type'" );
+ TODO: {
+ local $TODO = "minor bug";
+ SKIP: { skip "TODO $TODO", 1 if $] < 5.006002;
+ ok( $r, "setlogsock() should return true: '$r'" );
+ }
+ }
+
+
+ # open syslog with a "local0" facility
+ SKIP: {
+ # openlog()
+ $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
+ skip "can't connect to syslog", 6 if $@ =~ /^no connection to syslog available/;
+ is( $@, '', "openlog() called with facility 'local0'" );
+ ok( $r, "openlog() should return true: '$r'" );
+
+ # syslog()
+ $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
+ is( $@, '', "syslog() called with level 'info'" );
+ ok( $r, "syslog() should return true: '$r'" );
+
+ # closelog()
+ $r = eval { closelog() } || 0;
+ is( $@, '', "closelog()" );
+ ok( $r, "closelog() should return true: '$r'" );
+ }
+}
+
+# try to open a syslog using all the available connection methods
+# handle other connections in t/syslog.t
+
+my @passed = ();
+
+BEGIN { $tests += 22 * 2 }
+for my $sock_type (qw(inet udp)) {
+ SKIP: {
+ 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", 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", 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", 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", 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'" );
+
+ # 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: /', "[$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'" );
+ 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/', "[$sock_type] syslog() called with level 'local0,local1'" );
+ 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") } || 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
+ { 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'" );
+
+ push @passed, $sock_type;
+
+ SKIP: {
+ skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
+ # closelog()
+ $r = eval { closelog() } || 0;
+ is( $@, '', "[$sock_type] closelog()" );
+ ok( $r, "[$sock_type] closelog() should return true: '$r'" );
+ }
+ }
+}
+
+
+
diff --git a/cpan/Sys-Syslog/t/syslog.t b/cpan/Sys-Syslog/t/syslog.t
index 92af0c7f1c..6802ace665 100644
--- a/cpan/Sys-Syslog/t/syslog.t
+++ b/cpan/Sys-Syslog/t/syslog.t
@@ -102,6 +102,7 @@ SKIP: {
}
}
+
# open syslog with a "local0" facility
SKIP: {
# openlog()
@@ -122,15 +123,16 @@ SKIP: {
}
}
-
-BEGIN { $tests += 22 * 8 }
# try to open a syslog using all the available connection methods
+# handle inet and udp in a separate test file
+
my @passed = ();
-for my $sock_type (qw(native eventlog unix pipe stream inet tcp udp)) {
+
+BEGIN { $tests += 22 * 6 }
+for my $sock_type (qw(native eventlog unix pipe stream tcp )) {
SKIP: {
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", 22 unless $r;
@@ -199,7 +201,6 @@ for my $sock_type (qw(native eventlog unix pipe stream inet tcp udp)) {
}
}
-
BEGIN { $tests += 10 }
SKIP: {
skip "not testing setlogsock('stream') on Win32", 10 if $is_Win32;