"Fossies" - the Fresh Open Source Software Archive

Member "sendpage-1.001001/lib/Sendpage/KeesLog.pm" (3 Jan 2008, 4313 Bytes) of package /linux/privat/old/sendpage-1.001001.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "KeesLog.pm" see the Fossies "Dox" file reference documentation.

    1 package Sendpage::KeesLog;
    2 
    3 # KeesLog.pm implements a logging subsystem involving syslog and/or stderr
    4 #
    5 # $Id: KeesLog.pm 217 2006-08-09 00:02:06Z keescook $
    6 #
    7 # Copyright (C) 2000-2004 Kees Cook
    8 # kees@outflux.net, http://outflux.net/
    9 #
   10 # This program is free software; you can redistribute it and/or
   11 # modify it under the terms of the GNU General Public License
   12 # as published by the Free Software Foundation; either version 2
   13 # of the License, or (at your option) any later version.
   14 #
   15 # This program is distributed in the hope that it will be useful,
   16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18 # GNU General Public License for more details.
   19 #
   20 # You should have received a copy of the GNU General Public License
   21 # along with this program; if not, write to the Free Software
   22 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
   23 # <URL:http://www.gnu.org/copyleft/gpl.html>
   24 
   25 use Sys::Syslog qw(:DEFAULT setlogsock);
   26 
   27 =head1 NAME
   28 
   29 Sendpage::KeesLog - implements a logging subsystem
   30 
   31 =head1 SYNOPSIS
   32 
   33  $log = Sendpage::KeesLog->new();
   34  $log->on();
   35  $log->do('crit',"Something bad happened");
   36  $log->reconfig($config);
   37  $log->do('debug',"I'm doing things");
   38  $log->off();
   39  $log->do('info',"Look at me, I'm writing to stderr now");
   40 
   41 =head1 DESCRIPTION
   42 
   43 This module is used by L<sendpage> for its logging.
   44 
   45 =head1 BUGS
   46 
   47 I need to write more docs for it.
   48 
   49 =cut
   50 
   51 my %LogLevels = (
   52                  debug   => 0,
   53                  info    => 1,
   54                  notice  => 2,
   55                  warning => 3,
   56                  err     => 4,
   57                  crit    => 5,
   58                  alert   => 6,
   59                  emerg   => 7,
   60                 );
   61 
   62 # FIXME: can I have this thing detect if STDERR has already been closed and
   63 #        kick and scream some other way?
   64 
   65 # takes parameters "Syslog" (1 or 0), "Opts", "Facility", "MinLevel"
   66 sub new
   67 {
   68     my $proto = shift;
   69     my $class = ref($proto) || $proto;
   70     my $self  = { };
   71 
   72     bless $self => $class;
   73 
   74     $self->reconfig(@_);
   75 
   76     return $self;
   77 }
   78 
   79 # restarts logging with config'd values
   80 sub reconfig
   81 {
   82     my $self = shift;
   83     my %arg  = @_;
   84 
   85     $self->{SYSLOG}   = $arg{Syslog};
   86     $self->{OPTS}     = $arg{Opts};
   87     $self->{FACILITY} = $arg{Facility};
   88     $self->{MINLEVEL} = $arg{MinLevel};
   89     if (defined($arg{MinLevel})
   90     && defined($LogLevels{$arg{MinLevel}}))
   91     {
   92     $self->{MINLEVEL} = $arg{MinLevel};
   93     }
   94     else
   95     {
   96     $self->{MINLEVEL} = "debug";
   97     }
   98 
   99     unless (defined $self->{SYSLOG}) {
  100         $self->{SYSLOG} = 0;
  101         $self->off();
  102     } else {
  103         $self->on() if (defined $self->{OPEN});
  104     }
  105 }
  106 
  107 sub off
  108 {
  109     my $self = shift;
  110 
  111     if (defined $self->{OPEN}) {
  112         closelog;
  113         undef $self->{OPEN};
  114     }
  115 }
  116 
  117 sub on
  118 {
  119     my $self = shift;
  120 
  121     $self->off();
  122     if ($self->{SYSLOG} == 1) {
  123         # Comment out the following line if Solaris complains about
  124         # syslog.
  125         setlogsock('inet') unless defined setlogsock('unix');
  126         my $ret = openlog "sendpage", $self->{OPTS}, $self->{FACILITY};
  127         $self->{OPEN} = 1;
  128     }
  129 }
  130 
  131 # perform a logging function
  132 sub do
  133 {
  134     my($self, $pri, $format, @args) = @_;
  135 
  136     $pri = $self->{MINLEVEL}
  137         if ($LogLevels{$pri} < $LogLevels{$self->{MINLEVEL}});
  138 
  139     # convert tabs since syslog doesn't like them
  140     $format =~ s/\t/     /g;
  141 
  142     # question is: who adds the "\n"?  Me or syslog?  I assume me now.
  143     unless (defined $self->{OPEN}) {
  144         my $str = sprintf("%s [$$ $pri]: $format",
  145                           scalar(localtime()), @args);
  146         warn $str . "\n";
  147     } else {
  148         # FIXME: shouldn't I check error codes?
  149         syslog($pri, $format, @args);
  150     }
  151 }
  152 
  153 sub DESTROY
  154 {
  155     my ($self) = @_;
  156 
  157     $self->off();
  158 }
  159 
  160 1;                                # This is a module
  161 
  162 __END__
  163 
  164 =head1 AUTHOR
  165 
  166 Kees Cook <kees@outflux.net>
  167 
  168 =head1 SEE ALSO
  169 
  170 Man pages: L<perl>, L<sendpage>.
  171 
  172 Module documentation: L<Sendpage::KeesConf>, L<Sendpage::Modem>,
  173 L<Sendpage::PagingCentral>, L<Sendpage::PageQueue>, L<Sendpage::Page>,
  174 L<Sendpage::Recipient>, L<Sendpage::Queue>.
  175 
  176 =head1 COPYRIGHT
  177 
  178 Copyright 2000 Kees Cook.
  179 
  180 This library is free software; you can redistribute it and/or
  181 modify it under the same terms as Perl itself.
  182 
  183 =cut