path: root/lib/App/Beam.pm

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]");
}