diff options
Diffstat (limited to 'lib/App/Beam.pm')
-rw-r--r-- | lib/App/Beam.pm | 280 |
1 files changed, 280 insertions, 0 deletions
diff --git a/lib/App/Beam.pm b/lib/App/Beam.pm new file mode 100644 index 0000000..82d8f97 --- /dev/null +++ b/lib/App/Beam.pm @@ -0,0 +1,280 @@ +package App::Beam; + +use strict; +use Carp; +use File::Basename; +use Sys::Syslog; +use Unix::Sysexits; +use Fcntl qw(:flock SEEK_SET); +use Storable qw(fd_retrieve nstore_fd); +use POSIX qw(strftime); + +require App::Beam::Config; +our @ISA = qw(App::Beam::Config); + +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' }, + } + } +); + +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; + + return $self; +} + +sub get { + my $self = shift; + 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 { + my $self = shift; + my $prio = shift; + my $msg = join(' ', map { my $a = $_; $a =~ s/\n/\\n/g; $a } @_); + + 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 error { + my ($self, $err) = @_; + $self->logger('err', $err); +} + +sub abend { + my $self = shift; + my $code = shift; + $self->logger('crit', @_); + exit($code); +} + +# Locks the statfile and retrieves data from it into {status} +sub lock { + my $self = shift; + my $file = $self->get('core.statfile'); + unless (open($self->{statfd}, '+>>', $file)) { + $self->abend(EX_CANTCREAT, "can't open file $file: $!"); + } + unless (flock($self->{statfd}, LOCK_EX | LOCK_NB)) { + $self->abend(EX_TEMPFAIL, "can't lock file $file: $!"); + } + seek($self->{statfd}, 0, SEEK_SET); + if ((stat($self->{statfd}))[7] == 0) { + $self->{status} = { round => 0, + level => 0, + timestamp => time() }; + } else { + $self->{status} = fd_retrieve($self->{statfd}) + or $self->abend(EX_UNAVAILABLE, "can't retrieve status from $file: $!"); + } +} + +# Saves the current status and unlocks the status file. +sub unlock { + my ($self) = @_; + croak "unlock without lock" unless defined $self->{statfd}; + if ($self->{status}{updated}) { + delete $self->{status}{updated}; + seek($self->{statfd}, 0, SEEK_SET); + truncate($self->{statfd}, 0); + nstore_fd($self->{status}, $self->{statfd}); + } + flock($self->{statfd}, LOCK_UN); + close($self->{statfd}); +} + +sub status { + my ($self,$name,$val) = @_; + my $ret = $self->{status}{$name} if exists $self->{status}{$name}; + if (defined($val)) { +# print "SET $name=$val\n"; + $self->{status}{$name} = $val; + $self->{status}{updated} = 1 unless $self->{dry_run}; + } + return $ret; +} + +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'); +} + +sub end { + my $self = shift; + $self->logger('info', 'shutdown'); + if ($self->get('logger.channel') eq 'syslog') { + closelog(); + } +} + +sub run { + my $self = shift; + $self->abend(EX_SOFTWARE, "unsupported command $_[0]"); +} + |