1N/A#
1N/A# syslog.pl
1N/A#
1N/A# $Log: syslog.pl,v $
1N/A#
1N/A# tom christiansen <tchrist@convex.com>
1N/A# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
1N/A# NOTE: openlog now takes three arguments, just like openlog(3)
1N/A#
1N/A# call syslog() with a string priority and a list of printf() args
1N/A# like syslog(3)
1N/A#
1N/A# usage: require 'syslog.pl';
1N/A#
1N/A# then (put these all in a script to test function)
1N/A#
1N/A#
1N/A# do openlog($program,'cons,pid','user');
1N/A# do syslog('info','this is another test');
1N/A# do syslog('mail|warning','this is a better test: %d', time);
1N/A# do closelog();
1N/A#
1N/A# do syslog('debug','this is the last test');
1N/A# do openlog("$program $$",'ndelay','user');
1N/A# do syslog('notice','fooprogram: this is really done');
1N/A#
1N/A# $! = 55;
1N/A# do syslog('info','problem was %m'); # %m == $! in syslog(3)
1N/A
1N/Apackage syslog;
1N/A
1N/Ause warnings::register;
1N/A
1N/A$host = 'localhost' unless $host; # set $syslog'host to change
1N/A
1N/Aif ($] >= 5 && warnings::enabled()) {
1N/A warnings::warn("You should 'use Sys::Syslog' instead; continuing");
1N/A}
1N/A
1N/Arequire 'syslog.ph';
1N/A
1N/A eval 'use Socket; 1' ||
1N/A eval { require "socket.ph" } ||
1N/A require "sys/socket.ph";
1N/A
1N/A$maskpri = &LOG_UPTO(&LOG_DEBUG);
1N/A
1N/Asub main'openlog {
1N/A ($ident, $logopt, $facility) = @_; # package vars
1N/A $lo_pid = $logopt =~ /\bpid\b/;
1N/A $lo_ndelay = $logopt =~ /\bndelay\b/;
1N/A $lo_cons = $logopt =~ /\bcons\b/;
1N/A $lo_nowait = $logopt =~ /\bnowait\b/;
1N/A &connect if $lo_ndelay;
1N/A}
1N/A
1N/Asub main'closelog {
1N/A $facility = $ident = '';
1N/A &disconnect;
1N/A}
1N/A
1N/Asub main'setlogmask {
1N/A local($oldmask) = $maskpri;
1N/A $maskpri = shift;
1N/A $oldmask;
1N/A}
1N/A
1N/Asub main'syslog {
1N/A local($priority) = shift;
1N/A local($mask) = shift;
1N/A local($message, $whoami);
1N/A local(@words, $num, $numpri, $numfac, $sum);
1N/A local($facility) = $facility; # may need to change temporarily.
1N/A
1N/A die "syslog: expected both priority and mask" unless $mask && $priority;
1N/A
1N/A @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
1N/A undef $numpri;
1N/A undef $numfac;
1N/A foreach (@words) {
1N/A $num = &xlate($_); # Translate word to number.
1N/A if (/^kern$/ || $num < 0) {
1N/A die "syslog: invalid level/facility: $_\n";
1N/A }
1N/A elsif ($num <= &LOG_PRIMASK) {
1N/A die "syslog: too many levels given: $_\n" if defined($numpri);
1N/A $numpri = $num;
1N/A return 0 unless &LOG_MASK($numpri) & $maskpri;
1N/A }
1N/A else {
1N/A die "syslog: too many facilities given: $_\n" if defined($numfac);
1N/A $facility = $_;
1N/A $numfac = $num;
1N/A }
1N/A }
1N/A
1N/A die "syslog: level must be given\n" unless defined($numpri);
1N/A
1N/A if (!defined($numfac)) { # Facility not specified in this call.
1N/A $facility = 'user' unless $facility;
1N/A $numfac = &xlate($facility);
1N/A }
1N/A
1N/A &connect unless $connected;
1N/A
1N/A $whoami = $ident;
1N/A
1N/A if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
1N/A $whoami = $1;
1N/A $mask = $2;
1N/A }
1N/A
1N/A unless ($whoami) {
1N/A ($whoami = getlogin) ||
1N/A ($whoami = getpwuid($<)) ||
1N/A ($whoami = 'syslog');
1N/A }
1N/A
1N/A $whoami .= "[$$]" if $lo_pid;
1N/A
1N/A $mask =~ s/%m/$!/g;
1N/A $mask .= "\n" unless $mask =~ /\n$/;
1N/A $message = sprintf ($mask, @_);
1N/A
1N/A $sum = $numpri + $numfac;
1N/A unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
1N/A if ($lo_cons) {
1N/A if ($pid = fork) {
1N/A unless ($lo_nowait) {
1N/A do {$died = wait;} until $died == $pid || $died < 0;
1N/A }
1N/A }
1N/A else {
1N/A open(CONS,">/dev/console");
1N/A print CONS "<$facility.$priority>$whoami: $message\r";
1N/A exit if defined $pid; # if fork failed, we're parent
1N/A close CONS;
1N/A }
1N/A }
1N/A }
1N/A}
1N/A
1N/Asub xlate {
1N/A local($name) = @_;
1N/A $name = uc $name;
1N/A $name = "LOG_$name" unless $name =~ /^LOG_/;
1N/A $name = "syslog'$name";
1N/A defined &$name ? &$name : -1;
1N/A}
1N/A
1N/Asub connect {
1N/A $pat = 'S n C4 x8';
1N/A
1N/A $af_unix = &AF_UNIX;
1N/A $af_inet = &AF_INET;
1N/A
1N/A $stream = &SOCK_STREAM;
1N/A $datagram = &SOCK_DGRAM;
1N/A
1N/A ($name,$aliases,$proto) = getprotobyname('udp');
1N/A $udp = $proto;
1N/A
1N/A ($name,$aliases,$port,$proto) = getservbyname('syslog','udp');
1N/A $syslog = $port;
1N/A
1N/A if (chop($myname = `hostname`)) {
1N/A ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
1N/A die "Can't lookup $myname\n" unless $name;
1N/A @bytes = unpack("C4",$addrs[0]);
1N/A }
1N/A else {
1N/A @bytes = (0,0,0,0);
1N/A }
1N/A $this = pack($pat, $af_inet, 0, @bytes);
1N/A
1N/A if ($host =~ /^\d+\./) {
1N/A @bytes = split(/\./,$host);
1N/A }
1N/A else {
1N/A ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
1N/A die "Can't lookup $host\n" unless $name;
1N/A @bytes = unpack("C4",$addrs[0]);
1N/A }
1N/A $that = pack($pat,$af_inet,$syslog,@bytes);
1N/A
1N/A socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
1N/A bind(SYSLOG,$this) || die "bind: $!\n";
1N/A connect(SYSLOG,$that) || die "connect: $!\n";
1N/A
1N/A local($old) = select(SYSLOG); $| = 1; select($old);
1N/A $connected = 1;
1N/A}
1N/A
1N/Asub disconnect {
1N/A close SYSLOG;
1N/A $connected = 0;
1N/A}
1N/A
1N/A1;