lib/Sys/Syslog.pm

   1 package Sys::Syslog;
   2 require 5.000;
   3 require Exporter;
   4 use Carp;
   5
   6 @ISA = qw(Exporter);
   7 @EXPORT = qw(openlog closelog setlogmask syslog);
   8
   9 #
  10 # syslog.pl
  11 #
  12 # $Log: syslog.pl,v $
  13 #
  14 # tom christiansen <tchrist@convex.com>
  15 # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
  16 # NOTE: openlog now takes three arguments, just like openlog(3)
  17 #
  18 # call syslog() with a string priority and a list of printf() args
  19 # like syslog(3)
  20 #
  21 #  usage: use Syslog;
  22 #
  23 #  then (put these all in a script to test function)
  24 #
  25 #       openlog($program,'cons,pid','user');
  26 #       syslog('info','this is another test');
  27 #       syslog('mail|warning','this is a better test: %d', time);
  28 #       closelog();
  29 #
  30 #       syslog('debug','this is the last test');
  31 #       openlog("$program $$",'ndelay','user');
  32 #       syslog('notice','fooprogram: this is really done');
  33 #
  34 #       $! = 55;
  35 #       syslog('info','problem was %m'); # %m == $! in syslog(3)
  36
  37 $host = 'localhost' unless $host;       # set $Syslog::host to change
  38
  39 require 'syslog.ph';
  40
  41 $maskpri = &LOG_UPTO(&LOG_DEBUG);
  42
  43 sub openlog {
  44     ($ident, $logopt, $facility) = @_;  # package vars
  45     $lo_pid = $logopt =~ /\bpid\b/;
  46     $lo_ndelay = $logopt =~ /\bndelay\b/;
  47     $lo_cons = $logopt =~ /\bcons\b/;
  48     $lo_nowait = $logopt =~ /\bnowait\b/;
  49     &connect if $lo_ndelay;
  50 }
  51
  52 sub closelog {
  53     $facility = $ident = '';
  54     &disconnect;
  55 }
  56
  57 sub setlogmask {
  58     local($oldmask) = $maskpri;
  59     $maskpri = shift;
  60     $oldmask;
  61 }
  62
  63 sub syslog {
  64     local($priority) = shift;
  65     local($mask) = shift;
  66     local($message, $whoami);
  67     local(@words, $num, $numpri, $numfac, $sum);
  68     local($facility) = $facility;       # may need to change temporarily.
  69
  70     croak "syslog: expected both priority and mask" unless $mask && $priority;
  71
  72     @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
  73     undef $numpri;
  74     undef $numfac;
  75     foreach (@words) {
  76         $num = &xlate($_);              # Translate word to number.
  77         if (/^kern$/ || $num < 0) {
  78             croak "syslog: invalid level/facility: $_";
  79         }
  80         elsif ($num <= &LOG_PRIMASK) {
  81             croak "syslog: too many levels given: $_" if defined($numpri);
  82             $numpri = $num;
  83             return 0 unless &LOG_MASK($numpri) & $maskpri;
  84         }
  85         else {
  86             croak "syslog: too many facilities given: $_" if defined($numfac);
  87             $facility = $_;
  88             $numfac = $num;
  89         }
  90     }
  91
  92     croak "syslog: level must be given" unless defined($numpri);
  93
  94     if (!defined($numfac)) {    # Facility not specified in this call.
  95         $facility = 'user' unless $facility;
  96         $numfac = &xlate($facility);
  97     }
  98
  99     &connect unless $connected;
 100
 101     $whoami = $ident;
 102
 103     if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
 104         $whoami = $1;
 105         $mask = $2;
 106     }
 107
 108     unless ($whoami) {
 109         ($whoami = getlogin) ||
 110             ($whoami = getpwuid($<)) ||
 111                 ($whoami = 'syslog');
 112     }
 113
 114     $whoami .= "[$$]" if $lo_pid;
 115
 116     $mask =~ s/%m/$!/g;
 117     $mask .= "\n" unless $mask =~ /\n$/;
 118     $message = sprintf ($mask, @_);
 119
 120     $sum = $numpri + $numfac;
 121     unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
 122         if ($lo_cons) {
 123             if ($pid = fork) {
 124                 unless ($lo_nowait) {
 125                     do {$died = wait;} until $died == $pid || $died < 0;
 126                 }
 127             }
 128             else {
 129                 open(CONS,">/dev/console");
 130                 print CONS "<$facility.$priority>$whoami: $message\r";
 131                 exit if defined $pid;           # if fork failed, we're parent
 132                 close CONS;
 133             }
 134         }
 135     }
 136 }
 137
 138 sub xlate {
 139     local($name) = @_;
 140     $name =~ y/a-z/A-Z/;
 141     $name = "LOG_$name" unless $name =~ /^LOG_/;
 142     $name = "Sys::Syslog::$name";
 143     eval(&$name) || -1;
 144 }
 145
 146 sub connect {
 147     $pat = 'S n C4 x8';
 148
 149     $af_unix = 1;
 150     $af_inet = 2;
 151
 152     $stream = 1;
 153     $datagram = 2;
 154
 155     ($name,$aliases,$proto) = getprotobyname('udp');
 156     $udp = $proto;
 157
 158     ($name,$aliase,$port,$proto) = getservbyname('syslog','udp');
 159     $syslog = $port;
 160
 161     if (chop($myname = `hostname`)) {
 162         ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
 163         croak "Can't lookup $myname" unless $name;
 164         @bytes = unpack("C4",$addrs[0]);
 165     }
 166     else {
 167         @bytes = (0,0,0,0);
 168     }
 169     $this = pack($pat, $af_inet, 0, @bytes);
 170
 171     if ($host =~ /^\d+\./) {
 172         @bytes = split(/\./,$host);
 173     }
 174     else {
 175         ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
 176         croak "Can't lookup $host" unless $name;
 177         @bytes = unpack("C4",$addrs[0]);
 178     }
 179     $that = pack($pat,$af_inet,$syslog,@bytes);
 180
 181     socket(SYSLOG,$af_inet,$datagram,$udp) || croak "socket: $!";
 182     bind(SYSLOG,$this) || croak "bind: $!";
 183     connect(SYSLOG,$that) || croak "connect: $!";
 184
 185     local($old) = select(SYSLOG); $| = 1; select($old);
 186     $connected = 1;
 187 }
 188
 189 sub disconnect {
 190     close SYSLOG;
 191     $connected = 0;
 192 }
 193
 194 1;
 195