- use a better BuildRoot - drop a redundant mkdir in %%install - call patchlevel.h only once; rm patchlevel.bak - update modules Sys::Syslog, Module::Load::Conditional, Module::CoreList, Test::Harness, Test::Simple, CGI.pm (dropping the upstreamed patch), File::Path (that includes our perl-5.10.0-CVE-2008-2827.patch), constant, Pod::Simple, Archive::Tar, Archive::Extract, File::Fetch, File::Temp, IPC::Cmd, Time::HiRes, Module::Build, ExtUtils::CBuilder - standardize the patches for updating embedded modules - work around a bug in Module::Build tests bu setting TMPDIR to a directory inside the source tree
966 lines
34 KiB
Diff
966 lines
34 KiB
Diff
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 <sebastien@aperghis.net>',
|
|
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<setlogsock($sock_type, $stream_location)> (added in Perl 5.004_02)
|
|
|
|
+=item B<setlogsock($sock_type, $stream_location, $sock_timeout)> (added in 0.25)
|
|
+
|
|
Sets the socket type to be used for the next call to
|
|
C<openlog()> or C<syslog()> and returns true on success,
|
|
C<undef> on failure. The available mechanisms are:
|
|
@@ -984,15 +1044,18 @@
|
|
=item *
|
|
|
|
C<"tcp"> - connect to a TCP socket, on the C<syslog/tcp> or C<syslogng/tcp>
|
|
-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<syslog/udp> 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<native>, C<tcp>, C<udp>, C<unix>, C<stream>, C<console>.
|
|
+The default is to try C<native>, C<tcp>, C<udp>, C<unix>, C<pipe>, C<stream>,
|
|
+C<console>.
|
|
Under systems with the Win32 API, C<eventlog> will be added as the first
|
|
mechanism to try if C<Win32::EventLog> 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<http://www.gnu.org/software/libc/manual/html_node/Syslog.html>
|
|
|
|
Solaris 10 documentation on syslog,
|
|
-L<http://docs.sun.com/app/docs/doc/816-5168/6mbb3hruo?a=view>
|
|
+L<http://docs.sun.com/app/docs/doc/816-5168/syslog-3c?a=view>
|
|
|
|
-IRIX 6.4 documentation on syslog,
|
|
-L<http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=0640&db=man&fname=3c+syslog>
|
|
+Mac OS X documentation on syslog,
|
|
+L<http://developer.apple.com/documentation/Darwin/Reference/ManPages/man3/syslog.3.html>
|
|
+
|
|
+IRIX 6.5 documentation on syslog,
|
|
+L<http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=0650&db=man&fname=3c+syslog>
|
|
|
|
AIX 5L 5.3 documentation on syslog,
|
|
L<http://publib.boulder.ibm.com/infocenter/pseries/v5r3/index.jsp?topic=/com.ibm.aix.basetechref/doc/basetrf2/syslog.htm>
|
|
|
|
HP-UX 11i documentation on syslog,
|
|
-L<http://docs.hp.com/en/B9106-90010/syslog.3C.html>
|
|
+L<http://docs.hp.com/en/B2355-60130/syslog.3C.html>
|
|
|
|
Tru64 5.1 documentation on syslog,
|
|
L<http://h30097.www3.hp.com/docs/base_doc/DOCUMENTATION/V51_HTML/MAN/MAN3/0193____.HTM>
|
|
@@ -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<http://www.openss7.org/streams.html>
|
|
+
|
|
II12021: SYSLOGD HOWTO TCPIPINFO (z/OS, OS/390, MVS)
|
|
- L<http://www-1.ibm.com/support/docview.wss?uid=isg1II12021>
|
|
|
|
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 <windows.h>
|
|
+#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 <syslog.h>
|
|
-#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 <syslog.h>
|
|
+# 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" );
|