package App::Beam; use strict; use Carp; use File::Basename; use Sys::Syslog; use Unix::Sysexits; use POSIX qw(strftime floor); require App::Beam::Config; our @ISA = qw(App::Beam::Config); use App::Beam::History; my $default_config_file = '/etc/beam.conf'; sub ck_bool { my ($vref) = @_; my %bool = ( '1' => 1, 'yes' => 1, 'on' => 1, 'true' => 1, 't' => 1, '0' => 0, 'no' => 0, 'off' => 0, 'false' => 0, 'f' => 0, 'nil' => 0 ); return "not a valid boolean" unless exists $bool{lc $$vref}; $$vref = $bool{lc $$vref}; return undef; } sub ck_number { my ($vref) = @_; return "not a number" unless $$vref =~ /^\d+/; return undef; } my %parameters = ( logger => { section => { channel => { check => sub { my ($vref) = @_; return "unknown channel" unless grep { $_ eq $$vref } qw(syslog file); return undef; }, default => 'file' }, debug => { check => \&ck_number }, syslog => { section => { facility => { check => sub { my $vref = shift; my @faclist = qw (auth authpriv cron daemon ftp kern local0 local1 local2 local3 local4 local5 local6 local7 lpr mail news syslog user uucp); return "unknown syslog facility" unless (grep { $$vref eq $_ } @faclist); return undef; }, default => 'user' }, tag => 1, options => { default => 'pid' } } }, file => { section => { timestamp => { check => \&ck_bool }, name => 1, append => { check => \&ck_bool, default => 1 }, } } } }, schedule => { section => { levels => { check => \&ck_number, default => 2 }, rounds => { check => \&ck_number, default => 3 }, retain => { check => \&ck_number, default => 8 }, }, }, core => { section => { statfile => { default => '/var/spool/beam/beam.state' }, tempdir => { default => '/tmp' }, archivedir => { default => '/var/backups' }, items => 1 } }, backend => { section => { '*' => { section => { '*' => { array => 1 } } } } }, item => { section => { '*' => { section => { backend => { mandatory => 1 }, '*' => { array => 1 } } } } } ); sub new { my $class = shift; local %_ = @_; my $filename; my $progname; my $v; my $dry_run; if (defined($v = delete $_{progname})) { $progname = $v; } else { $progname = basename($0); } if (defined($v = delete $_{config})) { $filename = $v; } else { $filename = $default_config_file; } $dry_run = delete $_{dry_run}; $_{parameters} = \%parameters; # $_{debug} = sub { print "D @_\n"; }; my $self = $class->SUPER::new($filename, %_); $self->{progname} = $progname; $self->{dry_run} = $dry_run; $self->{debug}++ if $dry_run; return $self; } sub get { my $self = shift; if (ref($_[0]) eq 'HASH') { return $self->SUPER::get(@_); } else { return $self->SUPER::get(map { split /\./ } @_); } } sub isset { my $self = shift; return $self->SUPER::isset(map { split /\./ } @_); } sub issection { my $self = shift; return $self->SUPER::issection(map { split /\./ } @_); } sub isscalar { my $self = shift; return $self->SUPER::isscalar(map { split /\./ } @_); } sub set { my $self = shift; return $self->SUPER::set(map { split /\./ } @_); } sub unset { my $self = shift; return $self->SUPER::unset(map { split /\./ } @_); } sub logfmt { my $self = shift; my $prio = shift; my $fmt = shift; $self->logger($prio, sprintf($fmt, @_)); } sub logger_line { my ($self, $prio, $msg) = @_; chomp $msg; if ($self->get('logger.channel') eq 'syslog') { syslog($prio, $msg); } else { print STDERR strftime '%b %d %H:%M:%S ', localtime if $self->get('logger.file.timestamp'); print STDERR "$self->{progname}: $prio: $msg\n"; } } sub logger { my $self = shift; my $prio = shift; if (ref($_[0]) eq 'GLOB') { my $fd = shift; while (<$fd>) { chomp; $self->logger_line($prio, $_); } } else { my @msg = split(/\n/, join(' ', @_)); $self->logger_line($prio, shift @msg); for (@msg) { $self->logger_line($prio, " $_"); } } } sub error { my $self = shift; my $err = shift; local %_ = @_; $err = $_{locus}->format($err) if exists($_{locus}); $self->logger('err', $err); } sub debug { my $self = shift; my $lev = shift; return unless $self->{debug} >= $lev; $self->logger('DEBUG', @_); } sub abend { my $self = shift; my $code = shift; $self->logger('crit', @_); exit($code); } sub format_name { my ($self, $name, $idx) = @_; my $rec = $self->{history}->top($idx); return undef unless defined $rec; $name .= '-' . $rec->cycle . '-' . $rec->round . '-' . $rec->level; return $name; } sub load_backends { my $self = shift; $self->abend(EX_CONFIG, "no items defined") unless $self->isset('item'); $self->set('core.items', join(' ', $self->names_of('item'))) unless $self->isset('core.items'); my $err; my %h; foreach my $be (map { $_->[1] } sort { if ($a->[0] == $b->[0]) { $a->[1] cmp $b->[1] } else { $a->[0] <=> $b->[0] } } map { if ($self->isset("item.$_")) { my $backend = $self->get("item.$_.backend"); if (exists($h{$backend})) { (); } else { $h{$backend} = 1; [ $self->isset("backend.$backend.order") ? $self->get("backend.$backend.order") : 0, $backend ]; } } else { $self->error("item $_ not defined"); $err = 1; (); } } split(/\s+/, $self->get('core.items'))) { my $pack = "App::Beam::Backend::" . ucfirst($be); $self->debug(1, "loading $pack"); my $obj = eval "use $pack; new $pack(\$self);"; if ($@) { $self->logger('crit', $@); ++$err; } else { $self->{backend}{$be} = $obj; } } $err += $self->{error_count}; exit(EX_UNAVAILABLE) if $err; } sub begin { my $self = shift; exit(EX_CONFIG) unless $self->parse(); if ($self->get('logger.channel') eq 'syslog') { my $facility = $self->get('logger.syslog.facility') || 'user'; my $tag = $self->get('logger.syslog.tag') || $self->{progname}; my $options = $self->get('logger.syslog.options') || 'pid'; openlog($tag, $options, $facility) or do { croak "openlog failed"; exit(EX_CONFIG); } } elsif (my $filename = $self->get('logger.file.name')) { my $mode = $self->get('logger.file.append') ? '>>' : '>'; open(STDERR, $mode, $filename) or do { croak "can't open file $filename for logging"; exit(EX_CANTCREAT); }; } if (!exists($self->{debug}) && defined(my $v = $self->get('logger.debug'))) { $self->{debug} = $v; } $self->logger('info', 'startup'); $self->load_backends; eval { my %args; $args{dry_run} = $self->{dry_run}; $self->{history} = new App::Beam::History($self->get('core.statfile'), $self->get('schedule', 'rounds'), $self->get('schedule', 'levels'), %args); }; if ($@) { $self->logger('crit', $@); exit(EX_CANTCREAT); } } sub end { my $self = shift; $self->{history}->top->finish; $self->{history}->save; $self->logger('info', 'shutdown'); if ($self->get('logger.channel') eq 'syslog') { closelog(); } } sub run { my $self = shift; $self->abend(EX_SOFTWARE, "unsupported command $_[0]"); } sub check_items { my $self = shift; my @items = split /\s+/, $self->get('core.items'); if (@_) { push @items, $self->names_of('item'); foreach my $item (@_) { $self->abend(EX_USAGE, "$item: no such item defined") unless grep { $item eq $_ } @items; } @items = @_; } return @items; } 1;