[Summary view] [Print] [Text view]

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