InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/languages/perl/scripts-osu/syslog.shar

Internet Message Format | 1990-03-13 | 5.1 KB

Path: tut.cis.ohio-state.edu!ucbvax!decwrl!elroy.jpl.nasa.gov!jpl-devvax!lwall
From: [e-mail] (Larry Wall)
Newsgroups: comp.lang.perl
Subject: Re: openlog(3), syslog(3) in perl
Message-ID: <[e-mail]>
Date: 15 Mar 90 02:03:51 GMT
References: <[e-mail]>
Reply-To: [e-mail] (Larry Wall)
Organization: Jet Propulsion Laboratory, Pasadena, CA
Lines: 179

In article <[e-mail]> [e-mail] (Erik E. Fair) writes:
: Has anybody duplicated these routines for perl 3.0 yet, in such a
: manner that you don't have to spawn a process for every line you log
: (i.e. that hack I saw already isn't acceptable)?
:
:     trolling for wheels that are already 'round,
:
:     Erik E. Fair    apple!fair    [e-mail]
:
: P.S.    I'm not a perl hacker (yet).

Little does he know the insidious nature of the malady...  :-)

Here's a warmed-over version of Tom's syslog.pl.  It talks to the inet
socket of syslogd.  (There is, in fact, a hidden option to log to a different
machine.)  It also purports to support the logopt flags of openlog, though
some of them haven't been tested.  I won't claim the wheel's round yet,
but it's getting closer.

Larry

#!/bin/sh
: make a subdirectory, cd to it, and run this through sh.
echo 'If this kit is complete, "End of kit" will echo at the end'
echo Extracting syslog.pl
sed >syslog.pl <<'!STUFFY!FUNK!' -e 's/X//'
X#
X# syslog.pl
X#
X# tom christiansen <[e-mail]>
X# modified to use sockets by Larry Wall <[e-mail]>
X# NOTE: openlog now takes three arguments, just like openlog(3)
X#
X# call syslog() with a string priority and a list of printf() args
X# like syslog(3)
X#
X#  usage: do 'syslog.pl' || die "syslog.pl: $@";
X#
X#  then (put these all in a script to test function)
X#
X#
X#    do openlog($program,'cons,pid','user');
X#    do syslog('info','this is another test');
X#    do syslog('warn','this is a better test: %d', time);
X#    do closelog();
X#
X#    do syslog('debug','this is the last test');
X#    do openlog("$program $$",'ndelay','user');
X#    do syslog('notice','fooprogram: this is really done');
X#
X#    $! = 55;
X#    do syslog('info','problem was %m'); # %m == $! in syslog(3)
X
Xpackage syslog;
X
X$host = 'localhost' unless $host;    # set $syslog'host to change
X
Xdo '/usr/local/lib/perl/syslog.h'
X    || die "syslog: Can't do syslog.h: ",($@||$!),"\n";
X
Xsub main'openlog {
X    ($ident, $logopt, $facility) = @_;  # package vars
X    $lo_pid = $logopt =~ /\bpid\b/;
X    $lo_ndelay = $logopt =~ /\bndelay\b/;
X    $lo_cons = $logopt =~ /\bncons\b/;
X    $lo_nowait = $logopt =~ /\bnowait\b/;
X    &connect if $lo_ndelay;
X}
X
Xsub main'closelog {
X    $facility = $ident = '';
X    &disconnect;
X}
X
Xsub main'syslog {
X    local($priority) = shift;
X    local($mask) = shift;
X    local($message, $whoami);
X
X    &connect unless $connected;
X
X    $whoami = $ident;
X
X    die "syslog: expected both priority and mask" unless $mask && $priority;
X
X    $facility = "user" unless $facility;
X
X    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
X    $whoami = $1;
X    $mask = $2;
X    }
X    $whoami .= " [$$]" if $lo_pid;
X
X    $mask =~ s/%m/$!/g;
X    $mask .= "\n" unless $mask =~ /\n$/;
X    $message = sprintf ($mask, @_);
X
X    $whoami = sprintf ("%s %d",$ENV{'USER'}||$ENV{'LOGNAME'},$$) unless $whoami;
X
X    $sum = &xlate($priority) + &xlate($facility);
X    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
X    if ($lo_cons) {
X        if ($pid = fork) {
X        unless ($lo_nowait) {
X            do {$died = wait;} until $died == $pid || $died < 0;
X        }
X        }
X        else {
X        open(CONS,">/dev/console");
X        print CONS "$<facility.$priority>$whoami: $message\n";
X        exit if defined $pid;        # if fork failed, we're parent
X        close CONS;
X        }
X    }
X    }
X}
X
Xsub xlate {
X    local($name) = @_;
X    $name =~ y/a-z/A-Z/;
X    $name = "LOG_$name" unless $name =~ /^LOG_/;
X    $name = "syslog'$name";
X    &$name;
X}
X
Xsub connect {
X    $pat = 'S n C4 x8';
X
X    $af_unix = 1;
X    $af_inet = 2;
X
X    $stream = 1;
X    $datagram = 2;
X
X    ($name,$aliases,$proto) = getprotobyname('udp');
X    $udp = $proto;
X
X    ($name,$aliase,$port,$proto) = getservbyname('syslog','udp');
X    $syslog = $port;
X
X    if (chop($myname = `hostname`)) {
X    ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
X    die "Can't lookup $myname\n" unless $name;
X    @bytes = unpack("C4",$addrs[0]);
X    }
X    else {
X    @bytes = (0,0,0,0);
X    }
X    $this = pack($pat, $af_inet, 0, @bytes);
X
X    if ($host =~ /^\d+\./) {
X    @bytes = split(/\./,$host);
X    }
X    else {
X    ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
X    die "Can't lookup $host\n" unless $name;
X    @bytes = unpack("C4",$addrs[0]);
X    }
X    $that = pack($pat,$af_inet,$syslog,@bytes);
X
X    socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
X    bind(SYSLOG,$this) || die "bind: $!\n";
X    connect(SYSLOG,$that) || die "connect: $!\n";
X
X    local($old) = select(SYSLOG); $| = 1; select($old);
X    $connected = 1;
X}
X
Xsub disconnect {
X    close SYSLOG;
X    $connected = 0;
X}
X
X1;
!STUFFY!FUNK!
echo ""
echo "End of kit"
: I do not append .signature, but someone might mail this.
exit