aboutsummaryrefslogtreecommitdiff
path: root/lib/App
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-02-28 17:52:37 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2017-02-28 17:52:37 +0200
commitbdc4ce4b346a08c67969b848ec69996ea9c46e00 (patch)
treeed0e6bcace653c711a56731050e08d3d298e5e4a /lib/App
parent2f40b28caabbd90f72c3e4faf7bbd46dc4d9ec88 (diff)
downloadbeam-bdc4ce4b346a08c67969b848ec69996ea9c46e00.tar.gz
beam-bdc4ce4b346a08c67969b848ec69996ea9c46e00.tar.bz2
Improve run-time configuration framework; provide boilerplate for the backup subcommand
Diffstat (limited to 'lib/App')
-rw-r--r--lib/App/Beam.pm280
-rw-r--r--lib/App/Beam/Backup.pm18
-rw-r--r--lib/App/Beam/Config.pm38
3 files changed, 324 insertions, 12 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]");
+}
+
diff --git a/lib/App/Beam/Backup.pm b/lib/App/Beam/Backup.pm
new file mode 100644
index 0000000..d6c30a5
--- /dev/null
+++ b/lib/App/Beam/Backup.pm
@@ -0,0 +1,18 @@
+package App::Beam::Backup;
+
+use strict;
+use Carp;
+
+require App::Beam;
+our @ISA = qw(App::Beam);
+
+sub run {
+ my $self = shift;
+ $self->lock();
+ use Data::Dumper;
+ print Dumper([$self->{status}]);
+ $self->status('round', $self->status('round') + 1);
+ $self->status('timestamp', time());
+ $self->unlock();
+# print Dumper([$self->{conf}]);
+}
diff --git a/lib/App/Beam/Config.pm b/lib/App/Beam/Config.pm
index d86b258..46624bb 100644
--- a/lib/App/Beam/Config.pm
+++ b/lib/App/Beam/Config.pm
@@ -32,6 +32,13 @@ sub error {
print STDERR "$err\n";
}
+sub debug {
+ my $self = shift;
+ my $lev = shift;
+ return unless $self->{debug} >= $lev;
+ $self->logger('debug', "config:", @_);
+}
+
sub new {
my $class = shift;
my $filename = shift;
@@ -41,12 +48,7 @@ sub new {
my $err;
if (defined($v = delete $_{debug})) {
- if (ref($v) eq 'CODE') {
- $self->{debug} = $v;
- } else {
- carp "debug must refer to a CODE";
- ++$err;
- }
+ $self->{debug} = $v;
}
if (defined($v = delete $_{ci})) {
@@ -101,8 +103,7 @@ sub writecache {
return unless exists $self->{cachefile};
return unless exists $self->{conf};
return unless $self->{updated};
- &{$self->{debug}}("storing cache file $self->{cachefile}")
- if exists $self->{debug};
+ $self->debug(1, "storing cache file $self->{cachefile}");
store $self->{conf}, $self->{cachefile};
}
@@ -190,7 +191,7 @@ sub readconfig {
my $conf = shift;
local %_ = @_;
- &{$self->{debug}}("reading file $file") if exists $self->{debug};
+ $self->debug(1, "reading file $file");
open(my $fd, "<", $file)
or do {
$self->error("can't open configuration file $file: $!");
@@ -301,6 +302,19 @@ sub readconfig {
return $err;
}
+sub fixup {
+ my $self = shift;
+ my $params = shift;
+ while (my ($kv, $descr) = each %$params) {
+ next unless ref($descr) eq 'HASH';
+ if (exists($descr->{section})) {
+ $self->fixup($descr->{section}, @_, $kv);
+ } elsif (exists($descr->{default}) && !$self->isset(@_, $kv)) {
+ $self->set(@_, $kv, $descr->{default});
+ }
+ }
+}
+
sub file_up_to_date {
my ($self, $file) = @_;
my $st_conf = stat($self->{filename}) or return 1;
@@ -316,8 +330,7 @@ sub parse {
if (exists($self->{cachefile}) and -f $self->{cachefile}) {
if ($self->file_up_to_date($self->{cachefile})) {
my $ref;
- &{$self->{debug}}("reading from cache file $self->{cachefile}")
- if exists $self->{debug};
+ $self->debug(1, "reading from cache file $self->{cachefile}");
eval { $ref = retrieve($self->{cachefile}); };
if (defined($ref)) {
$self->{conf} = $ref;
@@ -330,11 +343,12 @@ sub parse {
unlink $self->{cachefile};
}
- &{$self->{debug}}("parsing $self->{filename}") if exists $self->{debug};
+ $self->debug(1, "parsing $self->{filename}");
my $err = $self->readconfig($self->{filename}, \%conf);
if ($err == 0) {
$self->{conf} = \%conf ;
$self->{updated} = 1;
+ $self->fixup($self->{parameters}) if exists $self->{parameters};
}
return !$err;
}

Return to:

Send suggestions and report system problems to the System administrator.