Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 12181 lines (9210 sloc) 359.605 kB
#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil; cperl-indent-level: 4-*-
## Script to control Bucardo
##
## Copyright 2006-2015 Greg Sabino Mullane <greg@endpoint.com>
##
## Please see http://bucardo.org/ for full documentation
##
## Run with a --help argument for some basic instructions
package bucardo;
use strict;
use warnings;
use utf8;
use 5.008003;
use open qw( :std :utf8 );
use DBI;
use IO::Handle qw/ autoflush /;
use File::Basename qw/ dirname /;
use Time::HiRes qw/ sleep gettimeofday tv_interval /;
use POSIX qw/ ceil setsid localeconv /;
use Config qw/ %Config /;
use Encode qw/ decode /;
use File::Spec;
use Data::Dumper qw/ Dumper /;
$Data::Dumper::Indent = 1;
use Getopt::Long;
Getopt::Long::Configure(qw/ no_ignore_case pass_through no_autoabbrev /);
require I18N::Langinfo;
our $VERSION = '5.3.1';
## For the tests, we want to check that it compiles without actually doing anything
return 1 if $ENV{BUCARDO_TEST};
## No buffering on the standard streams
*STDOUT->autoflush(1);
*STDERR->autoflush(1);
my $locale = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
for (@ARGV) {
$_ = decode($locale, $_);
}
## All the variables we use often and want to declare here without 'my'
use vars qw/$dbh $SQL $sth %sth $count $info %global $SYNC $GOAT $TABLE $SEQUENCE $DB $DBGROUP $HERD $RELGROUP
$CUSTOMCODE $CUSTOMNAME $CUSTOMCOLS $CLONE /;
## How to show dates from the database, e.g. start time of a sync
my $DATEFORMAT = $ENV{BUCARDO_DATEFORMAT} || q{Mon DD, YYYY HH24:MI:SS};
my $SHORTDATEFORMAT = $ENV{BUCARDO_SHORTDATEFORMAT} || q{HH24:MI:SS};
## How long (in seconds) we hang out between checks after a kick - or when waiting for notices
my $WAITSLEEP = 1;
## Determine how we were called
## If we were called from a different directory, and the base directory is in our path,
## we strip out the directory part
my $progname = $0;
if (exists $ENV{PATH} and $progname =~ m{(.+)/(.+)}) {
my ($base, $name) = ($1,$2);
for my $seg (split /\:/ => $ENV{PATH}) {
if ($seg eq $base) {
$progname = $name;
last;
}
}
}
## We must have at least one argument to do anything
help(1) unless @ARGV;
## Default arguments - most are for the bc constructor
my $bcargs = {
quiet => 0,
verbose => 0,
quickstart => 0,
bcverbose => 1,
dbname => 'bucardo',
dbuser => 'bucardo',
dbpass => undef,
sendmail => 0,
extraname => '',
logseparate => 0,
logextension => '',
logclean => 0,
batch => 0,
};
## These options must come before the main GetOptions call
my @opts = @ARGV;
GetOptions(
$bcargs,
'no-bucardorc',
'bucardorc=s',
);
## Values are first read from a .bucardorc, either in the current dir, or the home dir.
## If those do not exist, check for a global rc file
## These will be overwritten by command-line args.
my $file;
if (! $bcargs->{'no-bucardorc'}) {
if ($bcargs->{bucardorc}) {
-e $bcargs->{bucardorc} or die qq{Could not find the file "$bcargs->{bucardorc}"\n};
$file = $bcargs->{bucardorc};
}
elsif (-e '.bucardorc') {
$file = '.bucardorc';
}
elsif (defined $ENV{HOME} && -e "$ENV{HOME}/.bucardorc") {
$file = "$ENV{HOME}/.bucardorc";
}
elsif (-e '/etc/bucardorc') {
$file = '/etc/bucardorc';
}
}
if (defined $file) {
open my $rc, '<', $file or die qq{Could not open "$file": $!\n};
while (<$rc>) {
## Skip any lines starting with a hash
next if /^\s*#/;
## Format is foo=bar or foo:bar, with whitespace allowed
if (/^\s*(\w[\w-]+)\s*[:=]\s*(.+?)\s*$/o) {
my ($name,$value) = ($1,$2); ## no critic (ProhibitCaptureWithoutTest)
$bcargs->{$name} = $name eq 'logdest' ? [$value] : $value;
}
else {
warn qq{Could not parse line $. of file "$file"\n};
}
}
close $rc or die;
}
Getopt::Long::Configure(qw(no_pass_through autoabbrev));
GetOptions ## no critic (ProhibitCallsToUndeclaredSubs)
($bcargs,
'verbose+',
'vv',
'vvv',
'vvvv',
'quiet+',
'quickstart',
'notimer',
'help|?',
'debug!',
'version',
'sort=i',
'showdays|show-days',
'compress',
'retry=i',
'retrysleep|retry-sleep=i',
'batch',
'dryrun|dry-run',
'confirm',
'tsep=s',
'exit-on-nosync!',
## These are sent to the constructor:
'bcverbose',
'dbport|db-port|p=i',
'dbhost|db-host|h=s',
'dbname|db-name|d=s',
'dbuser|db-user|U=s',
'dbpass|db-pass|P=s',
'sendmail=i',
'extraname|extra-name=s',
'debugsyslog=i', # legacy
'debugdir=s', # legacy
'debugfile=i', # legacy
'cleandebugs=i', # legacy
'logdest|log-dest|log-destination=s@', # stderr, syslog, or file path
'logseparate|log-sep|log-separate|debugfilesep!',
'logextension|log-extension|log-ext|debugname=s',
'logclean|log-clean!',
## Used internally
'force',
'schema|n=s@',
'exclude-schema|N=s@',
'table|t=s@',
'exclude-table|T=s@',
'db|database=s',
'herd|relgroup=s',
'piddir|pid-dir=s',
) or die "\n";
## If --help is set, ignore everything else, show help, then exit
help() if $bcargs->{help};
## If --version is set, ignore everything else, show the version, and exit
if ($bcargs->{version}) {
print "$progname version $VERSION\n";
exit 0;
}
## Allow some options to be set by env
if ($ENV{BUCARDO_CONFIRM} and ! exists $bcargs->{confirm}) {
$bcargs->{confirm} = $ENV{BUCARDO_CONFIRM};
}
# Determine the logging destination.
if (exists $bcargs->{logdest}) {
if (! ref $bcargs->{logdest}) {
$bcargs->{logdest} = [$bcargs->{logdest}];
}
}
else {
if (exists $bcargs->{debugfile} && !delete $bcargs->{debugfile}) {
# Old --debugfile option can disable logging.
$bcargs->{logdest} = [];
}
elsif (my $dir = $bcargs->{debugdir}) {
# Old --debugdir option determines log directory.
$bcargs->{logdest} = [$dir];
}
else {
# Default value.
$bcargs->{logdest} = ['/var/log/bucardo'];
}
if ($bcargs->{debugsyslog}) {
# Old --debugsyslog option enables syslog logging.
push @{ $bcargs->{logdest} } => 'syslog';
}
}
# Handle legacy --cleandebugs option.
$bcargs->{logclean} = 1
if delete $bcargs->{cleandebugs} && !exists $bcargs->{logclean};
## Sometimes we want to be as quiet as possible
my $QUIET = delete $bcargs->{quiet};
## Quick shortcuts for lots of verbosity
$bcargs->{vv} and $bcargs->{verbose} = 2;
$bcargs->{vvv} and $bcargs->{verbose} = 3;
$bcargs->{vvvv} and $bcargs->{verbose} = 4;
## Set some global arguments
my $VERBOSE = delete $bcargs->{verbose};
my $DEBUG = delete $bcargs->{debug} || $ENV{BUCARDO_DEBUG} || 0;
## Do we compress time outputs by stripping out whitespace?
my $COMPRESS = delete $bcargs->{compress} || 0;
## Do we retry after a sleep period on failed kicks?
my $RETRY = delete $bcargs->{retry} || 0;
my $RETRYSLEEP = delete $bcargs->{retrysleep} || 0;
## Allow people to turn off the cool timer when kicking syncs
my $NOTIMER = delete $bcargs->{notimer} || 0;
## Anything left over is the verb and noun(s)
my $verb = shift || '';
## No verb? Show a help message and exit
help(1, "Missing required command\n") unless $verb;
## Standardize the verb as lowercase, and grab the rest of the args as the "nouns"
$verb = lc $verb;
my @nouns = @ARGV;
## Allow alternate underscore format
if ($verb =~ /^(\w+)_(\w+)$/) {
$verb = $1;
unshift @nouns => $2;
}
## Make a single string version, mostly for output in logs
my $nouns = join ' ' => @nouns;
## The verb may have a helper, usually a number
my $adverb;
## Installation must happen before we try to connect!
install() if $verb =~ /instal/i;
## Display more detailed help than --help
superhelp() if $verb eq 'help';
my ($STOPFILE,$REASONFILE,$REASONFILE_LOG);
## If we are trying a stop, and piddir is already set, do it now
if ('stop' eq $verb and $bcargs->{piddir}) {
$STOPFILE = "$bcargs->{piddir}/fullstopbucardo";
$REASONFILE = 'bucardo.restart.reason.txt';
$REASONFILE_LOG = 'bucardo.restart.reason.log';
stop();
}
## For everything else, we need to connect to a previously installed Bucardo database
## Create a quick data source name
my $DSN = "dbi:Pg:dbname=$bcargs->{dbname}";
$bcargs->{dbhost} and length $bcargs->{dbhost} and $DSN .= ";host=$bcargs->{dbhost}";
$bcargs->{dbport} and length $bcargs->{dbport} and $DSN .= ";port=$bcargs->{dbport}";
## Connect to the database
$dbh = DBI->connect($DSN, $bcargs->{dbuser}, $bcargs->{dbpass}, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
## We only want to concern ourselves with things in the bucardo schema
$dbh->do('SET search_path = bucardo');
## Make sure we find a valid Postgres version
## Why do we check this after a successful install?
## In case they get pg_dumped to a different (older) database. It has happened! :)
check_version($dbh); ## dies on invalid version
## Listen for the MCP. Not needed for old-school non-payload LISTEN/NOTIFY, but does no harm
$dbh->do('LISTEN bucardo');
$dbh->commit();
## Set some global variables based on information from the bucardo_config table
## The reason file records startup and shutdown messages
$REASONFILE = get_config('reason_file');
($REASONFILE_LOG = $REASONFILE) =~ s{(?:[.][^.]+)?$}{.log};
## The directory Bucardo.pm writes PID and other information to
my $PIDDIR = $bcargs->{piddir} || get_config('piddir');
## The PID file of the master control file (MCP)
## If this exists, it is a good bet that Bucardo is currently running
my $PIDFILE = "$PIDDIR/bucardo.mcp.pid";
## The stop file whose existence tells all Bucardo processes to exit immediately
my $stopfile = get_config('stopfile');
$STOPFILE = "$PIDDIR/$stopfile";
## Aliases for terms people may shorten, misspell, etc.
## Mostly used for database columns when doing an 'update'
our %alias = (
'ssp' => 'server_side_prepares',
'server_side_prepare' => 'server_side_prepares',
'port' => 'dbport',
'host' => 'dbhost',
'name' => 'dbname',
'user' => 'dbuser',
'pass' => 'dbpass',
'password' => 'dbpass',
'service' => 'dbservice',
);
## Columns that cannot be changed: used in the update_* subroutines
my %column_no_change = (
'id' => 1,
'cdate' => 1,
);
## Regular expression for a valid dbgroup name
my $re_dbgroupname = qr{\w[\w\d]*};
## Regular expression for a valid database name
my $re_dbname = qr{\w[\w\d]*};
## Send a ping to the MCP to make sure it is alive and responding
ping() if $verb eq 'ping';
## Make sure the Bucardo database has the latest schema
upgrade() if $verb =~ /^upgr/ or $verb eq 'uprgade' or $verb eq 'ugprade';
## All the rest of the verbs require use of global information
## Thus, we load everything right now
load_bucardo_info();
## View the status of one or more syncs
status_all() if $verb eq 'status' and ! @nouns;
status_detail() if $verb eq 'status';
## Stop, start, or restart the main Bucardo daemon
stop() if $verb eq 'stop';
start() if $verb eq 'start' or $verb eq 'strt';
restart() if $verb eq 'restart';
## Reload the configuration file
reload_config() if $verb eq 'reload' and defined $nouns[0] and $nouns[0] eq 'config';
## Reload the mcp (if args, we want reload_sync)
reload() if $verb eq 'reload' and ! defined $nouns[0];
# Reopen the log files
reopen() if $verb eq 'reopen';
## Show information about something: database, table, sync, etc.
list_item() if $verb eq 'list' or $verb eq 'l' or $verb eq 'lsit' or $verb eq 'liast'
or $verb eq 'lisy' or $verb eq 'lit';
## Add something
add_item() if $verb eq 'add';
## Remove something
remove_item() if $verb eq 'remove' or $verb eq 'delete' or $verb eq 'del';
## Update something
update_item() if $verb eq 'update' or $verb eq 'upd' or $verb eq 'udpate';
## Inspect something
inspect() if $verb eq 'inspect';
## Inject a message into the Bucardo logs
message() if $verb eq 'message' or $verb eq 'msg';
## Show or set an item from the bucardo.config table
config() if $verb eq 'set' or $verb eq 'show' or $verb eq 'config';
## Validate a sync
validate() if $verb =~ /^vali/;
## Purge the delta/track tables
purge() if $verb eq 'purge';
## Clone a database
clone() if $verb eq 'clone';
## View delta statistics
count_deltas() if $verb eq 'delta' or $verb eq 'deltas';
## There are only a few valid verbs left, so we check for them now
if ($verb ne 'kick' and $verb ne 'activate' and $verb ne 'deactivate'
and $verb ne 'reload'
and $verb ne 'pause' and $verb ne 'resume') {
## Show help and exit
help(1, qq{Unknown command "$verb"\n});
}
## For all remaining verbs, we expect a list of syncs with an optional decimal "timeout"
## If there are no syncs, no sense in going on!
if (! keys %$SYNC) {
die qq{No syncs have been created yet!\n};
}
## The final list of syncs we are going to do something to
my @syncs;
## The fail msg on a non-match
my $msg;
## Loop through each noun and handle it
SYNCMATCH: for my $sync (@nouns) {
## Quick skipping of noise word 'sync'
next if $sync =~ /^syncs?$/;
## If this is a number, it's a timeout, so set it and skip to the next noun
if ($sync =~ /^\d+$/) {
$adverb = $sync;
next SYNCMATCH;
}
## If they want all syncs, grab them all and stop reading any more nouns
if ($sync eq 'all') {
undef @syncs;
for my $name (sort keys %$SYNC) {
push @syncs => $name;
}
last SYNCMATCH;
}
## The rest are all ways of finding the sync they want
## Change the name to a Perl-regex friendly form
(my $term = $sync) =~ s/%/\*/g;
$term =~ s/([^\.])\*/$1.*/g;
$term =~ s/^\*/.*/;
if ($term =~ /\*/) {
for my $name (sort keys %$SYNC) {
push @syncs => $name if $name =~ /^$term$/;
}
next SYNCMATCH;
}
## Now that wildcards are out, we must have an absolute match
if (! exists $SYNC->{$sync}) {
$msg = qq{Sync "$sync" does not appear to exist\n};
## No sense in going on
last SYNCMATCH;
}
## Got a direct match, so store it away
push @syncs => $sync;
}
## If syncs is empty, a regular expression search failed
if (!@syncs) {
$msg = qq{No matching syncs were found\n};
}
## If we have a message, something is wrong
if (defined $msg) {
## Be nice and print a list of active syncs
my @goodsyncs;
for my $s (sort keys %$SYNC) {
push @goodsyncs => $s if $SYNC->{$s}{status} eq 'active';
}
if (@goodsyncs) {
$msg .= "Active syncs:\n";
$msg .= join "\n" => map { " $_" } @goodsyncs;
}
die "$msg\n";
}
## Activate or deactivate one or more syncs
vate_sync() if $verb eq 'activate' or $verb eq 'deactivate';
## Kick one or more syncs
kick() if $verb eq 'kick';
## Pause or resume one or more syncs
pause_resume($verb) if $verb eq 'pause' or $verb eq 'resume';
## Reload one or more syncs
reload_sync() if $verb eq 'reload';
## If we reach here (and we should not), display help and exit
help(1);
exit;
## Everything from here on out is subroutines
sub get_config {
## Given a name, return the matching value from the bucardo_config table
## Arguments: one
## 1. setting name
## Returns: bucardo_config.value string
my $name = shift;
$SQL = 'SELECT setting FROM bucardo.bucardo_config WHERE LOWER(name) = ?';
$sth = $dbh->prepare_cached($SQL);
$count = $sth->execute(lc $name);
if ($count < 1) {
$sth->finish();
die "Invalid bucardo_config setting: $name\n";
}
return $sth->fetchall_arrayref()->[0][0];
} ## end of get_config
sub numbered_relations {
## Sorting function
## Arguments: none (implicit $a / $b via Perl sorting)
## Returns: winning value
## Sorts relations of the form schema.table
## in which we do alphabetical first, but switch to numeric order
## for any numbers at the end of the schema or the table
## Thus, public.foobar1 will come before public.foobar10
## Pull in the names to be sorted, dereference as needed
my $uno = ref $a ? "$a->{schemaname}.$a->{tablename}" : $a;
my $dos = ref $b ? "$b->{schemaname}.$b->{tablename}" : $b;
## Break apart the first item into schema and table
die if $uno !~ /(.+)\.(.+)/;
my ($schema1,$sbase1,$table1,$tbase1) = ($1,$1,$2,$2);
## Store ending numbers if available: if not, use 0
my ($snum1, $tnum1) = (0,0);
$sbase1 =~ s/(\d+)$// and $snum1 = $1;
$tbase1 =~ s/(\d+)$// and $tnum1 = $1;
## Break apart the second item into schema and table
die if $dos !~ /(.+)\.(.+)/;
my ($schema2,$sbase2,$table2,$tbase2) = ($1,$1,$2,$2);
my ($snum2, $tnum2) = (0,0);
$sbase2 =~ s/(\d+)$// and $snum2 = $1;
$tbase2 =~ s/(\d+)$// and $tnum2 = $1;
return (
$sbase1 cmp $sbase2
or $snum1 <=> $snum2
or $tbase1 cmp $tbase2
or $tnum1 <=> $tnum2);
} ## end of numbered_relations
sub check_version {
## Quick check that we have the minumum supported version
## This is for the bucardo database itself
## Arguments: one
## 1. Database handle
## Returns: undef (may die if the version is not good)
my $dbh = shift;
my $res = $dbh->selectall_arrayref('SELECT version()')->[0][0];
if ($res !~ /(\d+)\.(\d+)/) {
die "Sorry, unable to determine the database version\n";
}
my ($maj,$min) = ($1,$2);
if ($maj < 8 or (8 == $maj and $min < 1)) {
die "Sorry, Bucardo requires Postgres version 8.1 or higher. This is only $maj.$min\n";
}
return;
} ## end of check_version
sub _pod2usage {
require Pod::Usage;
Pod::Usage::pod2usage(
'-verbose' => 99,
'-exitval' => 2,
@_
);
return;
}
sub help {
my ($exitval, $message) = @_;
## Give detailed help about usage of this program
## Arguments: none
## Returns: never, always exits
## Nothing to do if we are being quiet
exit 0 if $QUIET;
_pod2usage(
'-message' => $message,
'-sections' => '^(?:USAGE|COMMANDS|OPTIONS)$',
'-exitval' => $exitval || 0,
);
return;
} ## end of help
sub superhelp {
## Show detailed help by examining the verb and nouns
## Arguments: none
## Returns: never, always exits
## If there are no nouns, we can only show the generic help
help() if ! @nouns;
# Make sure all commands and actions, as well as their aliases, are here.
my %names = (
( map { $_ => 'relgroup' } qw(relgroup herd) ),
( map { $_ => 'db' } qw(db database) ),
( map { $_ => 'list' } qw(l lsit liast lisy lit) ),
( map { $_ => 'upgrade' } qw(upgrade uprgade ugprade) ),
( map { $_ => 'start' } qw(start strt) ),
( map { $_ => 'remove' } qw(remove delete del) ),
( map { $_ => 'update' } qw(update upd udpate) ),
map { $_ => $_ } qw(
activate
add
all
config
customcode
customcols
customname
dbgroup
deactivate
delta
help
inspect
install
kick
list
message
ping
purge
reload
reload
restart
sequence
sequences
set
show
status
stop
sync
table
tables
validate
),
);
# Standardize names.
my @names;
for my $noun (@nouns) {
push @names => $names{ lc $noun } || $names{ standardize_name($noun) }
|| help( 1, 'Unknown command: ' . join ' ' => @nouns );
}
my @command = ($names[0]);
if (@names > 1) {
## Actions are documented in Pod as "=head3 $action $command".
push @command, join ' ', @names;
}
else {
## Don't show subsections for commands that have them.
push @command, => '!.+' if $names[0] eq 'add' || $names[0] eq 'update';
}
usage_exit(join('/' => @command), 0);
return;
} ## end of superhelp
sub ping {
## See if the MCP is alive and responds to pings
## Default is to wait 15 seconds
## Arguments: none, but looks in @nouns for a timeout
## Returns: never, exits
## Set the default timeout, but override if any remaining args start with a number
my $timeout = 15;
for (@nouns) {
if (/^(\d+)/) {
$timeout = $1;
last;
}
}
$VERBOSE and print "Pinging MCP, timeout = $timeout\n";
$dbh->do('LISTEN bucardo_mcp_pong');
$dbh->do('NOTIFY bucardo_mcp_ping');
$dbh->commit();
my $starttime = time;
sleep 0.1;
## Loop until we timeout or get a confirmation from the MCP
P:{
## Grab any notices that have come in
my $notify = $dbh->func('pg_notifies');
if (defined $notify) {
## Extract the PID that sent this notice
my ($name, $pid, $payload) = @$notify;
## We are done: ping successful
$QUIET or print "OK: Got response from PID $pid\n";
exit 0;
}
## Rollback, sleep, and check for a timeout
$dbh->rollback();
sleep 0.5;
my $totaltime = time - $starttime;
if ($timeout and $totaltime >= $timeout) {
## We are done: ping failed
$QUIET or print "CRITICAL: Timed out ($totaltime s), no ping response from MCP\n";
exit 1;
}
redo;
}
return;
} ## end of ping
sub start {
## Attempt to start the Bucardo daemon
## Arguments: none
## Returns: undef
## Write a note to the 'reason' log file
## This will automatically write any nouns in as well
append_reason_file('start');
## Refuse to go on if we get a ping response within 5 seconds
$QUIET or print "Checking for existing processes\n";
## We refuse to start if the MCP PID file exists and looks valid
if (-e $PIDFILE) {
open my $fh, '<', $PIDFILE or die qq{Could not open "$PIDFILE": $!\n};
my $pid = <$fh> =~ /(\d+)/ ? $1 : 0;
close $fh or warn qq{Could not close $PIDFILE: $!\n};
$msg = qq{Cannot start, PID file "$PIDFILE" exists\n};
if (!$pid) {
warn qq{File "$PIDFILE" does not start with a PID!\n};
}
else {
## We have a PID, see if it is still alive
my $res = kill 0 => $pid;
if (0 == $res) {
warn qq{Removing file "$PIDFILE" with stale PID $pid\n};
unlink $PIDFILE;
$msg = '';
}
}
if ($msg) {
$QUIET or print $msg;
append_reason_file('fail');
exit 1;
}
}
## Verify that the version in the database matches our version
my $dbversion = get_config('bucardo_version')
or die "Could not find Bucardo version!\n";
if ($dbversion ne $VERSION) {
my $message = "Version mismatch: bucardo is $VERSION, but bucardo database is $dbversion\n";
append_reason_file('fail');
warn $message;
warn "Perhaps you need to run 'bucardo upgrade' ?\n";
exit 1;
}
## Create a new Bucardo daemon
## If we are a symlink, put the source directory in our path
if (-l $progname and readlink $progname) {
my $dir = dirname( readlink $progname );
unshift @INC, $dir;
}
require Bucardo;
$bcargs->{exit_on_nosync} = delete $bcargs->{'exit-on-nosync'}
if exists $bcargs->{'exit-on-nosync'};
my $bc = Bucardo->new($bcargs);
## Verify that the version of Bucardo.pm matches our version
my $pm_version = $bc->{version} || 'unknown';
if ($VERSION ne $pm_version) {
my $message = "Version mismatch: bucardo is $VERSION, but Bucardo.pm is $pm_version\n";
append_reason_file('fail');
die $message;
}
## Just in case, stop it
stop_bucardo();
if (-e $STOPFILE) {
print qq{Removing file "$STOPFILE"\n} unless $QUIET;
unlink $STOPFILE;
}
$QUIET or print qq{Starting Bucardo\n};
## Disconnect from our local connection before we fork
$dbh->disconnect();
## Remove nouns from @opts.
## XXX Will fail if an option value is the same as a noun.
my %remove = map { $_ => undef } @nouns;
@opts = grep { ! exists $remove{$_} } @opts;
## Fork and setsid to disassociate ourselves from the daemon
if (fork) {
## We are the kid, do nothing
}
else {
setsid() or die;
## Here we go!
$bc->start_mcp( \@opts );
}
exit 0;
} ## end of start
sub stop {
## Attempt to stop the Bucardo daemon
## Arguments: none
## Returns: undef
## Write a note to the 'reason' log file
append_reason_file('stop');
print "Creating $STOPFILE ... " unless $QUIET;
stop_bucardo();
print "Done\n" unless $QUIET;
## If this was called directly, just exit now
exit 0 if $verb eq 'stop';
return;
} ## end of stop
sub stop_bucardo {
## Create the semaphore that tells all Bucardo processes to exit
## Arguments: none
## Returns: undef
## Create the file, and write some quick debug information into it
## The only thing the processe care about is if the file exists
open my $stop, '>', $STOPFILE or die qq{Could not create "$STOPFILE": $!\n};
print {$stop} "Stopped by $progname on " . (scalar localtime) . "\n";
close $stop or warn qq{Could not close "$STOPFILE": $!\n};
return;
} ## end of stop_bucardo
sub restart {
## Simple, really: stop, wait, start!
## Arguments: none
## Returns: undef
stop();
sleep 1;
start();
return;
} ## end of restart
sub reload {
## Reload the MCP daemon
## Effectively restarts everything
## Arguments: none
## Returns: never, exits
## Is Bucardo active?
my $pong = 'bucardo_mcp_pong';
$dbh->do("LISTEN $pong");
$dbh->do('NOTIFY bucardo_mcp_ping');
$dbh->commit();
## Wait a little bit, then scan for the confirmation message
sleep 0.1;
if (! wait_for_notice($dbh, $pong, 2)) {
die "Looks like Bucardo is not running, so there is no need to reload\n";
}
## We want to wait to hear from the MCP that it is done
my $done = 'bucardo_reloaded_mcp';
$dbh->do('NOTIFY bucardo_mcp_reload');
$dbh->do("LISTEN $done");
$dbh->commit();
## Wait a little bit, then scan for the confirmation message
sleep 0.1;
my $timeout = $adverb || get_config('reload_config_timeout') || 30;
if (! wait_for_notice($dbh, $done, $timeout) ) {
die "Waited ${timeout}s, but Bucardo never confirmed the reload!\n"
. "HINT: Pass a longer timeout to the reload_config command or set the\n"
. "reload_config_timeout configuration setting to wait longer\n";
}
print "DONE!\n";
exit 0;
} ## end of reload
sub reload_config {
## Reload configuration settings from the bucardo database,
## then restart all controllers and kids
## Arguments: none directly (but processes the nouns to check for numeric arg)
## Returns: never, exits
## Scan the nouns for a numeric argument.
## If found, set as the adverb.
## This will cause us to wait for confirmation or reload before exiting
for (@nouns) {
if (/^(\d+)$/) {
$adverb = $1;
last;
}
}
$QUIET or print qq{Forcing Bucardo to reload the bucardo_config table\n};
## Is Bucardo active?
my $pong = 'bucardo_mcp_pong';
$dbh->do("LISTEN $pong");
$dbh->do('NOTIFY bucardo_mcp_ping');
$dbh->commit();
## Wait a little bit, then scan for the confirmation message
sleep 0.1;
if (! wait_for_notice($dbh, $pong, 2)) {
die "Looks like Bucardo is not running, so there is no need to reload\n";
}
## We want to wait to hear from the MCP that it is done
my $done = 'bucardo_reload_config_finished';
$dbh->do('NOTIFY bucardo_reload_config');
$dbh->do("LISTEN $done");
$dbh->commit();
## Wait a little bit, then scan for the confirmation message
sleep 0.1;
my $timeout = $adverb || get_config('reload_config_timeout') || 30;
if (! wait_for_notice($dbh, $done, $timeout) ) {
die "Waited ${timeout}s, but Bucardo never confirmed the configuration reload!\n"
. "HINT: Pass a longer timeout to the reload_config command or set the\n"
. "reload_config_timeout configuration setting to wait longer\n";
}
print "DONE!\n";
exit 0;
} ## end of reload_config
sub wait_for_notice {
## Keep hanging out until we get the notice we are waiting for
## Arguments: three
## 1. Database handle
## 2. String(s) to listen for
## 3. How long to wait (default is forever)
## Returns: 1
## If the strings argument is an array ref, this will return a hash ref
## where each key is a string we found, and the value is how many times we
## found it. Note that we return as soon as we've found at least one
## matching NOTIFY; we don't wait for the full timeout to see which
## messages show up.
my ($ldbh, $string, $howlong) = @_;
my ($num_strings, %search_strings, %matches);
my $found = 0;
if (ref $string eq 'ARRAY') {
$num_strings = scalar @$string;
map { $search_strings{$_} = 1 } @$string;
}
else {
$num_strings = 1;
$search_strings{$string} = 1;
}
my $start_time = [gettimeofday];
WAITIN: {
for my $notice (@{ db_get_notices($ldbh) }) {
my ($name) = @$notice;
if (exists $search_strings{$name}) {
$found = 1;
$matches{$name}++;
}
}
last WAITIN if $found;
if (defined $howlong) {
my $elapsed = tv_interval( $start_time );
return 0 if ($elapsed >= $howlong and (scalar keys %matches == 0));
}
$dbh->commit();
sleep($WAITSLEEP);
redo;
}
if (scalar keys %matches) {
if ($num_strings == 1) {
return 1;
}
else {
return \%matches;
}
}
else {
if ($num_strings == 1) {
return 0;
}
else {
return {};
}
}
} ## end of wait_for_notice
sub reload_sync {
## Ask for one or more syncs to be reloaded
## Arguments: none directly (but processes the nouns for a list of syncs)
## Returns: never, exits
my $doc_section = 'reload';
usage_exit($doc_section) unless @nouns;
for my $syncname (@nouns) {
## Be nice and allow things like $0 reload sync foobar
next if $syncname eq 'sync';
## Make sure this sync exists, and grab its status
$SQL = 'SELECT status FROM bucardo.sync WHERE name = ?';
$sth = $dbh->prepare($SQL);
$count = $sth->execute($syncname);
if ($count != 1) {
warn "Invalid sync: $syncname\n";
$sth->finish();
next;
}
my $status = $sth->fetch()->[0];
## Skip any syncs that are not active
if ($status ne 'active') {
warn qq{Cannot reload: status of sync "$syncname" is $status\n};
next;
}
## We wait for the MCP to tell us that each sync is done reloading
my $done = "bucardo_reloaded_sync_$syncname";
my $err = "bucardo_reload_error_sync_$syncname";
print "Reloading sync $syncname...";
$dbh->do(qq{LISTEN "$done"});
$dbh->do(qq{LISTEN "$err"});
$dbh->do(qq{NOTIFY "bucardo_reload_sync_$syncname"});
$dbh->commit();
## Sleep a little, then wait until we hear a confirmation from the MCP
sleep 0.1;
my $res = wait_for_notice($dbh, [$err, $done], 10);
if ($res == 0 or scalar keys %$res == 0) {
print "Reload of sync $syncname failed; reload response message never received\n";
}
elsif (exists $res->{$done}) {
print "Reload of sync $syncname successful\n";
}
elsif (exists $res->{$err}) {
print "Reload of sync $syncname failed\n";
}
else {
print "ERROR. Reload results unavailable, because something weird happened.\n";
}
print "\n";
} ## end each sync to be reloaded
exit 0;
} ## end of reload_sync
sub reopen {
## Signal the bucardo processes that they should reopen any log files
## Used after a log rotation
## Sends a USR2 to all Bucardo processes
## Arguments: none
## Returns: never, exits
open my $fh, '<', $PIDFILE
or die qq{Could not open pid file $PIDFILE: is Bucardo running?\n};
## Grab the PID of the MCP
if (<$fh> !~ /(\d+)/) { ## no critic
die qq{Could not find a PID in file $PIDFILE!\n};
}
close $fh or warn qq{Could not close $PIDFILE: $!\n};
my $gid = getpgrp $1;
$gid =~ /^\d+$/ or die qq{Unable to obtain the process group\n};
## Quick mapping of names to numbers so we can kill effectively
my $x = 0;
my %signumber;
for (split(' ', $Config{sig_name})) {
$signumber{$_} = $x++;
}
my $signumber = $signumber{USR2};
## The minus indicates we are sending to the whole group
my $num = kill -$signumber, $gid;
if ($num < 1) {
warn "Unable to signal any processed with USR2\n";
exit 1;
}
$QUIET or print "Sent USR2 to Bucardo processes\n";
exit 0;
} ## end of reopen
sub validate {
## Attempt to validate one or more syncs
## Arguments: none directly (but processes the nouns for a list of syncs)
## Returns: never, exits
my $doc_section = 'validate';
usage_exit($doc_section) unless @nouns;
## Build the list of syncs to validate
my @synclist;
## Nothing specific is the same as 'all'
if ($nouns[0] eq 'all' and ! defined $nouns[1]) {
@synclist = sort keys %$SYNC;
if (! @synclist) {
print "Sorry, there are no syncs to validate!\n";
exit 0;
}
}
else {
for my $name (@nouns) {
## Be nice and allow things like $0 validate sync foobar
next if $name eq 'sync';
if (! exists $SYNC->{$name}) {
die qq{Sorry, there is no sync named "$name"\n};
}
push @synclist => $name;
}
}
## Get the largest sync name so we can line up the dots all pretty
my $maxsize = 1;
for my $name (@synclist) {
$maxsize = length $name if length $name > $maxsize;
}
$maxsize += 3;
## Loop through and validate each in turn,
## waiting for a positive response from the MCP
my $exitval = 0;
for my $name (@synclist) {
printf "Validating sync $name %s ",
'.' x ($maxsize - length $name);
my ($evalok, $success);
eval {
my ($message) = $dbh->selectrow_array(
'SELECT validate_sync(?)',
undef, $name
);
$dbh->commit;
if ($message eq 'MODIFY') {
$success = 1;
}
else {
warn "$message\n";
$exitval++;
}
$evalok = 1;
};
if ($evalok) {
print "OK\n" if $success;
}
else {
warn $dbh->errstr || $@;
$exitval++;
}
}
exit $exitval;
} ## end of validate
sub count_deltas {
## Count up rows in the delta tables
## Does not remove "unvacuumed" rows: assumes delta tables are getting emptied out by VAC
## Arguments: optional
## Returns: nothing, exits
## May want to see totals only
my $total_only = (defined $nouns[0] and $nouns[0] =~ /totals?/i) ? 1 : 0;
## See if we want to limit it to specific databases
my %dblimit;
for my $name (@nouns) {
## Do not limit if doing a total, even if other names are specified
next if $total_only;
## Allow wildcards
if ($name =~ s/[%*]/.*/) {
for (grep { $_ =~ /$name/ } keys %$DB) {
$dblimit{$_}++;
}
}
elsif (exists $DB->{$name}) {
$dblimit{$name}++;
}
}
## No matches means we stop right away
if (@nouns and !keys %dblimit and !$total_only) {
warn qq{No matching databases were found: try "bucardo list dbs"\n};
exit 1;
}
my $total = { grand => 0 };
for my $dbname (sort keys %$DB) {
my $db = $DB->{$dbname};
## Only sources should get checked
if (! $db->{issource}) {
if (delete $dblimit{$dbname}) {
print "Skipping database $dbname: not a source\n";
}
elsif ($VERBOSE >= 1) {
print "Skipping $dbname: not a source\n";
}
next;
}
## If we are limiting, possibly skip this one
next if keys %dblimit and ! exists $dblimit{$dbname};
## Make sure it has a bucardo schema.
## May not if validate_sync has never been run!
my $dbh = connect_database($dbname);
if (! schema_exists('bucardo')) {
warn "Cannot check database $dbname: no bucardo schema!\n";
next;
}
## Grab all potential delta tables
$SQL = 'SELECT deltaname FROM bucardo.bucardo_delta_names';
for my $row (@{ $dbh->selectall_arrayref($SQL) }) {
my $tname = $row->[0];
$SQL = "SELECT count(*) FROM bucardo.$tname";
$count = $dbh->selectall_arrayref($SQL)->[0][0];
$total->{grand} += $count;
$total->{database}{$dbname} += $count;
if ($db->{status} ne 'active') {
$total->{databaseinactive}{$dbname} = 1;
}
}
$dbh->disconnect();
}
## Stop here if we did not actually scan any databases because they are all non-source
if (! keys %{ $total->{database} }) {
print "No databases to check\n";
exit 1;
}
## Figure out our sizes for a pretty alignment
my $grandmessage = 'Total deltas across all targets';
my $dbmessage = 'Total deltas for database';
my $size = { db => 0, largest => length $grandmessage, };
for my $db (keys %{ $total->{database} }) {
$size->{db} = length $db if length $db > $size->{db};
my $len = length " $dbmessage $db";
$size->{largest} = $len if $len > $size->{largest};
}
printf "%*s: %s\n", $size->{largest}, $grandmessage, pretty_number($total->{grand});
## Break it down by database
for my $db (sort keys %{ $total->{database} }) {
next if $total_only;
printf "%*s: %s%s\n",
$size->{largest},
" $dbmessage $db",
pretty_number($total->{database}{$db}),
$total->{databaseinactive}{$db} ? ' (not active)' : '';
}
exit 0;
} ## end of count_deltas
sub purge {
## Purge the delta and track tables for one or more tables, for one or more databases
## Arguments: variable
## Returns: never, exits
## TODO: databases, tables, timeslices
my $doc_section = 'purge';
## Nothing specific is the same as 'all'
my $doall = 0;
if (!@nouns or ($nouns[0] eq 'all' and ! defined $nouns[1])) {
$doall = 1;
for my $dbname (sort keys %$DB) {
my $db = $DB->{$dbname};
## Do not purge inactive databases
next if $db->{status} ne 'active';
## Do not purge unless they are a source
next if ! $db->{issource};
print "Checking db $dbname\n";
## Make sure it has a bucardo schema.
## May not if validate_sync has never been run!
my $dbh = connect_database($dbname);
if (! schema_exists('bucardo')) {
warn "Cannot purge database $dbname: no bucardo schema!\n";
next;
}
## Run the purge_delta on this database
$SQL = 'SELECT bucardo.bucardo_purge_delta(?)';
$sth = $dbh->prepare($SQL);
$sth->execute('1 second');
my $results = $sth->fetchall_arrayref()->[0][0];
## Dump the resulting message back to the user
## Should be like this: Tables processed: 3
print "$dbname: $results\n";
$dbh->commit();
}
}
if (! $doall) {
for my $name (@nouns) {
die "Purging name $name\n";
}
}
exit 0;
} ## end of purge
sub add_item {
## Add an item to the internal bucardo database
## Arguments: none directly (but processes the nouns)
## Returns: never, exits
my $doc_section = 'add/!.+';
usage_exit($doc_section) unless @nouns;
## First word is the type of thing we are adding
my $thing = shift @nouns;
## Account for variations and abbreviations
$thing = standardize_name($thing);
## All of these will exit and do not return
add_customcode() if $thing eq 'customcode';
add_customname() if $thing eq 'customname';
add_customcols() if $thing eq 'customcols';
add_database() if $thing eq 'database';
add_dbgroup() if $thing eq 'dbgroup';
add_herd() if $thing eq 'herd';
add_sync() if $thing eq 'sync';
## The rest is tables and sequences
## We need to support 'add table all' as well as 'add all tables'
my $second_arg = $nouns[0] || '';
## Rearrange the args as needed, and determine if we want 'all'
my $do_all = 0;
if ($thing eq 'all') {
$do_all = 1;
$thing = shift @nouns;
$thing = standardize_name($thing);
}
elsif (lc $second_arg eq 'all') {
$do_all = 1;
shift @nouns;
}
## Quick check in case someone thinks they should add a goat
if ($thing =~ /^goat/i) {
warn qq{Cannot add a goat: use add table or add sequence instead\n};
exit 1;
}
## Add a table
if ($thing eq 'table') {
if ($do_all) {
## Add all the tables, and return the output
print add_all_tables();
## The above does not commit, so make sure we do it here
confirm_commit();
exit 0;
}
else {
add_table('table');
}
}
## Add a sequence
if ($thing eq 'sequence') {
if ($do_all) {
## Add all the sequences, and return the output
print add_all_sequences();
## The above does not commit, so make sure we do it here
$dbh->commit();
exit 0;
}
else {
add_table('sequence');
}
}
## Anything past this point is an error
if ($do_all) {
warn qq{The 'all' option can only be used with 'table' and 'sequence'\n};
exit 1;
}
usage_exit($doc_section);
return;
} ## end of add_item
sub update_item {
## Update some object in the database
## This merely passes control on to the more specific update_ functions
## Arguments: none (but parses nouns)
## Returns: undef
my $doc_section = 'update/!.+';
## Must have at least three nouns
usage_exit($doc_section) if @nouns < 3;
## What type of thing are we updating?
my $thing = shift @nouns;
## Account for variations and abbreviations
$thing = standardize_name($thing);
my $code = $thing eq 'customcode' ? \&update_customcode
: $thing eq 'database' ? \&update_database
: $thing eq 'dbgroup' ? \&update_dbgroup
: $thing eq 'sync' ? \&update_sync
: $thing eq 'table' ? \&update_table
: $thing eq 'sequence' ? \&update_table
: usage_exit($doc_section)
;
## The update function returns, due to recursion, so we must exit.
$code->(@nouns);
exit 0;
} ## end of update_item
sub list_item {
## Show information about one or more items in the bucardo database
## Arguments: none, but parses nouns
## Returns: 0 on success, -1 on error
my $doc_section = 'list';
usage_exit($doc_section) unless @nouns;
## First word is the type if thing we are listing
my $thing = shift @nouns;
## Account for variations and abbreviations
$thing = standardize_name($thing);
SWITCH: {
$thing eq 'clone' and do {
list_clones();
last SWITCH;
};
$thing eq 'config' and do {
$verb = 'config';
config();
exit;
};
$thing eq 'customcode' and do {
list_customcodes();
last SWITCH;
};
$thing eq 'customname' and do {
list_customnames();
last SWITCH;
};
$thing eq 'customcols' and do {
list_customcols();
last SWITCH;
};
## The dbgroup must be checked before the database (dbg vs db)
$thing eq 'dbgroup' and do {
list_dbgroups();
last SWITCH;
};
$thing eq 'database' and do {
list_databases();
last SWITCH;
};
$thing eq 'herd' and do {
list_herds();
last SWITCH;
};
$thing eq 'sync' and do {
list_syncs();
last SWITCH;
};
$thing eq 'table' and do {
list_tables();
last SWITCH;
};
$thing eq 'sequence' and do {
list_sequences();
last SWITCH;
};
$thing eq 'all' and do {
## Not shown on purpose: clones
if (keys %$CUSTOMCODE) {
print "-- customcodes:\n"; list_customcodes();
}
if (keys %$CUSTOMNAME) {
print "-- customnames:\n"; list_customnames();
}
if (keys %$CUSTOMCOLS) {
print "-- customcols:\n"; list_customcols();
}
print "-- dbgroups:\n"; list_dbgroups();
print "-- databases:\n"; list_databases();
print "-- relgroup:\n"; list_herds();
print "-- syncs:\n"; list_syncs();
print "-- tables:\n"; list_tables();
print "-- sequences:\n"; list_sequences();
print "\n";
last SWITCH;
};
## catch all
## Cannot list anything else
usage_exit($doc_section);
} # SWITCH
exit 0;
} ## end of list_item
sub remove_item {
## Delete from the bucardo database
## Arguments: none, but parses nouns
## Returns: never, exits
my $doc_section = 'remove';
usage_exit($doc_section) unless @nouns;
## First word is the type if thing we are removing
my $thing = shift @nouns;
## Account for variations and abbreviations
$thing = standardize_name($thing);
my $second_arg = $nouns[0] || '';
## Allow the keyword 'all' to appear before or after the noun
my $do_all = 0;
if ($thing eq 'all') {
$do_all = 1;
$thing = shift @nouns;
$thing = standardize_name($thing);
}
elsif (lc $second_arg eq 'all') {
$do_all = 1;
shift @nouns;
}
my $arg = $do_all ? 'all' : '';
## All of these will exit and do not return
remove_customcode($arg) if $thing eq 'customcode';
remove_customname($arg) if $thing eq 'customname';
remove_customcols($arg) if $thing eq 'customcols';
## The dbgroup must be checked before the database (dbg vs db)
remove_database($arg) if $thing eq 'database';
remove_dbgroup($arg) if $thing eq 'dbgroup';
remove_herd($arg) if $thing eq 'herd';
remove_sync($arg) if $thing eq 'sync';
remove_relation('table', $arg) if $thing eq 'table';
remove_relation('sequence', $arg) if $thing eq 'sequence';
## Do not know how to remove anything else
usage_exit($doc_section);
return;
} ## end of remove_item
##
## Database-related subroutines: add, remove, update, list
##
sub add_database {
## Add one or more databases. Inserts to the bucardo.db table
## By default, we do a test connection as well (turn off with the --force argument)
## Arguments: two or more
## 1. The internal name Bucardo uses to refer to this database
## 2+ name=value parameters, dash-dash arguments
## Returns: undef
## Example: bucardo add db nyc1 dbname=nyc1 dbhost=nyc1.example.com dbgroup=sales
## Example: bucardo add dbs nyc1,nyc2 dbname=nyc1,nyc2 dbgroup=sales
## Grab our generic usage message
my $doc_section = 'add/add db';
## The first word is the internal name (bucardo.db.name) - may have commas
my $item_name = shift @nouns || '';
## No name is a problem
usage_exit($doc_section) unless length $item_name;
## We may have more than one database specified at once
## Assign to an array, and set the role as well in case a dbgroup is set
my $db_names = [];
my $newsource = 0;
for my $entry (split /\s*,\s*/ => $item_name) {
## First database defaults to source, others to targets
if (! @$db_names and $entry !~ /:/) {
$entry .= ':source';
$newsource = 1;
}
push @{ $db_names } => [ extract_name_and_role($entry) ];
}
## Inputs and aliases, database column name, flags, default value
my $validcols = q{
db|dbname dbname 0 null
type|dbtype dbtype 0 postgres
pass|password|dbpass dbpass 0 null
host|dbhost|pghost dbhost 0 ENV:PGHOSTADDR|PGHOST
port|dbport|pgport dbport 0 ENV:PGPORT
conn|dbconn|pgconn dbconn 0 null
service|dbservice dbservice 0 null
stat|status status =active|inactive null
group|dbgroup dbgroup 0 null
addalltables none 0 null
addallsequences none 0 null
server_side_prepares|ssp server_side_prepares TF null
makedelta makedelta TF null
};
## Include the value for the dbuser only if a service is not specified, or
## a user was explicitly included. In other words, don't default the user
## name when there's a service.
$validcols .= "user|username|dbuser dbuser 0 bucardo\n"
if ((! grep { /^(db)?service=/ } @nouns) || grep { /^(db)?user(name)?=/ } @nouns);
my ($dbcols) = process_simple_args({
cols => $validcols,
list => \@nouns,
doc_section => $doc_section,
});
## Must have a database name unless using a service
if (! exists $dbcols->{dbname} && ! exists $dbcols->{dbservice}) {
print qq{Cannot add database: must supply a database name to connect to\n};
exit 1;
}
## Cannot add if already there
for my $db (map { $_->[0] } @$db_names) {
if (exists $DB->{ $db }) {
print qq{Cannot add database: the name "$db" already exists\n};
exit 1;
}
}
## Clean up and standardize the type name
my $dbtype = $dbcols->{dbtype} = standardize_rdbms_name($dbcols->{dbtype});
## If we have a service, strip the host and port as they may have been set via ENV
if (exists $dbcols->{dbservice}) {
delete $dbcols->{dbport};
delete $dbcols->{dbhost};
}
## We do not want some things to hang around in the dbcols hash
my $dbgroup = delete $dbcols->{dbgroup};
## Map each value into individual databases
my %dbinfo;
for my $k (sort keys %$dbcols) {
## Each db in db_names needs to have an associated value for each dbcol entry
## Hence, we only use dbcols to build list of columns: values are kept in a hash
next if $dbcols->{$k} !~ /,/;
my @list = split /\s*,\s*/ => $dbcols->{$k};
my $value;
## The dbnames can contain role information: strip it out from here
if ('dbname' eq $k) {
@list = map { [extract_name_and_role($_)]->[0] } @list;
}
for (my $x=0; defined $db_names->[$x]; $x++) {
$value = $list[$x] if defined $list[$x];
$dbinfo{$k}[$x] = $value;
}
}
## Attempt to insert into the bucardo.db table
my $columns = join ',' => keys %$dbcols;
my $qs = '?,' x keys %$dbcols;
$SQL = "INSERT INTO bucardo.db (name,$columns) VALUES (${qs}?)";
debug("SQL: $SQL");
$sth = $dbh->prepare($SQL);
for (my $x = 0; defined $db_names->[$x]; $x++) {
my @args;
for my $key (keys %$dbcols) {
push @args => exists $dbinfo{$key} ? $dbinfo{$key}->[$x] : $dbcols->{$key};
}
my $evalok = 0;
debug(Dumper $db_names->[$x]);
debug(Dumper \@args);
eval {
$sth->execute($db_names->[$x][0], @args);
$evalok = 1;
};
if (! $evalok) {
if ($@ =~ /"db_name_sane"/) {
die qq{Invalid name: you cannot refer to this database as "$db_names->[$x]"\n};
}
die "Failed to add database: $@\n";
}
}
## Store certain messages so we can output them in a desired order
my $finalmsg = '';
## Test database handle
my $testdbh;
## May want to do a test connection to each databases
TESTCONN: {
## Nothing else to do for flatfiles
last TESTCONN if 'flatfile' eq $dbtype;
## Get the module name, the way to refer to its database
## This also makes sure we have a valid type
my %dbtypeinfo = (
drizzle => ['DBD::drizzle', 'Drizzle database'],
mongo => ['MongoDB', 'MongoDB'],
mysql => ['DBD::mysql', 'MySQL database'],
mariadb => ['DBD::mysql', 'MariaDB database'],
oracle => ['DBD::Oracle', 'Oracle database'],
postgres => ['DBD::Pg', 'PostgreSQL database'],
redis => ['Redis', 'Redis database'],
sqlite => ['DBD::SQLite', 'SQLite database'],
);
if (! exists $dbtypeinfo{$dbtype}) {
die qq{Unknown database type: $dbtype\n};
}
my ($module,$fullname) = @{ $dbtypeinfo{$dbtype} };
## Gather connection information from the database via db_getconn
$SQL = 'SELECT bucardo.db_getconn(?)';
$sth = $dbh->prepare($SQL);
for my $db (map { $_->[0] } @$db_names) {
$sth->execute($db);
my $dbconn = $sth->fetchall_arrayref()->[0][0];
## Must be able to load the Perl driver
my $evalok = 0;
eval {
eval "require $module";
$evalok = 1;
};
if (! $evalok) {
die "Cannot add unless the Perl module '$module' is available: $@\n";
}
## Reset for the evals below
$evalok = 0;
## Standard args for the DBI databases
## We put it here as we may move around with the Postgres bucardo user trick
my ($type,$dsn,$user,$pass) = split /\n/ => $dbconn;
## Handle all of the ones that do not use standard DBI first
if ('mongo' eq $dbtype) {
my $mongodsn = {};
for my $line (split /\n/ => $dbconn) {
next if $line !~ /(\w+):\s+(.+)/;
$mongodsn->{$1} = $2;
}
eval {
$testdbh = MongoDB::Connection->new($mongodsn); ## no critic
$evalok = 1;
};
}
elsif ('redis' eq $dbtype) {
my $tempdsn = {};
for my $line (split /\n/ => $dbconn) {
next if $line !~ /(\w+):\s+(.+)/;
$tempdsn->{$1} = $2;
}
my $server;
if (exists $tempdsn->{host}) {
$server = $tempdsn->{host};
}
if (exists $tempdsn->{port}) {
$server .= ":$tempdsn->{port}";
}
my @dsn;
if (defined $server) {
push @dsn => 'server', $server;
}
$evalok = 0;
eval {
$testdbh = Redis->new(@dsn);
$evalok = 1;
};
}
## Anything else must be something with a standard DBI driver
else {
eval {
$testdbh = DBI->connect($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
$evalok = 1;
};
}
## At this point, we have eval'd a connection
if ($evalok) {
## Disconnect from DBI.
$testdbh->disconnect if $module =~ /DBD/;
}
else {
my $err = $DBI::errstr || $@;
## For Postgres, we get a little fancy and try to account for instances
## where the bucardo user may not exist yet, by reconnecting and
## creating said user if needed.
if ($DBI::errstr
and 'postgres' eq $dbtype
and $user eq 'bucardo'
and $DBI::errstr =~ /bucardo/
and eval { require Digest::MD5; 1 }) {
# Try connecting as postgres instead.
print qq{Connection to "$db" ($fullname) as user bucardo failed.\nError was: $DBI::errstr\n\n};
print qq{Will try to connect as user postgres and create superuser $user...\n\n};
my $dbh = eval {
DBI->connect($dsn, 'postgres', $pass, {AutoCommit=>1,RaiseError=>1,PrintError=>0});
};
if ($dbh) {
## Create the bucardo user now. We'll need a password;
## create one if we don't have one.
my $connok = 0;
eval {
my $newpass = $pass || generate_password();
my $encpass = Digest::MD5::md5_hex($newpass);
$dbh->do(qq{CREATE USER $user SUPERUSER ENCRYPTED PASSWORD '$encpass'});
$dbh->disconnect;
my $extrauser = $pass ? '' : qq{ with password "$newpass"};
warn "Created superuser '$user'$extrauser\n\n";
$pass = $newpass;
$connok = 1;
};
goto TESTCONN if $connok;
$err = $DBI::errstr || $@;
$msg = "Unable to create superuser $user";
}
else {
$err = $DBI::errstr || $@;
$msg = 'Connection as postgres failed, too';
}
}
else {
$msg = qq{Connection to "$db" ($fullname) as user $user failed};
}
die "$msg. You may force add it with the --force argument.\nError was: $err\n\n"
unless $bcargs->{force};
warn "$msg, but will add anyway.\nError was: $err\n";
}
} ## End each database to connect to
} ## end of TESTCONN
## If we got a group, process that as well
if (defined $dbgroup) {
## If the dbnames had supplied role information, extract that now
if (exists $dbcols->{dbname} and $dbcols->{dbname} =~ /:/) {
my $x=0;
for my $namerole (split /\s*,\s*/ => $dbcols->{dbname}) {
my ($name,$role) = extract_name_and_role($namerole);
debug("$namerole gave us $name and $role");
$db_names->[$x++][1] = $role;
}
}
## If it has an attached role, strip it out and force that everywhere
my $master_role = $dbgroup =~ s/:(\w+)// ? $1 : 0;
## We need to store this away as the function below changes the global hash
my $isnew = exists $DBGROUP->{$dbgroup} ? 0 : 1;
my $firstrow = 1;
for my $row (@$db_names) {
my ($db,$role) = @$row;
## If we set this source ourself, change to target if the group already exists
if ($firstrow) {
$firstrow = 0;
if ($newsource and ! $isnew) {
$role = 'target';
}
}
## The master role trumps everything
$role = $master_role if $master_role;
my ($newgroup, $newrole) = add_db_to_group($db, "$dbgroup:$role");
if ($isnew) {
$finalmsg .= qq{Created dbgroup "$newgroup"\n};
$isnew = 0;
}
$finalmsg .= qq{ Added database "$db" to dbgroup "$newgroup" as $newrole\n};
}
}
## Adjust the db name so add_all_* can use it
$bcargs->{db} = $db_names->[0][0];
## Make sure $DB gets repopulated for the add_all_* calls below
load_bucardo_info(1);
## Add in all tables for this database
$finalmsg .= add_all_tables() if grep /addalltab/i, @nouns;
## Add in all sequences for this database
$finalmsg .= add_all_sequences() if grep /addallseq/i, @nouns;
if (!$QUIET) {
my $list = join ',' => map { qq{"$_->[0]"} } @$db_names;
printf qq{Added %s %s\n},
$list =~ /,/ ? 'databases' : 'database', $list;
$finalmsg and print $finalmsg;
}
confirm_commit();
exit 0;
} ## end of add_database
sub remove_database {
## Remove one or more databases. Updates the bucardo.db table
## Use the --force argument to clear out related tables and groups
## Arguments: one or more
## 1+ Name of a database
## Returns: undef
## Example: bucardo remove db nyc1 nyc2 --force
my $doc_section = 'remove';
usage_exit($doc_section) unless @nouns;
## Make sure all named databases exist
for my $name (@nouns) {
if (! exists $DB->{$name}) {
die qq{No such database "$name"\n};
}
}
## Prepare the SQL to delete each database
$SQL = 'DELETE FROM bucardo.db WHERE name = ?';
$sth = $dbh->prepare($SQL);
## Loop through and attempt to delete each given database
for my $name (@nouns) {
## Wrap in an eval so we can handle known exceptions
my $evalok = 0;
$dbh->pg_savepoint('try_remove_db');
eval {
$sth->execute($name);
$evalok = 1;
};
if (! $evalok) {
if ($bcargs->{force} and $@ =~ /"goat_db_fk"|"dbmap_db_fk"/) {
$QUIET or warn qq{Dropping all tables and dbgroups that reference database "$name"\n};
$dbh->pg_rollback_to('try_remove_db');
$dbh->do('DELETE FROM bucardo.goat WHERE db = ' . $dbh->quote($name));
$dbh->do('DELETE FROM bucardo.dbmap WHERE db = ' . $dbh->quote($name));
## Try the same query again
eval {
$sth->execute($name);
};
}
## We've failed: output a reasonable message when possible
if ($@ =~ /"goat_db_fk"/) {
die qq{Cannot delete database "$name": must remove all tables that reference it first (try --force)\n};
}
if ($@ =~ /"dbmap_db_fk"/) {
die qq{Cannot delete database "$name": must remove all dbmap references first (try --force)\n};
}
$@ and die qq{Could not delete database "$name"\n$@\n};
}
}
for my $name (@nouns) {
$QUIET or print qq{Removed database "$name"\n};
}
confirm_commit();
exit 0;
} ## end of remove_database
sub update_database {
## Update one or more databases.
## This may modify the bucardo.db, bucardo.dbgroup, and bucardo.dbmap tables
## Arguments: two plus
## 1. Name of the database to update. Can be "all" and can have wildcards
## 2+ What exactly we are updating.
## Returns: undef
## Example: bucardo update db nyc1 port=6543 group=nycservers:source,globals
my @actions = @_;
## Grab our generic usage message
my $doc_section = 'update/update db';
usage_exit($doc_section) unless @actions;
my $name = shift @actions;
## Recursively call ourselves for wildcards and 'all'
return if ! check_recurse($DB, $name, @actions);
## Make sure this database exists!
if (! exists $DB->{$name}) {
die qq{Could not find a database named "$name"\nUse 'list dbs' to see all available.\n};
}
## Everything is a name=value setting after this point
## We will ignore and allow noise word "set"
for my $arg (@actions) {
next if $arg =~ /set/i;
next if $arg =~ /\w+=\w+/o;
usage_exit($doc_section);
}
## Change the arguments into a hash
my $args = process_args(join ' ' => @actions);
## Track what changes we made
my %change;
## Walk through and handle each argument pair
for my $setting (sort keys %$args) {
next if $setting eq 'extraargs';
## Change the name to a more standard form, to better figure out what they really mean
## This also excludes all non-alpha characters
my $newname = transform_name($setting);
## Exclude ones that cannot / should not be changed (e.g. cdate)
if (exists $column_no_change{$newname}) {
print "Sorry, the value of $setting cannot be changed\n";
exit 1;
}
## Standardize the values as well
my $value = $args->{$setting};
my $newvalue = transform_value($value);
## Handle all the non-standard columns
if ($newname =~ /^group/) {
## Track the changes and publish at the end
my @groupchanges;
## Grab the current hash of groups
my $oldgroup = $DB->{$name}{group} || '';
## Keep track of what groups they end up in, so we can remove as needed
my %donegroup;
## Break apart into individual groups
for my $fullgroup (split /\s*,\s*/ => $newvalue) {
my ($group,$role,$extra) = extract_name_and_role($fullgroup);
## Note that we've found this group
$donegroup{$group}++;
## Does this group exist?
if (! exists $DBGROUP->{$group}) {
create_dbgroup($group);
push @groupchanges => qq{Created dbgroup "$group"};
}
## Are we a part of it already?
if ($oldgroup and exists $oldgroup->{$group}) {
## Same role?
my $oldrole = $oldgroup->{$group}{role};
if ($oldrole eq $role) {
$QUIET or print qq{No change: database "$name" already belongs to dbgroup "$group" as $role\n};
}
else {
change_db_role($role,$group,$name);
push @groupchanges => qq{Changed role for database "$name" in dbgroup "$group" from $oldrole to $role};
}
}
else {
## We are not a part of this group yet
add_db_to_group($name, "$group:$role");
push @groupchanges => qq{Added database "$name" to dbgroup "$group" as $role};
}
## Handle any extra modifiers
if (keys %$extra) {
update_dbmap($name, $group, $extra);
my $list = join ',' => map { "$_=$extra->{$_}" } sort keys %$extra;
push @groupchanges => qq{For database "$name" in dbgroup "$group", set $list};
}
} ## end each group specified
## See if we are removing any groups
if ($oldgroup) {
for my $old (sort keys %$oldgroup) {
next if exists $donegroup{$old};
## Remove this database from the group, but do not remove the group itself
remove_db_from_group($name, $old);
push @groupchanges => qq{Removed database "$name" from dbgroup "$old"};
}
}
if (@groupchanges) {
for (@groupchanges) {
chomp;
$QUIET or print "$_\n";
}
confirm_commit();
}
## Go to the next setting
next;
} ## end of 'group' adjustments
## This must exist in our hash
if (! exists $DB->{$name}{$newname}) {
print qq{Cannot change "$newname"\n};
next;
}
my $oldvalue = $DB->{$name}{$newname};
## Has this really changed?
if ($oldvalue eq $newvalue) {
print "No change needed for $newname\n";
next;
}
## Add to the queue. Overwrites previous ones
$change{$newname} = [$oldvalue, $newvalue];
} ## end each setting
## If we have any changes, attempt to make them all at once
if (%change) {
my $SQL = 'UPDATE bucardo.db SET ';
$SQL .= join ',' => map { "$_=?" } sort keys %change;
$SQL .= ' WHERE name = ?';
my $sth = $dbh->prepare($SQL);
eval {
$sth->execute((map { $change{$_}[1] } sort keys %change), $name);
};
if ($@) {
$dbh->rollback();
$dbh->disconnect();
print "Sorry, failed to update the bucardo.db table. Error was:\n$@\n";
exit 1;
}
for my $item (sort keys %change) {
my ($old,$new) = @{ $change{$item} };
print "Changed bucardo.db $item from $old to $new\n";
}
confirm_commit();
}
return;
} ## end of update_database
sub list_databases {
## Show information about databases. Queries the bucardo.db table
## Arguments: zero or more
## 1+ Databases to view. Can be "all" and can have wildcards
## Returns: 0 on success, -1 on error
## Example: bucardo list db sale%
## Might be no databases yet
if (! keys %$DB) {
print "No databases have been added yet\n";
return -1;
}
## If not doing all, keep track of which to show
my %matchdb;
for my $term (@nouns) {
## Special case for all: same as no nouns at all, so simply remove them!
if ($term =~ /\ball\b/i) {
undef %matchdb;
undef @nouns;
last;
}
## Check for wildcards
if ($term =~ s/[*%]/.*/) {
for my $name (keys %$DB) {
$matchdb{$name} = 1 if $name =~ /^$term$/;
}
next;
}
## Must be an exact match
for my $name (keys %$DB) {
$matchdb{$name} = 1 if $name eq $term;
}
} ## end each term
## No matches?
if (@nouns and ! keys %matchdb) {
print "No matching databases found\n";
return -1;
}
## We only show the type if they are different from each other
my %typecount;
## Figure out the length of each item for a pretty display
my ($maxdb,$maxtype,$maxstat,$maxlim1,$maxlim2,$showlim) = (1,1,1,1,1,0);
for my $name (sort keys %$DB) {
next if @nouns and ! exists $matchdb{$name};
my $info = $DB->{$name};
$typecount{$info->{dbtype}}++;
$maxdb = length $info->{name} if length $info->{name} > $maxdb;
$maxtype = length $info->{dbtype} if length $info->{dbtype} > $maxtype;
$maxstat = length $info->{status} if length $info->{status} > $maxstat;
}
## Do we show types?
my $showtypes = keys %typecount > 1 ? 1 : 0;
## Now do the actual printing
for my $name (sort keys %$DB) {
next if @nouns and ! exists $matchdb{$name};
my $info = $DB->{$name};
my $type = sprintf 'Type: %-*s ',
$maxtype, $info->{dbtype};
printf 'Database: %-*s %sStatus: %-*s ',
$maxdb, $info->{name},
$showtypes ? $type : '',
$maxstat, $info->{status};
my $showhost = length $info->{dbhost} ? " -h $info->{dbhost}" : '';
my $showport = $info->{dbport} =~ /\d/ ? " -p $info->{dbport}" : '';
my $dbtype = $info->{dbtype};
if ($dbtype eq 'postgres') {
print "Conn: psql$showport -U $info->{dbuser} -d $info->{dbname}$showhost";
if (! $info->{server_side_prepares}) {
print ' (SSP is off)';
}
if ($info->{makedelta}) {
print ' (makedelta on)';
}
}
if ($dbtype eq 'drizzle') {
$showport = (length $info->{dbport} and $info->{dbport} != 3306)
? " --port $info->{dbport}" : '';
printf 'Conn: drizzle -u %s -D %s%s%s',
$info->{dbuser},
$info->{dbname},
$showhost,
$showport;
}
if ($dbtype eq 'flatfile') {
print "Prefix: $info->{dbname}";
}
if ($dbtype eq 'mongo') {
if (length $info->{dbhost}) {
print "Host: $info->{dbhost}";
}
}
if ($dbtype eq 'mysql' or $dbtype eq 'mariadb') {
$showport = (length $info->{dbport} and $info->{dbport} != 3306)
? " --port $info->{dbport}" : '';
printf 'Conn: mysql -u %s -D %s%s%s',
$info->{dbuser},
$info->{dbname},
$showhost,
$showport;
}
if ($dbtype eq 'oracle') {
printf 'Conn: sqlplus %s%s',
$info->{dbuser},
$showhost ? qq{\@$showhost} : '';
}
if ($dbtype eq 'redis') {
my $server = '';
if (length $info->{dbhost}) {
$server .= $info->{dbhost};
}
if (length $info->{dbport}) {
$server .= ":$info->{dbport}";
}
if ($server) {
$server = "server=$server";
print "Conn: $server";
}
}
if ($dbtype eq 'sqlite') {
printf 'Conn: sqlite3 %s',
$info->{dbname};
}
print "\n";
if ($VERBOSE) {
## Which dbgroups is this a member of?
if (exists $info->{group}) {
for my $group (sort keys %{ $info->{group} }) {
my $i = $info->{group}{$group};
my $role = $i->{role};
my $gang = $i->{gang};
my $pri = $i->{priority};
print " Belongs to dbgroup $group ($role)";
$pri and print " Priority:$pri";
print "\n";
}
}
## Which syncs are using it, and as what role
if (exists $info->{sync}) {
for my $syncname (sort keys %{ $info->{sync} }) {
print " Used in sync $syncname in a role of $info->{sync}{$syncname}{role}\n";
}
}
$VERBOSE >= 2 and show_all_columns($info);
}
}
return 0;
} ## end of list_databases
##
## Database-group-related subroutines: add, remove, update, list
##
sub add_dbgroup {
## Add one or more dbgroups. Inserts to the bucardo.dbgroup table
## May also insert to the bucardo.dbmap table
## Arguments: one plus
## 1. The name of the group we are creating
## 2+ Databases to add to this group, with optional role information attached
## Returns: undef
## Example: bucardo add dbgroup nycservers nyc1:source nyc2:source lax1
## Grab our generic usage message
my $doc_section = 'add/add dbgroup';
my $name = shift @nouns || '';
## Must have a name
usage_exit($doc_section) unless length $name;
## Create the group if it does not exist
if (! exists $DBGROUP->{$name}) {
create_dbgroup($name);
$QUIET or print qq{Created dbgroup "$name"\n};
}
## Add all these databases to the group
for my $dblist (@nouns) {
for my $fulldb (split /\s*,\s*/ => $dblist) {
## Figure out the optional role
my ($db,$role) = extract_name_and_role($fulldb);
## This database must exist!
if (! exists $DB->{$db}) {
print qq{The database "$db" does not exist\n};
exit 1;
}
add_db_to_group($db, "$name:$role");
$QUIET or print qq{Added database "$db" to dbgroup "$name" as $role\n};
}
}
confirm_commit();
exit 0;
} ## end of add_dbgroup
sub remove_dbgroup {
## Remove one or more entries from the bucardo.dbgroup table
## Arguments: one or more
## 1+ Name of a dbgroup
## Returns: undef
## Example: bucardo remove dbgroup sales
my $doc_section = 'remove';
## Must have at least one name
usage_exit($doc_section) unless @nouns;
## Make sure all the groups exist
for my $name (@nouns) {
if (! exists $DBGROUP->{$name}) {
die qq{No such dbgroup: $name\n};
}
}
## Prepare the SQL to delete each group
$SQL = q{DELETE FROM bucardo.dbgroup WHERE name = ?};
$sth = $dbh->prepare($SQL);
for my $name (@nouns) {
## Wrap in an eval so we can handle known exceptions
eval {
$sth->execute($name);
};
if ($@) {
if ($@ =~ /"sync_dbs_fk"/) {
if ($bcargs->{force}) {
$QUIET or warn qq{Dropping all syncs that reference the dbgroup "$name"\n};
$dbh->rollback();
$dbh->do('DELETE FROM bucardo.sync WHERE dbs = ' . $dbh->quote($name));
eval {
$sth->execute($name);
};
goto NEND if ! $@;
}
else {
die qq{Cannot remove dbgroup "$name": it is being used by one or more syncs\n};
}
}
die qq{Could not delete dbgroup "$name"\n$@\n};
}
NEND:
$QUIET or print qq{Removed dbgroup "$name"\n};
}
confirm_commit();
exit 0;
} ## end of remove_dbgroup
sub update_dbgroup {
## Update one or more dbgroups
## This may modify the bucardo.dbgroup and bucardo.dbmap tables
## Arguments: two or more
## 1. Group to be updated
## 2. Databases to be adjusted, or name change request (name=newname)
## Returns: undef
## Example: bucardo update dbgroup sales A:target
my @actions = @_;
my $doc_section = 'update/update dbgroup';
usage_exit($doc_section) unless @actions;
my $name = shift @actions;
## Recursively call ourselves for wildcards and 'all'
exit 0 if ! check_recurse($DBGROUP, $name, @actions);
## Make sure this dbgroup exists!
if (! exists $DBGROUP->{$name}) {
die qq{Could not find a dbgroup named "$name"\nUse 'list dbgroups' to see all available.\n};
}
## From this point on, we have either:
## 1. A rename request
## 2. A database to add/modify
## Track dbs and roles
my %dblist;
## Track if we call confirm_commit or not
my $changes = 0;
for my $action (@actions) {
## New name for this group?
if ($action =~ /name=(.+)/) {
my $newname = $1;
if ($newname !~ /^$re_dbgroupname$/) {
die qq{Invalid dbgroup name "$newname"\n};
}
next if $name eq $newname; ## Duh
$SQL = 'UPDATE bucardo.dbgroup SET name=? WHERE name=?';
$sth = $dbh->prepare($SQL);
$sth->execute($newname, $name);
$QUIET or print qq{Changed dbgroup name from "$name" to "$newname"\n};
$changes++;
next;
}
## Assume the rest is databases to modify
## Default role is always target
my ($db,$role) = extract_name_and_role($action);
$dblist{$db} = $role;
}
## Leave now if no databases to handle
if (! %dblist) {
$changes and confirm_commit();
exit 0;
}
## The old list of databases:
my $oldlist = $DBGROUP->{$name}{db} || {};
## Walk through the old and see if any were changed or removed
for my $db (sort keys %$oldlist) {
if (! exists $dblist{$db}) {
remove_db_from_group($db, $name);
$QUIET or print qq{Removed database "$db" from dbgroup "$name"\n};
$changes++;
next;
}
my $oldrole = $oldlist->{$db}{role};
my $newrole = $dblist{$db};
if ($oldrole ne $newrole) {
change_db_role($newrole, $name, $db);
$QUIET or print qq{Changed role of database "$db" in dbgroup "$name" from $oldrole to $newrole\n};
$changes++;
}
}
## Walk through the new and see if any are truly new
for my $db (sort keys %dblist) {
next if exists $oldlist->{$db};
my $role = $dblist{$db};
add_db_to_group($db, "$name:$role");
$QUIET or print qq{Added database "$db" to dbgroup "$name" as $role\n};
$changes++;
}
confirm_commit() if $changes;
return;
} ## end of update_dbgroup
sub list_dbgroups {
## Show information about all or some subset of the bucardo.dbgroup table
## Arguments: zero or more
## 1+ Groups to view. Can be "all" and can have wildcards
## Returns: 0 on success, -1 on error
## Example: bucardo list dbgroups
## Might be no groups yet
if (! keys %$DBGROUP) {
print "No dbgroups have been added yet\n";
return -1;
}
## If not doing all, keep track of which to show
my %matchdbg;
for my $term (@nouns) {
## Special case for all: same as no nouns at all, so simply remove them!
if ($term =~ /\ball\b/i) {
undef %matchdbg;
undef @nouns;
last;
}
## Check for wildcards
if ($term =~ s/[*%]/.*/) {
for my $name (keys %$DBGROUP) {
$matchdbg{$name} = 1 if $name =~ /$term/;
}
next;
}
## Must be an exact match
for my $name (keys %$DBGROUP) {
$matchdbg{$name} = 1 if $name eq $term;
}
} ## end each term
## No matches?
if (@nouns and ! keys %matchdbg) {
print "No matching dbgroups found\n";
return -1;
}
## Figure out the length of each item for a pretty display
my ($maxlen) = (1);
for my $name (sort keys %$DBGROUP) {
next if @nouns and ! exists $matchdbg{$name};
my $info = $DBGROUP->{$name};
$maxlen = length $info->{name} if length $info->{name} > $maxlen;
}
## Print it
for my $name (sort keys %$DBGROUP) {
next if @nouns and ! exists $matchdbg{$name};
my $info = $DBGROUP->{$name};
## Does it have associated databases?
my $dbs = '';
if (exists $DBGROUP->{$name}{db}) {
$dbs = ' Members:';
for my $dbname (sort keys %{ $DBGROUP->{$name}{db} }) {
my $i = $DBGROUP->{$name}{db}{$dbname};
$dbs .= " $dbname:$i->{role}";
## Only show the gang if this group is using multiple gangs
if ($DBGROUP->{$name}{gangs} >= 2) {
$dbs .= ":gang=$i->{gang}";
}
## Only show the priority if <> 0
if ($i->{priority} != 0) {
$dbs .= ":pri=$i->{priority}";
}
}
}
printf "dbgroup: %-*s%s\n",
$maxlen, $name, $dbs;
$VERBOSE >= 2 and show_all_columns($info);
}
return 0;
} ## end of list_dbgroups
##
## Customname-related subroutines: add, exists, remove, list
##
sub add_customname {
## Add an item to the customname table
## Arguments: none, parses nouns for tablename|goatid, syncname, database name
## Returns: never, exits
## Examples:
## bucardo add customname public.foobar foobarz
## bucardo add customname public.foobar foobarz sync=bee
## bucardo add customname public.foobar foobarz db=baz
## bucardo add customname public.foobar foobarz db=baz sync=bee
my $item_name = shift @nouns || '';
my $doc_section = 'add/add customname';
my $newname = shift @nouns || '';
usage_exit($doc_section) unless length $item_name && length $newname;
## Does this number or name exist?
my $goat;
if (exists $GOAT->{by_fullname}{$item_name}) {
$goat = $GOAT->{by_fullname}{$item_name};
}
elsif (exists $GOAT->{by_table}{$item_name}) {
$goat = $GOAT->{by_table}{$item_name};
}
elsif (exists $GOAT->{by_id}{$item_name}) {
$goat = $GOAT->{by_id}{$item_name};
}
else {
print qq{Could not find a matching table for "$item_name"\n};
exit 1;
}
## If this is a ref due to it being an unqualified name, just use the first one
$goat = $goat->[0] if ref $goat eq 'ARRAY';
my ($sname,$tname) = ($goat->{schemaname},$goat->{tablename});
## The new name can have a schema. If it does not, use the "old" one
my $Sname;
my $Tname = $newname;
if ($Tname =~ /(.+)\.(.+)/) {
($Sname,$Tname) = ($1,$2);
}
else {
$Sname = $sname;
}
## If the new name contains an equal sign, treat as an error
usage_exit($doc_section) if $Tname =~ /=/;
## Names cannot be the same
if ($sname eq $Sname and $tname eq $Tname) {
print qq{The new name cannot be the same as the old\n};
exit 1;
}
## Parse the rest of the arguments
my (@sync,@db);
for my $arg (@nouns) {
## Name of a sync
if ($arg =~ /^sync\s*=\s*(.+)/) {
my $sync = $1;
if (! exists $SYNC->{$sync}) {
print qq{No such sync: "$sync"\n};
exit 1;
}
push @sync => $sync;
}
elsif ($arg =~ /^(?:db|database)\s*=\s*(.+)/) {
my $db = $1;
if (! exists $DB->{$db}) {
print qq{No such database: "$db"\n};
exit 1;
}
push @db => $db;
}
else {
usage_exit($doc_section);
}
}
## Loop through and start adding rows to customname
my $goatid = $goat->{id};
$SQL = "INSERT INTO bucardo.customname(goat,newname,db,sync) VALUES ($goatid,?,?,?)";
$sth = $dbh->prepare($SQL);
## We may have multiple syncs or databases, so loop through
my $x = 0;
my @msg;
{
## Setup common message post scripts
my $message = '';
defined $db[$x] and $message .= " (for database $db[$x])";
defined $sync[$x] and $message .= " (for sync $sync[$x])";
## Skip if this exact entry already exists
if (customname_exists($goatid,$newname,$db[$x],$sync[$x])) {
if (!$QUIET) {
printf "Already have an entry for %s to %s%s\n",
$item_name, $newname, $message;
}
next;
}
$sth->execute($newname, $db[$x], $sync[$x]);
push @msg => "Transformed $sname.$tname to $newname$message";
## Always go at least one round
## We go a second time if there is another sync or db waiting
$x++;
redo if defined $db[$x] or defined $sync[$x];
last;
}
if (!$QUIET) {
for (@msg) {
chomp; ## Just in case we forgot above
print "$_\n";
}
}
confirm_commit();
exit 0;
} ## end of add_customname
sub remove_customname {
## Remove one or more entries from the bucardo.customname table
## Arguments: one or more
## 1+ IDs to be deleted
## Returns: undef
## Example: bucardo remove customname 7
## Grab our generic usage message
my $doc_section = 'remove';
usage_exit($doc_section) unless @nouns;
## Make sure each argument is a number
for my $name (@nouns) {
usage_exit($doc_section) if $name !~ /^\d+$/;
}
## We want the per-id hash here
my $cn = $CUSTOMNAME->{id};
## Give a warning if a number does not exist
for my $name (@nouns) {
if (! exists $cn->{$name}) {
$QUIET or warn qq{Customname number $name does not exist\n};
}
}
## Prepare the SQL to delete each customname
$SQL = 'DELETE FROM bucardo.customname WHERE id = ?';
$sth = $dbh->prepare($SQL);
## Go through and delete any that exist
for my $number (@nouns) {
## We've already handled these in the loop above
next if ! exists $cn->{$number};
## Unlike other items, we do not need an eval,
## because it has no cascading dependencies
$sth->execute($number);
my $cc = sprintf '%s => %s%s%s',
$cn->{$number}{tname},
$cn->{$number}{newname},
(length $cn->{$number}{sync} ? " Sync: $cn->{$number}{sync}" : ''),
(length $cn->{$number}{db} ? " Database: $cn->{$number}{db}" : '');
$QUIET or print qq{Removed customcode $number: $cc\n};
}
confirm_commit();
exit 0;
} ## end of remove_customname
sub customname_exists {
## See if an entry already exists in the bucardo.customname table
## Arguments: four
## 1. Goat id
## 2. New name
## 3. Database name (can be null)
## 4. Sync name (can be null)
## Returns: true or false (1 or 0)
my ($id,$newname,$db,$sync) = @_;
## Easy if there are no entries yet!
return 0 if ! keys %$CUSTOMNAME;
my $cn = $CUSTOMNAME->{goat};
## Quick filtering by the goatid
return 0 if ! exists $cn->{$id};
my $matchdb = defined $db ? $db : '';
my $matchsync = defined $sync ? $sync : '';
return exists $cn->{$id}{$matchdb}{$matchsync};
} ## end of customname_exists
sub list_customnames {
## Show information about all or some subset of the bucardo.customname table
## Arguments: zero or more
## 1+ Names to view. Can be "all" and can have wildcards
## Returns: 0 on success, -1 on error
## Example: bucardo list customname
## Grab our generic usage message
my $doc_section = 'list';
## Might be no entries yet
if (! keys %$CUSTOMNAME) {
print "No customnames have been added yet\n";
return -1;
}
my $cn = $CUSTOMNAME->{list};
## If not doing all, keep track of which to show
my $matches = 0;
for my $term (@nouns) {
## Special case for all: same as no nouns at all, so simply remove them!
if ($term =~ /\ball\b/i) {
undef @nouns;
last;
}
## Check for wildcards
if ($term =~ s/[*%]/.*/) {
for my $row (@$cn) {
if ($row->{tname} =~ /$term/) {
$matches++;
$row->{match} = 1;
}
}
next;
}
## Must be an exact match
for my $row (@$cn) {
if ($row->{tname} eq $term) {
$matches++;
$row->{match} = 1;
}
}
} ## end each term
## No matches?
if (@nouns and ! $matches) {
print "No matching customnames found\n";
return -1;
}
## Figure out the length of each item for a pretty display
my ($maxid,$maxname,$maxnew,$maxsync,$maxdb) = (1,1,1,1,1);
for my $row (@$cn) {
next if @nouns and ! exists $row->{match};
$maxid = length $row->{id} if length $row->{id} > $maxid;
$maxname = length $row->{tname} if length $row->{tname} > $maxname;
$maxnew = length $row->{newname} if length $row->{newname} > $maxnew;
$maxsync = length $row->{sync} if length $row->{sync} > $maxsync;
$maxdb = length $row->{db} if length $row->{db} > $maxdb;
}
## Now do the actual printing
## Sort by tablename, then newname, then sync, then db
for my $row (sort {
$a->{tname} cmp $b->{tname}
or
$a->{newname} cmp $b->{newname}
or
$a->{sync} cmp $b->{sync}
or
$a->{db} cmp $b->{db}
} @$cn) {
next if @nouns and ! exists $row->{match};
printf '%-*s Table: %-*s => %-*s',
1+$maxid, "$row->{id}.",
$maxname, $row->{tname},
$maxnew, $row->{newname};
if ($row->{sync}) {
printf ' Sync: %-*s',
$maxsync, $row->{sync};
}
if ($row->{db}) {
printf ' Database: %-*s',
$maxsync, $row->{db};
}
print "\n";
}
return 0;
} ## end of list_customnames
sub find_goat_by_item {
## Finds a goat in the %GOAT hash, using one argument as a search key
## Arguments: name. Can be a goat id or a name, possibly including schema, or wildcards
## nouns. Ref to array of other args; right now only supports "db=###"
## Results: An array of goat objects that match these keys
my $name = shift;
my $lnouns = shift;
my @lnouns = ( defined $lnouns ? @$lnouns : ());
$DEBUG and warn "Finding goats with name $name, noun: " . Dumper(@lnouns);
my @results;
## Handle ID values
if ($name =~ /^\d+$/) {
$DEBUG and warn "$name is an ID value";
push @results, $GOAT->{by_id}{$name};
}
## Handle names, with or without schemas, and with or without wildcards
else {
$DEBUG and warn "$name is a name value";
my @found_keys;
## Find GOAT keys that may include matches
map {
if (exists $GOAT->{$_}{$name}) {
push @found_keys, [ $_, $name ];
}
} qw/by_table by_fullname/;
## Handle wildcards
if (index($name, '*') >= 0 || index($name, '%') >= 0) {
my $reg_name = $name;
## Change to a regexier form
$reg_name =~ s/\./\\./g;
$reg_name =~ s/[*%]/\.\*/g;
$reg_name = "$reg_name" if $reg_name !~ /^[\^\.\%]/;
$reg_name .= '$' if $reg_name !~ /[\$\*]$/;
$DEBUG and warn "There's a wildcard here. This is the regex version: $reg_name";
map {
push @found_keys, [ 'by_fullname', $_ ];
} grep { /$reg_name/ } keys %{$GOAT->{by_fullname}};
}
## The found goat keys point to arrayrefs. Turn all that into a
## one-dimensional array of goats
$DEBUG and warn 'Found these candidate keys: '. Dumper(@found_keys);
map {
for my $b (@{$GOAT->{$_->[0]}{$_->[1]}}) {
push(@results, $b);
}
} @found_keys;
$DEBUG and warn q{Here are the goats we've found, before filtering: } . Dumper(@results);
}
if (@results && defined $results[0] && @lnouns && defined $lnouns[0]) {
my @filters = grep(/^(?:db|database)\s*=/, @lnouns);
if (@filters) {
## The @lnouns array will only contain one db= value, even if the command includes several
my $db_filter = $filters[0];
$DEBUG and warn "Database filter starting value: $db_filter";
$db_filter =~ /^(?:db|database)\s*=\s*(.+)/;
$db_filter = $1;
$DEBUG and warn "Database filter value: $db_filter";
@results = grep {
$DEBUG and warn "Comparing $_->{db} to filter value $db_filter";
$_->{db} eq $db_filter;
} @results;
}
}
$DEBUG and warn 'Here are the filtered results: ' . Dumper(@results);
@results = () if (@results and !defined $results[0]);
return @results;
} ## end of find_goat_by_item
##
## Customcols-related subroutines: add, exists, remove, list
##
sub add_customcols {
## Add an item to the customcols table
## Arguments: none, parses nouns for tablename|goatid, syncname, database name
## Returns: never, exits
## Examples:
## bucardo add customcols public.foobar "select a,b,c"
## bucardo add customcols public.foobar "select a,b,c" db=foo
## bucardo add customcols public.foobar "select a,b,c" db=foo sync=abc
my $item_name = shift @nouns || '';
my $doc_section = 'add';
## Must have a clause as well
my $clause = shift @nouns || '';
usage_exit($doc_section) unless length $item_name && length $clause;
## Does this number or name exist?
my @candidate_goats = find_goat_by_item($item_name);
if (! @candidate_goats) {
print qq{Could not find a matching table for "$item_name"\n};
exit 1;
}
# The code lower in the function is meant to handle multiple matching goats,
# but if we didn't want that, this would bleat when we ran into multiple goats.
# if ($#candidate_goats > 0) {
# print qq{Could not uniquely identify the desired table for "$item_name"\n};
# print qq{Possible choices:\n};
# print "\tdb: $_->{db}\tschema: $_->{schemaname}\ttable: $_->{tablename}\n"
# for @candidate_goats;
# exit 1;
# }
my $goat = $candidate_goats[0];
my ($sname,$tname) = ($goat->{schemaname},$goat->{tablename});
## Make sure the clause looks sane
if ($clause !~ /^\s*SELECT /i) {
warn "\nThe clause must start with SELECT\n";
usage_exit($doc_section);
}
## Parse the rest of the arguments
my (@sync,@db);
for my $arg (@nouns) {
## Name of a sync
if ($arg =~ /^sync\s*=\s*(.+)/) {
my $sync = $1;
if (! exists $SYNC->{$sync}) {
print qq{No such sync: "$sync"\n};
exit 1;
}
push @sync => $sync;
}
elsif ($arg =~ /^(?:db|database)\s*=\s*(.+)/) {
my $db = $1;
if (! exists $DB->{$db}) {
print qq{No such database: "$db"\n};
exit 1;
}
push @db => $db;
}
else {
usage_exit($doc_section);
}
}
## Loop through and start adding rows to customcols
my $goatid = $goat->{id};
$SQL = "INSERT INTO bucardo.customcols(goat,clause,db,sync) VALUES ($goatid,?,?,?)";
$sth = $dbh->prepare($SQL);
## We may have multiple syncs or databases, so loop through
my $x = 0;
my @msg;
{
## Skip if this exact entry already exists
next if customcols_exists($goatid,$clause,$db[$x],$sync[$x]);
$count = $sth->execute($clause, $db[$x], $sync[$x]);
my $message = qq{New columns for $sname.$tname: "$clause"};
defined $db[$x] and $message .= " (for database $db[$x])";
defined $sync[$x] and $message .= " (for sync $sync[$x])";
push @msg => $message;
## Always go at least one round
## We go a second time if there is another sync or db waiting
$x++;
redo if defined $db[$x] or defined $sync[$x];
last;
}
if (!$QUIET) {
for (@msg) {
chomp; ## Just in case we forgot above
print "$_\n";
}
}
confirm_commit();
exit 0;
} ## end of add_customcols
sub remove_customcols {
## Remove one or more entries from the bucardo.customcols table
## Arguments: one or more
## 1+ IDs to be deleted
## Returns: undef
## Example: bucardo remove customcols 7
my $doc_section = 'remove';
usage_exit($doc_section) unless @nouns;
## Make sure each argument is a number
for my $name (@nouns) {
usage_exit($doc_section) if $name !~ /^\d+$/;
}
## We want the per-id hash here
my $cc = $CUSTOMCOLS->{id};
## Give a warning if a number does not exist
for my $name (@nouns) {
if (! exists $cc->{$name}) {
$QUIET or warn qq{Customcols number $name does not exist\n};
}
}
## Prepare the SQL to delete each customcols
$SQL = 'DELETE FROM bucardo.customcols WHERE id = ?';
$sth = $dbh->prepare($SQL);
## Go through and delete any that exist
for my $name (@nouns) {
## We've already handled these in the loop above
next if ! exists $cc->{$name};
## Unlike other items, we do not need an eval,
## because it has no cascading dependencies
$sth->execute($name);
my $cc2 = sprintf '%s => %s%s%s',
$cc->{$name}{tname},
$cc->{$name}{clause},
(length $cc->{$name}{sync} ? " Sync: $cc->{$name}{sync}" : ''),
(length $cc->{$name}{db} ? " Database: $cc->{$name}{db}" : '');
$QUIET or print qq{Removed customcols $name: $cc2\n};
}
confirm_commit();
exit 0;
} ## end of remove_customcols
sub customcols_exists {
## See if an entry already exists in the bucardo.customcols table
## Arguments: four
## 1. Goat id
## 2. Clause
## 3. Database name (can be null)
## 4. Sync name (can be null)
## Returns: true or false (1 or 0)
my ($id,$clause,$db,$sync) = @_;
## Easy if there are no entries yet!
return 0 if ! keys %$CUSTOMCOLS;
my $cc = $CUSTOMCOLS->{goat};
## Quick filtering by the goatid
return 0 if ! exists $cc->{$id};
## And by the clause therein
return 0 if ! exists $cc->{$id}{$clause};
## Is there a match for this db and sync combo?
for my $row (@{ $cc->{$id}{$clause} }) {
if (defined $db) {
next if (! length $row->{db} or $row->{db} ne $db);
}
else {
next if length $row->{db};
}
if (defined $sync) {
next if (! length $row->{sync} or $row->{sync} ne $sync);
}
else {
next if length $row->{sync};
}
## Complete match!
return 1;
}
return 0;
} ## end of customcols_exists
sub list_customcols {
## Show information about all or some subset of the bucardo.customcols table
## Arguments: zero or more
## 1+ Names to view. Can be "all" and can have wildcards
## Returns: 0 on success, -1 on error
## Example: bucardo list customcols
my $doc_section = 'list';
## Might be no entries yet
if (! keys %$CUSTOMCOLS) {
print "No customcols have been added yet\n";
return -1;
}
my $cc = $CUSTOMCOLS->{list};
## If not doing all, keep track of which to show
my $matches = 0;
for my $term (@nouns) {
## Special case for all: same as no nouns at all, so simply remove them!
if ($term =~ /\ball\b/i) {
undef @nouns;
last;
}
## Check for wildcards
if ($term =~ s/[*%]/.*/) {
for my $row (@$cc) {
if ($row->{tname} =~ /$term/) {
$matches++;
$row->{match} = 1;
}
}
next;
}
## Must be an exact match
for my $row (@$cc) {
if ($row->{tname} eq $term) {
$matches++;
$row->{match} = 1;
}
}
} ## end each term
## No matches?
if (@nouns and ! $matches) {
print "No matching customcols found\n";
return -1;
}
## Figure out the length of each item for a pretty display
my ($maxid,$maxname,$maxnew,$maxsync,$maxdb) = (1,1,1,1,1);
for my $row (@$cc) {
next if @nouns and ! exists $row->{match};
$maxid = length $row->{id} if length $row->{id} > $maxid;
$maxname = length $row->{tname} if length $row->{tname} > $maxname;
$maxnew = length $row->{clause} if length $row->{clause} > $maxnew;
$maxsync = length $row->{sync} if length $row->{sync} > $maxsync;
$maxdb = length $row->{db} if length $row->{db} > $maxdb;
}
## Now do the actual printing
## Sort by tablename, then newname, then sync, then db
for my $row (sort {
$a->{tname} cmp $b->{tname}
or
$a->{clause} cmp $b->{clause}
or
$a->{sync} cmp $b->{sync}
or
$a->{db} cmp $b->{db}
} @$cc) {
next if @nouns and ! exists $row->{match};
printf '%-*s Table: %-*s => %-*s',
1+$maxid, "$row->{id}.",
$maxname, $row->{tname},
$maxnew, $row->{clause};
if ($row->{sync}) {
printf ' Sync: %-*s',
$maxsync, $row->{sync};
}
if ($row->{db}) {
printf ' Database: %-*s',
$maxsync, $row->{db};
}
print "\n";
}
return 0;
} ## end of list_customcols
##
## Table-related subroutines: add, remove, update, list
##
sub add_table {
my $reltype = shift;
## Add one or more tables or sequences. Inserts to the bucardo.goat table
## May also update the bucardo.herd and bucardo.herdmap tables
## Arguments: one. Also parses @nouns for table / sequence names
## 1. Type of object to be added: table, or sequence
## Returns: undef
## Example: bucardo add table pgbench_accounts foo% myschema.abc
## Grab our generic usage message
my $doc_section = 'add/add table';
usage_exit($doc_section) unless @nouns;
## Inputs and aliases, database column name, flags, default
my $validcols = q{
db db 0 null
autokick|ping autokick TF null
rebuild_index rebuild_index numeric null
analyze_after_copy analyze_after_copy TF null
makedelta makedelta 0 null
herd|relgroup herd 0 skip
strict_checking strict_checking TF 1
};
my ( $dbcols, $cols, $phs, $vals, $extra ) = process_simple_args({
cols => $validcols,
list => \@nouns,
doc_section => $doc_section,
});
## Loop through all the args and attempt to add the tables
## This returns a hash with the following keys: relations, match, nomatch
my $goatlist = get_goat_ids(args => \@nouns, type => $reltype, dbcols => $dbcols);
## The final output. Store it up all at once for a single QUIET check
my $message = '';
## We will be nice and indicate anything that did not match
if (keys %{ $goatlist->{nomatch} }) {
$message .= "Did not find matches for the following terms:\n";
for (sort keys %{ $goatlist->{nomatch} }) {
$message .= " $_\n";
}
}
## Now we need to output which ones were recently added
if (keys %{ $goatlist->{new} }) {
$message .= "Added the following tables or sequences:\n";
for (sort keys %{ $goatlist->{new} }) {
$message .= " $_\n";
}
}
## If they requested a herd and it does not exist, create it
if (exists $extra->{relgroup}) {
my $herdname = $extra->{relgroup};
if (! exists $HERD->{$herdname}) {
$SQL = 'INSERT INTO bucardo.herd(name) VALUES(?)';
$sth = $dbh->prepare($SQL);
$sth->execute($herdname);
$message .= qq{Created the relgroup named "$herdname"\n};
}
## Now load all of these tables into this herd
$SQL = 'INSERT INTO bucardo.herdmap (herd,priority,goat) VALUES (?,?,'
. qq{ (SELECT id FROM goat WHERE schemaname||'.'||tablename=? AND db=? AND reltype='$reltype'))};
$sth = $dbh->prepare($SQL);