diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2019-10-22 01:08:30 +0100 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2019-10-22 01:08:30 +0100 |
commit | 10934390253ed18c48f144735ad3c6a508caabc1 (patch) | |
tree | 3fcad4d4775b19591ecf09dc31fbdb79c51fba3b /cpan | |
parent | 9e337eb6c8f2d075b72c1c7ca6d12a0a1c05ff42 (diff) | |
download | perl-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/.gitignore | 10 | ||||
-rw-r--r-- | cpan/Sys-Syslog/Syslog.pm | 4 | ||||
-rw-r--r-- | cpan/Sys-Syslog/t/cpan-rt-21516.t | 14 | ||||
-rw-r--r-- | cpan/Sys-Syslog/t/cpan-rt-21866.t | 16 | ||||
-rw-r--r-- | cpan/Sys-Syslog/t/cpan-rt-25488.t | 17 | ||||
-rw-r--r-- | cpan/Sys-Syslog/t/cpan-rt-49877.pl | 19 | ||||
-rw-r--r-- | cpan/Sys-Syslog/t/cpan-rt-55151.t | 19 | ||||
-rw-r--r-- | cpan/Sys-Syslog/t/cpan-rt-64287.t | 29 | ||||
-rw-r--r-- | cpan/Sys-Syslog/t/syslog-inet-udp.t | 205 | ||||
-rw-r--r-- | cpan/Sys-Syslog/t/syslog.t | 11 |
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; |