Revision history for Sys-Syslog
-0.13 2006.01.11
+0.14 -- 2006.05.25 -- Sebastien Aperghis-Tramoni (SAPER)
+ [BUGFIX] RT#19259, RT#17518: Now allowing all levels and facilities.
+ [CODE] Removed useless "&".
+ [CODE] Improved readability by adding empty lines and reworking the
+ code here and there.
+ [CODE] Added new macros from Mac OS X.
+ [TESTS] Added more tests in order to increase coverage.
+ [DOC] RT#19085: Corrected errors in the documentation for setlogmask().
+ [DOC] Added several links to online manual pages, RFCs and articles.
+ [DOC] Corrected minor things in Changes.
+
+0.13 -- 2006.01.11 -- Sebastien Aperghis-Tramoni (SAPER)
+ [CODE] Applied Gisle Aas patch for a better handling of error messages,
+ then optimized it.
[CODE] Merged blead@26768: If getservbyname fails tell what service
the lookup attempt tried to use.
[CODE] Merged blead@26769: suppress Sys::Hostname usage and directly
[CODE] Merged blead@26773: check that $syslog_path is a socket.
[TESTS] RT#16980 (Alan Burlison): Sys::Syslog blows up rather
spectacularly on Solaris. Corrected by previous patches.
- [TESTS] Applied Gisle Aas patch for a better handling of error messages,
- then optimized it.
[TESTS] RT#16974: Failed test in t/podspell. This test is now skipped.
-0.12 2006.01.07
- [CODE] Merged some modifications from bleadperl.
+0.12 -- 2006.01.07 -- Sebastien Aperghis-Tramoni (SAPER)
[DOC] Added a link to an article about Sys::Syslog.
+ [TESTS] Merged some modifications from bleadperl.
[TESTS] Removed optional dependency on Test::Exception.
[TESTS] Improved t/constant.t
[TESTS] Rewrote t/constants.t because future versions of
ExtUtils::Constant will prevent the constant() function from
being directly called.
-0.11 2005.12.28
+0.11 -- 2005.12.28 -- Sebastien Aperghis-Tramoni (SAPER)
[BUGFIX] setlogmask() now behaves like its C counterpart.
- [CODE] Can now export and use the macros.
- [CODE] Support for three Exporter tags.
- [CODE] XSLoader is now optional.
+ [FEATURE] Can now export and use the macros.
+ [FEATURE] Support for three Exporter tags.
+ [FEATURE] XSLoader is now optional.
[CODE] No longer "use"s Sys::Hostname as it was "require"d where needed.
[CODE] RT#16604: Use local timestamp.
- [DIST] Merged change from blead@26343
+ [DIST] Merged blead@26343: Fix realclean target.
[DOC] Improved documentation.
[TESTS] Added more tests to t/syslog.t in order to increase code coverage.
-0.10 2005.12.08
+0.10 -- 2005.12.08 -- Sebastien Aperghis-Tramoni (SAPER)
[DOC] Improved documentation.
[TESTS] Added -T to t/syslog.t
[TESTS] Added t/constants.t to check the macros.
[TESTS] Added t/distchk.t, t/podspell.t, t/podcover.t, t/portfs.t
-0.09 2005.12.06
+0.09 -- 2005.12.06 -- Sebastien Aperghis-Tramoni (SAPER)
[CODE] Now setlogsock() really croak(), as documented.
[DIST] CPANized from blead@26281.
[DIST] Modified Makefile.PL so that ExtUtils::Constant is conditionaly
+use strict;
use ExtUtils::MakeMaker;
eval 'use ExtUtils::MakeMaker::Coverage';
require 5.006;
WriteMakefile(
NAME => 'Sys::Syslog',
+ LICENSE => 'perl',
VERSION_FROM => 'Syslog.pm',
ABSTRACT_FROM => 'Syslog.pm',
INSTALLDIRS => 'perl',
XSPROTOARG => '-noprototypes',
PREREQ_PM => {
'Test::More' => 0,
- 'XSLoader' => 0,
+ 'XSLoader' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Sys-Syslog-*' },
my $_PATH_LOG;
-if (-S "/dev/log" && -w "/dev/log") {
+if (-S "/dev/log" and -w "/dev/log") {
# Most unixes have a unix domain socket /dev/log.
$_PATH_LOG = "/dev/log";
-} elsif (-c "/dev/conslog" && -w "/dev/conslog") {
+} elsif (-c "/dev/conslog" and -w "/dev/conslog") {
# SunOS 5.8 has a worldwritable /dev/conslog STREAMS log driver.
# The /dev/log STREAMS log driver on this platform has permissions
# and ownership `crw-r----- root sys'. /dev/conslog has more liberal
close(MACROS);
} else {
- use File::Copy;
- use File::Spec;
+ require File::Copy;
+ require File::Spec;
foreach my $file ('const-c.inc', 'const-xs.inc') {
my $fallback = File::Spec->catfile('fallback', $file);
- copy ($fallback, $file) or die "Can't copy $fallback to $ $!";
+ File::Copy::copy($fallback, $file) or die "Can't copy $fallback to $ $!";
}
}
package Sys::Syslog;
use strict;
use Carp;
+use POSIX qw(strftime setlocale LC_TIME);
+use Socket ':all';
require 5.006;
require Exporter;
-our $VERSION = '0.13';
+our $VERSION = '0.14';
our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
LOG_MAIL LOG_NDELAY LOG_NEWS LOG_NFACILITIES LOG_NOTICE
LOG_NOWAIT LOG_ODELAY LOG_PERROR LOG_PID LOG_PRIMASK LOG_SYSLOG
LOG_USER LOG_UUCP LOG_WARNING
+ LOG_MASK LOG_UPTO
)],
);
my $fail_time = undef;
our ($connected, @fallbackMethods, $syslog_send, $host);
-use Socket ':all';
-use POSIX qw(strftime setlocale LC_TIME);
=head1 NAME
=head1 VERSION
-Version 0.13
+Version 0.14
=head1 SYNOPSIS
=item *
C<:macros> exports the symbols corresponding to most of your C<syslog(3)>
-macros. See L<"CONSTANTS"> for the supported constants and their meaning.
+macros and the C<LOG_UPTO()> and C<LOG_MASK()> functions.
+See L<"CONSTANTS"> for the supported constants and their meaning.
=back
Sets the log mask for the current process to C<$mask_priority> and
returns the old mask. If the mask argument is 0, the current log mask
is not modified. See L<"Levels"> for the list of available levels.
+You can use the C<LOG_UPTO()> function to allow all levels up to a
+given priority (but it only accept the numeric macros as arguments).
B<Examples>
Only log errors:
- setlogmask(LOG_ERR);
+ setlogmask( LOG_MASK(LOG_ERR) );
+
+Log everything except informational messages:
+
+ setlogmask( ~(LOG_MASK(LOG_INFO)) );
Log critical messages, errors and warnings:
- setlogmask(LOG_CRIT|LOG_ERR|LOG_WARNING);
+ setlogmask( LOG_MASK(LOG_CRIT) | LOG_MASK(LOG_ERR) | LOG_MASK(LOG_WARNING) );
+
+Log all messages up to debug:
+
+ setlogmask( LOG_UPTO(LOG_DEBUG) );
=item B<setlogsock($sock_type)>
indicated by the pathname provided as the optional second parameter.
(For example Solaris and IRIX require C<"stream"> instead of C<"unix">.)
A value of C<"inet"> will connect to an INET socket (either C<tcp> or C<udp>,
-tried in that order) returned by C<getservbyname()>. C<"tcp"> and C<"udp"> can
-also be given as values. The value C<"console"> will send messages
+tried in that order) returned by C<getservbyname()>. C<"tcp"> and C<"udp">
+can also be given as values. The value C<"console"> will send messages
directly to the console, as for the C<"cons"> option in the logopts in
C<openlog()>.
setlogsock('inet');
$! = 55;
- syslog('info', 'problem was %m'); # %m == $! in syslog(3)
+ syslog('info', 'problem was %m'); # %m == $! in syslog(3)
+
+Log to UDP port on C<$remotehost> instead of logging locally:
- # Log to UDP port on $remotehost instead of logging locally
setlogsock('udp');
$Sys::Syslog::host = $remotehost;
openlog($program, 'ndelay', 'user');
=item syslog: invalid level/facility: %s
-B<(F)> You specified an invalid level or facility, like C<LOG_KERN>
-(which is reserved to the kernel).
+B<(F)> You specified an invalid level or facility.
=item syslog: too many levels given: %s
L<syslog(3)>
+SUSv3 issue 6, IEEE Std 1003.1, 2004 edition,
+L<http://www.opengroup.org/onlinepubs/000095399/basedefs/syslog.h.html>
+
+GNU C Library documentation on syslog,
+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>
+
+AIX 5L 5.3 documentation on syslog,
+L<http://publib.boulder.ibm.com/infocenter/pseries/v5r3/index.jsp?topic=/com.ibm.aix.doc/libs/basetrf2/syslog.htm>
+
+HP-UX 11i documentation on syslog,
+L<http://docs.hp.com/en/B9106-90010/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>
+
+Stratus VOS 15.1,
+L<http://stratadoc.stratus.com/vos/15.1.1/r502-01/wwhelp/wwhimpl/js/html/wwhelp.htm?context=r502-01&file=ch5r502-01bi.html>
+
+I<RFC 3164 - The BSD syslog Protocol>, L<http://www.faqs.org/rfcs/rfc3164.html>
+-- Please note that this is an informational RFC, and therefore does not
+specify a standard of any kind.
+
+I<RFC 3195 - Reliable Delivery for syslog>, L<http://www.faqs.org/rfcs/rfc3195.html>
+
I<Syslogging with Perl>, L<http://lexington.pm.org/meetings/022001.html>
-=head1 AUTHOR
+=head1 AUTHORS
Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall
E<lt>F<larry@wall.org>E<gt>.
=item * Search CPAN
-L<http://search.cpan.org/dist/Sys-Syslog>
+L<http://search.cpan.org/dist/Sys-Syslog/>
+
+=item * Kobes' CPAN Search
+
+L<http://cpan.uwinnipeg.ca/dist/Sys-Syslog>
+
+=item * Perl Documentation
+
+L<http://perldoc.perl.org/Sys/Syslog.html>
=back
my $constname;
our $AUTOLOAD;
($constname = $AUTOLOAD) =~ s/.*:://;
- croak "&Sys::Syslog::constant not defined" if $constname eq 'constant';
+ croak "Sys::Syslog::constant() not defined" if $constname eq 'constant';
my ($error, $val) = constant($constname);
croak $error if $error;
no strict 'refs';
bootstrap Sys::Syslog $VERSION;
};
-our $maskpri = &LOG_UPTO(&LOG_DEBUG);
+our $maskpri = LOG_UPTO(&LOG_DEBUG);
sub openlog {
our ($ident, $logopt, $facility) = @_; # package vars
our $lo_ndelay = $logopt =~ /\bndelay\b/;
our $lo_nowait = $logopt =~ /\bnowait\b/;
return 1 unless $lo_ndelay;
- &connect;
+ connect_log();
}
sub closelog {
our $facility = our $ident = '';
- &disconnect;
+ disconnect_log();
}
sub setlogmask {
sub setlogsock {
my $setsock = shift;
$syslog_path = shift;
- &disconnect if $connected;
+ disconnect_log() if $connected;
$transmit_ok = 0;
@fallbackMethods = ();
@connectMethods = @defaultMethods;
+
if (ref $setsock eq 'ARRAY') {
@connectMethods = @$setsock;
+
} elsif (lc($setsock) eq 'stream') {
unless (defined $syslog_path) {
my @try = qw(/dev/log /dev/conslog);
} else {
@connectMethods = ( 'stream' );
}
+
} elsif (lc($setsock) eq 'unix') {
if (length _PATH_LOG() && !defined $syslog_path) {
$syslog_path = _PATH_LOG();
carp 'unix passed to setlogsock, but path not available';
return undef;
}
+
} elsif (lc($setsock) eq 'tcp') {
if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) {
@connectMethods = ( 'tcp' );
carp "tcp passed to setlogsock, but tcp service unavailable";
return undef;
}
+
} elsif (lc($setsock) eq 'udp') {
if (getservbyname('syslog', 'udp')) {
@connectMethods = ( 'udp' );
carp "udp passed to setlogsock, but udp service unavailable";
return undef;
}
+
} elsif (lc($setsock) eq 'inet') {
@connectMethods = ( 'tcp', 'udp' );
+
} elsif (lc($setsock) eq 'console') {
@connectMethods = ( 'console' );
+
} else {
croak "Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'"
}
+
return 1;
}
@words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
undef $numpri;
undef $numfac;
+
foreach (@words) {
- $num = &xlate($_); # Translate word to number.
- if ($_ eq 'kern' || $num <= 0) {
+ $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;
+ return 0 unless LOG_MASK($numpri) & $maskpri;
}
else {
croak "syslog: too many facilities given: $_" if defined($numfac);
if (!defined($numfac)) { # Facility not specified in this call.
$facility = 'user' unless $facility;
- $numfac = &xlate($facility);
+ $numfac = xlate($facility);
}
- &connect unless $connected;
+ connect_log() unless $connected;
$whoami = our $ident;
}
unless ($whoami) {
- ($whoami = getlogin) ||
- ($whoami = getpwuid($<)) ||
- ($whoami = 'syslog');
+ $whoami = getlogin() || getpwuid($<) || 'syslog';
}
$whoami .= "[$$]" if our $lo_pid;
if ($failed && (time - $fail_time) > 60) {
# it's been a while... maybe things have been fixed
@fallbackMethods = ();
- disconnect();
+ disconnect_log();
$transmit_ok = 0; # make it look like a fresh attempt
- &connect;
+ connect_log();
}
+
if ($connected && !connection_ok()) {
# Something was OK, but has now broken. Remember coz we'll
# want to go back to what used to be OK.
$failed = $current_proto unless $failed;
$fail_time = time;
- disconnect();
+ disconnect_log();
}
- &connect unless $connected;
+
+ connect_log() unless $connected;
$failed = undef if ($current_proto && $failed && $current_proto eq $failed);
+
if ($syslog_send) {
- if (&{$syslog_send}($buf)) {
+ if ($syslog_send->($buf)) {
$transmit_ok++;
return 1;
}
# typically doesn't happen, since errors are rare from write().
- disconnect();
+ disconnect_log();
}
}
# could not send, could not fallback onto a working
#return send(SYSLOG, $buf, 0);
}
+# xlate()
+# -----
+# private function to translate names to numeric values
+#
sub xlate {
my($name) = @_;
return $name+0 if $name =~ /^\s*\d+\s*$/;
defined $value ? $value : -1;
}
-sub connect {
+sub connect_log {
@fallbackMethods = @connectMethods unless (scalar @fallbackMethods);
if ($transmit_ok && $current_proto) {
# Retry what we were on, because it's worked in the past.
}
setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1);
setsockopt(SYSLOG, IPPROTO_TCP, TCP_NODELAY, 1);
- if (!CORE::connect(SYSLOG,$that)) {
+ if (!connect(SYSLOG,$that)) {
push(@{$errs}, "tcp connect: $!");
return 0;
}
push(@{$errs}, "udp socket: $!");
return 0;
}
- if (!CORE::connect(SYSLOG,$that)) {
+ if (!connect(SYSLOG,$that)) {
push(@{$errs}, "udp connect: $!");
return 0;
}
push(@{$errs}, "unix stream socket: $!");
return 0;
}
- if (!CORE::connect(SYSLOG,$that)) {
+ if (!connect(SYSLOG,$that)) {
if (!socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0)) {
push(@{$errs}, "unix dgram socket: $!");
return 0;
}
- if (!CORE::connect(SYSLOG,$that)) {
+ if (!connect(SYSLOG,$that)) {
push(@{$errs}, "unix dgram connect: $!");
return 0;
}
return ($ret ? 0 : 1);
}
-sub disconnect {
+sub disconnect_log {
$connected = 0;
$syslog_send = undef;
return close SYSLOG;
constant_7 (pTHX_ const char *name, IV *iv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
- LOG_ERR LOG_FTP LOG_LPR LOG_PID */
+ LOG_ERR LOG_FTP LOG_LPR LOG_PID LOG_RAS */
/* Offset 4 gives the best switch position. */
switch (name[4]) {
case 'E':
#endif
}
break;
+ case 'R':
+ if (memEQ(name, "LOG_RAS", 7)) {
+ /* ^ */
+#ifdef LOG_RAS
+ *iv_return = LOG_RAS;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
}
return PERL_constant_NOTFOUND;
}
*pv_return = _PATH_LOG;
return PERL_constant_ISPV;
#else
- *pv_return = "/dev/log";
+ *pv_return = "";
return PERL_constant_ISPV;
#endif
}
constant_11 (pTHX_ const char *name, IV *iv_return) {
/* When generated this function returned values for the list of names given
here. However, subsequent manual editing may have added or removed some.
- LOG_FACMASK LOG_PRIMASK LOG_WARNING */
- /* Offset 6 gives the best switch position. */
- switch (name[6]) {
- case 'C':
+ LOG_FACMASK LOG_INSTALL LOG_LAUNCHD LOG_NETINFO LOG_PRIMASK LOG_WARNING */
+ /* Offset 4 gives the best switch position. */
+ switch (name[4]) {
+ case 'F':
if (memEQ(name, "LOG_FACMASK", 11)) {
- /* ^ */
+ /* ^ */
#ifdef LOG_FACMASK
*iv_return = LOG_FACMASK;
return PERL_constant_ISIV;
}
break;
case 'I':
+ if (memEQ(name, "LOG_INSTALL", 11)) {
+ /* ^ */
+#ifdef LOG_INSTALL
+ *iv_return = LOG_INSTALL;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'L':
+ if (memEQ(name, "LOG_LAUNCHD", 11)) {
+ /* ^ */
+#ifdef LOG_LAUNCHD
+ *iv_return = LOG_LAUNCHD;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'N':
+ if (memEQ(name, "LOG_NETINFO", 11)) {
+ /* ^ */
+#ifdef LOG_NETINFO
+ *iv_return = LOG_NETINFO;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
+ case 'P':
if (memEQ(name, "LOG_PRIMASK", 11)) {
- /* ^ */
+ /* ^ */
#ifdef LOG_PRIMASK
*iv_return = LOG_PRIMASK;
return PERL_constant_ISIV;
#endif
}
break;
- case 'R':
+ case 'W':
if (memEQ(name, "LOG_WARNING", 11)) {
- /* ^ */
+ /* ^ */
#ifdef LOG_WARNING
*iv_return = LOG_WARNING;
return PERL_constant_ISIV;
Regenerate these constant functions by feeding this entire source file to
perl -x
-#!/usr/bin/perl5.8.5 -w
+#!perl -w
use ExtUtils::Constant qw (constant_types C_constant XS_constant);
my $types = {map {($_, 1)} qw(IV PV)};
my @names = (qw(LOG_ALERT LOG_AUTH LOG_AUTHPRIV LOG_CONS LOG_CRIT LOG_CRON
LOG_DAEMON LOG_DEBUG LOG_EMERG LOG_ERR LOG_FACMASK LOG_FTP
- LOG_INFO LOG_KERN LOG_LFMT LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2
- LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR
- LOG_MAIL LOG_NDELAY LOG_NEWS LOG_NFACILITIES LOG_NOTICE
- LOG_NOWAIT LOG_ODELAY LOG_PERROR LOG_PID LOG_PRIMASK LOG_SYSLOG
+ LOG_INFO LOG_INSTALL LOG_KERN LOG_LAUNCHD LOG_LFMT LOG_LOCAL0
+ LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5
+ LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL LOG_NDELAY LOG_NETINFO
+ LOG_NEWS LOG_NFACILITIES LOG_NOTICE LOG_NOWAIT LOG_ODELAY
+ LOG_PERROR LOG_PID LOG_PRIMASK LOG_RAS LOG_REMOTEAUTH LOG_SYSLOG
LOG_USER LOG_UUCP LOG_WARNING),
- {name=>"_PATH_LOG", type=>"PV", default=>["PV", "\"/dev/log\""]});
+ {name=>"_PATH_LOG", type=>"PV", default=>["PV", "\"\""]});
print constant_types(); # macro defs
foreach (C_constant ("Sys::Syslog", 'constant', 'IV', $types, undef, 3, @names) ) {
#endif
}
break;
+ case 14:
+ if (memEQ(name, "LOG_REMOTEAUTH", 14)) {
+#ifdef LOG_REMOTEAUTH
+ *iv_return = LOG_REMOTEAUTH;
+ return PERL_constant_ISIV;
+#else
+ return PERL_constant_NOTDEF;
+#endif
+ }
+ break;
case 15:
if (memEQ(name, "LOG_NFACILITIES", 15)) {
#ifdef LOG_NFACILITIES
$name = $1;
my $v = eval "${callpack}::$name()";
- if(defined($v) && $v =~ /^\d+$/) {
+ if(defined $v and $v =~ /^\d+$/) {
is( $@, '', "calling the constant $name as a function" );
like( $v, '/^\d+$/', "checking that $name is a number ($v)" );
-#!/usr/bin/perl -T
+#!/usr/bin/perl -Tw
BEGIN {
if( $ENV{PERL_CORE} ) {
plan skip_all => "Socket was not build"
unless $Config{'extensions'} =~ /\bSocket\b/;
-BEGIN {
- plan tests => 119;
+my $tests;
+plan tests => $tests;
- # ok, now loads them
- eval 'use Socket';
- use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
-}
+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 += 1 }
# check the diagnostics
# setlogsock()
eval { setlogsock() };
like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/,
"calling setlogsock() with no argument" );
+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" );
+
+BEGIN { $tests += 1 }
+# setlogsock()
+eval { setlogsock() };
+like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/,
+ "calling setlogsock() with no 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
}
}
+
+BEGIN { $tests += 20 * 6 }
# try to open a syslog using all the available connection methods
for my $sock_type (qw(stream unix inet tcp udp console)) {
SKIP: {
- # setlogsock()
+ # setlogsock() called with an arrayref
$r = eval { setlogsock([$sock_type]) } || 0;
- skip "can't use '$sock_type' socket", 16 unless $r;
+ skip "can't use '$sock_type' socket", 20 unless $r;
+ is( $@, '', "setlogsock() called with ['$sock_type']" );
+ ok( $r, "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;
is( $@, '', "setlogsock() called with '$sock_type'" );
ok( $r, "setlogsock() should return true: '$r'" );
# openlog() without option NDELAY
$r = eval { openlog('perl', '', '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( $@, '', "openlog() called with facility 'local0' and without option 'ndelay'" );
ok( $r, "openlog() should return true: '$r'" );
# openlog() with the option NDELAY
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
- skip "can't connect to syslog", 12 if $@ =~ /^no connection to syslog available/;
+ skip "can't connect to syslog", 14 if $@ =~ /^no connection to syslog available/;
is( $@, '', "openlog() called with facility 'local0' with option 'ndelay'" );
ok( $r, "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: /', "syslog() called with level -1" );
+ ok( !$r, "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/', "syslog() called with level 'info,notice'" );
+ ok( !$r, "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/', "syslog() called with level 'info,notice'" );
+ ok( !$r, "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( $@, '', "syslog() called with level 'info'" );
+ $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
+ is( $@, '', "syslog() called with level 'info' (string)" );
ok( $r, "syslog() should return true: '$r'" );
# syslog() with level "info" (as a macro), should pass
- $r = eval { syslog(LOG_INFO, "$test_string by connecting to a $sock_type socket") } || 0;
- is( $@, '', "syslog() called with level 'info'" );
+ $r = eval { syslog(LOG_INFO(), "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
+ is( $@, '', "syslog() called with level 'info' (macro)" );
ok( $r, "syslog() should return true: '$r'" );
# syslog() with facility "kern" (as a string), should fail
- $r = eval { syslog('kern', "$test_string by connecting to a $sock_type socket") } || 0;
- like( $@, '/^syslog: invalid level/facility: kern/', "syslog() called with facility 'kern'" );
- ok( !$r, "syslog() should return false: '$r'" );
+ #$r = eval { syslog('kern', "$test_string by connecting to a $sock_type socket") } || 0;
+ #like( $@, '/^syslog: invalid level/facility: kern/', "syslog() called with facility 'kern'" );
+ #ok( !$r, "syslog() should return false: '$r'" );
# syslog() with facility "kern" (as a macro), should fail
- $r = eval { syslog(LOG_KERN, "$test_string by connecting to a $sock_type socket") } || 0;
- like( $@, '/^syslog: invalid level/facility: 0/', "syslog() called with facility 'kern'" );
- ok( !$r, "syslog() should return false: '$r'" );
+ #$r = eval { syslog(LOG_KERN, "$test_string by connecting to a $sock_type socket") } || 0;
+ #like( $@, '/^syslog: invalid level/facility: 0/', "syslog() called with facility 'kern'" );
+ #ok( !$r, "syslog() should return false: '$r'" );
SKIP: {
skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
}
}
+
+BEGIN { $tests += 10 }
+# setlogsock() with "stream" and an undef path
+$r = eval { setlogsock("stream", undef ) } || '';
+is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
+ok( $r, "setlogsock() should return true: '$r'" );
+
+# setlogsock() with "stream" and an empty path
+$r = eval { setlogsock("stream", '' ) } || '';
+is( $@, '', "setlogsock() called, with 'stream' and an empty path" );
+ok( !$r, "setlogsock() should return false: '$r'" );
+
+# setlogsock() with "stream" and /dev/null
+$r = eval { setlogsock("stream", '/dev/null' ) } || '';
+is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" );
+ok( $r, "setlogsock() should return true: '$r'" );
+
+# setlogsock() with "stream" and a non-existing file
+$r = eval { setlogsock("stream", 'test.log' ) } || '';
+is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" );
+ok( !$r, "setlogsock() should return false: '$r'" );
+
+# setlogsock() with "stream" and a local file
+SKIP: {
+ my $logfile = "test.log";
+ open(LOG, ">$logfile") or skip "can't create file '$logfile': $!", 2;
+ close(LOG);
+ $r = eval { setlogsock("stream", $logfile ) } || '';
+ is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" );
+ ok( $r, "setlogsock() should return true: '$r'" );
+ unlink($logfile);
+}
+
+
+BEGIN { $tests += 3 + 4 * 3 }
# setlogmask()
{
my $oldmask = 0;
is( $@, '', "setlogmask() called with a null mask (second time)" );
is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
- for my $newmask ( LOG_ERR , LOG_CRIT|LOG_ERR|LOG_WARNING ) {
+ my @masks = (
+ LOG_MASK(LOG_ERR()),
+ ~LOG_MASK(LOG_INFO()),
+ LOG_MASK(LOG_CRIT()) | LOG_MASK(LOG_ERR()) | LOG_MASK(LOG_WARNING()),
+ );
+
+ for my $newmask (@masks) {
$r = eval { setlogmask($newmask) } || 0;
is( $@, '', "setlogmask() called with a new mask" );
is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
projects / p5sagit/p5-mst-13.2.git / commitdiff