diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-02-28 17:52:37 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-02-28 17:52:37 +0200 |
commit | bdc4ce4b346a08c67969b848ec69996ea9c46e00 (patch) | |
tree | ed0e6bcace653c711a56731050e08d3d298e5e4a /lib/App | |
parent | 2f40b28caabbd90f72c3e4faf7bbd46dc4d9ec88 (diff) | |
download | beam-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.pm | 280 | ||||
-rw-r--r-- | lib/App/Beam/Backup.pm | 18 | ||||
-rw-r--r-- | lib/App/Beam/Config.pm | 38 |
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; } |