Improve run-time configuration framework; provide boilerplate for the backup subcommand

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