diff options
Diffstat (limited to 'contrib/perl5/ext/Sys/Syslog')
| -rw-r--r-- | contrib/perl5/ext/Sys/Syslog/Makefile.PL | 8 | ||||
| -rw-r--r-- | contrib/perl5/ext/Sys/Syslog/Syslog.pm | 302 | ||||
| -rw-r--r-- | contrib/perl5/ext/Sys/Syslog/Syslog.xs | 641 |
3 files changed, 0 insertions, 951 deletions
diff --git a/contrib/perl5/ext/Sys/Syslog/Makefile.PL b/contrib/perl5/ext/Sys/Syslog/Makefile.PL deleted file mode 100644 index e5edf3e..0000000 --- a/contrib/perl5/ext/Sys/Syslog/Makefile.PL +++ /dev/null @@ -1,8 +0,0 @@ -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'Sys::Syslog', - VERSION_FROM => 'Syslog.pm', - MAN3PODS => {}, # Pods will be built by installman. - XSPROTOARG => '-noprototypes', -); diff --git a/contrib/perl5/ext/Sys/Syslog/Syslog.pm b/contrib/perl5/ext/Sys/Syslog/Syslog.pm deleted file mode 100644 index 92b82a1..0000000 --- a/contrib/perl5/ext/Sys/Syslog/Syslog.pm +++ /dev/null @@ -1,302 +0,0 @@ -package Sys::Syslog; -require 5.000; -require Exporter; -require DynaLoader; -use Carp; - -@ISA = qw(Exporter DynaLoader); -@EXPORT = qw(openlog closelog setlogmask syslog); -@EXPORT_OK = qw(setlogsock); -$VERSION = '0.01'; - -use Socket; -use Sys::Hostname; - -# adapted from syslog.pl -# -# Tom Christiansen <tchrist@convex.com> -# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> -# NOTE: openlog now takes three arguments, just like openlog(3) -# Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu> -# with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list -# Modified to use an XS backend instead of syslog.ph by Tom Hughes <tom@compton.nu> - -# Todo: enable connect to try all three types before failing (auto setlogsock)? - -=head1 NAME - -Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls - -=head1 SYNOPSIS - - use Sys::Syslog; # all except setlogsock, or: - use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock - - setlogsock $sock_type; - openlog $ident, $logopt, $facility; - syslog $priority, $format, @args; - $oldmask = setlogmask $mask_priority; - closelog; - -=head1 DESCRIPTION - -Sys::Syslog is an interface to the UNIX C<syslog(3)> program. -Call C<syslog()> with a string priority and a list of C<printf()> args -just like C<syslog(3)>. - -Syslog provides the functions: - -=over - -=item openlog $ident, $logopt, $facility - -I<$ident> is prepended to every message. -I<$logopt> contains zero or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>. -I<$facility> specifies the part of the system - -=item syslog $priority, $format, @args - -If I<$priority> permits, logs I<($format, @args)> -printed as by C<printf(3V)>, with the addition that I<%m> -is replaced with C<"$!"> (the latest error message). - -=item setlogmask $mask_priority - -Sets log mask I<$mask_priority> and returns the old mask. - -=item setlogsock $sock_type (added in 5.004_02) - -Sets the socket type to be used for the next call to -C<openlog()> or C<syslog()> and returns TRUE on success, -undef on failure. - -A value of 'unix' will connect to the UNIX domain socket returned by the -C<_PATH_LOG> macro (if you system defines it) in F<syslog.h>. A value of -'inet' will connect to an INET socket returned by getservbyname(). If -C<_PATH_LOG> is unavailable or if getservbyname() fails, returns undef. Any -other value croaks. - -The default is for the INET socket to be used. - -=item closelog - -Closes the log file. - -=back - -Note that C<openlog> now takes three arguments, just like C<openlog(3)>. - -=head1 EXAMPLES - - openlog($program, 'cons,pid', 'user'); - syslog('info', 'this is another test'); - syslog('mail|warning', 'this is a better test: %d', time); - closelog(); - - syslog('debug', 'this is the last test'); - - setlogsock('unix'); - openlog("$program $$", 'ndelay', 'user'); - syslog('notice', 'fooprogram: this is really done'); - - setlogsock('inet'); - $! = 55; - syslog('info', 'problem was %m'); # %m == $! in syslog(3) - -=head1 SEE ALSO - -L<syslog(3)> - -=head1 AUTHOR - -Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall -E<lt>F<larry@wall.org>E<gt>. - -UNIX domain sockets added by Sean Robinson -E<lt>F<robinson_s@sc.maricopa.edu>E<gt> with support from Tim Bunce -E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and the perl5-porters mailing list. - -Dependency on F<syslog.ph> replaced with XS code by Tom Hughes -E<lt>F<tom@compton.nu>E<gt>. - -=cut - -sub AUTOLOAD { - # This AUTOLOAD is used to 'autoload' constants from the constant() - # XS function. - - my $constname; - our $AUTOLOAD; - ($constname = $AUTOLOAD) =~ s/.*:://; - croak "& not defined" if $constname eq 'constant'; - my $val = constant($constname); - if ($! != 0) { - croak "Your vendor has not defined Sys::Syslog macro $constname"; - } - *$AUTOLOAD = sub { $val }; - goto &$AUTOLOAD; -} - -bootstrap Sys::Syslog $VERSION; - -$maskpri = &LOG_UPTO(&LOG_DEBUG); - -sub openlog { - ($ident, $logopt, $facility) = @_; # package vars - $lo_pid = $logopt =~ /\bpid\b/; - $lo_ndelay = $logopt =~ /\bndelay\b/; - $lo_cons = $logopt =~ /\bcons\b/; - $lo_nowait = $logopt =~ /\bnowait\b/; - return 1 unless $lo_ndelay; - &connect; -} - -sub closelog { - $facility = $ident = ''; - &disconnect; -} - -sub setlogmask { - local($oldmask) = $maskpri; - $maskpri = shift; - $oldmask; -} - -sub setlogsock { - local($setsock) = shift; - &disconnect if $connected; - if (lc($setsock) eq 'unix') { - if (length _PATH_LOG()) { - $sock_type = 1; - } else { - return undef; - } - } elsif (lc($setsock) eq 'inet') { - if (getservbyname('syslog','udp')) { - undef($sock_type); - } else { - return undef; - } - } else { - croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'"; - } - return 1; -} - -sub syslog { - local($priority) = shift; - local($mask) = shift; - local($message, $whoami); - local(@words, $num, $numpri, $numfac, $sum); - local($facility) = $facility; # may need to change temporarily. - - croak "syslog: expected both priority and mask" unless $mask && $priority; - - @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility". - undef $numpri; - undef $numfac; - foreach (@words) { - $num = &xlate($_); # Translate word to number. - if (/^kern$/ || $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; - } - } - - croak "syslog: level must be given" unless defined($numpri); - - if (!defined($numfac)) { # Facility not specified in this call. - $facility = 'user' unless $facility; - $numfac = &xlate($facility); - } - - &connect unless $connected; - - $whoami = $ident; - - if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) { - $whoami = $1; - $mask = $2; - } - - unless ($whoami) { - ($whoami = getlogin) || - ($whoami = getpwuid($<)) || - ($whoami = 'syslog'); - } - - $whoami .= "[$$]" if $lo_pid; - - $mask =~ s/%m/$!/g; - $mask .= "\n" unless $mask =~ /\n$/; - $message = sprintf ($mask, @_); - - $sum = $numpri + $numfac; - unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) { - if ($lo_cons) { - if ($pid = fork) { - unless ($lo_nowait) { - $died = waitpid($pid, 0); - } - } - else { - if (open(CONS,">/dev/console")) { - print CONS "<$facility.$priority>$whoami: $message\r"; - close CONS; - } - exit if defined $pid; # if fork failed, we're parent - } - } - } -} - -sub xlate { - local($name) = @_; - $name = uc $name; - $name = "LOG_$name" unless $name =~ /^LOG_/; - $name = "Sys::Syslog::$name"; - eval { &$name } || -1; -} - -sub connect { - unless ($host) { - require Sys::Hostname; - my($host_uniq) = Sys::Hostname::hostname(); - ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _) - } - unless ( $sock_type ) { - my $udp = getprotobyname('udp') || croak "getprotobyname failed for udp"; - my $syslog = getservbyname('syslog','udp') || croak "getservbyname failed"; - my $this = sockaddr_in($syslog, INADDR_ANY); - my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host"); - socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!"; - connect(SYSLOG,$that) || croak "connect: $!"; - } else { - my $syslog = _PATH_LOG(); - length($syslog) || croak "_PATH_LOG unavailable in syslog.h"; - my $that = sockaddr_un($syslog) || croak "Can't locate $syslog"; - socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!"; - if (!connect(SYSLOG,$that)) { - socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0) || croak "socket: $!"; - connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)"; - } - } - local($old) = select(SYSLOG); $| = 1; select($old); - $connected = 1; -} - -sub disconnect { - close SYSLOG; - $connected = 0; -} - -1; diff --git a/contrib/perl5/ext/Sys/Syslog/Syslog.xs b/contrib/perl5/ext/Sys/Syslog/Syslog.xs deleted file mode 100644 index 31c0e84..0000000 --- a/contrib/perl5/ext/Sys/Syslog/Syslog.xs +++ /dev/null @@ -1,641 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef I_SYSLOG -#include <syslog.h> -#endif - -static double -constant_LOG_NO(char *name, int len) -{ - switch (name[6 + 0]) { - case 'T': - if (strEQ(name + 6, "TICE")) { /* LOG_NO removed */ -#ifdef LOG_NOTICE - return LOG_NOTICE; -#else - goto not_there; -#endif - } - case 'W': - if (strEQ(name + 6, "WAIT")) { /* LOG_NO removed */ -#ifdef LOG_NOWAIT - return LOG_NOWAIT; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_N(char *name, int len) -{ - switch (name[5 + 0]) { - case 'D': - if (strEQ(name + 5, "DELAY")) { /* LOG_N removed */ -#ifdef LOG_NDELAY - return LOG_NDELAY; -#else - goto not_there; -#endif - } - case 'E': - if (strEQ(name + 5, "EWS")) { /* LOG_N removed */ -#ifdef LOG_NEWS - return LOG_NEWS; -#else - goto not_there; -#endif - } - case 'F': - if (strEQ(name + 5, "FACILITIES")) { /* LOG_N removed */ -#ifdef LOG_NFACILITIES - return LOG_NFACILITIES; -#else - goto not_there; -#endif - } - case 'O': - return constant_LOG_NO(name, len); - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_P(char *name, int len) -{ - switch (name[5 + 0]) { - case 'I': - if (strEQ(name + 5, "ID")) { /* LOG_P removed */ -#ifdef LOG_PID - return LOG_PID; -#else - goto not_there; -#endif - } - case 'R': - if (strEQ(name + 5, "RIMASK")) { /* LOG_P removed */ -#ifdef LOG_PRIMASK - return LOG_PRIMASK; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_AU(char *name, int len) -{ - if (6 + 2 >= len ) { - errno = EINVAL; - return 0; - } - switch (name[6 + 2]) { - case '\0': - if (strEQ(name + 6, "TH")) { /* LOG_AU removed */ -#ifdef LOG_AUTH - return LOG_AUTH; -#else - goto not_there; -#endif - } - case 'P': - if (strEQ(name + 6, "THPRIV")) { /* LOG_AU removed */ -#ifdef LOG_AUTHPRIV - return LOG_AUTHPRIV; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_A(char *name, int len) -{ - switch (name[5 + 0]) { - case 'L': - if (strEQ(name + 5, "LERT")) { /* LOG_A removed */ -#ifdef LOG_ALERT - return LOG_ALERT; -#else - goto not_there; -#endif - } - case 'U': - return constant_LOG_AU(name, len); - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_CR(char *name, int len) -{ - switch (name[6 + 0]) { - case 'I': - if (strEQ(name + 6, "IT")) { /* LOG_CR removed */ -#ifdef LOG_CRIT - return LOG_CRIT; -#else - goto not_there; -#endif - } - case 'O': - if (strEQ(name + 6, "ON")) { /* LOG_CR removed */ -#ifdef LOG_CRON - return LOG_CRON; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_C(char *name, int len) -{ - switch (name[5 + 0]) { - case 'O': - if (strEQ(name + 5, "ONS")) { /* LOG_C removed */ -#ifdef LOG_CONS - return LOG_CONS; -#else - goto not_there; -#endif - } - case 'R': - return constant_LOG_CR(name, len); - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_D(char *name, int len) -{ - switch (name[5 + 0]) { - case 'A': - if (strEQ(name + 5, "AEMON")) { /* LOG_D removed */ -#ifdef LOG_DAEMON - return LOG_DAEMON; -#else - goto not_there; -#endif - } - case 'E': - if (strEQ(name + 5, "EBUG")) { /* LOG_D removed */ -#ifdef LOG_DEBUG - return LOG_DEBUG; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_U(char *name, int len) -{ - switch (name[5 + 0]) { - case 'S': - if (strEQ(name + 5, "SER")) { /* LOG_U removed */ -#ifdef LOG_USER - return LOG_USER; -#else - goto not_there; -#endif - } - case 'U': - if (strEQ(name + 5, "UCP")) { /* LOG_U removed */ -#ifdef LOG_UUCP - return LOG_UUCP; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_E(char *name, int len) -{ - switch (name[5 + 0]) { - case 'M': - if (strEQ(name + 5, "MERG")) { /* LOG_E removed */ -#ifdef LOG_EMERG - return LOG_EMERG; -#else - goto not_there; -#endif - } - case 'R': - if (strEQ(name + 5, "RR")) { /* LOG_E removed */ -#ifdef LOG_ERR - return LOG_ERR; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_F(char *name, int len) -{ - switch (name[5 + 0]) { - case 'A': - if (strEQ(name + 5, "ACMASK")) { /* LOG_F removed */ -#ifdef LOG_FACMASK - return LOG_FACMASK; -#else - goto not_there; -#endif - } - case 'T': - if (strEQ(name + 5, "TP")) { /* LOG_F removed */ -#ifdef LOG_FTP - return LOG_FTP; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_LO(char *name, int len) -{ - if (6 + 3 >= len ) { - errno = EINVAL; - return 0; - } - switch (name[6 + 3]) { - case '0': - if (strEQ(name + 6, "CAL0")) { /* LOG_LO removed */ -#ifdef LOG_LOCAL0 - return LOG_LOCAL0; -#else - goto not_there; -#endif - } - case '1': - if (strEQ(name + 6, "CAL1")) { /* LOG_LO removed */ -#ifdef LOG_LOCAL1 - return LOG_LOCAL1; -#else - goto not_there; -#endif - } - case '2': - if (strEQ(name + 6, "CAL2")) { /* LOG_LO removed */ -#ifdef LOG_LOCAL2 - return LOG_LOCAL2; -#else - goto not_there; -#endif - } - case '3': - if (strEQ(name + 6, "CAL3")) { /* LOG_LO removed */ -#ifdef LOG_LOCAL3 - return LOG_LOCAL3; -#else - goto not_there; -#endif - } - case '4': - if (strEQ(name + 6, "CAL4")) { /* LOG_LO removed */ -#ifdef LOG_LOCAL4 - return LOG_LOCAL4; -#else - goto not_there; -#endif - } - case '5': - if (strEQ(name + 6, "CAL5")) { /* LOG_LO removed */ -#ifdef LOG_LOCAL5 - return LOG_LOCAL5; -#else - goto not_there; -#endif - } - case '6': - if (strEQ(name + 6, "CAL6")) { /* LOG_LO removed */ -#ifdef LOG_LOCAL6 - return LOG_LOCAL6; -#else - goto not_there; -#endif - } - case '7': - if (strEQ(name + 6, "CAL7")) { /* LOG_LO removed */ -#ifdef LOG_LOCAL7 - return LOG_LOCAL7; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant_LOG_L(char *name, int len) -{ - switch (name[5 + 0]) { - case 'F': - if (strEQ(name + 5, "FMT")) { /* LOG_L removed */ -#ifdef LOG_LFMT - return LOG_LFMT; -#else - goto not_there; -#endif - } - case 'O': - return constant_LOG_LO(name, len); - case 'P': - if (strEQ(name + 5, "PR")) { /* LOG_L removed */ -#ifdef LOG_LPR - return LOG_LPR; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static double -constant(char *name, int len) -{ - errno = 0; - if (0 + 4 >= len ) { - errno = EINVAL; - return 0; - } - switch (name[0 + 4]) { - case 'A': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_A(name, len); - case 'C': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_C(name, len); - case 'D': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_D(name, len); - case 'E': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_E(name, len); - case 'F': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_F(name, len); - case 'I': - if (strEQ(name + 0, "LOG_INFO")) { /* removed */ -#ifdef LOG_INFO - return LOG_INFO; -#else - goto not_there; -#endif - } - case 'K': - if (strEQ(name + 0, "LOG_KERN")) { /* removed */ -#ifdef LOG_KERN - return LOG_KERN; -#else - goto not_there; -#endif - } - case 'L': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_L(name, len); - case 'M': - if (strEQ(name + 0, "LOG_MAIL")) { /* removed */ -#ifdef LOG_MAIL - return LOG_MAIL; -#else - goto not_there; -#endif - } - case 'N': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_N(name, len); - case 'O': - if (strEQ(name + 0, "LOG_ODELAY")) { /* removed */ -#ifdef LOG_ODELAY - return LOG_ODELAY; -#else - goto not_there; -#endif - } - case 'P': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_P(name, len); - case 'S': - if (strEQ(name + 0, "LOG_SYSLOG")) { /* removed */ -#ifdef LOG_SYSLOG - return LOG_SYSLOG; -#else - goto not_there; -#endif - } - case 'U': - if (!strnEQ(name + 0,"LOG_", 4)) - break; - return constant_LOG_U(name, len); - case 'W': - if (strEQ(name + 0, "LOG_WARNING")) { /* removed */ -#ifdef LOG_WARNING - return LOG_WARNING; -#else - goto not_there; -#endif - } - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - - -MODULE = Sys::Syslog PACKAGE = Sys::Syslog - -char * -_PATH_LOG() - CODE: -#ifdef _PATH_LOG - RETVAL = _PATH_LOG; -#else - RETVAL = ""; -#endif - OUTPUT: - RETVAL - -int -LOG_FAC(p) - INPUT: - int p - CODE: -#ifdef LOG_FAC - RETVAL = LOG_FAC(p); -#else - croak("Your vendor has not defined the Sys::Syslog macro LOG_FAC"); - RETVAL = -1; -#endif - OUTPUT: - RETVAL - -int -LOG_PRI(p) - INPUT: - int p - CODE: -#ifdef LOG_PRI - RETVAL = LOG_PRI(p); -#else - croak("Your vendor has not defined the Sys::Syslog macro LOG_PRI"); - RETVAL = -1; -#endif - OUTPUT: - RETVAL - -int -LOG_MAKEPRI(fac,pri) - INPUT: - int fac - int pri - CODE: -#ifdef LOG_MAKEPRI - RETVAL = LOG_MAKEPRI(fac,pri); -#else - croak("Your vendor has not defined the Sys::Syslog macro LOG_MAKEPRI"); - RETVAL = -1; -#endif - OUTPUT: - RETVAL - -int -LOG_MASK(pri) - INPUT: - int pri - CODE: -#ifdef LOG_MASK - RETVAL = LOG_MASK(pri); -#else - croak("Your vendor has not defined the Sys::Syslog macro LOG_MASK"); - RETVAL = -1; -#endif - OUTPUT: - RETVAL - -int -LOG_UPTO(pri) - INPUT: - int pri - CODE: -#ifdef LOG_UPTO - RETVAL = LOG_UPTO(pri); -#else - croak("Your vendor has not defined the Sys::Syslog macro LOG_UPTO"); - RETVAL = -1; -#endif - OUTPUT: - RETVAL - - -double -constant(sv) - PREINIT: - STRLEN len; - INPUT: - SV * sv - char * s = SvPV(sv, len); - CODE: - RETVAL = constant(s,len); - OUTPUT: - RETVAL - |
