# 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)
# call syslog() with a string priority and a list of printf() args
# usage: require 'syslog.pl';
# then (put these all in a script to test function)
# do openlog($program,'cons,pid','user');
# do syslog('info','this is another test');
# do syslog('mail|warning','this is a better test: %d', time);
# do syslog('debug','this is the last test');
# do openlog("$program $$",'ndelay','user');
# do syslog('notice','fooprogram: this is really done');
# do syslog('info','problem was %m'); # %m == $! in syslog(3)
$host = 'localhost' unless $host; # set $syslog'host to change
if ($] >= 5 && warnings
::enabled
()) {
warnings
::warn("You should 'use Sys::Syslog' instead; continuing");
eval { require "socket.ph" } ||
$maskpri = &LOG_UPTO
(&LOG_DEBUG
);
($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/;
local($oldmask) = $maskpri;
local($priority) = shift;
local($message, $whoami);
local(@words, $num, $numpri, $numfac, $sum);
local($facility) = $facility; # may need to change temporarily.
die "syslog: expected both priority and mask" unless $mask && $priority;
@words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
$num = &xlate
($_); # Translate word to number.
if (/^kern$/ || $num < 0) {
die "syslog: invalid level/facility: $_\n";
elsif ($num <= &LOG_PRIMASK
) {
die "syslog: too many levels given: $_\n" if defined($numpri);
return 0 unless &LOG_MASK
($numpri) & $maskpri;
die "syslog: too many facilities given: $_\n" if defined($numfac);
die "syslog: level must be given\n" unless defined($numpri);
if (!defined($numfac)) { # Facility not specified in this call.
$facility = 'user' unless $facility;
$numfac = &xlate
($facility);
&connect unless $connected;
if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
($whoami = getpwuid($<)) ||
$whoami .= "[$$]" if $lo_pid;
$mask .= "\n" unless $mask =~ /\n$/;
$message = sprintf ($mask, @_);
$sum = $numpri + $numfac;
unless (send(SYSLOG
,"<$sum>$whoami: $message",0)) {
do {$died = wait;} until $died == $pid || $died < 0;
open(CONS
,">/dev/console");
print CONS
"<$facility.$priority>$whoami: $message\r";
exit if defined $pid; # if fork failed, we're parent
$name = "LOG_$name" unless $name =~ /^LOG_/;
defined &$name ?
&$name : -1;
($name,$aliases,$proto) = getprotobyname('udp');
($name,$aliases,$port,$proto) = getservbyname('syslog','udp');
if (chop($myname = `hostname`)) {
($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
die "Can't lookup $myname\n" unless $name;
@bytes = unpack("C4",$addrs[0]);
$this = pack($pat, $af_inet, 0, @bytes);
@bytes = split(/\./,$host);
($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
die "Can't lookup $host\n" unless $name;
@bytes = unpack("C4",$addrs[0]);
$that = pack($pat,$af_inet,$syslog,@bytes);
socket(SYSLOG
,$af_inet,$datagram,$udp) || die "socket: $!\n";
bind(SYSLOG
,$this) || die "bind: $!\n";
connect(SYSLOG
,$that) || die "connect: $!\n";
local($old) = select(SYSLOG
); $| = 1; select($old);