[comp.lang.perl] openlog

fair@apple.com (Erik E. Fair) (03/14/90)

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	fair@apple.com

P.S.	I'm not a perl hacker (yet).

tchrist@convex.COM (Tom Christiansen) (03/14/90)

In article <39461@apple.Apple.COM> fair@apple.com (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)?

Eric, the problem is I can't get to arbitrary C library calls
from section 3 as I can to arbitrary system calls from section 2,
and Larry hasn't made syslog(3) a built-in to perl (yet?).
This means I can't really use openlog(3) and syslog(3), but must
use a pipe to logger(8) instead.  The "hack" you're complaining 
about attempts to provide the same functionality as syslog(3)
at the expense of an exec per line.  

Here's a version which does not do an exec per line, but rather an exec
per (priority, facility) pair, because I can't make logger switch these
things in mid-steam.    I really don't see how to do better than this
without getting Larry to put syslog(3) into perl itself.

--tom

#
# syslog.pl
#
# tom christiansen <tchrist@convex.com>
#
# call syslog() with a string priority and a list of printf() args
# like syslog(3) but using logger(8).  will only open a new pipe
# to logger if it needs to.
#
#  usage: do 'syslog.pl' || die "syslog.pl: $@";
#
#  then (put these all in a script to test function)
#		
#
#	do openlog($program,'user');
#	do syslog('info','this is another test');
#	do syslog('warn','this is a better test: %d', time);
#	do closelog();
#	
#	do syslog('debug','this is the last test');
#	do openlog("$program $$",'user');
#	do syslog('notice','fooprogram: this is really done');
#
#	$! = 55;
#	do syslog('info','problem was %m'); # %m == $! in syslog(3)

package syslog;

$logpath = '/usr/ucb/logger';

$opriority = $ofacility = $facility = $ident = '';

die "syslog: can't call $logpath: $!" unless -x $logpath;

sub main'openlog {
    &main'closelog if $logopen;
    ($ident, $facility) = @_;  # package vars
} 

sub main'closelog {
    $facility = $ident = '';
    if ($logopen) {
	$logopen = 0;
	close LOG;
    } 
} 
 
sub main'syslog {
    local($priority) = shift;
    local($mask) = shift;
    local($message, $whoami, $oldfh);

    $whoami = $ident;

    die "syslog: expected both priority and mask" unless $mask && $priority;

    $facility = "user" unless $facility;

    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
	$whoami = $1;
	$mask = $2;
    } 

    $mask =~ s/%m/$!/g;
    $mask .= "\n" unless $mask =~ /\n$/;

    $whoami = sprintf ("%s %d", $ENV{'USER'}, $$) unless $whoami;

    if ($opriority ne $priority || $ofacility ne $facility) {
	$opriority = $priority;
	$ofacility = $facility;
	close LOG if $logopen++;
	open(LOG, "| $logpath -t '$whoami' -p '$facility.$priority'");
	$oldfh = select(LOG);
	$| = 1;
	select($oldfh);
    } 
    printf LOG "$mask", @_;
}

1;
--

    Tom Christiansen                       {uunet,uiucdcs,sun}!convex!tchrist 
    Convex Computer Corporation                            tchrist@convex.COM
		 "EMACS belongs in <sys/errno.h>: Editor too big!"

lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (03/15/90)

In article <39461@apple.Apple.COM> fair@apple.com (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	fair@apple.com
: 
: 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 <tchrist@convex.com>
X# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
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

les@chinet.chi.il.us (Leslie Mikesell) (03/16/90)

In article <100571@convex.convex.com> tchrist@convex.COM (Tom Christiansen) writes:

>Eric, the problem is I can't get to arbitrary C library calls
>from section 3 as I can to arbitrary system calls from section 2,

Hey, good idea there.  How about it Larry, at least for shared-library
machines it shouldn't add much overhead?

Les Mikesell
 les@chinet.chi.il.us

lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (03/17/90)

In article <1990Mar15.212147.2978@chinet.chi.il.us> les@chinet.chi.il.us (Leslie Mikesell) writes:
: Hey, good idea there.  How about it Larry, at least for shared-library
: machines it shouldn't add much overhead?

You'd still have to put the calls in there, unless someone's written a shared
library fasl'er.  It would be possible, of course, for Configure to generate
a list of library routine names, and build a calls.c file and compile it in,
but that seems a bit of a kludge.

Maybe there's a tricky way to to build a jump-table on the fly, but I don't
know of it yet.

Larry

tneff@bfmny0.UU.NET (Tom Neff) (03/17/90)

I don't think I would want to add the code for all the Section 3 calls
into the Perl executable.  Some of them are pretty big.

Barring some kind of COFF 'do' that lets you load code dynamically,
this seems close to insoluble.  Better to put the POPULAR calls into
Perl directly.

Or define a user-extensions module, created when you build Perl,
that accepts a switch-code at entry followed by a list of parameters,
and branches and does the right thing.   Ooh, pretty scary kids.