Bucardo-5.4.1/0000755000175000017500000000000012601643631011534 5ustar greggregBucardo-5.4.1/dist/0000755000175000017500000000000012601643631012477 5ustar greggregBucardo-5.4.1/dist/bucardo-logfiles.patch0000644000175000017500000000272512427203642016747 0ustar greggreg--- bucardo.schema
+++ bucardo.schema
@@ -135,9 +135,9 @@ log_showpid|1|Show PID in the log output?
log_showlevel|0|Show log level in the log output?
log_showline|0|Show line number in the log output?
log_showtime|3|Show timestamp in the log output? 0=off 1=seconds since epoch 2=scalar gmtime 3=scalar localtime
-log_conflict_file|bucardo_conflict.log|Name of the conflict detail log file
+log_conflict_file|/var/log/bucardo/bucardo_conflict.log|Name of the conflict detail log file
log_level|NORMAL|How verbose to make the logging. Higher is more verbose.
-warning_file|bucardo.warning.log|File containing all log lines starting with "Warning"
+warning_file|/var/log/bucardo/bucardo.warning.log|File containing all log lines starting with "Warning"
\.
-- Versioning
@@ -161,7 +161,7 @@ email_debug_file||File to save a copy of all outgoing emails to
flatfile_dir|.|Directory to store the flatfile output inside of
host_safety_check||Regex to make sure we don't accidentally run where we should not
piddir|/var/run/bucardo|Directory holding Bucardo PID files
-reason_file|bucardo.restart.reason.txt|File to hold reasons for stopping and starting
+reason_file|/var/log/bucardo/bucardo.restart.reason.txt|File to hold reasons for stopping and starting
semaphore_table|bucardo_status|Table to let apps know a sync is ongoing
statement_chunk_size|10000|How many primary keys to shove into a single statement
stats_script_url|http://www.bucardo.org/|Location of the stats script
Bucardo-5.4.1/dist/bucardo.init0000755000175000017500000000510112427203642015003 0ustar greggreg#!/bin/bash
#
# /etc/rc.d/init.d/bucardo
#
# Starts / stops the bucardo daemon
#
# chkconfig: - 65 35
# description: Bucardo replication service
# processname: bucardo
# Source function library.
. /etc/init.d/functions
# Find the name of the script
NAME=`basename $0`
if [ ${NAME:0:1} = "S" -o ${NAME:0:1} = "K" ]
then
NAME=${NAME:3}
fi
# For SELinux we need to use 'runuser' not 'su'
if [ -x /sbin/runuser ]
then
SU=runuser
else
SU=su
fi
SYSUSER=${SYSUSER-postgres}
DBNAME=${DBNAME-bucardo}
DBUSER=${DBUSER-bucardo}
LOGDEST=${LOGDEST-/var/log/${NAME}}
PIDDIR=${PIDDIR-/var/run/${NAME}}
# Override defaults from /etc/sysconfig/bucardo, if file is present:
[ -f /etc/sysconfig/${NAME} ] && . /etc/sysconfig/${NAME}
if [ -z "$DBHOST" ]; then hostopt=""; else hostopt="--db-host $DBHOST"; fi
if [ -z "$DBPORT" ]; then portopt=""; else portopt="--db-port $DBPORT"; fi
DESTOPTS=$(printf ' \055-log-dest %s ' "${LOGDEST[@]}")
bucardo_flags="--quiet ${hostopt} ${portopt} --db-name ${DBNAME} --db-user ${DBUSER} ${DESTOPTS} --pid-dir ${PIDDIR}"
RETVAL=0
start() {
# Make sure that bucardo is not already running:
if [ -f "${PIDDIR}/bucardo.mc.pid" ]; then
echo -n "${NAME} is already running"
echo_success
echo
exit 0
fi
echo -n $"Starting ${NAME} service: "
$SU $SYSUSER -c "bucardo ${bucardo_flags} start 'Started by init script'"
RETVAL=$?
if [ $RETVAL -eq 0 ]; then
echo_success
echo
else
echo_failure
echo
script_result=1
fi
}
stop(){
echo -n $"Stopping ${NAME} service: "
$SU $SYSUSER -c "bucardo ${bucardo_flags} stop 'Stopped by init script'"
RETVAL=$?
if [ $RETVAL -eq 0 ]; then
echo_success
echo
else
echo_failure
echo
script_result=1
fi
}
reload(){
echo -n $"Reloading ${NAME} config: "
$SU $SYSUSER -c "bucardo $bucardo_flags reload_config"
RETVAL=$?
if [ $RETVAL -eq 0 ]; then
echo_success
echo
else
echo_failure
echo
script_result=1
fi
}
status(){
echo -n $"Checking ${NAME} status: "
$SU $SYSUSER -c "bucardo $bucardo_flags status"
RETVAL=$?
if [ $RETVAL -eq 0 ]; then
echo_success
echo
else
echo_failure
echo
script_result=1
fi
}
#
# See how we were called.
#
case "$1" in
start)
start
;;
stop)
stop
;;
reload)
reload
;;
restart)
stop
sleep 2
start
RETVAL=$?
;;
status)
status
;;
*)
echo $"Usage: $0 {start|stop|restart|reload|status}"
exit 1
esac
exit $RETVAL
Bucardo-5.4.1/dist/bucardo.spec0000644000175000017500000001006412427203642014773 0ustar greggreg%define realname Bucardo
%define sysuser postgres
Name: bucardo
Version: 4.99.7
Release: 2%{?dist}
Summary: Postgres replication system for both multi-master and multi-slave operations
Group: Applications/Databases
License: BSD
URL: http://bucardo.org/
Source0: http://bucardo.org/downloads/Bucardo-%{version}.tar.gz
BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
Source1: master-master-replication-example.txt
Source2: bucardo.init
Patch0: bucardo-logfiles.patch
BuildArch: noarch
BuildRequires: perl(ExtUtils::MakeMaker)
BuildRequires: perl(DBI)
BuildRequires: perl(DBD::Pg)
BuildRequires: perl(IO::Handle)
BuildRequires: perl(Sys::Hostname)
BuildRequires: perl(Sys::Syslog)
BuildRequires: perl(Net::SMTP)
BuildRequires: perl(List::Util)
BuildRequires: perl(Pod::Usage)
# available from fedora 10
BuildRequires: perl(DBIx::Safe)
BuildRequires: perl(boolean)
Requires: postgresql
Requires: perl(ExtUtils::MakeMaker)
Requires: perl(DBI)
Requires: perl(DBD::Pg)
Requires: perl(DBIx::Safe)
Requires: perl(IO::Handle)
Requires: perl(Sys::Hostname)
Requires: perl(Sys::Syslog)
Requires: perl(Net::SMTP)
Requires: perl(List::Util)
Requires: perl(Pod::Usage)
Requires: perl(boolean)
#testsuite
Requires: perl(Test::Simple)
Requires: perl(Test::Harness)
%description
Bucardo is an asynchronous PostgreSQL replication system, allowing for both
multi-master and multi-slave operations.It was developed at Backcountry.com
primarily by Greg Sabino Mullane of End Point Corporation.
%pre
mkdir -p /var/run/bucardo
mkdir -p /var/log/bucardo
chown -R %{sysuser}:%{sysuser} /var/run/bucardo
chown -R %{sysuser}:%{sysuser} /var/log/bucardo
%prep
%setup -q -n %{realname}-%{version}
%patch0 -p0
%build
%{__perl} Makefile.PL INSTALLDIRS=vendor
make %{?_smp_mflags}
%install
rm -rf %{buildroot}
make pure_install PERL_INSTALL_ROOT=%{buildroot}
find %{buildroot} -type f -name .packlist -exec rm -f {} +
find %{buildroot} -depth -type d -exec rmdir {} 2>/dev/null \;
sed -i -e '1d;2i#!/usr/bin/perl' bucardo
rm -f %{buildroot}/%{_bindir}/bucardo
install -Dp -m 755 bucardo %{buildroot}/%{_sbindir}/bucardo
install -Dp -m 644 %{SOURCE1} .
# install init script
install -d %{buildroot}/etc/rc.d/init.d
install -m 755 %{SOURCE2} %{buildroot}/etc/rc.d/init.d/%{name}
%{_fixperms} %{buildroot}
%clean
rm -rf %{buildroot}
%files
%defattr(-,root,root,-)
%doc bucardo.html Bucardo.pm.html Changes
%doc INSTALL LICENSE README SIGNATURE TODO
%doc master-master-replication-example.txt
%{perl_vendorlib}/*
%{_mandir}/man1/*
%{_mandir}/man3/*
%{_sbindir}/bucardo
%{_datadir}/bucardo/bucardo.schema
%{_initrddir}/%{name}
%changelog
* Wed Nov 7 2012 David E. Wheeler - 4.99.6-2
- Changed LOGDEST to support multiple destinations.
- Added a two-second sleep between stop and start in the init script restart
command.
* Tue Nov 6 2012 David E. Wheeler - 4.99.6-1
- Update to 4.99.6.
* Wed Oct 24 2012 David E. Wheeler - 4.99.5-3
- Fixed the init script so that the `stop` command actually works.
- Added a patch to point all of the log files to the log directory.
* Tue Oct 2 2012 David E. Wheeler - 4.99.5-2
- Require postgres.
- Add start script running as postgres.
- Add log directory.
* Fri Sep 28 2012 David E. Wheeler - 4.99.5-1
- Update to 4.99.5
* Thu Sep 6 2012 Devrim GÜNDÜZ - 4.5.0-1
- Update to 4.5.0
* Sat Apr 7 2012 Devrim GÜNDÜZ - 4.4.8-1
- Update to 4.4.8
* Tue Sep 27 2011 Devrim GÜNDÜZ - 4.4.6-2
- Fix PostgreSQL major number version. Per report from Phil Sorber .
* Tue Aug 9 2011 Devrim GUNDUZ - 4.4.6-1
- Update to 4.4.6
* Mon Apr 18 2011 Devrim GUNDUZ - 4.4.3-1
- Update to 4.4.3
* Thu Jan 6 2011 Devrim GUNDUZ - 4.4.0-3
- Add 9.0 dependency.
* Fri Mar 12 2010 Devrim GUNDUZ - 4.4.0-2
- Sync with Fedora spec again.
Bucardo-5.4.1/dist/README0000644000175000017500000000054612427203642013364 0ustar greggregThis directory contains various distribution configuration files,
patches, and start scripts.
* bucardo.rc
Sample BSD rc file for controlling Bucardo
* bucardo.init
Sample chkconfig-style start script for controlling Bucardo
* bucardo.spec
RPM spec file.
* bucardo-logfiles.patch
Patch to set the default directory for log files to /var/log/bucardo.
Bucardo-5.4.1/dist/bucardo.rc0000644000175000017500000000410312427203642014442 0ustar greggreg#!/bin/sh
# PROVIDE: bucardo
# REQUIRE: LOGIN postgresql
# KEYWORD: shutdown
#
# bucardo_enable="YES"
# bucardo_flags="--dbuser bucardo --dbname bucardo"
#
#
. /etc/rc.subr
name="bucardo"
rcvar=`set_rcvar`
command="/usr/local/bin/${name}"
load_rc_config $name
bucardo_flags=${bucardo_flags:-"--dbuser bucardo --dbname bucardo"}
rc_usage="start|stop|reload|restart|status|kick [sync_name]"
extra_commands="reload kick"
start_cmd="${name}_start"
stop_cmd="${name}_stop"
reload_cmd="${name}_reload"
restart_cmd="${name}_restart"
kick_cmd="${name}_kick"
status_cmd="${name}_status"
bucardo_start()
{
if [ -x ${command} ]; then
${command} ${bucardo_flags} start "Started by rc script."
else
echo "${command} not found or not executable!"
exit 1
fi
}
bucardo_stop()
{
if [ -x ${command} ]; then
${command} ${bucardo_flags} stop "Stopped by rc script."
else
echo "${command} not found or not executable!"
exit 1
fi
}
bucardo_reload()
{
if [ -x ${command} ]; then
${command} ${bucardo_flags} reload_config
else
echo "${command} not found or not executable!"
exit 1
fi
}
bucardo_restart()
{
if [ -x ${command} ]; then
${command} ${bucardo_flags} stop "Restarting: Stopped by rc script"
${command} ${bucardo_flags} start "Restarting: Started by rc script"
else
echo "${command} not found or not executable!"
exit 1
fi
}
bucardo_kick()
{
if [ -x ${command} ]; then
if [ $# -gt 0 ]; then
${command} ${bucardo_flags} kick $*
else
echo "Specifiy sync name to kick off"
exit 1
fi
else
echo "${command} not found or not executable!"
exit 1
fi
}
bucardo_status()
{
if [ -x ${command} ]; then
if [ $# -gt 0 ]; then
${command} ${bucardo_flags} status $*
else
${command} ${bucardo_flags} status
fi
else
echo "${command} not found or not executable!"
exit 1
fi
}
load_rc_config $name
run_rc_command "$@"
Bucardo-5.4.1/LICENSE0000644000175000017500000000251512563002233012536 0ustar greggregCopyright (c) 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015
Greg Sabino Mullane . All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY
OF SUCH DAMAGE.
Bucardo-5.4.1/TODO0000644000175000017500000001007012563002233012214 0ustar greggregTODO list for Bucardo
=====================
Version 5
---------
* Fix 'error loop' escaping bug from mailing list
https://github.com/bucardo/bucardo/issues/13
Version 5.1
-----------
* Get Drizzle tests verified as working
https://github.com/bucardo/bucardo/issues/16
* Get bucardo-report working again
https://github.com/bucardo/bucardo/issues/17
Future
------
These range the gamut from wildly speculative ideas to must-have features.
- Allow bucardo add table ... --relgroup=foo to work, or at least throw an error.
- Remove the need for pl/perl entirely: put all logic into ./bucardo
- Allow a new type of trigger that only indicates if a table has changed or not.
Rather than storing a PK, we only note "changed". This would allow fullcopy tables
inside of a sync to run or just get skipped.
- Make the listen/notify system cleaner, maybe break into mcp/ctl/kid streams rather than generic 'bucardo'
- Create a new "sourceonly" type what can issue deltas but not receive them
- Make sure pkonly and makedelta=xx work everywhere, e.g. add/update relation/relgroup
- Allow syncs to be grouped together to allow for a single kicksync notification
- Allow columns A.varchar(x) and B.varchar(x+y) to be equivalent in the initial
validate_sync check if B is only a target
- Allow skipping of some or all of the initial schema checks; currently
necessary but time consuming for large numbers of tables/servers
- Throttle outgoing mail; such as the flood when things go wrong
- Add column as well as table-level SQL comments to the bucardo schema
- Merge bucardo_kick_%sync into a single trigger and function per table that
does 1+N NOTIFYs inside of it
- Allow one log file per sync
- Handle the case where newly created databases do not have a public schema
- Add DB2 as a target
- Do table locking up front for fullcopy syncs, to reduce deadlock windows
- Allow creation of schema on first fullcopy as an option
- Same as above for pushdelta, but auto switch to onetimecopy after!
- Remove the gotos from the pl/perlu code.
- Use symlinks for long socket directories during testing, as DBD::Pg does.
- Fix the insert/foreign key problem for conflict resolution.
- Death-level custom code hooks
- Better conflict example in test suite, uses database handles
- Allow more data types for pkey on goats
- Handle partitioned tables
- Allow notification emails to be regex sorted, e.g. serialization warnings
- Address all XXX and TODO inside Bucardo.pm
- Add a pause mode
- Add exception code for DELETE
- I8n all messages/docs/etc.
- Allow targets to be hard-linked: nobody goes on until everyone has finished
- Support large objects
- Support system tables (Postgres 12.0?)
- Check for superuser on startup, to prevent errors that only show when a KID tries something.
- Add a flag that allows for table structure checking before each sync
- Make a Bucardo bundle for CPAN-like fun
- Readonly slaves: trigger/rule to prevent with good message
- bucardo_help() function to explain all
- Handle non-orderable data types such as polygons
- Put this list into a bug tracker
- Consider failover strategies
- Log validate_sync changes somewhere, add rollback statements
- Add support for manual DDL changes
- Add support for automatic DDL changes
- Cascading slaves: makedelta should create infrastructure as necessary
- Use polling not sleep for loop notifications
- Remove large src_code sections from the kid output when they die
- Force to C locale until we get i18n in place
- Use C triggers for the delta stuff if we can (and time them!)
- Find alternate ways for the kids to lock the tables other than $force_lock_file
- Options to allow Bucardo to continue with unaffected syncs if a target is dead
- Mongo: fix escaped data from COPY TO STDOUT
- Flatfiles: same escaped data as above for non-PG output
- Add readonly slaves:
Need to design a system to make slaves optionally "readonly". This will most
likely be accomplished through use of triggers. There should be a simple
interface to toggle the read-only on and off per database, and perhaps per
sync. Need to consider making non-tracked tables read-only as well.
Bucardo-5.4.1/MANIFEST.SKIP0000644000175000017500000000050212563002233013421 0ustar greggreg~$
^#
Makefile$
Makefile\.old$
^blib
pm_to_blib$
\.tar$
\.tar\.gz$
\.tar\.gz.asc$
.*tmp/
log$
log.bucardo
.git/
outgoingmail.
.bucardorc
bucardo_test_database_*
none/
.tmp$
.diff$
.blame$
bucardo.warning.log
t/00-release.t
t/99-lint.t
t/99-perlcritic.t
t/99-spellcheck.t
t/99-yaml.t
notes.*
.bak$
.db$
MYMETA.*
dev/
dist/
Bucardo-5.4.1/INSTALL0000644000175000017500000000313412563002233012560 0ustar greggregInstallation instructions for Bucardo.
For a possibly more up to date and complete version, please visit:
http://bucardo.org/wiki/Bucardo/Installation
Before installing, please make sure you have the latest version.
Please visit:
https://bucardo.org/wiki/Bucardo
It is recommended that you create a 'bucardo' user on your system
that will be responsible for running Bucardo.
Install Bucardo like any other Perl module:
perl Makefile.PL
make
make test
make install
The last step must be done as root. You may be able to do this by running:
sudo make install
Note that 'make test' is a rather long and involved process.
However, because Bucardo is fairly complex, testing is highly
recommended before installing.
Once the above has been run, you will need to create a Bucardo database.
This can be done by running:
bucardo install
There should be no errors: if there are, please report them to
bucardo-general@bucardo.org or ask on IRC for help.
IRC: #bucardo irc.freenode.net
Bucardo by default logs to syslog, and does so very verbosely. It is
recommended that you reroute your bucardo syslog traffic to another file.
This can be done by adding this line to your /etc/syslog.conf file:
local1.* -/var/log/bucardo.log
Of course, if "local1" is already being used for something else, you will
need to change it - see the "syslog_facility" entry in the bucardo_config
table.
Once this is done, make sure you restart your syslog daemon so it rereads the
new configuration file.
Please see the documentation at http://bucardo.org for information on how to
start using Bucardo once it is installed.
Bucardo-5.4.1/dev/0000755000175000017500000000000012601643631012312 5ustar greggregBucardo-5.4.1/dev/test_setup.sh0000755000175000017500000000305412563002233015044 0ustar greggreg#!/bin/bash
## Quick setup for semi-standardized command-line testing
echo This will remove any existing bucardo schema! Proceed?
read yn
if [ $yn != 'y' ]
then
exit
fi
echo Good to go!
## Clear out old databases and users
psql -qc 'drop database if exists bucardo'
psql -qc 'drop database if exists test1'
psql -qc 'drop database if exists test2'
psql -qc 'drop database if exists test3'
psql -qc 'drop user bucardo'
## Install bucardo
./bucardo install --batch
## Create test databases, users, and tables
psql -qc 'create database test1'
psql -d test1 -qc 'create table t1 (id serial primary key, email text)'
psql -d test1 -qc 'create table t2 (id serial primary key, email text)'
psql -d test1 -qc 'create table t3 (id serial primary key, email text)'
psql -d test1 -qc 'create table t4 (id serial primary key, email text)'
psql -qc 'create database test2 template test1'
psql -qc 'create database test3 template test1'
## Tell Bucardo about the databases
./bucardo add db db1 dbname=test1
./bucardo add db db2 dbname=test2
./bucardo add db db3 dbname=test3
## Add in all the tables from test1, put into a herd
./bucardo add all tables herd=myherd
## Add a new table that is not in any herd (or sync)
psql -d test1 -qc 'create table t5 (id serial primary key, email text)'
./bucardo add table t5
## Simple source -> target sync
./bucardo add sync alpha herd=myherd dbs=db1,db2
## Source to source sync
./bucardo add sync beta herd=myherd dbs=db1,db2:source
## Source to source to target sync
./bucardo add sync charlie herd=myherd dbs=db1,db2:source,db3:target
Bucardo-5.4.1/Bucardo.pm0000644000175000017500000136537212601643170013470 0ustar greggreg#!perl
# -*-mode:cperl; indent-tabs-mode: nil; cperl-indent-level: 4-*-
## The main Bucardo program
##
## This script should only be called via the 'bucardo' program
##
## Copyright 2006-2015 Greg Sabino Mullane
##
## Please visit http://bucardo.org for more information
package Bucardo;
use 5.008003;
use strict;
use warnings;
use utf8;
use open qw( :std :utf8 );
our $VERSION = '5.4.1';
use DBI 1.51; ## How Perl talks to databases
use DBD::Pg 2.0 qw( :async ); ## How Perl talks to Postgres databases
use DBIx::Safe '1.2.4'; ## Filter out what DB calls customcode may use
use sigtrap qw( die normal-signals ); ## Call die() on HUP, INT, PIPE, or TERM
use Config qw( %Config ); ## Used to map signal names
use File::Spec qw( ); ## For portable file operations
use Data::Dumper qw( Dumper ); ## Used to dump information in email alerts
use POSIX qw( strftime strtod ); ## For grabbing the local timezone, and forcing to NV
use Sys::Hostname qw( hostname ); ## Used for host safety check, and debugging/mail sending
use IO::Handle qw( autoflush ); ## Used to prevent stdout/stderr buffering
use Sys::Syslog qw( openlog syslog ); ## In case we are logging via syslog()
use Net::SMTP qw( ); ## Used to send out email alerts
use boolean qw( true false ); ## Used to send truthiness to MongoDB
use List::Util qw( first ); ## Better than grep
use MIME::Base64 qw( encode_base64
decode_base64 ); ## For making text versions of bytea primary keys
use Time::HiRes qw( sleep gettimeofday
tv_interval ); ## For better resolution than the built-in sleep
## and for timing of events
## Formatting of Data::Dumper() calls:
$Data::Dumper::Varname = 'BUCARDO';
$Data::Dumper::Indent = 1;
## Common variables we don't want to declare over and over:
use vars qw($SQL %SQL $sth %sth $count $info);
## Logging verbosity control
## See also the 'log_level_number' inside the config hash
use constant {
LOG_WARN => 0, ## Always shown
LOG_TERSE => 1, ## Bare minimum
LOG_NORMAL => 2, ## Normal messages
LOG_VERBOSE => 3, ## Many more details
LOG_DEBUG => 4, ## Firehose: rarely needed
LOG_DEBUG2 => 5, ## Painful level of detail
};
## Map system signal numbers to standard names
## This allows us to say kill $signumber{HUP} => $pid
my $i = 0;
my %signumber;
for (split(' ', $Config{sig_name})) {
$signumber{$_} = $i++;
}
## Prevent buffering of output:
*STDOUT->autoflush(1);
*STDERR->autoflush(1);
## Configuration of DBIx::Safe
## Specify exactly what database handles are allowed to do within custom code
## Here, 'strict' means 'inside the main transaction that Bucardo uses to make changes'
my $strict_allow = 'SELECT INSERT UPDATE DELETE quote quote_identifier';
my $nostrict_allow = "$strict_allow COMMIT ROLLBACK NOTIFY SET pg_savepoint pg_release pg_rollback_to";
my %dbix = (
source => {
strict => {
allow_command => $strict_allow,
allow_attribute => '',
allow_regex => '', ## Must be qr{} if not empty
deny_regex => '',
},
notstrict => {
allow_command => $nostrict_allow,
allow_attribute => 'RaiseError PrintError',
allow_regex => [qr{CREATE TEMP TABLE},qr{CREATE(?: UNIQUE)? INDEX}],
deny_regex => '',
},
},
target => {
strict => {
allow_command => $strict_allow,
allow_attribute => '',
allow_regex => '', ## Must be qr{} if not empty
deny_regex => '',
},
notstrict => {
allow_command => $nostrict_allow,
allow_attribute => 'RaiseError PrintError',
allow_regex => [qr{CREATE TEMP TABLE}],
deny_regex => '',
},
}
);
## Grab our full and shortened host name:
## Used for the host_safety_check as well as for emails
my $hostname = hostname;
my $shorthost = $hostname;
$shorthost =~ s/^(.+?)\..*/$1/;
## Items pulled from bucardo_config and shared everywhere:
our %config;
our %config_about;
## Set a default in case we call glog before we load the configs:
$config{log_level_number} = LOG_NORMAL;
## Sequence columns we care about and how to change them via ALTER:
my @sequence_columns = (
['last_value' => ''],
['start_value' => 'START WITH'],
['increment_by' => 'INCREMENT BY'],
['max_value' => 'MAXVALUE'],
['min_value' => 'MINVALUE'],
['is_cycled' => 'BOOL CYCLE'],
['is_called' => ''],
);
my $sequence_columns = join ',' => map { $_->[0] } @sequence_columns;
## Output messages per language
our %msg = (
'en' => {
'time-day' => q{day},
'time-days' => q{days},
'time-hour' => q{hour},
'time-hours' => q{hours},
'time-minute' => q{minute},
'time-minutes' => q{minutes},
'time-month' => q{month},
'time-months' => q{months},
'time-second' => q{second},
'time-seconds' => q{seconds},
'time-week' => q{week},
'time-weeks' => q{weeks},
'time-year' => q{year},
'time-years' => q{years},
},
'fr' => {
'time-day' => q{jour},
'time-days' => q{jours},
'time-hour' => q{heure},
'time-hours' => q{heures},
'time-minute' => q{minute},
'time-minutes' => q{minutes},
'time-month' => q{mois},
'time-months' => q{mois},
'time-second' => q{seconde},
'time-seconds' => q{secondes},
'time-week' => q{semaine},
'time-weeks' => q{semaines},
'time-year' => q{année},
'time-years' => q{années},
},
'de' => {
'time-day' => q{Tag},
'time-days' => q{Tag},
'time-hour' => q{Stunde},
'time-hours' => q{Stunden},
'time-minute' => q{Minute},
'time-minutes' => q{Minuten},
'time-month' => q{Monat},
'time-months' => q{Monate},
'time-second' => q{Sekunde},
'time-seconds' => q{Sekunden},
'time-week' => q{Woche},
'time-weeks' => q{Woche},
'time-year' => q{Jahr},
'time-years' => q{Jahr},
},
'es' => {
'time-day' => q{día},
'time-days' => q{días},
'time-hour' => q{hora},
'time-hours' => q{horas},
'time-minute' => q{minuto},
'time-minutes' => q{minutos},
'time-month' => q{mes},
'time-months' => q{meses},
'time-second' => q{segundo},
'time-seconds' => q{segundos},
'time-week' => q{semana},
'time-weeks' => q{semanas},
'time-year' => q{año},
'time-years' => q{años},
},
);
## use critic
## Figure out which language to use for output
our $lang = $ENV{LC_ALL} || $ENV{LC_MESSAGES} || $ENV{LANG} || 'en';
$lang = substr($lang,0,2);
##
## Everything else is subroutines
##
sub new {
## Create a new Bucardo object and return it
## Takes a hashref of options as the only argument
my $class = shift;
my $params = shift || {};
## The hash for this object, with default values:
my $self = {
created => scalar localtime,
mcppid => $$,
verbose => 1,
quickstart => 0,
logdest => ['.'],
warning_file => '',
logseparate => 0,
logextension => '',
logclean => 0,
dryrun => 0,
sendmail => 1,
extraname => '',
logprefix => 'BC!',
version => $VERSION,
listening => {},
pidmap => {},
exit_on_nosync => 0,
sqlprefix => "/* Bucardo $VERSION */",
};
## Add any passed-in parameters to our hash:
for (keys %$params) {
$self->{$_} = $params->{$_};
}
## Transform our hash into a genuine 'Bucardo' object:
bless $self, $class;
## Remove any previous log files if requested
if ($self->{logclean} && (my @dirs = grep {
$_ !~ /^(?:std(?:out|err)|none|syslog)/
} @{ $self->{logdest} }) ) {
## If the dir does not exists, silently proceed
for my $dir (@dirs) {
opendir my $dh, $dir or next;
## We look for any files that start with 'log.bucardo' plus another dot
for my $file (grep { /^log\.bucardo\./ } readdir $dh) {
my $fullfile = File::Spec->catfile( $dir => $file );
unlink $fullfile or warn qq{Could not remove "$fullfile": $!\n};
}
closedir $dh or warn qq{Could not closedir "$dir": $!\n};
}
}
## Zombie stopper
$SIG{CHLD} = 'IGNORE';
## Basically, dryrun does a rollback instead of a commit at the final sync step
## This is not 100% safe, if (for example) you have custom code that reaches
## outside the database to do things.
if (exists $ENV{BUCARDO_DRYRUN}) {
$self->{dryrun} = 1;
}
if ($self->{dryrun}) {
$self->glog(q{** DRYRUN - Syncs will not be committed! **}, LOG_WARN);
}
## This gets appended to the process description ($0)
if ($self->{extraname}) {
$self->{extraname} = " ($self->{extraname})";
}
## Connect to the main Bucardo database
$self->{masterdbh} = $self->connect_database();
## Load in the configuration information
$self->reload_config_database();
## Figure out if we are writing emails to a file
$self->{sendmail_file} = $ENV{BUCARDO_EMAIL_DEBUG_FILE} || $config{email_debug_file} || '';
## Where to store our PID:
$self->{pid_file} = File::Spec->catfile( $config{piddir} => 'bucardo.mcp.pid' );
## The file to ask all processes to stop:
$self->{stop_file} = File::Spec->catfile( $config{piddir} => $config{stopfile} );
## Send all log lines starting with "Warning" to a separate file
$self->{warning_file} ||= $config{warning_file};
## Make sure we are running where we are supposed to be
## This prevents items in bucardo.db that reference production
## systems from getting run on QA!
## ...or at least makes sure people have to work a lot harder
## to shoot themselves in the foot.
if (length $config{host_safety_check}) {
my $safe = $config{host_safety_check};
my $osafe = $safe;
my $ok = 0;
## Regular expression
if ($safe =~ s/^~//) {
$ok = 1 if $hostname =~ qr{$safe};
}
## Set of choices
elsif ($safe =~ s/^=//) {
for my $string (split /,/ => $safe) {
if ($hostname eq $string) {
$ok=1;
last;
}
}
}
## Simple string
elsif ($safe eq $hostname) {
$ok = 1;
}
if (! $ok) {
warn qq{Cannot start: configured to only run on "$osafe". This is "$hostname"\n};
warn qq{ This is usually done to prevent a configured Bucardo from running\n};
warn qq{ on the wrong host. Please verify the 'db' settings by doing:\n};
warn qq{bucardo list dbs\n};
warn qq{ Once you are sure the bucardo.db table has the correct values,\n};
warn qq{ you can adjust the 'host_safety_check' value\n};
exit 2;
}
}
return $self;
} ## end of new
sub start_mcp {
## Start the Bucardo daemon. Called by bucardo after setsid()
## Arguments: one
## 1. Arrayref of command-line options.
## Returns: never (exit 0 or exit 1)
my ($self, $opts) = @_;
## Store the original invocation string, then modify it
my $old0 = $0;
## May not work on all platforms, of course, but we're gonna try
$0 = "Bucardo Master Control Program v$VERSION.$self->{extraname}";
## Prefix all lines in the log file with this TLA (until overriden by a forked child)
$self->{logprefix} = 'MCP';
## If the standard pid file [from new()] already exists, cowardly refuse to run
if (-e $self->{pid_file}) {
## Grab the PID from the file if we can for better output
my $extra = '';
## Failing to open is not fatal here, just means no PID shown
my $oldpid;
if (open my $fh, '<', $self->{pid_file}) {
if (<$fh> =~ /(\d+)/) {
$oldpid = $1;
$extra = " (PID=$oldpid)";
}
close $fh or warn qq{Could not close "$self->{pid_file}": $!\n};
}
## Output to the logfile, to STDERR, then exit
if ($oldpid != $$) {
my $msg = qq{File "$self->{pid_file}" already exists$extra: cannot run until it is removed};
$self->glog($msg, LOG_WARN);
warn $msg;
exit 1;
}
}
## We also refuse to run if the global stop file exists
if (-e $self->{stop_file}) {
my $msg = qq{Cannot run while this file exists: "$self->{stop_file}"};
$self->glog($msg, LOG_WARN);
warn $msg;
## Failure to open this file is not fatal
if (open my $fh, '<', $self->{stop_file}) {
## Read in up to 10 lines from the stopfile and output them
while (<$fh>) {
$msg = "Line $.: $_";
$self->glog($msg, LOG_WARN);
warn $msg;
last if $. > 10;
}
close $fh or warn qq{Could not close "$self->{stop_file}": $!\n};
}
exit 1;
}
## We are clear to start. Output a quick hello and version to the logfile
$self->glog("Starting Bucardo version $VERSION", LOG_WARN);
$self->glog("Log level: $config{log_level}", LOG_WARN);
## Close unused file handles.
unless (grep { $_ eq 'stderr' } @{ $self->{logdest} }) {
close STDERR or warn "Could not close STDERR\n";
}
unless (grep { $_ eq 'stdout' } @{ $self->{logdest} }) {
close STDOUT or warn "Could not close STDOUT\n";
}
## Create a new (but very temporary) PID file
## We will overwrite later with a new PID once we do the initial fork
$self->create_mcp_pid_file($old0);
## Send an email message with details about this invocation
if ($self->{sendmail} or $self->{sendmail_file}) {
## Create a pretty Dumped version of the current $self object, with the password elided
## Squirrel away the old password
my $oldpass = $self->{dbpass};
## Set to something else
$self->{dbpass} = '';
## Dump the entire object with Data::Dumper (with custom config variables)
my $dump = Dumper $self;
## Put the password back in place
$self->{dbpass} = $oldpass;
## Prepare to send an email letting people know we have started up
my $body = qq{
Master Control Program $$ was started on $hostname
Args: $old0
Version: $VERSION
};
my $subject = qq{Bucardo $VERSION started on $shorthost};
## If someone left a message in the reason file, append it, then delete the file
my $reason = get_reason('delete');
if ($reason) {
$body .= "Reason: $reason\n";
$subject .= " ($reason)";
}
## Strip leading whitespace from the body (from the qq{} above)
$body =~ s/^\s+//gsm;
## Send out the email (if sendmail or sendmail_file is enabled)
$self->send_mail({ body => "$body\n\n$dump", subject => $subject });
}
## Drop the existing database connection, fork, and get a new one
## This self-fork helps ensure our survival
my $disconnect_ok = 0;
eval {
## This connection was set in new()
$self->{masterdbh}->disconnect();
$disconnect_ok = 1;
};
$disconnect_ok or $self->glog("Warning! Disconnect failed $@", LOG_WARN);
my $seeya = fork;
if (! defined $seeya) {
die q{Could not fork mcp!};
}
## Immediately close the child process (one side of the fork)
if ($seeya) {
exit 0;
}
## Now that we've forked, overwrite the PID file with our new value
$self->create_mcp_pid_file($old0);
## Reconnect to the master database
($self->{mcp_backend}, $self->{masterdbh}) = $self->connect_database();
my $masterdbh = $self->{masterdbh};
## Let any listeners know we have gotten this far
## (We do this nice and early for impatient watchdog programs)
$self->db_notify($masterdbh, 'boot', 1);
## Store the function to use to generate clock timestamps
## We greatly prefer clock_timestamp,
## but fallback to timeofday() for 8.1 and older
$self->{mcp_clock_timestamp} =
$masterdbh->{pg_server_version} >= 80200
? 'clock_timestamp()'
: 'timeofday()::timestamptz';
## Start outputting some interesting things to the log
$self->show_db_version_and_time($masterdbh, $self->{mcp_backend}, 'Master DB ');
$self->glog("PID: $$", LOG_WARN);
$self->glog('Postgres library version: ' . $masterdbh->{pg_lib_version}, LOG_WARN);
$self->glog("bucardo: $old0", LOG_WARN);
$self->glog('Bucardo.pm: ' . $INC{'Bucardo.pm'}, LOG_WARN);
$self->glog((sprintf 'OS: %s Perl: %s %vd', $^O, $^X, $^V), LOG_WARN);
## Get an integer version of the DBD::Pg version, for later comparisons
if ($DBD::Pg::VERSION !~ /(\d+)\.(\d+)\.(\d+)/) {
die "Could not parse the DBD::Pg version: was $DBD::Pg::VERSION\n";
}
$self->{dbdpgversion} = int (sprintf '%02d%02d%02d', $1,$2,$3);
$self->glog((sprintf 'DBI version: %s DBD::Pg version: %s (%d) DBIx::Safe version: %s',
$DBI::VERSION,
$DBD::Pg::VERSION,
$self->{dbdpgversion},
$DBIx::Safe::VERSION),
LOG_WARN);
## Attempt to print the git hash to help with debugging if running a dev version
if (-d '.git') {
my $COM = 'git log -1';
my $log = '';
eval { $log = qx{$COM}; };
if ($log =~ /^commit ([a-f0-9]{40}).+Date:\s+(.+?)$/ms) {
$self->glog("Last git commit sha and date: $1 $2", LOG_NORMAL);
}
}
## Store some PIDs for later debugging use
$self->{pidmap}{$$} = 'MCP';
$self->{pidmap}{$self->{mcp_backend}} = 'Bucardo DB';
## Get the maximum key length of the "self" hash for pretty formatting
my $maxlen = 5;
for (keys %$self) {
$maxlen = length($_) if length($_) > $maxlen;
}
## Print each object, aligned, and show 'undef' for undefined values
## Yes, this prints things like HASH(0x8fbfc84), but we're okay with that
$Data::Dumper::Indent = 0;
$Data::Dumper::Terse = 1;
my $objdump = "Bucardo object:\n";
for my $key (sort keys %$self) {
my $value = $key eq 'dbpass' ? '' : $self->{$key};
$objdump .= sprintf " %-*s => %s\n", $maxlen, $key,
(defined $value) ?
(ref $value eq 'ARRAY') ? Dumper($value)
: qq{'$value'} : 'undef';
}
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 0;
$self->glog($objdump, LOG_TERSE);
## Dump all configuration variables to the log
$self->log_config();
## Any other files we find in the piddir directory should be considered old
## Thus, we can remove them
my $piddir = $config{piddir};
opendir my $dh, $piddir or die qq{Could not opendir "$piddir": $!\n};
## Nothing else should really be in here, but we will limit with a regex anyway
my @pidfiles = grep { /^bucardo.*\.pid$/ } readdir $dh;
closedir $dh or warn qq{Could not closedir "$piddir" $!\n};
## Loop through and remove each file found, making a note in the log
for my $pidfile (sort @pidfiles) {
my $fullfile = File::Spec->catfile( $piddir => $pidfile );
## Do not erase our own file
next if $fullfile eq $self->{pid_file};
## Everything else can get removed
if (-e $fullfile) {
if (unlink $fullfile) {
$self->glog("Warning: removed old pid file $fullfile", LOG_VERBOSE);
}
else {
## This will cause problems, but we will drive on
$self->glog("Warning: failed to remove pid file $fullfile", LOG_TERSE);
}
}
}
## We use a USR2 signal to indicate that the logs should be reopened
local $SIG{USR2} = sub {
$self->glog("Received USR2 from pid $$, who is a $self->{logprefix}", LOG_DEBUG);
## Go through and reopen anything that needs reopening
## For now, that is only plain text files
for my $logdest (sort keys %{$self->{logcodes}}) {
my $loginfo = $self->{logcodes}{$logdest};
next if $loginfo->{type} ne 'textfile';
my $filename = $loginfo->{filename};
## Reopen the same (named) file with a new filehandle
my $newfh;
if (! open $newfh, '>>', $filename) {
$self->glog("Warning! Unable to open new filehandle for $filename", LOG_WARN);
next;
}
## Turn off buffering on this handle
$newfh->autoflush(1);
## Overwrite the old sub and point to the new filehandle
my $oldfh = $loginfo->{filehandle};
$self->glog("Switching to new filehandle for log file $filename", LOG_NORMAL);
$loginfo->{code} = sub { print {$newfh} @_, $/ };
$self->glog("Completed reopen of file $filename", LOG_NORMAL);
## Close the old filehandle, then remove it from our records
close $oldfh or warn "Could not close old filehandle for $filename: $!\n";
$loginfo->{filehandle} = $newfh;
}
}; ## end of handling USR2 signals
## From this point forward, we want to die gracefully
## We setup our own subroutine to catch any die signals
local $SIG{__DIE__} = sub {
## Arguments: one
## 1. The error message
## Returns: never (exit 1 or exec new process)
my $msg = shift;
my $line = (caller)[2];
$self->glog("Warning: Killed (line $line): $msg", LOG_WARN);
## Was this a database problem?
## We can carefully handle certain classes of errors
if ($msg =~ /DBI|DBD/) {
## How many bad databases we found
my $bad = 0;
for my $db (sort keys %{ $self->{sdb} }) { ## need a better name!
if (! exists $self->{sdb}{$db}{dbh} ) {
$self->glog("Database $db has no database handle", LOG_NORMAL);
$bad++;
}
elsif (! $self->{sdb}{$db}{dbh}->ping()) {
$self->glog("Database $db failed ping check", LOG_NORMAL);
$msg = 'Ping failed';
$bad++;
}
}
if ($bad) {
my $changes = $self->check_sync_health();
if ($changes) {
## If we already made a MCP label, go there
## Else fallthrough and assume our bucardo.sync changes stick!
if ($self->{mcp_loop_started}) {
$self->glog('Going to restart the MCP loop, as syncs have changed', LOG_VERBOSE);
die 'We are going to redo the MCP loop'; ## goes to end of mcp main eval
}
}
}
}
## The error message determines if we try to resurrect ourselves or not
my $respawn = (
$msg =~ /DBI connect/ ## From DBI
or $msg =~ /Ping failed/ ## Set below
) ? 1 : 0;
## Sometimes we don't want to respawn at all (e.g. during some tests)
if (! $config{mcp_dbproblem_sleep}) {
$self->glog('Database problem, but will not attempt a respawn due to mcp_dbproblem_sleep=0', LOG_TERSE);
$respawn = 0;
}
## Create some output for the mail message
my $diesubject = "Bucardo MCP $$ was killed";
my $diebody = "MCP $$ was killed: $msg";
## Most times we *do* want to respawn
if ($respawn) {
$self->glog("Database problem, will respawn after a short sleep: $config{mcp_dbproblem_sleep}", LOG_TERSE);
$diebody .= " (will attempt respawn in $config{mcp_dbproblem_sleep} seconds)";
$diesubject .= ' (respawning)';
}
## Callers can prevent an email being sent by setting this before they die
if (! $self->{clean_exit}) {
$self->send_mail({ body => $diebody, subject => $diesubject });
}
## Kill kids, remove pidfile, update tables, etc.
$self->cleanup_mcp("Killed: $msg");
## If we are not respawning, simply exit right now
exit 1 if ! $respawn;
## We will attempt a restart, but sleep a while first to avoid constant restarts
$self->glog("Sleep time: $config{mcp_dbproblem_sleep}", LOG_TERSE);
sleep($config{mcp_dbproblem_sleep});
## Do a quick check for a stopfile
## Bail if the stopfile exists
if (-e $self->{stop_file}) {
$self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_WARN);
my $message = 'Found stopfile';
## Grab the reason, if it exists, so we can propagate it onward
my $mcpreason = get_reason(0);
if ($mcpreason) {
$message .= ": $mcpreason";
}
## Stop controllers, disconnect, remove PID file, etc.
$self->cleanup_mcp("$message\n");
$self->glog('Exiting', LOG_WARN);
exit 0;
}
## We assume this is bucardo, and that we are in same directory as when called
my $RUNME = $old0;
## Check to see if $RUNME is executable as is, before we assume we're in the same directory
if (! -x $RUNME) {
$RUNME = "./$RUNME" if index ($RUNME,'.') != 0;
}
my $mcpreason = 'Attempting automatic respawn after MCP death';
$self->glog("Respawn attempt: $RUNME @{ $opts } start '$mcpreason'", LOG_TERSE);
## Replace ourselves with a new process running this command
{ exec $RUNME, @{ $opts }, 'start', $mcpreason };
$self->glog("Could not exec $RUNME: $!", LOG_WARN);
}; ## end SIG{__DIE__} handler sub
## This resets listeners, kills kids, and loads/activates syncs
my $active_syncs = $self->reload_mcp();
if (!$active_syncs && $self->{exit_on_nosync}) {
## No syncs means no reason for us to hang around, so we exit
$self->glog('No active syncs were found, so we are exiting', LOG_WARN);
$self->db_notify($masterdbh, 'nosyncs', 1);
$self->cleanup_mcp('No active syncs');
exit 1;
}
## Report which syncs are active
$self->glog("Active syncs: $active_syncs", LOG_TERSE);
## We want to reload everything if someone HUPs us
local $SIG{HUP} = sub {
$self->reload_mcp();
};
## We need KIDs to tell us their PID so we can deregister them
$self->{kidpidlist} = {};
## Let any listeners know we have gotten this far
$self->db_notify($masterdbh, 'started', 1);
## For optimization later on, we need to know which syncs are 'fullcopy'
for my $syncname (keys %{ $self->{sync} }) {
my $s = $self->{sync}{$syncname};
## Skip inactive or paused syncs
next if !$s->{mcp_active} or $s->{paused};
## Walk through each database and check the roles, discarding inactive dbs
my %rolecount;
for my $db (values %{ $s->{db} }) {
next if $db->{status} ne 'active';
$rolecount{$db->{role}}++;
}
## Default to being fullcopy
$s->{fullcopy} = 1;
## We cannot be a fullcopy sync if:
if ($rolecount{'target'} ## there are any target dbs
or $rolecount{'source'} > 1 ## there is more than one source db
or ! $rolecount{'fullcopy'}) { ## there are no fullcopy dbs
$s->{fullcopy} = 0;
}
}
## Because a sync may have gotten a notice while we were down,
## we auto-kick all eligible syncs
## We also need to see if we can prevent the VAC daemon from running,
## if there are no databases with bucardo schemas
$self->{needsvac} = 0;
for my $syncname (keys %{ $self->{sync} }) {
my $s = $self->{sync}{$syncname};
## Default to starting in a non-kicked mode
$s->{kick_on_startup} = 0;
## Skip inactive or paused syncs
next if !$s->{mcp_active} or $s->{paused};
## Skip fullcopy syncs
next if $s->{fullcopy};
## Right now, the vac daemon is only useful for source Postgres databases
## Of course, it is not needed for fullcopy syncs
for my $db (values %{ $s->{db} }) {
if ($db->{status} eq 'active'
and $db->{dbtype} eq 'postgres'
and $db->{role} eq 'source') {
## We need to increment it for any matches in sdb, regardless of which sync initially set it!
$self->{sdb}{ $db->{name} }{needsvac} = 2;
$self->{needsvac} = 1;
}
}
## Skip if autokick is false
next if ! $s->{autokick};
## Kick it!
$s->{kick_on_startup} = 1;
}
## Start the main loop
{
my $value = $self->mcp_main();
redo if $value;
}
return; ## no critic
} ## end of start_mcp
sub create_mcp_pid_file {
## Create a file containing the PID of the current MCP,
## plus a few other details
## Arguments: one
## 1. Message (usually just the original invocation line)
## Returns: undef
my $self = shift;
my $message = shift || '';
open my $pidfh, '>', $self->{pid_file}
or die qq{Cannot write to $self->{pid_file}: $!\n};
## Inside our newly created PID file, print out PID on the first line
## - print how the script was originally invoked on the second line (old $0),
## - print the current time on the third line
my $now = scalar localtime;
print {$pidfh} "$$\n$message\n$now\n";
close $pidfh or warn qq{Could not close "$self->{pid_file}": $!\n};
return;
} ## end of create_mcp_pid_file
sub mcp_main {
## The main MCP process
## Arguments: none
## Returns: undef (but almost always just exits with 0 or 1)
my $self = shift;
my $maindbh = $self->{masterdbh};
my $sync = $self->{sync};
## Used to gather up and handle any notices received via the listen/notify system
my $notice;
## Used to keep track of the last time we pinged the databases
my $lastpingcheck = 0;
## Keep track of how long since we checked on the VAC daemon
my $lastvaccheck = 0;
$self->glog('Entering main loop', LOG_TERSE);
$self->{mcp_loop_started} = 1;
MCP: {
## We eval the whole loop so we can cleanly redo it if needed
eval {
## Bail if the stopfile exists
if (-e $self->{stop_file}) {
$self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_WARN);
my $msg = 'Found stopfile';
## Grab the reason, if it exists, so we can propagate it onward
my $mcpreason = get_reason(0);
if ($mcpreason) {
$msg .= ": $mcpreason";
}
## Stop controllers, disconnect, remove PID file, etc.
$self->cleanup_mcp("$msg\n");
$self->glog('Exiting', LOG_WARN);
exit 0;
}
## Startup the VAC daemon as needed
## May be off via user configuration, or because of no valid databases
if ($config{bucardo_vac} and $self->{needsvac}) {
## Check on it occasionally (different than the running time)
if (time() - $lastvaccheck >= $config{mcp_vactime}) {
## Is it alive? If not, spawn
my $pidfile = "$config{piddir}/bucardo.vac.pid";
if (! -e $pidfile) {
$self->fork_vac();
}
$lastvaccheck = time();
} ## end of time to check vac
} ## end if bucardo_vac
## Every once in a while, make sure our database connections are still there
if (time() - $lastpingcheck >= $config{mcp_pingtime}) {
## This message must have "Ping failed" to match the $respawn above
$maindbh->ping or die qq{Ping failed for main database!\n};
## Check each (pingable) remote database in undefined order
for my $dbname (keys %{ $self->{sdb} }) {
my $d = $self->{sdb}{$dbname};
next if $d->{dbtype} =~ /flat|mongo|redis/o;
my $try_reconnect = 0;
if ($d->{status} eq 'stalled') {
$self->glog("Trying to connect to stalled database $dbname", LOG_VERBOSE);
$try_reconnect = 1;
}
elsif (! $d->{dbh}->ping) {
$self->glog("Ping failed for database $dbname, trying to reconnect", LOG_NORMAL);
}
if ($try_reconnect) {
## Sleep a hair so we don't reloop constantly
sleep 0.5;
undef $d->{backend};
{
local $SIG{__DIE__} = 'IGNORE';
eval {
($d->{backend}, $d->{dbh}) = $self->connect_database($dbname);
};
}
if (defined $d->{backend}) {
$self->show_db_version_and_time($d->{dbh}, $d->{backend}, qq{Database "$dbname" });
$d->{status} = 'active'; ## In case it was stalled
}
else {
$self->glog("Unable to reconnect to database $dbname!", LOG_WARN);
## We may want to throw an exception if this keeps happening
## We may also want to adjust lastpingcheck so we check more often
}
}
}
## Reset our internal counter to 'now'
$lastpingcheck = time();
} ## end of checking database connections
## Add in any messages from the main database and reset the notice hash
## Ignore things we may have sent ourselves
$notice = $self->db_get_notices($maindbh, $self->{mcp_backend});
## Add in any messages from each remote database
for my $dbname (keys %{ $self->{sdb} }) {
my $d = $self->{sdb}{$dbname};
next if $d->{dbtype} ne 'postgres';
next if $d->{status} eq 'stalled';
my $nlist = $self->db_get_notices($d->{dbh});
$d->{dbh}->rollback();
for my $name (keys %{ $nlist } ) {
if (! exists $notice->{$name}) {
$notice->{$name} = $nlist->{$name};
}
else {
for my $pid (keys %{ $nlist->{$name}{pid} }) {
$notice->{$name}{pid}{$pid}++;
}
}
}
}
## Handle each notice one by one
for my $name (sort keys %{ $notice }) {
my $npid = $notice->{$name}{firstpid};
## Request to stop everything
if ('mcp_fullstop' eq $name) {
$self->glog("Received full stop notice from PID $npid, leaving", LOG_TERSE);
$self->cleanup_mcp("Received stop NOTICE from PID $npid");
exit 0;
}
## Request that a named sync get kicked
elsif ($name =~ /^kick_sync_(.+)/o) {
my $syncname = $1;
## Prepare to send some sort of log message
my $msg = '';
## We will not kick if this sync does not exist or it is inactive
if (! exists $self->{sync}{$syncname}) {
$msg = qq{Warning: Unknown sync to be kicked: "$syncname"\n};
}
elsif (! $self->{sync}{$syncname}{mcp_active}) {
$msg = qq{Cannot kick inactive sync "$syncname"};
}
elsif ($self->{sync}{$syncname}{paused}) {
$msg = qq{Cannot kick paused sync "$syncname"};
}
## We also won't kick if this was created by a kid
## This can happen as our triggerkicks may be set to 'always'
elsif (exists $self->{kidpidlist}{$npid}) {
$self->glog(qq{Not kicking sync "$syncname" as it came from KID $npid}, LOG_DEBUG);
}
else {
## Kick it!
$sync->{$syncname}{kick_on_startup} = 1;
}
if ($msg) {
$self->glog($msg, $msg =~ /Unknown/ ? LOG_TERSE : LOG_VERBOSE);
## As we don't want people to wait around for a syncdone...
$self->db_notify($maindbh, "syncerror_$syncname", 1);
}
}
## A sync has finished
elsif ($name =~ /^syncdone_(.+)/o) {
my $syncdone = $1;
$self->glog("Sync $syncdone has finished", LOG_DEBUG);
## Echo out to anyone listening
$self->db_notify($maindbh, $name, 1);
## If this was a onetimecopy sync, flip it off
$sync->{$syncdone}{onetimecopy} = 0;
}
## A sync has been killed
elsif ($name =~ /^synckill_(.+)/o) {
my $syncdone = $1;
$self->glog("Sync $syncdone has been killed", LOG_DEBUG);
## Echo out to anyone listening
$self->db_notify($maindbh, $name, 1);
## Check on the health of our databases, in case that was the reason the sync was killed
$self->check_sync_health();
}
## Request to pause a sync
elsif ($name =~ /^pause_sync_(.+)/o) {
my $syncname = $1;
my $msg;
## We will not pause if this sync does not exist or it is inactive
if (! exists $self->{sync}{$syncname}) {
$msg = qq{Warning: Unknown sync to be paused: "$syncname"\n};
}
elsif (! $self->{sync}{$syncname}{mcp_active}) {
$msg = qq{Cannot pause inactive sync "$syncname"};
}
else {
## Mark it as paused, stop the kids and controller
$sync->{$syncname}{paused} = 1;
my $stopsync = "stopsync_$syncname";
$self->db_notify($maindbh, "kid_$stopsync");
$self->db_notify($maindbh, "ctl_$stopsync");
$maindbh->commit();
$self->glog(qq{Set sync "$syncname" as paused}, LOG_VERBOSE);
}
if (defined $msg) {
$self->glog($msg, LOG_TERSE);
}
}
## Request to resume a sync
elsif ($name =~ /^resume_sync_(.+)/o) {
my $syncname = $1;
my $msg;
## We will not resume if this sync does not exist or it is inactive
if (! exists $self->{sync}{$syncname}) {
$msg = qq{Warning: Unknown sync to be resumed: "$syncname"\n};
}
elsif (! $self->{sync}{$syncname}{mcp_active}) {
$msg = qq{Cannot resume inactive sync "$syncname"};
}
else {
## Mark it as resumed
my $s = $sync->{$syncname};
$s->{paused} = 0;
## Since we may have accumulated deltas while pasued, set to autokick if needed
if (!$s->{fullcopy} and $s->{autokick}) {
$s->{kick_on_startup} = 1;
}
$self->glog(qq{Set sync "$syncname" as resumed}, LOG_VERBOSE);
## MCP will restart the CTL on next loop around
}
if (defined $msg) {
$self->glog($msg, LOG_TERSE);
}
}
## Request to reload the configuration file
elsif ('reload_config' eq $name) {
$self->glog('Reloading configuration table', LOG_TERSE);
$self->reload_config_database();
## Output all values to the log file again
$self->log_config();
## We need to reload ourself as well
## XXX Not needed for some items! e.g. mcp_pingtime
$self->reload_mcp();
## Let anyone listening know we are done
$self->db_notify($maindbh, 'reload_config_finished', 1);
}
## Request to reload the MCP
elsif ('mcp_reload' eq $name) {
$self->glog('Reloading MCP', LOG_TERSE);
$self->reload_mcp();
## Let anyone listening know we are done
$self->db_notify($maindbh, 'reloaded_mcp', 1);
}
## Request for a ping via listen/notify
elsif ('mcp_ping' eq $name) {
$self->glog("Got a ping from PID $npid, issuing pong", LOG_DEBUG);
$self->db_notify($maindbh, 'mcp_pong', 1);
}
## Request that we parse and empty the log message table
elsif ('log_message' eq $name) {
$self->glog('Checking for log messages', LOG_DEBUG);
$SQL = 'SELECT msg,cdate FROM bucardo_log_message ORDER BY cdate';
my $sth = $maindbh->prepare_cached($SQL);
$count = $sth->execute();
if ($count ne '0E0') {
for my $row (@{$sth->fetchall_arrayref()}) {
$self->glog("MESSAGE ($row->[1]): $row->[0]", LOG_TERSE);
}
$maindbh->do('DELETE FROM bucardo_log_message');
$maindbh->commit();
}
else {
$sth->finish();
}
}
## Request that a named sync get reloaded
elsif ($name =~ /^reload_sync_(.+)/o) {
my $syncname = $1;
my $succeeded = 0;
## Skip if the sync does not exist or is inactive
if (! exists $sync->{$syncname}) {
$self->glog(qq{Invalid sync reload: "$syncname"}, LOG_TERSE);
}
elsif (!$sync->{$syncname}{mcp_active}) {
$self->glog(qq{Cannot reload: sync "$syncname" is not active}, LOG_TERSE);
}
else {
## reload overrides a pause
if ($sync->{$syncname}{paused}) {
$self->glog(qq{Resuming paused sync "$syncname"}, LOG_TERSE);
$sync->{$syncname}{paused} = 0;
}
$self->glog(qq{Deactivating sync "$syncname"}, LOG_TERSE);
$self->deactivate_sync($sync->{$syncname});
## Reread from the database
$SQL = q{SELECT *, }
. q{COALESCE(EXTRACT(epoch FROM checktime),0) AS checksecs, }
. q{COALESCE(EXTRACT(epoch FROM lifetime),0) AS lifetimesecs }
. q{FROM bucardo.sync WHERE name = ?};
my $sth = $maindbh->prepare($SQL);
$count = $sth->execute($syncname);
if ($count eq '0E0') {
$sth->finish();
$self->glog(qq{Warning! Cannot reload sync "$syncname": no longer in the database!}, LOG_WARN);
$maindbh->commit();
next; ## Handle the next notice
}
## XXX: Actually do a full disconnect and redo all the items in here
my $info = $sth->fetchall_arrayref({})->[0];
$maindbh->commit();
## Only certain things can be changed "on the fly"
for my $val (qw/checksecs stayalive deletemethod status autokick
analyze_after_copy vacuum_after_copy targetgroup targetdb
onetimecopy lifetimesecs maxkicks rebuild_index
conflict_strategy/) {
$sync->{$syncname}{$val} = $self->{sync}{$syncname}{$val} = $info->{$val};
}
## XXX: Todo: Fix those double assignments
## Empty all of our custom code arrays
for my $key (grep { /^code_/ } sort keys %{ $self->{sync}{$syncname} }) {
$sync->{$syncname}{$key} = $self->{sync}{$syncname}{$key} = [];
}
sleep 2; ## XXX TODO: Actually wait somehow, perhaps fork
$self->glog("Reactivating sync $syncname", LOG_TERSE);
$sync->{$syncname}{mcp_active} = 0;
if (! $self->activate_sync($sync->{$syncname})) {
$self->glog(qq{Warning! Reactivation of sync "$syncname" failed}, LOG_WARN);
}
else {
## Let anyone listening know the sync is now ready
$self->db_notify($maindbh, "reloaded_sync_$syncname", 1);
$succeeded = 1;
}
$maindbh->commit();
$self->glog("Succeeded: $succeeded", LOG_WARN);
}
$self->db_notify($maindbh, "reload_error_sync_$syncname", 1)
if ($succeeded != 1);
}
## Request that a named sync get activated
elsif ($name =~ /^activate_sync_(.+)/o) {
my $syncname = $1;
if (! exists $sync->{$syncname}) {
$self->glog(qq{Invalid sync activation: "$syncname"}, LOG_TERSE);
}
elsif ($sync->{$syncname}{mcp_active}) {
$self->glog(qq{Sync "$syncname" is already activated}, LOG_TERSE);
$self->db_notify($maindbh, "activated_sync_$syncname", 1);
}
elsif ($self->activate_sync($sync->{$syncname})) {
$sync->{$syncname}{mcp_active} = 1;
## Just in case:
$sync->{$syncname}{paused} = 0;
$maindbh->do(
'UPDATE sync SET status = ? WHERE name = ?',
undef, 'active', $syncname
);
}
}
## Request that a named sync get deactivated
elsif ($name =~ /^deactivate_sync_(.+)/o) {
my $syncname = $1;
if (! exists $sync->{$syncname}) {
$self->glog(qq{Invalid sync "$syncname"}, LOG_TERSE);
}
elsif (! $sync->{$syncname}{mcp_active}) {
$self->glog(qq{Sync "$syncname" is already deactivated}, LOG_TERSE);
$self->db_notify($maindbh, "deactivated_sync_$syncname", 1);
}
elsif ($self->deactivate_sync($sync->{$syncname})) {
$sync->{$syncname}{mcp_active} = 0;
$maindbh->do(
'UPDATE sync SET status = ? WHERE name = ?',
undef, 'inactive', $syncname
);
}
}
# Serialization/deadlock problems; now the child is gonna sleep.
elsif ($name =~ /^syncsleep_(.+)/o) {
my $syncname = $1;
$self->glog("Sync $syncname could not serialize, will sleep", LOG_DEBUG);
## Echo out to anyone listening
$self->db_notify($maindbh, $name, 1);
}
## A kid reporting in. We just store the PID
elsif ('kid_pid_start') {
for my $lpid (keys %{ $notice->{$name}{pid} }) {
$self->{kidpidlist}{$lpid} = 1;
}
}
## A kid leaving. We remove the stored PID.
elsif ('kid_pid_stop') {
for my $lpid (keys %{ $notice->{$name}{pid} }) {
delete $self->{kidpidlist}{$lpid};
}
}
## Someone giving us a hint that a database may be down
elsif ($name =~ /dead_db_(.+)/) {
my $dbname = $1;
$self->glog(qq{Got a hint that database "$dbname" may be down. Let's check it out!}, LOG_NORMAL);
my $changes = $self->check_sync_health($dbname);
}
## Should not happen, but let's at least log it
else {
$self->glog("Warning: received unknown message $name from $npid!", LOG_TERSE);
}
} ## end each notice
$maindbh->commit();
## Just in case this changed behind our back:
$sync = $self->{sync};
## Startup controllers for all eligible syncs
SYNC: for my $syncname (keys %$sync) {
my $s = $sync->{$syncname};
## Skip if this sync has not been activated
next if ! $s->{mcp_active};
## Skip if this one is paused
next if $s->{paused};
## Skip is this one is stalled
next if $s->{status} eq 'stalled';
## If this is not a stayalive, AND is not being kicked, skip it
next if ! $s->{stayalive} and ! $s->{kick_on_startup};
## If this is a fullcopy sync, skip unless it is being kicked
next if $s->{fullcopy} and ! $s->{kick_on_startup};
## If this is a previous stayalive, see if it is active, kick if needed
if ($s->{stayalive} and $s->{controller}) {
$count = kill 0 => $s->{controller};
## If kill 0 returns nothing, the controller is gone, so create a new one
if (! $count) {
$self->glog("Could not find controller $s->{controller}, will create a new one. Kicked is $s->{kick_on_startup}", LOG_TERSE);
$s->{controller} = 0;
}
else { ## Presume it is alive and listening to us, restart and kick as needed
if ($s->{kick_on_startup}) {
## See if controller needs to be killed, because of time limit or job count limit
my $restart_reason = '';
## We can kill and restart a controller after a certain number of kicks
if ($s->{maxkicks} > 0 and $s->{ctl_kick_counts} >= $s->{maxkicks}) {
$restart_reason = "Total kicks ($s->{ctl_kick_counts}) >= limit ($s->{maxkicks})";
}
## We can kill and restart a controller after a certain amount of time
elsif ($s->{lifetimesecs} > 0) {
my $thistime = time();
my $timediff = $thistime - $s->{start_time};
if ($thistime - $s->{start_time} > $s->{lifetimesecs}) {
$restart_reason = "Time is $timediff, limit is $s->{lifetimesecs} ($s->{lifetime})";
}
}
if ($restart_reason) {
## Kill and restart controller
$self->glog("Restarting controller for sync $syncname. $restart_reason", LOG_TERSE);
kill $signumber{USR1} => $s->{controller};
## Create a new controller
$self->fork_controller($s, $syncname);
}
else {
## Perform the kick
my $notify = "ctl_kick_$syncname";
$self->db_notify($maindbh, $notify);
$self->glog(qq{Sent a kick to controller $s->{controller} for sync "$syncname"}, LOG_VERBOSE);
}
## Reset so we don't kick the next round
$s->{kick_on_startup} = 0;
## Track how many times we've kicked
$s->{ctl_kick_counts}++;
}
next SYNC;
}
}
## At this point, we are either:
## 1. Not a stayalive
## 2. A stayalive that has not been run yet
## 3. A stayalive that has been run but is not responding
## Make sure there is nothing out there already running
my $syncname = $s->{name};
my $pidfile = "$config{piddir}/bucardo.ctl.sync.$syncname.pid";
if ($s->{mcp_changed}) {
$self->glog(qq{Checking for existing controllers for sync "$syncname"}, LOG_VERBOSE);
}
if (-e $pidfile and ! $s->{mcp_problemchild}) {
$self->glog("File exists staylive=$s->{stayalive} controller=$s->{controller}", LOG_TERSE);
my $pid;
if (!open $pid, '<', $pidfile) {
$self->glog(qq{Warning: Could not open file "$pidfile": $!}, LOG_WARN);
$s->{mcp_problemchild} = 1;
next SYNC;
}
my $oldpid = <$pid>;
chomp $oldpid;
close $pid or warn qq{Could not close "$pidfile": $!\n};
## We don't need to know about this every time
if ($s->{mcp_changed}) {
$self->glog(qq{Found previous controller $oldpid from "$pidfile"}, LOG_TERSE);
}
if ($oldpid !~ /^\d+$/) {
$self->glog(qq{Warning: Invalid pid found inside of file "$pidfile" ($oldpid)}, LOG_WARN);
$s->{mcp_changed} = 0;
$s->{mcp_problemchild} = 2;
next SYNC;
}
## Is it still alive?
$count = kill 0 => $oldpid;
if ($count==1) {
if ($s->{mcp_changed}) {
$self->glog(qq{Skipping sync "$syncname", seems to be already handled by $oldpid}, LOG_VERBOSE);
## Make sure this kid is still running
$count = kill 0 => $oldpid;
if (!$count) {
$self->glog(qq{Warning! PID $oldpid was not found. Removing PID file}, LOG_WARN);
unlink $pidfile or $self->glog("Warning! Failed to unlink $pidfile", LOG_WARN);
$s->{mcp_problemchild} = 3;
next SYNC;
}
$s->{mcp_changed} = 0;
}
if (! $s->{stayalive}) {
$self->glog(qq{Non stayalive sync "$syncname" still active - sending it a notify}, LOG_NORMAL);
}
my $notify = "ctl_kick_$syncname";
$self->db_notify($maindbh, $notify);
$s->{kick_on_startup} = 0;
next SYNC;
}
$self->glog("No active pid $oldpid found. Killing just in case, and removing file", LOG_TERSE);
$self->kill_bucardo_pid($oldpid => 'normal');
unlink $pidfile or $self->glog("Warning! Failed to unlink $pidfile", LOG_WARN);
$s->{mcp_changed} = 1;
} ## end if pidfile found for this sync
## We may have found an error in the pid file detection the first time through
$s->{mcp_problemchild} = 0;
## Fork off the controller, then clean up the $s hash
$self->{masterdbh}->commit();
$self->fork_controller($s, $syncname);
$s->{kick_on_startup} = 0;
$s->{mcp_changed} = 1;
} ## end each sync
sleep $config{mcp_loop_sleep};
redo MCP;
}; # end of eval
## We may want to redo if the error was not *that* fatal
if ($@ =~ /redo/) {
$self->glog('Going to restart the main MCP loop', LOG_VERBOSE);
redo MCP;
}
} ## end of MCP loop
return;
} ## end of mcp_main
sub check_sync_health {
## Check every database used by a sync
## Typically called on demand when we know something is wrong
## Marks any unreachable databases, and their syncs, as stalled
## Arguments: zero or one
## 1. Optional name of database to hone in on
## Returns: number of bad databases detected
my $self = shift;
my $dbnamematch = shift || '';
$self->glog('Starting check_sync_health', LOG_NORMAL);
## How many bad databases did we find?
my $bad_dbs = 0;
## No need to check databases more than once, as they can span across syncs
my $db_checked = {};
## Do this at the sync level, rather than 'sdb', as we don't
## want to check non-active syncs at all
SYNC: for my $syncname (sort keys %{ $self->{sync} }) {
my $sync = $self->{sync}{$syncname};
if ($sync->{status} ne 'active') {
$self->glog("Skipping $sync->{status} sync $syncname", LOG_NORMAL);
next SYNC;
}
## Walk through each database used by this sync
DB: for my $dbname (sort keys %{ $sync->{db} }) {
## Only check each database (by name) once
next if $db_checked->{$dbname}++;
## If limiting to a single database, only check that one
next if $dbnamematch and $dbnamematch ne $dbname;
$self->glog("Checking database $dbname for sync $syncname", LOG_DEBUG);
my $dbinfo = $sync->{db}{$dbname};
## We only bother checking ones that are currently active
if ($dbinfo->{status} ne 'active') {
$self->glog("Skipping $dbinfo->{status} database $dbname for sync $syncname", LOG_NORMAL);
next DB;
}
## Is this database valid or not?
my $isbad = 0;
my $dbh = $dbinfo->{dbh};
if (! ref $dbh) {
$self->glog("Database handle for database $dbname does not look valid", LOG_NORMAL);
if ($dbinfo->{dbtype} eq 'postgres') {
$isbad = 1;
}
else {
## TODO: Account for other non dbh types
next DB;
}
}
elsif (! $dbh->ping()) {
$isbad = 1;
$self->glog("Database $dbname failed ping", LOG_NORMAL);
}
## If not marked as bad, assume good and move on
next DB unless $isbad;
## Retry connection afresh: wrap in eval as one of these is likely to fail!
undef $dbinfo->{dbh};
eval {
($dbinfo->{backend}, $dbinfo->{dbh}) = $self->connect_database($dbname);
$self->show_db_version_and_time($dbinfo->{dbh}, $dbinfo->{backend}, qq{Database "$dbname" });
};
## If we cannot connect, mark the db (and the sync) as stalled
if (! defined $dbinfo->{dbh}) {
$self->glog("Database $dbname is unreachable, marking as stalled", LOG_NORMAL);
$dbinfo->{status} = 'stalled';
$bad_dbs++;
if ($sync->{status} ne 'stalled') {
$self->glog("Marked sync $syncname as stalled", LOG_NORMAL);
$sync->{status} = 'stalled';
$SQL = 'UPDATE bucardo.sync SET status = ? WHERE name = ?';
eval {
my $sth = $self->{masterdbh}->prepare($SQL);
$sth->execute('stalled',$syncname);
};
if ($@) {
$self->glog("Failed to set sync $syncname as stalled: $@", LOG_WARN);
$self->{masterdbh}->rollback();
}
}
$SQL = 'UPDATE bucardo.db SET status = ? WHERE name = ?';
my $sth = $self->{masterdbh}->prepare($SQL);
eval {
$sth->execute('stalled',$dbname);
$self->{masterdbh}->commit();
};
if ($@) {
$self->glog("Failed to set db $dbname as stalled: $@", LOG_WARN);
$self->{masterdbh}->rollback();
}
}
} ## end each database in this sync
} ## end each sync
## If any databases were marked as bad, go ahead and stall other syncs that are using them
## (todo)
return $bad_dbs;
} ## end of check_sync_health
sub restore_syncs {
## Try to restore stalled syncs by checking its stalled databases
## Arguments: none
## Returns: number of syncs restored
my $self = shift;
$self->glog('Starting restore_syncs', LOG_DEBUG);
## How many syncs did we restore?
my $restored_syncs = 0;
## No need to check databases more than once, as they can span across syncs
my $db_checked = {};
## If a sync is stalled, check its databases
SYNC: for my $syncname (sort keys %{ $self->{sync} }) {
my $sync = $self->{sync}{$syncname};
next SYNC if $sync->{status} ne 'stalled';
$self->glog("Checking stalled sync $syncname", LOG_DEBUG);
## Number of databases restored for this sync only
my $restored_dbs = 0;
## Walk through each database used by this sync
DB: for my $dbname (sort keys %{ $sync->{db} }) {
## Only check each database (by name) once
next if $db_checked->{$dbname}++;
$self->glog("Checking database $dbname for sync $syncname", LOG_DEBUG);
my $dbinfo = $sync->{db}{$dbname};
## All we need to worry about are stalled ones
next DB if $dbinfo->{status} ne 'stalled';
## Just in case, remove the database handle
undef $dbinfo->{dbh};
eval {
($dbinfo->{backend}, $dbinfo->{dbh}) = $self->connect_database($dbname);
$self->show_db_version_and_time($dbinfo->{dbh}, $dbinfo->{backend}, qq{Database "$dbname" });
};
if (defined $dbinfo->{dbh}) {
$dbinfo->{status} = 'active';
$SQL = 'UPDATE bucardo.db SET status = ? WHERE name = ?';
my $sth = $self->{masterdbh}->prepare($SQL);
$sth->execute('active',$dbname);
$self->{masterdbh}->commit();
$restored_dbs++;
$self->glog("Sucessfully restored database $dbname: no longer stalled", LOG_NORMAL);
}
} ## end each database
## If any databases were restored, restore the sync too
if ($restored_dbs) {
$sync->{status} = 'stalled';
$SQL = 'UPDATE bucardo.sync SET status = ? WHERE name = ?';
my $sth = $self->{masterdbh}->prepare($SQL);
$sth->execute('active',$syncname);
$self->{masterdbh}->commit();
$restored_syncs++;
$self->glog("Sucessfully restored sync $syncname: no longer stalled", LOG_NORMAL);
}
} ## end each sync
return $restored_syncs;
} ## end of restore_syncs
sub start_controller {
## For a particular sync, does all the listening and creation of KIDs
## aka the CTL process
## Why not just spawn KIDs? Someday the CTL may have multiple kids again...
## Arguments: one
## 1. Hashref of sync information
## Returns: never
our ($self,$sync) = @_;
$self->{ctlpid} = $$;
$self->{syncname} = $sync->{name};
## Prefix all log lines with this TLA (was MCP)
$self->{logprefix} = 'CTL';
## Extract some of the more common items into local vars
my ($syncname,$kidsalive,$dbinfo, $kicked,) = @$sync{qw(
name kidsalive dbs kick_on_startup)};
## Set our process name
$0 = qq{Bucardo Controller.$self->{extraname} Sync "$syncname" for relgroup "$sync->{herd}" to dbs "$sync->{dbs}"};
## Upgrade any specific sync configs to global configs
if (exists $config{sync}{$syncname}) {
while (my ($setting, $value) = each %{$config{sync}{$syncname}}) {
$config{$setting} = $value;
$self->glog("Set sync-level config setting $setting: $value", LOG_TERSE);
}
}
## Store our PID into a file
## Save the complete returned name for later cleanup
$self->{ctlpidfile} = $self->store_pid( "bucardo.ctl.sync.$syncname.pid" );
## Start normal log output for this controller: basic facts
my $msg = qq{New controller for sync "$syncname". Relgroup is "$sync->{herd}", dbs is "$sync->{dbs}". PID=$$};
$self->glog($msg, LOG_TERSE);
## Log some startup information, and squirrel some away for later emailing
my $mailmsg = "$msg\n";
$msg = qq{ stayalive: $sync->{stayalive} checksecs: $sync->{checksecs} kicked: $kicked};
$self->glog($msg, LOG_NORMAL);
$mailmsg .= "$msg\n";
$msg = sprintf q{ kidsalive: %s onetimecopy: %s lifetimesecs: %s (%s) maxkicks: %s},
$kidsalive,
$sync->{onetimecopy},
$sync->{lifetimesecs},
$sync->{lifetime} || 'NULL',
$sync->{maxkicks};
$self->glog($msg, LOG_NORMAL);
$mailmsg .= "$msg\n";
## Allow the MCP to signal us (request to exit)
local $SIG{USR1} = sub {
## Do not change this message: looked for in the controller DIE sub
die "MCP request\n";
};
## From this point forward, we want to die gracefully
local $SIG{__DIE__} = sub {
## Arguments: one
## 1. Error message
## Returns: never (exit 0)
my ($diemsg) = @_;
## Store the line that did the actual exception
my $line = (caller)[2];
## Don't issue a warning if this was simply a MCP request
my $warn = $diemsg =~ /MCP request/ ? '' : 'Warning! ';
$self->glog(qq{${warn}Controller for "$syncname" was killed at line $line: $diemsg}, LOG_WARN);
## We send an email if it's enabled
if ($self->{sendmail} or $self->{sendmail_file}) {
## Never email passwords
my $oldpass = $self->{dbpass};
$self->{dbpass} = '???';
## Create a text version of our $self to email out
my $dump = Dumper $self;
my $body = qq{
Controller $$ has been killed at line $line
Host: $hostname
Sync name: $syncname
Relgroup: $sync->{herd}
Databases: $sync->{dbs}
Error: $diemsg
Parent process: $self->{mcppid}
Stats page: $config{stats_script_url}?sync=$syncname
Version: $VERSION
};
## Whitespace cleanup
$body =~ s/^\s+//gsm;
## Give some hints in the subject lines for known types of errors
my $moresub = '';
if ($diemsg =~ /Found stopfile/) {
$moresub = ' (stopfile)';
}
elsif ($diemsg =~ /could not serialize access/) {
$moresub = ' (serialization)';
}
elsif ($diemsg =~ /deadlock/) {
$moresub = ' (deadlock)';
}
elsif ($diemsg =~ /could not connect/) {
$moresub = ' (no connection)';
}
## Send the mail, but not for a normal shutdown
if ($moresub !~ /stopfile/) {
my $subject = qq{Bucardo "$syncname" controller killed on $shorthost$moresub};
$self->send_mail({ body => "$body\n", subject => $subject });
}
## Restore the password for the final cleanup connection
$self->{dbpass} = $oldpass;
} ## end sending email
## Cleanup the controller by killing kids, cleaning database tables and removing the PID file.
$self->cleanup_controller(0, $diemsg);
exit 0;
}; ## end SIG{__DIE__} handler sub
## Connect to the master database
($self->{master_backend}, $self->{masterdbh}) = $self->connect_database();
my $maindbh = $self->{masterdbh};
$self->glog("Bucardo database backend PID: $self->{master_backend}", LOG_VERBOSE);
## Map the PIDs to common names for better log output
$self->{pidmap}{$$} = 'CTL';
$self->{pidmap}{$self->{master_backend}} = 'Bucardo DB';
## Listen for kick requests from the MCP for this sync
my $kicklisten = "kick_$syncname";
$self->db_listen($maindbh, "ctl_$kicklisten");
## Listen for a controller ping request
my $pinglisten = "${$}_ping";
$self->db_listen($maindbh, "ctl_$pinglisten");
## Commit so we start listening right away
$maindbh->commit();
## SQL to update the syncrun table's status only
## This is currently unused, but no harm in leaving it in place.
## It would be nice to syncrun the before_sync and after_sync
## custom codes. If we reintroduce the multi-kid 'gang' concept,
## that changes things radically as well.
$SQL = q{
UPDATE bucardo.syncrun
SET status=?
WHERE sync=?
AND ended IS NULL
};
$sth{ctl_syncrun_update_status} = $maindbh->prepare($SQL);
## SQL to update the syncrun table on startup
## Returns the insert (start) time
$SQL = q{
UPDATE bucardo.syncrun
SET ended=now(), status=?
WHERE sync=?
AND ended IS NULL
RETURNING started
};
$sth{ctl_syncrun_end_now} = $maindbh->prepare($SQL);
## At this point, this controller must be authoritative for its sync
## Thus, we want to stop/kill any other CTL or KID processes that exist for this sync
## The first step is to send a friendly notice asking them to leave gracefully
my $stopsync = "stopsync_$syncname";
## This will commit after the notify:
$self->db_notify($maindbh, "kid_$stopsync");
## We also want to force other controllers of this sync to leave
$self->db_notify($maindbh, "ctl_$stopsync");
## Now we can listen for it ourselves in case the MCP requests it
$self->db_listen($maindbh, "ctl_$stopsync");
## Now we look for any PID files for this sync and send them a HUP
$count = $self->send_signal_to_PID( {sync => $syncname} );
## Next, we want to interrupt any long-running queries a kid may be in the middle of
## If they are, they will not receive the message above until done, but we can't wait
## If we stopped anyone, sleep a bit to allow them to exit and remove their PID files
$self->terminate_old_goats($syncname) and sleep 1;
## Clear out any old entries in the syncrun table
$sth = $sth{ctl_syncrun_end_now};
$count = $sth->execute("Old entry ended (CTL $$)", $syncname);
if (1 == $count) {
$info = $sth->fetchall_arrayref()->[0][0];
$self->glog("Ended old syncrun entry, start time was $info", LOG_NORMAL);
}
else {
$sth->finish();
}
## Count the number of gangs in use by this sync
my %gang;
for my $dbname (sort keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
## Makes no sense to specify gangs for source databases!
next if $d->{role} eq 'source';
$gang{$d->{gang}}++;
}
$sync->{numgangs} = keys %gang;
## Listen for a kid letting us know the sync has finished
my $syncdone = "syncdone_$syncname";
$self->db_listen($maindbh, "ctl_$syncdone");
## Determine the last time this sync fired, if we are using "checksecs"
if ($sync->{checksecs}) {
## The handy syncrun table tells us the time of the last good run
$SQL = q{
SELECT CEIL(EXTRACT(epoch FROM ended))
FROM bucardo.syncrun
WHERE sync=?
AND lastgood IS TRUE
OR lastempty IS TRUE
};
$sth = $maindbh->prepare($SQL);
$count = $sth->execute($syncname);
## Got a match? Use that
if (1 == $count) {
$sync->{lastheardfrom} = $sth->fetchall_arrayref()->[0][0];
}
else {
## We default to "now" if we cannot find an earlier time
$sth->finish();
$sync->{lastheardfrom} = time();
}
$maindbh->commit();
}
## If running an after_sync customcode, we need a timestamp
if (exists $sync->{code_after_sync}) {
$SQL = 'SELECT now()';
$sync->{starttime} = $maindbh->selectall_arrayref($SQL)->[0][0];
## Rolling back as all we did was the SELECT
$maindbh->rollback();
}
## Reconnect to all databases we care about: overwrites existing dbhs
for my $dbname (sort keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
if ($d->{dbtype} =~ /flat/o) {
$self->glog(qq{Not connecting to flatfile database "$dbname"}, LOG_NORMAL);
next;
}
## Do not need non-Postgres handles for the controller
next if $d->{dbtype} ne 'postgres';
## Establish a new database handle
($d->{backend}, $d->{dbh}) = $self->connect_database($dbname);
$self->glog(qq{Database "$dbname" backend PID: $d->{backend}}, LOG_NORMAL);
$self->{pidmap}{$d->{backend}} = "DB $dbname";
}
## Adjust the target table names as needed and store in the goat hash
## New table name regardless of syncs or databases
$SQL = 'SELECT newname FROM bucardo.customname WHERE goat=? AND db IS NULL and sync IS NULL';
my $sth_custom1 = $maindbh->prepare($SQL);
## New table name for this sync only
$SQL = 'SELECT newname FROM bucardo.customname WHERE goat=? AND sync=? AND db IS NULL';
my $sth_custom2 = $maindbh->prepare($SQL);
## New table name for a specific database only
$SQL = 'SELECT newname FROM bucardo.customname WHERE goat=? AND db=? AND sync IS NULL';
my $sth_custom3 = $maindbh->prepare($SQL);
## New table name for this sync and a specific database
$SQL = 'SELECT newname FROM bucardo.customname WHERE goat=? AND sync=? AND db=?';
my $sth_custom4 = $maindbh->prepare($SQL);
## Adjust the target table columns as needed and store in the goat hash
## New table cols regardless of syncs or databases
$SQL = 'SELECT clause FROM bucardo.customcols WHERE goat=? AND db IS NULL and sync IS NULL';
my $sth_customc1 = $maindbh->prepare($SQL);
## New table cols for this sync only
$SQL = 'SELECT clause FROM bucardo.customcols WHERE goat=? AND sync=? AND db IS NULL';
my $sth_customc2 = $maindbh->prepare($SQL);
## New table cols for a specific database only
$SQL = 'SELECT clause FROM bucardo.customcols WHERE goat=? AND db=? AND sync IS NULL';
my $sth_customc3 = $maindbh->prepare($SQL);
## New table cols for this sync and a specific database
$SQL = 'SELECT clause FROM bucardo.customcols WHERE goat=? AND sync=? AND db=?';
my $sth_customc4 = $maindbh->prepare($SQL);
for my $g (@{ $sync->{goatlist} }) {
## We only transform tables for now
next if $g->{reltype} ne 'table';
my ($S,$T) = ($g->{safeschema},$g->{safetable});
## See if we have any custom names or columns. Each level overrides the last
my $customname = '';
my $customcols = '';
## Just this goat
$count = $sth_custom1->execute($g->{id});
if ($count < 1) {
$sth_custom1->finish();
}
else {
$customname = $sth_custom1->fetchall_arrayref()->[0][0];
}
$count = $sth_customc1->execute($g->{id});
if ($count < 1) {
$sth_customc1->finish();
}
else {
$customcols = $sth_customc1->fetchall_arrayref()->[0][0];
}
## Just this goat and this sync
$count = $sth_custom2->execute($g->{id}, $syncname);
if ($count < 1) {
$sth_custom2->finish();
}
else {
$customname = $sth_custom2->fetchall_arrayref()->[0][0];
}
$count = $sth_customc2->execute($g->{id}, $syncname);
if ($count < 1) {
$sth_customc2->finish();
}
else {
$customcols = $sth_customc2->fetchall_arrayref()->[0][0];
}
## Need to pick one source at random to extract the list of columns from
my $saved_sourcedbh = '';
## Set for each target db
$g->{newname}{$syncname} = {};
$g->{newcols}{$syncname} = {};
for my $dbname (sort keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
my $type= $d->{dbtype};
my $cname;
my $ccols = '';
## We only ever change table names (or cols) for true targets
if ($d->{role} ne 'source') {
## Save local copies for this database only
$cname = $customname;
$ccols = $customcols;
## Anything for this goat and this database?
$count = $sth_custom3->execute($g->{id}, $dbname);
if ($count < 1) {
$sth_custom3->finish();
}
else {
$cname = $sth_custom3->fetchall_arrayref()->[0][0];
}
$count = $sth_customc3->execute($g->{id}, $dbname);
if ($count < 1) {
$sth_customc3->finish();
}
else {
$ccols = $sth_customc3->fetchall_arrayref()->[0][0];
}
## Anything for this goat, this sync, and this database?
$count = $sth_custom4->execute($g->{id}, $syncname, $dbname);
if ($count < 1) {
$sth_custom4->finish();
}
else {
$cname = $sth_custom4->fetchall_arrayref()->[0][0];
}
$count = $sth_customc4->execute($g->{id}, $syncname, $dbname);
if ($count < 1) {
$sth_customc4->finish();
}
else {
$ccols = $sth_customc4->fetchall_arrayref()->[0][0];
}
}
## Got a new name match? Just use that for everything
if (defined $cname and $cname) {
$g->{newname}{$syncname}{$dbname} = $cname;
}
## Only a few use schemas:
elsif ($d->{dbtype} eq 'postgres'
or $d->{dbtype} eq 'flatpg') {
$g->{newname}{$syncname}{$dbname} = "$S.$T";
}
## Some always get the raw table name
elsif ($d->{dbtype} eq 'redis') {
$g->{newname}{$syncname}{$dbname} = $g->{tablename};
}
else {
$g->{newname}{$syncname}{$dbname} = $T;
}
## Set the columns for this combo: empty for no change
$g->{newcols}{$syncname}{$dbname} = $ccols;
## If we do not have a source database handle yet, grab one
if (! $saved_sourcedbh) {
for my $dbname (sort keys %{ $sync->{db} }) {
next if $sync->{db}{$dbname}{role} ne 'source';
## All we need is the handle, nothing more
$saved_sourcedbh = $sync->{db}{$dbname}{dbh};
## Leave this loop, we got what we came for
last;
}
}
## We either get the specific columns, or use a '*' if no customcols
my $SELECT = $ccols || 'SELECT *';
## Run a dummy query against the source to pull back the column names
## This is particularly important for customcols of course!
$sth = $saved_sourcedbh->prepare("SELECT * FROM ($SELECT FROM $S.$T LIMIT 0) AS foo LIMIT 0");
$sth->execute();
## Store the arrayref of column names for this goat and this select clause
$g->{tcolumns}{$SELECT} = $sth->{NAME};
$sth->finish();
$saved_sourcedbh->rollback();
## Make sure none of them are un-named, which Postgres outputs as ?column?
if (grep { /\?/ } @{ $g->{tcolumns}{$SELECT} }) {
die "Invalid customcols given: must give an alias to all columns! ($g->{tcolumns}{$SELECT}) for $SELECT\n";
}
}
}
## Set to true if we determine the kid(s) should make a run
## Can be set by:
## kick notice from the MCP for this sync
## 'checksecs' timeout
## if we are just starting up (now)
my $kick_request = 1;
## How long it has been since we checked on our kids
my $kidchecktime = 0;
## For custom code:
our $input = {}; ## XXX still needed?
## We are finally ready to enter the main loop
CONTROLLER: {
## Bail if the stopfile exists
if (-e $self->{stop_file}) {
$self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_TERSE);
## Do not change this message: looked for in the controller DIE sub
my $stopmsg = 'Found stopfile';
## Grab the reason, if it exists, so we can propagate it onward
my $ctlreason = get_reason(0);
if ($ctlreason) {
$stopmsg .= ": $ctlreason";
}
## This exception is caught by the controller's __DIE__ sub above
die "$stopmsg\n";
}
## Process any notifications from the main database
## Ignore things we may have sent ourselves
my $nlist = $self->db_get_notices($maindbh, $self->{master_backend});
NOTICE: for my $name (sort keys %{ $nlist }) {
my $npid = $nlist->{$name}{firstpid};
## Strip prefix so we can easily use both pre and post 9.0 versions
$name =~ s/^ctl_//o;
## Kick request from the MCP?
if ($name eq $kicklisten) {
$kick_request = 1;
next NOTICE;
}
## Request for a ping via listen/notify
if ($name eq $pinglisten) {
$self->glog('Got a ping, issuing pong', LOG_DEBUG);
$self->db_notify($maindbh, "ctl_${$}_pong");
next NOTICE;
}
## Another controller has asked us to leave as we are no longer The Man
if ($name eq $stopsync) {
$self->glog('Got a stop sync request, so exiting', LOG_TERSE);
die 'Stop sync request';
}
## A kid has just finished syncing
if ($name eq $syncdone) {
$self->{syncdone} = time;
$self->glog("Kid $npid has reported that sync $syncname is done", LOG_DEBUG);
## If this was a onetimecopy sync, flip the bit (which should be done in the db already)
if ($sync->{onetimecopy}) {
$sync->{onetimecopy} = 0;
}
next NOTICE;
}
## Someone else's sync is getting kicked, finishing up, or stopping
next NOTICE if
(index($name, 'kick_') == 0)
or
(index($name, 'syncdone_') == 0)
or
(index($name, 'stopsync_') == 0);
## Ignore any messages sent to a kid
next NOTICE if 0 == index($name, 'kid_');
## Should not happen, but let's at least log it
$self->glog("Warning: received unknown message $name from $npid!", LOG_TERSE);
} ## end of each notification
## To ensure we can receive new notifications next time:
$maindbh->commit();
if ($self->{syncdone}) {
## Reset the notice
$self->{syncdone} = 0;
## Run all after_sync custom codes
if (exists $sync->{code_after_sync}) {
for my $code (@{$sync->{code_after_sync}}) {
#$sth{ctl_syncrun_update_status}->execute("Code after_sync (CTL $$)", $syncname);
$maindbh->commit();
my $result = $self->run_ctl_custom_code($sync,$input,$code, 'nostrict');
$self->glog("End of after_sync $code->{id}", LOG_VERBOSE);
} ## end each custom code
}
## Let anyone listening know that this sync is complete. Global message
my $notifymsg = "syncdone_$syncname";
$self->db_notify($maindbh, $notifymsg);
## If we are not a stayalive, this is a good time to leave
if (! $sync->{stayalive} and ! $kidsalive) {
$self->cleanup_controller(1, 'Kids are done');
exit 0;
}
## XXX: re-examine
# If we ran an after_sync and grabbed rows, reset the time
# if (exists $rows_for_custom_code->{source}) {
# $SQL = "SELECT $self->{mcp_clock_timestamp}";
# $sync->{starttime} = $maindbh->selectall_arrayref($SQL)->[0][0];
# }
} ## end if sync done
## If we are using checksecs, possibly force a kick
if ($sync->{checksecs}) {
## Already being kicked? Reset the clock
if ($kick_request) {
$sync->{lastheardfrom} = time();
}
elsif (time() - $sync->{lastheardfrom} >= $sync->{checksecs}) {
if ($sync->{onetimecopy}) {
$self->glog(qq{Timed out, but in onetimecopy mode, so not kicking, for "$syncname"}, LOG_DEBUG);
}
else {
$self->glog(qq{Timed out - force a sync for "$syncname"}, LOG_VERBOSE);
$kick_request = 1;
}
## Reset the clock
$sync->{lastheardfrom} = time();
}
}
## XXX What about non stayalive kids?
## XXX This is called too soon - recently created kids are not there yet!
## Check that our kids are alive and healthy
## XXX Skip if we know the kids are busy? (cannot ping/pong!)
## XXX Maybe skip this entirely and just check on a kick?
if ($sync->{stayalive} ## CTL must be persistent
and $kidsalive ## KID must be persistent
and $self->{kidpid} ## KID must have been created at least once
and time() - $kidchecktime >= $config{ctl_checkonkids_time}) {
my $pidfile = "$config{piddir}/bucardo.kid.sync.$syncname.pid";
## If we find a problem, set this to true
my $resurrect = 0;
## Make sure the PID file exists
if (! -e $pidfile) {
$self->glog("PID file missing: $pidfile", LOG_DEBUG);
$resurrect = 1;
}
else {
## Make sure that a kill 0 sees it
## XXX Use ping/pong?
my $pid = $self->{kidpid};
$count = kill 0 => $pid;
if ($count != 1) {
$self->glog("Warning: Kid $pid is not responding, will respawn", LOG_TERSE);
$resurrect = 2;
}
}
## At this point, the PID file does not exist or the kid is not responding
if ($resurrect) {
## XXX Try harder to kill it?
## First clear out any old entries in the syncrun table
$sth = $sth{ctl_syncrun_end_now};
$count = $sth->execute("Old entry died (CTL $$)", $syncname);
if (1 == $count) {
$info = $sth->fetchall_arrayref()->[0][0];
$self->glog("Old syncrun entry removed during resurrection, start time was $info", LOG_NORMAL);
}
else {
$sth->finish();
}
$self->glog("Resurrecting kid $syncname, resurrect was $resurrect", LOG_DEBUG);
$self->{kidpid} = $self->create_newkid($sync);
## Sleep a little here to prevent runaway kid creation
sleep $config{kid_restart_sleep};
}
## Reset the time
$kidchecktime = time();
} ## end of time to check on our kid's health
## Redo if we are not kicking but are stayalive and the queue is clear
if (! $kick_request and $sync->{stayalive}) {
sleep $config{ctl_sleep};
redo CONTROLLER;
}
## Reset the kick_request for the next run
$kick_request = 0;
## At this point, we know we are about to run a sync
## We will either create the kid(s), or signal the existing one(s)
## XXX If a custom code handler needs a database handle, create one
our ($cc_sourcedbh,$safe_sourcedbh);
## Run all before_sync code
## XXX Move to kid? Do not want to run over and over if something is queued
if (exists $sync->{code_before_sync}) {
#$sth{ctl_syncrun_update_status}->execute("Code before_sync (CTL $$)", $syncname);
$maindbh->commit();
for my $code (@{$sync->{code_before_sync}}) {
my $result = $self->run_ctl_custom_code($sync,$input,$code, 'nostrict');
if ($result eq 'redo') {
redo CONTROLLER;
}
}
}
$maindbh->commit();
if ($self->{kidpid}) {
## Tell any listening kids to go ahead and start
$self->db_notify($maindbh, "kid_run_$syncname");
}
else {
## Create any kids that do not exist yet (or have been killed, as detected above)
$self->glog("Creating a new kid for sync $syncname", LOG_VERBOSE);
$self->{kidpid} = $self->create_newkid($sync);
}
sleep $config{ctl_sleep};
redo CONTROLLER;
} ## end CONTROLLER
die 'How did we reach outside of the main controller loop?';
} ## end of start_controller
sub start_kid {
## A single kid, in charge of doing a sync between two or more databases
## aka the KID process
## Arguments: one
## 1. Hashref of sync information
## Returns: never (exits)
my ($self,$sync) = @_;
## Prefix all log lines with this TLA
$self->{logprefix} = 'KID';
## Extract some of the more common items into local vars
my ($syncname, $goatlist, $kidsalive, $dbs, $kicked) = @$sync{qw(
name goatlist kidsalive dbs kick_on_startup)};
## Adjust the process name, start logging
$0 = qq{Bucardo Kid.$self->{extraname} Sync "$syncname"};
my $extra = $sync->{onetimecopy} ? "OTC: $sync->{onetimecopy}" : '';
if ($config{log_showsyncname}) {
$self->{logprefix} .= " ($syncname)";
}
$self->glog(qq{New kid, sync "$syncname" alive=$kidsalive Parent=$self->{ctlpid} PID=$$ kicked=$kicked $extra}, LOG_TERSE);
## Store our PID into a file
## Save the complete returned name for later cleanup
$self->{kidpidfile} = $self->store_pid( "bucardo.kid.sync.$syncname.pid" );
## Establish these early so the DIE block can use them
my ($S,$T,$pkval) = ('?','?','?');
## Keep track of how many times this kid has done work
my $kidloop = 0;
## Catch USR1 errors as a signal from the parent CTL process to exit right away
local $SIG{USR1} = sub {
## Mostly so we do not send an email:
$self->{clean_exit} = 1;
die "CTL request\n";
};
## Set up some common groupings of the databases inside sync->{db}
## Also setup common attributes
my (@dbs, @dbs_source, @dbs_target, @dbs_delta, @dbs_fullcopy,
@dbs_connectable, @dbs_dbi, @dbs_write, @dbs_non_fullcopy,
@dbs_postgres, @dbs_drizzle, @dbs_mongo, @dbs_mysql, @dbs_oracle,
@dbs_redis, @dbs_sqlite);
## Used to weed out all but one source if in onetimecopy mode
my $found_first_source = 0;
for my $dbname (sort keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
## All databases start with triggers enabled
$d->{triggers_enabled} = 1;
## First, do some exclusions
## If this is a onetimecopy sync, the fullcopy targets are dead to us
next if $sync->{onetimecopy} and $d->{role} eq 'fullcopy';
## If this is a onetimecopy sync, we only need to connect to a single source
if ($sync->{onetimecopy} and $d->{role} eq 'source') {
next if $found_first_source;
$found_first_source = 1;
}
## If this is inactive, we've already checked that if it is a source in validate_sync
## Thus, if we made it this far, it is a target and should be skipped
if ($d->{status} eq 'inactive') {
$self->glog(qq{Skipping inactive database "$dbname" entirely}, LOG_NORMAL);
## Don't just skip it: nuke it from orbit! It's the only way to be sure.
delete $sync->{db}{$dbname};
next;
}
## Now set the default attributes
## Is this a SQL database?
$d->{does_sql} = 0;
## Do we have a DBI-based driver?
$d->{does_dbi} = 0;
## Can it do truncate?
$d->{does_truncate} = 0;
## Does it support asynchronous queries well?
$d->{does_async} = 0;
## Does it have good support for ANY()?
$d->{does_ANY_clause} = 0;
## Can it do savepoints (and roll them back)?
$d->{does_savepoints} = 0;
## Does it support truncate cascade?
$d->{does_cascade} = 0;
## Does it support a LIMIT clause?
$d->{does_limit} = 0;
## Can it be queried?
$d->{does_append_only} = 0;
## List of tables in this database that need makedelta inserts
$d->{does_makedelta} = {};
## Does it have that annoying timestamp +dd bug?
$d->{has_mysql_timestamp_issue} = 0;
## Start clumping into groups and adjust the attributes
## Postgres
if ('postgres' eq $d->{dbtype}) {
push @dbs_postgres => $dbname;
$d->{does_sql} = 1;
$d->{does_truncate} = 1;
$d->{does_savepoints} = 1;
$d->{does_cascade} = 1;
$d->{does_limit} = 1;
$d->{does_async} = 1;
$d->{does_ANY_clause} = 1;
}
## Drizzle
if ('drizzle' eq $d->{dbtype}) {
push @dbs_drizzle => $dbname;
$d->{does_sql} = 1;
$d->{does_truncate} = 1;
$d->{does_savepoints} = 1;
$d->{does_limit} = 1;
$d->{has_mysql_timestamp_issue} = 1;
}
## MongoDB
if ('mongo' eq $d->{dbtype}) {
push @dbs_mongo => $dbname;
}
## MySQL (and MariaDB)
if ('mysql' eq $d->{dbtype} or 'mariadb' eq $d->{dbtype}) {
push @dbs_mysql => $dbname;
$d->{does_sql} = 1;
$d->{does_truncate} = 1;
$d->{does_savepoints} = 1;
$d->{does_limit} = 1;
$d->{has_mysql_timestamp_issue} = 1;
}
## Oracle
if ('oracle' eq $d->{dbtype}) {
push @dbs_oracle => $dbname;
$d->{does_sql} = 1;
$d->{does_truncate} = 1;
$d->{does_savepoints} = 1;
}
## Redis
if ('redis' eq $d->{dbtype}) {
push @dbs_redis => $dbname;
}
## SQLite
if ('sqlite' eq $d->{dbtype}) {
push @dbs_sqlite => $dbname;
$d->{does_sql} = 1;
$d->{does_truncate} = 1;
$d->{does_savepoints} = 1;
$d->{does_limit} = 1;
}
## Flat files
if ($d->{dbtype} =~ /flat/) {
$d->{does_append_only} = 1;
}
## Everyone goes into this bucket
push @dbs => $dbname;
## Databases we read data from
push @dbs_source => $dbname
if $d->{role} eq 'source';
## Target databases
push @dbs_target => $dbname
if $d->{role} ne 'source';
## Databases that (potentially) get written to
## This is all of them, unless we are a source
## and a fullcopy sync or in onetimecopy mode
push @dbs_write => $dbname
if (!$sync->{fullcopy} and !$sync->{onetimecopy})
or $d->{role} ne 'source';
## Databases that get deltas
## If in onetimecopy mode, this is always forced to be empty
## Likewise, no point in populating if this is a fullcopy sync
push @dbs_delta => $dbname
if $d->{role} eq 'source'
and ! $sync->{onetimecopy}
and ! $sync->{fullcopy};
## Databases that get the full monty
## In normal mode, this means a role of 'fullcopy'
## In onetimecopy mode, this means a role of 'target'
push @dbs_fullcopy => $dbname
if ($sync->{onetimecopy} and $d->{role} eq 'target')
or ($sync->{fullcopy} and $d->{role} eq 'fullcopy');
## Non-fullcopy databases. Basically dbs_source + dbs_target
push @dbs_non_fullcopy => $dbname
if $d->{role} ne 'fullcopy';
## Databases with Perl DBI support
if ($d->{dbtype} eq 'postgres'
or $d->{dbtype} eq 'drizzle'
or $d->{dbtype} eq 'mariadb'
or $d->{dbtype} eq 'mysql'
or $d->{dbtype} eq 'oracle'
or $d->{dbtype} eq 'sqlite') {
push @dbs_dbi => $dbname;
$d->{does_dbi} = 1;
}
## Things we can connect to. Almost everything
push @dbs_connectable => $dbname
if $d->{dbtype} !~ /flat/;
}
## Connect to the main database
($self->{master_backend}, $self->{masterdbh}) = $self->connect_database();
## Set a shortcut for this handle, and log the details
my $maindbh = $self->{masterdbh};
$self->glog("Bucardo database backend PID: $self->{master_backend}", LOG_VERBOSE);
## Setup mapping so we can report in the log which things came from this backend
$self->{pidmap}{$self->{master_backend}} = 'Bucardo DB';
## SQL to enter a new database in the dbrun table
$SQL = q{
INSERT INTO bucardo.dbrun(sync,dbname,pgpid)
VALUES (?,?,?)
};
$sth{dbrun_insert} = $maindbh->prepare($SQL);
## SQL to remove a database from the dbrun table
$SQL{dbrun_delete} = q{
DELETE FROM bucardo.dbrun
WHERE sync = ? AND dbname = ?
};
$sth{dbrun_delete} = $maindbh->prepare($SQL{dbrun_delete});
## Disable the CTL exception handler.
## Fancy exception handler to clean things up before leaving.
my $err_handler = sub {
## Arguments: one
## 1. Error message
## Returns: never (exit 1)
## Trim whitespace from our message
my ($msg) = @_;
$msg =~ s/\s+$//g;
## Where did we die?
my $line = (caller)[2];
$msg .= "\nLine: $line";
## Subject line tweaking later on
my $moresub = '';
## Find any error messages/states for all databases
if ($msg =~ /DBD::Pg/) {
$msg .= "\nMain DB state: " . ($maindbh->state || '?');
$msg .= ' Error: ' . ($maindbh->err || 'none');
for my $dbname (@dbs_dbi) {
my $d = $sync->{db}{$dbname};
my $dbh = $d->{dbh};
my $state = $dbh->state || '?';
$msg .= "\nDB $dbname state: $state";
$msg .= ' Error: ' . ($dbh->err || 'none');
## If this was a deadlock problem, try and gather more information
if ($state eq '40P01' and $d->{dbtype} eq 'postgres') {
$msg .= $self->get_deadlock_details($dbh, $msg);
$moresub = ' (deadlock)';
last;
}
}
}
$msg .= "\n";
(my $flatmsg = $msg) =~ s/\n/ /g;
$self->glog("Kid has died, error is: $flatmsg", LOG_TERSE);
## Drop connection to the main database, then reconnect
if (defined $maindbh and $maindbh) {
$maindbh->rollback;
$_->finish for values %{ $maindbh->{CachedKids} };
$maindbh->disconnect;
}
my ($finalbackend, $finaldbh) = $self->connect_database();
$self->glog("Final database backend PID: $finalbackend", LOG_VERBOSE);
$sth{dbrun_delete} = $finaldbh->prepare($SQL{dbrun_delete});
$self->db_notify($finaldbh, 'kid_pid_stop', 1);
## Drop all open database connections, clear out the dbrun table
for my $dbname (@dbs_dbi) {
my $d = $sync->{db}{$dbname};
my $dbh = $d->{dbh} or do {
$self->glog("Missing $dbname database handle", LOG_WARN);
next;
};
## Is this still around?
if (!$dbh->ping) {
$self->glog("Ping failed for database $dbname", LOG_TERSE);
## We want to give the MCP a hint that something is wrong
$self->db_notify($finaldbh, "dead_db_$dbname", 1);
## We'll assume no disconnect is necessary - but we'll undef it below just in case
}
else {
## Rollback, finish all statement handles, and disconnect
$dbh->rollback();
$self->glog("Disconnecting from database $dbname", LOG_DEBUG);
$_->finish for values %{ $dbh->{CachedKids} };
$dbh->disconnect();
}
## Make sure we don't think we are still in the middle of an async query
$d->{async_active} = 0;
## Make sure we never access this connection again
undef $dbh;
## Clear out the entry from the dbrun table
$sth = $sth{dbrun_delete};
$sth->execute($syncname, $dbname);
$finaldbh->commit();
}
## If using semaphore tables, mark the status as 'failed'
## At least in the Mongo case, it's pretty safe to do this,
## as it is unlikely the error came from Mongo Land
if ($config{semaphore_table}) {
my $tname = $config{semaphore_table};
for my $dbname (@dbs_connectable) {
my $d = $sync->{db}{$dbname};
if ($d->{dbtype} eq 'mongo') {
my $collection = $d->{dbh}->get_collection($tname);
my $object = {
sync => $syncname,
status => 'failed',
endtime => scalar gmtime,
};
$collection->update
(
{sync => $syncname},
$object,
{ upsert => 1, safe => 1 }
);
}
}
}
## Mark this syncrun as aborted if needed, replace the 'lastbad'
my $status = "Failed : $flatmsg (KID $$)";
$self->end_syncrun($finaldbh, 'bad', $syncname, $status);
$finaldbh->commit();
## Update the dbrun table as needed
$SQL = q{DELETE FROM bucardo.dbrun WHERE sync = ?};
$sth = $finaldbh->prepare($SQL);
$sth->execute($syncname);
## Let anyone listening know that this target sync aborted. Global message.
$self->db_notify($finaldbh, "synckill_${syncname}");
## Done with database cleanups, so disconnect
$finaldbh->disconnect();
## Send an email as needed (never for clean exit)
if (! $self->{clean_exit} and $self->{sendmail} or $self->{sendmail_file}) {
my $warn = $msg =~ /CTL.+request/ ? '' : 'Warning! ';
$self->glog(qq{${warn}Child for sync "$syncname" was killed at line $line: $msg}, LOG_WARN);
## Never display the database passwords
for (values %{$self->{dbs}}) {
$_->{dbpass} = '???';
}
$self->{dbpass} = '???';
## Create the body of the message to be mailed
my $dump = Dumper $self;
my $body = qq{
Kid $$ has been killed at line $line
Error: $msg
Possible suspects: $S.$T: $pkval
Host: $hostname
Sync name: $syncname
Stats page: $config{stats_script_url}?sync=$syncname
Parent process: $self->{mcppid} -> $self->{ctlpid}
Rows set to aborted: $count
Version: $VERSION
Loops: $kidloop
};
$body =~ s/^\s+//gsm;
if ($msg =~ /Found stopfile/) {
$moresub = ' (stopfile)';
}
elsif ($msg =~ /could not connect/) {
$moresub = ' (no connection)';
}
my $subject = qq{Bucardo kid for "$syncname" killed on $shorthost$moresub};
$self->send_mail({ body => "$body\n", subject => $subject });
} ## end sending email
my $extrainfo = sprintf '%s%s%s',
qq{Sync "$syncname"},
$S eq '?' ? '' : " $S.$T",
$pkval eq '?' ? '' : " pk: $pkval";
$self->cleanup_kid($flatmsg, $extrainfo);
exit 1;
}; ## end $err_handler
my $stop_sync_request = "stopsync_$syncname";
## Tracks how long it has been since we last ran a ping against our databases
my $lastpingcheck = 0;
## Row counts from the delta tables:
my %deltacount;
## Count of changes made (inserts,deletes,truncates,conflicts handled):
my %dmlcount;
my $did_setup = 0;
local $@;
eval {
## Listen for the controller asking us to go again if persistent
if ($kidsalive) {
$self->db_listen( $maindbh, "kid_run_$syncname" );
}
## Listen for a kid ping, even if not persistent
my $kidping = "${$}_ping";
$self->db_listen( $maindbh, "kid_$kidping" );
## Listen for a sync-wide exit signal
$self->db_listen( $maindbh, "kid_$stop_sync_request" );
## Prepare all of our SQL
## Note that none of this is actually 'prepared' until the first execute
## SQL to add a new row to the syncrun table
$SQL = 'INSERT INTO bucardo.syncrun(sync,status) VALUES (?,?)';
$sth{kid_syncrun_insert} = $maindbh->prepare($SQL);
## SQL to update the syncrun table's status only
$SQL = q{
UPDATE bucardo.syncrun
SET status=?
WHERE sync=?
AND ended IS NULL
};
$sth{kid_syncrun_update_status} = $maindbh->prepare($SQL);
## SQL to set the syncrun table as ended once complete
$SQL = q{
UPDATE bucardo.syncrun
SET deletes=deletes+?, inserts=inserts+?, truncates=truncates+?,
conflicts=?, details=?, status=?
WHERE sync=?
AND ended IS NULL
};
$sth{kid_syncrun_end} = $maindbh->prepare($SQL);
## Connect to all (connectable) databases we are responsible for
## This main list has already been pruned by the controller as needed
for my $dbname (@dbs_connectable) {
my $d = $sync->{db}{$dbname};
($d->{backend}, $d->{dbh}) = $self->connect_database($dbname);
$self->glog(qq{Database "$dbname" backend PID: $d->{backend}}, LOG_VERBOSE);
## Register ourself with the MCP (if we are Postgres)
if ($d->{dbtype} eq 'postgres') {
$self->db_notify($maindbh, 'kid_pid_start', 1, $dbname);
}
}
## Set the maximum length of the $dbname.$S.$T string.
## Used for logging output
$self->{maxdbname} = 1;
for my $dbname (keys %{ $sync->{db} }) {
$self->{maxdbname} = length $dbname if length $dbname > $self->{maxdbname};
}
my $maxst = 3;
for my $g (@$goatlist) {
next if $g->{reltype} ne 'table';
($S,$T) = ($g->{safeschema},$g->{safetable});
$maxst = length "$S.$T" if length ("$S.$T") > $maxst;
}
$self->{maxdbstname} = $self->{maxdbname} + 1 + $maxst;
## If we are using delta tables, prepare all relevant SQL
if (@dbs_delta) {
## Prepare the SQL specific to each table
for my $g (@$goatlist) {
## Only tables get all this fuss: sequences are easy
next if $g->{reltype} ne 'table';
## This is the main query: grab all unique changed primary keys since the last sync
$SQL{delta}{$g} = qq{
SELECT DISTINCT $g->{pklist}
FROM bucardo.$g->{deltatable} d
WHERE NOT EXISTS (
SELECT 1
FROM bucardo.$g->{tracktable} t
WHERE d.txntime = t.txntime
AND (t.target = DBGROUP::text)
)
};
## We also need secondary queries to catch the case of partial replications
## This is a per-target check
$SQL{deltatarget}{$g} = qq{
SELECT DISTINCT $g->{pklist}
FROM bucardo.$g->{deltatable} d
WHERE NOT EXISTS (
SELECT 1
FROM bucardo.$g->{tracktable} t
WHERE d.txntime = t.txntime
AND (t.target = TARGETNAME::text)
)
};
## Mark all unclaimed visible delta rows as done in the track table
$SQL{track}{$g} = qq{
INSERT INTO bucardo.$g->{tracktable} (txntime,target)
SELECT DISTINCT txntime, DBGROUP::text
FROM bucardo.$g->{deltatable} d
WHERE NOT EXISTS (
SELECT 1
FROM bucardo.$g->{tracktable} t
WHERE d.txntime = t.txntime
AND (t.target = DBGROUP::text)
);
};
## The same thing, but to the staging table instead, as we have to
## wait for all targets to succesfully commit in multi-source situations
($SQL{stage}{$g} = $SQL{track}{$g}) =~ s/$g->{tracktable}/$g->{stagetable}/;
} ## end each table
## For each source database, prepare the queries above
for my $dbname (@dbs_source) {
my $d = $sync->{db}{$dbname};
## Set the DBGROUP for each database: the bucardo.track_* target entry
$d->{DBGROUPNAME} = "dbgroup $dbs";
for my $g (@$goatlist) {
next if $g->{reltype} ne 'table';
($S,$T) = ($g->{safeschema},$g->{safetable});
## Replace with the target name for source delta querying
($SQL = $SQL{delta}{$g}) =~ s/DBGROUP/'$d->{DBGROUPNAME}'/o;
## As these can be expensive, make them asynchronous
$sth{getdelta}{$dbname}{$g} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC});
## We need to update either the track table or the stage table
## There is no way to know beforehand which we will need, so we prepare both
## Replace with the target name for source track updating
($SQL = $SQL{track}{$g}) =~ s/DBGROUP/'$d->{DBGROUPNAME}'/go;
## Again, async as they may be slow
$sth{track}{$dbname}{$g} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC});
## Same thing for stage
($SQL = $SQL{stage}{$g}) =~ s/DBGROUP/'$d->{DBGROUPNAME}'/go;
$sth{stage}{$dbname}{$g} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC});
} ## end each table
} ## end each source database
## Set all makedelta tables (target databases can have them too, as another sync may have them as a source)
for my $dbname (@dbs) {
my $d = $sync->{db}{$dbname};
for my $g (@$goatlist) {
next if $g->{reltype} ne 'table';
($S,$T) = ($g->{safeschema},$g->{safetable});
## Set the per database/per table makedelta setting now
if (1 == $d->{makedelta} or $g->{makedelta} eq 'on' or $g->{makedelta} =~ /\b$dbname\b/) {
$d->{does_makedelta}{"$S.$T"} = 1;
$self->glog("Set table $dbname.$S.$T to makedelta", LOG_NORMAL);
}
} ## end each table
} ## end all databases
} ## end if delta databases
## Create safe versions of the database handles if we are going to need them
if ($sync->{need_safe_dbh_strict} or $sync->{need_safe_dbh}) {
for my $dbname (@dbs_postgres) {
my $d = $sync->{db}{$dbname};
my $darg;
if ($sync->{need_safe_dbh_strict}) {
for my $arg (sort keys %{ $dbix{ $d->{role} }{strict} }) {
next if ! length $dbix{ $d->{role} }{strict}{$arg};
$darg->{$arg} = $dbix{ $d->{role} }{strict}{$arg};
}
$darg->{dbh} = $d->{dbh};
$self->{safe_dbh_strict}{$dbname} = DBIx::Safe->new($darg);
}
if ($sync->{need_safe_dbh}) {
undef $darg;
for my $arg (sort keys %{ $dbix{ $d->{role} }{notstrict} }) {
next if ! length $dbix{ $d->{role} }{notstrict}{$arg};
$darg->{$arg} = $dbix{ $d->{role} }{notstrict}{$arg};
}
$darg->{dbh} = $d->{dbh};
$self->{safe_dbh}{$dbname} = DBIx::Safe->new($darg);
}
}
} ## end DBIX::Safe creations
$did_setup = 1;
};
$err_handler->($@) if !$did_setup;
## Begin the main KID loop
my $didrun = 0;
my $runkid = sub {
KID: {
## Leave right away if we find a stopfile
if (-e $self->{stop_file}) {
$self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_WARN);
last KID;
}
## Should we actually do something this round?
my $dorun = 0;
## If we were just created or kicked, go ahead and start a run.
if ($kicked) {
$dorun = 1;
$kicked = 0;
}
## If persistent, listen for messages and do an occasional ping of all databases
if ($kidsalive) {
my $nlist = $self->db_get_notices($maindbh);
for my $name (sort keys %{ $nlist }) {
my $npid = $nlist->{$name}{firstpid};
## Strip the prefix
$name =~ s/^kid_//o;
## The controller wants us to exit
if ( $name eq $stop_sync_request ) {
$self->glog('Got a stop sync request, so exiting', LOG_TERSE);
die 'Stop sync request';
}
## The controller has told us we are clear to go
elsif ($name eq "run_$syncname") {
$dorun = 1;
}
## Got a ping? Respond with a pong.
elsif ($name eq "${$}_ping") {
$self->glog('Got a ping, issuing pong', LOG_DEBUG);
$self->db_notify($maindbh, "kid_${$}_pong");
}
## Someone else's sync is running
elsif (index($name, 'run_') == 0) {
}
## Someone else's sync is stopping
elsif (index($name, 'stopsync_') == 0) {
}
## Someone else's kid is getting pinged
elsif (index($name, '_ping') > 0) {
}
## Should not happen, but let's at least log it
else {
$self->glog("Warning: received unknown message $name from $npid!", LOG_TERSE);
}
} ## end each notice
## Now that we've read in any notices, simply rollback
$maindbh->rollback();
## Periodically verify connections to all databases
if (time() - $lastpingcheck >= $config{kid_pingtime}) {
## If this fails, simply have the CTL restart it
## Other things match on the exception wording below, so change carefully
$maindbh->ping or die qq{Ping failed for main database\n};
for my $dbname (@dbs_dbi) {
my $d = $sync->{db}{$dbname};
$d->{dbh}->ping or die qq{Ping failed for database "$dbname"\n};
$d->{dbh}->rollback();
}
$lastpingcheck = time();
}
} ## end if kidsalive
## If we are not doing anything this round, sleep and start over
## We will only ever hit this on the second go around, as kids
## start as autokicked
if (! $dorun) {
sleep $config{kid_sleep};
redo KID;
}
## From this point on, we are a live kid that is expected to run the sync
## Used to report on total times for the long-running parts, e.g. COPY
my $kid_start_time = [gettimeofday];
## Create an entry in the syncrun table to let people know we've started
$self->glog('Adding entry to syncrun table', LOG_DEBUG);
$sth{kid_syncrun_insert}->execute($syncname, "Started (KID $$)");
## Increment our count of how many times we have been here before
$kidloop++;
## Reset the numbers to track total bucardo_delta matches
undef %deltacount;
$deltacount{all} = 0;
$deltacount{table} = {};
## Reset our counts of total inserts, deletes, truncates, and conflicts
undef %dmlcount;
$dmlcount{deletes} = 0;
$dmlcount{inserts} = 0;
$dmlcount{truncates} = 0;
$dmlcount{conflicts} = 0;
## Reset all of our truncate stuff
$self->{has_truncation} = 0;
delete $self->{truncateinfo};
## Reset some things at the per-database level
for my $dbname (keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
## This must be set, as it is used by the conflict_strategy below
$deltacount{$dbname} = 0;
$dmlcount{allinserts}{$dbname} = 0;
$dmlcount{alldeletes}{$dbname} = 0;
delete $d->{truncatewinner};
}
## Reset things at the goat level
for my $g (@$goatlist) {
delete $g->{truncatewinner};
}
## Run all 'before_txn' code
if (exists $sync->{code_before_txn}) {
## Let external people know where we are
$sth{kid_syncrun_update_status}->execute("Code before_txn (KID $$)", $syncname);
$maindbh->commit();
for my $code (@{$sync->{code_before_txn}}) {
## Check if the code has asked us to skip other before_txn codes
last if 'last' eq $self->run_kid_custom_code($sync, $code);
}
}
## Populate the dbrun table so others know we are using these databases
$self->glog('Populating the dbrun table', LOG_DEBUG);
for my $dbname (@dbs_connectable) {
my $d = $sync->{db}{$dbname};
$sth{dbrun_insert}->execute($syncname, $dbname, $d->{backend});
}
## Add a note to the syncrun table
$self->glog('Adding note to the syncrun table', LOG_DEBUG);
$sth{kid_syncrun_update_status}->execute("Begin txn (KID $$)", $syncname);
## Figure out our isolation level. Only used for Postgres
## All others are hard-coded as 'serializable'
$self->{pg_isolation_level} = defined $sync->{isolation_level} ? $sync->{isolation_level} :
$config{isolation_level} || 'serializable';
## Commit so our dbrun and syncrun stuff is visible to others
## This should be done just before we start transactions on all dbs
$self->glog('Doing final maindbh commit', LOG_DEBUG);
$maindbh->commit();
## Start the main transaction and do things such as setting isolation levels
$self->start_main_transaction({ sync => $sync, databases => \@dbs_connectable});
## We may have a request to lock all the tables
$self->lock_all_tables({ sync => $sync, databases => \@dbs_write, tables => $goatlist});
## Do all the delta (non-fullcopy) targets
if (@dbs_delta) {
## We will never reach this while in onetimecopy mode as @dbs_delta is emptied
## Run all 'before_check_rows' code
if (exists $sync->{code_before_check_rows}) {
$sth{kid_syncrun_update_status}->execute("Code before_check_rows (KID $$)", $syncname);
$maindbh->commit();
for my $code (@{$sync->{code_before_check_rows}}) {
## Check if the code has asked us to skip other before_check_rows codes
last if 'last' eq $self->run_kid_custom_code($sync, $code);
}
}
## Check if any tables were truncated on all source databases
## If so, set $self->{has_truncation}; store results in $self->{truncateinfo}
## First level keys are schema then table name
## Third level is maxtime and maxdb, showing the "winner" for each table
$SQL = 'SELECT quote_ident(sname), quote_ident(tname), MAX(EXTRACT(epoch FROM cdate))'
. ' FROM bucardo.bucardo_truncate_trigger '
. ' WHERE sync = ? AND replicated IS NULL GROUP BY 1,2';
for my $dbname (@dbs_source) {
my $d = $sync->{db}{$dbname};
## Grab the latest truncation time for each table, for this source database
$self->glog(qq{Checking truncate_trigger table on database "$dbname"}, LOG_VERBOSE);
$sth = $d->{dbh}->prepare($SQL);
$self->{has_truncation} += $sth->execute($syncname);
for my $row (@{ $sth->fetchall_arrayref() }) {
my ($s,$t,$time) = @{ $row };
## Store if this is the new winner
if (! exists $self->{truncateinfo}{$s}{$t}{maxtime}
or $time > $self->{truncateinfo}{$s}{$t}{maxtime}) {
$self->{truncateinfo}{$s}{$t}{maxtime} = $time;
$self->{truncateinfo}{$s}{$t}{maxdb} = $dbname;
}
}
} ## end each source database, checking for truncations
## Now go through and mark the winner within the "x" hash, for easy skipping later on
if ($self->{has_truncation}) {
for my $s (keys %{ $self->{truncateinfo} }) {
for my $t (keys %{ $self->{truncateinfo}{$s} }) {
my $dbname = $self->{truncateinfo}{$s}{$t}{maxdb};
my $d = $sync->{db}{$dbname};
$d->{truncatewinner}{$s}{$t} = 1;
$self->glog("Truncate winner for $s.$t is database $dbname", LOG_DEBUG);
}
}
## Set the truncate count
my $number = @dbs_non_fullcopy; ## not the best estimate: corner cases
$dmlcount{truncate} = $number - 1;
## Now map this back to our goatlist
for my $g (@$goatlist) {
next if $g->{reltype} ne 'table';
($S,$T) = ($g->{safeschema},$g->{safetable});
if (exists $self->{truncateinfo}{$S}{$T}) {
$g->{truncatewinner} = $self->{truncateinfo}{$S}{$T}{maxdb};
}
}
}
## Next, handle all the sequences
for my $g (@$goatlist) {
next if $g->{reltype} ne 'sequence';
($S,$T) = ($g->{safeschema},$g->{safetable});
## Grab the sequence information from each database
## Figure out which source one is the highest
## Right now, this is the only sane option.
## In the future, we might consider coupling tables and sequences and
## then copying sequences based on the 'winning' underlying table
$SQL = "SELECT * FROM $S.$T";
my $maxvalue = -1;
for my $dbname (@dbs_non_fullcopy) {
my $d = $sync->{db}{$dbname};
next if $d->{dbtype} ne 'postgres';
$sth = $d->{dbh}->prepare($SQL);
$sth->execute();
my $info = $sth->fetchall_arrayref({})->[0];
$g->{sequenceinfo}{$dbname} = $info;
## Only the source databases matter for the max value comparison
next if $d->{role} ne 'source';
if ($info->{last_value} > $maxvalue) {
$maxvalue = $info->{last_value};
$g->{winning_db} = $dbname;
}
}
$self->glog("Sequence $S.$T from db $g->{winning_db} is the highest", LOG_DEBUG);
## Now that we have a winner, apply the changes to every other (non-fullcopy) PG database
for my $dbname (@dbs_non_fullcopy) {
my $d = $sync->{db}{$dbname};
next if $d->{dbtype} ne 'postgres';
$d->{adjustsequence} = 1;
}
$deltacount{sequences} += $self->adjust_sequence($g, $sync, $S, $T, $syncname);
} ## end of handling sequences
## We want to line up all the delta count numbers in the logs,
## so this tracks the largest number returned
my $maxcount = 0;
## Use the bucardo_delta_check function on each database, which gives us
## a quick summary of whether each table has any active delta rows
## This is a big win on slow networks!
if ($config{quick_delta_check}) {
for my $dbname (@dbs_source) {
my $d = $sync->{db}{$dbname};
$SQL = 'SELECT * FROM bucardo.bucardo_delta_check(?,?)';
$sth = $d->{dbh}->prepare($SQL);
$sth->execute($syncname, $d->{DBGROUPNAME});
$d->{deltazero} = $d->{deltatotal} = 0;
for my $row (@{$sth->fetchall_arrayref()}) {
my ($number,$tablename) = split /,/ => $row->[0], 2;
$d->{deltaquick}{$tablename} = $number;
if ($number) {
$d->{deltatotal}++;
$deltacount{table}{$tablename}++;
}
else {
$d->{deltazero}++;
}
}
$self->glog("Tables with deltas on $dbname: $d->{deltatotal} Without: $d->{deltazero}", LOG_VERBOSE);
} ## end quick delta check for each database
} ## end quick delta check
## Grab the delta information for each table from each source database
## While we could do this as per-db/per-goat instead of per-goat/per-db,
## we want to take advantage of the async requests as much as possible,
## and we'll get the best benefit by hitting each db in turn
for my $g (@$goatlist) {
## Again, this is only for tables
next if $g->{reltype} ne 'table';
## Populate the global vars
($S,$T) = ($g->{safeschema},$g->{safetable});
## This is the meat of Bucardo:
for my $dbname (@dbs_source) {
## If we had a truncation, we only get deltas from the "winning" source
## We still need these, as we want to respect changes made after the truncation!
next if exists $g->{truncatewinner} and $g->{truncatewinner} ne $dbname;
my $d = $sync->{db}{$dbname};
## No need to grab information if we know there are no deltas for this table
if ($config{quick_delta_check}) {
next if ! $d->{deltaquick}{"$S.$T"};
}
## Gets all relevant rows from bucardo_deltas: runs asynchronously
$d->{async_active} = time;
$sth{getdelta}{$dbname}{$g}->execute();
}
## Grab all results as they finish.
## Order does not really matter here, except for consistency in the logs
for my $dbname (@dbs_source) {
## Skip if truncating and this one is not the winner
next if exists $g->{truncatewinner} and $g->{truncatewinner} ne $dbname;
my $d = $sync->{db}{$dbname};
## If we skipped this, set the deltacount to zero and move on
if ($config{quick_delta_check}) {
if (! $d->{deltaquick}{"$S.$T"}) {
$deltacount{dbtable}{$dbname}{$S}{$T} = 0;
next;
}
}
## pg_result tells us to wait for the query to finish
$count = $d->{dbh}->pg_result();
$d->{async_active} = 0;
## Call finish() and change the ugly 0E0 to a true zero
$sth{getdelta}{$dbname}{$g}->finish() if $count =~ s/0E0/0/o;
## Store counts globally (per sync), per DB, per table, and per table/DB
$deltacount{all} += $count;
$deltacount{db}{$dbname} += $count;
$deltacount{table}{$S}{$T} += $count;
$deltacount{dbtable}{$dbname}{$S}{$T} = $count; ## NOT a +=
## Special versions for FK checks below
if ($count) {
$deltacount{tableoid}{$g->{oid}}{$dbname} = $count;
}
## For our pretty output below
$maxcount = $count if $count > $maxcount;
} ## end each database
} ## end each table (deltacount)
## Output the counts, now that we know the widths
for my $g (@$goatlist) {
## Only for tables
next if $g->{reltype} ne 'table';
## Populate the global vars
($S,$T) = ($g->{safeschema},$g->{safetable});
for my $dbname (@dbs_source) {
## Skip if truncating and this one is not the winner
next if exists $g->{truncatewinner} and $g->{truncatewinner} ne $dbname;
$self->glog((sprintf q{Delta count for %-*s : %*d},
$self->{maxdbstname},
"$dbname.$S.$T",
length $maxcount,
$deltacount{dbtable}{$dbname}{$S}{$T}),
$deltacount{dbtable}{$dbname}{$S}{$T} ? LOG_NORMAL : LOG_VERBOSE);
} ## end each db
} ## end each table
## Report on the total number of deltas found
$self->glog("Total delta count: $deltacount{all}", LOG_VERBOSE);
## Reset our list of possible FK issues
$sync->{fkcheck} = {};
## If more than one total source db, break it down at that level
## We also check for foreign key dependencies here
if (keys %{ $deltacount{db} } > 1) {
## Figure out the width for the per-db breakdown below
my $maxdbcount = 0;
for my $dbname (sort keys %{ $sync->{db} }) {
$maxdbcount = $deltacount{db}{$dbname}
if exists $deltacount{db}{$dbname}
and $deltacount{db}{$dbname} > $maxdbcount;
}
for my $dbname (@dbs_source) {
## Skip if truncating and deltacount is thus not set
next if ! exists $deltacount{db}{$dbname};
$self->glog((sprintf q{Delta count for %-*s: %*d},
$self->{maxdbname} + 2,
qq{"$dbname"},
length $maxdbcount,
$deltacount{db}{$dbname}), LOG_VERBOSE);
}
## Since we have changes appearing on more than one database,
## we need to see if any of the database-spanning tables involved
## are linked via foreign keys. If they are, we may have to
## change our replication strategy so that the foreign keys are
## still intact at the end of our operation.
## If we find tables that need to be checked, we add them to $self->{fkcheck}
## Walk through each table with changes
for my $toid (sort keys %{ $deltacount{tableoid} }) {
my $t1 = $deltacount{tableoid}{$toid};
my $tname1 = $sync->{tableoid}{$toid}{name};
## Find all tables that this table references
my $info = $sync->{tableoid}{$toid};
## Note that we really only need to check one of references or referencedby
REFFER: for my $reftable (sort keys %{ $info->{references} } ) {
## Skip if it has no changes
next if ! exists $deltacount{tableoid}{$reftable};
## At this point, we know that both linked tables have at
## least one source change. We also know that at least two
## source databases are involved in this sync.
my $t2 = $deltacount{tableoid}{$reftable};
my $tname2 = $sync->{tableoid}{$reftable}{name};
## The danger is if the changes come from different databases
## If this happens, the foreign key relationship may be violated
## when we push the changes both ways.
## Check if any of the dbs are mismatched. If so, instant FK marking
for my $db1 (sort keys %$t1) {
if (! exists $t2->{$db1}) {
$self->glog("Table $tname1 and $tname2 may have FK issues", LOG_DEBUG);
$sync->{fkcheck}{$tname1}{$tname2} = 1;
next REFFER;
}
}
## So both tables have changes on the same source databases.
## Now the only danger is if either has more than one source
if (keys %$t1 > 1 or keys %$t2 > 1) {
$self->glog("Table $tname1 and $tname2 may have FK issues", LOG_DEBUG);
$sync->{fkcheck}{$tname1}{$tname2} = 1;
$sync->{fkcheck}{$tname2}{$tname1} = 2;
}
} ## end each reffed table
} ## end each changed table
} ## end if more than one source database has changes
## If there were no changes on any sources, rollback all databases,
## update the syncrun and dbrun tables, notify listeners,
## then either re-loop or leave
if (! $deltacount{all} and ! $self->{has_truncation}) {
## If we modified the bucardo_sequences table, save the change
if ($deltacount{sequences}) {
#die "fixme";
#$sourcedbh->commit();
}
## Just to be safe, rollback everything
for my $dbname (@dbs_dbi) {
my $d = $sync->{db}{$dbname};
$d->{dbh}->rollback();
}
## Clear out the entries from the dbrun table
for my $dbname (@dbs_connectable) {
my $d = $sync->{db}{$dbname};
## We never do native fullcopy targets here
next if $d->{role} eq 'fullcopy';
$sth = $sth{dbrun_delete};
$sth->execute($syncname, $dbname);
$maindbh->commit();
}
## Clear the syncrun table
my $msg = "No delta rows found (KID $$)";
$self->end_syncrun($maindbh, 'empty', $syncname, $msg);
$maindbh->commit();
## Let the CTL know we are done
$self->db_notify($maindbh, "ctl_syncdone_${syncname}");
$maindbh->commit();
## Even with no changes, we like to know how long this took
my $synctime = sprintf '%.2f', tv_interval($kid_start_time);
$self->glog((sprintf 'Total time for sync "%s" (no rows): %s%s',
$syncname,
pretty_time($synctime),
$synctime < 120 ? '' : " ($synctime seconds)",),
LOG_DEBUG);
## Sleep a hair
sleep $config{kid_nodeltarows_sleep};
redo KID if $kidsalive;
last KID;
} ## end no deltas
## Only need to turn off triggers and rules once via pg_class
my $disabled_via_pg_class = 0;
## Reset all of our non-persistent conflict information
$self->{conflictinfo} = {};
## Custom conflict handler may have told us to always use the same winner
if (exists $self->{conflictinfo}{winneralways}) {
$self->{conflictinfo}{winners} = $self->{conflictinfo}{winneralways};
}
## Do each goat in turn
PUSHDELTA_GOAT: for my $g (@$goatlist) {
## No need to proceed unless we're a table
next if $g->{reltype} ne 'table';
## Skip if we've already handled this via fullcopy
next if $g->{source}{needstruncation};
($S,$T) = ($g->{safeschema},$g->{safetable});
## Skip this table if no source rows have changed
## However, we still need to go on in the case of a truncation
next if ! $deltacount{table}{$S}{$T} and ! exists $g->{truncatewinner};
## How many times this goat has handled an exception?
$g->{exceptions} ||= 0;
## The list of primary key columns
if (! $g->{pkeycols}) { ## only do this once
$g->{pkeycols} = '';
$i=0;
for my $qpk (@{$g->{qpkey}}) {
$g->{pkeycols} .= sprintf '%s,', $g->{binarypkey}{$i} ? qq{ENCODE($qpk,'base64')} : $qpk;
$i++;
}
chop $g->{pkeycols};
$g->{numpkcols} > 1 and $g->{pkeycols} = "($g->{pkeycols})";
## Example: id
## Example MCPK: (id,"space bar",cdate)
## Store a raw version for some non-Postgres targets
$g->{pkeycolsraw} = join ',' => @{ $g->{pkey} };
}
## How many times have we done the loop below?
my $delta_attempts = 0;
## For each source database, grab all distinct pks for this table
## from bucardo_delta (that have not already been pushed to the targetname)
## We've already executed and got a count from these queries:
## it's now time to gather the actual data
my %deltabin;
## Customcode may need to know which rows we have changed: reset it here
$sync->{deltarows} = {};
for my $dbname (@dbs_source) {
## Skip if we are truncating and this is not the winner
next if exists $g->{truncatewinner} and $g->{truncatewinner} ne $dbname;
## If this is a truncation, we always want the deltabin to exist, even if empty!
if (exists $g->{truncatewinner}) {
$deltabin{$dbname} = {};
}
## Skip if we know we have no rows - and thus have issued a finish()
next if ! $deltacount{dbtable}{$dbname}{$S}{$T};
## Create an empty hash to hold the primary key information
$deltabin{$dbname} = {};
while (my $y = $sth{getdelta}{$dbname}{$g}->fetchrow_arrayref()) {
## Join all primary keys together with \0, put into hash as key
## XXX: Using \0 is not unique for binaries
if (!$g->{hasbinarypk}) {
$deltabin{$dbname}{join "\0" => @$y} = 1;
}
else {
my $decodename = '';
my @pk;
for my $row (@$y) {
push @pk => $row;
}
$deltabin{$dbname}{join "\0" => @pk} = 1;
}
}
} ## end getting pks from each db for this table
## Walk through and make sure we have only one source for each primary key
## Simple map of what we've already compared:
my %seenpair;
## Hash indicating which databases have conflicts:
$self->{db_hasconflict} = {};
## Hash of all conflicts for this goat
## Key is the primary key value
## Value is a list of all databases containing this value
my %conflict;
for my $dbname1 (sort keys %deltabin) {
for my $dbname2 (sort keys %deltabin) {
## Don't compare with ourselves
next if $dbname1 eq $dbname2;
## Skip if we've already handled this pair the reverse way
next if exists $seenpair{$dbname2}{$dbname1};
$seenpair{$dbname1}{$dbname2} = 1;
## Loop through all rows from database 1 and see if they exist on 2
## If they do, it's a conflict, and one of them must win
## Store in the conflict hash for processing below
for my $key (keys %{ $deltabin{$dbname1} }) {
next if ! exists $deltabin{$dbname2}{$key};
## Got a conflict! Same pkey updated on both sides
$conflict{$key}{$dbname1} = 1;
$conflict{$key}{$dbname2} = 1;
## Build a list of which databases have conflicts
$self->{db_hasconflict}{$dbname1} = 1;
$self->{db_hasconflict}{$dbname2} = 1;
}
}
}
## If we had any conflicts, handle them now
$count = keys %conflict;
if ($count) {
## Increment count across all tables
$dmlcount{conflicts} += $count;
$self->glog("Conflicts for $S.$T: $count", LOG_NORMAL);
## If we have a custom conflict handler for this goat, invoke it
if ($g->{code_conflict}) {
## We can safely skip this if we already have the winners list in some format
if (exists $self->{conflictinfo}{tablewinner_always}{$g}) {
$self->glog('Using previous tablewinner_always winner', LOG_DEBUG);
}
elsif (exists $self->{conflictinfo}{syncwinner}) {
$self->glog('Using previous syncwinner winner', LOG_DEBUG);
}
elsif (exists $self->{conflictinfo}{syncwinner_always}) {
$self->glog('Using previous syncwinner_always winner', LOG_DEBUG);
}
else {
$self->glog('Starting code_conflict', LOG_VERBOSE);
## Give each piece of code a chance to resolve the conflict
for my $code (@{ $g->{code_conflict} }) {
## The all important conflict hash, which the caller may change
$code->{info}{conflicts} = \%conflict;
## Provide the current schema and table name
$code->{info}{schemaname} = $S;
$code->{info}{tablename} = $T;
## Provide detailed information on all databases, but elide the dbh
for my $dbname (@dbs_connectable) {
my $d = $sync->{db}{$dbname};
## Make a shallow copy, excluding the actual dbh handle
for my $name (keys %$d) {
## We provide DBIx::Safe versions elsewhere
next if $name eq 'dbh';
$code->{info}{dbinfo}{$dbname}{$name} = $d->{$name};
}
}
my $cname = $code->{name};
## Run the conflict handler customcode, get the result
my $result = $self->run_kid_custom_code($sync, $code);
$self->glog("Result of custom code $cname is $result", LOG_DEBUG);
## Code has asked us to do nothing
next if 'skip' eq $result;
## How to handle conflicts for this table right now only:
if ($result =~ /tablewinner: (.+)/o) {
my $winlist = $1;
$self->glog("Custom code $cname says table winners should be: $winlist", LOG_VERBOSE);
$self->{conflictinfo}{tablewinner}{$g} = $winlist;
last;
}
## How to handle conflicts for this table until the sync restarts:
if ($result =~ /tablewinner_always: (.+)/o) {
my $winlist = $1;
$self->glog("Custom code $cname says table winners should always be: $winlist", LOG_VERBOSE);
$self->{conflictinfo}{tablewinner_always}{$g} = $winlist;
last;
}
## How to handle conflicts for all tables in this sync:
if ($result =~ /syncwinner: (.+)/o) {
my $winlist = $1;
$self->glog("Custom code $cname says all table winners should be: $winlist", LOG_VERBOSE);
$self->{conflictinfo}{syncwinner} = $winlist;
last;
}
## How to handle conflicts for all tables in this sync, until the sync restarts:
if ($result =~ /syncwinner_always: (.+)/o) {
my $winlist = $1;
$self->glog("Custom code $cname says all table winners should always be: $winlist", LOG_VERBOSE);
$self->{conflictinfo}{syncwinner_always} = $winlist;
last;
}
## We assume that some or all keys in %conflict have been changed,
## from a hashref to a scalar.
## We don't do checks here, as it will get caught down below.
## If info->{lastcode} has been set, we don't call any other codes
last if $result eq 'last';
} ## end each code_conflict
}
}
## If conflict_strategy is abort, simply die right away
elsif ('bucardo_abort' eq $g->{conflict_strategy}) {
$self->pause_and_exit(qq{Aborting sync due to conflict of $S.$T});
}
## If we require a custom code, also die
elsif ('bucardo_custom' eq $g->{conflict_strategy}) {
$self->pause_and_exit(qq{Aborting sync due to lack of custom conflict handler for $S.$T});
}
elsif ($g->{conflict_strategy} =~ /^bucardo_latest/o) {
## For bucardo_latest*, we want to check the transaction times across
## all databases in this sync that may conflict - in other words,
## source databases that have deltas. We then sort that list and set it
## as the list of preferred databases
## There are two variants:
## bucardo_latest: check this table only
## bucardo_latest_all_tables: check all tables in the sync
## These get internally mapped to tablewinner and syncwinner respectively
$self->glog(qq{Starting conflict strategy $g->{conflict_strategy}}, LOG_VERBOSE);
## If we are doing all tables, we only run it once, then save the information
if (exists $self->{conflictinfo}{syncwinner}) {
$self->glog("Using previous conflict winner $self->{conflictinfo}{syncwinner}", LOG_DEBUG);
}
else {
my $maxsql = 'SELECT COALESCE(extract(epoch FROM MAX(txntime)),0) FROM';
## Find the maximum txntime across all databases for this table
if ($g->{conflict_strategy} eq 'bucardo_latest') {
$SQL = "$maxsql bucardo.$g->{deltatable}";
}
## Same, but also across all tables in the sync
elsif ($g->{conflict_strategy} eq 'bucardo_latest_all_tables') {
$SQL = join " UNION\n" =>
map { "$maxsql bucardo.$_->{deltatable}" }
grep { $_->{reltype} eq 'table'}
@$goatlist;
}
else {
## Sanity check in case something got misspelled
$self->pause_and_exit(qq{Unknown conflict_strategy $g->{conflict_strategy}!});
}
$SQL .= ' ORDER BY 1 DESC LIMIT 1';
## Check every database that generates deltas
for my $dbname (@dbs_delta) {
my $d = $sync->{db}{$dbname};
$d->{sth} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC});
$d->{async_active} = time;
$d->{sth}->execute();
}
for my $dbname (@dbs_delta) {
my $d = $sync->{db}{$dbname};
$d->{dbh}->pg_result();
$d->{async_active} = 0;
$d->{lastmod} = $d->{sth}->fetchall_arrayref()->[0][0] || 0;
}
## Now we can put them in rank order
## The last modification time is the main key
## In the unlikely chance of a tie, we go by alphabetical database name
my $winner =
join ' ' =>
map { $_->[0] }
sort { $b->[1] <=> $a->[1] or $a->[0] cmp $b->[0] }
map { [$_, $sync->{db}{$_}{lastmod} ] }
@dbs_delta;
$self->glog("Set conflict winners to: $winner", LOG_VERBOSE);
## Store it away
$self->{conflictinfo}{tablewinner}{$g} = $winner;
if ($g->{conflict_strategy} eq 'bucardo_latest_all_tables') {
$self->{conflictinfo}{syncwinner} = $winner;
}
}
} ## end of bucardo_latest*
else {
## Not a built-in, so assume a list of databases:
$self->{conflictinfo}{winners} = $g->{conflict_strategy};
}
## At this point, we should have enough information to solve the conflict
## Either conflictinfo{winners} will have a list of databases,
## or we will have a per-table or per-sync list
if (! exists $self->{conflictinfo}{winners}) {
if (exists $self->{conflictinfo}{tablewinner}{$g}) {
$self->{conflictinfo}{winners} = $self->{conflictinfo}{tablewinner}{$g};
}
if (exists $self->{conflictinfo}{tablewinner_always}{$g}) {
$self->{conflictinfo}{winners} = $self->{conflictinfo}{tablewinner_always}{$g};
}
if (exists $self->{conflictinfo}{syncwinner}) {
$self->{conflictinfo}{winners} = $self->{conflictinfo}{syncwinner};
}
if (exists $self->{conflictinfo}{syncwinner_alwyas}) {
$self->{conflictinfo}{winners} = $self->{conflictinfo}{syncwinner_always};
}
}
if (exists $self->{conflictinfo}{winners}) {
## We walk through all of the conflicting rows, and set the winner as the
## database highest in the supplied list
my $sc = $self->{conflictinfo}{winners}
or $self->pause_and_exit(q{Invalid conflict winners list given});
if (index($sc, ' ') < 1) {
## Sanity check
if (! exists $deltacount{$sc}) {
$self->pause_and_exit(qq{Invalid conflict strategy '$sc' used for $S.$T: no such database});
}
for my $pkval (keys %conflict) {
## May have already been set by customcode, so only change if a ref
$conflict{$pkval} = $sc if ref $conflict{$pkval};
}
}
else {
## Have more than one, so figure out the best one to use
my @mdbs = split / +/ => $sc;
## Make sure they all exist
for my $dbname (@mdbs) {
if (! exists $deltacount{$dbname}) {
$self->pause_and_exit(qq{Invalid conflict strategy '$sc' used for $S.$T: no such database '$dbname'});;
}
}
## Fill in each conflict with first found database
for my $pkval (keys %conflict) {
## As above, we only change if currently a ref
next if ! ref $conflict{$pkval};
$conflict{$pkval} = first { exists $conflict{$pkval}{$_} } split ' ' => $sc;
}
}
}
## Delete our old conflict resolution information so we don't use it again
delete $self->{conflictinfo}{winners};
## At this point, the conflict hash should consist of keys with
## the winning database as the value
## Walk through and apply to the %deltabin hash
for my $pkey (keys %conflict) {
## Delete everyone for this primary key
for my $dbname (keys %deltabin) {
delete $deltabin{$dbname}{$pkey};
}
## Add (or re-add) the winning one
## We do it this way as we cannot be sure that the combo existed.
## It could be the case that the winning database made
## no changes to this table!
$deltabin{ $conflict{$pkey} }{$pkey} = 1;
}
$self->glog('Conflicts have been resolved', LOG_NORMAL);
} ## end if have conflicts
## Create filehandles for any flatfile databases
for my $dbname (keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
next if $d->{dbtype} !~ /flat/o;
## Figure out and set the filename
my $date = strftime('%Y%m%d_%H%M%S', localtime());
$d->{filename} = "$config{flatfile_dir}/bucardo.flatfile.$self->{syncname}.$date.sql";
## Does this already exist? It's possible we got so quick the old one exists
## Since we want the names to be unique, come up with a new name
if (-e $d->{filename}) {
my $tmpfile;
my $extension = 1;
{
$tmpfile = "$d->{filename}.$extension";
last if -e $tmpfile;
$extension++;
redo;
}
$d->{filename} = $tmpfile;
}
$d->{filename} .= '.tmp';
open $d->{filehandle}, '>>', $d->{filename}
or die qq{Could not open flatfile "$d->{filename}": $!\n};
}
## Populate the semaphore table if the setting is non-empty
if ($config{semaphore_table}) {
my $tname = $config{semaphore_table};
for my $dbname (@dbs_connectable) {
my $d = $sync->{db}{$dbname};
if ($d->{dbtype} eq 'mongo') {
my $collection = $d->{dbh}->get_collection($tname);
my $object = {
sync => $syncname,
status => 'started',
starttime => scalar gmtime,
};
$collection->update
(
{sync => $syncname},
$object,
{ upsert => 1, safe => 1 }
);
}
}
}
## At this point, %deltabin should contain a single copy of each primary key
## It may even be empty if we are truncating
## We need to figure out how many sources we have for some later optimizations
my $numsources = keys %deltabin;
## Figure out which databases are getting written to
## If there is only one source, then it will *not* get written to
## If there is more than one source, then everyone gets written to!
for my $dbname (keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
## Again: everyone is written to unless there is a single source
## A truncation source may have an empty deltabin, but it will exist
$d->{writtento} = (1==$numsources and exists $deltabin{$dbname}) ? 0 : 1;
next if ! $d->{writtento};
## Should we use the stage table for this database?
$d->{trackstage} = ($numsources > 1 and exists $deltabin{$dbname}) ? 1 : 0;
## Disable triggers as needed
$self->disable_triggers($sync, $d);
## Disable indexes as needed (will be rebuilt after data is copied)
$self->disable_indexes($sync, $d, $g);
} ## end setting up each database
## This is where we want to 'rewind' to on a handled exception
PUSH_SAVEPOINT: {
$delta_attempts++;
## From here on out, we're making changes that may trigger an exception
## Thus, if we have exception handling code, we create savepoints to rollback to
if ($g->{has_exception_code}) {
for my $dbname (keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
## No need to rollback if we didn't make any changes
next if ! $d->{writtento};
$self->glog(qq{Creating savepoint on database "$dbname" for exception handler(s)}, LOG_DEBUG);
$d->{dbh}->do("SAVEPOINT bucardo_$$")
or die qq{Savepoint creation failed for bucardo_$$};
}
}
## This var gets set to true at the end of the eval
## Safety check as $@ alone is not enough
my $evaldone = 0;
## This label is solely to localize the DIE signal handler
LOCALDIE: {
$sth{kid_syncrun_update_status}->execute("Sync $S.$T (KID $$)", $syncname);
$maindbh->commit();
## Everything before this point should work, so we delay the eval until right before
## our first actual data change on a target
eval {
## Walk through each database in %deltabin, and push its contents
## to all other databases for this sync
for my $dbname1 (sort keys %deltabin) {
## If we are doing a truncate, delete everything from all other dbs!
if (exists $g->{truncatewinner}) {
for my $dbnamet (@dbs) {
## Exclude ourselves, which should be the only thing in deltabin!
next if $dbname1 eq $dbnamet;
## Set the real target name
$g->{tablename} = $g->{newname}{$syncname}{$dbnamet};
my $d = $sync->{db}{$dbnamet};
my $do_cascade = 0;
$self->truncate_table($d, $g, $do_cascade);
## Do not keep this around, as it is sync and db specific!
delete $g->{tablename};
}
## We keep going, in case the source has post-truncation items
}
## How many rows are we pushing around? If none, we done!
my $rows = keys %{ $deltabin{$dbname1} };
$self->glog("Rows to push from $dbname1.$S.$T: $rows", LOG_VERBOSE);
## This also exits us if we are a truncate with no source rows
next if ! $rows;
## Build the list of target databases we are pushing to
my @pushdbs;
for my $dbname2 (@dbs_non_fullcopy) {
## Don't push to ourselves!
next if $dbname1 eq $dbname2;
## No %seenpair is needed: this time we *do* go both ways (A->B, then B->A)
push @pushdbs => $sync->{db}{$dbname2};
}
my $sourcedb = $sync->{db}{$dbname1};
## Here's the real action: delete/truncate from target, then copy from source to target
## For this table, delete all rows that may exist on the target(s)
$dmlcount{deletes} += $self->delete_rows(
$deltabin{$dbname1}, $S, $T, $g, $sync, \@pushdbs);
## For this table, copy all rows from source to target(s)
$dmlcount{inserts} += $self->push_rows(
$deltabin{$dbname1}, $g, $sync, $sourcedb, \@pushdbs);
## Store references to the list of changes in case custom code needs them
$sync->{deltarows}{$S}{$T} = $deltabin{$dbname1};
} ## end copying data from each source database
## Enable indexes and run REINDEX as needed
$self->enable_indexes($sync, $g);
## We set this as we cannot rely on $@ alone
$evaldone = 1;
}; ## end of eval
} ## end of LOCALDIE
## Got exception handlers, but no exceptions, so reset the count:
if ($evaldone) {
$g->{exceptions} = 0;
}
## Did we fail the eval?
else {
chomp $@;
(my $err = $@) =~ s/\n/\\n/g;
## If we have no exception code, we simply die to pass control to $err_handler.
## XXX If no handler, we want to rewind and try again ourselves
## XXX But this time, we want to enter a more aggressive conflict resolution mode
## XXX Specifically, we need to ensure that a single database "wins" and that
## XXX all table changes therein come from that database.
## XXX No need if we only have a single table, of course, or if there were
## XXX no possible conflicting changes.
## XXX Finally, we skip if the first run already had a canonical winner
if (!$g->{has_exception_code}) {
$self->glog("Warning! Aborting due to exception for $S.$T:$pkval Error was $err",
$err =~ /serialize|deadlock/ ? LOG_VERBOSE : LOG_WARN);
## If this was a serialization error, we will not need to use pg_cancel
if ($err =~ /serialize/) {
$g->{aync_active} = 0;
}
die "$err\n";
}
## We have an exception handler
$self->glog("Exception caught: $err", LOG_WARN);
## Bail if we've already tried to handle this goat via an exception
if ($g->{exceptions}++ > 1) {
## XXX Does this get properly reset on a redo?
$self->glog("Warning! Exception custom code did not work for $S.$T:$pkval", LOG_WARN);
die qq{Error: too many exceptions to handle for $S.$T:$pkval};
}
## Time to let the exception handling custom code do its work
## First, we rollback to our savepoint on all databases that are using them
for my $dbname (keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
next if ! $d->{writtento};
## Just in case, clear out any existing async queries
if ($d->{async_active}) {
$d->{dbh}->pg_cancel();
$d->{async_active} = 0;
}
$self->glog("Rolling back to savepoint on database $dbname", LOG_DEBUG);
$d->{dbh}->do("ROLLBACK TO SAVEPOINT bucardo_$$");
}
## Prepare information to pass to the handler about this run
my $codeinfo = {
version => $VERSION,
schemaname => $S,
tablename => $T,
error_string => $err,
deltabin => \%deltabin,
attempts => $delta_attempts,
};
## Set if any handlers think we should try again
my $runagain = 0;
for my $code (@{$g->{code_exception}}) {
$self->glog("Trying exception code $code->{id}: $code->{name}", LOG_TERSE);
## Pass in the information above about the current state
$code->{info} = $codeinfo;
my $result = $self->run_kid_custom_code($sync, $code);
## A request to run the same goat again.
if ('retry' eq $result) {
$self->glog('Exception handler thinks we can try again', LOG_NORMAL);
$runagain = 1;
last;
}
## Request to skip any other codes
last if $result eq 'last';
$self->glog('Going to next available exception code', LOG_VERBOSE);
next;
}
## If not running again, we simply give up and throw an exception to the kid
if (!$runagain) {
$self->glog('No exception handlers were able to help, so we are bailing out', LOG_WARN);
die qq{No exception handlers were able to help, so we are bailing out\n};
}
## The custom code wants to try again
## XXX Should probably reset session_replication_role
## Make sure the Postgres database connections are still clean
for my $dbname (@dbs_postgres) {
my $ping = $sync->{db}{$dbname}{dbh}->ping();
if ($ping !~ /^[123]$/o) {
$self->glog("Warning! Ping on database $dbname after exception handler was $ping", LOG_WARN);
}
}
## Now jump back and try this goat again!
redo PUSH_SAVEPOINT;
} ## end of handled exception
} ## end of PUSH_SAVEPOINT
} ## end each goat
$self->glog("Totals: deletes=$dmlcount{deletes} inserts=$dmlcount{inserts} conflicts=$dmlcount{conflicts}",
($dmlcount{deletes} or $dmlcount{inserts} or $dmlcount{conflicts}) ? LOG_NORMAL : LOG_VERBOSE);
## Update bucardo_track table so that the bucardo_delta rows we just processed
## are marked as "done" and ignored by subsequent runs
## Reset our pretty-printer count
$maxcount = 0;
for my $g (@$goatlist) {
next if $g->{reltype} ne 'table';
($S,$T) = ($g->{safeschema},$g->{safetable});
delete $g->{rateinfo};
## Gather up our rate information - just store for now, we can write it after the commits
## XX Redo with sourcename etc.
## Skip as {deltarate} is not even defined!
if (0) {
if ($deltacount{source}{$S}{$T} and $sync->{track_rates}) {
$self->glog('Gathering source rate information', LOG_VERBOSE);
my $sth = $sth{source}{$g}{deltarate};
$count = $sth->execute();
$g->{rateinfo}{source} = $sth->fetchall_arrayref();
}
for my $dbname (@dbs_source) {
if ($deltacount{dbtable}{$dbname}{$S}{$T} and $sync->{track_rates}) {
$self->glog('Gathering target rate information', LOG_VERBOSE);
my $sth = $sth{target}{$g}{deltarate};
$count = $sth->execute();
$g->{rateinfo}{target} = $sth->fetchall_arrayref();
}
}
}
## For each database that had delta changes, insert rows to bucardo_track
for my $dbname (@dbs_source) {
my $d = $sync->{db}{$dbname};
$d->{needs_track} = 0;
if ($deltacount{dbtable}{$dbname}{$S}{$T}) {
$d->{needs_track} = 1;
## Kick off the track or stage update asynchronously
if ($d->{trackstage}) {
## The stage table can only have rows if a previous version failed
## This can happen if this kid committed, but another failed
## Thus, we always want to make sure the stage table is empty:
$SQL = "DELETE FROM bucardo.$g->{stagetable}";
$d->{dbh}->do($SQL);
$sth{stage}{$dbname}{$g}->execute();
}
else {
$sth{track}{$dbname}{$g}->execute();
}
$d->{async_active} = time;
}
}
## Loop through again and let everyone finish
for my $dbname (@dbs_source) {
my $d = $sync->{db}{$dbname};
if ($d->{needs_track}) {
($count = $d->{dbh}->pg_result()) =~ s/0E0/0/o;
$d->{async_active} = 0;
$self->{insertcount}{dbname}{$S}{$T} = $count;
$maxcount = $count if $count > $maxcount;
}
}
} ## end each goat
## Get sizing for the next printout
my $maxsize = 10;
my $maxcount2 = 1;
for my $g (@$goatlist) {
next if $g->{reltype} ne 'table';
($S,$T) = ($g->{safeschema},$g->{safetable});
for my $dbname (keys %{ $sync->{db} }) {
next if ! $deltacount{dbtable}{$dbname}{$S}{$T};
$maxsize = length " $dbname.$S.$T" if length " $dbname.$S.$T" > $maxsize;
$maxcount2 = length $count if length $count > $maxcount2;
}
}
## Pretty print the number of rows per db/table
for my $g (@$goatlist) {
next if $g->{reltype} ne 'table';
($S,$T) = ($g->{safeschema},$g->{safetable});
for my $dbname (keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
if ($deltacount{dbtable}{$dbname}{$S}{$T}) {
$count = $self->{insertcount}{dbname}{$S}{$T};
$self->glog((sprintf 'Rows inserted to bucardo_%s for %-*s: %*d',
$d->{trackstage} ? 'stage' : 'track',
$maxsize,
"$dbname.$S.$T",
length $maxcount2,
$count),
LOG_DEBUG);
}
} ## end each db
} ## end each table
} ## end if dbs_delta
## Handle all the fullcopy targets
if (@dbs_fullcopy) {
## We only need one of the sources, so pull out the first one
## (dbs_source should only have a single entry anyway)
my ($sourcename, $sourcedbh, $sourcex);
for my $dbname (@dbs_source) {
my $d = $sync->{db}{$dbname};
$sourcename = $dbname;
$sourcedbh = $d->{dbh};
$sourcex = $d;
$self->glog(qq{For fullcopy, we are using source database "$sourcename"}, LOG_VERBOSE);
last;
}
## Temporary hash to store onetimecopy information
$sync->{otc} = {};
## Walk through and handle each goat
GOAT: for my $g (@$goatlist) {
($S,$T) = ($g->{safeschema},$g->{safetable});
## Handle sequences first
## We always do these, regardless of onetimecopy
if ($g->{reltype} eq 'sequence') {
$SQL = "SELECT * FROM $S.$T";
$sth = $sourcedbh->prepare($SQL);
$sth->execute();
$g->{sequenceinfo}{$sourcename} = $sth->fetchall_arrayref({})->[0];
$g->{winning_db} = $sourcename;
## We want to modify all fullcopy targets only
for my $dbname (@dbs_fullcopy) {
$sync->{db}{$dbname}{adjustsequence} = 1;
}
$self->adjust_sequence($g, $sync, $S, $T, $syncname);
next;
}
## Some tables exists just to be examined but not pushed to
if ($g->{ghost}) {
$self->glog("Skipping ghost table $S.$T", LOG_VERBOSE);
next;
}
## If doing a one-time-copy and using empty mode, skip this table if it has rows
## This is done on a per table / per target basis
if (2 == $sync->{onetimecopy}) {
## Also make sure we have at least one row on the source
my $tname = $g->{newname}{$syncname}{$sourcename};
if (! $self->table_has_rows($sourcex, $tname)) {
$self->glog(qq{Source table "$sourcename.$S.$T" has no rows and we are in onetimecopy if empty mode, so we will not COPY}, LOG_NORMAL);
## No sense in going any further
next GOAT;
}
## Check each fullcopy target to see if it is empty and thus ready to COPY
my $have_targets = 0;
for my $dbname (@dbs_fullcopy) {
my $d = $sync->{db}{$dbname};
my $targetname = $g->{newname}{$syncname}{$dbname};
## If this target table has rows, skip it
if ($self->table_has_rows($d, $targetname)) {
$sync->{otc}{skip}{$dbname} = 1;
$self->glog(qq{Target table "$dbname.$targetname" has rows and we are in onetimecopy if empty mode, so we will not COPY}, LOG_NORMAL);
}
else {
$have_targets = 1;
}
}
## If we have no valid targets at all, skip this goat
next GOAT if ! $have_targets;
} ## end onetimecopy of 2
## The list of targets we will be fullcopying to
## This is a subset of dbs_fullcopy, and may be less due
## to the target having rows and onetimecopy being set
my @dbs_copytarget;
for my $dbname (@dbs_fullcopy) {
## Skip if onetimecopy was two and this target had rows
next if exists $sync->{otc}{skip}{$dbname};
push @dbs_copytarget => $dbname;
}
## Truncate the table on all target databases, and fallback to delete if that fails
for my $dbname (@dbs_copytarget) {
my $d = $sync->{db}{$dbname};
## Nothing to do here for flatfiles
next if $d->{dbtype} =~ /flat/;
## Disable triggers as needed
$self->disable_triggers($sync, $d);
## Disable indexes as needed
$self->disable_indexes($sync, $d, $g);
$self->glog(qq{Emptying out $dbname.$S.$T using $sync->{deletemethod}}, LOG_VERBOSE);
my $use_delete = 1;
## By hook or by crook, empty this table
my $tname = $g->{tablename} = $g->{newname}{$syncname}{$dbname};
if ($sync->{deletemethod} =~ /truncate/io) {
my $do_cascade = $sync->{deletemethod} =~ /cascade/io ? 1 : 0;
if ($self->truncate_table($d, $g, $do_cascade)) {
$self->glog("Truncated table $tname", LOG_VERBOSE);
$use_delete = 0;
}
else {
$self->glog("Truncation of table $tname failed, so we will try a delete", LOG_VERBOSE);
}
}
if ($use_delete) {
## This may take a while, so we update syncrun
$sth{kid_syncrun_update_status}->execute("DELETE $tname (KID $$)", $syncname);
$maindbh->commit();
## Note: even though $tname is the actual name, we still track stats with $S.$T
$dmlcount{D}{target}{$S}{$T} = $self->delete_table($d, $g);
$dmlcount{alldeletes}{target} += $dmlcount{D}{target}{$S}{$T};
$self->glog("Rows deleted from $tname: $dmlcount{D}{target}{$S}{$T}", LOG_VERBOSE);
}
## This needs to not stick around
delete $g->{tablename};
} ## end each database to be truncated/deleted
## For this table, copy all rows from source to target(s)
$dmlcount{inserts} += $dmlcount{I}{target}{$S}{$T} = $self->push_rows(
'fullcopy', $g, $sync, $sourcex,
## We need an array of database objects here:
[ map { $sync->{db}{$_} } @dbs_copytarget ]);
## Add to our cross-table tally
$dmlcount{allinserts}{target} += $dmlcount{I}{target}{$S}{$T};
## Restore the indexes and run REINDEX where needed
$self->enable_indexes($sync, $g);
## TODO: logic to clean out delta rows is this was a onetimecopy
} ## end each goat
if ($sync->{deletemethod} ne 'truncate') {
$self->glog("Total target rows deleted: $dmlcount{alldeletes}{target}", LOG_NORMAL);
}
$self->glog("Total target rows copied: $dmlcount{allinserts}{target}", LOG_NORMAL);
} ## end have some fullcopy targets
## Close filehandles for any flatfile databases
for my $dbname (keys %{ $sync->{db} }) {
my $d = $sync->{db}{$dbname};
next if $d->{dbtype} !~ /flat/o;
close $d->{filehandle}
or warn qq{Could not close flatfile "$d->{filename}": $!\n};
## Atomically rename it so other processes can pick it up
(my $newname = $d->{filename}) =~ s/\.tmp$//;
rename $d->{filename}, $newname;
## Remove the old ones, just in case
delete $d->{filename};
delete $d->{filehandle};
}
## If using semaphore tables, mark the status as 'complete'
if ($config{semaphore_table}) {
my $tname = $config{semaphore_table};
for my $dbname (@dbs_connectable) {
my $d = $sync->{db}{$dbname};
if ($d->{dbtype} eq 'mongo') {
my $collection = $d->{dbh}->get_collection($tname);
my $object = {
sync => $syncname,
status => 'complete',
endtime => scalar gmtime,
};
$collection->update
(
{sync => $syncname},
$object,
{ upsert => 1, safe => 1 }
);
}
}
}
## If doing truncate, do some cleanup
if (exists $self->{truncateinfo}) {
## For each source database that had a truncate entry, mark them all as done
$SQL = 'UPDATE bucardo.bucardo_truncate_trigger SET replicated = now() WHERE sync = ? AND replicated IS NULL';
for my $dbname (@dbs_source) {
my $d = $sync->{db}{$dbname};
$d->{sth} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC});
$d->{sth}->execute($syncname);
$d->{async_active} = time;
}
for my $dbname (@dbs_source) {
my $d = $sync->{db}{$dbname};
$d->{dbh}->pg_result();
$d->{async_active} = 0;
}
}
## Run all 'before_trigger_enable' code
if (exists $sync->{code_before_trigger_enable}) {
$sth{kid_syncrun_update_status}->execute("Code before_trigger_enable (KID $$)", $syncname);
$maindbh->commit();
for my $code (@{$sync->{code_before_trigger_enable}}) {
last if 'last' eq $self->run_kid_custom_code($sync, $code);
}
}
## Turn triggers and rules back on as needed
$self->enable_triggers($sync);
## Bring the db back to normal
for my $dbname (@dbs_write) {
my $d = $sync->{db}{$dbname};
next if ! $d->{writtento};
if ($d->{dbtype} eq 'mysql' or $d->{dbtype} eq 'mariadb') {
$self->glog(qq{Turning foreign key checks back on for $dbname}, LOG_VERBOSE);
$d->{dbh}->do('SET foreign_key_checks = 1');
}
}
if ($self->{dryrun}) {
$self->glog('Dryrun, rolling back...', LOG_TERSE);
for my $dbname (@dbs_dbi) {
$sync->{db}{$dbname}{dbh}->rollback();
}
for my $dbname (@dbs_redis) {
## Implement DISCARD when the client supports it
##$sync->{db}{$dbname}{dbh}->discard();
}
$maindbh->rollback();
}
else {
$self->glog(q{Issuing final commit for all databases}, LOG_VERBOSE);
## This is a tricky bit: all writeable databases *must* go first
## If we only have a single source, this ensures we don't mark rows as done
## in the track tables before everyone has reported back
for my $dbname (@dbs_dbi) {
my $d = $sync->{db}{$dbname};
next if ! $d->{writtento};
$d->{dbh}->commit();
}
## Now we can commit anyone else
for my $dbname (@dbs_dbi) {
my $d = $sync->{db}{$dbname};
next if $d->{writtento};
$d->{dbh}->commit();
}
for my $dbname (@dbs_redis) {
## Implement EXEC when the client supports it
## $sync->{db}{$dbname}{dbh}->exec();
}
$self->glog(q{All databases committed}, LOG_VERBOSE);
}
## If we used a staging table for the tracking info, do the final inserts now
## This is the safest way to ensure we never miss any changes
for my $dbname (@dbs_dbi) {
my $d = $sync->{db}{$dbname};
next if ! $d->{trackstage};
my $dbh = $d->{dbh};
for my $g (@$goatlist) {
next if $g->{reltype} ne 'table';
next if ! $deltacount{dbtable}{$dbname}{$g->{safeschema}}{$g->{safetable}};
$SQL = "INSERT INTO bucardo.$g->{tracktable} SELECT * FROM bucardo.$g->{stagetable}";
$dbh->do($SQL);
$SQL = "DELETE FROM bucardo.$g->{stagetable}";
$dbh->do($SQL);
$self->glog("Populated $dbname.$g->{tracktable}", LOG_DEBUG);
}
$dbh->commit();
}
## Capture the current time. now() is good enough as we just committed or rolled back
## XXX used for track below
#my $source_commit_time = $sourcedbh->selectall_arrayref('SELECT now()')->[0][0];
#my $target_commit_time = $targetdbh->selectall_arrayref('SELECT now()')->[0][0];
#$sourcedbh->commit();
#$targetdbh->commit();
#my ($source_commit_time, $target_commit_time);
## Update the syncrun table, including the delete and insert counts
my $reason = "Finished (KID $$)";
my $details = '';
$count = $sth{kid_syncrun_end}->execute(
$dmlcount{deletes}, $dmlcount{inserts}, $dmlcount{truncates}, $dmlcount{conflicts},
$details, $reason, $syncname);
## Change this row to the latest good or empty
my $action = ($dmlcount{deletes} or $dmlcount{inserts} or $dmlcount{truncates})
? 'good' : 'empty';
$self->end_syncrun($maindbh, $action, $syncname, "Complete (KID $$)");
$maindbh->commit();
## Just in case, report on failure to update
if ($count != 1) {
$self->glog("Unable to correctly update syncrun table! (count was $count)", LOG_TERSE);
}
## Put a note in the logs for how long this took
my $synctime = sprintf '%.2f', tv_interval($kid_start_time);
$self->glog((sprintf 'Total time for sync "%s" (%s %s, %s %s): %s%s',
$syncname,
$dmlcount{inserts},
(1==$dmlcount{inserts} ? 'row' : 'rows'),
scalar keys %{$deltacount{table}},
(1== keys %{$deltacount{table}} ? 'table' : 'tables'),
pretty_time($synctime),
$synctime < 120 ? '' : " ($synctime seconds)",),
## We don't want to output a "finished" if no changes made unless verbose
$dmlcount{allinserts}{target} ? LOG_NORMAL : LOG_VERBOSE);
## Update our rate information as needed
if (0 and $sync->{track_rates}) {
$SQL = 'INSERT INTO bucardo_rate(sync,goat,target,mastercommit,slavecommit,total) VALUES (?,?,?,?,?,?)';
$sth = $maindbh->prepare($SQL);
for my $g (@$goatlist) {
next if ! exists $g->{rateinfo} or $g->{reltype} ne 'table';
($S,$T) = ($g->{safeschema},$g->{safetable});
if ($deltacount{source}{$S}{$T}) {
for my $time (@{$g->{rateinfo}{source}}) {
#$sth->execute($syncname,$g->{id},$targetname,$time,$source_commit_time,$deltacount{source}{$S}{$T});
}
}
if ($deltacount{target}{$S}{$T}) {
for my $time (@{$g->{rateinfo}{target}}) {
# fixme
#$sth->execute($syncname,$g->{id},$sourcename,$time,$source_commit_time,$deltacount{target}{$S}{$T});
}
}
}
$maindbh->commit();
} ## end of track_rates
if (@dbs_fullcopy and !$self->{dryrun}) {
if ($sync->{vacuum_after_copy}) {
## May want to break this output down by table
$sth{kid_syncrun_update_status}->execute("VACUUM (KID $$)", $syncname);
$maindbh->commit();
for my $dbname (@dbs_fullcopy) {
my $d = $sync->{db}{$dbname};
for my $g (@$goatlist) {
next if ! $g->{vacuum_after_copy} or $g->{reltype} ne 'table';
my $tablename = $g->{newname}{$syncname}{$dbname};
$self->vacuum_table($kid_start_time, $d->{dbtype}, $d->{dbh}, $d->{name}, $tablename);
}
}
}
if ($sync->{analyze_after_copy}) {
$sth{kid_syncrun_update_status}->execute("ANALYZE (KID $$)", $syncname);
$maindbh->commit();
for my $dbname (@dbs_fullcopy) {
my $d = $sync->{db}{$dbname};
for my $g (@$goatlist) {
next if ! $g->{analyze_after_copy} or $g->{reltype} ne 'table';
if ($g->{onetimecopy_ifempty}) {
$g->{onetimecopy_ifempty} = 0;
next;
}
my $tablename = $g->{newname}{$syncname}{$dbname};
$self->analyze_table($kid_start_time, $d->{dbtype}, $d->{dbh}, $d->{name}, $tablename);
}
}
}
}
my $total_time = sprintf '%.2f', tv_interval($kid_start_time);
## Remove lock file if we used it
$self->remove_lock_file();
## Run all 'after_txn' code
if (exists $sync->{code_after_txn}) {
$sth{kid_syncrun_update_status}->execute("Code after_txn (KID $$)", $syncname);
$maindbh->commit();
for my $code (@{$sync->{code_after_txn}}) {
last if 'last' eq $self->run_kid_custom_code($sync, $code);
}
}
## Clear out the entries from the dbrun table
for my $dbname (@dbs_connectable) {
$sth = $sth{dbrun_delete};
$sth->execute($syncname, $dbname);
$maindbh->commit();
}
## Notify the parent that we are done
$self->db_notify($maindbh, "ctl_syncdone_${syncname}");
$maindbh->commit();
## If this was a onetimecopy, leave so we don't have to rebuild dbs_fullcopy etc.
if ($sync->{onetimecopy}) {
$self->glog('Turning onetimecopy back to 0', LOG_VERBOSE);
$SQL = 'UPDATE sync SET onetimecopy=0 WHERE name = ?';
$sth = $maindbh->prepare($SQL);
$sth->execute($syncname);
$maindbh->commit();
## This gets anything loaded from scratch from this point
## The CTL knows to switch onetimecopy off because it gets a syncdone signal
last KID;
}
if (! $kidsalive) {
$self->glog('Kid is not kidsalive, so exiting', LOG_DEBUG);
last KID;
}
redo KID;
} ## end KID
## Disconnect from all the databases used in this sync
for my $dbname (@dbs_dbi) {
my $dbh = $sync->{db}{$dbname}{dbh};
$dbh->rollback();
$_->finish for values %{ $dbh->{CachedKids} };
$dbh->disconnect();
}
if ($sync->{onetimecopy}) {
## XXX
## We need the MCP and CTL to pick up the new setting. This is the
## easiest way: First we sleep a second, to make sure the CTL has
## picked up the syncdone signal. It may resurrect a kid, but it
## will at least have the correct onetimecopy
#sleep 1;
#$maindbh->do("NOTIFY reload_sync_$syncname");
#$maindbh->commit();
}
## Disconnect from the main database
$maindbh->disconnect();
$self->cleanup_kid('Normal exit', '');
$didrun = 1;
}; ## end $runkid
## Do the actual work.
RUNKID: {
$didrun = 0;
eval { $runkid->() };
exit 0 if $didrun;
my $err = $@;
## Bail out unless this error came from DBD::Pg
$err_handler->($err) if $err !~ /DBD::Pg/;
eval {
## We only do special things for certain errors, so check for those.
my ($sleeptime, $fail_msg) = (0,'');
my @states = map { $sync->{db}{$_}{dbh}->state } @dbs_dbi;
if (first { $_ eq '40001' } @states) {
$sleeptime = $config{kid_serial_sleep};
## If set to -1, this means we never try again
if ($sleeptime < 0) {
$self->glog('Could not serialize, will not retry', LOG_VERBOSE);
$err_handler->($err);
}
elsif ($sleeptime) {
$self->glog((sprintf 'Could not serialize, will sleep for %s %s',
$sleeptime, 1==$sleeptime ? 'second' : 'seconds'), LOG_NORMAL);
}
else {
$self->glog('Could not serialize, will try again', LOG_NORMAL);
}
$fail_msg = 'Serialization failure';
}
elsif (first { $_ eq '40P01' } @states) {
$sleeptime = $config{kid_deadlock_sleep};
## If set to -1, this means we never try again
if ($sleeptime < 0) {
$self->glog('Encountered a deadlock, will not retry', LOG_VERBOSE);
$err_handler->($err);
}
elsif ($sleeptime) {
$self->glog((sprintf 'Encountered a deadlock, will sleep for %s %s',
$sleeptime, 1==$sleeptime ? 'second' : 'seconds'), LOG_NORMAL);
}
else {
$self->glog('Encountered a deadlock, will try again', LOG_NORMAL);
}
$fail_msg = 'Deadlock detected';
## TODO: Get more information via get_deadlock_details()
}
else {
$err_handler->($err);
}
if ($config{log_level_number} >= LOG_VERBOSE) {
## Show complete error information in debug mode.
for my $dbh (map { $sync->{db}{$_}{dbh} } @dbs_dbi) {
$self->glog(
sprintf('* %s: %s - %s', $dbh->{Name}, $dbh->state, $dbh->errstr),
LOG_VERBOSE
) if $dbh->err;
}
}
## Roll everyone back
for my $dbname (@dbs_dbi) {
my $d = $sync->{db}{$dbname};
my $dbh = $d->{dbh};
## If we are async, clear it out - if the connection is still valid!
if ($d->{async_active}) {
my $state = $dbh->state;
if ($state eq '' or $state eq '25P01') {
$dbh->pg_cancel();
}
$d->{async_active} = 0;
}
## Mark triggers as enabled, since we are also rolling back our trigger disabling magic
$d->{triggers_enabled} = 1;
## Seperate eval{} for the rollback as we are probably still connected to the transaction.
eval { $dbh->rollback; };
if ($@) {
$self->glog("Result of eval for rollback: $@", LOG_DEBUG);
die $@;
}
}
# End the syncrun.
$self->end_syncrun($maindbh, 'bad', $syncname, "Failed : $fail_msg (KID $$)" );
$maindbh->commit;
## Tell listeners we are about to sleep
## TODO: Add some sweet payload information: sleep time, which dbs/tables failed, etc.
$self->db_notify($maindbh, "syncsleep_${syncname}", 0, "$fail_msg. Sleep=$sleeptime");
## Sleep and try again.
sleep $sleeptime if $sleeptime;
$kicked = 1;
};
if ($@) {
# Our recovery failed. :-(
$err_handler->($@);
}
else {
redo RUNKID;
}
}
} ## end of start_kid
sub start_main_transaction {
## Prepare each database for the final work of copying data
## This is the time when we do things such as set the isolation level
## From this point on, we are in the "main" transaction and speed is important
## Arguments: one hashref
## sync: the sync object
## databases: arrayref of all databases that have been connected to
## Returns: undef
my ($self, $info) = @_;
my $sync = $info->{sync} or die qq{Required arg 'sync' missing\n};
my $databases = $info->{databases} or die qq{Required arg 'databases' missing\n};
for my $dbname (@$databases) {
my $d = $sync->{db}{$dbname};
my $dbh = exists $d->{dbh} ? $d->{dbh} : '';
if ($d->{does_dbi}) {
## Just in case:
$dbh->rollback();
}
if ('postgres' eq $d->{dbtype}) {
## We never want to timeout!
$dbh->do('SET statement_timeout = 0');
## Using the same time zone everywhere keeps us sane
$dbh->do(q{SET TIME ZONE 'GMT'});
## Rare, but allow for tcp fiddling
for my $var (qw/ idle interval count /) {
my $name = "tcp_keepalives_$var";
## Should always exist, but:
next if ! exists $config{$name};
## Quick sanity checks:
next if ! defined $config{$name} or $config{$name} !~ /^\d+$/;
## A setting of zero means leave it alone
next if ! $config{$name};
$dbh->do("SET $name = $config{$name}");
$self->glog("Set $name to $config{$name} for database $dbname", LOG_DEBUG);
}
$dbh->do(qq{SET TRANSACTION ISOLATION LEVEL $self->{pg_isolation_level} READ WRITE});
$self->glog(qq{Set database "$dbname" to $self->{pg_isolation_level} read write}, LOG_DEBUG);
}
if ('mysql' eq $d->{dbtype} or 'mariadb' eq $d->{dbtype}) {
## ANSI mode: mostly because we want ANSI_QUOTES
$dbh->do(q{SET sql_mode = 'ANSI'});
## Use the same time zone everywhere
$dbh->do(q{SET time_zone = '+0:00'});
$dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE'); ## READ WRITE appears in MySQL 5.6.5
$self->glog(qq{Set database "$dbname" to serializable}, LOG_DEBUG);
}
if ('drizzle' eq $d->{dbtype}) {
## Drizzle does not appear to have anything to control this yet
}
if ('oracle' eq $d->{dbtype}) {
$dbh->do('SET TRANSACTION READ WRITE');
$dbh->do(q{SET TRANSACTION ISOLATION LEVEL SERIALIZABLE NAME 'bucardo'});
$self->glog(qq{Set database "$dbname" to serializable and read write}, LOG_DEBUG);
}
if ('sqlite' eq $d->{dbtype}) {
## Defer all foreign key checking until the very end
$dbh->do('PRAGMA defer_foreign_keys = 1');
}
if ('redis' eq $d->{dbtype}) {
## Implement MULTI, when the driver supports it
##$dbh->multi();
}
}
return undef;
} ## end of start_main_transaction
sub lock_all_tables {
## If requested, lock all the tables used in the sync
## Arguments: one hashref
## sync: sync object
## tables: arrayref of table objects
## databases: arrayref of database names
## Returns: undef
my ($self, $info) = @_;
my $sync = $info->{sync} or die qq{Required arg 'sync' missing\n};
my $tables = $info->{tables} or die qq{Required arg 'tables' missing\n};
my $databases = $info->{databases} or die qq{Required arg 'databases' missing\n};
## The final mode we choose
my $lock_table_mode = '';
my $syncname = $sync->{name};
## Check if the filesystem has a lock file request
my $force_lock_file = File::Spec->catfile( $config{piddir} => "bucardo-force-lock-$syncname" );
## Cache that
## Currently, a file is the only way to trigger this rather severe action
return undef if ! -e $force_lock_file;
$self->{force_lock_file} = $force_lock_file;
## If the file exists, pull the mode from inside it. Default to EXCLUSIVE mode
$lock_table_mode = 'EXCLUSIVE';
if (-s _ and (open my $fh, '<', "$force_lock_file")) {
my $newmode = <$fh>;
close $fh or warn qq{Could not close "$force_lock_file": $!\n};
if (defined $newmode) {
chomp $newmode;
## Quick sanity check: only set if looks like normal words
$lock_table_mode = $newmode if $newmode =~ /^\s*\w[ \w]+\s*$/o;
}
}
$self->glog(qq{Found lock control file "$force_lock_file". Mode: $lock_table_mode}, LOG_TERSE);
$self->glog("Locking all writeable tables in $lock_table_mode MODE", LOG_TERSE);
for my $dbname (@$databases) {
my $d = $sync->{db}{$dbname};
for my $g (@$tables) {
next if $g->{reltype} ne 'table';
## Figure out which table name to use
my $tname = $g->{newname}{$syncname}{$dbname};
if ('postgres' eq $d->{dbtype}) {
my $com = "$tname IN $lock_table_mode MODE";
$self->glog("Database $dbname: Locking table $com", LOG_TERSE);
$d->{dbh}->do("LOCK TABLE $com");
}
elsif ('mysql' eq $d->{dbtype } or 'drizzle' eq $d->{dbtype} or 'mariadb' eq $d->{dbtype}) {
my $com = "$tname WRITE";
$self->glog("Database $dbname: Locking table $com", LOG_TERSE);
$d->{dbh}->do("LOCK TABLE $com");
}
elsif ('oracle' eq $d->{dbtype}) {
my $com = "$tname IN EXCLUSIVE MODE";
$self->glog("Database $dbname: Locking table $com", LOG_TERSE);
$d->{dbh}->do("LOCK TABLE $com");
}
elsif ('sqlite' eq $d->{dbtype}) {
$d->{dbh}->do('BEGIN EXCLUSIVE TRANSACTION');
}
}
}
return undef;
} ## end of lock_all_tables
sub remove_lock_file {
## Remove a lock file that was used above in the remove_lock_file sub
## Arguments: none
## Returns: undef
my $self = shift;
if (exists $self->{force_lock_file} and -e $self->{force_lock_file}) {
$self->glog("Removing lock control file $self->{force_lock_file}", LOG_VERBOSE);
unlink $self->{force_lock_file}
or $self->glog("Warning! Failed to unlink $self->{force_lock_file}", LOG_WARN);
}
return undef;
} ## end of remove_lock_file
sub disable_triggers {
## Disable triggers and rules for all tables in a sync, for the given database.
## This gets all tables at once, so it only needs to be called once for each database.
## Arguments: two
## 1. Sync object
## 2. Database object
## Returns: undef
my ($self, $sync, $db) = @_;
## Are triggers already disabled for this database? Return and do nothing
return undef if ! $db->{triggers_enabled};
my $dbh = $db->{dbh};
if ('mysql' eq $db->{dbtype} or 'mariadb' eq $db->{dbtype}) {
## Do not worry about checking foreign keys
$dbh->do('SET foreign_key_checks = 0');
## Do not worry about uniqueness of unique indexes
$dbh->do('SET unique_checks = 0');
$db->{triggers_enabled} = 0;
return undef;
}
## From this point on we are doing Postgres
return undef if $db->{dbtype} ne 'postgres';
## Can we do this the easy way? Thanks to Jan for srr!
my $dbname = $db->{name};
if ($dbh->{pg_server_version} >= 80300) {
$self->glog("Setting session_replication_role to replica for database $dbname", LOG_VERBOSE);
$dbh->do(q{SET session_replication_role = 'replica'});
$db->{triggers_enabled} = 0;
return undef;
}
## Okay, the old and ugly way: pg_class table manipulation
## First, create the SQL as needed
if (! $sync->{SQL_disable_trigrules}) {
## The SQL to disable all triggers and rules for the tables in this sync
$SQL = q{
UPDATE pg_class
SET reltriggers = 0, relhasrules = false
WHERE (
};
$SQL .= join "OR\n"
=> map { "(oid = '$_->{safeschema}.$_->{safetable}'::regclass)" }
grep { $_->{reltype} eq 'table' }
@{ $sync->{goatlist} };
$SQL .= ')';
$sync->{SQL_disable_trigrules} = $SQL;
}
## Now run the SQL and mark that we have been here
$self->glog(qq{Disabling triggers and rules on database "$dbname" via pg_class}, LOG_VERBOSE);
$dbh->do($sync->{SQL_disable_trigrules});
$db->{triggers_enabled} = 0;
return undef;
} ## end of disable_triggers
sub enable_triggers {
## Restore any previously disabled triggers and rules for all databases
## Arguments: one
## 1. Sync object
## Returns: undef
my ($self, $sync) = @_;
## Walk through each database in this sync and enable triggers as needed
for my $dbname (sort keys %{ $sync->{db} }) {
my $db = $sync->{db}{$dbname};
## Do nothing unless triggers are disabled
next if $db->{triggers_enabled};
my $dbh = $db->{dbh};
if ('mysql' eq $db->{dbtype} or 'mariadb' eq $db->{dbtype}) {
$dbh->do('SET foreign_key_checks = 1');
$dbh->do('SET unique_checks = 1');
$db->{triggers_enabled} = time;
next;
}
## Past here is Postgres
## If we are using srr, just flip it back to the default
if ($db->{dbh}{pg_server_version} >= 80300) {
$self->glog("Setting session_replication_role to default for database $dbname", LOG_VERBOSE);
$dbh->do(q{SET session_replication_role = default}); ## Assumes a sane default!
$dbh->commit();
$db->{triggers_enabled} = time;
next;
}
## Okay, the old and ugly way: pg_class table manipulation
## First, create the SQL as needed
if (! $sync->{SQL_enable_trigrules}) {
my $setclause =
## no critic (RequireInterpolationOfMetachars)
q{reltriggers = }
. q{(SELECT count(*) FROM pg_catalog.pg_trigger WHERE tgrelid = pg_catalog.pg_class.oid),}
. q{relhasrules = }
. q{CASE WHEN (SELECT COUNT(*) FROM pg_catalog.pg_rules WHERE schemaname=SNAME AND tablename=TNAME) > 0 }
. q{THEN true ELSE false END};
## use critic
my $tempsql = qq{
UPDATE pg_class
SET $setclause
WHERE oid = 'SCHEMANAME.TABLENAME'::regclass
};
$SQL = join ";\n"
=> map {
my $sql = $tempsql;
$sql =~ s/SNAME/$_->{safeschemaliteral}/g;
$sql =~ s/TNAME/$_->{safetableliteral}/g;
$sql =~ s/SCHEMANAME/$_->{safeschema}/g;
$sql =~ s/TABLENAME/$_->{safetable}/g;
$sql;
}
grep { $_->{reltype} eq 'table' }
@{ $sync->{goatlist} };
$sync->{SQL_enable_trigrules} = $SQL;
}
## Now run the SQL and mark that we have been here
$self->glog(qq{Enabling triggers and rules on database "$dbname" via pg_class}, LOG_VERBOSE);
$db->{dbh}->do($sync->{SQL_enable_trigrules});
$db->{triggers_enabled} = time;
}
return undef;
} ## end of enable_triggers
sub disable_indexes {
## Disable indexes on a specific table in a specific database for faster copying
## Obviously, the index will get enabled and rebuilt later on
## If you want finer tuning, such as only disabling the same table for some databases,
## then it is up to the caller to tweak {rebuild_index} before calling.
## Arguments: three
## 1. Sync object
## 2. Database object
## 3. Table object
## Returns: undef
my ($self, $sync, $db, $table) = @_;
## Do nothing unless rebuild_index has been set for this table
return undef if ! $table->{rebuild_index};
## The only system we do this with is Postgres
return undef if $db->{dbtype} ne 'postgres';
## Grab the actual target table name
my $tablename = $table->{newname}{$sync->{name}}{$db->{name}};
## Have we already disabled triggers on this table? Return but make a note
my $dbname = $db->{name};
if ($table->{"db:$dbname"}{indexes_disabled}) {
$self->glog("Warning: tried to disable indexes twice for $db->{name}.$tablename", LOG_WARN);
return undef;
}
## We need to know if this table has indexes or not
if (! exists $table->{"db:$dbname"}{has_indexes}) {
$SQL = qq{SELECT relhasindex FROM pg_class WHERE oid = '$tablename'::regclass};
## relhasindex is a boolean 't' or 'f', but DBD::Pg will return it as 1 or 0
$table->{"db:$dbname"}{has_indexes} = $db->{dbh}->selectall_arrayref($SQL)->[0][0];
}
## If the table has no indexes, then we don't need to worry about disabling them
return undef if ! $table->{"db:$dbname"}{has_indexes};
## Now we can proceed with the disabling, by monkeying with the system catalog
$self->glog("Disabling indexes for $dbname.$tablename", LOG_NORMAL);
$SQL = qq{UPDATE pg_class SET relhasindex = 'f' WHERE oid = '$tablename'::regclass};
$count = $db->{dbh}->do($SQL);
## Safety check:
if ($count < 1) {
$self->glog("Warning: disable index failed for $dbname.$tablename", LOG_WARN);
}
## This is mostly here to tell enable_indexes to proceed
$table->{"db:$dbname"}{indexes_disabled} = 1;
return undef;
} ## end of disable_indexes
sub enable_indexes {
## Make indexes live again, and rebuild if needed
## Walks through all the databases itself
## Arguments: two
## 1. Sync object
## 2. Table object
## Returns: undef
my ($self, $sync, $table) = @_;
## Walk through each database in this sync and reapply indexes as needed
for my $dbname (sort keys %{ $sync->{db} }) {
my $db = $sync->{db}{$dbname};
## Do nothing unless we are sure indexes have been disabled
next if ! $table->{"db:$dbname"}{indexes_disabled};
## This all assumes the database is Postgres
## Grab the actual target table name
my $tablename = $table->{newname}{$sync->{name}}{$db->{name}};
## Turn the indexes back on
$self->glog("Enabling indexes for $dbname.$tablename", LOG_NORMAL);
## We set this to 'f' earlier, so flip it back now
$SQL = qq{UPDATE pg_class SET relhasindex = 't' WHERE oid = '$tablename'::regclass};
$count = $db->{dbh}->do($SQL);
## Safety check:
if ($count < 1) {
$self->glog("Warning: enable index failed for $dbname.$tablename", LOG_WARN);
}
$table->{"db:$dbname"}{indexes_disabled} = 0;
## Rebuild all the indexes on this table
$self->glog("Reindexing table $dbname.$tablename", LOG_NORMAL);
## We do this asynchronously so we don't wait on each db
$db->{async_active} = time;
$db->{dbh}->do( "REINDEX TABLE $tablename", {pg_async => PG_ASYNC} );
## Very short-lived variable to help the loop below
$db->{rebuild_index_active} = 1;
}
## Now walk through and let each one finish
for my $dbname (sort keys %{ $sync->{db} }) {
my $db = $sync->{db}{$dbname};
if ($db->{rebuild_index_active}) {
## Waits for the REINDEX to finish:
$db->{dbh}->pg_result();
$db->{async_active} = 0;
}
delete $db->{rebuild_index_active};
}
return undef;
} ## end of enable_indexes
sub pause_and_exit {
## Usually called by a kid, dies and pauses the sync before it leaves
## This prevents infinite loops because something went wrong with the kid
## Arguments: one
## 1. Message to give (LOG_WARN)
## Returns: never, dies.
my ($self, $message) = @_;
$self->glog($message, LOG_WARN);
my $syncname = $self->{sync}{name};
$self->glog("Pausing sync $syncname", LOG_TERSE);
$self->db_notify($self->{masterdbh}, "pause_sync_$syncname", 1);
die $message;
} ## end of pause_and_exit
sub connect_database {
## Connect to the given database
## Arguments: one
## 1. The id of the database
## If the database id is blank or zero, we return the main database
## Returns:
## - the database handle and the backend PID
## OR
## - the string 'inactive' if set as such in the db table
## OR
## - the string 'flat' if this is a flatfile 'database'
my $self = shift;
my $id = shift || 0;
my ($dsn,$dbh,$user,$pass,$ssp,$dbname);
my $dbtype = 'postgres';
## If id is 0, connect to the main database
if (!$id) {
$dsn = "dbi:Pg:dbname=$self->{dbname}";
defined $self->{dbport} and length $self->{dbport} and $dsn .= ";port=$self->{dbport}";
defined $self->{dbhost} and length $self->{dbhost} and $dsn .= ";host=$self->{dbhost}";
defined $self->{dbconn} and length $self->{dbconn} and $dsn .= ";$self->{dbconn}";
$user = $self->{dbuser};
$pass = $self->{dbpass};
$ssp = 1;
}
else {
my $db = $self->get_dbs;
exists $db->{$id} or die qq{Invalid database id!: $id\n};
my $d = $db->{$id};
$dbtype = $d->{dbtype};
$dbname = $d->{dbname};
if ($d->{status} eq 'inactive') {
return 0, 'inactive';
}
## Flat files do not actually get connected to, of course
if ($dbtype =~ /flat/o) {
return 0, 'flat';
}
if ('postgres' eq $dbtype) {
$dsn = 'dbi:Pg:';
$dsn .= join ';', map {
($_ eq 'dbservice' ? 'service' : $_ ) . "=$d->{$_}";
} grep { defined $d->{$_} and length $d->{$_} } qw/dbname dbservice/;
}
elsif ('drizzle' eq $dbtype) {
$dsn = "dbi:drizzle:database=$dbname";
}
elsif ('mongo' eq $dbtype) {
my $mongodsn = {};
for my $name (qw/ dbhost dbport dbuser dbpass /) {
defined $d->{$name} and length $d->{$name} and $mongodsn->{$name} = $d->{$name};
}
## For now, we simply require it
require MongoDB;
my $conn = MongoDB::Connection->new($mongodsn); ## no critic
$dbh = $conn->get_database($dbname);
my $backend = 0;
return $backend, $dbh;
}
elsif ('mysql' eq $dbtype or 'mariadb' eq $dbtype) {
$dsn = "dbi:mysql:database=$dbname";
}
elsif ('oracle' eq $dbtype) {
$dsn = "dbi:Oracle:dbname=$dbname";
}
elsif ('redis' eq $dbtype) {
my @dsn;
my $server = '';
if (defined $d->{host} and length $d->{host}) {
$server = $d->{host};
}
if (defined $d->{port} and length $d->{port}) {
$server = ":$d->{port}";
}
if ($server) {
push @dsn => 'server', $server;
}
## For now, we simply require it
require Redis;
$dbh = Redis->new(@dsn);
my $backend = 0;
return $backend, $dbh;
}
elsif ('sqlite' eq $dbtype) {
$dsn = "dbi:SQLite:dbname=$dbname";
}
else {
die qq{Cannot handle databases of type "$dbtype"\n};
}
defined $d->{dbport} and length $d->{dbport} and $dsn .= ";port=$d->{dbport}";
defined $d->{dbhost} and length $d->{dbhost} and $dsn .= ";host=$d->{dbhost}";
length $d->{dbconn} and $dsn .= ";$d->{dbconn}";
$user = $d->{dbuser};
$pass = $d->{dbpass} || '';
$ssp = $d->{server_side_prepares};
}
$self->glog("DSN: $dsn", LOG_VERBOSE) if exists $config{log_level};
$dbh = DBI->connect
(
$dsn,
$user,
$pass,
{AutoCommit=>0, RaiseError=>1, PrintError=>0}
);
## Register this database in our global list
## Note that we only worry about DBI-backed databases here,
## as there is no particular cleanup needed (e.g. InactiveDestroy)
## for other types.
$self->{dbhlist}{$dbh} = $dbh;
## From here on out we are setting Postgres-specific items, so everyone else is done
if ($dbtype ne 'postgres') {
return 0, $dbh;
}
## Set the application name if we can
if ($dbh->{pg_server_version} >= 90000) {
my $role = $self->{logprefix} || '???';
$dbh->do("SET application_name='bucardo $role'");
$dbh->commit();
}
## If we are using something like pgbouncer, we need to tell Bucardo not to
## use server-side prepared statements, as they will not span commits/rollbacks.
if (! $ssp) {
$self->glog('Turning off server-side prepares for this database connection', LOG_TERSE);
$dbh->{pg_server_prepare} = 0;
}
## Grab the backend PID for this Postgres process
## Also a nice check that everything is working properly
$SQL = 'SELECT pg_backend_pid()';
my $backend = $dbh->selectall_arrayref($SQL)->[0][0];
$dbh->rollback();
## If the main database, prepend 'bucardo' to the search path
if (!$id) {
$dbh->do(q{SELECT pg_catalog.set_config('search_path', 'bucardo,' || current_setting('search_path'), false)});
$dbh->commit();
}
## If this is not the main database, listen for a dead db hint
if ($id and $self->{logprefix} eq 'MCP') {
$self->db_listen($self->{masterdbh}, "dead_db_$id");
$self->glog("Listening for dead_db_$id", LOG_DEBUG);
$dbh->commit();
}
return $backend, $dbh;
} ## end of connect_database
sub reload_config_database {
## Reload the %config and %config_about hashes from the bucardo_config table
## Calls commit on the masterdbh
## Arguments: none
## Returns: undef
my $self = shift;
undef %config;
undef %config_about;
my %log_level_number = (
WARN => 1, ## Yes, this is correct. Should not be able to set lower than 1
TERSE => 1,
NORMAL => 2,
VERBOSE => 3,
DEBUG => 4,
);
$SQL = 'SELECT name,setting,about,type,name FROM bucardo_config';
$sth = $self->{masterdbh}->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
## Things from an rc file can override the value in the db
my $setting = exists $self->{$row->{name}} ? $self->{$row->{name}} : $row->{setting};
if ($row->{name} eq 'log_level') {
my $newvalue = $log_level_number{uc $setting};
if (! defined $newvalue) {
die "Invalid log_level!\n";
}
$config{log_level_number} = $newvalue;
}
if (defined $row->{type}) {
$config{$row->{type}}{$row->{name}}{$row->{setting}} = $setting;
$config_about{$row->{type}}{$row->{name}}{$row->{setting}} = $row->{about};
}
else {
$config{$row->{name}} = $setting;
$config_about{$row->{name}} = $row->{about};
}
}
$self->{masterdbh}->commit();
return;
} ## end of reload_config_database
sub log_config {
## Write the current contents of the config hash to the log
## Arguments: none
## Returns: undef
my $self = shift;
my $msg = "Bucardo config:\n";
## Figure out the longest key name for pretty formatting
my $maxlen = 5;
for (keys %config) {
$maxlen = length($_) if length($_) > $maxlen;
}
## Print each config name and setting in alphabetic order
for (sort keys %config) {
$msg .= sprintf " %-*s => %s\n", $maxlen, $_, (defined $config{$_}) ? qq{'$config{$_}'} : 'undef';
}
$self->glog($msg, LOG_WARN);
return;
} ## end of log_config
sub _logto {
my $self = shift;
if ($self->{logpid} && $self->{logpid} != $$) {
# We've forked! Get rid of any existing handles.
delete $self->{logcodes};
}
return $self->{logcodes} if $self->{logcodes};
# Do no logging if any destination is "none".
if (grep { $_ eq 'none' } @{ $self->{logdest} }) {
$self->{logcodes} = {};
return $self->{logcodes};
}
$self->{logpid} = $$;
my %logger;
for my $dest (@{ $self->{logdest}} ) {
next if exists $logger{$dest};
if ($dest eq 'syslog') {
## Use Sys::Syslog to open a new syslog connection
openlog 'Bucardo', 'pid nowait', $config{syslog_facility};
## Ignore the header argument for syslog output.
$logger{syslog} = { type => 'syslog', code => sub { shift; syslog 'info', @_ } };
}
elsif ($dest eq 'stderr') {
$logger{stderr} = { type => 'stderr', code => sub { print STDERR @_, $/ } };
}
elsif ($dest eq 'stdout') {
$logger{stdout} = { type => 'stdout', code => sub { print STDOUT @_, $/ } };
}
else {
## Just a plain text file
my $fn = File::Spec->catfile($dest, 'log.bucardo');
$fn .= ".$self->{logextension}" if length $self->{logextension};
## If we are writing each process to a separate file,
## append the prefix (first three letters) and the PID to the file name
my $tla = substr($self->{logprefix},0,3);
$fn .= "$tla.$$" if $self->{logseparate};
open my $fh, '>>', $fn or die qq{Could not append to "$fn": $!\n};
## Turn off buffering on this handle
$fh->autoflush(1);
$logger{$dest} = {
type => 'textfile',
code => sub { print {$fh} @_, $/ },
filename => $fn,
filehandle => $fh,
};
}
}
## Store this away so the reopening via USR2 works
$self->{logcodes} = \%logger;
return \%logger;
}
sub glog { ## no critic (RequireArgUnpacking)
## Reformat and log internal messages to the correct place
## Arguments: two
## 1. the log message
## 2. the log level (defaults to 0)
## Returns: undef
## Quick shortcut if verbose is 'off' (which is not recommended!)
return if ! $_[0]->{verbose};
my $self = shift;
my $msg = shift;
## Grab the log level: defaults to 0 (LOG_WARN)
my $loglevel = shift || 0;
## Return and do nothing, if we have not met the minimum log level
return if $loglevel > $config{log_level_number};
## Just return if there is no place to log to.
my $logs = $self->_logto;
return unless keys %$logs || ($loglevel == LOG_WARN && $self->{warning_file});
## Remove newline from the end of the message, in case it has one
chomp $msg;
## We should always have a prefix, either BC!, MCP, CTL, KID, or VAC
## Prepend it to our message
my $prefix = $self->{logprefix} || '???';
$msg = "$prefix $msg";
## We may also show other optional things: log level, PID, timestamp, line we came from
## Optionally show the current time in some form
my $showtime = '';
if ($config{log_showtime}) {
my ($sec,$msec) = gettimeofday;
$showtime =
1 == $config{log_showtime} ? $sec
: 2 == $config{log_showtime} ? (scalar gmtime($sec))
: 3 == $config{log_showtime} ? (scalar localtime($sec))
: '';
if ($config{log_microsecond}) {
$showtime =~ s/(:\d\d) /"$1." . substr($msec,0,3) . ' '/oe;
$showtime =~ s/(:\d\d\.\d\d) /${1}0 /;
}
}
## Optionally show the PID (and set the time from above)
## Show which line we came from as well
my $header = sprintf '%s%s%s',
($config{log_showpid} ? "($$) " : ''),
($showtime ? "[$showtime] " : ''),
$config{log_showline} ? (sprintf '#%04d ', (caller)[2]) : '';
## Prepend the loglevel to the message
if ($config{log_showlevel}) {
$header = sprintf "%s $header", qw(WARN TERSE NORMAL VERBOSE DEBUG)[$loglevel];
}
## Warning messages may also get written to a separate file
## Note that a 'warning message' is simply anything starting with "Warning"
if ($self->{warning_file} and $loglevel == LOG_WARN) {
my $file = $self->{warning_file};
open my $fh, , '>>', $file or die qq{Could not append to "$file": $!\n};
print {$fh} "$header$msg\n";
close $fh or warn qq{Could not close "$file": $!\n};
}
# Send it to all logs.
for my $log (sort keys %$logs) {
next if ! exists $logs->{$log}{code};
$logs->{$log}{code}->($header, $msg);
}
return;
} ## end of glog
sub conflict_log {
## Log a message to the conflict log file at config{log_conflict_file}
## Arguments: one
## 1. the log message
## Returns: undef
my $self = shift;
my $msg = shift;
chomp $msg;
my $cfile = $config{log_conflict_file};
my $clog;
if (! open $clog, '>>', $cfile) {
warn qq{Could not append to file "$cfile": $!};
return;
}
print {$clog} "$msg\n";
close $clog or warn qq{Could not close "$cfile": $!\n};
return;
} ## end of conflict_log
sub show_db_version_and_time {
## Output the time, timezone, and version information to the log
## Arguments: three
## 1. Database handle
## 2. Backend PID
## 3. A string indicating which database this is
## Returns: undef
my ($self,$ldbh,$backend,$prefix) = @_;
return if ! defined $ldbh;
return if ref $ldbh ne 'DBI::db';
return if $ldbh->{Driver}{Name} ne 'Pg';
$self->glog(qq{${prefix}backend PID: $backend}, LOG_VERBOSE);
## Get the databases epoch, timestamp, and timezone
$SQL = q{SELECT extract(epoch FROM now()), now(), current_setting('timezone')};
my $sth = $ldbh->prepare($SQL);
## Get the system's time
my $systemtime = Time::HiRes::time();
## Do the actual database call as close as possible to the system one
$sth->execute();
my $dbtime = $sth->fetchall_arrayref()->[0];
$self->glog("${prefix}Local epoch: $systemtime DB epoch: $dbtime->[0]", LOG_WARN);
$systemtime = scalar localtime ($systemtime);
$self->glog("${prefix}Local time: $systemtime DB time: $dbtime->[1]", LOG_WARN);
$systemtime = strftime('%Z (%z)', localtime());
$self->glog("${prefix}Local timezone: $systemtime DB timezone: $dbtime->[2]", LOG_WARN);
$self->glog("${prefix}Postgres version: " . $ldbh->{pg_server_version}, LOG_WARN);
$self->glog("${prefix}Database port: " . $ldbh->{pg_port}, LOG_WARN);
$ldbh->{pg_host} and $self->glog("${prefix}Database host: " . $ldbh->{pg_host}, LOG_WARN);
return;
} ## end of show_db_version_and_time
sub get_dbs {
## Fetch a hashref of everything in the db table
## Used by connect_database()
## Calls commit on the masterdbh
## Arguments: none
## Returns: hashref
my $self = shift;
$SQL = 'SELECT * FROM bucardo.db';
$sth = $self->{masterdbh}->prepare($SQL);
$sth->execute();
my $info = $sth->fetchall_hashref('name');
$self->{masterdbh}->commit();
return $info;
} ## end of get_dbs
sub get_goats {
## Fetch a hashref of everything in the goat table
## Used by find_goats()
## Calls commit on the masterdbh
## Arguments: none
## Returns: hashref
my $self = shift;
$SQL = 'SELECT * FROM bucardo.goat';
$sth = $self->{masterdbh}->prepare($SQL);
$sth->execute();
my $info = $sth->fetchall_hashref('id');
$self->{masterdbh}->commit();
return $info;
} ## end of get_goats
sub find_goats {
## Given a herd, return an arrayref of goats
## Used by validate_sync()
## Calls commit on the masterdbh
## Arguments: none
## Returns: hashref
my ($self,$herd) = @_;
my $goats = $self->get_goats();
$SQL = q{
SELECT goat
FROM bucardo.herdmap
WHERE herd = ?
ORDER BY priority DESC, goat ASC
};
$sth = $self->{masterdbh}->prepare($SQL);
$sth->execute($herd);
my $newgoats = [];
for (@{$sth->fetchall_arrayref()}) {
push @$newgoats, $goats->{$_->[0]};
}
$self->{masterdbh}->commit();
return $newgoats;
} ## end of find_goats
sub get_syncs {
## Fetch a hashref of everything in the sync table
## Used by reload_mcp()
## Calls commit on the masterdbh
## Arguments: none
## Returns: hashref
my $self = shift;
## Grab all fields plus some computed ones from the sync table
$SQL = q{
SELECT *,
COALESCE(EXTRACT(epoch FROM checktime),0) AS checksecs,
COALESCE(EXTRACT(epoch FROM lifetime),0) AS lifetimesecs
FROM bucardo.sync
};
$sth = $self->{masterdbh}->prepare($SQL);
$sth->execute();
## Turn it into a hash based on the sync name, then return the ref
my $info = $sth->fetchall_hashref('name');
$self->{masterdbh}->commit();
return $info;
} ## end of get_syncs
sub get_reason {
## Returns the current string (if any) in the reason file
## Arguments: one
## 1. Optional boolean: if true, the reason file is removed
## Returns: string
my $delete = shift || 0;
## String to return
my $reason = '';
## If we can't open the file, we simply return an empty string
if (open my $fh, '<', $config{reason_file}) {
## Everything after the pipe is the reason. If no match, return empty string
if (<$fh> =~ /\|\s*(.+)/o) {
$reason = $1;
}
close $fh or warn qq{Could not close "$config{reason_file}": $!\n};
## Optionally delete the file after we've opened and closed it
$delete and unlink $config{reason_file};
}
return $reason;
} ## end of get_reason
sub db_listen {
## Listen for specific messages. Does not commit.
## Arguments: two, three, or four
## 1. Database handle
## 2. String to listen for
## 3. Short name of the database (optional, for debug output, default to 'bucardo')
## 4. Whether to skip payloads. Optional boolean, defaults to false
## Returns: undef
my $self = shift;
my $ldbh = shift;
my $string = shift;
my $name = shift || 'bucardo';
my $skip_payload = shift || 0;
if (! ref $ldbh) {
my $line = (caller)[2];
$self->glog("Call to db_listen from an invalid database handle for $name, line $line", LOG_WARN);
return;
}
## If using payloads, we only need to listen for one thing
if ($ldbh->{pg_server_version} >= 90000 and ! $skip_payload) {
## Do nothing if we are already listening
return if $self->{listen_payload}{$ldbh};
## Mark this process as listening to this database.
## Get implicitly reset post-fork as new database handles are created
$self->{listen_payload}{$ldbh} = 1;
## We use 'bucardo', 'bucardo_ctl', or 'bucardo_kid'
my $suffix = $self->{logprefix} =~ /(KID|CTL)/ ? ('_' . lc $1) : '';
$string = "bucardo$suffix";
}
elsif (exists $self->{listening}{$ldbh}{$string}) {
## Using old-style direct names and already listening? Just return
return;
}
else {
## Mark it as already done
$self->{listening}{$ldbh}{$string} = 1;
}
$string = "bucardo_$string" if index($string, 'bucardo');
## If log level low enough, show which line this call came from
if ($config{log_level_number} <= LOG_DEBUG) {
my $line = (caller)[2];
$self->glog(qq{LISTEN for "$string" on "$name" (line $line)}, LOG_DEBUG);
}
$ldbh->do(qq{LISTEN "$string"})
or die qq{LISTEN "$string" failed!\n};
return;
} ## end of db_listen
sub db_unlisten {
## Stop listening for specific messages
## Arguments: four
## 1. Database handle
## 2. String to stop listening to
## 3. Short name of the database (for debug output)
## 4. Whether to skip payloads. Optional boolean, defaults to false
## Returns: undef
my $self = shift;
my $ldbh = shift;
my $string = shift;
my $name = shift || 'bucardo';
my $skip_payload = shift || 0;
## If we are 9.0 or greater, we never stop listening
if ($ldbh->{pg_server_version} >= 90000 and ! $skip_payload) {
return;
}
my $original_string = $string;
$string = "bucardo_$string";
## If log level low enough, show which line this call came from
if ($config{log_level_number} <= LOG_DEBUG) {
my $line = (caller)[2];
$self->glog(qq{UNLISTEN for "$string" on "$name" (line $line)}, LOG_DEBUG);
}
## We'll unlisten even if the hash indicates we are not
$ldbh->do(qq{UNLISTEN "$string"});
delete $self->{listening}{$ldbh}{$original_string};
return;
} ## end of db_unlisten
sub db_unlisten_all {
## Stop listening to everything important
## Arguments: one
## 1. Database handle
## Returns: undef
my $self = shift;
my $ldbh = shift;
## If the log level is low enough, show the line that called this
if ($config{log_level_number} <= LOG_DEBUG) {
my $line = (caller)[2];
$self->glog(qq{UNLISTEN * (line $line)}, LOG_DEBUG);
}
## Do the deed
$ldbh->do('UNLISTEN *');
delete $self->{listening}{$ldbh};
delete $self->{listen_payload}{$ldbh};
return;
} ## end of db_unlisten_all
sub db_notify {
## Send an asynchronous notification into the DB aether, then commit
## Arguments: five
## 1. Database handle
## 2. The string to send
## 3. Whether to skip payloads. Optional boolean, defaults to false
## 4. Name of the database (as defined in bucardo.db). Optional
## 5. Whether we should skip the final commit or not. Defaults to false. Optional.
## Returns: undef
my ($self, $ldbh, $string, $skip_payload, $dbname, $skip_commit) = @_;
## We make some exceptions to the payload system, mostly for early MCP notices
## This is because we don't want to complicate external clients with payload decisions
$skip_payload = 0 if ! defined $skip_payload;
$skip_commit = 0 if ! defined $skip_commit;
if ($config{log_level_number} <= LOG_DEBUG) {
my $line = (caller)[2];
my $showdb = (defined $dbname and length $dbname) ? " to db $dbname" : '';
$self->glog(qq{Sending NOTIFY "$string"$showdb (line $line) skip_commit=$skip_commit}, LOG_DEBUG);
}
if ($ldbh->{pg_server_version} < 90000 or $skip_payload) {
## Old-school notification system. Simply send the given string
## ...but prepend a 'bucardo_' to it first
$string = "bucardo_$string";
$ldbh->do(qq{NOTIFY "$string"})
or $self->glog(qq{Warning: NOTIFY failed for "$string"}, LOG_DEBUG);
}
else {
## New-style notification system. The string becomes the payload
## The channel is always 'bucardo' based.
my $channel = 'bucardo';
## Going to ctl?
$channel = 'bucardo_ctl' if $string =~ s/^ctl_//o;
## Going to kid
$channel = 'bucardo_kid' if $string =~ s/^kid_//o;
$ldbh->do(qq{NOTIFY $channel, '$string'})
or $self->glog(qq{Warning: NOTIFY failed for bucardo, '$string'}, LOG_DEBUG);
}
$ldbh->commit() if ! $skip_commit;
return;
} ## end of db_notify
sub db_get_notices {
## Gather up and return a list of asynchronous notices received since the last check
## Arguments: one or two
## 1. Database handle
## 2. PID that can be ignored (optional)
## Returns: hash of notices, with the key as the name and then another hash with:
## count: total number received
## firstpid: the first PID for this notice
## pids: hashref of all pids
## If using 9.0 or greater, the payload becomes the name
my ($self, $ldbh, $selfpid) = @_;
my ($n, %notice);
while ($n = $ldbh->func('pg_notifies')) {
my ($name, $pid, $payload) = @$n;
## Ignore certain PIDs (e.g. from ourselves!)
next if defined $selfpid and $pid == $selfpid;
if ($ldbh->{pg_server_version} >= 90000 and $payload) {
$name = $payload; ## presto!
}
else {
$name =~ s/^bucardo_//o;
}
if (exists $notice{$name}) {
$notice{$name}{count}++;
$notice{$name}{pid}{$pid}++;
}
else {
$notice{$name}{count} = 1;
$notice{$name}{pid}{$pid} = 1;
$notice{$name}{firstpid} = $pid;
}
}
## Return right now if we had no notices,
## or if don't need lots of logging detail
if (! keys %notice or $config{log_level_number} > LOG_DEBUG) {
return \%notice;
}
## TODO: Return if this was sent from us (usually PID+1)
## Always want to write the actual line these came from
my $line = (caller)[2];
## Walk the list and show each unique message received
for my $name (sort keys %notice) {
my $pid = $notice{$name}{firstpid};
my $prettypid = (exists $self->{pidmap}{$pid} ? "$pid ($self->{pidmap}{$pid})" : $pid);
my $extra = '';
my $pcount = keys %{ $notice{$name}{pid} };
$pcount--; ## Not the firstpid please
if ($pcount > 1) {
$extra = sprintf ' (and %d other %s)',
$pcount, 1 == $pcount ? 'PID' : 'PIDs';
}
my $times = '';
$count = $notice{$name}{count};
if ($count > 1) {
$times = " $count times";
}
my $msg = sprintf 'Got NOTICE %s%s from %s%s (line %d)',
$name, $times, $prettypid, $extra, $line;
$self->glog($msg, LOG_DEBUG);
}
return \%notice;
} ## end of db_get_notices
sub send_signal_to_PID {
## Send a USR1 to one or more PIDs
## Arguments: one
## 1. Hashref of info, including:
## sync => name of a sync to filter PID files with
## Returns: number of signals sucessfully sent
my ($self, $arg) = @_;
my $total = 0;
## Slurp in all the files from the PID directory
my $piddir = $config{piddir};
opendir my $dh, $piddir or die qq{Could not opendir "$piddir" $!\n};
my @pidfiles = grep { /^bucardo.*\.pid$/ } readdir $dh;
closedir $dh or warn qq{Could not closedir "$piddir": $!\n};
## Send a signal to the ones we care about
for my $pidfile (sort @pidfiles) {
next if $arg->{sync} and $pidfile !~ /\bsync\.$arg->{sync}\b/;
my $pfile = File::Spec->catfile( $piddir => $pidfile );
if (open my $fh, '<', $pfile) {
my $pid = <$fh>;
close $fh or warn qq{Could not close "$pfile": $!\n};
if (! defined $pid or $pid !~ /^\d+$/) {
$self->glog("Warning: No PID found in file, so removing $pfile", LOG_TERSE);
unlink $pfile;
}
elsif ($pid == $$) {
}
else {
$total += kill $signumber{'USR1'} => $pid;
$self->glog("Sent USR1 signal to process $pid", LOG_VERBOSE);
}
}
else {
$self->glog("Warning: Could not open file, so removing $pfile", LOG_TERSE);
unlink $pfile;
}
}
return $total;
} ## end of send_signal_to_PID
sub validate_sync {
## Check each database a sync needs to use, and validate all tables and columns
## This also populates the all important $self->{sdb} hash
## We use sdb to prevent later accidental mixing with $sync->{db}
## Arguments: one
## 1. Hashref of sync information
## Returns: boolean success/failure
my ($self,$s) = @_;
my $syncname = $s->{name};
$self->glog(qq{Running validate_sync on "$s->{name}"}, LOG_NORMAL);
## Populate $s->{db} with all databases in this sync
$SQL = 'SELECT db.*, m.role, m.priority, m.gang FROM dbmap m JOIN db ON (db.name = m.db) WHERE m.dbgroup = ?';
$sth = $self->{masterdbh}->prepare($SQL);
$count = $sth->execute($s->{dbs});
$s->{db} = $sth->fetchall_hashref('name');
## Figure out what role each database will play in this sync
my %role = ( source => 0, target => 0, fullcopy => 0);
## Establish a connection to each database used
## We also populate the "source" database as the first source we come across
my ($sourcename,$srcdbh);
## How many database were restored from a stalled state
my $restored_dbs = 0;
for my $dbname (sort keys %{ $s->{db} }) {
## Helper var so we don't have to type this out all the time
my $d = $s->{db}{$dbname};
## Check for inactive databases
if ($d->{status} eq 'inactive') {
## Source databases are never allowed to be inactive
if ($d->{role} eq 'source') {
$self->glog("Source database $dbname is not active, cannot run this sync", LOG_WARN);
## Normally, we won't get here as the sync should not be active
## Mark the syncs as stalled and move on
$s->{status} = 'stalled';
$SQL = 'UPDATE bucardo.sync SET status = ? WHERE name = ?';
eval {
my $sth = $self->{masterdbh}->prepare($SQL);
$sth->execute('stalled',$syncname);
$self->{masterdbh}->commit();
};
if ($@) {
$self->glog("Failed to set sync $syncname as stalled: $@", LOG_WARN);
$self->{masterdbh}->rollback();
}
return 0;
}
## Warn about non-source ones, but allow the sync to proceed
$self->glog("Database $dbname is not active, so it will not be used", LOG_WARN);
## No sense in connecting to it
next;
}
## If we've not already populated sdb, do so now
if (! exists $self->{sdb}{$dbname}) {
$self->{sdb}{$dbname} = $d;
my $role = $d->{role};
if ($d->{dbtype} =~ /flat/o) {
$self->glog(qq{Skipping flatfile database "$dbname"}, LOG_NORMAL);
next;
}
$self->glog(qq{Connecting to database "$dbname" ($role)}, LOG_TERSE);
eval {
## We do not want the CTL handler here
local $SIG{__DIE__} = undef;
($d->{backend}, $d->{dbh}) = $self->connect_database($dbname);
};
if (!defined $d->{backend}) {
## If this was already stalled, we can simply reject the validation
if ($d->{status} eq 'stalled') {
$self->glog("Stalled db $dbname failed again: $@", LOG_VERBOSE);
return 0;
}
## Wasn't stalled before, but is now!
## This is a temporary setting: we don't modify masterdbh
$d->{status} = 'stalled';
return 0;
}
$self->show_db_version_and_time($d->{dbh}, $d->{backend}, qq{Database "$dbname" });
## If this db was previously stalled, restore it
if ($d->{status} eq 'stalled') {
$self->glog("Restoring stalled db $dbname", LOG_NORMAL);
$SQL = 'UPDATE bucardo.db SET status = ? WHERE name = ?';
my $sth = $self->{masterdbh}->prepare($SQL);
eval {
$sth->execute('active',$dbname);
$self->{masterdbh}->commit();
$restored_dbs++;
$d->{status} = 'active';
};
if ($@) {
$self->glog("Failed to set db $dbname as active: $@", LOG_WARN);
$self->{masterdbh}->rollback();
## If this fails, we don't want the sync restored
$restored_dbs = 0;
}
}
}
## If the whole sync was stalled but we retored its dbs above,
## restore the sync as well
if ($restored_dbs) {
$self->glog("Restoring stalled sync $syncname", LOG_NORMAL);
$SQL = 'UPDATE bucardo.sync SET status = ? WHERE name = ?';
eval {
my $sth = $self->{masterdbh}->prepare($SQL);
$sth->execute('active',$syncname);
$s->{status} = 'active';
};
if ($@) {
$self->glog("Failed to set sync $syncname as active: $@", LOG_WARN);
$self->{masterdbh}->rollback();
}
}
## Help figure out source vs target later on
$role{$d->{role}}++;
## We want to grab the first source we find and populate $sourcename and $srcdbh
if (! defined $sourcename and $s->{db}{$dbname}{role} eq 'source') {
$sourcename = $dbname;
$srcdbh = $self->{sdb}{$dbname}{dbh};
}
} ## end each database
## If we have more than one source, then everyone is a target
## Otherwise, only non-source databases are
for my $dbname (keys %{ $s->{db} }) {
my $d = $s->{db}{$dbname};
$d->{istarget} = ($d->{role} ne 'source' or $role{source} > 1) ? 1 : 0;
$d->{issource} = $d->{role} eq 'source' ? 1 : 0;
}
## Grab the authoritative list of goats in this herd
$s->{goatlist} = $self->find_goats($s->{herd});
## Call validate_sync: checks tables, columns, sets up supporting
## schemas, tables, functions, and indexes as needed
eval {
local $SIG{__DIE__} = undef;
$self->{masterdbh}->do("SELECT validate_sync('$syncname')");
};
if ($@) {
$self->glog("Error from validate_sync: $@", LOG_NORMAL);
$self->{masterdbh}->rollback;
return 0;
}
## Prepare some SQL statements for immediate and future use
my %SQL;
## Given a schema and table name, return safely quoted names
$SQL{checktable} = q{
SELECT c.oid, quote_ident(n.nspname), quote_ident(c.relname), quote_literal(n.nspname), quote_literal(c.relname)
FROM pg_class c, pg_namespace n
WHERE c.relnamespace = n.oid
AND c.oid = ?::regclass
};
$sth{checktable} = $srcdbh->prepare($SQL{checktable});
## Given a table, return detailed column information
$SQL{checkcols} = q{
SELECT attname, quote_ident(attname) AS qattname, atttypid, format_type(atttypid, atttypmod) AS ftype,
attnotnull, atthasdef, attnum,
(SELECT pg_get_expr(adbin, adrelid) FROM pg_attrdef WHERE adrelid=attrelid
AND adnum=attnum AND atthasdef) AS def
FROM pg_attribute
WHERE attrelid = ?::regclass AND attnum > 0 AND NOT attisdropped
ORDER BY attnum
};
$sth{checkcols} = $srcdbh->prepare($SQL{checkcols});
## Reset custom code related counters for this sync
$s->{need_rows} = $s->{need_safe_dbh} = $s->{need_safe_dbh_strict} = 0;
## Empty out any existing lists of code types
for my $key (grep { /^code_/ } sort keys %$s) {
$s->{$key} = [];
}
## Validate all (active) custom codes for this sync
my $goatlistcodes = join ',' => map { $_->{id} } @{$s->{goatlist}};
my $goatclause = length $goatlistcodes ? "OR m.goat IN ($goatlistcodes)" : '';
$SQL = qq{
SELECT c.src_code, c.id, c.whenrun, c.getdbh, c.name, COALESCE(c.about,'?') AS about,
c.status, m.active, m.priority, COALESCE(m.goat,0) AS goat
FROM customcode c, customcode_map m
WHERE c.id=m.code AND m.active IS TRUE
AND (m.sync = ? $goatclause)
ORDER BY m.priority ASC, m.goat IS NULL, c.name ASC
};
$sth = $self->{masterdbh}->prepare($SQL);
$sth->execute($syncname);
## Loop through all customcodes for this sync
for my $c (@{$sth->fetchall_arrayref({})}) {
if ($c->{status} ne 'active') {
$self->glog(qq{ Skipping custom code $c->{id} ($c->{name}): not active }. LOG_NORMAL);
next;
}
$self->glog(qq{ Validating custom code $c->{id} ($c->{whenrun}) (goat=$c->{goat}): $c->{name}}, LOG_WARN);
## Carefully compile the code and catch complications
TRY: {
local $@;
local $_;
$c->{coderef} = eval qq{
package Bucardo::CustomCode;
sub { $c->{src_code} }
}; ## no critic (ProhibitStringyEval)
if ($@) {
$self->glog(qq{Warning! Custom code $c->{id} ($c->{name}) for sync "$syncname" did not compile: $@}, LOG_WARN);
return 0;
};
}
## If this code is run at the goat level, push it to each goat's list of code
if ($c->{goat}) {
my ($goat) = grep { $_->{id}==$c->{goat} } @{$s->{goatlist}};
push @{$goat->{"code_$c->{whenrun}"}}, $c;
if ($c->{whenrun} eq 'exception') {
$goat->{has_exception_code}++;
}
}
else {
push @{$s->{"code_$c->{whenrun}"}}, $c;
## Every goat gets this code
for my $g ( @{$s->{goatlist}} ) {
push @{$g->{"code_$c->{whenrun}"}}, $c;
$g->{has_exception_code}++ if $c->{whenrun} eq 'exception';
}
}
## Some custom code needs database handles - if so, gets one of two types
if ($c->{getdbh}) {
if ($c->{whenrun} eq 'before_txn'
or $c->{whenrun} eq 'after_txn'
or $c->{whenrun} eq 'before_sync'
or $c->{whenrun} eq 'after_sync') {
$s->{need_safe_dbh} = 1;
}
else {
$s->{need_safe_dbh_strict} = 1;
}
}
} ## end checking each custom code
## Go through each goat in this sync, adjusting items and possibly bubbling up info to sync
for my $g (@{$s->{goatlist}}) {
## None of this applies to non-tables
next if $g->{reltype} ne 'table';
## If we didn't find exception custom code above, set it to 0 for this goat
$g->{has_exception_code} ||= 0;
if (!defined $g->{rebuild_index}) {
$g->{rebuild_index} = $s->{rebuild_index};
}
} ## end each goat
## There are things that a fullcopy sync does not do
if ($s->{fullcopy}) {
$s->{track_rates} = 0;
}
## Build our customname hash for use below when checking remote database tables
my %customname;
$SQL = q{SELECT goat,newname,db,COALESCE(db,'') AS db, COALESCE(sync,'') AS sync FROM bucardo.customname};
my $maindbh = $self->{masterdbh};
$sth = $maindbh->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
## Ignore if this is for some other sync
next if length $row->{sync} and $row->{sync} ne $syncname;
$customname{$row->{goat}}{$row->{db}} = $row->{newname};
}
## Go through each table and make sure it exists and matches everywhere
for my $g (@{$s->{goatlist}}) {
## TODO: refactor with work in validate_sync()
$self->glog(qq{ Inspecting source $g->{reltype} "$g->{schemaname}.$g->{tablename}" on database "$sourcename"}, LOG_NORMAL);
## Check the source table, save escaped versions of the names
$sth = $sth{checktable};
$count = $sth->execute(qq{"$g->{schemaname}"."$g->{tablename}"});
if ($count != 1) {
$sth->finish();
my $msg = qq{Could not find $g->{reltype} "$g->{schemaname}"."$g->{tablename}"\n};
$self->glog($msg, LOG_WARN);
warn $msg;
return 0;
}
## Store oid and quoted names for this relation
($g->{oid},$g->{safeschema},$g->{safetable},$g->{safeschemaliteral},$g->{safetableliteral})
= @{$sth->fetchall_arrayref()->[0]};
my ($S,$T) = ($g->{safeschema},$g->{safetable});
## Plunk the oid into a hash for easy lookup below when saving FK information
$s->{tableoid}{$g->{oid}}{name} = "$S.$T";
## Makedelta for this table starts empty
$g->{makedelta} ||= '';
## Determine the conflict method for each goat
## Use the syncs if it has one, otherwise the default
$g->{conflict_strategy} = $s->{conflict_strategy} || $config{default_conflict_strategy};
$self->glog(qq{ Set conflict strategy for $S.$T to "$g->{conflict_strategy}"}, LOG_DEBUG);
## We do this even if g->{code_conflict} exists so it can fall through
my $colinfo;
if ($g->{reltype} eq 'table') {
## Save information about each column in the primary key
if (!defined $g->{pkey} or !defined $g->{qpkey}) {
die "Table $g->{safetable} has no pkey or qpkey - do you need to run validate_goat() on it?\n";
}
## Much of this is used later on, for speed of performing the sync
$g->{pkey} = [split /\|/o => $g->{pkey}];
$g->{qpkey} = [split /\|/o => $g->{qpkey}];
$g->{pkeytype} = [split /\|/o => $g->{pkeytype}];
$g->{numpkcols} = @{$g->{pkey}};
$g->{hasbinarypk} = 0; ## Not used anywhere?
$i = 0;
for (@{$g->{pkey}}) {
$g->{binarypkey}{$i++} = 0;
}
## All pks together for the main delta query
## We change bytea to base64 so we don't have to declare binary args anywhere
$g->{pklist} = '';
for ($i = 0; defined $g->{pkey}[$i]; $i++) {
$g->{pklist} .= sprintf '%s,',
$g->{pkeytype}[$i] eq 'bytea'
? qq{ENCODE("$g->{pkey}[$i]", 'base64')}
: qq{"$g->{pkey}[$i]"};
}
## Remove the final comma:
chop $g->{pklist};
## The name of the delta and track tables for this table
$SQL = 'SELECT bucardo.bucardo_tablename_maker(?)';
$sth = $self->{masterdbh}->prepare($SQL);
$sth->execute($S.'_'.$T);
$g->{makername} = $sth->fetchall_arrayref()->[0][0];
if ($g->{makername} =~ s/"//g) {
$g->{deltatable} = qq{"delta_$g->{makername}"};
$g->{tracktable} = qq{"track_$g->{makername}"};
$g->{stagetable} = qq{"stage_$g->{makername}"};
}
else {
$g->{deltatable} = "delta_$g->{makername}";
$g->{tracktable} = "track_$g->{makername}";
$g->{stagetable} = "stage_$g->{makername}";
}
## Turn off the search path, to help the checks below match up
$srcdbh->do('SET LOCAL search_path = pg_catalog');
## Check the source columns, and save them
$sth = $sth{checkcols};
$sth->execute(qq{"$g->{schemaname}"."$g->{tablename}"});
$colinfo = $sth->fetchall_hashref('attname');
## Allow for 'dead' columns in the attnum ordering
$i = 1;
for (sort { $colinfo->{$a}{attnum} <=> $colinfo->{$b}{attnum} } keys %$colinfo) {
$colinfo->{$_}{realattnum} = $i++;
}
$g->{columnhash} = $colinfo;
## Build lists of columns
$i = 1;
$g->{cols} = [];
$g->{safecols} = [];
COL: for my $colname (sort { $colinfo->{$a}{attnum} <=> $colinfo->{$b}{attnum} } keys %$colinfo) {
## Skip if this column is part of the primary key
for my $pk (@{$g->{pkey}}) {
next COL if $pk eq $colname;
}
push @{$g->{cols}}, $colname;
push @{$g->{safecols}}, $colinfo->{$colname}{qattname};
$colinfo->{$colname}{order} = $i++;
}
## Stringified versions of the above lists, for ease later on
$g->{columnlist} = join ',' => @{$g->{cols}};
$g->{safecolumnlist} = join ',' => @{$g->{safecols}};
## Note which columns are bytea
BCOL: for my $colname (keys %$colinfo) {
my $c = $colinfo->{$colname};
next if $c->{atttypid} != 17; ## Yes, it's hardcoded, no sweat
$i = 0;
for my $pk (@{$g->{pkey}}) {
if ($colname eq $pk) {
$g->{binarypkey}{$i} = 1;
$g->{hasbinarypk} = 1;
next BCOL;
}
$i++;
}
## This is used to bind_param these as binary during inserts and updates
push @{$g->{binarycols}}, $colinfo->{$colname}{order};
}
$srcdbh->do('RESET search_path');
} ## end if reltype is table
my $sourceseq = 1;
#$g->{reltype} eq 'sequence'
# ? $self->get_sequence_info($srcdbh, $S, $T)
# : {};
next if $g->{reltype} ne 'table';
## Verify sequences or tables+columns on remote databases
for my $dbname (sort keys %{ $self->{sdb} }) {
## Only ones for this sync, please
next if ! exists $s->{db}{$dbname};
my $d = $self->{sdb}{$dbname};
next if $d->{role} eq 'source';
## Flat files are obviously skipped as we create them de novo
next if $d->{dbtype} =~ /flat/o;
## Mongo is skipped because it can create schemas on the fly
next if $d->{dbtype} =~ /mongo/o;
## Redis is skipped because we can create keys on the fly
next if $d->{dbtype} =~ /redis/o;
## MySQL/MariaDB/Drizzle/Oracle/SQLite is skipped for now, but should be added later
next if $d->{dbtype} =~ /mysql|mariadb|drizzle|oracle|sqlite/o;
if ($self->{quickstart}) {
$self->glog(" quickstart: Skipping table check for $dbname.$S.$T", LOG_VERBOSE);
next;
}
## Respond to ping here and now for very impatient watchdog programs
$maindbh->commit();
my $nlist = $self->db_get_notices($maindbh);
for my $name (keys %{ $nlist }) {
my $npid = $nlist->{$name}{firstpid};
if ($name eq 'mcp_fullstop') {
$self->glog("Received full stop notice from PID $npid, leaving", LOG_WARN);
$self->cleanup_mcp("Received stop NOTICE from PID $npid");
exit 0;
}
if ($name eq 'mcp_ping') {
$self->glog("Got a ping from PID $npid, issuing pong", LOG_DEBUG);
$self->db_notify($maindbh, 'mcp_pong');
}
}
## Get a handle for the remote database
my $dbh = $d->{dbh};
## If a sequence, verify the information and move on
if ($g->{reltype} eq 'sequenceSKIP') {
my $targetseq = $self->get_sequence_info($dbh, $S, $T);
for my $key (sort keys %$targetseq) {
if (! exists $sourceseq->{$key}) {
$self->glog(qq{Warning! Sequence on target has item $key, but source does not!}, LOG_WARN);
next;
}
if ($targetseq->{$key} ne $sourceseq->{$key}) {
$self->glog("Warning! Sequence mismatch. Source $key=$sourceseq->{$key}, target is $targetseq->{$key}", LOG_WARN);
next;
}
}
next;
} ## end if sequence
## Turn off the search path, to help the checks below match up
$dbh->do('SET LOCAL search_path = pg_catalog');
## Grab column information about this table
$sth = $dbh->prepare($SQL{checkcols});
## Change to the customname if needed
my ($RS,$RT) = ($S,$T);
## We don't need to check if this is a source: this is already targets only
my $using_customname = 0;
if (exists $customname{$g->{id}}) {
## If there is an entry for this particular database, use that
## Otherwise, use the default one
if (exists $customname{$g->{id}}{$dbname} or exists $customname{$g->{id}}{''}) {
$RT = $customname{$g->{id}}{$dbname} || $customname{$g->{id}}{''};
$using_customname = 1;
## If this has a dot, change the schema as well
## Otherwise, we simply use the existing schema
if ($RT =~ s/(.+)\.//) {
$RS = $1;
}
}
}
$self->glog(qq{ Inspecting target $g->{reltype} "$RS.$RT" on database "$dbname"}, LOG_NORMAL);
$sth->execute("$RS.$RT");
my $targetcolinfo = $sth->fetchall_hashref('attname');
## Allow for 'dead' columns in the attnum ordering
$i = 1;
for (sort { $targetcolinfo->{$a}{attnum} <=> $targetcolinfo->{$b}{attnum} } keys %$targetcolinfo) {
$targetcolinfo->{$_}{realattnum} = $i++;
}
$dbh->do('RESET search_path');
$dbh->rollback();
my $t = "$g->{schemaname}.$g->{tablename}";
## We'll state no problems until we are proved wrong
my $column_problems = 0;
## Check each column in alphabetic order
for my $colname (sort keys %$colinfo) {
## Simple var mapping to make the following code sane
my $fcol = $targetcolinfo->{$colname};
my $scol = $colinfo->{$colname};
$self->glog(qq{ Column on target database "$dbname": "$colname" ($scol->{ftype})}, LOG_DEBUG);
## Always fatal: column on source but not target
if (! exists $targetcolinfo->{$colname}) {
$column_problems = 2;
my $msg = qq{Source database for sync "$syncname" has column "$colname" of table "$t", but target database "$dbname" does not};
$self->glog("Warning: $msg", LOG_WARN);
warn $msg;
next;
}
## Almost always fatal: types do not match up
if ($scol->{ftype} ne $fcol->{ftype}) {
## Carve out some known exceptions (but still warn about them)
## Allowed: varchar == text
## Allowed: timestamp* == timestamp*
if (
($scol->{ftype} eq 'character varying' and $fcol->{ftype} eq 'text')
or
($scol->{ftype} eq 'text' and $fcol->{ftype} eq 'character varying')
or
($scol->{ftype} =~ /^timestamp/ and $fcol->{ftype} =~ /^timestamp/)
) {
my $msg = qq{Source database for sync "$syncname" has column "$colname" of table "$t" as type "$scol->{ftype}", but target database "$dbname" has a type of "$fcol->{ftype}". You should really fix that.};
$self->glog("Warning: $msg", LOG_WARN);
}
else {
$column_problems = 2;
my $msg = qq{Source database for sync "$syncname" has column "$colname" of table "$t" as type "$scol->{ftype}", but target database "$dbname" has a type of "$fcol->{ftype}"};
$self->glog("Warning: $msg", LOG_WARN);
next;
}
}
## Fatal in strict mode: NOT NULL mismatch
if ($scol->{attnotnull} != $fcol->{attnotnull}) {
$column_problems ||= 1; ## Don't want to override a setting of "2"
my $msg = sprintf q{Source database for sync "%s" has column "%s" of table "%s" set as %s, but target database "%s" has column set as %s},
$syncname,
$colname,
$t,
$scol->{attnotnull} ? 'NOT NULL' : 'NULL',
$dbname,
$scol->{attnotnull} ? 'NULL' : 'NOT NULL';
$self->glog("Warning: $msg", LOG_WARN);
warn $msg;
}
## Fatal in strict mode: DEFAULT existence mismatch
if ($scol->{atthasdef} != $fcol->{atthasdef}) {
$column_problems ||= 1; ## Don't want to override a setting of "2"
my $msg = sprintf q{Source database for sync "%s" has column "%s" of table "%s" %s, but target database "%s" %s},
$syncname,
$colname,
$t,
$scol->{atthasdef} ? 'with a DEFAULT value' : 'has no DEFAULT value',
$dbname,
$scol->{atthasdef} ? 'has none' : 'does';
$self->glog("Warning: $msg", LOG_WARN);
warn $msg;
}
## Fatal in strict mode: DEFAULT exists but does not match
if ($scol->{atthasdef} and $fcol->{atthasdef} and $scol->{def} ne $fcol->{def}) {
## Make an exception for Postgres versions returning DEFAULT parenthesized or not
## e.g. as "-5" in 8.2 or as "(-5)" in 8.3
my $scol_def = $scol->{def};
my $fcol_def = $fcol->{def};
for ($scol_def, $fcol_def) {
s/\A\(//;
s/\)\z//;
s/\)::/::/;
}
my $msg;
if ($scol_def eq $fcol_def) {
$msg = q{Postgres version mismatch leads to this difference, which is being tolerated: };
}
else {
$column_problems ||= 1; ## Don't want to override a setting of "2"
$msg = '';
}
$msg .= qq{Source database for sync "$syncname" has column "$colname" of table "$t" with a DEFAULT of "$scol->{def}", but target database "$dbname" has a DEFAULT of "$fcol->{def}"};
$self->glog("Warning: $msg", LOG_WARN);
warn $msg;
}
## Fatal in strict mode: order of columns does not match up
if ($scol->{realattnum} != $fcol->{realattnum}) {
$column_problems ||= 1; ## Don't want to override a setting of "2"
my $msg = qq{Source database for sync "$syncname" has column "$colname" of table "$t" at position $scol->{realattnum} ($scol->{attnum}), but target database "$dbname" has it in position $fcol->{realattnum} ($fcol->{attnum})};
$self->glog("Warning: $msg", LOG_WARN);
warn $msg;
}
} ## end each column to be checked
## Fatal in strict mode: extra columns on the target side
for my $colname (sort keys %$targetcolinfo) {
next if exists $colinfo->{$colname};
$column_problems ||= 1; ## Don't want to override a setting of "2"
my $msg = qq{Target database has column "$colname" on table "$t", but source database does not};
$self->glog("Warning: $msg", LOG_WARN);
warn $msg;
}
## Real serious problems always bail out
return 0 if $column_problems >= 2;
## If this is a minor problem, and we are using a customname,
## allow it to pass
$column_problems = 0 if $using_customname;
## If other problems, only bail if strict checking is on both sync and goat
## This allows us to make a sync strict, but carve out exceptions for goats
return 0 if $column_problems and $s->{strict_checking} and $g->{strict_checking};
} ## end each target database
} ## end each goat
## Generate mapping of foreign keys
## This helps us with conflict resolution later on
my $oidlist = join ',' => map { $_->{oid} } @{ $s->{goatlist} };
if ($oidlist) {
## Postgres added the array_agg function in 8.3, so if this is older than that,
## we add our own copy
my $arrayagg = 'array_agg';
if ($srcdbh->{pg_server_version} < 80300) {
## We reset the search_path below, so we need to force the query below to use the public namespace
$arrayagg = 'public.array_agg';
## Searching for the proname rather than the aggregate should be good enough
$SQL = 'SELECT proname FROM pg_proc WHERE proname ~ ?';
$sth = $srcdbh->prepare($SQL);
$count = $sth->execute('array_agg');
$sth->finish();
if ($count < 1) {
$SQL = q{CREATE AGGREGATE array_agg(anyelement) ( SFUNC=array_append, STYPE=anyarray, INITCOND='{}')};
$srcdbh->do($SQL);
}
}
$SQL = qq{SELECT conname,
conrelid, conrelid::regclass,
confrelid, confrelid::regclass,
$arrayagg(a.attname), $arrayagg(z.attname)
FROM pg_constraint c
JOIN pg_attribute a ON (a.attrelid = conrelid AND a.attnum = ANY(conkey))
JOIN pg_attribute z ON (z.attrelid = confrelid AND z.attnum = ANY (confkey))
WHERE contype = 'f'
AND (conrelid IN ($oidlist) OR confrelid IN ($oidlist))
GROUP BY 1,2,3,4,5
};
## We turn off search_path to get fully-qualified relation names
$srcdbh->do('SET LOCAL search_path = pg_catalog');
for my $row (@{ $srcdbh->selectall_arrayref($SQL) }) {
my ($conname, $oid1,$t1, $oid2,$t2, $c1,$c2) = @$row;
## The referenced table is not being tracked in this sync
if (! exists $s->{tableoid}{$oid2}) {
## Nothing to do except report this problem and move on
$self->glog("Table $t1 references $t2($conname), which is not part of this sync!", LOG_NORMAL);
next;
}
## A table referencing us is not being tracked in this sync
if (! exists $s->{tableoid}{$oid1}) {
## Nothing to do except report this problem and move on
$self->glog("Table $t2 is referenced by $t1($conname), which is not part of this sync!", LOG_NORMAL);
next;
}
## Both exist, so tie them together
$s->{tableoid}{$oid1}{references}{$oid2} = [$conname,$c1,$c2];
$s->{tableoid}{$oid2}{referencedby}{$oid1} = [$conname,$c1,$c2];
}
$srcdbh->do('RESET search_path');
$srcdbh->commit();
}
## If autokick, listen for a triggerkick on all source databases
if ($s->{autokick}) {
my $l = "kick_sync_$syncname";
for my $dbname (sort keys %{ $s->{db} }) {
my $d = $s->{db}{$dbname};
next if $d->{status} ne 'active';
$self->glog("Listen for $l on $dbname ($d->{role})", LOG_DEBUG);
next if $d->{role} ne 'source';
my $dbh = $self->{sdb}{$dbname}{dbh};
$self->db_listen($dbh, $l, $dbname, 0);
$dbh->commit;
}
}
## Success!
return 1;
} ## end of validate_sync
sub activate_sync {
## We've got a new sync to be activated (but not started)
## Arguments: one
## 1. Hashref of sync information
## Returns: boolean success/failure
my ($self,$s) = @_;
my $maindbh = $self->{masterdbh};
my $syncname = $s->{name};
## Connect to each database used by this sync and validate tables
if (! $self->validate_sync($s)) {
$self->glog("Validation of sync $s->{name} FAILED", LOG_WARN);
$s->{mcp_active} = 0;
return 0;
}
## If the kids stay alive, the controller must too
if ($s->{kidsalive} and !$s->{stayalive}) {
$s->{stayalive} = 1;
$self->glog('Warning! Setting stayalive to true because kidsalive is true', LOG_WARN);
}
## Mark this sync as active: used in sync kicks/reloads later on
$self->{sync}{$syncname}{mcp_active} = 1;
## Let any listeners know we are done
$self->db_notify($maindbh, "activated_sync_$syncname", 1);
## We don't need to listen for activation requests anymore
$self->db_unlisten($maindbh, "activate_sync_$syncname", '', 1);
## But we do need to listen for deactivate and kick requests
$self->db_listen($maindbh, "deactivate_sync_$syncname", '', 1);
$self->db_listen($maindbh, "kick_sync_$syncname", '', 1);
$self->db_listen($maindbh, "pause_sync_$syncname", '', 1);
$self->db_listen($maindbh, "resume_sync_$syncname", '', 1);
$maindbh->commit();
## Redo our process name to include an updated list of active syncs
my @activesyncs;
for my $syncname (sort keys %{ $self->{sync} }) {
next if ! $self->{sync}{$syncname}{mcp_active};
push @activesyncs, $syncname;
}
## Change our process name to show all active syncs
$0 = "Bucardo Master Control Program v$VERSION.$self->{extraname} Active syncs: ";
$0 .= join ',' => @activesyncs;
return 1;
} ## end of activate_sync
sub deactivate_sync {
## We need to turn off a running sync
## Arguments: one
## 1. Hashref of sync information
## Returns: boolean success/failure
my ($self,$s) = @_;
my $maindbh = $self->{masterdbh};
my $syncname = $s->{name};
## Kill the controller
my $ctl = $s->{controller};
if (!$ctl) {
$self->glog('Warning! Controller not found', LOG_WARN);
}
else {
$count = kill $signumber{USR1} => $ctl;
$self->glog("Sent kill USR1 to CTL process $ctl. Result: $count", LOG_NORMAL);
}
$s->{controller} = 0;
$self->{sync}{$syncname}{mcp_active} = 0;
## Let any listeners know we are done
$self->db_notify($maindbh, "deactivated_sync_$syncname");
## We don't need to listen for deactivation or kick/pause/resume requests
$self->db_unlisten($maindbh, "deactivate_sync_$syncname", '', 1);
$self->db_unlisten($maindbh, "kick_sync_$syncname", '', 1);
$self->db_unlisten($maindbh, "pause_sync_$syncname", '', 1);
$self->db_unlisten($maindbh, "resume_sync_$syncname", '', 1);
## But we do need to listen for an activation request
$self->db_listen($maindbh, "activate_sync_$syncname", '', 1);
$maindbh->commit();
## If we are listening for kicks on the source, stop doing so
for my $dbname (sort keys %{ $self->{sdb} }) {
my $d = $self->{sdb}{$dbname};
next if $d->{dbtype} ne 'postgres';
next if $d->{role} ne 'source';
$d->{dbh} ||= $self->connect_database($dbname);
$d->{dbh}->commit();
if ($s->{autokick}) {
my $l = "kick_sync_$syncname";
$self->db_unlisten($d->{dbh}, $l, $dbname, 0);
$d->{dbh}->commit();
}
}
## Redo our process name to include an updated list of active syncs
my @activesyncs;
for my $syncname (keys %{ $self->{sync} }) {
push @activesyncs, $syncname;
}
$0 = "Bucardo Master Control Program v$VERSION.$self->{extraname} Active syncs: ";
$0 .= join ',' => @activesyncs;
return 1;
} ## end of deactivate_sync
sub fork_controller {
## Fork off a controller process
## Arguments: two
## 1. Hashref of sync information
## 2. The name of the sync
## Returns: undef
my ($self, $s, $syncname) = @_;
my $newpid = $self->fork_and_inactivate('CTL');
if ($newpid) { ## We are the parent
$self->glog(qq{Created controller $newpid for sync "$syncname". Kick is $s->{kick_on_startup}}, LOG_NORMAL);
$s->{controller} = $newpid;
$self->{pidmap}{$newpid} = 'CTL';
## Reset counters for ctl restart via maxkicks and lifetime settings
$s->{ctl_kick_counts} = 0;
$s->{start_time} = time();
return;
}
## We are the kid, aka the new CTL process
## Sleep a hair so the MCP can finish the items above first
sleep 0.05;
## No need to keep information about other syncs around
$self->{sync} = $s;
$self->start_controller($s);
exit 0;
} ## end of fork_controller
sub fork_and_inactivate {
## Call fork, and immediately inactivate open database handles
## Arguments: one
## 1. Type of thing we are forking (VAC, CTL, KID)
## Returns: nothing
my $self = shift;
my $type = shift || '???';
my $newpid = fork;
if (!defined $newpid) {
die qq{Warning: Fork for $type failed!\n};
}
if ($newpid) { ## Parent
## Very slight sleep to increase the chance of something happening to the kid
## before InactiveDestroy is set
sleep 0.1;
}
else { ## Kid
## Walk through the list of all known DBI databases
## Inactivate each one, then undef it
## Change to a better prefix, so 'MCP' does not appear in the logs
$self->{logprefix} = $type;
## It is probably still referenced elsewhere, so handle that - how?
for my $iname (keys %{ $self->{dbhlist} }) {
my $ldbh = $self->{dbhlist}{$iname};
$self->glog("Inactivating dbh $iname post-fork", LOG_DEBUG2);
$ldbh->{InactiveDestroy} = 1;
delete $self->{dbhlist}{$iname};
}
## Now go through common shared database handle locations, and delete them
$self->{masterdbh}->{InactiveDestroy} = 1
if $self->{masterdbh};
delete $self->{masterdbh};
## Clear the 'sdb' structure of any existing database handles
if (exists $self->{sdb}) {
for my $dbname (keys %{ $self->{sdb} }) {
if (exists $self->{sync}{sdb}{$dbname}{dbh}) {
if (ref $self->{sync}{sdb}{$dbname}{dbh}) {
$self->glog("Removing sdb reference to database $dbname", LOG_DEBUG);
$self->{sync}{sdb}{$dbname}{dbh}->{InactiveDestroy} = 1;
}
delete $self->{sync}{sdb}{$dbname}{dbh};
}
}
}
## Clear any sync-specific database handles
if (exists $self->{sync}) {
if (exists $self->{sync}{name}) { ## This is a controller/kid with a single sync
for my $dbname (sort keys %{ $self->{sync}{db} }) {
if (exists $self->{sync}{db}{$dbname}{dbh}) {
if (ref $self->{sync}{db}{$dbname}{dbh}) {
$self->glog("Removing reference to database $dbname", LOG_DEBUG2);
$self->{sync}{db}{$dbname}{dbh}->{InactiveDestroy} = 1;
}
delete $self->{sync}{db}{$dbname}{dbh};
}
}
}
else {
for my $syncname (keys %{ $self->{sync} }) {
for my $dbname (sort keys %{ $self->{sync}{$syncname}{db} }) {
if (exists $self->{sync}{$syncname}{db}{$dbname}{dbh}) {
if (ref $self->{sync}{$syncname}{db}{$dbname}{dbh}) {
$self->glog("Removing reference to database $dbname in sync $syncname", LOG_DEBUG2);
$self->{sync}{$syncname}{db}{$dbname}{dbh}->{InactiveDestroy} = 1;
}
delete $self->{sync}{$syncname}{db}{$dbname}{dbh};
}
}
}
}
}
}
return $newpid;
} ## end of fork_and_inactivate
sub fork_vac {
## Fork off a VAC process
## Arguments: none
## Returns: undef
my $self = shift;
## Fork it off
my $newpid = $self->fork_and_inactivate('VAC');
## Parent MCP just makes a note in the logs and returns
if ($newpid) { ## We are the parent
$self->glog(qq{Created VAC $newpid}, LOG_NORMAL);
$self->{vacpid} = $newpid;
return;
}
## Prefix all log lines with this TLA (was MCP)
$self->{logprefix} = 'VAC';
## Set our process name
$0 = qq{Bucardo VAC.$self->{extraname}};
## Store our PID into a file
## Save the complete returned name for later cleanup
$self->{vacpidfile} = $self->store_pid( 'bucardo.vac.pid' );
## Start normal log output for this controller: basic facts
my $msg = qq{New VAC daemon. PID=$$};
$self->glog($msg, LOG_NORMAL);
## Allow the MCP to signal us (request to exit)
local $SIG{USR1} = sub {
## Do not change this message: looked for in the controller DIE sub
die "MCP request\n";
};
## From this point forward, we want to die gracefully
local $SIG{__DIE__} = sub {
## Arguments: one
## 1. Error message
## Returns: never (exit 0)
my ($diemsg) = @_;
## Store the line that did the actual exception
my $line = (caller)[2];
## Don't issue a warning if this was simply a MCP request
my $warn = ($diemsg =~ /MCP request|Not needed/ ? '' : 'Warning! ');
$self->glog(qq{${warn}VAC was killed at line $line: $diemsg}, $warn ? LOG_WARN :LOG_VERBOSE);
## Not a whole lot of cleanup to do on this one: just shut database connections and leave
$self->{masterdbh}->disconnect() if exists $self->{masterdbhvac};
for my $dbname (keys %{ $self->{sdb} }) {
my $d = $self->{sdb}{$dbname};
if (defined $d->{dbh} and $d->{dbh}) {
$d->{dbh}->disconnect();
}
}
## Remove our pid file
unlink $self->{vacpidfile} or $self->glog("Warning! Failed to unlink $self->{vacpidfile}", LOG_WARN);
exit 0;
}; ## end SIG{__DIE__} handler sub
## Connect to the master database
($self->{master_backend}, $self->{masterdbh}) = $self->connect_database();
$self->{masterdbhvac} = 1;
my $maindbh = $self->{masterdbh};
$self->glog("Bucardo database backend PID: $self->{master_backend}", LOG_VERBOSE);
## Map the PIDs to common names for better log output
$self->{pidmap}{$$} = 'VAC';
$self->{pidmap}{$self->{master_backend}} = 'Bucardo DB';
## Listen for an exit request from the MCP
my $exitrequest = 'stop_vac';
$self->db_listen($maindbh, $exitrequest, '', 1); ## No payloads please
## Commit so we start listening right away
$maindbh->commit();
## Reconnect to all databases we care about
for my $dbname (keys %{ $self->{sdb} }) {
my $d = $self->{sdb}{$dbname};
## We looped through all the syncs earlier to determine which databases
## really need to be vacuumed. The criteria:
## not a fullcopy sync, dbtype is postgres, role is source
next if ! $d->{needsvac};
## Establish a new database handle
($d->{backend}, $d->{dbh}) = $self->connect_database($dbname);
$self->glog(qq{Connected to database "$dbname" with backend PID of $d->{backend}}, LOG_NORMAL);
$self->{pidmap}{$d->{backend}} = "DB $dbname";
## We don't want details about the purging
$d->{dbh}->do(q{SET client_min_messages = 'warning'});
}
## Track how long since we last came to life for vacuuming
my $lastvacrun = 0;
## The main loop
VAC: {
## Bail if the stopfile exists
if (-e $self->{stop_file}) {
$self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_TERSE);
## Do not change this message: looked for in the controller DIE sub
my $stopmsg = 'Found stopfile';
## Grab the reason, if it exists, so we can propagate it onward
my $vacreason = get_reason(0);
if ($vacreason) {
$stopmsg .= ": $vacreason";
}
## This exception is caught by the controller's __DIE__ sub above
die "$stopmsg\n";
}
## Process any notifications from the main database
## Ignore things we may have sent ourselves
my $nlist = $self->db_get_notices($maindbh, $self->{master_backend});
NOTICE: for my $name (sort keys %{ $nlist }) {
my $npid = $nlist->{$name}{firstpid};
## Strip prefix so we can easily use both pre and post 9.0 versions
$name =~ s/^vac_//o;
## Exit request from the MCP?
if ($name eq $exitrequest) {
die "Process $npid requested we exit\n";
}
## Just ignore everything else
} ## end of each notification
## To ensure we can receive new notifications next time:
$maindbh->commit();
## Should we attempt a vacuum?
if (time() - $lastvacrun >= $config{vac_run}) {
$lastvacrun = time();
## If there are no valid backends, we want to stop running entirely
my $valid_backends = 0;
## Kick each one off async
for my $dbname (sort keys %{ $self->{sdb}} ) {
my $d = $self->{sdb}{$dbname};
next if ! $d->{needsvac};
my $dbh = $d->{dbh};
## Safety check: if the bucardo schema is not there, we don't want to vacuum
if (! exists $d->{hasschema}) {
$SQL = q{SELECT count(*) FROM pg_namespace WHERE nspname = 'bucardo'};
$d->{hasschema} = $dbh->selectall_arrayref($SQL)->[0][0];
if (! $d->{hasschema} ) {
$self->glog("Warning! Cannot vacuum db $dbname unless we have a bucardo schema", LOG_WARN);
}
}
## No schema? We've already complained, so skip it silently
next if ! $d->{hasschema};
$valid_backends++;
## Async please
$self->glog(qq{Running bucardo_purge_delta on database "$dbname"}, LOG_VERBOSE);
$SQL = q{SELECT bucardo.bucardo_purge_delta('45 seconds')};
$sth{"vac_$dbname"} = $dbh->prepare($SQL, { pg_async => PG_ASYNC } );
$sth{"vac_$dbname"}->execute();
$d->{async_active} = time;
} ## end each source database
## If we found no backends, we can leave right away, and not run again
if (! $valid_backends) {
$self->glog('No valid backends, so disabling the VAC daemon', LOG_VERBOSE);
$config{bucardo_vac} = 0;
## Caught by handler above
die 'Not needed';
}
## Finish each one up
for my $dbname (sort keys %{ $self->{sdb}} ) {
my $d = $self->{sdb}{$dbname};
## As above, skip if not a source or no schema available
next if ! $d->{needsvac};
next if ! $d->{hasschema};
my $dbh = $d->{dbh};
$self->glog(qq{Finish and fetch bucardo_purge_delta on database "$dbname"}, LOG_DEBUG);
$count = $sth{"vac_$dbname"}->pg_result();
$d->{async_active} = 0;
my $info = $sth{"vac_$dbname"}->fetchall_arrayref()->[0][0];
$dbh->commit();
$self->glog(qq{Purge on db "$dbname" gave: $info}, LOG_VERBOSE);
} ## end each source database
} ## end of attempting to vacuum
sleep $config{vac_sleep};
redo VAC;
} ## end of main VAC loop
exit 0;
} ## end of fork_vac
sub reset_mcp_listeners {
## Unlisten everything, the relisten to specific entries
## Used by reload_mcp()
## Arguments: none
## Returns: undef
my $self = shift;
my $maindbh = $self->{masterdbh};
## Unlisten everything
$self->db_unlisten_all($maindbh);
## Need to commit here to work around Postgres bug!
$maindbh->commit();
## Listen for MCP specific items
for my $l
(
'mcp_fullstop',
'mcp_reload',
'reload_config',
'log_message',
'mcp_ping',
'kid_pid_start',
'kid_pid_stop',
) {
$self->db_listen($maindbh, $l, '', 1);
}
## Listen for sync specific items
for my $syncname (keys %{ $self->{sync} }) {
for my $l
(
'activate_sync',
'deactivate_sync',
'reload_sync',
'kick_sync',
) {
## If the sync is inactive, no sense in listening for anything but activate/reload requests
if ($self->{sync}{$syncname}{status} ne 'active') {
next if $l eq 'deactivate_sync' or $l eq 'kick_sync';
}
else {
## If sync is active, no need to listen for an activate request
next if $l eq 'activate_sync';
}
my $listen = "${l}_$syncname";
$self->db_listen($maindbh, $listen, '', 1);
}
## Listen for controller telling us the sync is done
$self->db_listen($maindbh, "syncdone_$syncname");
}
$maindbh->commit();
return;
} ## end of reset_mcp_listeners
sub reload_mcp {
## Reset listeners, kill kids, load and activate syncs
## Arguments: none
## Returns: number of syncs we activated
my $self = shift;
## Grab a list of all the current syncs from the database and store as objects
$self->{sync} = $self->get_syncs();
## Try and restore any stalled syncs
$self->restore_syncs();
## This unlistens any old syncs
$self->reset_mcp_listeners();
## Stop any kids that currently exist
## First, we loop through the PID directory and signal all CTL processes
## These should in turn remove their kids
$self->signal_pid_files('ctl');
## Next, we signal any KID processes that are still around
$self->signal_pid_files('kid');
## Next we use dbrun to see if any database connections are still active
## First, a brief sleep to allow things to catch up
sleep 0.5;
$self->terminate_old_goats();
my $maindbh = $self->{masterdbh};
## At this point, we are authoritative, so we can safely clean out the syncrun table
$SQL = q{
UPDATE bucardo.syncrun
SET status=?, ended=now()
WHERE ended IS NULL
};
$sth = $maindbh->prepare($SQL);
my $cleanmsg = "Old entry ended (MCP $$)";
$count = $sth->execute($cleanmsg);
$maindbh->commit();
if ($count >= 1) {
$self->glog("Entries cleaned from the syncrun table: $count", LOG_NORMAL);
}
$SQL = q{DELETE FROM bucardo.dbrun};
$maindbh->do($SQL);
$self->glog(('Loading sync table. Rows=' . (scalar (keys %{ $self->{sync} }))), LOG_VERBOSE);
## Load each sync in alphabetical order
my @activesyncs;
for (sort keys %{ $self->{sync} }) {
my $s = $self->{sync}{$_};
my $syncname = $s->{name};
## Note that the mcp has changed this sync
$s->{mcp_changed} = 1;
## Reset some boolean flags for this sync
$s->{mcp_active} = $s->{kick_on_startup} = $s->{controller} = 0;
## If this sync is not active or stalled, don't bother going any further
if ($s->{status} ne 'active' and $s->{status} ne 'stalled') {
$self->glog(qq{Skipping sync "$syncname": status is "$s->{status}"}, LOG_TERSE);
next;
}
## If we are doing specific syncs, check the name
if (exists $self->{dosyncs}) {
if (! exists $self->{dosyncs}{$syncname}) {
$self->glog(qq{Skipping sync "$syncname": not explicitly named}, LOG_VERBOSE);
next;
}
$self->glog(qq{Activating sync "$syncname": explicitly named}, LOG_VERBOSE);
}
else {
$self->glog(qq{Activating sync "$syncname"}, LOG_NORMAL);
}
## Activate this sync!
$s->{mcp_active} = 1;
if (! $self->activate_sync($s)) {
$s->{mcp_active} = 0;
}
# If it was successfully activated, push it on the queue
push @activesyncs, $syncname if $s->{mcp_active};
} ## end each sync
## Change our process name, and list all active syncs
$0 = "Bucardo Master Control Program v$VERSION.$self->{extraname} Active syncs: ";
$0 .= join ',' => @activesyncs;
my $count = @activesyncs;
return $count;
} ## end of reload_mcp
sub cleanup_mcp {
## MCP is shutting down, so we:
## - disconnect from the database
## - attempt to kill any controller kids
## - send a final NOTIFY
## - remove our own PID file
## Arguments: one
## 1. String with a reason for exiting
## Returns: undef
my ($self,$exitreason) = @_;
## Rollback and disconnect from the master database if needed
if ($self->{masterdbh}) {
$self->{masterdbh}->rollback();
$self->{masterdbh}->disconnect();
}
## Reconnect to the master database for some final cleanups
my ($finalbackend,$finaldbh) = $self->connect_database();
$self->glog("Final database backend PID: $finalbackend", LOG_VERBOSE);
## Sleep a bit to let the processes clean up their own pid files
sleep 1.5;
## We know we are authoritative for all pid files in the piddir
## Use those to kill any open processes that we think are still bucardo related
my $piddir = $config{piddir};
opendir my $dh, $piddir or die qq{Could not opendir "$piddir" $!\n};
## As before, we only worry about certain files,
## even though nothing else should be in there
my @pidfiles2 = grep { /^bucardo.*\.pid$/ } readdir $dh;
closedir $dh or warn qq{Could not closedir "$piddir": $!\n};
## For each file, attempt to kill the process it refers to
for my $pidfile (sort @pidfiles2) {
next if $pidfile eq 'bucardo.mcp.pid'; ## That's us!
my $pfile = File::Spec->catfile( $piddir => $pidfile );
if (-e $pfile) {
$self->glog("Trying to kill stale PID file $pidfile", LOG_DEBUG);
my $result = $self->kill_bucardo_pidfile($pfile);
if ($result == -4) { ## kill 0 indicates that PID is no more
$self->glog("PID from $pidfile is gone, removing file", LOG_NORMAL);
unlink $pfile;
}
}
}
## Gather system and database timestamps, output them to the logs
my $end_systemtime = scalar localtime;
my $end_dbtime = eval { $finaldbh->selectcol_arrayref('SELECT now()')->[0] } || 'unknown';
$self->glog(qq{End of cleanup_mcp. Sys time: $end_systemtime. Database time: $end_dbtime}, LOG_TERSE);
## Let anyone listening know we have stopped
$self->db_notify($finaldbh, 'stopped', 1) if $end_dbtime ne 'unknown';
$finaldbh->disconnect();
## For the very last thing, remove our own PID file
if (unlink $self->{pid_file}) {
$self->glog(qq{Removed pid file "$self->{pid_file}"}, LOG_DEBUG);
}
else {
$self->glog("Warning! Failed to remove pid file $self->{pid_file}", LOG_WARN);
}
return;
} ## end of cleanup_mcp
sub terminate_old_goats {
## Uses the dbrun table to see if any existing connections are still active
## This can happen if a KID is killed but a large COPY is still going on
## Arguments: one
## 1. Optional sync name to limit the reaping to
## Returns: number of backends successfully terminated
my $self = shift;
my $sync = shift || '';
my $maindbh = $self->{masterdbh};
## Grab all backends in the tbale
$SQL = 'SELECT * FROM bucardo.dbrun WHERE pgpid IS NOT NULL';
## Just for one sync if that was passed in
if ($sync) {
$SQL .= ' AND sync = ' . $maindbh->quote($sync);
}
$sth = $maindbh->prepare($SQL);
$sth->execute();
## Create a hash with the names of the databases as the first-level keys,
## and the process ids as the second-level keys.
my %dbpid;
for my $row (@{ $sth->fetchall_arrayref({}) }) {
$dbpid{$row->{dbname}}{$row->{pgpid}} = $row->{started};
}
## Use pg_stat_activity to find a match, then terminate it
my $pidcol = $maindbh->{pg_server_version} >= 90200 ? 'pid' : 'procpid';
$SQL = "SELECT 1 FROM pg_stat_activity WHERE $pidcol = ? AND query_start = ?";
my $SQLC = 'SELECT pg_cancel_backend(?)';
my $total = 0;
for my $dbname (sort keys %{ $self->{sdb} }) {
my $d = $self->{sdb}{$dbname};
## All of this is very Postgres specific
next if $d->{dbtype} ne 'postgres';
## Loop through each backend PID found for this database
for my $pid (sort keys %{ $dbpid{$dbname} }) {
my $time = $dbpid{$dbname}{$pid};
$sth = $d->{dbh}->prepare($SQL);
## See if the process is still around by matching PID and query_start time
$count = $sth->execute($pid, $time);
$sth->finish();
## If no match, silently move on
next if $count < 1;
## If we got a match, try and kill it
$sth = $d->{dbh}->prepare($SQLC);
$count = $sth->execute($pid);
my $res = $count < 1 ? 'failed' : 'ok';
$self->glog("Attempted to kill backend $pid on db $dbname, started $time. Result: $res", LOG_NORMAL);
## We are going to count both failed and ok as the same for the return number
$total += $count;
}
}
return $total;
} ## end of terminate_old_goats
sub kill_bucardo_pidfile {
## Given a file, extract the PID and kill it
## Arguments: 2
## 1. File to be checked
## 2. String either 'strict' or not. Strict does TERM and KILL in addition to USR1
## Returns: same as kill_bucardo_pid, plus:
## -100: File not found
## -101: Could not open the file
## -102: No PID found in the file
my ($self,$file,$strength) = @_;
## Make sure the file supplied exists!
if (! -e $file) {
$self->glog(qq{Failed to find PID file "$file"}, LOG_VERBOSE);
return -100;
}
## Try and open the supplied file
my $fh;
if (! open $fh, '<', $file) {
$self->glog(qq{Failed to open PID file "$file": $!}, LOG_VERBOSE);
return -101;
}
## Try and extract the numeric PID from inside of it
## Should be the only thing on the first line
if (<$fh> !~ /(\d+)/) {
$self->glog(qq{Failed to find a PID in the file PID "$file"}, LOG_TERSE);
close $fh or warn qq{Could not close "$file": $!};
return -102;
}
## Close the file and call another method to do the dirty work
close $fh or warn qq{Could not close "$file": $!};
return $self->kill_bucardo_pid($1 => $strength);
} ## end of kill_bucardo_pidfile
sub kill_bucardo_pid {
## Send a kill signal to a specific process
## Arguments: two
## 1. PID to be killed
## 2. String either 'strict' or not. Strict does KILL and TERM in addition to USR1
## Returns: 1 on successful kill, < 0 otherwise
## 0: no such PID or not a 'bucardo' PID
## +1 : successful TERM
## -1: Failed to signal with USR1
## +2: Successful KILL
## -2: Failed to signal with TERM and KILL
## -3: Invalid PID (non-numeric)
## -4: PID does not exist
my ($self,$pid,$nice) = @_;
$self->glog("Attempting to kill PID $pid", LOG_VERBOSE);
## We want to confirm this is still a Bucardo process
## The most portable way at the moment is a plain ps -p
## Windows users are on their own
## If the PID is not numeric, throw a warning and return
if ($pid !~ /^\d+$/o) {
$self->glog("Warning: invalid PID supplied to kill_bucardo_pid: $pid", LOG_WARN);
return -3;
}
## Make sure the process is still around
## If not, log it and return
if (! kill(0 => $pid) ) {
$self->glog("Process $pid did not respond to a kill 0", LOG_NORMAL);
return -4;
}
## It's nice to do some basic checks when possible that these are Bucardo processes
## For non Win32 boxes, we can try a basic ps
## If no header line, drive on
## If command is not perl, skip it!
## If args is not perl or bucardo, skip it
if ($^O !~ /Win/) {
my $COM = "ps -p $pid -o comm,args";
my $info = qx{$COM};
if ($info !~ /^COMMAND/) {
$self->glog(qq{Could not determine ps information for pid $pid}, LOG_VERBOSE);
}
elsif ($info !~ /\bbucardo\s+/oi) {
$self->glog(qq{Will not kill process $pid: ps args is not 'Bucardo', got: $info}, LOG_TERSE);
return 0;
}
} ## end of trying ps because not Windows
## At this point, we've done due diligence and can start killing this pid
## Start with a USR1 signal
$self->glog("Sending signal $signumber{USR1} to pid $pid", LOG_DEBUG);
$count = kill $signumber{USR1} => $pid;
if ($count >= 1) {
$self->glog("Successfully signalled pid $pid with kill USR1", LOG_DEBUG);
return 1;
}
## If we are not strict, we are done
if ($nice ne 'strict') {
$self->glog("Failed to USR1 signal pid $pid", LOG_TERSE);
return -1;
}
$self->glog("Sending signal $signumber{TERM} to pid $pid", LOG_DEBUG);
$count = kill $signumber{TERM} => $pid;
if ($count >= 1) {
$self->glog("Successfully signalled pid $pid with kill TERM", LOG_DEBUG);
return 1;
}
$self->glog("Failed to TERM signal pid $pid", LOG_TERSE);
## Raise the stakes and issue a KILL signal
$self->glog("Sending signal $signumber{KILL} to pid $pid", LOG_DEBUG);
$count = kill $signumber{KILL} => $pid;
if ($count >= 1) {
$self->glog("Successfully signalled pid $pid with kill KILL", LOG_DEBUG);
return 2;
}
$self->glog("Failed to KILL signal pid $pid", LOG_TERSE);
return -2;
} ## end of kill_bucardo_pid
sub signal_pid_files {
## Finds the pid in all matching pid files, and signals with USR1
## Arguments: 1
## 1. String to match the file inside the PID directory with
## Returns: number successfully signalled
my ($self,$string) = @_;
my $signalled = 0;
## Open the directory that contains our PID files
my $piddir = $config{piddir};
opendir my $dh, $piddir or die qq{Could not opendir "$piddir": $!\n};
my ($name, $fh);
while (defined ($name = readdir($dh))) {
## Skip unless it's a matched file
next if index($name, $string) < 0;
$self->glog(qq{Attempting to signal PID from file "$name"}, LOG_TERSE);
## File must be readable
my $cfile = File::Spec->catfile( $piddir => $name );
if (! open $fh, '<', $cfile) {
$self->glog(qq{Could not open $cfile: $!}, LOG_WARN);
next;
}
## File must contain a number (the PID)
if (<$fh> !~ /(\d+)/) {
$self->glog(qq{Warning! File "$cfile" did not contain a PID!}, LOG_WARN);
next;
}
my $pid = $1; ## no critic (ProhibitCaptureWithoutTest)
close $fh or warn qq{Could not close "$cfile": $!\n};
## No sense in doing deeper checks that this is still a Bucardo process,
## as a USR1 should be a pretty harmless signal
$count = kill $signumber{USR1} => $pid;
if ($count != 1) {
$self->glog(qq{Failed to signal $pid with USR1}, LOG_WARN);
}
else {
$signalled++;
}
} ## end each file in the pid directory
closedir $dh or warn qq{Warning! Could not closedir "$piddir": $!\n};
return $signalled;
} ## end of signal_pid_files
sub cleanup_controller {
## Controller is shutting down
## Disconnect from the database
## Attempt to kill any kids
## Remove our PID file
## Arguments: two
## 1. Exited normally? (0 or 1)
## 2. Reason for leaving
## Return: undef
my ($self,$normalexit,$reason) = @_;
if (exists $self->{cleanexit}) {
$reason = 'Normal exit';
}
## Disconnect from the master database
if ($self->{masterdbh}) {
## Ask all kids to exit as well
my $exitname = "kid_stopsync_$self->{syncname}";
$self->{masterdbh}->rollback();
$self->db_notify($self->{masterdbh}, $exitname);
# Quick debug to find active statement handles
# for my $s (@{$self->{masterdbh}{ChildHandles}}) {
# next if ! ref $s or ! $s->{Active};
# $self->glog(Dumper $s->{Statement}, LOG_NORMAL);
#}
$self->{masterdbh}->rollback();
$self->{masterdbh}->disconnect();
}
## Sleep a bit to let the processes clean up their own pid files
sleep 0.5;
## Kill any kids who have a pid file for this sync
## By kill, we mean "send a friendly USR1 signal"
my $piddir = $config{piddir};
opendir my $dh, $piddir or die qq{Could not opendir "$piddir" $!\n};
my @pidfiles = readdir $dh;
closedir $dh or warn qq{Could not closedir "$piddir": $!\n};
for my $pidfile (sort @pidfiles) {
my $sname = $self->{syncname};
next unless $pidfile =~ /^bucardo\.kid\.sync\.$sname\.?.*\.pid$/;
my $pfile = File::Spec->catfile( $piddir => $pidfile );
if (open my $fh, '<', $pfile) {
my $pid = <$fh>;
close $fh or warn qq{Could not close "$pfile": $!\n};
if (! defined $pid or $pid !~ /^\d+$/) {
$self->glog("Warning: no PID found in file, so removing $pfile", LOG_TERSE);
unlink $pfile;
}
else {
kill $signumber{USR1} => $pid;
$self->glog("Sent USR1 signal to kid process $pid", LOG_VERBOSE);
}
}
else {
$self->glog("Warning: could not open file, so removing $pfile", LOG_TERSE);
unlink $pfile;
}
}
$self->glog("Controller $$ exiting at cleanup_controller. Reason: $reason", LOG_TERSE);
## Remove the pid file
if (unlink $self->{ctlpidfile}) {
$self->glog(qq{Removed pid file "$self->{ctlpidfile}"}, LOG_DEBUG);
}
else {
$self->glog("Warning! Failed to remove pid file $self->{ctlpidfile}", LOG_WARN);
}
## Reconnect and clean up the syncrun table
my ($finalbackend, $finaldbh) = $self->connect_database();
$self->glog("Final database backend PID: $finalbackend", LOG_VERBOSE);
## Need to make this one either lastgood or lastbad
## In theory, this will never set lastgood
$self->end_syncrun($finaldbh, $normalexit ? 'good' : 'bad',
$self->{syncname}, "Ended (CTL $$)");
$finaldbh->commit();
$finaldbh->disconnect();
$self->glog('Made final adjustment to the syncrun table', LOG_DEBUG);
return;
} ## end of cleanup_controller
sub end_syncrun {
## End the current syncrun entry, and adjust lastgood/lastbad/lastempty as needed
## If there is no null ended for this sync, does nothing
## Does NOT commit
## Arguments: four
## 1. The database handle to use
## 2. How did we exit ('good', 'bad', or 'empty')
## 3. The name of the sync
## 4. The new status to put
## Returns: undef
my ($self, $ldbh, $exitmode, $syncname, $status) = @_;
## Which column are we changing?
my $lastcol =
$exitmode eq 'good' ? 'lastgood' :
$exitmode eq 'bad' ? 'lastbad' :
$exitmode eq 'empty' ? 'lastempty' :
die qq{Invalid exitmode "$exitmode"};
## Make sure we have something to update
$SQL = q{
SELECT ctid
FROM bucardo.syncrun
WHERE sync = ?
AND ended IS NULL};
$sth = $ldbh->prepare($SQL);
$count = $sth->execute($syncname);
if ($count < 1) {
$sth->finish();
return;
}
if ($count > 1) {
$self->glog("Expected one row from end_syncrun, but got $count", LOG_NORMAL);
}
my $ctid = $sth->fetchall_arrayref()->[0][0];
## Remove the previous 'last' entry, if any
$SQL = qq{
UPDATE bucardo.syncrun
SET $lastcol = 'false'
WHERE $lastcol IS TRUE
AND sync = ?
};
$sth = $ldbh->prepare($SQL);
$sth->execute($syncname);
## End the current row, and elevate it to a 'last' position
$SQL = qq{
UPDATE bucardo.syncrun
SET $lastcol = 'true', ended=now(), status=?
WHERE ctid = ?
};
$sth = $ldbh->prepare($SQL);
$sth->execute($status, $ctid);
return;
} ## end of end_syncrun
sub run_ctl_custom_code {
## Arguments: four
## 1. Sync object
## 2. Input object
## 2. Hashref of customcode information
## 3. Strictness boolean, defaults to false
## 4. Number of attempts, defaults to 0
## Returns: string indicating what to do, one of:
## 'next'
## 'redo'
## 'normal'
my $self = shift;
my $sync = shift;
my $input = shift;
my $c = shift;
my $strictness = shift || '';
my $attempts = shift || 0;
$self->glog("Running $c->{whenrun} controller custom code $c->{id}: $c->{name}", LOG_NORMAL);
my $cc_sourcedbh;
if (!defined $sync->{safe_sourcedbh}) {
$cc_sourcedbh = $self->connect_database($sync->{sourcedb});
my $darg;
for my $arg (sort keys %{ $dbix{source}{notstrict} }) {
next if ! length $dbix{source}{notstrict}{$arg};
$darg->{$arg} = $dbix{source}{notstrict}{$arg};
}
$darg->{dbh} = $cc_sourcedbh;
$sync->{safe_sourcedbh} = DBIx::Safe->new($darg);
}
$input = {
sourcedbh => $sync->{safe_sourcedbh},
syncname => $sync->{name},
goatlist => $sync->{goatlist},
rellist => $sync->{goatlist},
sourcename => $sync->{sourcedb},
targetname => '',
message => '',
warning => '',
error => '',
nextcode => '',
endsync => '',
};
$self->{masterdbh}->{InactiveDestroy} = 1;
$cc_sourcedbh->{InactiveDestroy} = 1;
local $_ = $input;
$c->{coderef}->($input);
$self->{masterdbh}->{InactiveDestroy} = 0;
$cc_sourcedbh->{InactiveDestroy} = 0;
$self->glog("Finished custom code $c->{name}", LOG_VERBOSE);
if (length $input->{message}) {
$self->glog("Message from $c->{whenrun} code $c->{name}: $input->{message}", LOG_TERSE);
}
if (length $input->{warning}) {
$self->glog("Warning! Code $c->{whenrun} $c->{name}: $input->{warning}", LOG_WARN);
}
if (length $input->{error}) {
$self->glog("Warning! Code $c->{whenrun} $c->{name}: $input->{error}", LOG_WARN);
die "Code $c->{whenrun} $c->{name} error: $input->{error}";
}
if (length $input->{nextcode}) { ## Mostly for conflict handlers
return 'next';
}
if (length $input->{endsync}) {
$self->glog("Code $c->{whenrun} requests a cancellation of the rest of the sync", LOG_TERSE);
## before_txn and after_txn only should commit themselves
$cc_sourcedbh->rollback();
$self->{masterdbh}->commit();
sleep $config{endsync_sleep};
return 'redo';
}
return 'normal';
} ## end of run_ctl_custom_code
sub create_newkid {
## Fork and create a KID process
## Arguments: one
## 1. Hashref of sync information ($self->{sync}{$syncname})
## Returns: PID of new process
my ($self, $kidsync) = @_;
## Just in case, ask any existing kid processes to exit
$self->db_notify($self->{masterdbh}, "kid_stopsync_$self->{syncname}");
## Sleep a hair so we don't have the newly created kid get the message above
# sleep 1;
## Fork off a new process which will become the KID
my $newkid = $self->fork_and_inactivate('KID');
if ($newkid) { ## We are the parent
my $msg = sprintf q{Created new kid %s for sync "%s"},
$newkid, $self->{syncname};
$self->glog($msg, LOG_VERBOSE);
## Map this PID to a name for CTL use elsewhere
$self->{pidmap}{$newkid} = 'KID';
sleep $config{ctl_createkid_time};
return $newkid;
}
## At this point, this is the kid. Make sure we do not inherit the CTL error handler:
$SIG{__DIE__} = undef;
## Create the kid process
$self->start_kid($kidsync);
exit 0;
} ## end of create_newkid
sub get_deadlock_details {
## Given a database handle, extract deadlock details from it
## Arguments: two
## 1. Database handle
## 2. Database error string
## Returns: detailed string, or an empty one
my ($self, $dldbh, $dlerr) = @_;
return '' unless $dlerr =~ /Process \d+ waits for /;
return '' unless defined $dldbh and $dldbh;
$dldbh->rollback();
my $pid = $dldbh->{pg_pid};
while ($dlerr =~ /Process (\d+) waits for (.+) on relation (\d+) of database (\d+); blocked by process (\d+)/g) {
next if $1 == $pid;
my ($process,$locktype,$relation) = ($1,$2,$3);
## Fetch the relation name
my $getname = $dldbh->prepare(q{SELECT nspname||'.'||relname FROM pg_class c, pg_namespace n ON (n.oid=c.relnamespace) WHERE c.oid = ?});
$getname->execute($relation);
my $relname = $getname->fetchall_arrayref()->[0][0];
my $clock_timestamp = $dldbh->{pg_server_version} >= 80200
? 'clock_timestamp()' : 'timeofday()::timestamptz';
## Fetch information about the conflicting process
my $pidcol = $dldbh->{pg_server_version} >= 90200 ? 'pid' : 'procpid';
my $queryinfo =$dldbh->prepare(qq{
SELECT
current_query AS query,
datname AS database,
TO_CHAR($clock_timestamp, 'HH24:MI:SS (YYYY-MM-DD)') AS current_time,
TO_CHAR(backend_start, 'HH24:MI:SS (YYYY-MM-DD)') AS backend_started,
TO_CHAR($clock_timestamp - backend_start, 'HH24:MI:SS') AS backend_age,
CASE WHEN query_start IS NULL THEN '?' ELSE
TO_CHAR(query_start, 'HH24:MI:SS (YYYY-MM-DD)') END AS query_started,
CASE WHEN query_start IS NULL THEN '?' ELSE
TO_CHAR($clock_timestamp - query_start, 'HH24:MI:SS') END AS query_age,
COALESCE(host(client_addr)::text,''::text) AS ip,
CASE WHEN client_port <= 0 THEN 0 ELSE client_port END AS port,
usename AS user
FROM pg_stat_activity
WHERE $pidcol = ?
});
$queryinfo->execute($process);
my $q = $queryinfo->fetchall_arrayref({})->[0];
my $ret = qq{Deadlock on "$relname"\nLocktype: $locktype\n};
if (defined $q) {
$ret .= qq{Blocker PID: $process $q->{ip} Database: $q->{database} User: $q->{user}\n}.
qq{Query: $q->{query}\nQuery started: $q->{query_started} Total time: $q->{query_age}\n}.
qq{Backend started: $q->{backend_started} Total time: $q->{backend_age}\n};
}
return $ret;
}
return;
} ## end of get_deadlock_details
sub cleanup_kid {
## Kid is shutting down
## Remove our PID file
## Arguments: two
## 1. Reason for leaving
## 2. Extra information
## Returns: undef
my ($self,$reason,$extrainfo) = @_;
$self->glog("Kid $$ exiting at cleanup_kid. $extrainfo Reason: $reason", LOG_TERSE);
## Remove the pid file, but only if it has our PID in it!
my $file = $self->{kidpidfile};
my $fh;
if (! open my $fh, '<', $file) {
$self->glog("Warning! Could not find pid file $file", LOG_WARN);
}
elsif (<$fh> !~ /(\d+)/) {
$self->glog("Warning! File $file did not contain a PID", LOG_WARN);
}
else {
my $oldpid = $1;
if ($$ !~ $oldpid) {
$self->glog("File $file contained foreign PID $oldpid, so will not remove", LOG_WARN);
}
elsif (unlink $file) {
$self->glog(qq{Removed pid file $file}, LOG_DEBUG);
}
else {
$self->glog("Warning! Failed to remove pid file $file", LOG_WARN);
}
}
return;
} ## end of cleanup_kid
sub store_pid {
## Store the PID of the current process somewhere (e.g. local disk)
## Arguments: one
## 1. Name of the file
## Returns: complete name of the file, with directory
my $self = shift;
my $file = shift or die;
## Put this file into our pid directory
my $pidfile = File::Spec->catfile( $config{piddir} => $file );
## Check for and remove old processes
my $oldpid = '?';
if (-e $pidfile) {
## Send the PID in the file a USR1. If we did so, sleep a little bit
## to allow that process to clean itself up
$self->signal_pid_files($pidfile) and sleep 1;
if (-e $pidfile) {
$self->glog("Overwriting $pidfile: old process was $oldpid", LOG_NORMAL);
}
}
## Overwrite anything that is already there
open my $pidfh, '>', $pidfile or die qq{Cannot write to $pidfile: $!\n};
print {$pidfh} "$$\n";
close $pidfh or warn qq{Could not close "$pidfile": $!\n};
$self->glog("Created $pidfile", LOG_DEBUG);
return $pidfile;
} ## end of store_pid
sub table_has_rows {
## See if the given table has any rows or not
## Arguments: two
## 1. Target database object (contains dbtype and possibly dbh)
## 2. Name of the table
## Returns: true or false
my ($self,$d,$tname) = @_;
## Some types do not have a count
return 0 if $d->{does_append_only};
if ($d->{does_limit}) {
$SQL = "SELECT 1 FROM $tname LIMIT 1";
$sth = $d->{dbh}->prepare($SQL);
$sth->execute();
$count = $sth->rows();
$sth->finish();
return $count >= 1 ? 1 : 0;
}
elsif ('mongo' eq $d->{dbtype}) {
my $collection = $d->{dbh}->get_collection($tname);
$count = $collection->count({});
return $count >= 1 ? 1 : 0;
}
elsif ('oracle' eq $d->{dbtype}) {
$SQL = "SELECT 1 FROM $tname WHERE rownum > 1";
$sth = $d->{dbh}->prepare($SQL);
$sth->execute();
$count = $sth->rows();
$sth->finish();
return $count >= 1 ? 1 : 0;
}
elsif ('redis' eq $d->{dbtype}) {
## No sense in returning anything here
return 0;
}
else {
die "Cannot handle database type $d->{dbtype} yet!";
}
return 0;
} ## end of table_has_rows
sub get_sequence_info {
## Get sequence information
## Not technically MVCC but good enough for our purposes
## Arguments: five
## 1. Database handle
## 2. Schema name
## 3. Sequence name
## 4. (optional) Name of the sync
## 5. (optional) Target database name
## Returns: hashref of information
## If five arguments are given, look up the "old" information in bucardo_sequences
## With only three arguments, pull directly from the sequence
return; ## XXX sequence work
my ($self,$ldbh,$schemaname,$seqname,$syncname,$targetname) = @_;
if (defined $syncname) {
## Pull "old" sequence information. May be empty.
$SQL = "SELECT $sequence_columns FROM bucardo.bucardo_sequences "
. ' WHERE schemaname=? AND seqname = ? AND syncname=? AND targetname=?';
$sth = $ldbh->prepare($SQL);
$sth->execute($schemaname,$seqname, $syncname, $targetname);
}
else {
## Pull directly from a named sequence
$SQL = "SELECT $sequence_columns FROM $schemaname.$seqname";
$sth = $ldbh->prepare($SQL);
$sth->execute();
}
return $sth->fetchall_arrayref({})->[0];
} ## end of get_sequence_info
sub adjust_sequence {
## Adjusts all sequences as needed using a "winning" source database sequence
## If changed, update the bucardo_sequences table
## Arguments: four
## 1. goat object (which contains 'winning_db' and 'sequenceinfo')
## 2. sync object
## 2. Schema name
## 3. Sequence name
## 4. Name of the current sync
## Returns: number of changes made for this sequence
my ($self,$g,$sync,$S,$T,$syncname) = @_;
## Total changes made across all databases
my $changes = 0;
my $winner = $g->{winning_db};
my $sourceinfo = $g->{sequenceinfo}{$winner};
## Walk through all Postgres databases and set the sequence
for my $dbname (sort keys %{ $sync->{db} }) {
next if $dbname eq $winner; ## Natch
my $d = $sync->{db}{$dbname};
next if $d->{dbtype} ne 'postgres';
next if ! $d->{adjustsequence};
## Reset the flag in case this sub is called more than once
$d->{adjustsequence} = 0;
my $targetinfo = $g->{sequenceinfo}{$dbname} || {};
## First, change things up via SETVAL if needed
if (! exists $targetinfo->{last_value}
or
$sourceinfo->{last_value} != $targetinfo->{last_value}
or
$sourceinfo->{is_called} != $targetinfo->{is_called}) {
$self->glog("Set sequence $dbname.$S.$T to $sourceinfo->{last_value} (is_called to $sourceinfo->{is_called})",
LOG_DEBUG);
$SQL = qq{SELECT setval('$S.$T', $sourceinfo->{last_value}, '$sourceinfo->{is_called}')};
$d->{dbh}->do($SQL);
$changes++;
}
## Then, change things up via ALTER SEQUENCE if needed
my @alter;
for my $col (@sequence_columns) {
my ($name,$syntax) = @$col;
## Skip things not set by ALTER SEQUENCE
next if ! $syntax;
## Older versions may not have all the fields!
next if ! exists $sourceinfo->{$name} or ! exists $targetinfo->{$name};
## Skip if these items are the exact same
next if $sourceinfo->{$name} eq $targetinfo->{$name};
## Fullcopy will not have this, and we won't report it
if (exists $targetinfo->{$name}) {
$self->glog("Sequence $S.$T has a different $name value: was $targetinfo->{$name}, now $sourceinfo->{$name}", LOG_VERBOSE);
}
## If this is a boolean setting, we want to simply prepend a 'NO' for false
if ($syntax =~ s/BOOL //) {
push @alter => sprintf '%s%s',
$sourceinfo->{$name} ? '' : 'NO ',
$syntax;
}
else {
push @alter => "$syntax $sourceinfo->{$name}";
}
$changes++;
} ## end each sequence column
if (@alter) {
$SQL = "ALTER SEQUENCE $S.$T ";
$SQL .= join ' ' => @alter;
$self->glog("Running on target $dbname: $SQL", LOG_DEBUG);
$d->{dbh}->do($SQL);
}
} ## end each database
return $changes;
} ## end of adjust_sequence
sub run_kid_custom_code {
## Prepare and then run the custom code subroutine
## Arguments: two
## 1. Sync information
## 2. This code information
## Returns: status code, one of 'redo', 'last', 'retry', or 'normal'
## May also throw an exception if the calling code requests it
my $self = shift;
my $sync = shift;
my $c = shift;
$self->glog("Running $c->{whenrun} custom code $c->{id}: $c->{name}", LOG_NORMAL);
## Allow the caller to maintain some state by providing a hash
if (! exists $self->{kid_customcode_shared}) {
$self->{kid_customcode_shared} = {};
}
## Create a hash of information common to all customcodes
my $info = {
rows => $sync->{deltarows},
syncname => $sync->{name},
version => $self->{version}, ## Version of Bucardo
message => '', ## Allows the code to send a message to the logs
warning => '', ## Allows a warning to be thrown by the code
error => '', ## Allows an exception to be thrown by the code
skip => '', ## Tells the caller to skip this code
lastcode => '', ## Tells the caller to skip any other codes of this type
endsync => '', ## Tells the caller to cancel the whole sync
sendmail => sub { $self->send_mail(@_) },
shared => $self->{kid_customcode_shared},
};
## Add in any items custom to this code
if (exists $c->{info}) {
for my $key (keys %{ $c->{info} }) {
$info->{$key} = $c->{info}{$key};
}
delete $c->{info};
}
## Make a copy of what we send them, so we can safely pull back info later
my $infocopy = {};
for (keys %$info) {
$infocopy->{$_} = $info->{$_};
}
## If they need database handles, provide them
if ($c->{getdbh}) {
my $strict = ($c->{whenrun} eq 'before_txn' or $c->{whenrun} eq 'after_txn') ? 1 : 0;
for my $dbname (keys %{ $sync->{db} }) {
$info->{dbh}{$dbname} = $strict ? $self->{safe_dbh}{$dbname}
: $self->{safe_dbh_strict}{$dbname};
}
}
## Set all databases' InactiveDestroy to on, so the customcode doesn't mess things up
for my $dbname (keys %{ $sync->{db} }) {
$sync->{db}{$dbname}{dbh}->{InactiveDestroy} = 1;
}
## Run the actual code!
local $_ = $info;
$c->{coderef}->($info);
$self->glog("Finished custom code $c->{name}", LOG_VERBOSE);
for my $dbname (keys %{ $sync->{db} }) {
$sync->{db}{$dbname}{dbh}->{InactiveDestroy} = 0;
}
## Check for any messages set by the custom code
if (length $info->{message}) {
$self->glog("Message from $c->{whenrun} code $c->{name}: $info->{message}", LOG_TERSE);
}
## Check for any warnings set by the custom code
if (length $info->{warning}) {
$self->glog("Warning! Code $c->{whenrun} $c->{name}: $info->{warning}", LOG_WARN);
}
## Check for any errors set by the custom code. Throw an exception if found.
if (length $info->{error}) {
$self->glog("Warning! Code $c->{whenrun} $c->{name}: $info->{error}", LOG_WARN);
die "Code $c->{whenrun} $c->{name} error: $info->{error}";
}
## Check for a request to end the sync.
## If found, rollback, adjust the Q, and redo the kid
if (length $info->{endsync}) {
$self->glog("Code $c->{whenrun} requests a cancellation of the rest of the sync", LOG_TERSE);
## before_txn and after_txn should commit themselves
for my $dbname (keys %{ $sync->{db} }) {
$sync->{db}{$dbname}{dbh}->rollback();
}
my $syncname = $infocopy->{syncname};
my $targetname = $infocopy->{targetname};
$sth{qend}->execute(0,0,0,$syncname,$targetname,$$);
my $notify = "bucardo_syncdone_${syncname}_$targetname";
my $maindbh = $self->{masterdbh};
$self->db_notify($maindbh, $notify);
sleep $config{endsync_sleep};
return 'redo';
}
## The custom code has requested we retry this sync (exception code only)
if (exists $info->{retry} and $info->{retry}) {
return 'retry';
}
## The custom code has requested we don't call any other codes of the same type
if (length $info->{lastcode}) {
return 'last';
}
## The custom code has requested we skip this code (and let any others try)
if (length $info->{skip}) {
return 'skip';
}
## Four cases for handling conflicts:
## The customcode has told us how to handle this table
## The customcode has told us how to handle this table until a sync restart
## The customcode has told us how to handle all tables in the sync
## The customcode has told us how to handle all tables in the sync until a sync restart
for my $case (qw/ tablewinner tablewinner_always syncwinner syncwinner_always /) {
if (exists $info->{$case}) {
return "$case: $info->{$case}";
}
}
## Default action, which usually means the next code in the list, if any
return 'normal';
} ## end of run_kid_custom_code
sub truncate_table {
## Given a table, attempt to truncate it
## Arguments: three
## 1. Database object
## 2. Table object
## 3. Boolean if we should CASCADE the truncate or not
## Returns: true if the truncate succeeded without error, false otherwise
my ($self, $Database, $Table, $does_cascade) = @_;
## Override any existing handlers so we can cleanly catch the eval
local $SIG{__DIE__} = sub {};
my $tablename = exists $Table->{tablename} ? $Table->{tablename} : "$Table->{safeschema}.$Table->{safetable}";
if ($Database->{does_sql}) {
if ($Database->{does_savepoints}) {
$Database->{dbh}->do('SAVEPOINT truncate_attempt');
}
$SQL = sprintf 'TRUNCATE TABLE %s%s',
$tablename,
($does_cascade and $Database->{does_cascade}) ? ' CASCADE' : '';
my $truncate_ok = 0;
eval {
$Database->{dbh}->do($SQL);
$truncate_ok = 1;
};
if (! $truncate_ok) {
$Database->{does_savepoints} and $Database->{dbh}->do('ROLLBACK TO truncate_attempt');
$self->glog("Truncate error for db $Database->{name}.$Database->{dbname}.$tablename: $@", LOG_NORMAL);
return 0;
}
else {
$Database->{does_savepoints} and $Database->{dbh}->do('RELEASE truncate_attempt');
return 1;
}
}
if ('mongo' eq $Database->{dbtype}) {
my $collection = $Database->{dbh}->get_collection($tablename);
$collection->remove({}, { safe => 1} );
return 1;
}
elsif ('redis' eq $Database->{dbtype}) {
## No real equivalent here, as we do not map tables 1:1 to redis keys
## In theory, we could walk through all keys and delete ones that match the table
## We will hold off until someone actually needs that, however :)
return 1;
}
return undef;
} ## end of truncate_table
sub delete_table {
## Given a table, attempt to unconditionally delete rows from it
## Arguments: two
## 1. Database object
## 2. Table object
## Returns: number of rows deleted
my ($self, $d, $Table) = @_;
my $tablename = exists $Table->{tablename} ? $Table->{tablename} : "$Table->{safeschema}.$Table->{safetable}";
my $count = 0;
if ($d->{does_sql}) {
($count = $d->{dbh}->do("DELETE FROM $tablename")) =~ s/0E0/0/o;
}
elsif ('mongo' eq $d->{dbtype}) {
## Same as truncate, really, except we return the number of rows
my $collection = $d->{dbh}->get_collection($tablename);
my $res = $collection->remove({}, { safe => 1} );
$count = $res->{n};
}
elsif ('redis' eq $d->{dbtype}) {
## Nothing relevant here, as the table is only part of the key name
}
else {
die "Do not know how to delete a dbtype of $d->{dbtype}";
}
return $count;
} ## end of delete_table
sub delete_rows {
## Given a list of rows, delete them from a database
## Arguments: six
## 1. Hash of rows, where the key is \0 joined pkeys
## 2. Schema name
## 3. Table name
## 4. Goat object
## 5. Sync object
## 6. Target database object, or arrayref of the same
## Returns: number of rows deleted
my ($self,$rows,$S,$T,$goat,$sync,$deldb) = @_;
my $syncname = $sync->{name};
my $pkcols = $goat->{pkeycols};
my $pkcolsraw = $goat->{pkeycolsraw};
my $numpks = $goat->{numpkcols};
## Have we already truncated this table? If yes, skip and reset the flag
if (exists $goat->{truncatewinner}) {
return 0;
}
## Ensure the target database argument is always an array
if (ref $deldb ne 'ARRAY') {
$deldb = [$deldb];
}
## We may be going from one table to another - this is the mapping hash
my $newname = $goat->{newname}{$self->{syncname}};
## Are we truncating?
if (exists $self->{truncateinfo} and exists $self->{truncateinfo}{$S}{$T}) {
## Try and truncate each target
for my $d (@$deldb) {
my $type = $d->{dbtype};
my $tname = $newname->{$d->{name}};
## Postgres is a plain and simple TRUNCATE, with an async flag
## TRUNCATE CASCADE is not needed as everything should be in one
## sync (herd), and we have turned all FKs off
if ('postgres' eq $type) {
my $tdbh = $d->{dbh};
$tdbh->do("TRUNCATE table $tname", { pg_async => PG_ASYNC });
$d->{async_active} = time;
} ## end postgres database
## For all other SQL databases, we simply truncate
elsif ($d->{does_sql}) {
$d->{dbh}->do("TRUNCATE TABLE $tname");
}
## For MongoDB, we simply remove everything from the collection
## This keeps the indexes around (which is why we don't "drop")
elsif ('mongo' eq $type) {
$self->{collection} = $d->{dbh}->get_collection($tname);
$self->{collection}->remove({}, { safe => 1} );
}
## For Redis, do nothing
elsif ('redis' eq $type) {
}
## For flatfiles, write out a basic truncate statement
elsif ($type =~ /flat/o) {
printf {$d->{filehandle}} qq{TRUNCATE TABLE %S;\n\n},
'flatpg' eq $type ? $tname : $tname;
$self->glog(qq{Appended to flatfile "$d->{filename}"}, LOG_VERBOSE);
}
} ## end each database to be truncated
## Final cleanup for each target
for my $d (@$deldb) {
if ('postgres' eq $d->{dbtype}) {
## Wrap up all the async truncate call
$d->{dbh}->pg_result();
$d->{async_active} = 0;
}
}
return 0;
} ## end truncation
## The number of items before we break it into a separate statement
## This is inexact, as we don't know how large each key is,
## but should be good enough as long as not set too high.
## For now, all targets have the same chunksize
my $chunksize = $config{statement_chunk_size} || 8_000;
## Setup our deletion SQL as needed
my %SQL;
for my $t (@$deldb) {
my $type = $t->{dbtype};
## Track the number of rows actually deleted from this target
$t->{deleted_rows} = 0;
## Set to true when all rounds completed
$t->{delete_complete} = 0;
## No special preparation for mongo or redis
next if $type =~ /mongo|redis/;
## Set the type of SQL we are using: IN vs ANY. Default is IN
my $sqltype = 'IN';
## Use of ANY is greatly preferred, but can only use if the
## underlying database supports it, and if we have a single column pk
if ($t->{does_ANY_clause} and 1==$numpks) {
$sqltype = 'ANY';
}
## The actual target table name: may differ from the source!
my $tname = $newname->{$t->{name}};
## Internal counters to help us break queries into chunks if needed
my ($round, $roundtotal) = (0,0);
## Array to store each chunk of SQL
my @chunk;
## Optimization for a single primary key using ANY(?)
if ('ANY' eq $sqltype and ! exists $SQL{ANY}{$tname}) {
$SQL{ANY}{$tname} = "$self->{sqlprefix}DELETE FROM $tname WHERE $pkcols = ANY(?)";
for my $key (keys %$rows) {
push @{$chunk[$round]} => length $key ? ([split '\0', $key, -1]) : [''];
if (++$roundtotal >= $chunksize) {
$roundtotal = 0;
$round++;
}
}
$SQL{ANYargs} = \@chunk;
}
## Normal DELETE call with IN() clause
elsif ('IN' eq $sqltype and ! exists $SQL{IN}{$tname}) {
$SQL{IN}{$tname} = sprintf '%sDELETE FROM %s WHERE (%s) IN (',
$self->{sqlprefix},
$tname,
$goat->{pklist};
my $inner;
if ($t->{has_mysql_timestamp_issue}) {
for my $key (keys %$rows) {
$inner = length $key
? (join ',' => map { s/\'/''/go; s{\\}{\\\\}; s/\+\d\d$//; qq{'$_'}; } split '\0', $key, -1)
: q{''};
$chunk[$round] .= "($inner),";
if (++$roundtotal >= $chunksize) {
$roundtotal = 0;
$round++;
}
}
}
else {
for my $key (keys %$rows) {
$inner = length $key
? (join ',' => map { s/\'/''/go; s{\\}{\\\\}; qq{'$_'}; } split '\0', $key, -1)
: q{''};
$chunk[$round] .= "($inner),";
if (++$roundtotal >= $chunksize) {
$roundtotal = 0;
$round++;
}
}
}
## Cleanup
for (@chunk) {
chop;
$_ = "$SQL{IN}{$tname} $_)";
}
$SQL{IN}{$tname} = \@chunk;
}
$t->{delete_rounds} = @chunk;
## If we bypassed because of a cached version, use the cached delete_rounds too
if ('ANY' eq $sqltype) {
if (exists $SQL{ANYrounds}{$tname}) {
$t->{delete_rounds} = $SQL{ANYrounds}{$tname};
}
else {
$SQL{ANYrounds}{$tname} = $t->{delete_rounds};
}
}
elsif ('IN' eq $sqltype) {
if (exists $SQL{INrounds}{$tname}) {
$t->{delete_rounds} = $SQL{INrounds}{$tname};
}
else {
$SQL{INrounds}{$tname} = $t->{delete_rounds};
}
}
## Empty our internal tracking items that may have been set previously
$t->{delete_round} = 0;
delete $t->{delete_sth};
}
## Start the main deletion loop
## The idea is to be efficient as possible by always having as many
## async targets running as possible. We run one non-async at a time
## before heading back to check on the asyncs.
my $done = 0;
my $did_something;
while (!$done) {
$did_something = 0;
## Wrap up any async targets that have finished
for my $t (@$deldb) {
next if !$t->{async_active} or $t->{delete_complete};
if ('postgres' eq $t->{dbtype}) {
if ($t->{dbh}->pg_ready) {
## If this was a do(), we already have the number of rows
if (1 == $numpks) {
$t->{deleted_rows} += $t->{dbh}->pg_result();
}
else {
$t->{dbh}->pg_result();
}
$t->{async_active} = 0;
}
}
## Don't need to check for invalid types: happens on the kick off below
}
## Kick off all dormant async targets
for my $t (@$deldb) {
## Skip if this target does not support async, or is in the middle of a query
next if !$t->{does_async} or $t->{async_active} or $t->{delete_complete};
## The actual target name
my $tname = $newname->{$t->{name}};
if ('postgres' eq $t->{dbtype}) {
## Which chunk we are processing.
$t->{delete_round}++;
if ($t->{delete_round} > $t->{delete_rounds}) {
$t->{delete_complete} = 1;
next;
}
my $dbname = $t->{name};
$self->glog("Deleting from target $dbname.$tname (round $t->{delete_round} of $t->{delete_rounds})", LOG_DEBUG);
$did_something++;
## Single primary key, so delete using the ANY(?) format
if (1 == $numpks) {
## Use the or-equal so we only prepare this once
$t->{delete_sth} ||= $t->{dbh}->prepare("$SQL{ANY}{$tname}", { pg_async => PG_ASYNC });
$t->{delete_sth}->execute($SQL{ANYargs}->[$t->{delete_round}-1]);
}
## Multiple primary keys, so delete old school via IN ((x,y),(a,b))
else {
my $pre = $t->{delete_rounds} > 1 ? "/* $t->{delete_round} of $t->{delete_rounds} */ " : '';
## The pg_direct tells DBD::Pg there are no placeholders, and to use PQexec directly
$t->{deleted_rows} += $t->{dbh}->
do($pre.$SQL{IN}{$tname}->[$t->{delete_round}-1], { pg_async => PG_ASYNC, pg_direct => 1 });
}
$t->{async_active} = time;
} ## end postgres
else {
die qq{Do not know how to do async for type $t->{dbtype}!\n};
}
} ## end all async targets
## Kick off a single non-async target
for my $t (@$deldb) {
## Skip if this target is async, or has no more rounds
next if $t->{does_async} or $t->{delete_complete};
$did_something++;
my $type = $t->{dbtype};
## The actual target name
my $tname = $newname->{$t->{name}};
if ('mongo' eq $type) {
## Grab the collection name and store it
$self->{collection} = $t->{dbh}->get_collection($tname);
## Because we may have multi-column primary keys, and each key may need modifying,
## we have to put everything into an array of arrays.
## The first level is the primary key number, the next is the actual values
my @delkeys = [];
## The pkcolsraw variable is a simple comma-separated list of PK column names
## The rows variable is a hash with the PK values as keys (the values can be ignored)
## Binary PKs are easy: all we have to do is decode
## We can assume that binary PK means not a multi-column PK
if ($goat->{hasbinarypkey}) {
@{ $delkeys[0] } = map { decode_base64($_) } keys %$rows;
}
else {
## Break apart the primary keys into an array of arrays
my @fullrow = map { length($_) ? [split '\0', $_, -1] : [''] } keys %$rows;
## Which primary key column we are currently using
my $pknum = 0;
## Walk through each column making up the primary key
for my $realpkname (split /,/, $pkcolsraw, -1) {
## Grab what type this column is
## We need to map non-strings to correct types as best we can
my $ctype = $goat->{columnhash}{$realpkname}{ftype};
## For integers, we simply force to a Perlish int
if ($ctype =~ /smallint|integer|bigint/o) {
@{ $delkeys[$pknum] } = map { int $_->[$pknum] } @fullrow;
}
## Non-integer numbers get set via the strtod command from the 'POSIX' module
elsif ($ctype =~ /real|double|numeric/o) {
@{ $delkeys[$pknum] } = map { strtod $_->[$pknum] } @fullrow;
}
## Boolean becomes true Perlish booleans via the 'boolean' module
elsif ($ctype eq 'boolean') {
@{ $delkeys[$pknum] } = map { $_->[$pknum] eq 't' ? true : false } @fullrow;
}
## Everything else gets a direct mapping
else {
@{ $delkeys[$pknum] } = map { $_->[$pknum] } @fullrow;
}
$pknum++;
}
} ## end of multi-column PKs
## We may need to batch these to keep the total message size reasonable
my $max = keys %$rows;
$max--;
## The bottom of our current array slice
my $bottom = 0;
## This loop limits the size of our delete requests to mongodb
MONGODEL: {
## Calculate the current top of the array slice
my $top = $bottom + $chunksize;
## Stop at the total number of rows
$top = $max if $top > $max;
## If we have a single key, we can use the '$in' syntax
if ($numpks <= 1) {
my @newarray = @{ $delkeys[0] }[$bottom..$top];
my $result = $self->{collection}->remove(
{$pkcolsraw => { '$in' => \@newarray }}, { safe => 1 });
$t->{deleted_rows} += $result->{n};
}
else {
## For multi-column primary keys, we cannot use '$in', sadly.
## Thus, we will just call delete once per row
## Put the names into an easy to access array
my @realpknames = split /,/, $pkcolsraw, -1;
my @find;
## Which row we are currently processing
my $numrows = scalar keys %$rows;
for my $rownumber (0..$numrows-1) {
for my $pknum (0..$numpks-1) {
push @find => $realpknames[$pknum], $delkeys[$pknum][$rownumber];
}
}
my $result = $self->{collection}->remove(
{ '$and' => \@find }, { safe => 1 });
$t->{deleted_rows} += $result->{n};
## We do not need to loop, as we just went 1 by 1 through the whole list
last MONGODEL;
}
## Bail out of the loop if we've hit the max
last MONGODEL if $top >= $max;
## Assign the bottom of our array slice to be above the current top
$bottom = $top + 1;
redo MONGODEL;
}
$self->glog("Mongo objects removed from $tname: $t->{deleted_rows}", LOG_VERBOSE);
}
elsif ('mysql' eq $type or 'drizzle' eq $type or 'mariadb' eq $type
or 'oracle' eq $type or 'sqlite' eq $type) {
my $tdbh = $t->{dbh};
for (@{ $SQL{IN}{$tname} }) {
$t->{deleted_rows} += $tdbh->do($_);
}
}
elsif ('redis' eq $type) {
## We need to remove the entire tablename:pkey:column for each column we know about
my $cols = $goat->{cols};
for my $pk (keys %$rows) {
## If this is a multi-column primary key, change our null delimiter to a colon
if ($goat->{numpkcols} > 1) {
$pk =~ s{\0}{:}go;
}
$t->{deleted_rows} += $t->{dbh}->del("$tname:$pk");
}
}
elsif ($type =~ /flat/o) { ## same as flatpg for now
for (@{ $SQL{IN}{$tname} }) {
print {$t->{filehandle}} qq{$_;\n\n};
}
$self->glog(qq{Appended to flatfile "$t->{filename}"}, LOG_VERBOSE);
}
else {
die qq{No support for database type "$type" yet!};
}
$t->{delete_complete} = 1;
## Only one target at a time, please: we need to check on the asyncs
last;
} ## end async target
## If we did nothing this round, and there are no asyncs running, we are done.
## Otherwise, we will wait for the oldest async to finish
if (!$did_something) {
if (! grep { $_->{async_active} } @$deldb) {
$done = 1;
}
else {
## Since nothing else is going on, let's wait for the oldest async to finish
my $t = ( sort { $a->{async_active} > $b->{async_active} } grep { $_->{async_active} } @$deldb)[0];
if (1 == $numpks) {
$t->{deleted_rows} += $t->{dbh}->pg_result();
}
else {
$t->{dbh}->pg_result();
}
$t->{async_active} = 0;
}
}
} ## end of main deletion loop
## Generate our final deletion counts
my $count = 0;
for my $t (@$deldb) {
## We do not delete from certain types of targets
next if $t->{dbtype} =~ /mongo|flat|redis/o;
my $tname = $newname->{$t->{name}};
$count += $t->{deleted_rows};
$self->glog(qq{Rows deleted from $t->{name}.$tname: $t->{deleted_rows}}, LOG_VERBOSE);
}
return $count;
} ## end of delete_rows
sub push_rows {
## Copy rows from one database to another
## Arguments: five
## 1. Hash of rows, where the key is \0 joined pkeys
## 2. Table object
## 3. Sync object
## 4. Source database object
## 5. Target database object, or arrayref of the same
## Returns: number of rows copied
my ($self,$rows,$goat,$sync,$fromdb,$todb) = @_;
my $tablename = "$goat->{safeschema}.$goat->{safetable}";
my $fromdbh = $fromdb->{dbh};
my $syncname = $sync->{name};
my $pkcols = $goat->{pkeycols};
my $numpks = $goat->{numpkcols};
## This may be a fullcopy. If it is, $rows will not be a hashref
## If it is fullcopy, flip it to a dummy hashref
my $fullcopy = 0;
if (! ref $rows) {
if ($rows eq 'fullcopy') {
$fullcopy = 1;
$self->glog('Setting push_rows to fullcopy mode', LOG_DEBUG);
}
else {
die "Invalid rows passed to push_rows: $rows\n";
}
$rows = {};
}
## This will be zero for fullcopy of course
my $total = keys %$rows;
## Total number of rows written
$count = 0;
my $newname = $goat->{newname}{$self->{syncname}};
## As with delete, we may break this into more than one step
## Should only be a factor for very large numbers of keys
my $chunksize = $config{statement_chunk_size} || 10_000;
## Build a list of all PK values to feed to IN clauses
my @pkvals;
my $round = 0;
my $roundtotal = 0;
for my $key (keys %$rows) {
my $inner = length $key
? (join ',' => map { s{\'}{''}go; s{\\}{\\\\}go; qq{'$_'}; } split '\0', $key, -1)
: q{''};
push @{ $pkvals[$round] ||= [] } => $numpks > 1 ? "($inner)" : $inner;
if (++$roundtotal >= $chunksize) {
$roundtotal = 0;
$round++;
}
}
## Example: 1234, 221
## Example MCPK: ('1234','Don''t Stop','2008-01-01'),('221','foobar','2008-11-01')
## Allow for non-arrays by forcing to an array
if (ref $todb ne 'ARRAY') {
$todb = [$todb];
}
## This can happen if we truncated but had no delta activity
return 0 if (! $pkvals[0] or ! length $pkvals[0]->[0] ) and ! $fullcopy;
## Get ready to export from the source
## This may have multiple versions depending on the customcols table
my $newcols = $goat->{newcols}{$syncname} || {};
## Walk through and grab which SQL is needed for each target
## Cache this earlier on - controller?
my %srccmd;
for my $t (@$todb) {
## The SELECT clause we use (may be empty)
my $clause = $newcols->{$t->{name}};
## Associate this target with this clause
push @{$srccmd{$clause}} => $t;
}
## Loop through each source command and push it out to all targets
## that are associated with it
for my $clause (sort keys %srccmd) {
## Build the clause (cache) and kick it off
my $SELECT = $clause || 'SELECT *';
## Prepare each target in turn
for my $t (@{ $srccmd{$clause} }) {
## Internal name of this target
my $targetname = $t->{name};
## Name of the table we are pushing to on this target
my $tname = $newname->{$targetname};
## The columns we are pushing to, both as an arrayref and a CSV:
my $cols = $goat->{tcolumns}{$SELECT};
my $columnlist = $t->{does_sql} ?
('(' . (join ',', map { $t->{dbh}->quote_identifier($_) } @$cols) . ')')
: ('(' . (join ',', map { $_ } @$cols) . ')');
my $type = $t->{dbtype};
## Use columnlist below so we never have to worry about the order
## of the columns on the target
if ('postgres' eq $type) {
my $tgtcmd = "$self->{sqlprefix}COPY $tname$columnlist FROM STDIN";
$t->{dbh}->do($tgtcmd);
}
elsif ('flatpg' eq $type) {
print {$t->{filehandle}} "COPY $tname$columnlist FROM STDIN;\n";
$self->glog(qq{Appended to flatfile "$t->{filename}"}, LOG_VERBOSE);
}
elsif ('flatsql' eq $type) {
print {$t->{filehandle}} "INSERT INTO $tname$columnlist VALUES\n";
$self->glog(qq{Appended to flatfile "$t->{filename}"}, LOG_VERBOSE);
}
elsif ('mongo' eq $type) {
$self->{collection} = $t->{dbh}->get_collection($tname);
}
elsif ('redis' eq $type) {
## No prep needed, other than to reset our count of changes
$t->{redis} = 0;
}
elsif ('mysql' eq $type or 'drizzle' eq $type or 'mariadb' eq $type) {
my $tgtcmd = "INSERT INTO $tname$columnlist VALUES (";
$tgtcmd .= '?,' x @$cols;
$tgtcmd =~ s/,$/)/o;
$t->{sth} = $t->{dbh}->prepare($tgtcmd);
}
elsif ('oracle' eq $type) {
my $tgtcmd = "INSERT INTO $tname$columnlist VALUES (";
$tgtcmd .= '?,' x @$cols;
$tgtcmd =~ s/,$/)/o;
$t->{sth} = $t->{dbh}->prepare($tgtcmd);
}
elsif ('sqlite' eq $type) {
my $tgtcmd = "INSERT INTO $tname$columnlist VALUES (";
$tgtcmd .= '?,' x @$cols;
$tgtcmd =~ s/,$/)/o;
$t->{sth} = $t->{dbh}->prepare($tgtcmd);
}
else {
die qq{No support for database type "$type" yet!};
}
} ## end preparing each target for this clause
## Put dummy data into @pkvals if using fullcopy
if ($fullcopy) {
push @pkvals => ['fullcopy'];
}
my $loop = 1;
my $pcount = @pkvals;
## Loop through each chunk of primary keys to copy over
for my $pk_values (@pkvals) {
my $pkvs = join ',' => @{ $pk_values };
## Message to prepend to the statement if chunking
my $pre = $pcount <= 1 ? '' : "/* $loop of $pcount */ ";
$loop++;
## Kick off the copy on the source
my $fromname = $fromdb->{name};
$self->glog(qq{${pre}Copying from $fromname.$tablename}, LOG_VERBOSE);
my $srccmd = sprintf '%s%sCOPY (%s FROM %s %s) TO STDOUT%s',
$pre,
$self->{sqlprefix},
$SELECT,
$tablename,
$fullcopy ? '' : " WHERE $pkcols IN ($pkvs)",
$sync->{copyextra} ? " $sync->{copyextra}" : '';
$fromdbh->do($srccmd);
my $buffer = '';
## Loop through all changed rows on the source, and push to the target(s)
my $multirow = 0;
## If in fullcopy mode, we don't know how many rows will get copied,
## so we count as we go along
if ($fullcopy) {
$total = 0;
}
## Loop through each row output from the source, storing it in $buffer
while ($fromdbh->pg_getcopydata($buffer) >= 0) {
$total++ if $fullcopy;
## For each target using this particular COPY statement
for my $t (@{ $srccmd{$clause} }) {
my $type = $t->{dbtype};
my $cols = $goat->{tcolumns}{$SELECT};
my $tname = $newname->{$t->{name}};
chomp $buffer;
## For Postgres, we simply do COPY to COPY
if ('postgres' eq $type) {
$t->{dbh}->pg_putcopydata("$buffer\n");
}
## For flat files destined for Postgres, just do a tab-delimited dump
elsif ('flatpg' eq $type) {
print {$t->{filehandle}} "$buffer\n";
}
## For other flat files, make a standard VALUES list
elsif ('flatsql' eq $type) {
if ($multirow++) {
print {$t->{filehandle}} ",\n";
}
print {$t->{filehandle}} '(' .
(join ',' => map { $self->{masterdbh}->quote($_) } split /\t/, $buffer, -1) . ')';
}
## For Mongo, do some mongomagic
elsif ('mongo' eq $type) {
## Have to map these values back to their names
my @cols = map { $_ = undef if $_ eq '\\N'; $_; } split /\t/, $buffer, -1;
## Our object consists of the primary keys, plus all other fields
my $object = {};
for my $cname (@{ $cols }) {
$object->{$cname} = shift @cols;
}
## Coerce non-strings into different objects
for my $key (keys %$object) {
## Since mongo is schemaless, don't set null columns in the mongo doc
if (!defined($object->{$key})) {
delete $object->{$key};
}
elsif ($goat->{columnhash}{$key}{ftype} =~ /smallint|integer|bigint/o) {
$object->{$key} = int $object->{$key};
}
elsif ($goat->{columnhash}{$key}{ftype} eq 'boolean') {
if (defined $object->{$key}) {
$object->{$key} = $object->{$key} eq 't' ? true : false;
}
}
elsif ($goat->{columnhash}{$key}{ftype} =~ /real|double|numeric/o) {
$object->{$key} = strtod($object->{$key});
}
}
$self->{collection}->insert($object, { safe => 1 });
}
## For MySQL, MariaDB, Drizzle, Oracle, and SQLite, do some basic INSERTs
elsif ('mysql' eq $type
or 'mariadb' eq $type
or 'drizzle' eq $type
or 'oracle' eq $type
or 'sqlite' eq $type) {
my @cols = map { $_ = undef if $_ eq '\\N'; $_; } split /\t/, $buffer, -1;
for my $cindex (0..@cols) {
next unless defined $cols[$cindex];
if ($goat->{columnhash}{$cols->[$cindex]}{ftype} eq 'boolean') {
# BOOLEAN support is inconsistent, but almost everyone will coerce 1/0 to TRUE/FALSE
$cols[$cindex] = ( $cols[$cindex] =~ /^[1ty]/i )? 1 : 0;
}
}
$count += $t->{sth}->execute(@cols);
}
elsif ('redis' eq $type) {
## We are going to set a Redis hash, in which the key is "tablename:pkeyvalue"
my @colvals = map { $_ = undef if $_ eq '\\N'; $_; } split /\t/, $buffer, -1;
my @pkey;
for (1 .. $goat->{numpkcols}) {
push @pkey => shift @colvals;
}
my $pkeyval = join ':' => @pkey;
## Build a list of non-null key/value pairs to set in the hash
my @add;
$i = $goat->{numpkcols} - 1;
for my $val (@colvals) {
$i++;
next if ! defined $val;
push @add, $cols->[$i], $val;
}
$t->{dbh}->hmset("$tname:$pkeyval", @add);
$count++;
$t->{redis}++;
}
} ## end each target
} ## end each row pulled from the source
} ## end each pklist
## Workaround for DBD::Pg bug
## Once we require a minimum version of 2.18.1 or better, we can remove this!
if ($self->{dbdpgversion} < 21801) {
$fromdbh->do('SELECT 1');
}
## Perform final cleanups for each target
for my $t (@{ $srccmd{$clause} }) {
my $type = $t->{dbtype};
my $tname = $newname->{$t->{name}};
if ('postgres' eq $type) {
my $dbh = $t->{dbh};
$dbh->pg_putcopyend();
## Same bug as above
if ($self->{dbdpgversion} < 21801) {
$dbh->do('SELECT 1');
}
$self->glog(qq{Rows copied to $t->{name}.$tname: $total}, LOG_VERBOSE);
$count += $total;
## If this table is set to makedelta, add rows to bucardo.delta to simulate the
## normal action of a trigger and add a row to bucardo.track to indicate that
## it has already been replicated here.
my $d = $sync->{db}{ $t->{name} };
if (!$fullcopy and $d->{does_makedelta}{$tablename}) {
$self->glog("Using makedelta to populate delta and track tables for $t->{name}.$tname", LOG_VERBOSE);
my $vals;
if ($numpks == 1) {
$vals = join ',', map { "($_)" } map { @{ $_ } } @pkvals;
}
else {
$vals = join ',', map { @{ $_ } } @pkvals;
}
my $cols = join ',' => @{ $goat->{qpkey} };
$dbh->do(qq{
INSERT INTO bucardo.$goat->{deltatable} ($cols)
VALUES $vals
});
# Make sure we track it - but only if this sync already acts as a source!
if ($t->{role} eq 'source') {
$dbh->do(qq{
INSERT INTO bucardo.$goat->{tracktable}
VALUES (NOW(), ?)
}, undef, $d->{DBGROUPNAME});
}
## We want to send a kick signal to other syncs that are using this table
## However, we do not want to kick unless they are set to autokick and active
$self->glog('Signalling other syncs that this table has changed', LOG_DEBUG);
## Cache this
if (! exists $self->{kick_othersyncs}{$syncname}{$tname}) {
#$SQL = 'SELECT sync FROM bucardo.bucardo_delta_names WHERE sync <> ? AND tablename = ?';
$SQL = 'SELECT name FROM sync WHERE herd IN (SELECT herd FROM herdmap WHERE goat IN (SELECT id FROM goat WHERE schemaname=? AND tablename = ?)) AND name <> ? AND autokick AND status = ?';
$sth = $self->{masterdbh}->prepare($SQL);
$sth->execute($goat->{schemaname}, $goat->{tablename}, $syncname, 'active');
$self->{kick_othersyncs}{$syncname}{$tname} = $sth->fetchall_arrayref();
}
for my $row (@{ $self->{kick_othersyncs}{$syncname}{$tname} }) {
my $othersync = $row->[0];
$self->db_notify($dbh, "kick_sync_$othersync", 0, '', 1);
}
}
}
elsif ('flatpg' eq $type) {
print {$t->{filehandle}} "\\\.\n\n";
}
elsif ('flatsql' eq $type) {
print {$t->{filehandle}} ";\n\n";
}
elsif ('redis' eq $type) {
$self->glog(qq{Rows copied to Redis $t->{name}.$tname:: $t->{redis}}, LOG_VERBOSE);
}
}
} ## end of each clause in the source command list
return $count;
} ## end of push_rows
sub vacuum_table {
## Compact and/or optimize the table in the target database
## Argument: five
## 1. Starting time for the kid, so we can output cumulative times
## 2. Database type
## 3. Database handle
## 4. Database name
## 5. Table name (may be in schema.table format)
## Returns: undef
my ($self, $start_time, $dbtype, $ldbh, $dbname, $tablename) = @_;
## XXX Return output from vacuum/optimize as a LOG_VERBOSE or LOG_DEBUG?
if ('postgres' eq $dbtype) {
## Do a normal vacuum of the table
$ldbh->commit();
$ldbh->{AutoCommit} = 1;
$self->glog("Vacuuming $dbname.$tablename", LOG_VERBOSE);
$ldbh->do("VACUUM $tablename");
$ldbh->{AutoCommit} = 0;
my $total_time = sprintf '%.2f', tv_interval($start_time);
$self->glog("Vacuum complete. Time: $total_time", LOG_VERBOSE);
}
elsif ('mysql' eq $dbtype or 'drizzle' eq $dbtype or 'mariadb' eq $dbtype) {
## Optimize the table
$self->glog("Optimizing $tablename", LOG_VERBOSE);
$ldbh->do("OPTIMIZE TABLE $tablename");
$ldbh->commit();
my $total_time = sprintf '%.2f', tv_interval($start_time);
$self->glog("Optimization complete. Time: $total_time", LOG_VERBOSE);
}
elsif ('sqlite' eq $dbtype) {
# Note the SQLite command vacuums the entire database.
# Should probably avoid multi-vacuuming if several tables have changed.
$self->glog('Vacuuming the database', LOG_VERBOSE);
$ldbh->do('VACUUM');
my $total_time = sprintf '%.2f', tv_interval($start_time);
$self->glog("Vacuum complete. Time: $total_time", LOG_VERBOSE);
}
elsif ('redis' eq $dbtype) {
# Nothing to do, really
}
elsif ('mongodb' eq $dbtype) {
# Use db.repairDatabase() ?
}
else {
## Do nothing!
}
return;
} ## end of vacuum_table
sub analyze_table {
## Update table statistics in the target database
## Argument: five
## 1. Starting time for the kid, so we can output cumulative times
## 2. Database type
## 3. Database handle
## 4. Database name
## 5. Table name (may be in schema.table format)
## Returns: undef
my ($self, $start_time, $dbtype, $ldbh, $dbname, $tablename) = @_;
## XXX Return output from analyze as a LOG_VERBOSE or LOG_DEBUG?
if ('postgres' eq $dbtype) {
$ldbh->do("ANALYZE $tablename");
my $total_time = sprintf '%.2f', tv_interval($start_time);
$self->glog("Analyze complete for $dbname.$tablename. Time: $total_time", LOG_VERBOSE);
$ldbh->commit();
}
elsif ('sqlite' eq $dbtype) {
$ldbh->do("ANALYZE $tablename");
my $total_time = sprintf '%.2f', tv_interval($start_time);
$self->glog("Analyze complete for $dbname.$tablename. Time: $total_time", LOG_VERBOSE);
$ldbh->commit();
}
elsif ('mysql' eq $dbtype or 'drizzle' eq $dbtype or 'mariadb' eq $dbtype) {
$ldbh->do("ANALYZE TABLE $tablename");
my $total_time = sprintf '%.2f', tv_interval($start_time);
$self->glog("Analyze complete for $tablename. Time: $total_time", LOG_VERBOSE);
$ldbh->commit();
}
else {
## Nothing to do here
}
return undef;
} ## end of analyze_table
sub msg { ## no critic
my $name = shift || '?';
my $msg = '';
if (exists $msg{$lang}{$name}) {
$msg = $msg{$lang}{$name};
}
elsif (exists $msg{'en'}{$name}) {
$msg = $msg{'en'}{$name};
}
else {
my $line = (caller)[2];
die qq{Invalid message "$name" from line $line\n};
}
$i = 1;
{
my $val = $_[$i-1];
$val = '?' if ! defined $val;
last unless $msg =~ s/\$$i/$val/g;
$i++;
redo;
}
return $msg;
} ## end of msg
sub pretty_time {
## Transform number of seconds to a more human-readable format
## First argument is number of seconds
## Second optional arg is highest transform: s,m,h,d,w
## If uppercase, it indicates to "round that one out"
my $sec = shift;
my $tweak = shift || '';
## Round to two decimal places, then trim the rest
$sec = sprintf '%.2f', $sec;
$sec =~ s/0+$//o;
$sec =~ s/\.$//o;
## Just seconds (< 2:00)
if ($sec < 120 or $tweak =~ /s/) {
return sprintf "$sec %s", $sec==1 ? msg('time-second') : msg('time-seconds');
}
## Minutes and seconds (< 60:00)
if ($sec < 60*60 or $tweak =~ /m/) {
my $min = int $sec / 60;
$sec %= 60;
my $ret = sprintf "$min %s", $min==1 ? msg('time-minute') : msg('time-minutes');
$sec and $tweak !~ /S/ and $ret .= sprintf " $sec %s", $sec==1 ? msg('time-second') : msg('time-seconds');
return $ret;
}
## Hours, minutes, and seconds (< 48:00:00)
if ($sec < 60*60*24*2 or $tweak =~ /h/) {
my $hour = int $sec / (60*60);
$sec -= ($hour*60*60);
my $min = int $sec / 60;
$sec -= ($min*60);
my $ret = sprintf "$hour %s", $hour==1 ? msg('time-hour') : msg('time-hours');
$min and $tweak !~ /M/ and $ret .= sprintf " $min %s", $min==1 ? msg('time-minute') : msg('time-minutes');
$sec and $tweak !~ /[SM]/ and $ret .= sprintf " $sec %s", $sec==1 ? msg('time-second') : msg('time-seconds');
return $ret;
}
## Days, hours, minutes, and seconds (< 28 days)
if ($sec < 60*60*24*28 or $tweak =~ /d/) {
my $day = int $sec / (60*60*24);
$sec -= ($day*60*60*24);
my $our = int $sec / (60*60);
$sec -= ($our*60*60);
my $min = int $sec / 60;
$sec -= ($min*60);
my $ret = sprintf "$day %s", $day==1 ? msg('time-day') : msg('time-days');
$our and $tweak !~ /H/ and $ret .= sprintf " $our %s", $our==1 ? msg('time-hour') : msg('time-hours');
$min and $tweak !~ /[HM]/ and $ret .= sprintf " $min %s", $min==1 ? msg('time-minute') : msg('time-minutes');
$sec and $tweak !~ /[HMS]/ and $ret .= sprintf " $sec %s", $sec==1 ? msg('time-second') : msg('time-seconds');
return $ret;
}
## Weeks, days, hours, minutes, and seconds (< 28 days)
my $week = int $sec / (60*60*24*7);
$sec -= ($week*60*60*24*7);
my $day = int $sec / (60*60*24);
$sec -= ($day*60*60*24);
my $our = int $sec / (60*60);
$sec -= ($our*60*60);
my $min = int $sec / 60;
$sec -= ($min*60);
my $ret = sprintf "$week %s", $week==1 ? msg('time-week') : msg('time-weeks');
$day and $tweak !~ /D/ and $ret .= sprintf " $day %s", $day==1 ? msg('time-day') : msg('time-days');
$our and $tweak !~ /[DH]/ and $ret .= sprintf " $our %s", $our==1 ? msg('time-hour') : msg('time-hours');
$min and $tweak !~ /[DHM]/ and $ret .= sprintf " $min %s", $min==1 ? msg('time-minute') : msg('time-minutes');
$sec and $tweak !~ /[DHMS]/ and $ret .= sprintf " $sec %s", $sec==1 ? msg('time-second') : msg('time-seconds');
return $ret;
} ## end of pretty_time
sub send_mail {
## Send out an email message
## Arguments: one
## 1. Hashref with mandatory args 'body' and 'subject'. Optional 'to'
## Returns: undef
my $self = shift;
## Return right away if sendmail and sendmail_file are false
return if ! $self->{sendmail} and ! $self->{sendmail_file};
## Hashref of args
my $arg = shift;
## If 'default_email_from' is not set, we default to currentuser@currenthost
my $from = $config{default_email_from} || (getpwuid($>) . '@' . $hostname);
## Who is the email going to? We usually use the default.
$arg->{to} ||= $config{default_email_to};
## We should always pass in a subject, but just in case:
$arg->{subject} ||= 'Bucardo Mail!';
## Like any good murder mystery, a body is mandatory
if (! $arg->{body}) {
$self->glog('Warning: Cannot send mail, no body message', LOG_WARN);
return;
}
## Where do we connect to?
my $smtphost = $config{default_email_host} || 'localhost';
my $smtpport = $config{default_email_port} || 25;
## Send normal email
## Do not send it if the 'example.com' default value is still in place
if ($self->{sendmail} and $arg->{to} ne 'nobody@example.com') {
## Wrap the whole call in an eval so we can report errors
my $evalworked = 0;
eval {
my $smtp = Net::SMTP->new(
Host => $smtphost,
Port => $smtpport,
Hello => $hostname,
Timeout => 15
);
if ($config{email_auth_user} and $config{email_auth_pass}) {
## Requires Authen::SASL
my ($auser,$apass) = ($config{email_auth_user}, $config{email_auth_pass});
$self->glog("Attempting Net::SMTP::auth with user $auser", LOG_DEBUG);
$smtp->auth($auser, $apass);
}
$smtp->mail($from);
$smtp->to($arg->{to});
$smtp->data();
$smtp->datasend("From: $from\n");
$smtp->datasend("To: $arg->{to}\n");
$smtp->datasend("Subject: $arg->{subject}\n");
$smtp->datasend("\n");
$smtp->datasend($arg->{body});
$smtp->dataend;
$smtp->quit;
$evalworked = 1;
};
if (! $evalworked) {
my $error = $@ || '???';
$self->glog("Warning: Error sending email to $arg->{to}: $error", LOG_WARN);
}
else {
$self->glog("Sent an email to $arg->{to} from $from: $arg->{subject}", LOG_NORMAL);
}
}
## Write the mail to a file
if ($self->{sendmail_file}) {
my $fh;
## This happens rare enough to not worry about caching the file handle
if (! open $fh, '>>', $self->{sendmail_file}) {
$self->glog(qq{Warning: Could not open sendmail file "$self->{sendmail_file}": $!}, LOG_WARN);
return;
}
my $now = scalar localtime;
print {$fh} qq{
==========================================
To: $arg->{to}
From: $from
Subject: $arg->{subject}
Date: $now
$arg->{body}
};
close $fh or warn qq{Could not close "$self->{sendmail_file}": $!\n};
}
return;
} ## end of send_mail
1;
__END__
=pod
=head1 NAME
Bucardo - Postgres multi-master replication system
=head1 VERSION
This document describes version 5.4.1 of Bucardo
=head1 WEBSITE
The latest news and documentation can always be found at:
http://bucardo.org/
=head1 DESCRIPTION
Bucardo is a Perl module that replicates Postgres databases using a combination
of Perl, a custom database schema, Pl/Perlu, and Pl/Pgsql.
Bucardo is unapologetically extremely verbose in its logging.
Full documentation can be found on the website, or in the files that came with
this distribution. See also the documentation for the bucardo program.
=head1 DEPENDENCIES
=over
=item * DBI (1.51 or better)
=item * DBD::Pg (2.0.0 or better)
=item * Sys::Hostname
=item * Sys::Syslog
=item * DBIx::Safe ## Try 'yum install perl-DBIx-Safe' or visit bucardo.org
=item * boolean
=back
=head1 BUGS
Bugs should be reported to bucardo-general@bucardo.org. A list of bugs can be found at
http://bucardo.org/bugs.html
=head1 CREDITS
Bucardo was originally developed and funded by Backcountry.com, who have been using versions
of it in production since 2002. Jon Jensen wrote the original version.
=head1 AUTHOR
Greg Sabino Mullane
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2005-2015 Greg Sabino Mullane .
This software is free to use: see the LICENSE file for details.
=cut
Bucardo-5.4.1/.perlcriticrc0000644000175000017500000000726712563002233014230 0ustar greggreg
## perlcritic file for Bucardo
## Usage: perlcritic -profile
verbose = 8
severity = 1
profile-strictness = quiet
##
## Five:
##
[-BuiltinFunctions::ProhibitStringyEval]
[-ControlStructures::ProhibitMutatingListFunctions]
[-Subroutines::ProhibitNestedSubs]
[-ValuesAndExpressions::ProhibitAccessOfPrivateData]
[-Subroutines::ProhibitExplicitReturnUndef]
##
## Four:
##
[-BuiltinFunctions::RequireBlockGrep]
## We are just fine with 'die', thanks very much
[-ErrorHandling::RequireUseOfExceptions]
[-InputOutput::ProhibitOneArgSelect]
## Too many false positives for this one:
[-InputOutput::RequireBriefOpen]
[-Lax::RequireEndWithTrueConst]
[-Modules::RequireEndWithOne]
## This does such a poor job we have to exclude it
[-RegularExpressions::ProhibitCaptureWithoutTest]
[-RegularExpressions::ProhibitFixedStringMatches]
[-ValuesAndExpressions::ProhibitConstantPragma]
[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
[-Variables::RequireLocalizedPunctuationVars]
[-InputOutput::ProhibitExplicitStdin]
##
## Three:
##
[-Bangs::ProhibitNumberedNames]
[-Bangs::ProhibitVagueNames]
[-BuiltinFunctions::ProhibitComplexMappings]
[-CodeLayout::RequireUseUTF8]
[-ControlStructures::ProhibitCascadingIfElse]
[-ControlStructures::ProhibitDeepNests]
[-Documentation::RequirePODUseEncodingUTF8]
[-ErrorHandling::RequireCarping]
[-ErrorHandling::RequireCheckingReturnValueOfEval]
[-InputOutput::ProhibitBacktickOperators]
[-Lax::ProhibitComplexMappings::LinesNotStatements]
[-Miscellanea::ProhibitUnrestrictedNoCritic]
[-Modules::ProhibitExcessMainComplexity]
[-Modules::ProhibitUseQuotedVersion]
[-RegularExpressions::ProhibitComplexRegexes]
[-RegularExpressions::RequireExtendedFormatting]
[-Subroutines::ProhibitExcessComplexity]
[-Subroutines::ProhibitManyArgs]
[-ValuesAndExpressions::ProhibitImplicitNewlines]
[-Variables::ProhibitPackageVars]
[-Variables::RequireInitializationForLocalVars]
[-ValuesAndExpressions::ProhibitVersionStrings]
##
## Two:
##
[-Bangs::ProhibitCommentedOutCode]
[-Bangs::ProhibitFlagComments]
[-BuiltinFunctions::ProhibitBooleanGrep]
[-BuiltinFunctions::ProhibitStringySplit]
[-CodeLayout::ProhibitQuotedWordLists]
[-ControlStructures::ProhibitCStyleForLoops]
[-ControlStructures::ProhibitPostfixControls]
[-ControlStructures::ProhibitUnlessBlocks]
[-Documentation::RequirePodSections]
[-Editor::RequireEmacsFileVariables]
[-Lax::ProhibitEmptyQuotes::ExceptAsFallback]
## This one really ought to be removed entirely:
## Giving too many false positives in bucardo:
[-Miscellanea::ProhibitUselessNoCritic]
[-Miscellanea::RequireRcsKeywords]
[-References::ProhibitDoubleSigils]
[-RegularExpressions::RequireDotMatchAnything]
[-RegularExpressions::RequireLineBoundaryMatching]
[-Tics::ProhibitLongLines]
[-ValuesAndExpressions::ProhibitEmptyQuotes]
[-ValuesAndExpressions::ProhibitMagicNumbers]
## This one has such potential to be useful, but complains about some wrong things:
[-ValuesAndExpressions::ProhibitNoisyQuotes]
[-ValuesAndExpressions::RequireNumberSeparators]
[-ValuesAndExpressions::RestrictLongStrings]
[-Variables::ProhibitPunctuationVars]
##
## One:
##
[-BuiltinFunctions::ProhibitReverseSortBlock]
[-CodeLayout::ProhibitParensWithBuiltins]
[-CodeLayout::RequireTidyCode]
[-Documentation::PodSpelling]
## Yeah, because everyone checks the return value of 'print'
[-InputOutput::RequireCheckedSyscalls]
[-Miscellanea::RequireRcsKeywords]
[-NamingConventions::Capitalization]
[-RegularExpressions::ProhibitEnumeratedClasses]
[-RegularExpressions::ProhibitEscapedMetacharacters]
[-RegularExpressions::ProhibitSingleCharAlternation]
## Change the severity level of some specific items
[CodeLayout::ProhibitTrailingWhitespace]
severity = 5
[Subroutines::ProhibitBuiltinHomonyms]
severity = 5
Bucardo-5.4.1/Changes0000644000175000017500000010435412601643406013036 0ustar greggreg
Bucardo version 5.4.1, released September 27, 2015 (git commit e2b238c7a6239f8ab78a96d7cd356f3cbb840551)
- Fix failure to upgrade because of sequence name missing a schema
[Greg Sabino Mullane]
Bucardo version 5.4.0, released August 6, 2015 (git commit a0eff9f6558cc2c6b19e4e675604250ad00ce420)
- Allow dashes in valid schema and table names
[David Christensen]
- New command "bucardo delta [syncname...]" to show number of pending
delta rows on source databases.
[Greg Sabino Mullane]
- Fix incorrect usage of the 'dbconn' parameter in the bucardo.db table
[Greg Sabino Mullane, reported by Alexandre Busquets]
- Fix case where VAC sometimes skipped databases used in multiple syncs.
[Greg Sabino Mullane, reported by Andrey Solovjov]
- Adjustments for new version of ExtUtils::MakeMaker
[Mathieu Arnold]
- When doing target deletes, use the quoted version of the primary key column names.
[Greg Sabino Mullane]
- Make sure we do not signal other syncs during makedelta runs if the other
syncs are inactive or have autokick off.
[Greg Sabino Mullane]
- Allow code with 'array_agg' to work on Postgres <= 8.2,
along with many other minor changes to support older versions.
[Greg Sabino Mullane]
- Add new internal function bucardo_purge_delta_oid which helps the
VAC process work better on older versions of Postgres (<= 8.2)
[Greg Sabino Mullane]
- Add new function bucardo_purge_sync_track which removes all track
and delta entries for a given sync. Use with care.
[Greg Sabino Mullane]
- Allow 'bucardo validate' to drop the autokick triggers if they are no longer needed.
[Greg Sabino Mullane]
- Add 'PRAGMA defer_foreign_keys' for sqlite targets
[Greg Sabino Mullane]
- Do not try to apply 'READ WRITE' when doing the initial SET TRANSACTION for MySQL and MariaDB,
as that option is not supported across all versions.
[Greg Sabino Mullane]
- Remove default value from sync.isolation_level, so we can default to
the global one when needed.
[Greg Sabino Mullane]
- Improve workings of the 'pkonly' argument to "bucardo add tables"
[Greg Sabino Mullane]
- Make 'bucardo list relgroup foo' show the tables in priority order.
[Greg Sabino Mullane]
- Make 'bucardo list all' a little less verbose for some not-so-common items
[Greg Sabino Mullane]
- Fix up the "add relgroup" call to allow it to work for capitalized relations,
and remove a prepare_cached error that could occur.
[Greg Sabino Mullane]
- Allow validate_sync to check the contents of functions for upgrade,
not just their existence.
[Greg Sabino Mullane]
- Do not 'RESET search_path' inside some of the internal functions.
[Greg Sabino Mullane]
- Sleep longer between stop and start when doing 'bucardo restart'
[Greg Sabino Mullane]
Bucardo version 5.3.1, released January 27, 2015 (git commit a4e59ea351410acd4fe750384a19393c261f7e91)
- When clearing out the async mode, do not do so unless the state() is sane.
This will solve some of the "pg_cancel failed" errors seen
[Greg Sabino Mullane]
- Throw a cleaner and earlier exception when connect_database fails
[Greg Sabino Mullane]
- Give a warning when a bucardo rc file has an unparseable line
[Greg Sabino Mullane]
Bucardo version 5.3.0, released December 22, 2014 (git commit 07d884fea5ba113b5d314c318bcff2cced55b6bb)
- Fix race condition when makedelta used which could cause some
rows to be incorrectly entered into the track table
[Greg Sabino Mullane]
- Fix bug when makedelta used on tables with binary primary key columns
[Greg Sabino Mullane]
- Allow 'makedelta' to be specified at the database level
[Greg Sabino Mullane]
- Give customcodes access to the list of changed rows via
the 'rows' key in the passed-in hashref
[Greg Sabino Mullane]
- Allow specification of non-default port when sending email.
Attempt support for SASL auth.
[Greg Sabino Mullane, per suggestion from Michael Wagner]
- Better support for continuing once a database has crashed
[Greg Sabino Mullane]
- Allow removing all tables or sequences at once via command line,
e.g. 'bucardo remove all tables'
[Greg Sabino Mullane]
- Allow --makedelta=foo to work on command line when adding all tables
[Greg Sabino Mullane]
- New test file t/50-star.t and much improvement to testing framework
[Greg Sabino Mullane]
- Added new logging level, DEBUG2, for things that are just too verbose
even for DEBUG!
[Greg Sabino Mullane]
- When the VAC exits, disconnect from any databases cleanly we
may still be connected to.
[Greg Sabino Mullane]
- Allow --dryrun to work when adding items, esp. tables
[Greg Sabino Mullane]
- Allow msg as alias for message e.g. 'bucardo msg foobar'
[Greg Sabino Mullane]
- When showing microseconds in the log, force the third and final zero to appear
[Greg Sabino Mullane]
Bucardo version 5.2.0, released November 5, 2014 (git commit 003b827a73a6e2e51cc5e833a5b4bc21631bd216)
- quickstart: new parameter to give on startup (e.g. "bucardo start --quickstart").
When set, skips checking the tables and columns on remote databases.
[Greg Sabino Mullane]
- Fix problem of not clearing out stagetable before using it. There was a
chance that a previous KID left some rows in there, in which case duplicate
entries will appear in bucardo_track.
[Greg Sabino Mullane]
- Make sure makedelta only adds matching track table rows if the current database is
a source, not a target, for the current sync.
[Greg Sabino Mullane]
- Fix some errant global variables which were causing subtle bugs in the makedelta
system.
[Greg Sabino Mullane]
Bucardo version 5.1.2, released October 15, 2014 (git commit 6b8f02feaef5b116dfba9b57f6a0617d73ba3657)
- Fix problem with async failures
[Greg Sabino Mullane]
- Fix add_customcols params parsing
[David Christensen]
- Improve MCP loop handling on errors
[Greg Sabino Mullane]
- Make sure makedelta can be set for all databases, not just source ones
[Greg Sabino Mullane]
- Fix minor bug in send_mail subroutine
[Greg Sabino Mullane]
- Remove Encode::Locale dependency
[Joshua Tolley]
- Allow 'git list config*' to work as an alias for git config.
Make plain 'git config' act as 'git show all'
[Greg Sabino Mullane]
Bucardo version 5.1.1, released July 23, 2014 (git commit c91753ef834cdcac311d66851947d1e4cb8acc7c)
- Minor fixes to conflict handling.
[Greg Sabino Mullane]
- Fix upgrade to add updating of defaults.
[Greg Sabino Mullane]
Bucardo version 5.1.0, released July 14, 2014 (git commit 7465d87ec60d29555fc2a38e70e08cc09e33a7db)
- Many fixes and features added to the conflict resolution system.
[Greg Sabino Mullane]
- Fix the upgrade so new constraints are handled better.
[Greg Sabino Mullane]
Bucardo version 5.0.0, released June 23, 2014 (git commit 2349582733df31a4115b952bfcc2f5732d5af16a)
- Complete rework of Bucardo: we now allow as many source and target
databases as wanted in a single sync.
[Greg Sabino Mullane]
- Allow alternate targets: Drizzle, MariaDB, MongoDB, MySQL, Oracle, Redis,
SQLite, as well as "flat files"
[Greg Sabino Mullane]
- Rename "bucardo_ctl" to simply "bucardo"
[Jon Jensen]
- Rename "goat" to "relation" or, more commonly, "table" and "sequence".
[David Wheeler]
- Rename "standard_conflict" option to "conflict_strategy".
- Rename "herd" to "relgroup".
[David Wheeler]
- Change the way that swap syncs work: should be much faster
[Greg Sabino Mullane]
- Use asynchronous queries when possible
[Greg Sabino Mullane]
- Redo the makedelta system, and add makedelta option for relations, which
inherit from db. Add makedelta as on/off for db.
[Greg Sabino Mullane]
- Overhaul of sequence handling: now allows for all attributes to be
replicated, such as INCREMENT_BY and MAXVALUE
[Greg Sabino Mullane]
- Fix for failing swap syncs when column is not all lowercase.
[Greg Sabino Mullane]
- Fix for proper sourcelimit and targetlimit calculations.
[Greg Sabino Mullane]
- Add slony_migrator.pl script
[Josh Tolley]
- Add example scripts in 'bucardo_examples' directory
[Selena Deckelmann]
- Allow 'list sync' to filter by 'active' and 'inactive'
[Greg Sabino Mullane]
- Remove unused config variable 'upsert_attempts'
[Greg Sabino Mullane]
- Show detailed information on KID error exit.
[Greg Sabino Mullane]
- Fix bug in bucardo_purge_q_table in index detection logic.
[Aolmezov]
- Show the reason why a sync failed on a failed bucardo kick.
[Greg Sabino Mullane]
- Add new subprocess (VAC) to run bucardo_purge_delta
[Greg Sabino Mullane]
- Fix errors with bytea and swap syncs
[Greg Sabino Mullane]
- Do not replicate null values to MongoDB
[Ali Asad Lotia]
- Add 'default_conflict_strategy' option
[Greg Sabino Mullane, idea from Franz Dürr]
- Force time zone to UTC to resolve timestamptz issues with bucardo_delta
[Michelle Sullivan, Greg Sabino Mullane]
- Add a log_level parameter, and classify all messages inside Bucardo.pm
with a log_level of TERSE, NORMAL, VERBOSE, or DEBUG.
[Rosser Schwarz, Greg Sabino Mullane]
- Relax SELECT version() regex in bucardo, to let modified versions
of Postgres tell us their version.
[Greg Sabino Mullane]
- Fix incorrect automatic population of database when using
'bucardo add database' and only one database exists.
[Greg Sabino Mullane]
- Fix failing makedelta when using multi-column primary keys.
[Greg Sabino Mullane, reported by Michelle Sullivan]
- Add new vacuum_after_copy variable for goats and syncs.
[Greg Sabino Mullane]
- Do not perform a checktime kick if onetimecopy mode is on.
[Greg Sabino Mullane]
- New syncs of type fullcopy now default to false for ping, stayalive,
and kidsalive.
[Greg Sabino Mullane, idea from Andrew Spencer]
- Refuse to start if the bucardo database version does not match that of
bucardo (the former is set by 'bucardo upgrade')
[Greg Sabino Mullane]
- Set the search_path to prevent bogus warnings on startup about sequence
mismatches based on schema names.
[Greg Sabino Mullane] (Bug #17)
- Add a --force option so we can remove databases via 'bucardo remove db'
along with all related goats and syncs.
[Greg Sabino Mullane]
- Change bucardo.dbrun table column pgpid to INTEGER
[Wim Lewis]
- Remove race condition from bucardo_purge_q_table()
[Greg Sabino Mullane]
- Add new options for 'bucardo add db': addalltables and addallsequences
[Greg Sabino Mullane]
- Allows syncs to be paused and resumed while they are running.
[Greg Sabino Mullane]
- Allow 'bucardo status' to run even if piddir is not available.
[Greg Sabino Mullane]
- Don't bother comparing the 'log_cnt' field of sequences.
[Rosser Schwarz]
- Allow "schema.table" format for 'bucardo list tables'
[Greg Sabino Mullane]
- Add new option "log_microsecond" to show sub-second output in logs.
[Greg Sabino Mullane]
- Make sure we update bucardo_config.bucardo_current_version when
doing a 'bucardo upgrade'
[Greg Sabino Mullane] (Bug #5)
- Automatically create the bucardo (superuser) if we can connect as 'postgres'.
[Greg Sabino Mullane]
- Add 'bucardo list all' feature.
[Christian Recktenwald]
- Allow removal of tables from relgroups via bucardo.
[Greg Sabino Mullane]
- Add create_child_q_table() function.
[Greg Sabino Mullane]
- Allow 'bucardo update relgroup foo remove
'
and 'bucardo update relgroup foo add
'
[Greg Sabino Mullane]
- Rename the default reason_file to bucardo.restart.reason.txt. The reason
log is then named bucardo.restart.reason.log (instead of
bucardo.restart.reason.log.log as before).
[David Wheeler]
- Better formatting of bucardo.reason.txt.log, and log startup failures.
[Greg Sabino Mullane]
- Log the current configuration settings on startup.
[Greg Sabino Mullane]
- Fix incorrect assignment of ppid in the bucardo.q table.
[Greg Sabino Mullane]
- Remove unused 'kick_sleep' config variable.
[Greg Sabino Mullane]
- Show the database name when listing relgroups via bucardo.
[Greg Sabino Mullane]
- Show the database name when listing sequences via bucardo.
[Douglas Tan]
- Show each target's Postgres version, time, and timezone on first connect.
[Greg Sabino Mullane]
- Change main trigger names to 'bucardo_delta' and 'bucardo_kick'
[Greg Sabino Mullane]
- Allow databases to have the same dsn, as we are moving
towards in-database replication.
[Greg Sabino Mullane]
- Add complete documentation of all public commands, actions, parameters,
and options to the bucardo Pod (and therefore the man page, as well).
[David Wheeler]
- Use the Pod docs to show the output of 'help command' and
'help command action' instead of duplicating that information in code.
[David Wheeler]
- Fixed PostgreSQL 9.2 compatibility issues.
[David Wheeler]
- Fix syntax issues to restore support for PostgreSQL 8.1
[Greg Sabino Mullane]
- Fix "arguments of row IN must all be row expressions" error.
[Greg Sabino Mullane]
- Fix empty primary key join/split bug.
[Greg Sabino Mullane]
- Add Linux int script and RPM spec file
[Devrim GÜNDÜZ, David Wheeler]
- Add --exit-on-nosync option. Bucardo no longer exits from 'start' when
there are no syncs. Use this option to restore that behavior.
[David Wheeler]
- Switch to pg_ctl in tests for more reliable (and faster!) Postgres
startup and shutdown.
[David Wheeler]
- Fix incorrect shutdown when Postgres is not running. The pid file is now
properly cleaned up on shutdown even if Postgres is down.
[David Wheeler]
- Tests now properly report the reasons for failed bucardo commands.
[David Wheeler]
- Revamp retry on serialization failure so that it actually works. The KID
no longer sleeps and exits, but sleeps and retries the sync on its own,
only sending a NOTICE to other processes that it is doing so.
[David Wheeler, Greg Sabino Mullane]
- Change the default serialization failure sleep time from 10s to 0.5s.
- Added new 'bucardo reopen' command to reopen all open file handles
Useful for log rotation.
[Greg Sabino Mullane].
- The 'update' command no longer exits with an error code on success.
- Fixed issue with missing database handles when a KID shuts down.
[David Wheeler]
- Remove the customselect parameter. Use the customcols command, instead.
[David Wheeler]
- Remove the do_listen parameter, which was just another name for ping.
- Rename the 'ping' parameter to 'autokick', to better describe what it does
and to prevent confusion with the 'ping' command, which does something
totally different.
[David Wheeler]
- Rename standard_conflict to conflict_strategy.
[David Wheeler]
- Move conflict_strategy from add/update table to add/update sync.
[David Wheeler]
- Fix issue that prevented the VAC process from shutting down
immediately on 'stop'.
[David Wheeler]
- Fix failure to restart after database disconnections.
- Add 'remove sequence'
[David Wheeler]
- Rename most --debug* options to --log-*:
+ --debugdir is now --log-destination
+ --debugfile is deprecated; use '--log-destination none' to disable all logging
+ --debugsyslog is deprecated; use --log-destination syslog'
+ Allow logging to stderr or stdout via --log-destination
+ --log-destination may be specified multiple times for multiple logs
+ --debugfilesep is now --log-separate
+ --debugname is now --log-extension
+ --cleandebugs is now --log-clean
[David Wheeler]
- Eliminated 'Use of "goto" to jump into a construct has been deprecated'
warnings on Perl 5.12 and higher.
- Removed the 'trigrules' attribute for customcodes. Callers should
(carefully!) change session_replication_role themselves.
[Greg Sabino Mullane]
[ GSM is Greg Sabino Mullane ]
Bucardo version 4.4.8, released November 30, 2011
- Fix incorrect checking of hostname for host_safety_check [GSM]
- Fix wrong version number in the bucardo_ctl script.
Bucardo version 4.4.7, released November 8, 2011
- Fix bug when using multi-column primary keys where the first
is an int, and the second is not. Reported by Brady S Edwards [GSM]
- Do not rely on $@ to catch important evals [GSM]
Bucardo version 4.4.6, released July 10, 2011
- Fix bug resulting in wrong escapes in swap syncs for int4 primary keys
Reported by Kiriakos Tsourapas. [GSM]
Bucardo version 4.4.5, released June 18, 2011
- Set SECURITY DEFINER on triggerkick functions. [GSM]
Bucardo version 4.4.4, released May 14, 2011
- Make sure we escape backslashes when building the
DELETE queries for pushdelta syncs [GSM]. Reported
by Gabriel Weinberg
- Report correct number of inserts/deletions in
bucardo_ctl status [GSM]. Reported by Gabriel
Weinberg
Bucardo version 4.4.3, released April 15, 2011
- Fix rare race condition when target database dies. [GSM]
Thanks to Kaveh Mousavi Zamani for the report.
Bucardo version 4.4.2, released March 17, 2011
- Fix incorrect SET TIME ZONE inside the bucardo_delta functions. [GSM]
Bucardo version 4.4.1, released November 9, 2010
- Set the search_path to prevent bogus warnings on startup about sequence
mismatches based on schema names. [GSM] (Bug #17)
- Fix failing makedelta when using multi-column primary keys.
[GSM, reported by Michelle Sullivan]
- Fix for failing swap syncs when column is not all lowercase. [GSM]
- Fix errors with bytea and swap syncs. [GSM]
- Use clock_timestamp if Postgres version is 8.2 or better. (Bug #25)
Thanks to David Christensen for digging in
and solving this.
- Fix error in bind_param for target to source. [GSM]
- Make sure we truly reset onetimecopy for persistent controllers and children. [GSM]
- If in onetimecopy mode, always create a q entry, regardless of synctype. [GSM]
- Rename the ENCODE call for bytea selects. [GSM]
- Always make the source transaction serializable. [GSM]
- Force time zone to GMT to resolve timestamptz issues with bucardo_delta
[GSM, Michelle Sullivan]
- Allow '2' as a valid sqlstate after exception thrown. [GSM]
- Fix typo with 'lowest/highest' standard conflict methods. Caught by Don Drake.
- Remove race condition from bucardo_purge_q_table() [GSM]
- Make search_path declaration LOCAL in bucardo_audit() [GSM]
- Fix bug in bucardo_purge_q_table in index detection logic. [Aolmezov]
- Don't bother comparing the 'log_cnt' field of sequences. [Rosser Schwarz]
- Do not perform a checktime kick if onetimecopy mode is on. [GSM]
- Add quote() methods to safe list for DBIx::Safe call [GSM]
- Add -vv option to bucardo_ctl as a shortcut for --verbose --verbose [GSM]
- Don't allow kicking of inactive syncs. [GSM]
- Relax SELECT version() regex in bucardo_ctl, to let modified versions
of Postgres tell us their version. [GSM]
- Change DESTDIR to INSTALL_BASE in the makefile [GSM]
- No need to look at anything but ONLY master_q for populate_child_q function. [GSM]
- Automatically create the bucardo (superuser) if we can connect as 'postgres'. [GSM]
- Allow 'bucardo_ctl status' to run even if piddir is not available. [GSM]
- Allow "schema.table" format for bucardo_ctl list tables [GSM]
- Show the database name when listing herds via bucardo_ctl. [GSM]
- Show the database name when listing sequences via bucardo_ctl. [Douglas Tan]
- Make sure we update bucardo_config.bucardo_current_version when doing
a bucardo_ctl upgrade [GSM] (Bug #5)
- Add additional clause to the the q_cleanup index. [GSM]
- Remove unused config variable 'upsert_attempts' [GSM]
- Remove unused 'kick_sleep' config variable. [GSM]
- Show additional version information on startup for debugging [GSM]
Bucardo version 4.4.0, released October 14, 2009
- Allow validate_goat() to work correctly against pgbouncer databases by
respecting the server_side_prepares parameter. [GSM]
- Loosen restrictions on customcode - now the derived columns must match
the target, but the target and source tables can be completely different. [GSM]
- Add the bucardo_audit() function that runs on all master databases, ensures
that everything related to the bucardo_* control tables is correct.
[Josh Tolley and GSM]
- Fix bucardo_ctl add sync ... tables=x - now adds the sync on first pass,
even if the tables have not been added. [GSM]
- Adding customcode via bucardo_ctl can now specify sync, goat, priority,
and active columns. [GSM]
- When viewing customcode via 'bucardo_ctl list code foo', the src_code column
is shown last. [GSM]
- Add some small sleeps before checking for stale pid files, to allow their owners
a chance to clean them up first. [GSM]
- Give a warning when kicking an inactive sync. [GSM]
- Remove 'text' casting which prevented 'bucardo_ctl inspect' from working on
older versions of Postgres. [GSM]
- Allow testing of multiple versions of Postgres at the same time by setting the
environment variables PGBINDIR[A-Z]. [GSM]
- Don't look for hard-coded string to determine if cluster is up [GSM, thanks
to Andre Felipe Machado for suggesting]
Bucardo version 4.3.0, released October 8, 2009
- Allow MCP and CTL to kill based on piddir, not just audit_pid. This will prevent duplicate
kids from existing if audit_pid is switched off. [GSM]
- Fix error in lowest/highest conflict handling. [Mathieu Arnold]
- Add new column to customcode: trigrules. Defaults to false: if true,
we turn on triggers and rules for the duration of the custom code. [GSM]
- Add a new configuration value 'host_safety_check', to help prevent
Bucardo from being copied from one host to another and then run
without modifying at least bucardo.db.dbhost first. [GSM]
- For custom code exception handlers, make the 'dbi_error' hash key return
a flattened string of the actual exception thrown. [GSM]
- Ensure exiting processes always remove their pidfile. [GSM]
- Have the MCP clean up old pid files from the piddir on startup. [GSM]
- Remove the 'pidfile' configuration option: now hard-coded to 'bucardo.mcp.pid' [GSM]
- Make the pid file names more consistent, add new ones for kid processes. [GSM]
- Refactor the killing of pids, make safer by checking they are bucardo-like [GSM]
- Remove the PIDCLEANUP option from Bucardo.pm [GSM]
- Better upgrading of very old versions of Bucardo. [GSM]
- Allow add, remove, and list customcode through bucardo_ctl [GSM]
- Allow bucardo_ctl upgrade to remove configuration settings. [GSM]
Bucardo version 4.2.2, released October 2, 2009
- Fix so that warning_file works properly again. [GSM]
Bucardo version 4.2.1, released October 1, 2009
- Improve ability of 'bucardo_ctl upgrade' to work against older
versions of Bucardo [GSM]
- Changed the chunking threshold for pushdelta to 100,000 and 10,000 [GSM]
- Make bucardo_ctl list table|sequence follow same wildcard rules as
other list nouns. [GSM]
- Remove the old 'alter' verb from bucardo_ctl: use 'update' instead [GSM]
- Fix a SQL error in 'bucardo_ctl status [GSM]
- Remove the unused t/bucardo.test.data file [GSM]
Bucardo version 4.2.0, released September 30, 2009
- Add the "delta_bypass" feature, which allows a pushdelta sync to switch
to 'fullcopy' mode on the fly, depending on the number of rows that
have changed. [GSM]
- Fixed an error preventing customselect from working in certain situations. [GSM]
- Have 'bucardo_ctl install' check for successful plperlu installation. [GSM]
- Clean up and standardize all the bucardo_ctl list/add/remove actions. [GSM]
Bucardo version 4.1.2, released September 25, 2009
- Fix sequence replication by setting is_called properly on the targets
[GSM, thanks to Selena Deckelmann for discovering this]
- Respect server_side_prepares db setting in validate_sync. Previously,
this function would fail if validating more than one table at a time
and the database was set as server_side_prepares off [GSM]
- Make sure we cast rowid* to text within the bucardo_add_delta-called
functions, for picky versions of Postgres. [GSM]
Bucardo version 4.1.1, released September 24, 2009
- Fix case where Bucardo was too eager to lock tables post serialization
failures. Since we can't really do this automatically and safely,
remove the code in question for now. [GSM, hat tip to Selena Deckelmann]
Bucardo version 4.1.0, released September 24, 2009
- Fix problem with possible function name collision when the names
of the combined columns in the primary key is greater than NAMEDATALEN,
which we'll assume is 63. [GSM]
- Add "bucardo_ctl inspect table" to show all dependencies, as well
as cross referencing against herds the table is in [GSM]
- Fix an error when validate_sync tries to recreate an existing trigger;
occurred when a fullcopy sync was set to ping=true [GSM]
- When using "bucardo_ctl add all tables db=", make sure we only
look for the already added tables for that specific database.
[Selena Deckelmann and Josh Tolley]
- Add new boolean column to the "db" table named "server_side_prepares", which
is true by default. If off, Bucardo will not use server-side prepared
statements, and thus can be used in PgBouncer's transaction mode.
[GSM, idea by Andrew Spencer]
- During pushdelta, break large number of rows for a single table until multiple
DELETE and COPY calls, to help debugging, to allow for a progress indicator
both at the Bucardo and Postgres levels, and to prevent crashes seen on
older versions of Postgres when very large IN() lists are used. [GSM]
- When using "bucardo_ctl add all tables", ignore any tables inside
schemas starting with 'bucardo' [GSM]
- Allow --verbose flag for list syncs to show linked tables [GSM]
- Allow --verbose flag for list tables to show linked herds and syncs [GSM]
- Change rebuild_index to a smallint: a 1 only runs it with a fullcopy.
If you really want to use it otherwise, set it to 2 [GSM]
- Allow the dbhost to be turned off (local socket only) in the db table
when using "bucardo_ctl update db host=non. [GSM]
Bucardo version 4.0.3, released September 16, 2009
- Fix some minor problems with bucardo_ctl and "add sync" [GSM]
- Allow ping to be specified for new tables added via "add sync" [GSM]
Bucardo version 4.0.2, released September 16, 2009
- Add the name of the database to the install choices, as some systems
have mismatched names (BSD's 'pgsql' user) [Vilem Kebrt]
- Clear out stale q entries on startup, created when a kid was hit with a
kill -9. This was causing Bucardo to think the q slot was still active. [GSM]
- Fix cases where we were not quoting the UNLISTEN names [GSM]
- Remove duplicate PID numbers from log [GSM]
- Prohibit syncs from having names reserved for synctypes. [GSM]
- Add new delete method of "truncate_cascade" for syncs [GSM]
- Allow "foo*", "*foo", and "*foo*" wildcard format in bucardo_ctl
when specifying syncs, e.g. bucardo_ctl kick ABC* [GSM]
- Allow special cases for bucardo_ctl kick: "all [synctype] [active]" [GSM]
- Allow filtering of 'bucardo_ctl list syncs' by synctype [GSM]
- Allow 'bucardo_ctl add sync tables=...' to work with schema.table format [GSM]
- Add --verbose option to 'bucardo_ctl list syncs' to show tables [GSM]
- Allow name changes for syncs, herds, dbs, dbgroups [GSM]
- Automatically add missing tables when doing
"bucardo_ctl add sync source=dbname ... tables=x,y,z" [GSM]
- Allow multiple items to be changed at one time with 'bucardo_ctl update item' [GSM]
- Change validate_sync notice to LOG [GSM]
Bucardo version 4.0.1, released September 8, 2009
- Fix to allow "add all tables db=foo" to work as expected. [GSM]
- Set audit_pid to be off by default. [GSM]
- Fix broken WHERE clause inside bucardo_ctl for "add table" [GSM]
Version 4.0.0, released September 7, 2009
New features:
- Add support for multi-column primary keys. Thanks to Backcountry.com. [GSM]
- Add new 'onetimecopy' attribute to sync table, to allow recreation on
demand of pushdelta tables on targets via COPY. [GSM]
- Support for replication after TRUNCATE. This will only work on
Postgres version 8.4 and higher, and only pushdelta syncs. [GSM]
- Add log_conflict_details to allow logging of conflict information
to a separate file. [Adam Wendt]
- Add 'maxkicks' and 'lifetime' to syncs to force restart of controller
and kids after a certain number of kicks or time. [Josh Tolley]
Thanks to Backcountry.com.
- Allow replication of sequences. [GSM]
- Add the bucardo_custom_trigger table, which allows tight control of exactly
what items in a table will be replicated. [Ben Allen]
- Add the bucardo_rate table to track exactly how long replication takes
on a per-sync and per-table basis. [GSM]
- Add more bucardo_ctl actions: install, reload, validate, restart, update [GSM]
- Allow adding of all tables and sequences in a database at once via bucardo_ctl [GSM]
- Add in bucardo_compress_delta function, to remove duplicate rows from
the bucardo_delta table. [GSM]
- Allow the injection of custom messages into the Bucardo logs, and make
an interface for same in bucardo_ctl. [GSM]
- Add the "warning_file" config parameter to log all 'Warning' messages. [GSM]
- Add validate_all_syncs() function, and allow an argument to both that
and validate_sync() to force recreation of supporting objects. [GSM]
Enhancements:
- Remove 'Moose' dependency. [GSM]
- Remove disable_triggers and disable_rules from the sync table.
We simply choose pg_class or replica based on the version of the
database in question. [GSM]
- Rewrite the pushdelta sync method to be more efficient and safer. [GSM]
- Change from Mail::Sendmail to Net::SMTP [Ben Allen]
- Allow wildcards in the 'bucardo_ctl kick' [Josh Tolley]
- Improve the FreeBSD scripts/bucardo_ctl.rc file [Ben Allen]
- Add "sendmail" option to the customcode input. [Ben Allen]
- Add 'bucardo_ctl upgrade' to make intra-version upgrades easy
and automatic. [Selena Deckelmann and GSM]
- Add more tests and improve existing ones. [Josh Tolley]
- Force READ WRITE mode so Bucardo works on read only databases. [GSM]
- Make the audit_pid table more useful. Use sequences instead of
PIDs to find children. Allow for the audit_pid table to be toggled off. [GSM]
- Remove the debugstderr and debugstdout options, as they never worked
correctly anyway. [GSM]
- When truncating during fullcopy, fallback to delete if it fails. [GSM]
- On startup, all syncs that may have trigger-based notifies are
initially kicked. [GSM]
- MCP listens for pings during table validations. [GSM]
- Have master_q use a trigger, not multiple rules. Remove the need
for a separate create_child_q() function. [GSM]
- Default for log_showtime is now 'scalar localtime' rather than
epoch seconds. [GSM]
- No longer require a reason for the "stop" action. [GSM]
- Add INSTALL_BUCARDODIR for quick and dirty 'make install' [GSM]
Bug fixes:
- Fix failure to disable/enable triggers when using pg_class and table
and schema are words changed by quote_ident. [Ben Allen]
- Tolerate incompatibility in DEFAULT of negative numbers between
Postgres 8.2 and 8.3. [Jon Jensen]
- Do better checking of bucardo_ctl executable when MCP is restarting. [Ben Allen]
- Change timestamp to timestamptz where needed inside Bucardo.pm [Yan Farmawan]
- Put schema in db_getconn calls [Alex Bahlai]
- Record the proper PID for the MCP in the pid file [Goran Gugic]
- Set the tcp_* defaults in bucardo_config to zero (system default). [GSM]
- Allow for dead columns when checking attnums. [GSM]
- Do not attempt respawn of MCP if mcp_dbproblem_sleep is 0. [GSM]
Bucardo version 3.1.0, released April 6, 2008
- Fix race condition in bucardo_delta/bucardo_track updates
for pushdelta syncs. [GSM]
- Auto-detect primary keys (or unique indexes) for added tables. [GSM]
- Add update_bucardo_schema.pl to facilitate version changes. [GSM]
- Use correct quoted/non-quoted versions of primary keys to allow
primary keys with spaces, etc. [GSM]
- Add new options to log_showtime to show non-epoch time strings [GSM]
- Make bucardo_ctl use the global version number, not its own. [GSM]
- Support bytea in primary key and regular columns. [GSM]
Bucardo version 3.0.9, released March 26, 2008
- Fix problem causing killed controller to not re-do interrupted syncs
on restart. [GSM]
Bucardo version 3.0.8, released February 5, 2008
- Fix error in 'latest' conflict code. [Adam Wendt].
- Filter out inactive target dbs from bucardo-report script.
[Spencer Christensen ]
- Fix race condition in bucardo_delta/bucardo_track updates
for pushdelta syncs. [GSM]
- Fix a sorting problem in the bucardo-report script. [Jon Jensen ]
- Fix problem with after_sync code not firing at correct time for stayalive kids. [GSM]
Bucardo version 3.0.7, released October 11, 2007
- Allow bucardo_ctl options to be specified in a .bucardorc file. [GSM]
- Add new index to bucardo_delta for faster purging. [GSM]
- Add a BSD-style rc file in the scripts directory. [Ben Allen ]
- Activate the "latest" standard_conflict method. [GSM]
- Fix error for tables with primary key and no other columns in pushdelta/swap syncs,
per report from Ben Allen. [GSM]
- Change pid and ppid columns in table "q" from smallint to integer. [Ben Allen ]
- Ensure sourcedbh used by customcode has inactivedestroy set. [GSM]
- Find system grep rather than hard-coding the path [Jeff Boes ]
- Fix for tests: make third database have a default password. [GSM]
- Add ping method to CTL and KID processes. [GSM]
Bucardo version 3.0.6 - First public release, September 1, 2007
Bucardo-5.4.1/MANIFEST0000644000175000017500000000172312601642760012672 0ustar greggreg.gitignore
.perlcriticrc
bucardo
bucardo.html
Bucardo.pm
Bucardo.pm.html
bucardo.schema
Changes
dist/bucardo-logfiles.patch
dist/bucardo.init
dist/bucardo.rc
dist/bucardo.spec
dist/README
INSTALL
LICENSE
Makefile.PL
MANIFEST
MANIFEST.SKIP
META.yml
patches/Bucardo.4.4.0.fix.search.path.patch.txt
README
README.dev
scripts/bucardo-report
scripts/bucardo_rrd
scripts/check_bucardo_sync
scripts/README
scripts/slony_migrator.pl
SIGNATURE
t/01-basic.t
t/02-bctl-customname.t
t/02-bctl-db.t
t/02-bctl-dbg.t
t/02-bctl-herd.t
t/02-bctl-sync.t
t/02-bctl-table.t
t/10-fullcopy.t
t/10-object-names.t
t/20-drizzle.t
t/10-makedelta.t
t/20-mariadb.t
t/20-mongo.t
t/20-mysql.t
t/20-oracle.t
t/20-postgres.t
t/20-redis.t
t/20-sqlite.t
t/30-crash.t
t/30-delta.t
t/40-conflict.t
t/40-customcode-exception.t
t/40-serializable.t
t/50-star.t
t/98-cleanup.t
t/99-signature.t
t/BucardoTesting.pm
t/customcode.exception.bucardotest.pl
t/ctest1.pl
t/ctest2.pl
t/ctest3.pl
dev/test_setup.sh
TODO
UPGRADE
Bucardo-5.4.1/bucardo.html0000644000175000017500000023001312601643271014040 0ustar greggreg
The bucardo script is the main interaction to a running Bucardo instance. It can be used to start and stop Bucardo, add new items, kick syncs, and even install and upgrade Bucardo itself. For more complete documentation, please view the wiki.
COMMANDS
Run bucardo help <command> for additional details
install
Installs the Bucardo configuration database.
upgrade
Upgrades the Bucardo configuration database to the latest schema.
Sends a message to all CTL and KID processes asking them to reload the Bucardo configuration.
reopen
Sends a message to all Bucardo processes asking them to reopen any log files they may have open. Call this after you have rotated the log file(s).
show all|<setting> [<setting>...]
Shows the current Bucardo settings.
<set <setting=value [<setting=value>...] >>
Sets one or more configuration setting..
ping [<timeout>]
Sends a ping notice to the MCP process to see if it will respond.
status [<status options>] <syncname> [<syncname>...]
Shows the brief status of syncs in a tabular format.
activate <syncname> [<syncname>...] [<timeout>]
Activates one or more named syncs.
deactivate <syncname> [<syncname>...] [<timeout>]
Deactivates one or more named syncs.
message <body>
Sends a message to the running Bucardo logs.
reload [<syncname> [<syncname>...]]
Sends a message to one or more sync processes, instructing them to reload.
inspect <type> <name> [<name>...]
Inspects one or more objects of a particular type.
validate all|<syncname> [<syncname>...]
Validates one or more syncs.
purge all|<table> [<table>...]
Purges the delta and track tables for one or more tables, for one or more databases.
delta [<database(s)>]
Show the delta counts for each source target.
help [<command> [<action>]]
Shows help.
OPTIONS
-d --db-name NAME Database name.
-U --db-user USER Database user name.
-P --db-pass PASS Database password.
-h --db-host HOST Database server host name.
-p --db-port PORT Database server port number.
--bucardorc FILE Use specified .bucardorc file.
--no-bucardorc Do not use .bucardorc file.
--quiet Incremental quiet.
--verbose Incremental verbose mode.
-? --help Output basic help and exit.
--version Print the version number and exit.
--dryrun Do not perform any actual actions.
--confirm Require direct confirmation before changes.
COMMAND DETAILS
Most of the commands take parameters. These may be passed after the command name and, where appropriate, an object name. Parameters take the form of key/value pairs separated by an equal sign (=). For example:
bucardo add db sea_widgets dbname=widgets host=db.example.com
Here dbname and <host> are parameters.
Many of the commands also use command-line options, which are specified in the normal way. For example, the bucardo add db command could also be written as:
bucardo add db sea_widgets --dbname widgets --dbhost db.example.com
However, parameters and options are not directly interchangeable in all cases. See the documentation for individual commands for their supported options.
install
bucardo install
Installs the Bucardo schema from the file bucardo.schema into an existing Postgres cluster. The user "bucardo" and database "bucardo" will be created first as needed. This is an interactive installer, but you can supply the following values from the command line:
--dbuser
defaults to postgres
--dbname
defaults to postgres
--dbport
defaults to 5432
--pid-dir
defaults to /var/run/bucardo/
upgrade
bucardo upgrade
Upgrades an existing Bucardo installation to the current version of the bucardo database script. Requires that bucardo and the bucardo.schema file be the same version. All changes should be backwards compatible, but you may need to re-validate existing scripts to make sure changes get propagated to all databases.
start
bucardo start "Reason"
Starts Bucardo. Fails if the MCP process is running (determined if its PID file is present). Otherwise, starts cleanly by first issuing the equivalent of a stop to ask any existing Bucardo processes to exit, and then starting a new Bucardo MCP process. A short reason and name should be provided - these are written to the reason_file file (./bucardo.restart.reason.txt by default) and sent in the email sent when Bucardo has been started up. It is also appended to the reason log, which has the same name as the the reason_file but ends in .log.
The options for the start command are:
--sendmail
Tells Bucardo whether or not to send mail on interesting events: startup, shutdown, and errors. Default is on.
--extra-name string
A short string that will be appended to the version string as output by the Bucardo process names. Mostly useful for debugging.
--log-destination destination
Determines the destination for logging output. The supported values are:
stderr
stdout
syslog
none
A file system directory.
May be specified more than once, which is useful for, e.g., logging both to a directory and to syslog. If --log-destination is not specified at all, the default is to log to files in /var/log/bucardo.
--log-separate
Forces creation of separate log files for each Bucardo process of the form "log.bucardo.X.Y", where X is the type of process (MCP, CTL, or KID), and Y is the process ID.
--log-extension string
Appends the given string to the end of the default log file name, log.bucardo. A dot is added before the name as well, so a log extension of "rootdb" would produce a log file named log.bucardo.rootdb.
--log-clean
Forces removal of all old log files before running.
--debug
--no-debug
Enable or disable debugging output. Disabled by default.
--exit-on-nosync
--no-exit-on-nosync
On startup, if Bucardo finds no active syncs, it normally will continue to run, requiring a restart once syncs are added. This is useful for startup scripts and whatnot.
If, however, you want it to exit when there are no active syncs, pass the --exit-on-nosync option. You can also be explicit that it should not exit when there are no syncs by passing --no-exit-on-nosync. This is the default value.
stop
bucardo stop "Reason"
Forces Bucardo to quit by creating a stop file which all MCP, CTL, and KID processes should detect and cause them to exit. Note that active syncs will not exit right away, as they will not look for the stop file until they have finished their current run. Typically, you should scan the list of processes after running this program to make sure that all Bucardo processes have stopped. One should also provide a reason for issuing the stop - usually this is a short explanation and your name. This is written to the reason_file file (./bucardo.restart.reason.txt by default) and is also used by Bucardo when it exits and sends out mail about its death. It is also appended to the reason log, which has the same name as the the reason_file but ends in .log.
restart
bucardo restart "Reason"
Stops bucardo, waits for the stop to complete, and then starts it again. Supports the same options as <start/start>. Useful for start scripts. For getting just CTL and KID processes to recognize newly added, updated, or removed objects, use the reload command, instead.
list
bucardo list <type> <regex>
Lists summary information about Bucardo objects. The supported types are:
database
dbgroup
relgroup
sync
table
sequence
customcode
customname
customcols
all
The all option will list information about all object types.
The optional regex option can be used to filter the list to only those matching a regular expression.
add
bucardo add <type> <name> <parameters>
Adds a new object to Bucardo. The type specifies the type of object to add, while the name should be the name of the object. The supported types include:
db
dbgroup
table
sequence
all tables
all sequences
relgroup
sync
customname
customcols
add db
bucardo add db <name> dbname=actual_name port=xxx host=xxx user=xxx
Adds one or more new databases. The name is the name by which the database will be known to Bucardo, and must be unique. This may vary from the actual database name, as multiple hosts might have databases with the same name. Multiple databases can be added by separating the names with commas. Options that differ between the databases should be separated by a matching commas. Example:
bucardo add db alpha,beta dbname=sales host=aa,bb user=bucardo
This command will attempt an immediate test connection to the added database(s). The supported named parameters are:
dbname
The actual name of the database. Required unless using a service file.
type
The type of the database. Defaults to postgres. Currently supported values are:
postgres
drizzle
mongo
mysql
maria
oracle
redis
sqlite
user
The username Bucardo should use when connecting to this database.
pass
The password Bucardo should use when connecting to this database. It is recommended that you use a .pgpass file rather than entering the password here.
host
The host Bucardo should use when connecting to this database. Defaults to the value of the $PGHOSTADDR or $PGHOST environment variables, if present.
port
The port Bucardo should use when connecting to this database. Defaults to the value of the $PGPORT environment variable, if present.
conn
Additional connection parameters, e.g. sslmode=require.
service
The service name Bucardo should use when connecting to this database.
status
Initial status of this database. Defaults to "active" but can be set to "inactive".
dbgroup
Name of the database group this database should belong to.
addalltables
Automatically add all tables from this database.
addallsequences
Automatically add all sequences from this database.
server_side_prepares
ssp
Set to 1 or 0 to enable or disable server-side prepares. Defaults to 1.
makedelta
Set to 1 or 0 to enable or disable makedelta. Defaults to 0.
Additional parameters:
--force
Forces the database to be added without running a connection test.
Note: As a convenience, if the dbuser value is its default value, "bucardo", in the event that Bucardo cannot connect to the database, it will try connecting as "postgres" and create a superuser named "bucardo". This is to make things easier for folks getting started with Bucardo, but will not work if it cannot connect as "postgres", or if it the connection failed due to an authentication failure.
add dbgroup
bucardo add dbgroup name db1:source db2:source db3:target ...
Adds one or more databases to the named dbgroup. If the dbgroup doesn't exist, it will be created. The database parameters should specify their roles, either "source" or "target".
Adds a table object. The table information will be read from the specified database. Supported parameters:
db
The name of the database from which to read the table information. Should be a name known to Bucardo, thanks to a previous call to add database. Required.
autokick
Boolean indicating whether or not the table should automatically send kick messages when it's modified. Overrides the autokick parameter of any syncs of which the table is a part.
rebuild_index
Boolean indicating whether or not to rebuild indexes after every sync. Off by default. Optional.
analyze_after_copy
Boolean indicating whether or not to analyze the table after every sync. Off by default. Optional.
vacuum_after_copy
Boolean indicating whether or not to vacuum the table after every sync. Off by default. Optional.
relgroup
Adds the table to the named relgroup. If the relgroup does not exist, it will be created. Optional.
makedelta
Turns makedelta magic on or off. Value is a list of databases which need makedelta for this table. Value can also be "on" to enable makedelta for all databases. Defaults to "off".
strict_check
Boolean indicating whether or not to be strict when comparing the table between syncs. If the columns have different names or data types, the validation will fail. But perhaps the columns are allowed to have different names or data types. If so, disable strict_check and column differences will result in warnings rather than failing the validation. Defaults to true.
The name of the database from which to read the sequence information. Should be a name known to Bucardo, thanks to a previous call to add database. Required.
relgroup
Adds the sequence to the named relgroup. If the relgroup does not exist, it will be created. Optional.
add all tables
bucardo add all tables [relgroup=xxx] [pkonly]
Adds all the tables in all known databases or in a specified database. Excludes tables in the pg_catalog, information_schema, and bucardo schemas. (Yes, this means that you cannot replicate the Bucardo configuration database using Bucardo. Sorry about that.) Supported options and parameters:
db
--db
Name of the database from which to find all the tables to add. If not provided, tables will be added from all known databases.
schema
--schema
-n
Limit to the tables in the specified comma-delimited list of schemas. The options may be specified more than once.
exclude-schema
--exclude-schema
-N
Exclude tables in the specified comma-delimited list of schemas. The options may be specified more than once.
table
--table
-t
Limit to the specified tables. The options may be specified more than once.
exclude-table
--exclude-table
-T
Exclude the specified tables. The options may be specified more than once.
relgroup
--relgroup
Name of the relgroup to which to add new tables.
pkonly
Exclude tables without primary keys.
add all sequences
bucardo add all sequences relgroup=xxx
Adds all the sequences in all known databases or in a specified database. Excludes sequences in the pg_catalog, information_schema, and bucardo schemas. (Yes, this means that you cannot replicate the Bucardo configuration database using Bucardo. Sorry about that.) Supported options and parameters:
db
--db
Name of the database from which to find all the sequences to add. If not provided, sequences will be added from all known databases.
schema
--schema
-n
Limit to the sequences in the specified comma-delimited list of schemas. The options may be specified more than once.
exclude-schema
--exclude-schema
-N
Exclude sequences in the specified comma-delimited list of schemas. The options may be specified more than once.
relgroup
--relgroup
Name of the relgroup to which to add new tables or sequences.
add relgroup
bucardo add relgroup name
bucardo add relgroup name table, sequence, ...
Adds a relgroup. After the name, pass in an optional list of tables and/or sequences and they will be added to the group.
add sync
bucardo add sync name relgroup=xxx dbs=xxx
Adds a sync, which is a named replication event containing information about what to replicate from where to where. The supported parameters are:
dbs
The name of a dbgroup or comma-delimited list of databases. All of the specified databases will be synchronized. Required.
dbgroup
The name of a dbgroup. All of the databases within this group will be part of the sync. If the dbgroup does not exists and a separate list of databases is given, the group will be created and populated.
relgroup
The name of a relgroup to synchronize. All of the tables and/or sequences in the relgroup will be synchronized. Required unless tables is specified.
tables
List of tables to add to the sync. This implicitly creates a relgroup with the same name as the sync. Required unless relgroup is specified.
status
Indicates whether or not the sync is active. Must be either "active" or "inactive". Defaults to "active".
rebuild_index
Boolean indicating whether or not to rebuild indexes after every sync. Defaults to off.
lifetime
Number of seconds a KID can live before being reaped. No limit by default.
maxkicks
Number of times a KID may be kicked before being reaped. No limit by default.
conflict_strategy
The conflict resolution strategy to use in the sync. Supported values:
bucardo_source
The rows on the "source" database always "win". In other words, in a conflict, Bucardo copies rows from source to target.
bucardo_target
The rows on the "target" database always win.
bucardo_skip
Any conflicting rows are simply not replicated. Not recommended for most cases.
bucardo_random
Each database has an equal chance of winning each time. This is the default.
bucardo_latest
The row that was most recently changed wins.
bucardo_abort
The sync is aborted on a conflict.
onetimecopy
Determines whether or not a sync should switch to a full copy mode for a single run. Supported values are:
0: off
1: always full copy
2: only copy tables that are empty on the target
stayalive
Boolean indicating whether or not the sync processes (CTL) should be persistent. Defaults to false.
kidsalive
Boolean indicating whether or not the sync child processes (KID) should be persistent. Defaults to false.
autokick
Boolean indicating whether or not tables in the sync should automatically send kick messages when they're modified. May be overridden by the autokick parameter of individual tables.
checktime
An interval specifying the maximum time a sync should go before being kicked. Useful for busy systems where you don't want the overhead of notify triggers.
priority
An integer indicating the priority of the sync. Lower numbers are higher priority. Currently used only for display purposes.
analyze_after_copy
Boolean indicating whether or not to analyze tables after every sync. Off by default. Optional.
overdue
An interval specifying the amount of time after which the sync has not run that it should be considered overdue. check_bucardo_sync issues a warning when a sync has not been run in this amount of time.
expired
An interval specifying the amount of time after which the sync has not run that it should be considered expired. check_bucardo_sync issues a critical message when a sync has not been run in this amount of time.
track_rates
Boolean indicating whether or not to track synchronization rates.
rebuild_index
Boolean indicating whether or not to rebuild indexes after every sync. Off by default. Optional.
strict_check
Boolean indicating whether or not to be strict when comparing tables in the sync. If the columns have different names or data types, the validation will fail. But perhaps the columns are allowed to have different names or data types. If so, disable strict_check and column differences will result in warnings rather than failing the validation. Defaults to true.
Creates a new Bucardo custom name mapping. This allows the tables involved in replication to have different names on different databases. The oldname must contain the schema as well as the table name (if the source database supports schemas). The optional parameters limit it to one or more databases, and/or to one or more syncs. Supported parameters:
sync
A sync to which to add the customname. May be specified multiple times.
database
db
A database for which to add the customname. May be specified multiple times.
Specify the list of columns to select from when syncing. Rather than the default SELECT * behavior, you can specify any columns you want, including the use of function call return values and things not in the source column list. The optional parameters limit it to one or more databases, and/or to one or more syncs. Some examples:
bucardo add customcols public.foobar "select a, b, c"
bucardo add customcols public.foobar "select a, upper(b) AS b, c" db=foo
bucardo add customcols public.foobar "select a, b, c" db=foo sync=abc
Supported parameters:
sync
A sync to which to add the customcols. May be specified multiple times.
database
db
A database for which to add the customcols. May be specified multiple times.
Adds a customcode, which is a Perl subroutine that can be run at certain points in the sync process. It might handle exceptions, handle conflicts, or just run at certain times with no expectation of functionality (e.g., before Bucardo drops triggers). Metadata about that point will be passed to the subroutine as a hash reference.
Supported parameters:
name
The name of the custom code object.
about
A short description of the custom code.
whenrun
when_run
A string indicating when the custom code should be run. Supported values include:
before_txn
before_check_rows
before_trigger_drop
after_trigger_drop
after_table_sync
exception
conflict
before_trigger_enable
after_trigger_enable
after_txn
before_sync
after_sync
getdbh
Boolean indicating whether or not Perl DBI database handles should be provided to the custom code subroutine. If true, database handles will be provided under the dbh key of the hash reference passed to the subroutine. The value under this key will be a hash reference mapping database names to their respective handles.
sync
Name of the sync with which to associate the custom code.
relation
Name of the table or sequence with which to associate the custom code.
status
The current status of this customcode. Anything other than "active" means the code is not run.
priority
Number indicating the priority in which order to execute custom codes. Lower numbers are higher priority. Useful for subroutines that set lastcode in order to cancel the execution of subsequent custom codes for the same when_run.
src_code
File from which to read the custom code Perl source.
The body of the Perl subroutine should be implemented in the src_code file, and not inside a sub declaration. When called, it will be passed a single hash reference with the following keys:
syncname
The name of the currently-executing sync.
version
The version of Bucardo executing the sync.
sourcename
The name of the source database.
targetname
The name of the target database.
sendmail
A code reference that can be used to send email messages.
sourcedbh
A DBI database handle to the sync source database. Provided only to custom code executed by the controller.
rellist
An array reference of hash references, each representing a relation in the sync. Provided only to custom code executed by the controller. The keys in the hash are the same as the parameters supported by "add table" and "add sequence", as appropriate.
schemaname
The schema for the table that triggered the exception. Provided only to "exception" custom codes.
tablename
The name of the table that triggered the exception. Provided only to "exception" custom codes.
error_string
The string containing the actual error message. Provided only to "exception" custom codes.
deltabin
A hash reference with the name of each source database as a key and a list of all primary keys joined together with "\0". Provided only to "exception" custom codes.
attempts
The number of times the sync has been attempted. Provided only to "exception" custom codes.
conflicts
A hash reference of conflicting rows. The keys are the primary key values, and the values are hash references with the names of the databases containing the conflicting rows and true values. Provided only to "conflict" custom codes.
The custom code subroutine may set any of these keys in the hash reference to change the behavior of the sync:
message
Message to send to the logs.
warning
A warning to emit after the subroutine has returned.
error
An error to be thrown after the subroutine has returned.
nextcode
Set to send execution to the next custom code of the same type. Mainly useful to exception custom codes, and supported only by custom codes executed by the controller.
lastcode
Set to true to have any subsequent custom codes of the same type to be skipped.
endsync
Cancels the sync altogether.
An example:
use strict;
use warnings;
use Data::Dumper;
my $info = shift;
# Let's open a file.
my $file = '/tmp/bucardo_dump.txt';
open my $fh, '>:encoding(UTF-8)', $file or do {
$info->{warning} = "Cannot open $file: $!\n";
return;
};
# Inspect $info for fun.
print $fh Dumper $info;
close $fh or $info->{warning} = "Error closing $file: $!\n";
# Log a message and return.
$info->{message} = 'IN UR DATABASEZ NORMALIZIN UR RELAYSHUNS';
return;
update
bucardo update <type> <name> <parameters>
Updates a Bucardo object. The type specifies the type of object to update, while the name should be the name of the object. The supported parameters for each type are the same as those for "add". The supported types are:
customcode
db
sync
table
sequence
update customcode
bucardo update customcode <name> setting=value
Updates an existing customcode. Items that can be changed are:
about
A short description of the custom code.
getdbh
Boolean indicating whether or not Perl DBI database handles should be provided to the custom code subroutine. If true, database handles will be provided under the dbh key of the hash reference passed to the subroutine. The value under this key will be a hash reference mapping database names to their respective handles.
name
The name of the custom code object.
priority
Number indicating the priority in which order to execute custom codes. Lower numbers are higher priority. Useful for subroutines that set lastcode in order to cancel the execution of subsequent custom codes for the same when_run.
status
The current status of this customcode. Anything other than "active" means the code is not run.
whenrun
A string indicating when the custom code should be run. Supported values include:
before_txn
before_check_rows
before_trigger_drop
after_trigger_drop
after_table_sync
exception
conflict
before_trigger_enable
after_trigger_enable
after_txn
before_sync
after_sync
update db
bucardo udpate db <name> port=xxx host=xxx user=xxx pass=xxx
Updates a database. The name is the name by which the database is known to Bucardo. This may vary from the actual database name, as multiple hosts might have databases with the same name.
The supported named parameters are:
dbname
db
The actual name of the database.
type
dbtype
The type of the database. Currently supported values are:
postgres
drizzle
mongo
mysql
maria
oracle
redis
sqlite
username
dbuser
user
The username Bucardo should use to connect to the database.
password
dbpass
pass
The password Bucardo should use when connecting to the database.
Status of the database in Bucardo. Must be either "active" or "inactive".
dbgroup
server_side_prepares
ssp
Enable or disable server-side prepares. Pass 1 to enable them or 0 to disable them.
makedelta
Enable or disable makedelta for this database.
dbservice
service
The service name to use for a Postgres database.
dbgroup
A comma-separated list of dbgroups to which to add the database. The database will be removed from any other dbgroups of which it was previously a member.
update sync
bucardo update sync syncname relgroup=xxx dbs=xxx
Updates a sync, which is a named replication event containing information about what to replicate from where to where. The supported parameters are:
name
The name of the sync. Required.
dbs
The name of a dbgroup or comma-delimited list of databases.
relgroup
The name of a relgroup to synchronize.
status
Indicates whether or not the sync is active. Must be either "active" or "inactive". Note that this will not change the current run status of the sync, just mark whether it should be active or inactive on the next reload. Use the activate sync and <deactivate sync> commands to actually activate or deactivate a sync.
rebuild_index
Boolean indicating whether or not to rebuild indexes after every sync.
lifetime
Number of seconds a KID can live before being reaped.
maxkicks
Number of times a KID may be kicked before being reaped.
isolation_level
The transaction isolation level this sync should use. Only choices are "serializable" and "repeatable read"
conflict_strategy
The conflict resolution strategy to use in the sync. Supported values:
bucardo_source
The rows on the "source" database always "win". In other words, in a conflict, Bucardo copies rows from source to target.
bucardo_target
The rows on the "target" database always win.
bucardo_skip
Any conflicting rows are simply not replicated. Not recommended for most cases.
bucardo_random
Each database has an equal chance of winning each time.
bucardo_latest
The row that was most recently changed wins.
bucardo_abort
The sync is aborted on a conflict.
onetimecopy
Determines whether or not a sync should switch to a full copy mode for a single run. Supported values are:
0: off
1: always full copy
2: only copy tables that are empty on the target
stayalive
Boolean indicating whether or not the sync processes (CTL) should be persistent.
kidsalive
Boolean indicating whether or not the sync child processes (KID) should be persistent.
autokick
Boolean indicating whether or not tables in the sync should automatically send kick messages when they're modified. May be overridden by the autokick parameter of individual tables.
checktime
An interval specifying the maximum time a sync should go before being kicked. Useful for busy systems where you don't want the overhead of notify triggers.
priority
An integer indicating the priority of the sync. Lower numbers are higher priority. Currently used only for display purposes.
analyze_after_copy
Boolean indicating whether or not to analyze tables after every sync. Off by default.
overdue
An interval specifying the amount of time after which the sync has not run that it should be considered overdue. check_bucardo_sync issues a warning when a sync has not been run in this amount of time.
expired
An interval specifying the amount of time after which the sync has not run that it should be considered expired. check_bucardo_sync issues a critical message when a sync has not been run in this amount of time.
track_rates
Boolean indicating whether or not to track synchronization rates.
rebuild_index
Boolean indicating whether or not to rebuild indexes after every sync.
strict_check
Boolean indicating whether or not to be strict when comparing tables in the sync. If the columns have different names or data types, the validation will fail. But perhaps the columns are allowed to have different names or data types. If so, disable strict_check and column differences will result in warnings rather than failing the validation. Defaults to true.
Updates a table object. The table information will be read from the specified database. Supported parameters:
db
The name of the database from which to read the table information. Should be a name known to Bucardo.
schemaname
The name of the schema in which the table is found.
tablename
The actual name of the table.
autokick
Boolean indicating whether or not the table should automatically send kick messages when it's modified. Overrides the autokick parameter of any syncs of which the table is a part.
rebuild_index
Boolean indicating whether or not to rebuild indexes after every sync.
analyze_after_copy
Boolean indicating whether or not to analyze the table after every sync.
vacuum_after_copy
Boolean indicating whether or not to vacuum the table after every sync.
relgroup
Adds the table to the named relgroup. May be specified more than once. The table will be removed from any other relgroups.
makedelta
Specifies which databases need makedelta enabled for this table.
strict_check
Boolean indicating whether or not to be strict when comparing the table between syncs. If the columns have different names or data types, the validation will fail. But perhaps the columns are allowed to have different names or data types. If so, disable strict_check and column differences will result in warnings rather than failing the validation. Defaults to true.
The name of the database where the sequence lives.
schemaname
The name of the schema in which the sequence is found.
relgroup
Adds the sequence to the named relgroup. May be speci<fied more than once. The sequence will be removed from any other relgroups.
remove
bucardo remove <item_type> <item_name>
Removes one or more objects from Bucardo. Valid item types are;
db or database
Use the --force option to clear out related tables and groups instead of erroring out.
dbgroup
relgroup
sync
table
sequence
customcols
customname
customcode
kick
bucardo kick <syncname(s)> [timeout]
Tells one or more named syncs to fire as soon as possible. Note that this simply sends a request that the sync fire: it may not start right away if the same sync is already running, or if the source or target database has exceeded the number of allowed Bucardo connections. If the final argument is a number, it is treated as a timeout. If this number is zero, the bucardo command will not return until the sync has finished. For any other number, the sync will wait at most that number of seconds. If any sync has not finished before the timeout, an exit value of 1 will be returned. Errors will cause exit values of 2 or 3. In all other cases, an exit value of 0 will be returned.
If a timeout is given, the total completion time in seconds is also displayed. If the sync is going to multiple targets, the time that each target takes from the start of the kick is also shown as each target finishes. Options:
--retry
The number of times to retry a sync if it fails. Defaults to 0.
--retry-sleep
How long to sleep, in seconds, between each retry attempt.
--notimer
By default, kicks with a timeout argument give a running real-time summary of time elapsed by using the backspace character. This may not be wanted if running a kick, for example, via a cronjob, so turning --notimer on will simply print the entire message without backspaces.
pause
bucardo pause <syncname(s)>
bucardo pause all
bucardo resume <syncname(s)>
bucardo resume all
Tells one or more named syncs to temporarily pause, or to resume from a previous pause. This only applies to active syncs and only takes effect if Bucardo is currently running. The keyword 'all' can be used as well to pause or resume all known active syncs.
reload config
bucardo reload config
bucardo reload config 30
Sends a message to all CTL and KID processes asking them to reload the Bucardo configuration. This configuration is a series of key/value pairs that configure Bucardo's behavior, and not any of the objects managed by the add, remove, or update commands.
By default, Bucardo will send the message and then exit. Pass an optional number and Bucardo will instead wait up to that length of time for all child processes to report completion.
set
bucardo set setting1=value [setting2=value]
Sets one or more configuration setting table. Setting names are case-insensitive. The available settings are:
autosync_ddl
Which DDL changing conditions do we try to remedy automatically? Default: newcol.
bucardo_version
Current version of Bucardo. Default: 5.4.1.
bucardo_vac
Do we want the automatic VAC daemon to run? Default: 1.
bucardo_initial_version
Bucardo version this schema was created with. Default: 5.4.1.
ctl_checkonkids_time
How often does the controller check on the kids health? Default: 10.
ctl_createkid_time
How long do we sleep to allow kids-on-demand to get on their feet? Default: 0.5.
ctl_sleep
How long does the controller loop sleep? Default: 0.2.
default_conflict_strategy
Default conflict strategy for all syncs. Default: bucardo_latest.
default_email_from
Who the alert emails are sent as. Default: nobody@example.com.
default_email_host
Which host to send email through. Default: localhost.
default_email_to
Who to send alert emails to. Default: nobody@example.com.
email_debug_file
File to save a copy of all outgoing emails to. Default: None.
endsync_sleep
How long do we sleep when custom code requests an endsync? Default: 1.0.
flatfile_dir
Directory to store the flatfile output inside of. Default: ..
host_safety_check
Regex to make sure we don't accidentally run where we should not. Default: None.
isolation_level
The transaction isolation level all sync should use. Defaults to 'serializable'. The only other valid option is 'repeatable read'
kid_deadlock_sleep
How long to sleep in seconds if we hit a deadlock error. Default: 0.5. Set to -1 to prevent the kid from retrying.
kid_nodeltarows_sleep
How long do kids sleep if no delta rows are found? Default: 0.5.
kid_pingtime
How often do we ping check the KID? Default: 60.
kid_restart_sleep
How long to sleep in seconds when restarting a kid? Default: 1.
kid_serial_sleep
How long to sleep in seconds if we hit a serialization error. Default: 0.5. Set to -1 to prevent the kid from retrying.
kid_sleep
How long does a kid loop sleep? Default: 0.5.
log_conflict_file
Name of the conflict detail log file. Default: bucardo_conflict.log.
log_level
How verbose to make the logging. Higher is more verbose. Default: normal.
log_microsecond
Show microsecond output in the timestamps? Default: 0.
log_showlevel
Show log level in the log output? Default: 0.
log_showline
Show line number in the log output? Default: 0.
log_showpid
Show PID in the log output? Default: 1.
log_showtime
Show timestamp in the log output? 0=off 1=seconds since epoch 2=scalar gmtime 3=scalar localtime. Default: 3.
mcp_dbproblem_sleep
How many seconds to sleep before trying to respawn. Default: 15.
mcp_loop_sleep
How long does the main MCP daemon sleep between loops? Default: 0.2.
mcp_pingtime
How often do we ping check the MCP? Default: 60.
mcp_vactime
How often in seconds do we check that a VAC is still running? Default: 60.
File to hold reasons for stopping and starting. Default: bucardo.restart.reason.txt.
reload_config_timeout
Number of seconds the reload_config command should wait for the reload to complete. Default: 30.
semaphore_table
Table to let apps know a sync is ongoing. Default: bucardo_status.
statement_chunk_size
How many primary keys to shove into a single statement. Default: 10000.
stats_script_url
Location of the stats script. Default: http://www.bucardo.org/.
stopfile
Name of the semaphore file used to stop Bucardo processes. Default: fullstopbucardo.
syslog_facility
Which syslog facility level to use. Default: log_local1.
tcp_keepalives_count
How many probes to send. 0 indicates sticking with system defaults. Default: 0.
tcp_keepalives_idle
How long to wait between each keepalive probe. Default: 0.
tcp_keepalives_interval
How long to wait for a response to a keepalive probe. Default: 0.
vac_run
How often does the VAC process run? Default: 30.
vac_sleep
How long does VAC process sleep between runs? Default: 120.
warning_file
File containing all log lines starting with "Warning". Default: bucardo.warning.log.
show
bucardo show all|<setting> [<setting>...]
Shows the current Bucardo settings. Use the keyword "all" to see all the settings, or specify one or more search terms. See "set" for complete details on the configuration settings.
config
bucardo config show all|<setting> [<setting>...]
bucardo config set <setting=value> [<setting=value>...]
Deprecated interface for showing and setting configuration settings. Use the "show" and "set" commands, instead.
ping
bucardo ping
bucardo ping 60
bucardo ping 0
Sends a ping notice to the MCP process to see if it will respond. By default, it will wait 15 seconds. A numeric argument will change this timeout. Using a 0 as the timeout indicates waiting forever. If a response was returned, the program will exit with a value of 0. If it times out, the value will be 1. Returns a Nagios like message starting with "OK" or "CRITICAL" for success or failure.
status
bucardo status [syncname(s)] [--sort=#] [--show-days] [--compress]
Shows the brief status of all known syncs in a tabular format. If given one or more sync names, shows detailed information for each one. To see detailed information for all syncs, simply use "status all"
When showing brief information, the columns are:
1. Name
The name of the sync
2. State
The state of the sync. Can be 'Good', 'Bad', 'Empty', 'No records found', 'Unknown', or the run state for a currently-running sync.
3. Last good
When the sync last successfully ran.
4. Time
How long it has been since the last sync success
5. Last I/U
The number of insert and deletes performed by the last successful sync. May also show the number of rows truncated (T) or conflicted (C), if applicable.
6. Last bad
When the sync last failed.
7. Time
How long it has been since the last sync failure
The options for status are:
--show-days
Specifies whether or not do list the time interval with days, or simply show the hours. For example, "3d 12h 6m 3s" vs. "48h 6m 3s"
--compress
Specifies whether or not to compress the time interval by removing spaces. Mostly used to limit the width of the 'status' display.
--sort=#
Requests sorting of the 'status' output by one of the nine columns. Use a negative number to reverse the sort order.
Activates one or more named syncs. If given a timeout argument, it will wait until it has received confirmation from Bucardo that each sync has been successfully activated.
Deactivates one or more named syncs. If given a timeout argument, it will wait until it has received confirmation from Bucardo that the sync has been successfully deactivated.
message
bucardo message 'I WAS HERE'
Sends a message to the running Bucardo logs. This message will appear prefixed with "MESSAGE: ". If Bucardo is not running, the message will go to the logs the next time Bucardo runs and someone adds another message.
reload
bucardo reload [syncname2 syncname3 ...]
Sends a message to one or more sync processes, instructing them to reload. Waits for each to reload before going on to the next. Reloading consists of deactivating a sync, reloading its information from the database, and activating it again.
inspect
bucardo inspect <type> <name> [<name2>...]
Inspects one or more objects of a particular type. The results are sent to STDOUT. The supported types include:
table
sync
relgroup
validate
bucardo validate all|<sync> [<sync>...]
Validates one or more syncs. Use the keyword "all" to validate all syncs, or specify one or more syncs to validate.
Note that this command executes a subset of all the validation done when a sync is started or activated.
purge
bucardo purge all|<table> [<table>...]
Purges the delta and track tables for one or more tables, for one or more databases. Use the keyword "all" to validate all tables, or specify one or more tables to validate.
delta
bucardo delta [total] [<database>...]
Show the current delta count for each source target. Provide a list of databases to limit it to just the given ones. Wildcards are allowed. Use the special name "totals" to show only the grand total.
help
bucardo help
bucardo help <command>
bucardo help <command> <action>
Get help. General help can be returned, as well as help for a single command or a command and its action. Some examples:
bucard help list
bucard help add table
OPTIONS DETAILS
It is usually easier to set most of these options at the top of the script, or make an alias for them, as they will not change very often if at all.
-d
--db-name
bucardo --db-name widgets
bucardo -d bricolage
Name of the Bucardo database to which to connect.
-U
--db-user
bucardo --db-user postgres
bucardo -U Mom
User name to use when connecting to the Bucardo database.
-P
--db-pass
bucardo --db-pass s3cr1t
bucardo -P lolz
Password to use when connecting to the Bucardo database.
Host name to use when connecting to the Bucardo database.
-p
--db-port
bucardo --db-port 7654
Port number to connect to when connecting to the Bucardo database.
--bucardorc
bucardo --bucardorc myrcfile
Use the specified file for configuration instead of the default ./.bucardorc.
--no-bucardorc
Do not use the ./.bucardorc configuration file.
--verbose
Makes bucardo run verbosely. Default is off.
--quiet
Tells bucardo to be as quiet as possible. Default is off.
--help
Shows a brief summary of usage for bucardo.
FILES
In addition to command-line configurations, you can put any options inside of a file. The file .bucardorc in the current directory will be used if found. If not found, then the file ~/.bucardorc will be used. Finally, the file /etc/bucardorc will be used if available. The format of the file is option = value, one per line. Any line starting with a '#' will be skipped. Any values loaded from a bucardorc file will be overwritten by command-line options. All bucardorc files can be ignored by supplying a --no-bucardorc argument. A specific file can be forced with the --bucardorc=file option; if this option is set, bucardo will refuse to run unless that file can be read.
ENVIRONMENT VARIABLES
The bucardo script uses $ENV{HOME} to look for a .bucardorc file.
This program is free to use, subject to the limitations in the LICENSE file.
Bucardo-5.4.1/UPGRADE0000644000175000017500000000421412311341640012540 0ustar greggregThese directions are for upgrading an existing Bucardo installation.
If you encounter any problems, please email the mailing list at
bucardo-general@bucardo.org.
Ideally, upgrading Bucardo takes just five steps:
1. Install the new Bucardo programs
2. Stop Bucardo
3. Upgrade the Bucardo database
4. Re-validate all syncs
5. Start Bucardo
Each step is detailed below.
1. Install the new Bucardo programs
As with an install, just untar the file (or git pull), then run:
perl Makefile.PL
make
make test
make install
The first three steps should be done as a non-superuser. Thus, the final
step should be done on some systems as:
sudo make install
This will replace the existing Bucardo.pm file, the bucardo script, the
bucardo.schema file, and the associated man pages.
2. Stop Bucardo
Because we may be making schema changes, it is safest to stop Bucardo while
the upgrade is performed. This can be done by running:
./bucardo stop
3. Upgrade the Bucardo database
The bucardo script has an 'upgrade' command that connects to the
existing Bucardo database and upgrades the schema as needed.
./bucardo upgrade
Note:
* This must be run on every Bucardo instance you have (most sites only use one)
You should see a summary of any changes made, and then given a chance to
accept or reject the changes. You may want to run it again after, to double
check that the upgrade worked and no further changes are needed.
A summary of all changes is stored in the bucardo.upgrade_log table.
4. Re-validate all syncs
Because there may have been schema changes on the remote databases, you may
have to run the validate_sync() function against each of your syncs. This command
will connect to each remote database and do things like verify that all
bucardo-related functions and tables are installed correctly. The easiest way to
do this is by running:
./bucardo validate all
Alternatively, you can specify one or more syncs like so:
./bucardo validate sync1 sync2
5. Restart Bucardo
The final step is to restart Bucardo:
./bucardo start "Upgrade"
It's probably a good idea to check out the Bucardo log at this point and make
sure everything is working properly.
Bucardo-5.4.1/t/0000755000175000017500000000000012601643631011777 5ustar greggregBucardo-5.4.1/t/02-bctl-sync.t0000644000175000017500000000206512311341640014275 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test adding, dropping, and changing databases via bucardo
## Tests the main subs: add_database, list_databases, update_database, remove_database
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More tests => 1;
use vars qw/$t $res $command $dbhX $dbhA $dbhB/;
use BucardoTesting;
my $bct = BucardoTesting->new({notime=>1})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = '';
## Make sure A and B are started up
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Grab connection information for each database
my ($dbuserA,$dbportA,$dbhostA) = $bct->add_db_args('A');
my ($dbuserB,$dbportB,$dbhostB) = $bct->add_db_args('B');
pass('No tests for this yet');
exit;
END {
$bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
}
Bucardo-5.4.1/t/10-fullcopy.t0000644000175000017500000000737012566674070014261 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test fullcopy functionality
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use BucardoTesting;
my $bct = BucardoTesting->new({sync => 'fctest', location => 'fullcopy'})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
my $numtables = keys %tabletype;
my $numsequences = keys %sequences;
my $single_tests = 14;
my $table_tests = 2;
my $numdatabases = 3;
plan tests => $single_tests +
( $table_tests * $numtables * $numdatabases ) +
( 1 * $numsequences );
pass("*** Beginning 'fullcopy' tests");
use vars qw/ $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t %pkey $SQL %sth %sql/;
use vars qw/ $i $result /;
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
$dbhD and $dbhD->disconnect();
}
## Get A, B, C, and D created, emptied out, and repopulated with sample data
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
$dbhD = $bct->repopulate_cluster('D');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Teach Bucardo about four databases
for my $name (qw/ A B C D /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
## Put all tables (including non-PK) into a herd
$t = q{Adding all tables on the master works};
$res = $bct->ctl(q{bucardo add tables '*bucardo*test*' '*Bucardo*test*' db=A herd=all});
like ($res, qr/Created the relgroup named "all".*are now part of/s, $t);
## Add all sequences as well
$t = q{Adding all tables on the master works};
$res = $bct->ctl(q{bucardo add sequences all herd=all});
like ($res, qr/New sequences added/s, $t);
## Add sequences to their own herd and sync
$t = q{Adding all sequences to a new sync works};
$res = $bct->ctl(q{bucardo add sequences all herd=seqonly});
like ($res, qr/Creating relgroup: seqonly/s, $t);
## Create a new dbgroup going from A to B and C and D
$t = q{Created a new fullcopy dbgroup A -> B C D};
$res = $bct->ctl('bucardo add dbgroup pg A:source B:fullcopy C:fullcopy D:fullcopy');
like ($res, qr/Created dbgroup "pg"/, $t);
## Create a new sync
$t = q{Created a new sync};
$res = $bct->ctl('bucardo add sync fctest herd=all dbs=pg');
like ($res, qr/Added sync "fctest"/, $t);
## Create a new sync for the sequences only
$t = q{Created a new sync};
$res = $bct->ctl('bucardo add sync seqtest herd=seqonly dbs=A:source,B:Source,C:target');
like ($res, qr/Added sync "seqtest"/, $t);
## Start up Bucardo with this new sync.
## No need to wait for the sync, as fullcopy syncs don't auto-run
$bct->restart_bucardo($dbhX);
## Add a row to each table in database A
$bct->add_row_to_database('A', 2);
## Kick off the sync and wait for it to return
$bct->ctl('bucardo kick fctest 0');
## Check targets for the new rows
$bct->check_for_row([[2]], [qw/ B C D/]);
## Do insert, update, and delete to targets
$bct->add_row_to_database('B',3);
$bct->remove_row_from_database('C', 2);
## Change the sequence on A
$dbhA->do('alter sequence bucardo_test_seq1 start 20 restart 25 minvalue 10 maxvalue 100');
$dbhA->commit();
## Kick off the sync, then check that everything was replaced
$bct->ctl('bucardo kick fctest 0');
$bct->check_for_row([[2]], [qw/ B C D/]);
$bct->check_sequences_same([qw/A B C D/]);
## Test a sequence-only sync
$bct->ctl('bucardo kick seqtest 0');
pass("*** End 'fullcopy' tests");
exit;
Bucardo-5.4.1/t/10-object-names.t0000644000175000017500000000675612563002233014761 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test handling of object names
use 5.008003;
use strict;
use warnings;
use utf8;
use open qw( :std :utf8 );
use charnames ':full';
use lib 't','.';
use DBD::Pg;
use Test::More;
my $dbdpgversion = $DBD::Pg::VERSION;
(my $majorversion = $dbdpgversion) =~ s/^(\d+).*/$1/;
if ($majorversion < 3) {
plan (skip_all => "Test skipped unless DBD::Pg is version 3 or higher: this is $dbdpgversion");
}
plan tests => 20;
use BucardoTesting;
my $bct = BucardoTesting->new({ location => 'makedelta' })
or BAIL_OUT "Creation of BucardoTesting object failed\n";
END { $bct->stop_bucardo if $bct }
ok my $dbhA = $bct->repopulate_cluster('A'), 'Populate cluster A';
ok my $dbhB = $bct->repopulate_cluster('B'), 'Populate cluster B';
ok my $dbhC = $bct->repopulate_cluster('C'), 'Populate cluster C';
ok my $dbhD = $bct->repopulate_cluster('D'), 'Populate cluster D';
ok my $dbhX = $bct->setup_bucardo('A'), 'Set up Bucardo';
END { $_->disconnect for grep { $_ } $dbhA, $dbhB, $dbhC, $dbhD, $dbhX }
# Teach Bucardo about the databases.
for my $db (qw(A B C D)) {
my ($user, $port, $host) = $bct->add_db_args($db);
like $bct->ctl(
"bucardo add db $db dbname=bucardo_test user=$user port=$port host=$host"
), qr/Added database "$db"/, qq{Add database "$db" to Bucardo};
}
for my $arr ((['A','B'], ['C','D'])) {
my ($src, $dest) = @$arr;
like $bct->ctl("bucardo add table bucardo_test1 db=$src relgroup=myrels_$src"),
qr/Added the following tables/, "Added table in db $src ";
like $bct->ctl("bucardo add sync test_$src relgroup=myrels_$src dbs=$src:source,$dest:target"),
qr/Added sync "test_$src"/, "Create sync from $src to $dest";
}
# Now remove syncs, for easier testing
map { $bct->ctl('bucardo remove sync $_') } qw/A C/;
# Remove a table from just database C
like $bct->ctl('bucardo remove table public.bucardo_test1 db=C'),
qr/Removed the following tables:\s*\n\s+public.bucardo_test1 \(DB: C\)/,
"Removed table from just one database";
## Test non-ASCII characters in table names
## XXX Probably ought to test non-ASCII schemas as well, as well as different client_encoding values
for my $dbh (($dbhA, $dbhB)) {
$dbh->do(qq/CREATE TABLE test_büçárđo ( pkey_\x{2695} INTEGER PRIMARY KEY, data TEXT );/);
$dbh->commit;
}
## XXX TODO: Make sync names and relgroup names with non-ASCII characters work
like $bct->ctl('bucardo add table test_büçárđo db=A relgroup=unicode'),
qr/Added the following tables/, "Added table in db A";
like($bct->ctl("bucardo add sync test_unicode relgroup=unicode dbs=A:source,B:target"),
qr/Added sync "test_unicode"/, "Create sync from A to B")
or BAIL_OUT "Failed to add test_unicode sync";
$dbhA->do("INSERT INTO test_büçárđo (pkey_\x{2695}, data) VALUES (1, 'Something')");
$dbhA->commit;
## Get Bucardo going
$bct->restart_bucardo($dbhX);
## Kick off the sync.
my $timer_regex = qr/\[0\s*s\]\s+(?:[\b]{6}\[\d+\s*s\]\s+)*/;
like $bct->ctl('kick sync test_unicode 0'),
qr/^Kick\s+test_unicode:\s+${timer_regex}DONE!/,
'Kick test_unicode' or die 'Sync failed, no point continuing';
my $res = $dbhB->selectall_arrayref('SELECT * FROM test_büçárđo');
ok($#$res == 0 && $res->[0][0] == 1 && $res->[0][1] eq 'Something', 'Replication worked');
END {
$bct and $bct->stop_bucardo();
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
$dbhD and $dbhD->disconnect();
}
Bucardo-5.4.1/t/20-sqlite.t0000644000175000017500000002444712563002233013711 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test using SQLite as a database target
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use vars qw/ $bct $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t %pkey $SQL %sth %sql/;
## Must have the DBD::SQLite module
my $evalok = 0;
eval {
require DBD::SQLite;
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => 'Cannot test SQLite unless the Perl module DBD::SQLite is installed');
}
## SQLite must be up and running
$evalok = 0;
my $dbh;
my $dbuser = 'root';
my $dbname = 'test.sqlite.db';
eval {
$dbh = DBI->connect("dbi:SQLite:dbname=$dbname", $dbuser, '',
{AutoCommit=>1, PrintError=>0, RaiseError=>1});
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => "Cannot test SQLite as we cannot connect to a SQLite database: $@");
}
use BucardoTesting;
## For now, remove the bytea table type as we don't have full SQLite support yet
for my $num (2,8,10) {
delete $tabletype{"bucardo_test$num"};
}
my $numtabletypes = keys %tabletype;
plan tests => 91;
## Create one table for each table type
for my $table (sort keys %tabletype) {
$dbh->do(qq{DROP TABLE IF EXISTS "$table"});
my $pkeyname = $table =~ /test5/ ? q{"id space"} : 'id';
my $pkindex = $table =~ /test2/ ? '' : 'PRIMARY KEY';
$SQL = qq{
CREATE TABLE "$table" (
$pkeyname $tabletypesqlite{$table} NOT NULL $pkindex};
$SQL .= $table =~ /X/ ? "\n)" : qq{,
data1 VARCHAR(100) NULL,
inty SMALLINT NULL,
booly BOOLEAN NULL, -- Treated as NUMERIC by SQLite
bite1 VARBINARY(999) NULL,
bite2 VARBINARY(999) NULL,
email VARCHAR(100) NULL UNIQUE
)
};
$dbh->do($SQL);
}
$bct = BucardoTesting->new() or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = 'sqlite';
pass("*** Beginning sqlite tests");
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
}
## Get Postgres database A and B and C created
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Tell Bucardo about these databases
## Three Postgres databases will be source, source, and target
for my $name (qw/ A B C /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
$t = 'Adding sqlite database Q works';
$command =
"bucardo add db Q dbname=$dbname type=sqlite dbuser=$dbuser";
$res = $bct->ctl($command);
like ($res, qr/Added database "Q"/, $t);
## Teach Bucardo about all pushable tables, adding them to a new relgroup named "trelgroup"
$t = q{Adding all tables on the master works};
$command =
"bucardo add tables all db=A relgroup=trelgroup pkonly";
$res = $bct->ctl($command);
like ($res, qr/Creating relgroup: trelgroup.*New tables added: \d/s, $t);
## Add all sequences, and add them to the newly created relgroup
$t = q{Adding all sequences on the master works};
$command =
"bucardo add sequences all db=A relgroup=trelgroup";
$res = $bct->ctl($command);
like ($res, qr/New sequences added: \d/, $t);
## Create a new dbgroup
$t = q{Created a new dbgroup};
$command =
"bucardo add dbgroup qx A:source B:source C Q";
$res = $bct->ctl($command);
like ($res, qr/Created dbgroup "qx"/, $t);
## Create a new sync
$t = q{Created a new sync};
$command =
"bucardo add sync sqlite relgroup=trelgroup dbs=qx autokick=false";
$res = $bct->ctl($command);
like ($res, qr/Added sync "sqlite"/, $t);
## Create a second sync, solely for multi-sync interaction issues
$bct->ctl('bucardo add dbgroup t1 A:source B C');
$bct->ctl('bucardo add sync tsync1 relgroup=trelgroup dbs=t1 autokick=false status=inactive');
## Start up Bucardo with these new syncs
$bct->restart_bucardo($dbhX);
## Get the statement handles ready for each table type
for my $table (sort keys %tabletype) {
$pkey{$table} = $table =~ /test5/ ? q{"id space"} : 'id';
## INSERT
my (@boolys) = qw( xxx true false null false true null );
for my $x (1..6) {
$SQL = $table =~ /X/
? qq{INSERT INTO "$table"($pkey{$table}) VALUES (?)}
: qq{INSERT INTO "$table"($pkey{$table},data1,inty,booly) VALUES (?,'foo',$x,$boolys[$x])};
$sth{insert}{$x}{$table}{A} = $dbhA->prepare($SQL);
if ('BYTEA' eq $tabletype{$table}) {
$sth{insert}{$x}{$table}{A}->bind_param(1, undef, {pg_type => PG_BYTEA});
}
}
## SELECT
$sql{select}{$table} = qq{SELECT inty,booly FROM "$table" ORDER BY $pkey{$table}};
$table =~ /X/ and $sql{select}{$table} =~ s/inty/$pkey{$table}/;
## DELETE ALL
$SQL = qq{DELETE FROM "$table"};
$sth{deleteall}{$table}{A} = $dbhA->prepare($SQL);
## DELETE ONE
$SQL = qq{DELETE FROM "$table" WHERE inty = ?};
$sth{deleteone}{$table}{A} = $dbhA->prepare($SQL);
## TRUNCATE
$SQL = qq{TRUNCATE TABLE "$table"};
$sth{truncate}{$table}{A} = $dbhA->prepare($SQL);
## UPDATE
$SQL = qq{UPDATE "$table" SET inty = ?};
$sth{update}{$table}{A} = $dbhA->prepare($SQL);
}
## Add one row per table type to A
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
}
## Before the commit on A, B and C should be empty
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
$t = qq{B has not received rows for table $table before A commits};
$res = [];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
## Commit, then kick off the sync
$dbhA->commit();
$bct->ctl('bucardo kick sqlite 0');
$bct->ctl('bucardo kick sqlite 0');
## Check B and C for the new rows
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
$t = qq{Row with pkey of type $type gets copied to B};
$res = [[1,1]];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
## Check that SQLite has the new rows
for my $table (sort keys %tabletype) {
$t = "SQLite table $table has correct entries";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $info = $sth->fetchall_arrayref({})->[0];
my $type = $tabletype{$table};
my $id = $val{$type}{1};
my $pkeyname = $table =~ /test5/ ? 'id space' : 'id';
## Datetime has no time zone thingy at the end
$tabletypesqlite{$table} =~ /DATETIME/ and $id =~ s/\+.*//;
is_deeply(
$info,
{
$pkeyname => $id,
inty => 1,
email => undef,
bite1 => undef,
bite2 => undef,
data1 => 'foo',
booly => 1,
},
$t);
}
## Update each row
for my $table (keys %tabletype) {
$sth{update}{$table}{A}->execute(42);
}
$dbhA->commit();
$bct->ctl('bucardo kick sqlite 0');
for my $table (keys %tabletype) {
$t = "SQLite table $table has correct number of rows after update";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
$sth->execute();
$t = "SQLite table $table has updated value";
my $info = $sth->fetchall_arrayref({})->[0];
is ($info->{inty}, 42, $t);
}
## Delete each row
for my $table (keys %tabletype) {
$sth{deleteall}{$table}{A}->execute();
}
$dbhA->commit();
$bct->ctl('bucardo kick sqlite 0');
for my $table (keys %tabletype) {
$t = "SQLite table $table has correct number of rows after delete";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
(my $count = $sth->execute()) =~ s/0E0/0/;
$sth->finish();
is ($count, 0, $t);
}
## Insert two rows, then delete one of them
## Add one row per table type to A
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
my $val2 = $val{$type}{2};
$sth{insert}{2}{$table}{A}->execute($val2);
}
$dbhA->commit();
$bct->ctl('bucardo kick sqlite 0');
for my $table (keys %tabletype) {
$t = "SQLite table $table has correct number of rows after double insert";
$SQL = qq{SELECT count(*) FROM "$table"};
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $count = $sth->fetchall_arrayref()->[0][0];
is ($count, 2, $t);
}
## Delete one of the rows
for my $table (keys %tabletype) {
$sth{deleteone}{$table}{A}->execute(2); ## inty = 2
}
$dbhA->commit();
$bct->ctl('bucardo kick sqlite 0');
for my $table (keys %tabletype) {
$t = "SQLite table $table has correct number of rows after single deletion";
$SQL = qq{SELECT count(*) FROM "$table"};
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $count = $sth->fetchall_arrayref()->[0][0];
is ($count, 1, $t);
}
## Insert two more rows, then truncate
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val3 = $val{$type}{3};
$sth{insert}{3}{$table}{A}->execute($val3);
my $val4 = $val{$type}{4};
$sth{insert}{4}{$table}{A}->execute($val4);
}
$dbhA->commit();
$bct->ctl('bucardo kick sqlite 0');
for my $table (keys %tabletype) {
$t = "SQLite table $table has correct data after more inserts";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $info = $sth->fetchall_arrayref({});
$info = [ sort { $a->{inty} <=> $b->{inty} } @$info ];
my($val1, $val3, $val4) = @{$val{$tabletype{$table}}}{1, 3, 4};
my $pkeyname = $table =~ /test5/ ? 'id space' : 'id';
my(@invar) = ( data1 => 'foo', 'email' => undef, bite1 => undef, bite2 => undef );
is_deeply ($info, [{ $pkeyname=>$val1, inty=>1, booly=>1, @invar },
{ $pkeyname=>$val3, inty=>3, booly=>undef, @invar },
{ $pkeyname=>$val4, inty=>4, booly=>0, @invar }], $t) || diag explain $info;
}
exit;
Bucardo-5.4.1/t/20-drizzle.t0000644000175000017500000002424412563002233014066 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test using Drizzle as a database target
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use vars qw/ $bct $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t %pkey $SQL %sth %sql/;
## Must have the DBD::drizzle module
my $evalok = 0;
eval {
require DBD::drizzle;
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => 'Cannot test Drizzle unless the Perl module DBD::drizzle is installed');
}
## Drizzle must be up and running
$evalok = 0;
my $dbh;
my $dbuser = 'root';
eval {
$dbh = DBI->connect('dbi:drizzle:database=test', $dbuser, '',
{AutoCommit=>1, PrintError=>0, RaiseError=>1});
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => "Cannot test Drizzle as we cannot connect to a running Drizzle database: $@");
}
use BucardoTesting;
## For now, remove the bytea table type as we don't have full Drizzle support yet
delete $tabletype{bucardo_test8};
my $numtabletypes = keys %tabletype;
plan tests => 119;
## Drop the Drizzle database if it exists
my $dbname = 'bucardo_test';
eval {
$dbh->do("DROP DATABASE $dbname");
};
## Create the Drizzle database
$dbh->do("CREATE DATABASE $dbname");
## Reconnect to the new database
$dbh = DBI->connect("dbi:drizzle:database=$dbname", $dbuser, '',
{AutoCommit=>1, PrintError=>0, RaiseError=>1});
## Create one table for each table type
## For now, we use the same data types as MySQL
for my $table (sort keys %tabletype) {
my $pkeyname = $table =~ /test5/ ? q{`id space`} : 'id';
my $pkindex = $table =~ /test2/ ? '' : 'PRIMARY KEY';
$SQL = qq{
CREATE TABLE $table (
$pkeyname $tabletypemysql{$table} NOT NULL $pkindex};
$SQL .= $table =~ /X/ ? "\n)" : qq{,
data1 VARCHAR(100) NULL,
inty SMALLINT NULL,
bite1 VARBINARY(999) NULL,
bite2 VARBINARY(999) NULL,
email VARCHAR(100) NULL UNIQUE
)
};
$dbh->do($SQL);
if ($table =~ /test2/) {
$dbh->do("ALTER TABLE $table ADD CONSTRAINT multipk PRIMARY KEY ($pkeyname,data1)");
}
}
$bct = BucardoTesting->new() or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = 'drizzle';
pass("*** Beginning drizzle tests");
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
}
## Get Postgres database A and B and C created
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Tell Bucardo about these databases
## Three Postgres databases will be source, source, and target
for my $name (qw/ A B C /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
$t = 'Adding drizzle database Q works';
$command =
"bucardo add db Q dbname=$dbname type=drizzle dbuser=$dbuser";
$res = $bct->ctl($command);
like ($res, qr/Added database "Q"/, $t);
## Teach Bucardo about all pushable tables, adding them to a new relgroup named "therd"
$t = q{Adding all tables on the master works};
$command =
"bucardo add tables all db=A relgroup=therd pkonly";
$res = $bct->ctl($command);
like ($res, qr/Creating relgroup: therd.*New tables added: \d/s, $t);
## Add all sequences, and add them to the newly created relgroup
$t = q{Adding all sequences on the master works};
$command =
"bucardo add sequences all db=A relgroup=therd";
$res = $bct->ctl($command);
like ($res, qr/New sequences added: \d/, $t);
## Create a new dbgroup
$t = q{Created a new dbgroup};
$command =
"bucardo add dbgroup qx A:source B:source C Q";
$res = $bct->ctl($command);
like ($res, qr/Created dbgroup "qx"/, $t);
## Create a new sync
$t = q{Created a new sync};
$command =
"bucardo add sync drizzle relgroup=therd dbs=qx autokick=false";
$res = $bct->ctl($command);
like ($res, qr/Added sync "drizzle"/, $t);
## Create a second sync, solely for multi-sync interaction issues
$bct->ctl('bucardo add dbgroup t1 A:source B C');
$bct->ctl('bucardo add sync tsync1 relgroup=therd dbs=t1 autokick=false status=inactive');
## Start up Bucardo with these new syncs
$bct->restart_bucardo($dbhX);
## Get the statement handles ready for each table type
for my $table (sort keys %tabletype) {
$pkey{$table} = $table =~ /test5/ ? q{"id space"} : 'id';
## INSERT
for my $x (1..6) {
$SQL = $table =~ /X/
? "INSERT INTO $table($pkey{$table}) VALUES (?)"
: "INSERT INTO $table($pkey{$table},data1,inty) VALUES (?,'foo',$x)";
$sth{insert}{$x}{$table}{A} = $dbhA->prepare($SQL);
if ('BYTEA' eq $tabletype{$table}) {
$sth{insert}{$x}{$table}{A}->bind_param(1, undef, {pg_type => PG_BYTEA});
}
}
## SELECT
$sql{select}{$table} = "SELECT inty FROM $table ORDER BY $pkey{$table}";
$table =~ /X/ and $sql{select}{$table} =~ s/inty/$pkey{$table}/;
## DELETE ALL
$SQL = "DELETE FROM $table";
$sth{deleteall}{$table}{A} = $dbhA->prepare($SQL);
## DELETE ONE
$SQL = "DELETE FROM $table WHERE inty = ?";
$sth{deleteone}{$table}{A} = $dbhA->prepare($SQL);
## TRUNCATE
$SQL = "TRUNCATE TABLE $table";
$sth{truncate}{$table}{A} = $dbhA->prepare($SQL);
## UPDATE
$SQL = "UPDATE $table SET inty = ?";
$sth{update}{$table}{A} = $dbhA->prepare($SQL);
}
## Add one row per table type to A
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
}
## Before the commit on A, B and C should be empty
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
$t = qq{B has not received rows for table $table before A commits};
$res = [];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
## Commit, then kick off the sync
$dbhA->commit();
$bct->ctl('bucardo kick drizzle 0');
$bct->ctl('bucardo kick drizzle 0');
## Check B and C for the new rows
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
$t = qq{Row with pkey of type $type gets copied to B};
$res = [[1]];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
## Check that Drizzle has the new rows
for my $table (sort keys %tabletype) {
$t = "Drizzle table $table has correct number of rows after insert";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
is ($count, 1, $t);
$t = "Drizzle table $table has correct entries";
my $info = $sth->fetchall_arrayref({})->[0];
my $type = $tabletype{$table};
my $id = $val{$type}{1};
my $pkeyname = $table =~ /test5/ ? 'id space' : 'id';
## For now, binary is stored in escaped form, so we skip this one
next if $table =~ /test8/;
## Datetime has no time zone thingy at the end
$tabletypemysql{$table} =~ /DATETIME/ and $id =~ s/\+.*//;
is_deeply(
$info,
{
$pkeyname => $id,
inty => 1,
email => undef,
bite1 => undef,
bite2 => undef,
data1 => 'foo',
},
$t);
}
## Update each row
for my $table (keys %tabletype) {
$sth{update}{$table}{A}->execute(42);
}
$dbhA->commit();
$bct->ctl('bucardo kick drizzle 0');
for my $table (keys %tabletype) {
$t = "Drizzle table $table has correct number of rows after update";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
is ($count, 1, $t);
$t = "Drizzle table $table has updated value";
my $info = $sth->fetchall_arrayref({})->[0];
is ($info->{inty}, 42, $t);
}
## Delete each row
for my $table (keys %tabletype) {
$sth{deleteall}{$table}{A}->execute();
}
$dbhA->commit();
$bct->ctl('bucardo kick drizzle 0');
for my $table (keys %tabletype) {
$t = "Drizzle table $table has correct number of rows after delete";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
(my $count = $sth->execute()) =~ s/0E0/0/;
$sth->finish();
is ($count, 0, $t);
}
## Insert two rows, then delete one of them
## Add one row per table type to A
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
my $val2 = $val{$type}{2};
$sth{insert}{2}{$table}{A}->execute($val2);
}
$dbhA->commit();
$bct->ctl('bucardo kick drizzle 0');
for my $table (keys %tabletype) {
$t = "Drizzle table $table has correct number of rows after double insert";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
$sth->finish();
is ($count, 2, $t);
}
## Delete one of the rows
for my $table (keys %tabletype) {
$sth{deleteone}{$table}{A}->execute(2); ## inty = 2
}
$dbhA->commit();
$bct->ctl('bucardo kick drizzle 0');
for my $table (keys %tabletype) {
$t = "Drizzle table $table has correct number of rows after single deletion";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
$sth->finish();
is ($count, 1, $t);
}
## Insert two more rows, then truncate
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val3 = $val{$type}{3};
$sth{insert}{3}{$table}{A}->execute($val3);
my $val4 = $val{$type}{4};
$sth{insert}{4}{$table}{A}->execute($val4);
}
$dbhA->commit();
$bct->ctl('bucardo kick drizzle 0');
for my $table (keys %tabletype) {
$t = "Drizzle table $table has correct number of rows after more inserts";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
$sth->finish();
is ($count, 3, $t);
}
exit;
Bucardo-5.4.1/t/BucardoTesting.pm0000644000175000017500000016063212601642760015264 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
package BucardoTesting;
## Helper module for the Bucardo tests
## Contains shared code for setup and breakdown
use strict;
use warnings;
use utf8;
use Encode qw/ decode /;
use Encode::Locale;
use DBI;
use DBD::Pg;
use Time::HiRes qw/sleep gettimeofday tv_interval/;
use Cwd;
use Data::Dumper;
use vars qw/$SQL $sth $count $COM %dbh/;
my $DEBUG = $ENV{BUCARDO_DEBUG} || 0;
$ENV{BUCARDO_CONFIRM} = 0 if exists $ENV{BUCARDO_CONFIRM};
use base 'Exporter';
our @EXPORT = qw/%tabletype %tabletypemysql %tabletypemariadb %tabletypeoracle %tabletypesqlite
%sequences %val
compare_tables bc_deeply clear_notices wait_for_notice
$location $oldherd_msg $newherd_msg $addtable_msg $deltable_msg $nomatch_msg/;
## Special global vars for munging the data
my (%gsth, %gdbh);
my $dbname = 'bucardo_test';
## We need to use the local Bucardo.pm, not a system installed one!
$ENV{PERL5LIB} = '.';
## Shortcuts for ease of changes and smaller text:
our $addtable_msg = 'Added the following tables or sequences';
our $deltable_msg = 'Removed the following tables';
our $nomatch_msg = 'Did not find matches for the following terms';
our $oldherd_msg = 'The following tables or sequences are now part of the relgroup';
our $newherd_msg = 'The following tables or sequences are now part of the relgroup';
our $location = 'setup';
my $testmsg = ' ?';
my $testline = '?';
## Sometimes, we want to stop as soon as we see an error
my $bail_on_error = $ENV{BUCARDO_TESTBAIL} || 0;
my $total_errors = 0;
## Used by the tt sub
my %timing;
## If true, turns off the epoch "time" output at the end of each testing output line
my $notime = 1;
my $user = qx{whoami};
chomp $user;
my $FRESHLOG = 1;
if ($FRESHLOG) {
unlink 'tmp/bucardo.log';
}
my $piddir = 'pid';
if (! -e $piddir) {
mkdir $piddir;
}
## Test databases are labelled as A, B, C, etc.
my @dbs = qw/A B C D E/;
### TODO: Add point type (which has no natural ordering operator!)
our %tabletype =
(
'bucardo_test1' => 'SMALLINT',
'bucardo_test2' => 'INT',
'Bucardo_test3' => 'BIGINT',
'bucardo_test4' => 'TEXT',
'bucardo_test5' => 'DATE',
'bucardo_test6' => 'TIMESTAMP',
'bucardo_test7' => 'NUMERIC',
'bucardo_test8' => 'BYTEA',
'bucardo_test9' => 'int_unsigned',
'bucardo_test10' => 'TIMESTAMPTZ',
'bucardo space test' => 'INT',
);
our %tabletypemysql =
(
'bucardo_test1' => 'SMALLINT',
'bucardo_test2' => 'INT',
'Bucardo_test3' => 'BIGINT',
'bucardo_test4' => 'VARCHAR(1000)',
'bucardo_test5' => 'DATE',
'bucardo_test6' => 'DATETIME',
'bucardo_test7' => 'NUMERIC(5,1)',
'bucardo_test8' => 'VARBINARY(1000)',
'bucardo_test9' => 'INTEGER UNSIGNED',
'bucardo_test10' => 'DATETIME',
'bucardo space test' => 'INT',
);
our %tabletypemariadb =
(
'bucardo_test1' => 'SMALLINT',
'bucardo_test2' => 'INT',
'Bucardo_test3' => 'BIGINT',
'bucardo_test4' => 'VARCHAR(700)',
'bucardo_test5' => 'DATE',
'bucardo_test6' => 'DATETIME',
'bucardo_test7' => 'NUMERIC(5,1)',
'bucardo_test8' => 'VARBINARY(1000)',
'bucardo_test9' => 'INTEGER UNSIGNED',
'bucardo_test10' => 'DATETIME',
'bucardo space test' => 'INT',
);
our %tabletypeoracle =
(
'bucardo_test1' => 'SMALLINT',
'bucardo_test2' => 'INT',
'Bucardo_test3' => 'BIGINT',
'bucardo_test4' => 'NVARCHAR2(1000)',
'bucardo_test5' => 'DATE',
'bucardo_test6' => 'TIMESTAMP',
'bucardo_test7' => 'NUMERIC(5,1)',
'bucardo_test8' => 'BLOB',
'bucardo_test9' => 'INTEGER',
'bucardo_test10' => 'TIMESTAMP WITH TIME ZONE',
'bucardo space test' => 'INT',
);
our %tabletypesqlite =
(
'bucardo_test1' => 'SMALLINT',
'bucardo_test2' => 'INT',
'Bucardo_test3' => 'BIGINT',
'bucardo_test4' => 'VARCHAR(1000)',
'bucardo_test5' => 'DATE',
'bucardo_test6' => 'DATETIME',
'bucardo_test7' => 'NUMERIC(5,1)',
'bucardo_test8' => 'VARBINARY(1000)',
'bucardo_test9' => 'INTEGER UNSIGNED',
'bucardo_test10' => 'DATETIME',
'bucardo space test' => 'INT',
);
our @tables2empty = (qw/droptest_bucardo/);
our %sequences =
(
'bucardo_test_seq1' => '',
'bucardo_test_seq2' => '',
'Bucardo_test_seq3' => '',
);
my %debug = (
recreatedb => 0,
recreateschema => 1,
recreateuser => 0,
);
my $DEBUGDIR = ".";
-e $DEBUGDIR or mkdir $DEBUGDIR;
## To avoid stepping on other instance's toes
my $PIDDIR = "/tmp/bucardo_testing_$ENV{USER}";
mkdir $PIDDIR if ! -e $PIDDIR;
## Let pg_config guide us to a likely initdb/pg_ctl location
my $output = qx{pg_config --bindir};
chomp $output;
my $bindir = $output =~ m{^/} ? $1 : '';
## Location of files
my $initdb = $ENV{PGBINDIR} ? "$ENV{PGBINDIR}/initdb" : $bindir ? "$bindir/initdb" : 'initdb';
my $pg_ctl = $ENV{PGBINDIR} ? "$ENV{PGBINDIR}/pg_ctl" : $bindir ? "$bindir/pg_ctl" : 'pg_ctl';
## Get the default initdb location
my $pgversion = qx{$initdb -V};
my ($pg_ver, $pg_major_version, $pg_minor_version, $pg_point_version);
if (defined $pgversion and $pgversion =~ /initdb \(PostgreSQL\) (\d+\..*)/) {
$pg_ver = $1;
($pg_major_version, $pg_minor_version, $pg_point_version) = split /\./, $pg_ver;
$pg_minor_version =~ s/(\d+).+/$1/;
}
else {
die qq{Could not determine initdb version information from running "$initdb -V"\n};
}
## Each database can also have a custom version
## We do this by setting PGBINDIR[A-Z]
## This allows us to test (for example) a 8.1 master and an 8.4 slave
my %pgver;
my %clusterinfo;
my $lport = 58920;
for my $name ('A'..'Z') {
$lport++;
$clusterinfo{$name}{port} = $lport;
my $lbindir = $ENV{PGBINDIR} || '';
my $linitdb = $initdb;
my $lpgctl = $pg_ctl;
my $localver = $pg_ver;
my ($lmaj,$lmin,$lrev) = ($pg_major_version, $pg_minor_version, $pg_point_version);
if (exists $ENV{"PGBINDIR$name"}) {
$lbindir = $ENV{"PGBINDIR$name"};
-d $lbindir or die qq{Invalid ENV "PGBINDIR$name"\n};
$linitdb = "$lbindir/initdb";
$lpgctl = "$lbindir/pg_ctl";
$COM = "$linitdb -V";
my $answer = qx{$COM};
die "Cannot find version from: $COM" if $answer !~ /initdb \(PostgreSQL\) (\d+\..*)/;
$localver = $1;
($lmaj,$lmin,$lrev) = split /\./, $localver;
$lmin =~ s/(\d+).+/$1/;
}
$pgver{$name} = {
bindir => $lbindir,
initdb => $linitdb,
pgctl => $lpgctl,
version => $localver,
ver => "$lmaj.$lmin",
vmaj => $lmaj,
vmin => $lmin,
vrev => $lrev,
dirname => "bucardo_test_database_${name}_$lmaj.$lmin",
port => $lport,
};
}
# Set a semi-unique name to make killing old tests easier
my $xname = "bctest_$ENV{USER}";
## Maximum time to wait for bucardo to return
my $ALARM_BUCARDO = 25;
## Maximum time to wait for a kid to appear via pg_listener
my $ALARM_WAIT4KID = 3;
## How long to wait for most syncs to take effect?
my $TIMEOUT_SYNCWAIT = 3;
## How long to sleep between checks for sync being done?
my $TIMEOUT_SLEEP = 0.1;
## How long to wait for a notice to be issued?
my $TIMEOUT_NOTICE = 4;
## Bail if the bucardo file does not exist / does not compile
for my $file (qw/bucardo Bucardo.pm/) {
if (! -e $file) {
die "Cannot run without file $file\n";
}
eval {
$ENV{BUCARDO_TEST} = 1;
require $file;
$ENV{BUCARDO_TEST} = 0;
};
if ($@) {
die "Cannot run unless $file compiles cleanly: $@\n";
}
}
## Prepare some test values for easy use
## The secondary names are for other databases, e.g. MySQL
our %val;
my $xvalmax = 30;
for (1..$xvalmax) {
$val{SMALLINT}{$_} = $_;
$val{INT}{$_} = 1234567+$_;
$val{BIGINT}{$_} = 7777777777 + $_;
$val{TEXT}{$_} = $val{'VARCHAR(1000)'}{$_} = "bc'$_";
$val{DATE}{$_} = sprintf '2001-10-%02d', $_;
$val{TIMESTAMP}{$_} = $val{DATE}{$_} . ' 12:34:56';
$val{NUMERIC}{$_} = $val{'NUMERIC(5,1)'}{$_} = 0.7 + $_;
$val{BYTEA}{$_} = "$_\0Z";
$val{int_unsigned}{$_} = $val{'INTEGER UNSIGNED'}{$_} = 5000 + $_;
$val{TIMESTAMPTZ}{$_} = $val{DATETIME}{$_} = $val{DATE}{$_} . ' 11:22:33+00';
$val{DATETIME}{$_} =~ s/\+00//;
$val{TIMESTAMPTZNOZERO} = $val{DATE}{$_} . ' 11:22:33';
}
sub diag {
Test::More::diag(@_);
}
sub new {
## Create a new BucardoTesting object.
## Arguments:
## 1. Hashref of options (optional)
## Returns: reference to a new BucardoTesting object
my $class = shift;
my $arg = shift || {};
my $self = {};
bless $self, $class;
if ($arg->{notime}) {
$notime = 1;
}
## Make a note of which file invoked us for later debugging
$self->{file} = (caller)[1];
## Bail on first error? Default is ENV, then false.
$bail_on_error = exists $arg->{bail} ? $arg->{bail} : $ENV{BUCARDO_TESTBAIL} || 0;
## Name of the test schema
$self->{schema} = 'bucardo_schema';
## Let's find out where bucardo is. Prefer the blib ones, which are shebang adjusted
if (-e 'blib/script/bucardo') {
$self->{bucardo} = 'blib/script/bucardo';
}
elsif (-e '../blib/script/bucardo') {
$self->{bucardo} = '../blib/script/bucardo';
}
elsif (-e './bucardo') {
$self->{bucardo} = './bucardo';
}
elsif (-e '../bucardo') {
$self->{bucardo} = '../bucardo';
}
else {
die qq{Could not find bucardo\n};
}
## Handle both old and new way of setting location
if ($location eq 'setup' and $arg->{location}) {
$location = $self->{location} = $arg->{location};
}
return $self;
} ## end of new
sub debug {
## Simply internal debugging routine, prints a message if $DEBUG is set
## Arguments:
## 1. Message to print
## 2. Optional level, defaults to 0
## Returns: nothing
$DEBUG or return;
my $msg = shift || 'No message?!';
my $level = shift || 0;
return if $DEBUG < $level;
chomp $msg;
warn "DEBUG: $msg\n";
return;
} ## end of debug
sub empty_cluster {
## Empty out a cluster's databases
## Creates the cluster and 'bucardo_test' database as needed
## For existing databases, removes all known schemas
## Always recreates the public schema
## Arguments: one
## 1. Name of the cluster
## Returns: arrayref of database handles to the 'bucardo_test*' databases
my $self = shift;
my $clustername = shift or die;
## Create the cluster if needed
$self->create_cluster($clustername);
## Start it up if needed
$self->start_cluster($clustername);
my $alldbh;
## Get a handle to the postgres database
my $masterdbh = $self->connect_database($clustername, 'postgres');
my $dbh;
if (database_exists($masterdbh, $dbname)) {
$dbh = $self->connect_database($clustername, $dbname);
## Remove any of our known schemas
my @slist;
for my $sname (qw/ public bucardo freezer tschema /) {
push @slist => $sname if $self->drop_schema($dbh, $sname);
}
debug(qq{Schemas dropped from $dbname on $clustername: } . join ',' => @slist);
## Recreate the public schema
$dbh->do("CREATE SCHEMA public");
$dbh->commit();
}
else {
local $masterdbh->{AutoCommit} = 1;
debug(qq{Creating database $dbname});
$masterdbh->do("CREATE DATABASE $dbname");
$dbh = $self->connect_database($clustername, $dbname);
}
$masterdbh->disconnect();
return $dbh;
} ## end of empty_cluster
sub create_cluster {
## Create a cluster if it does not already exist
## Runs initdb, then modifies postgresql.conf
## Arguments:
## 1. Name of the cluster
## Returns: nothing
my $self = shift;
my $clustername = shift or die;
my $line = (caller)[2];
my $info = $pgver{$clustername}
or die qq{No such cluster as "$clustername" (called from line $line)\n};
my $dirname = $info->{dirname};
if (-d $dirname) {
## Sometimes these test clusters get left in a broken state.
my $file = "$dirname/postgresql.conf";
if (! -e $file) {
## Just move it out of the way, rather than deleting it
rename $dirname, "$dirname.old";
}
return;
}
my $localinitdb = $info->{initdb};
debug(qq{Running $localinitdb for cluster "$clustername"});
my $com = qq{$localinitdb -D $dirname 2>&1};
debug($com);
my $res = qx{$com};
die $res if $? != 0;
if ($DEBUG) {
warn Dumper $res;
}
## Make some minor adjustments
my $connections = $clustername eq 'A' ? 150 : 75;
my $file = "$dirname/postgresql.conf";
open my $fh, '>>', $file or die qq{Could not open "$file": $!\n};
printf {$fh} "
port = %d
max_connections = $connections
random_page_cost = 2.5
log_statement = 'all'
log_min_duration_statement = 0
client_min_messages = WARNING
log_line_prefix = '%s %s[%s] '
listen_addresses = ''
",
$info->{port}, '%m', '%d', '%p';
## Make some per-version adjustments
if ($info->{ver} >= 8.3) {
print {$fh} "logging_collector = off\n";
}
else {
print {$fh} "redirect_stderr = off\n";
}
close $fh or die qq{Could not close "$file": $!\n};
return;
} ## end of create_cluster
sub start_cluster {
## Startup a cluster if not already running
## Arguments:
## 1. Name of the cluster
## Returns: nothing
my $self = shift;
my $clustername = shift || 'A';
## Create the cluster if needed
$self->create_cluster($clustername);
my $info = $pgver{$clustername};
my $dirname = $info->{dirname};
## Check the PID file. If it exists and is active, simply return
my $pidfile = "$dirname/postmaster.pid";
if (-e $pidfile) {
open my $fh, '<', $pidfile or die qq{Could not open "$pidfile": $!\n};
<$fh> =~ /(\d+)/ or die qq{No PID found in file "$pidfile"\n};
my $pid = $1;
close $fh or die qq{Could not close "$pidfile": $!\n};
## An active process should respond to a "ping kill"
$count = kill 0 => $pid;
return if 1 == $count;
## If no response, remove the pidfile ourselves and go on
debug(qq{Server seems to have died, removing file "$pidfile"});
unlink $pidfile or die qq{Could not remove file "$pidfile"\n};
}
my $port = $info->{port};
debug(qq{Starting cluster "$clustername" on port $port});
## If not Windows, we'll use Unix sockets with a custom socket dir
my $option = '';
if ($^O !~ /Win32/) {
my $sockdir = "$dirname/socket";
-e $sockdir or mkdir $sockdir;
$option = q{-o '-k socket'};
## Older versions do not assume socket is right off of data dir
if ($info->{ver} <= 8.0) {
$option = qq{-o '-k $dirname/socket'};
}
}
## Attempt to start it up with a pg_ctl call
my $localpgctl = $info->{pgctl};
$COM = qq{$localpgctl $option -l $dirname/pg.log -D $dirname start};
debug(qq{Running: $COM});
qx{$COM};
## Wait for the pidfile to appear
my $maxwaitseconds = 20;
my $loops = 0;
{
last if -e $pidfile;
sleep 0.1;
if ($loops++ > ($maxwaitseconds * 10)) {
die "Failed to startup cluster $clustername, command was $COM\n";
}
redo;
}
## Keep attempting to get a database connection until we get one or timeout
$maxwaitseconds = 10;
my $dbhost = getcwd;
$dbhost .= "/$dirname/socket";
## Using the "invalidname" is a nice way to work around locale issues
my $dsn = "dbi:Pg:dbname=invalidname;port=$port;host=$dbhost";
my $dbh;
debug(qq{Connecting as $dsn});
$loops = 0;
LOOP: {
eval {
$dbh = DBI->connect($dsn, '', '', { AutoCommit=>0, RaiseError=>1, PrintError=>0 });
};
last if $@ =~ /"invalidname"/;
sleep 0.1;
if ($loops++ > ($maxwaitseconds * 10)) {
die "Database did not come up: dsn was $dsn\n";
}
redo;
}
return;
} ## end of start_cluster
sub connect_database {
## Return a connection to a database within a cluster
## Arguments:
## 1. Name of the cluster
## 2. Name of the database (optional, defaults to 'bucardo_test')
## Returns: database handle
my $self = shift;
my $clustername = shift or die;
my $ldbname = shift || $dbname;
## This may be one of the "extra" databases. In which case the true cluster must be revealed:
$clustername =~ s/\d+$//;
## Create and start the cluster as needed
$self->start_cluster($clustername);
## Build the DSN to connect with
my $info = $pgver{$clustername};
my $dbport = $info->{port};
my $dbhost = getcwd . "/$info->{dirname}/socket";
my $dsn = "dbi:Pg:dbname=$ldbname;port=$dbport;host=$dbhost";
## If we already have a cached version and it responds, return it
if (exists $dbh{$dsn}) {
my $dbh = $dbh{$dsn};
$dbh->ping and return $dbh;
## No ping? Remove from the cache
$dbh->disconnect();
delete $dbh{$dsn};
}
my $dbh;
eval {
$dbh = DBI->connect($dsn, '', '', { AutoCommit=>0, RaiseError=>1, PrintError=>0 });
};
if ($@) {
if ($ldbname eq 'postgres' and $@ =~ /"postgres"/) {
## Probably an older version that uses template1
(my $localdsn = $dsn) =~ s/dbname=postgres/dbname=template1/;
## Give up right away if we are already trying template1
die $@ if $localdsn eq $dsn;
debug(qq{Connection failed, trying to connect to template1 to create a postgres database});
## Connect as template1 and create a postgres database
$dbh = DBI->connect($localdsn, '', '', { AutoCommit=>1, RaiseError=>1, PrintError=>0 });
$dbh->do('CREATE DATABASE postgres');
$dbh->disconnect();
## Reconnect to our new database
$dbh = DBI->connect($dsn, '', '', { AutoCommit=>0, RaiseError=>1, PrintError=>0 });
}
else {
die "$@\n";
}
}
$dbh->do(q{SET TIME ZONE 'UTC'});
if ($DEBUG) {
my $file = 'bucardo.debug.dsns.txt';
if (open my $fh, '>>', $file) {
print {$fh} "\n$dsn\n";
my ($host,$port,$db);
$dsn =~ /port=(\d+)/ and $port=$1;
$dsn =~ /dbname=(.+?);/ and $db=$1;
$dsn =~ /host=(.+)/ and $host=$1;
printf {$fh} "psql%s%s%s\n", " -h $host", " -p $port", " $db";
close $fh or die qq{Could not close file "$file": $!\n};
}
}
$dbh->commit();
return $dbh;
} ## end of connect_database
sub drop_schema {
## Drop a schema if it exists
## Two arguments:
## 1. database handle
## 2. name of the schema
## Returns 1 if dropped, 0 if not
my ($self,$dbh,$sname) = @_;
return 0 if ! schema_exists($dbh, $sname);
local $dbh->{AutoCommit} = 1;
local $dbh->{Warn} = 0;
$dbh->do("DROP SCHEMA $sname CASCADE");
return 1;
} ## end of drop_schema
sub repopulate_cluster {
## Make sure a cluster is empty, then add in the sample data
## Arguments: two
## 1. Name of the cluster
## 2. Optional - number of additional databases to create
## Returns: database handle to the 'bucardo_test' database
my $self = shift;
my $clustername = shift or die;
my $extradbs = shift || 0;
Test::More::note("Recreating cluster $clustername");
my $dbh = $self->empty_cluster($clustername);
$self->add_test_schema($dbh, $clustername);
## Now recreate all the extra databases via templating
for my $number (1..$extradbs) {
my $dbname2 = "$dbname$number";
local $dbh->{AutoCommit} = 1;
if (database_exists($dbh, $dbname2)) {
## First, kill other sessions!
my $odbh = $self->connect_database($clustername, $dbname2);
eval {
$SQL = 'SELECT pg_terminate_backend(pid) FROM pg_stat_activity WHERE datname = ? AND pid <> pg_backend_pid()';
$sth = $odbh->prepare($SQL);
$odbh->execute($dbname2);
$odbh->commit();
};
$odbh->disconnect();
$dbh->do("DROP DATABASE $dbname2");
}
$dbh->do("CREATE DATABASE $dbname2 TEMPLATE $dbname");
}
## Store our names away
$gdbh{$clustername} = $dbh;
return $dbh;
} ## end of repopulate_cluster
sub add_test_schema {
## Add an empty test schema to a database
## Arguments: two
## 1. database handle (usually to 'bucardo_test')
## 2. Cluster name
## Returns: nothing
my $self = shift;
my $dbh = shift or die;
my $clustername = shift or die;
my ($tcount,$scount,$fcount) = (0,0,0);
## Empty out or create the droptest table
if (table_exists($dbh => 'droptest_bucardo')) {
$dbh->do('TRUNCATE TABLE droptest_bucardo');
}
else {
$tcount++;
$dbh->do(q{
CREATE TABLE droptest_bucardo (
name TEXT NOT NULL,
type TEXT NOT NULL
)
});
}
## Create the language if needed
if (!language_exists($dbh => 'plpgsql')) {
debug(q{Creating language plpgsql});
$dbh->do('CREATE LANGUAGE plpgsql');
}
## Create supporting functions as needed
if (!function_exists($dbh => 'trigger_test')) {
$fcount++;
$dbh->do(q{
CREATE FUNCTION trigger_test()
RETURNS trigger
LANGUAGE plpgsql
AS $_$ BEGIN
INSERT INTO droptest_bucardo(name,type)
VALUES (TG_RELNAME, 'trigger');
RETURN NULL;
END;
$_$
});
}
if (!function_exists($dbh => 'trigger_test_zero')) {
$fcount++;
$dbh->do(q{
CREATE FUNCTION trigger_test_zero()
RETURNS trigger
LANGUAGE plpgsql
AS $_$ BEGIN
INSERT INTO droptest_bucardo(name,type)
VALUES (TG_RELNAME, 'trigger');
RETURN NULL;
END;
$_$;
});
}
## Create our helper domain for pseudo-types
if (domain_exists($dbh => 'int_unsigned')) {
$dbh->do('DROP DOMAIN int_unsigned CASCADE');
}
$dbh->do('CREATE DOMAIN int_unsigned INTEGER CHECK (value >= 0)');
## Create one table for each table type
for my $table (sort keys %tabletype) {
local $dbh->{Warn} = 0;
## Does the table already exist? If so, drop it.
if (table_exists($dbh => $table)) {
$dbh->do(qq{DROP TABLE "$table"});
}
my $pkeyname = $table =~ /test5/ ? q{"id space"} : 'id';
my $pkindex = $table =~ /test2/ ? '' : 'PRIMARY KEY';
$SQL = qq{
CREATE TABLE "$table" (
$pkeyname $tabletype{$table} NOT NULL $pkindex};
$SQL .= $table =~ /X/ ? "\n)" : qq{,
data1 TEXT NULL,
inty SMALLINT NULL,
booly BOOLEAN NULL,
bite1 BYTEA NULL,
bite2 BYTEA NULL,
email TEXT NULL UNIQUE
)
};
$dbh->do($SQL);
$tcount++;
if ($table =~ /test2/) {
$dbh->do(qq{ALTER TABLE "$table" ADD CONSTRAINT multipk PRIMARY KEY ($pkeyname,data1)});
}
## Create a trigger to test trigger supression during syncs
$SQL = qq{
CREATE TRIGGER "bctrig_$table"
AFTER INSERT OR UPDATE ON "$table"
FOR EACH ROW EXECUTE PROCEDURE trigger_test()
};
$table =~ /0/ and ($SQL =~ s/trigger_test/trigger_test_zero/);
$dbh->do($SQL);
## Create a rule to test rule supression during syncs
$SQL = qq{
CREATE OR REPLACE RULE "bcrule_$table"
AS ON INSERT TO "$table"
DO ALSO INSERT INTO droptest_bucardo(name,type) VALUES ('$table','rule')
};
$table =~ /0/ and $SQL =~ s/NEW.inty/0/;
$dbh->do($SQL);
}
## Create the foreign key tables
#$dbh->do('CREATE TABLE bucardo_fkey1 (fkid INTEGER NOT NULL PRIMARY KEY, data2 TEXT)');
$SQL = q{
ALTER TABLE bucardo_fkey1
ADD CONSTRAINT "bucardo_fkey1"
FOREIGN KEY (fkid)
REFERENCES bucardo_test1 (id)
ON DELETE CASCADE ON UPDATE CASCADE
};
#$dbh->do($SQL);
## Create one sequence for each table type
for my $seq (sort keys %sequences) {
local $dbh->{Warn} = 0;
## Does the sequence already exist? If so, drop it.
if (table_exists($dbh => $seq)) {
$dbh->do(qq{DROP SEQUENCE "$seq"});
}
$SQL = qq{CREATE SEQUENCE "$seq"};
$dbh->do($SQL);
$scount++;
}
debug("Test objects created for $clustername. Tables: $tcount Sequences: $scount Functions: $fcount");
# diag("Test objects created for $clustername. Tables: $tcount Sequences: $scount Functions: $fcount");
$dbh->commit() if ! $dbh->{AutoCommit};
return;
} ## end of add_test_schema
sub mock_serialization_failure {
my ($self, $dbh, $table) = @_;
return if $dbh->{pg_server_version} < 80401;
$table ||= 'bucardo_test1';
# Mock a serialization failure on every other INSERT. Runs only when
# `session_replica_role` is "replica", which it true for Bucardo targets.
$dbh->do(qq{
DROP SEQUENCE IF EXISTS serial_seq;
CREATE SEQUENCE serial_seq;
CREATE OR REPLACE FUNCTION mock_serial_fail(
) RETURNS trigger LANGUAGE plpgsql AS \$_\$
BEGIN
IF nextval('serial_seq') % 2 = 0 THEN RETURN NEW; END IF;
RAISE EXCEPTION 'Serialization error'
USING ERRCODE = 'serialization_failure';
END;
\$_\$;
CREATE TRIGGER mock_serial_fail AFTER INSERT ON "$table"
FOR EACH ROW EXECUTE PROCEDURE mock_serial_fail();
ALTER TABLE "$table" ENABLE REPLICA TRIGGER mock_serial_fail;
});
$dbh->commit;
return 1;
} ## end of mock_serialization_failure
sub unmock_serialization_failure {
my ($self, $dbh, $table) = @_;
return if $dbh->{pg_server_version} < 80401;
$table ||= 'bucardo_test1';
$dbh->do(qq{
DROP TRIGGER IF EXISTS mock_serial_fail ON "$table";
DROP FUNCTION IF EXISTS mock_serial_fail();
DROP SEQUENCE IF EXISTS serial_seq;
});
return 1;
} ## end of unmock_serialization_failure
sub add_test_databases {
## Add one or more databases to the bucardo.db table
## Arguments:
## 1. White-space separated db names
## Returns: nothing
my $self = shift;
my $string = shift or die;
for my $db (split /\s+/ => $string) {
my $ctlargs = $self->add_db_args($db);
my $i = $self->ctl("add database bucardo_test $ctlargs");
die $i if $i =~ /ERROR/;
}
return;
} ## end of add_test_databases
sub add_db_args {
## Arguments:
## 1. Name of a cluster
## Returns: DSN-like string to connect to that cluster
## Allows for "same" databases o the form X# e.g. A1, B1
## May return string or array depending on how it was called
my $self = shift;
my $clustername = shift or die;
$clustername =~ s/\d+$//;
## Build the DSN to connect with
my $info = $pgver{$clustername};
my $dbport = $info->{port};
my $dbhost = getcwd . "/$info->{dirname}/socket";
my $dsn = "dbi:Pg:dbname=$dbname;port=$dbport;host=$dbhost";
return wantarray
? ($user,$dbport,$dbhost)
: "name=$dbname user=$user port=$dbport host=$dbhost";
} ## end of add_db_args
sub stop_bucardo {
## Stops Bucardo via a bucardo request
## Arguments: none
## Returns: 1
my $self = shift;
$self->ctl('stop testing');
sleep 0.2;
return 1;
} ## end of stop_bucardo
sub ctl {
## Run a simple non-forking command against bucardo
## Emulates a command-line invocation
## Arguments:
## 1. String to pass to bucardo
## 2. Database name to connect to. Used only when we're not confident the bucardo database exists already.
## Returns: answer as a string
my ($self,$args, $db) = @_;
$db ||= 'bucardo';
my $info;
my $ctl = $self->{bucardo};
## Build the connection options
my $bc = $self->{bcinfo};
my $connopts = '';
for my $arg (qw/host port pass/) {
my $val = 'DB' . (uc $arg) . '_bucardo';
next unless exists $bc->{$val} and length $bc->{$val};
$connopts .= " --db$arg=$bc->{$val}";
}
$connopts .= " --dbname=$db --log-dest .";
$connopts .= " --dbuser=$user";
## Just hard-code these, no sense in multiple Bucardo base dbs yet:
$connopts .= " --dbport=58921";
my $dbhost = getcwd;
my $dirname = $pgver{A}{dirname};
$dbhost .= "/$dirname/socket";
$connopts .= " --dbhost=$dbhost";
## Whitespace cleanup
$args =~ s/^\s+//s;
## Allow the caller to look better
$args =~ s/^bucardo\s+//;
## Set a timeout
alarm 0;
eval {
local $SIG{ALRM} = sub { die "Alarum!\n"; };
alarm $ALARM_BUCARDO;
debug("Script: $ctl Connection options: $connopts Args: $args", 3);
$info = decode( locale => qx{$ctl $connopts $args 2>&1} );
debug("Exit value: $?", 3);
die $info if $? != 0;
alarm 0;
};
if ($@ =~ /Alarum/ or $info =~ /Alarum/) {
return __PACKAGE__ . ' timeout hit, giving up';
}
if ($@) {
return "Error running bucardo: " . decode( locale => $@ ) . "\n";
}
debug("bucardo said: $info", 3);
return $info;
} ## end of ctl
sub restart_bucardo {
## Start Bucardo, but stop first if it is already running
## Arguments: one, two, or three
## 1. database handle to the bucardo_control_test db
## 2. The notice we wait for, defaults to: bucardo_started
## 3. The message to give to the "pass" function, defaults to: Bucardo was started
## Returns: nothing
my ($self,$dbh,$notice,$passmsg) = @_;
my $line = (caller)[2];
$notice ||= 'bucardo_started';
$passmsg ||= "Bucardo was started (caller line $line)";
$self->stop_bucardo();
## Because the stop signal arrives before the PID is removed, sleep a bit
sleep 2;
pass("Starting up Bucardo (caller line $line)");
$dbh->do('LISTEN bucardo');
$dbh->do('LISTEN bucardo_boot');
$dbh->do("LISTEN $notice");
$dbh->do('LISTEN bucardo_nosyncs');
$dbh->commit();
my $output = $self->ctl('start --exit-on-nosync --quickstart testing');
my $bail = 50;
my $n;
WAITFORIT: {
if ($bail--<0) {
$output =~ s/^/# /gmx;
my $time = localtime;
die "Bucardo did not start, but we waited!\nTime: $time\nStart output:\n\n$output\n";
}
while ($n = $dbh->func('pg_notifies')) {
my ($name, $pid, $payload) = @$n;
if ($dbh->{pg_server_version} >= 9999990000) {
next if $name ne 'bucardo';
$name = $payload;
}
last WAITFORIT if $name eq $notice;
}
$dbh->commit();
sleep 0.2;
redo;
}
pass($passmsg);
## There is a race condition here for testing
## Bucardo starts up, and gives the notice above.
## However, after it does so, CTLs and KIDs start up and look for new rows
## If the caller of this function makes changes right away and then kicks,
## Bucardo may see them on the "startup kick" and thus the caller will
## get a "syncdone" message that was not initiated by *their* kick.
## One way around this is to make sure your caller immediately does a
## kick 0, which will flush out the startup kick. If it arrives after the
## startup kick, then it simply returns as a sync with no activity
return 1;
} ## end of restart_bucardo
sub setup_bucardo {
## Installs bucardo via "bucardo install" into a database
## The database will be emptied out first if it already exists
## If it does not exist, it will be created
## If the cluster does not exist, it will be created
## Arguments:
## 1. Name of the cluster
## Returns: database handle to the bucardo database
my $self = shift;
my $clustername = shift or die;
Test::More::note('Installing Bucardo');
$self->create_cluster($clustername);
my $dbh = $self->connect_database($clustername, 'postgres');
if (database_exists($dbh,'bucardo')) {
## Kick off all other people
my $pidcol = $dbh->{pg_server_version} >= 90200 ? 'pid' : 'procpid';
$SQL = qq{SELECT $pidcol FROM pg_stat_activity WHERE datname = 'bucardo' and $pidcol <> pg_backend_pid()};
for my $row (@{$dbh->selectall_arrayref($SQL)}) {
my $pid = $row->[0];
$SQL = 'SELECT pg_terminate_backend(?)';
$sth = $dbh->prepare($SQL);
$sth->execute($pid);
}
$dbh->commit();
debug(qq{Dropping database bucardo from cluster $clustername});
local $dbh->{AutoCommit} = 1;
$dbh->do('DROP DATABASE bucardo');
}
## Make sure we have a postgres role
if (! user_exists($dbh, 'postgres')) {
$dbh->do('CREATE USER postgres SUPERUSER');
$dbh->commit();
}
## Now run the install. Timeout after a few seconds
debug(qq{Running bucardo install on cluster $clustername});
my $info = $self->ctl('install --batch', 'postgres');
if ($info !~ /Installation is now complete/) {
die "Installation failed: $info\n";
}
## Reconnect to the new database
$dbh = $self->connect_database($clustername, 'bucardo');
## Make some adjustments
$sth = $dbh->prepare('UPDATE bucardo.bucardo_config SET setting = $2 WHERE name = $1');
$count = $sth->execute('piddir' => $PIDDIR);
$count = $sth->execute('reason_file' => "$PIDDIR/reason");
$count = $sth->execute('sendmail_file' => 'debug.sendmail.txt');
$count = $sth->execute('audit_pid' => 1);
$dbh->commit();
## Adjust a second way
$self->ctl('set log_level=debug log_microsecond=1 log_showline=1');
debug(qq{Install complete});
return $dbh;
} ## end of setup_bucardo
## Utility functions for object existences:
sub thing_exists {
my ($dbh,$name,$table,$column) = @_;
my $SQL = "SELECT 1 FROM $table WHERE $column = ?";
## Only want tables from the public schema for now
if ($table eq 'pg_class') {
$SQL .= qq{ AND relnamespace = (SELECT oid FROM pg_namespace WHERE nspname = 'public')};
}
my $sth = $dbh->prepare($SQL);
$count = $sth->execute($name);
$sth->finish();
$dbh->commit() if ! $dbh->{AutoCommit};
return $count < 1 ? 0 : $count;
}
sub schema_exists { return thing_exists(@_, 'pg_namespace', 'nspname'); }
sub language_exists { return thing_exists(@_, 'pg_language', 'lanname'); }
sub database_exists { return thing_exists(@_, 'pg_database', 'datname'); }
sub user_exists { return thing_exists(@_, 'pg_user', 'usename'); }
sub table_exists { return thing_exists(@_, 'pg_class', 'relname'); }
sub function_exists { return thing_exists(@_, 'pg_proc', 'proname'); }
sub domain_exists { return thing_exists(@_, 'pg_type', 'typname'); }
sub wait_for_notice {
## Wait until a named NOTIFY is issued
## Arguments:
## 1. The listen string or array of strings
## 2. Seconds until we give up
## 3. Seconds we sleep between checks
## 4. Boolean: bail out if not found (defaults to true)
## Returns true if the NOTIFY was recieved.
my $self = shift;
my $dbh = shift;
my $text = shift;
my $timeout = shift || $TIMEOUT_NOTICE;
my $sleep = shift || $TIMEOUT_SLEEP;
my $bail = shift;
$bail = 0 if !defined($bail);
my $n;
my %wait_for;
for my $str (ref $text ? @{ $text } : $text) {
$wait_for{$str}++;
}
eval {
local $SIG{ALRM} = sub { die "Lookout!\n"; };
alarm $timeout;
N: {
while ($n = $dbh->func('pg_notifies')) {
my ($name, $pid, $payload) = @$n;
$name = $payload if length $payload;
if (exists $wait_for{$name}) {
if (--$wait_for{$name} == 0) {
delete $wait_for{$name};
last N unless %wait_for;
}
}
else {
debug("notice was $name", 1);
}
}
sleep $sleep;
redo;
}
alarm 0;
};
if ($@) {
if ($@ =~ /Lookout/o) {
my $line = (caller)[2];
my $now = scalar localtime;
my $texts = join '", "', keys %wait_for;
my $pl = keys %wait_for > 1 ? 's' : '';
my $notice = qq{Gave up waiting for notice$pl "$texts": timed out at $timeout from line $line. Time=$now};
if ($bail) {
Test::More::BAIL_OUT ($notice);
}
else {
die $notice;
}
return;
}
}
return 1;
} ## end of wait_for_notice
## Older methods:
sub fresh_database {
## Drop and create the bucardo_test database
## First arg is cluster name
## Second arg is hashref, can be 'dropdb'
my $self = shift;
my $name = shift || 'A';
my $arg = shift || {};
my $dirname = $pgver{$name}{dirname};
## Just in case
-d $dirname or $self->create_cluster($name);
-e "$dirname/postmaster.pid" or $self->start_cluster($name);
my $dbh = $self->connect_database($name, 'postgres');
my $brandnew = 0;
{
if (database_exists($dbh => $dbname) and $arg->{dropdb}) {
local $dbh->{AutoCommit} = 1;
debug("Dropping database $dbname");
$dbh->do("DROP DATABASE $dbname");
}
if (!database_exists($dbh => $dbname)) {
local $dbh->{AutoCommit} = 1;
debug("Creating database $dbname");
$dbh->do("CREATE DATABASE $dbname");
$brandnew = 1;
$dbh->disconnect();
}
}
$dbh = $self->connect_database($name, $dbname);
return $dbh if $brandnew;
$self->empty_test_database($dbh);
return $dbh;
} ## end of fresh_database
sub create_database {
## Create a new database
## First argument is the cluster name
## Second argument is the name of the database
## If the database already exists, nothing will be done
## Returns a database handle to the database
my $self = shift;
my $clustername = shift or die;
my $dbname = shift or die;
my $dirname = $pgver{$clustername}{dirname};
## Create the cluster if needed
-d $dirname or $self->create_cluster($clustername);
## Start the cluster up if needed
-e "$dirname/postmaster.pid" or $self->start_cluster($clustername);
## Connect to the database
my $dbh = $self->connect_database($clustername, 'postgres');
if (! database_exists($dbh => $dbname)) {
local $dbh->{AutoCommit} = 1;
debug("Creating database $dbname");
$dbh->do("CREATE DATABASE $dbname");
$dbh->disconnect();
}
$dbh = $self->connect_database($clustername, $dbname);
return $dbh;
} ## end of create_database
sub empty_test_database {
## Wipe all data tables from a test database
## Takes a database handle as only arg
my $self = shift;
my $dbh = shift;
if ($dbh->{pg_server_version} >= 80300) {
$dbh->do(q{SET session_replication_role = 'replica'});
}
for my $table (sort keys %tabletype) {
$dbh->do(qq{TRUNCATE TABLE "$table"});
}
for my $table (@tables2empty) {
$dbh->do(qq{TRUNCATE TABLE "$table"});
}
if ($dbh->{pg_server_version} >= 80300) {
$dbh->do(q{SET session_replication_role = 'origin'});
}
$dbh->commit;
return;
} ## end of empty_test_database
END {
# __PACKAGE__->shutdown_cluster($_) for keys %pgver;
}
sub shutdown_cluster {
## Shutdown a cluster if running
## Takes the cluster name
my $self = shift;
my $name = shift;
my $dirname = $pgver{$name}{dirname};
return if ! -d $dirname;
my $pidfile = "$dirname/postmaster.pid";
return if ! -e $pidfile;
Test::More::note("Stopping cluster $name");
my @cmd = ($pg_ctl, '-D', $dirname, '-s', '-m', 'fast', 'stop');
system(@cmd) == 0 or die "@cmd failed: $?\n";
## Hang around until the PID file is gone
my $loops = 0;
{
sleep 0.2;
last if ! -e $pidfile;
redo;
}
delete $gdbh{$name};
return;
} ## end of shutdown_cluster
sub remove_cluster {
## Remove a cluster, shutting it down first
## Takes the cluster name
my $self = shift;
my $name = shift;
my $dirname = $pgver{$name}{dirname};
return if ! -d $dirname;
## Just in case
$self->shutdown_cluster($name);
system("rm -fr $dirname");
return;
} ## end of remove_cluster
sub tt {
## Simple timing routine. Call twice with the same arg, before and after
my $name = shift or die qq{Need a name!\n};
if (exists $timing{$name}) {
my $newtime = tv_interval($timing{$name});
debug("Timing for $name: $newtime");
delete $timing{$name};
}
else {
$timing{$name} = [gettimeofday];
}
return;
} ## end of tt
sub t {
$testmsg = shift || '';
$testline = shift || (caller)[2];
$testmsg =~ s/^\s+//;
if ($location) {
$testmsg = "($location) $testmsg";
}
$testmsg .= " [line: $testline]";
my $time = time;
$testmsg .= " [time: $time]" unless $notime;
return;
} ## end of t
sub add_test_tables_to_herd {
## Add all of the test tables (and sequences) to a herd
## Create the herd if it does not exist
## First arg is database name, second arg is the herdname
my $self = shift;
my $db = shift;
my $herd = shift;
my $result = $self->ctl("add herd $herd");
if ($result !~ /Added herd/) {
die "Failed to add herd $herd: $result\n";
}
my $addstring = join ' ' => sort keys %tabletype;
my $com = "add table $addstring db=$db herd=$herd";
$result = $self->ctl($com);
if ($result !~ /Added table/) {
die "Failed to add tables: $result (command was: $com)\n";
}
$addstring = join ' ' => sort keys %sequences;
$com = "add sequence $addstring db=$db herd=$herd";
$result = $self->ctl($com);
if ($result !~ /Added sequence/) {
die "Failed to add sequences: $result (command was: $com)\n";
}
return;
} ## end of add_test_tables_to_herd
sub bc_deeply {
my ($exp,$dbh,$sql,$msg,$oline) = @_;
my $line = (caller)[2];
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 0;
die "Very invalid statement from line $line: $sql\n" if $sql !~ /^\s*select/i;
my $got;
eval {
$got = $dbh->selectall_arrayref($sql);
};
if ($@) {
die "bc_deeply failed from line $line. SQL=$sql\n$@\n";
}
local $Test::Builder::Level = $Test::Builder::Level + 1;
return is_deeply($got,$exp,$msg,$oline||(caller)[2]);
} ## end of bc_deeply
sub clear_notices {
my $dbh = shift;
my $timeout = shift || $TIMEOUT_NOTICE;
sleep $timeout;
0 while (my $n = $dbh->func('pg_notifies'));
}
sub get_pgctl_options {
my $dirname = shift;
my $option;
if ($^O !~ /Win32/) {
my $sockdir = "$dirname/socket";
-e $sockdir or mkdir $sockdir;
$option = q{-o '-k socket'};
}
return $option;
}
sub remove_single_dir {
my $dirname = shift;
print "Removing test database in $dirname\n";
# Try stopping PostgreSQL
my $options = get_pgctl_options($dirname);
qx{$pg_ctl $options -l $dirname/pg.log -D $dirname stop -m immediate};
sleep 2;
qx{rm -rf $dirname};
return;
}
sub drop_database {
my ($self, $dir) = @_;
if ($dir eq 'all') {
ok(opendir(my $dh, '.'), 'Open current directory to clean up');
my @test_db_dirs = grep { -d $_ && /^bucardo_test_database/ } readdir $dh;
close($dh);
for my $dirname (@test_db_dirs) {
remove_single_dir($dirname);
}
}
else {
remove_single_dir($dir);
}
return;
}
sub add_row_to_database {
## Add a row to each table in one of the databases
## Arguments: three
## 1. Database name to use
## 2. Value to use (lookup, not the direct value)
## 3. Do we commit or not? Boolean, defaults to true
## Returns: undef
my ($self, $dbname, $xval, $commit) = @_;
if ($xval > $xvalmax) {
die "Too high of an ID: max is $xvalmax\n";
}
$commit = 1 if ! defined $commit;
my $dbh = $gdbh{$dbname} or die "No such database: $dbname";
## Loop through each table we know about
for my $table (sort keys %tabletype) {
## Look up the actual value to use
my $type = $tabletype{$table};
my $value = $val{$type}{$xval};
## Prepare it if we have not already
if (! exists $gsth{$dbh}{insert}{$xval}{$table}) {
## Handle odd pkeys
my $pkey = $table =~ /test5/ ? q{"id space"} : 'id';
## Put some standard values in, plus a single placeholder
my $SQL = qq{INSERT INTO "$table"($pkey,data1,inty,booly) VALUES (?,'foo',$xval,'true')};
$gsth{$dbh}{insert}{$xval}{$table} = $dbh->prepare($SQL);
## If this is a bytea, we need to tell DBD::Pg about it
if ('BYTEA' eq $type) {
$gsth{$dbh}{insert}{$xval}{$table}->bind_param(1, undef, {pg_type => PG_BYTEA});
}
}
## Execute!
$gsth{$dbh}{insert}{$xval}{$table}->execute($value);
}
$dbh->commit() if $commit;
return undef;
} ## end of add_row_to_database
sub update_row_in_database {
## Change a row in each table in a database
## We always change the "inty" field
## Arguments: four
## 1. Database name to use
## 2. Primary key to update
## 3. New value
## 4. Do we commit or not? Boolean, defaults to true
## Returns: undef
my ($self, $dbname, $pkeyvalue, $newvalue, $commit) = @_;
$commit = 1 if ! defined $commit;
my $dbh = $gdbh{$dbname} or die "No such database: $dbname";
## Loop through each table we know about
for my $table (sort keys %tabletype) {
## Look up the actual value to use
my $type = $tabletype{$table};
my $value = $val{$type}{$pkeyvalue};
## Prepare it if we have not already
if (! exists $gsth{$dbh}{update}{inty}{$table}) {
## Handle odd pkeys
my $pkey = $table =~ /test5/ ? q{"id space"} : 'id';
my $SQL = qq{UPDATE "$table" SET inty=? WHERE $pkey = ?};
$gsth{$dbh}{update}{inty}{$table} = $dbh->prepare($SQL);
if ('BYTEA' eq $type) {
$gsth{$dbh}{update}{inty}{$table}->bind_param(2, undef, {pg_type => PG_BYTEA});
}
}
## Execute!
$gsth{$dbh}{update}{inty}{$table}->execute($newvalue,$value);
}
$dbh->commit() if $commit;
return undef;
} ## end of update_row_in_database
sub remove_row_from_database {
## Delete a row from each table in one of the databases
## Arguments: three
## 1. Database name to use
## 2. Value to use (lookup, not the direct value). Can be an arrayref.
## 3. Do we commit or not? Boolean, defaults to true
## Returns: undef
my ($self, $dbname, $val, $commit) = @_;
$commit = 1 if ! defined $commit;
my $dbh = $gdbh{$dbname} or die "No such database: $dbname";
## Loop through each table we know about
for my $table (sort keys %tabletype) {
## Prepare it if we have not already
if (! exists $gsth{$dbh}{delete}{$table}) {
## Delete, based on the inty
my $SQL = qq{DELETE FROM "$table" WHERE inty = ?};
$gsth{$dbh}{delete}{$table} = $dbh->prepare($SQL);
}
## Execute it.
if (ref $val) {
for (@$val) {
$gsth{$dbh}{delete}{$table}->execute($_);
}
}
else {
$gsth{$dbh}{delete}{$table}->execute($val);
}
}
$dbh->commit() if $commit;
return undef;
} ## end of remove_row_from_database
sub truncate_all_tables {
## Truncate all the tables
## Arguments: two
## 1. Database to use
## 3. Do we commit or not? Boolean, defaults to true
## Returns: undef
my ($self, $dbname, $commit) = @_;
$commit = 1 if ! defined $commit;
my $dbh = $gdbh{$dbname} or die "No such database: $dbname";
## Loop through each table we know about
for my $table (sort keys %tabletype) {
$dbh->do(qq{TRUNCATE Table "$table"});
}
$dbh->commit() if $commit;
return undef;
} ## end of truncate_all_tables
sub delete_all_tables {
## Delete all the tables.
## Mostly for old versions that do not support truncate triggers.
## Arguments: two
## 1. Database to use
## 3. Do we commit or not? Boolean, defaults to true
## Returns: undef
my ($self, $dbname, $commit) = @_;
$commit = 1 if ! defined $commit;
my $dbh = $gdbh{$dbname} or die "No such database: $dbname";
## Loop through each table we know about
for my $table (sort keys %tabletype) {
$dbh->do(qq{DELETE FROM "$table"});
}
$dbh->commit() if $commit;
return undef;
} ## end of delete_all_tables
sub check_for_row {
## Check that a given row is on the database as expected: checks the inty column only
## Arguments: two or three or four
## 1. The result we are expecting, as an arrayref
## 2. A list of database names (should be inside gdbh)
## 3. Optional text to append to output message
## 4. Optional tables to limit checking to
## Returns: undef
my ($self, $res, $dblist, $text, $filter) = @_;
## Get largest tablename
my $maxtable = 1;
for my $table (keys %tabletype) {
## Allow skipping tables
if (defined $filter) {
my $f = $filter;
if ($f =~ s/^\!//) {
if ($table =~ /$f$/) {
delete $tabletype{$table};
next;
}
}
else {
if ($table !~ /$f$/) {
delete $tabletype{$table};
next;
}
}
}
$maxtable = length $table if length $table > $maxtable;
}
for my $dbname (@$dblist) {
if (! $gdbh{$dbname}) {
$gdbh{$dbname} = $self->connect_database($dbname,$BucardoTesting::dbname);
}
my $dbh = $gdbh{$dbname};
my $maxdbtable = $maxtable + 1 + length $dbname;
for my $table (sort keys %tabletype) {
## Handle odd pkeys
my $pkey = $table =~ /test5/ ? q{"id space"} : 'id';
my $type = $tabletype{$table};
my $t = sprintf qq{%-*s copy ok (%s)},
$maxdbtable,
"$dbname.$table",
$type;
## Change the message if no rows
if (ref $res eq 'ARRAY' and ! defined $res->[0]) {
$t = sprintf qq{No rows as expected in %-*s for pkey type %s},
$maxdbtable,
"$dbname.$table",
$type;
}
if (defined $text and length $text) {
$t .= " $text";
}
my $SQL = qq{SELECT inty FROM "$table" ORDER BY inty};
$table =~ /X/ and $SQL =~ s/inty/$pkey/;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $result = bc_deeply($res, $dbh, $SQL, $t, (caller)[2]);
$dbh->commit();
if (!$result) {
my $line = (caller)[2];
Test::More::BAIL_OUT "Stopping on a failed 'check_for_row' test from line $line";
}
}
}
return;
} ## end of check_for_row
sub check_sequences_same {
## Check that sequences are the same across all databases
## Arguments: one
## 1. A list of database names (should be inside gdbh)
## Returns: undef
my ($self, $dblist) = @_;
for my $seq (sort keys %sequences) {
$SQL = qq{SELECT * FROM "$seq"};
## The first we come across will be the standard for the others
my (%firstone, $firstdb);
## Store failure messages
my @msg;
for my $dbname (@$dblist) {
my $dbh = $gdbh{$dbname} or die "Invalid database name: $dbname";
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $info = $sth->fetchall_arrayref({})->[0];
if (! defined $firstone{$seq}) {
$firstone{$seq} = $info;
$firstdb = $dbname;
next;
}
## Compare certain items
for my $item (qw/ last_value start_value increment_by min_value max_value is_cycled is_called/) {
my ($uno,$dos) = ($firstone{$seq}->{$item}, $info->{$item});
next if ! defined $uno or ! defined $dos;
if ($uno ne $dos) {
push @msg, "$item is different on $firstdb vs $dbname: $uno vs $dos";
}
}
} ## end each sequence
if (@msg) {
Test::More::fail("Sequence $seq NOT the same");
for (@msg) {
diag($_);
}
}
else {
Test::More::pass("Sequence $seq is the same across all databases");
}
} ## end each database
return;
} ## end of check_sequences_same
## Hack to override some Test::More methods
## no critic
sub is_deeply {
t($_[2],$_[3] || (caller)[2]);
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $rv = Test::More::is_deeply($_[0],$_[1],$testmsg);
return $rv if $rv;
if ($bail_on_error and ++$total_errors => $bail_on_error) {
my $line = (caller)[2];
my $time = time;
diag("GOT: ".Dumper $_[0]);
diag("EXPECTED: ".Dumper $_[1]);
Test::More::BAIL_OUT "Stopping on a failed 'is_deeply' test from line $line. Time: $time";
}
} ## end of is_deeply
sub like($$;$) {
t($_[2],(caller)[2]);
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $rv = Test::More::like($_[0],$_[1],$testmsg);
return $rv if $rv;
if ($bail_on_error and ++$total_errors => $bail_on_error) {
my $line = (caller)[2];
my $time = time;
# Test::More::diag("GOT: ".Dumper $_[0]);
# Test::More::diag("EXPECTED: ".Dumper $_[1]);
Test::More::BAIL_OUT "Stopping on a failed 'like' test from line $line. Time: $time";
}
} ## end of like
sub pass(;$) {
t($_[0],$_[1]||(caller)[2]);
local $Test::Builder::Level = $Test::Builder::Level + 1;
Test::More::pass($testmsg);
} ## end of pass
sub is($$;$) {
t($_[2],(caller)[2]);
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $rv = Test::More::is($_[0],$_[1],$testmsg);
return $rv if $rv;
## Where exactly did this fail?
my $char = 0;
my $onelen = length $_[0];
my $twolen = length $_[1];
my $line = 1;
my $lchar = 1;
for ($char = 0; $char < $onelen and $char < $twolen; $char++) {
my $one = ord(substr($_[0],$char,1));
my $two = ord(substr($_[1],$char,1));
if ($one != $two) {
diag("First difference at character $char ($one vs $two) (line $line, char $lchar)");
last;
}
if (10 == $one) {
$line++;
$lchar = 1;
}
else {
$lchar++;
}
}
if ($bail_on_error and ++$total_errors => $bail_on_error) {
my $line = (caller)[2];
my $time = time;
Test::More::BAIL_OUT "Stopping on a failed 'is' test from line $line. Time: $time";
}
} ## end of is
sub isa_ok($$;$) {
t("Object isa $_[1]",(caller)[2]);
my ($name, $type, $msg) = ($_[0],$_[1]);
local $Test::Builder::Level = $Test::Builder::Level + 1;
if (ref $name and ref $name eq $type) {
Test::More::pass($testmsg);
return;
}
if ($bail_on_error and ++$total_errors => $bail_on_error) {
Test::More::BAIL_OUT "Stopping on a failed test";
}
} ## end of isa_ok
sub ok($;$) {
t($_[1]||$testmsg);
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $rv = Test::More::ok($_[0],$testmsg);
return $rv if $rv;
if ($bail_on_error and ++$total_errors => $bail_on_error) {
my $line = (caller)[2];
my $time = time;
Test::More::BAIL_OUT "Stopping on a failed 'ok' test from line $line. Time: $time";
}
} ## end of ok
## use critic
1;
Bucardo-5.4.1/t/20-redis.t0000644000175000017500000001164512563002233013512 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test using Redis as a database target
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use vars qw/ $dbhX $dbhA $dbhB $res $command $t $SQL %pkey %sth %sql $sth $count $val /;
## Must have the Redis module
my $evalok = 0;
eval {
require Redis;
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => 'Cannot test Redis unless the Perl module Redis is installed');
}
## Redis must be up and running
$evalok = 0;
my $dbhR;
eval {
$dbhR = Redis->new();
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => "Cannot test Redis as we cannot connect to a running Redis instance");
}
use BucardoTesting;
## For now, remove the bytea table type as we don't have full support yet
delete $tabletype{bucardo_test8};
my $bct = BucardoTesting->new({location => 'redis'})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
plan tests => 70;
pass("*** Beginning redis tests");
END {
$dbhR and remove_test_tables();
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
}
## Remove any existing Bucardo test keys that may exist on the Redis server
remove_test_tables();
sub remove_test_tables {
for my $table (sort keys %tabletype) {
my @keylist = $dbhR->keys("$table:*");
for my $key (@keylist) {
$dbhR->del($key);
}
}
}
## Get A and B created, emptied out, and repopulated with sample data
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Teach Bucardo about the Postgres databases
for my $name (qw/ A B /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
## Put all pk tables into a relgroup
$t = q{Adding all PK tables on the master works};
$res = $bct->ctl(q{bucardo add tables '*bucardo*test*' '*Bucardo*test*' db=A relgroup=allpk pkonly});
like ($res, qr/Created the relgroup named "allpk".*are now part of/s, $t);
## Add all sequences
$t = q{Adding all sequences to the main relgroup};
$res = $bct->ctl(q{bucardo add all sequences relgroup=allpk});
like ($res, qr/New sequences added/s, $t);
my $dbname = 'bucardo_test';
$t = 'Adding Redis database R works';
$command =
"bucardo add db R dbname=$dbname type=redis";
$res = $bct->ctl($command);
like ($res, qr/Added database "R"/, $t);
## Create a new dbgroup going from A to B and off to R
$t = q{Created a new dbgroup A <=> B -> R};
$res = $bct->ctl('bucardo add dbgroup pg1 A:source B:source R:target');
like ($res, qr/Created dbgroup "pg1"/, $t);
$t = q{Created a new sync for dbgroup pg1};
$res = $bct->ctl('bucardo add sync pgtest1 relgroup=allpk dbs=pg1 status=active');
like ($res, qr/Added sync "pgtest1"/, $t);
## Add a row to A, and one to B
$bct->add_row_to_database('A', 1);
$bct->add_row_to_database('B', 2);
## Start listening for a syncdone message
$dbhX->do('LISTEN bucardo_syncdone_pgtest1');
$dbhX->commit();
## Start up Bucardo
$bct->restart_bucardo($dbhX, 'bucardo_syncdone_pgtest1');
## See if things are on the other databases
$bct->check_for_row([[1],[2]], [qw/ A B /]);
## Check that both rows made it out to Redis
for my $rownum (1..2) {
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
my $val = $val{$type}{$rownum};
my $expected = { inty => $rownum, booly => 't', data1 => 'foo' };
if ($table eq 'bucardo_test2') {
$val .= ':foo';
delete $expected->{data1};
}
my $name = "$table:$val";
my %hash = $dbhR->hgetall($name);
$t = "Table $table, pkey $val is replicated to Redis as expected";
if (! is_deeply(\%hash, $expected, $t)) {
diag Dumper \%hash;
}
}
}
## Make sure null maps to the field being removed
for my $table (sort keys %tabletype) {
$SQL = qq{UPDATE "$table" SET booly=NULL};
$dbhA->do($SQL);
}
$dbhA->commit();
$bct->ctl('bucardo kick pgtest1 0');
## Check that both rows made it out to Redis
for my $rownum (1..2) {
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
my $val = $val{$type}{$rownum};
my $expected = { inty => $rownum, data1 => 'foo' };
if ($table eq 'bucardo_test2') {
$val .= ':foo';
delete $expected->{data1};
}
my $name = "$table:$val";
my %hash = $dbhR->hgetall($name);
$t = "Table $table, pkey $val is replicated to Redis as expected (booly gone)";
if (! is_deeply(\%hash, $expected, $t)) {
diag Dumper \%hash;
}
}
}
exit;
Bucardo-5.4.1/t/50-star.t0000644000175000017500000001132212563002233013350 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test Bucardo in a large star network
## We will use 'A' as the hub, and the three others B C D, each having multiple dbs
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use vars qw/ $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t $SQL $sth $count /;
use BucardoTesting;
my $bct = BucardoTesting->new({location => 'star', bail => 1})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
pass("*** Beginning star tests");
END {
$bct and $bct->stop_bucardo();
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
$dbhD and $dbhD->disconnect();
}
## Get A, B, C, and D created, emptied out, and repopulated with sample data
my $extras = 5;
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B',$extras);
$dbhC = $bct->repopulate_cluster('C',$extras);
$dbhD = $bct->repopulate_cluster('D',$extras);
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Teach Bucardo about all databases
my (@alldbs, @alldbhs, %dbmap);
for my $name (qw/ A B C D /) {
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
for my $number (0..$extras) {
my $dbname = 'bucardo_test';
my $bname = $name;
## Always a single hub
next if $number and $name eq 'A';
if ($number) {
$dbname .= $number;
$bname .= $number;
}
$t = "Added database $bname for database $dbname";
$command = "bucardo add db $bname dbname=$dbname user=$dbuser port=$dbport host=$dbhost";
$command .= ' makedelta=1' if $name eq 'A';
$res = $bct->ctl($command);
like ($res, qr/Added database "$bname"/, $t);
push @alldbs => $bname;
my $dbh = $bct->connect_database($bname, $dbname);
push @alldbhs => $dbh;
$dbmap{$dbh} = $bname;
}
}
## Put all pk tables into a relgroup
$t = q{Added all PK tables to a relgroup named 'allpk'};
$res = $bct->ctl(q{bucardo add tables '*bucardo*test*' '*Bucardo*test*' db=A relgroup=allpk pkonly});
like ($res, qr/Created the relgroup named "allpk".*are now part of/s, $t);
## Make a simpler relgroup of just one table
$t = q{Created relgroup of just bucardo_test1 named 'rel1'};
$res = $bct->ctl(q{bucardo add relgroup rel1 bucardo_test1});
like ($res, qr/relgroup "rel1"/s, $t);
## Create a lot of syncs. Each simulates a multi-source from center to a distinct server leaf
my $number = 2;
for my $db (qw/ B C D /) {
for my $num (0..$extras) {
my $syncname = "star$number";
my $leaf = sprintf '%s%s', $db, $num || '';
$t = qq{Created a new sync $syncname going for A <=> $leaf};
my $command = "bucardo add sync $syncname relgroup=rel1 dbs=A,$leaf:source autokick=true";
$res = $bct->ctl($command);
like ($res, qr/Added sync "$syncname"/, $t);
$number++;
}
}
## Turn off the vac daemon for now
$bct->ctl('bucardo set bucardo_vac=0');
## Start up the Bucardo daemon
$bct->restart_bucardo($dbhX);
## Add a row to A and make sure it gets to all leafs
$bct->add_row_to_database('A', 1);
$bct->ctl('bucardo kick sync star1 0');
sleep 5;
$bct->check_for_row([[1]], \@alldbs, '', 'bucardo_test1');
$number = 0;
my $maxnumber = 1;
$SQL = 'INSERT INTO bucardo_test1(id,inty) VALUES (?,?)';
for my $dbh (@alldbhs) {
$number++;
next if $number < 2; ## Do not want to add anything to the "A" database
$dbh->do($SQL, undef, $number, $number);
$dbh->commit();
my $mydb = $dbmap{$dbh};
#diag "Added number $number to database $mydb";
$maxnumber = $number;
#last if $number >= 5;
}
## Scan everyone until replication is done.
## Bail if it gets too long
my $toolong = 30; ## number of 1-second loops
my $round = 1;
$SQL = 'SELECT id FROM bucardo_test1 ORDER BY id';
my %sth;
for my $dbh (@alldbhs) {
$sth{$dbh} = $dbh->prepare($SQL);
}
my $good = '';
for (1..$maxnumber) {
$good .= "$_ ";
}
chop $good;
{
my $allgood = 1;
for my $dbh (@alldbhs) {
$sth{$dbh}->execute();
my $output = join ' ' => map { $_->[0] } @{ $sth{$dbh}->fetchall_arrayref() };
$allgood = 0 if $output ne $good;
}
#diag "Round $round, good is $allgood";
last if $allgood;
if ($round++ >= $toolong) {
diag "Too many loops and no complete replication";
exit;
}
sleep 1;
redo;
}
pass 'All databases received all updates!';
for my $dbh (@alldbhs) {
$dbh->disconnect();
}
my $result = [];
push @$result, [$_] for 1..$maxnumber;
$bct->check_for_row($result, [qw/ A B C D /], '', 'bucardo_test1');
$bct->ctl('bucardo stop');
done_testing();
Bucardo-5.4.1/t/30-delta.t0000644000175000017500000001362212563002233013473 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test bucardo_delta and bucardo_track table tasks
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use vars qw/ $bct $dbhX $dbhA $dbhB $dbhC $res $command $t $SQL %pkey %sth %sql $sth $count/;
use BucardoTesting;
$bct = BucardoTesting->new() or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = '';
my $numtabletypes = keys %tabletype;
my $numsequences = keys %sequences;
plan tests => 164;
pass("*** Beginning delta tests");
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
}
## Get Postgres databases A, B, and C created
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Tell Bucardo about these databases (one source and two targets)
for my $name (qw/ A B C /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
## Put all pk tables into a relgroup
$t = q{Adding all PK tables on the master works};
$res = $bct->ctl(q{bucardo add tables '*bucardo*test*' '*Bucardo*test*' db=A relgroup=trelgroup pkonly});
like ($res, qr/Created the relgroup named "trelgroup".*are now part of/s, $t);
## Add all sequences, and add them to the newly created relgroup
$t = q{Adding all sequences on the master works};
$res = $bct->ctl("bucardo add all sequences relgroup=trelgroup");
like ($res, qr/New sequences added: \d/, $t);
## Create a new dbgroup going from A to B and C
$t = q{Created a new dbgroup};
$res = $bct->ctl(q{ bucardo add dbgroup pg A:source B:target C:target });
like ($res, qr/Created dbgroup "pg"/, $t);
## Create a new sync
$t = q{Created a new sync};
$res = $bct->ctl(q{ bucardo add sync dtest relgroup=trelgroup dbs=pg autokick=false });
like ($res, qr/Added sync "dtest"/, $t);
## Make sure the bucardo_delta and bucardo_track tables are empty
for my $table (sort keys %tabletype) {
my $tracktable = "track_public_$table";
my $deltatable = "delta_public_$table";
$t = "The track table $tracktable is empty";
$SQL = qq{SELECT 1 FROM bucardo."$tracktable"};
$count = $dbhA->do($SQL);
is ($count, '0E0', $t);
$t = "The delta table $deltatable is empty";
$SQL = qq{SELECT 1 FROM bucardo."$deltatable"};
$count = $dbhA->do($SQL);
is ($count, '0E0', $t);
}
## Start up Bucardo with this new sync
$bct->restart_bucardo($dbhX);
## Add a row to A
$bct->add_row_to_database('A', 1);
## Make sure that bucardo_track is empty and bucardo_delta has the expected value
for my $table (sort keys %tabletype) {
my $tracktable = "track_public_$table";
my $deltatable = "delta_public_$table";
$t = "The track table $tracktable is empty";
$SQL = qq{SELECT 1 FROM bucardo."$tracktable"};
$count = $dbhA->do($SQL);
is ($count, '0E0', $t);
my $pkeyname = $table =~ /test5/ ? q{"id space"} : 'id';
$t = "The delta table $deltatable contains the correct id";
$SQL = qq{SELECT $pkeyname FROM bucardo."$deltatable"};
$dbhA->do(q{SET TIME ZONE 'UTC'});
$res = $dbhA->selectall_arrayref($SQL);
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
is_deeply ($res, [[$val1]], $t) or die;
}
## Kick off the sync
$bct->ctl('bucardo kick dtest 0');
## All rows should be on A, B, and C
my $expected = [[1]];
$bct->check_for_row($expected, [qw/A B C/]);
## Make sure that bucardo_track now has a row
for my $table (sort keys %tabletype) {
my $tracktable = "track_public_$table";
$t = "The track table $tracktable contains the proper entry";
$SQL = qq{SELECT target FROM bucardo."$tracktable"};
$res = $dbhA->selectall_arrayref($SQL);
is_deeply ($res, [['dbgroup pg']], $t);
}
## Run the purge program
$bct->ctl('bucardo purge');
for my $table (sort keys %tabletype) {
my $tracktable = "track_public_$table";
my $deltatable = "delta_public_$table";
$t = "The track table $tracktable contains no entries post purge";
$SQL = qq{SELECT 1 FROM bucardo."$tracktable"};
$count = $dbhA->do($SQL);
is ($count, '0E0', $t);
$t = "The delta table $deltatable contains no entries post purge";
$SQL = qq{SELECT 1 FROM bucardo."$deltatable"};
$count = $dbhA->do($SQL);
is ($count, '0E0', $t);
}
## Create a doubled up entry in the delta table (two with same timestamp and pk)
$bct->add_row_to_database('A', 22, 0);
$bct->add_row_to_database('A', 28, 0);
$dbhA->commit();
## Check for two entries per table
for my $table (sort keys %tabletype) {
my $tracktable = "track_public_$table";
my $deltatable = "delta_public_$table";
$t = "The track table $tracktable is empty";
$SQL = qq{SELECT 1 FROM bucardo."$tracktable"};
$count = $dbhA->do($SQL);
is ($count, '0E0', $t);
$t = "The delta table $deltatable contains two entries";
$SQL = qq{SELECT 1 FROM bucardo."$deltatable"};
$count = $dbhA->do($SQL);
is ($count, 2, $t);
}
## Kick it off
$bct->ctl('bucardo kick dtest 0');
## Run the purge program
$bct->ctl('bucardo purge');
for my $table (sort keys %tabletype) {
my $tracktable = "track_public_$table";
my $deltatable = "delta_public_$table";
$t = "The track table $tracktable contains no entries post purge";
$SQL = qq{SELECT 1 FROM bucardo."$tracktable"};
$count = $dbhA->do($SQL);
is ($count, '0E0', $t);
$t = "The delta table $deltatable contains no entries post purge";
$SQL = qq{SELECT 1 FROM bucardo."$deltatable"};
$count = $dbhA->do($SQL);
is ($count, '0E0', $t);
}
exit;
Bucardo-5.4.1/t/ctest1.pl0000644000175000017500000000043712563002233013535 0ustar greggreg## ctest1.pl - a conflict handler for Bucardo
use strict;
use warnings;
my $info = shift;
## If this table is named 'work', do nothing
if ($info->{tablename} eq 'work') {
$info->{skip} = 1;
}
else {
## Winning databases, in order
$info->{tablewinner} = 'B A C';
}
return;
Bucardo-5.4.1/t/02-bctl-table.t0000644000175000017500000003072512563002233014415 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test adding, dropping, and changing tables via bucardo
## Tests the main subs: add_table, list_table, update_table, remove_table
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More tests => 46;
use vars qw/$t $res $expected $command $dbhX $dbhA $dbhB $SQL/;
use BucardoTesting;
my $bct = BucardoTesting->new({notime=>1})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = '';
## Make sure A and B are started up
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Grab connection information for each database
my ($dbuserA,$dbportA,$dbhostA) = $bct->add_db_args('A');
my ($dbuserB,$dbportB,$dbhostB) = $bct->add_db_args('B');
## Tests of basic 'add table' usage
$t = 'Add table with no argument gives expected help message';
$res = $bct->ctl('bucardo add table');
like ($res, qr/add table/, $t);
$t = q{Add table fails when no databases have been created yet};
$res = $bct->ctl('bucardo add table foobarz');
like ($res, qr/No databases have been added yet/, $t);
$bct->ctl("bucardo add db A dbname=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA");
$t = q{Add table fails when the table does not exist};
$res = $bct->ctl('bucardo add table foobarz');
like ($res, qr/Did not find matches.* foobarz/s, $t);
## Clear out each time, gather a list afterwards
sub empty_goat_table() {
$SQL = 'TRUNCATE TABLE herdmap, herd, goat CASCADE';
$dbhX->do($SQL);
$dbhX->commit();
}
empty_goat_table();
$t = q{Add table works for a single valid schema.table entry};
$res = $bct->ctl('bucardo add table public.bucardo_test1');
is ($res, qq{$addtable_msg:\n public.bucardo_test1\n}, $t);
$t = q{Add table fails for a single invalid schema.table entry};
$res = $bct->ctl('bucardo add table public.bucardo_notest1');
is ($res, qq{$nomatch_msg:\n public.bucardo_notest1\n}, $t);
$t = q{Add table works for a single valid table entry (no schema)};
$res = $bct->ctl('bucardo add table bucardo_test2');
is ($res, qq{$addtable_msg:\n public.bucardo_test2\n}, $t);
$t = q{Add table fails for a single invalid table entry (no schema)};
$res = $bct->ctl('bucardo add table bucardo_notest2');
is ($res, qq{$nomatch_msg:\n bucardo_notest2\n}, $t);
$dbhA->do('DROP SCHEMA IF EXISTS tschema CASCADE');
$dbhA->do('CREATE SCHEMA tschema');
$dbhA->do('CREATE TABLE tschema.bucardo_test4 (a int)');
$dbhA->commit();
$t = q{Add table works for multiple matching valid table entry (no schema)};
$res = $bct->ctl('bucardo add table bucardo_test4');
is ($res, qq{$addtable_msg:\n public.bucardo_test4\n tschema.bucardo_test4\n}, $t);
$t = q{Add table works for a single valid middle wildcard entry};
$res = $bct->ctl('bucardo add table B%_test3');
is ($res, qq{$addtable_msg:\n public.Bucardo_test3\n}, $t);
$t = q{Add table works for a single valid beginning wildcard entry};
$res = $bct->ctl('bucardo add table %_test5');
is ($res, qq{$addtable_msg:\n public.bucardo_test5\n}, $t);
$t = q{Add table works for a single valid ending wildcard entry};
$res = $bct->ctl('bucardo add table drop%');
is ($res, qq{$addtable_msg:\n public.droptest_bucardo\n}, $t);
$t = q{Add table works for a single valid middle wildcard entry};
$res = $bct->ctl('bucardo add table b%_test6');
is ($res, qq{$addtable_msg:\n public.bucardo_test6\n}, $t);
$t = q{Add table fails for a single invalid wildcard entry};
$res = $bct->ctl('bucardo add table b%_notest');
is ($res, qq{$nomatch_msg:\n b%_notest\n}, $t);
$t = q{Add table works for a single valid schema wildcard entry};
$res = $bct->ctl('bucardo add table %.bucardo_test7');
is ($res, qq{$addtable_msg:\n public.bucardo_test7\n}, $t);
$t = q{Add table fails for a single invalid schema wildcard entry};
$res = $bct->ctl('bucardo add table %.notest');
is ($res, qq{$nomatch_msg:\n %.notest\n}, $t);
$t = q{Add table works for a single valid table wildcard entry};
$res = $bct->ctl('bucardo add table public.bucard%8');
is ($res, qq{$addtable_msg:\n public.bucardo_test8\n}, $t);
$t = q{Add table fails for a single invalid table wildcard entry};
$res = $bct->ctl('bucardo add table public.no%test');
is ($res, qq{$nomatch_msg:\n public.no%test\n}, $t);
$t = q{Add table works for a single valid schema and table wildcard entry};
$res = $bct->ctl('bucardo add table pub%.bucard%9');
is ($res, qq{$addtable_msg:\n public.bucardo_test9\n}, $t);
$t = q{Add table fails for a single invalid schema and table wildcard entry};
$res = $bct->ctl('bucardo add table pub%.no%test');
is ($res, qq{$nomatch_msg:\n pub%.no%test\n}, $t);
$t = q{Add table does not re-add existing tables};
$res = $bct->ctl('bucardo add table bucard%');
is ($res, qq{$addtable_msg:\n public.bucardo space test\n public.bucardo_test10\n}, $t);
$t = q{'bucardo list tables' returns expected result};
$res = $bct->ctl('bucardo list tables');
$expected =
qr{\d+\.\s* Table: public.Bucardo_test3 DB: A PK: id \(bigint\)\s+
\d+\.\s* Table: public.bucardo space test DB: A PK: id \(integer\)\s+
\d+\.\s* Table: public.bucardo_test1 DB: A PK: id \(smallint\)\s+
\d+\.\s* Table: public.bucardo_test2 DB: A PK: id\|data1 \(integer\|text\)
\d+\.\s* Table: public.bucardo_test4 DB: A PK: id \(text\)\s+
\d+\.\s* Table: public.bucardo_test5 DB: A PK: id space \(date\)\s+
\d+\.\s* Table: public.bucardo_test6 DB: A PK: id \(timestamp\)\s+
\d+\.\s* Table: public.bucardo_test7 DB: A PK: id \(numeric\)\s+
\d+\.\s* Table: public.bucardo_test8 DB: A PK: id \(bytea\)\s+
\d+\.\s* Table: public.bucardo_test9 DB: A PK: id \(int_unsigned\)\s+
\d+\.\s* Table: public.bucardo_test10 DB: A PK: id \(timestamptz\)\s+
\d+\.\s* Table: public.droptest_bucardo DB: A PK: none\s+
\d+\.\s* Table: tschema.bucardo_test4 DB: A PK: none\s+
};
like ($res, $expected, $t);
## Remove them all, then try adding in various combinations
empty_goat_table();
$t = q{Add table works with multiple entries};
$res = $bct->ctl('bucardo add table pub%.bucard%9 public.bucardo_test1 nada bucardo3 buca%2');
is ($res, qq{$nomatch_msg:\n bucardo3\n nada\n$addtable_msg:\n public.bucardo_test1\n public.bucardo_test2\n public.bucardo_test9\n}, $t);
$t = q{Add table works when specifying the autokick option};
$res = $bct->ctl('bucardo add table bucardo_test5 autokick=true');
is ($res, qq{$addtable_msg:\n public.bucardo_test5\n}, $t);
$t = q{'bucardo list tables' returns expected result};
$res = $bct->ctl('bucardo list tables');
$expected =
qr{\d+\.\s* Table: public.bucardo_test1 DB: A PK: id \(smallint\)\s*
\d+\.\s* Table: public.bucardo_test2 DB: A PK: id\|data1 \(integer\|text\)\s*
\d+\.\s* Table: public.bucardo_test5 DB: A PK: id space \(date\)\s+ autokick:true\s*
\d+\.\s* Table: public.bucardo_test9 DB: A PK: id \(int_unsigned\)\s*
};
like ($res, $expected, $t);
$t = q{Add table works when specifying the rebuild_index and autokick options};
$res = $bct->ctl('bucardo add table bucardo_test4 autokick=false rebuild_index=1');
is ($res, qq{$addtable_msg:\n public.bucardo_test4\n tschema.bucardo_test4\n}, $t);
$t = q{'bucardo list tables' returns expected result};
$res = $bct->ctl('bucardo list tables');
$expected =
qr{\d+\.\s* Table: public.bucardo_test1 DB: A PK: id \(smallint\)\s*
\d+\.\s* Table: public.bucardo_test2 DB: A PK: id|data1 \(integer\|text\)\s*
\d+\.\s* Table: public.bucardo_test4 DB: A PK: id \(text\)\s* autokick:false\s*rebuild_index:true\s*
\d+\.\s* Table: public.bucardo_test5 DB: A PK: id space \(date\)\s* autokick:true\s*
\d+\.\s* Table: public.bucardo_test9 DB: A PK: id \(int_unsigned\)\s*
\d+\.\s* Table: tschema.bucardo_test4 DB: A PK: none\s*autokick:false rebuild_index:true\s*
};
like ($res, $expected, $t);
## Remove them all, then try 'all tables'
empty_goat_table();
$t = q{Add all tables};
$res = $bct->ctl('bucardo add all tables -vv --debug');
like ($res, qr{New tables added: 13}, $t);
## Try removing them all via commandline
$t = q{Remove all tables at once};
$res = $bct->ctl('bucardo remove all tables -vv --debug --batch');
like ($res, qr{Removed the following tables}, $t);
## Remove them all, then try 'tables all'
$t = q{Add all tables with reversed words};
$res = $bct->ctl('bucardo add tables all -vv --debug');
like ($res, qr{New tables added: 13}, $t);
## Try removing them all via commandline, reversed args
$t = q{Remove all tables at once with reversed words};
$res = $bct->ctl('bucardo remove tables all -vv --debug --batch');
like ($res, qr{Removed the following tables}, $t);
## Try 'all tables' with tables limit
$t = q{Add all tables with tables limit};
$res = $bct->ctl('bucardo add all tables -t bucardo_test1 -t bucardo_test2 -vv --debug');
like ($res, qr{New tables added: 2\n}, $t);
## Remove them all, then try 'all tables' with schema limit
empty_goat_table();
$t = q{Add all tables with schema limit};
$res = $bct->ctl('bucardo add all tables -n public -vv --debug');
like ($res, qr{New tables added: 12\n}, $t);
## Remove them all, then try 'all tables' with exclude table
empty_goat_table();
$t = q{Add all tables with exclude table};
$res = $bct->ctl('bucardo add all tables -T droptest_bucardo -vv --debug');
like ($res, qr{New tables added: 12}, $t);
## Remove them all, then try 'all tables' with exclude schema
empty_goat_table();
$t = q{Add all tables with exclude schema};
$res = $bct->ctl('bucardo add all tables -N public -vv --debug');
like ($res, qr{New tables added: 1\n}, $t);
empty_goat_table();
$t = q{Add table works when adding to a new relgroup};
$res = $bct->ctl('bucardo add table bucardo_test1 relgroup=foobar');
$expected =
qq{$addtable_msg:
public.bucardo_test1
Created the relgroup named "foobar"
$newherd_msg "foobar":
public.bucardo_test1
};
is ($res, $expected, $t);
$t = q{Add table works when adding to an existing relgroup};
$res = $bct->ctl('bucardo add table bucardo_test5 relgroup=foobar');
is ($res, qq{$addtable_msg:\n public.bucardo_test5\n$oldherd_msg "foobar":\n public.bucardo_test5\n}, $t);
$t = q{Add table works when adding multiple tables to a new relgroup};
$res = $bct->ctl('bucardo add table "public.Buc*3" %.bucardo_test2 relgroup=foobar2');
$expected =
qq{$addtable_msg:
public.Bucardo_test3
public.bucardo_test2
Created the relgroup named "foobar2"
$newherd_msg "foobar2":
public.Bucardo_test3
public.bucardo_test2
};
is ($res, $expected, $t);
$t = q{Add table works when adding multiple tables to an existing relgroup};
$res = $bct->ctl('bucardo add table bucardo_test6 %.%do_test4 relgroup=foobar2');
$expected =
qq{$addtable_msg:
public.bucardo_test4
public.bucardo_test6
tschema.bucardo_test4
$newherd_msg "foobar2":
public.bucardo_test4
public.bucardo_test6
tschema.bucardo_test4
};
is ($res, $expected, $t);
## Tests of basic 'delete table' usage
$t = q{Delete table works for a single entry};
$res = $bct->ctl('bucardo remove table public.bucardo_test4');
$expected =
qq{$deltable_msg:
public.bucardo_test4
};
is ($res, $expected, $t);
$t = q{Delete table works for multiple entries};
$res = $bct->ctl('bucardo remove table public.Bucardo_test3 public.bucardo_test2');
$expected =
qq{$deltable_msg:
public.Bucardo_test3
public.bucardo_test2
};
is ($res, $expected, $t);
## Tests to list a single table
$t = q{List verbose single table};
$res = $bct->ctl('bucardo list tables -vv public.bucardo_test1');
like ($res, qr/ghost\s+= 0/ , $t);
## Tests of 'update table' usage
$t = q{Update table changes a value properly};
$bct->ctl('bucardo update table public.bucardo_test1 ghost=1');
$res = $bct->ctl('bucardo list tables -vv public.bucardo_test1');
like ($res, qr/ghost\s+= 1/, $t);
$t = q{Update table returns correctly when the value doesn't need changing};
$res = $bct->ctl('bucardo update table public.bucardo_test1 ghost=1');
like ($res, qr/No change needed for ghost/, $t);
$t = q{Update table doesn't try to set "db=" actions};
$res = $bct->ctl('bucardo update table public.bucardo_test1 db=A ghost=1');
unlike ($res, qr/No change needed for db/, $t);
$t = q{Update table correctly filters by db when table exists};
$res = $bct->ctl('bucardo update table public.bucardo_test1 db=A ghost=1');
like ($res, qr/No change needed for ghost/, $t);
$t = q{Update table correctly filters by db when table doesn't exist};
$res = $bct->ctl('bucardo update table public.bucardo_test1 db=B ghost=1');
like ($res, qr/Didn't find any matching tables/, $t);
END {
$bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
}
Bucardo-5.4.1/t/ctest2.pl0000644000175000017500000000051712563002233013535 0ustar greggreg## ctest2.pl - a conflict handler for Bucardo
use strict;
use warnings;
my $info = shift;
## Walk through all conflicted rows and set a winning list
for my $row (keys %{ $info->{conflicts}}) {
$info->{conflicts}{$row} = 'B';
}
## We don't want any other customcodes to fire: we have handled this!
$info->{lastcode} = 1;
return;
Bucardo-5.4.1/t/20-postgres.t0000644000175000017500000004463112563002233014253 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test using Postgres as a database target
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use File::Temp qw/ tempfile /;
use Cwd;
use vars qw/ $dbhX $dbhA $dbhB $dbhC $dbhD $dbhE $res $command $t $SQL %pkey %sth %sql $sth $count $val /;
use BucardoTesting;
my $bct = BucardoTesting->new({location => 'postgres'})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
## Some of the tests are called inside of BucardoTesting.pm
## e.g. $bct->check_for_row([[1]], [qw/ B C D/]);
## The above runs one test for each passed in database x the number of test tables
my $numtables = keys %tabletype;
my $numsequences = keys %sequences;
my $single_tests = 63;
my $check_for_row_1 = 1;
my $check_for_row_2 = 2;
my $check_for_row_3 = 3;
my $check_for_row_4 = 7;
my $check_sequences_same = 1;
## We have to set up the PGSERVICEFILE early on, so the proper
## environment variable is set for all processes from the beginning.
my ($service_fh, $service_temp_filename) = tempfile("bucardo_pgservice.tmp.XXXX", UNLINK => 0);
$ENV{PGSERVICEFILE} = getcwd . '/' . $service_temp_filename;
plan tests => $single_tests +
( $check_sequences_same * $numsequences ) + ## Simple sequence testing
( $check_for_row_1 * $numtables * 1 ) + ## D
( $check_for_row_2 * $numtables * 2 ) + ## A B
( $check_for_row_3 * $numtables * 3 ) + ## B C D
( $check_for_row_4 * $numtables * 4 ); ## A B C D
pass("*** Beginning postgres tests");
END {
$bct and $bct->stop_bucardo();
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
$dbhD and $dbhD->disconnect();
$dbhE and $dbhE->disconnect();
}
## Get A, B, C, D, and E created, emptied out, and repopulated with sample data
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
$dbhD = $bct->repopulate_cluster('D');
$dbhE = $bct->repopulate_cluster('E');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Teach Bucardo about the first four databases
for my $name (qw/ A B C D A1 /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost status=active conn=sslmode=allow";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
## Teach Bucardo about the fifth database using a service file
$t = "Adding database E via a service name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args('E');
print $service_fh "[dbE]\ndbname=bucardo_test\nuser=$dbuser\nport=$dbport\nhost=$dbhost\n";
close $service_fh;
$res = $bct->ctl("add db E service=dbE status=inactive");
like ($res, qr/Added database "E"/, $t);
## Put all pk tables into a relgroup
$t = q{Adding all PK tables on the master works};
$res = $bct->ctl(q{bucardo add tables '*bucardo*test*' '*Bucardo*test*' db=A relgroup=allpk pkonly});
like ($res, qr/Created the relgroup named "allpk".*are now part of/s, $t);
## Add all sequences
$t = q{Adding all sequences to the main relgroup};
$res = $bct->ctl(q{bucardo add all sequences relgroup=allpk});
like ($res, qr/New sequences added/s, $t);
## Create a new dbgroup going from A to B and C and D and E
$t = q{Created a new dbgroup A -> B C D E};
$res = $bct->ctl('bucardo add dbgroup pg1 A:source B:target C:target D:target E:target');
like ($res, qr/Created dbgroup "pg1"/, $t);
## Create a new dbgroup going from A and B to C and D
$t = q{Created a new dbgroup (A <=> B ) -> C D};
$res = $bct->ctl('bucardo add dbgroup pg2 A:source B:source C D');
like ($res, qr/Created dbgroup "pg2"/, $t);
## Create a new dbgroup going from A and B and C to D
$t = q{Created a new dbgroup (A <=> B <=> C) -> D};
$res = $bct->ctl('bucardo add dbgroup pg3 A:source B:source C:source D');
like ($res, qr/Created dbgroup "pg3"/, $t);
## Create a new dbgroup going from A and B and C and D
$t = q{Created a new dbgroup (A <=> B <=> C <=> D)};
$res = $bct->ctl('bucardo add dbgroup pg4 A:source B:source C:source D:source');
like ($res, qr/Created dbgroup "pg4"/, $t);
## Create a new dbgroup going between A and B
$t = q{Created a new dbgroup (A <=> B)};
$res = $bct->ctl('bucardo add dbgroup pg5 A:source B:source');
like ($res, qr/Created dbgroup "pg5"/, $t);
## Create some new syncs. Only one should be active at a time!
$t = q{Created a new sync for dbgroup pg1};
$res = $bct->ctl('bucardo add sync pgtest1 relgroup=allpk dbs=pg1 status=inactive');
like ($res, qr/Added sync "pgtest1"/, $t);
$t = q{Created a new sync for dbgroup pg2};
$res = $bct->ctl('bucardo add sync pgtest2 relgroup=allpk dbs=pg2 status=inactive autokick=false');
like ($res, qr/Added sync "pgtest2"/, $t);
$t = q{Created a new sync for dbgroup pg3};
$res = $bct->ctl('bucardo add sync pgtest3 relgroup=allpk dbs=pg3 status=inactive autokick=false');
like ($res, qr/Added sync "pgtest3"/, $t);
$t = q{Created a new sync for dbgroup pg4};
$res = $bct->ctl('bucardo add sync pgtest4 relgroup=allpk dbs=pg4 status=inactive autokick=false');
like ($res, qr/Added sync "pgtest4"/, $t);
$t = q{Created a new sync for dbgroup pg5};
$res = $bct->ctl('bucardo add sync pgtest5 relgroup=allpk dbs=pg5 status=inactive autokick=false');
like ($res, qr/Added sync "pgtest5"/, $t);
## Create a table that only exists on A and B: make sure C does not look for it!
$SQL = 'CREATE TABLE mtest(id INT PRIMARY KEY, email TEXT)';
$dbhA->do($SQL);
$dbhA->commit();
$dbhB->do($SQL);
$dbhB->commit();
## Create a copy of table1, but with a different name for same-database replication testing
$SQL = 'CREATE TABLE bucardo_test1_copy (LIKE bucardo_test1)';
$dbhA->do($SQL);
$dbhA->commit();
$dbhB->do($SQL);
$dbhB->commit();
## Create a relgroup for same-database testing
$t = q{Created a new relgroup samerelgroup};
$res = $bct->ctl('bucardo add relgroup samerelgroup bucardo_test1');
like ($res, qr/Created relgroup "samerelgroup"/, $t);
## We want all access to A1 to use the alternate table
$t = q{Created a customname to force usage of bucardo_test1_copy};
$res = $bct->ctl('bucardo add customname bucardo_test1 bucardo_test1_copy db=A1');
like ($res, qr/\Qpublic.bucardo_test1 to bucardo_test1_copy (for database A1)/, $t);
$t = q{Created a new sync for samedb};
$res = $bct->ctl('bucardo add sync samedb relgroup=samerelgroup dbs=A,A1 status=inactive');
like ($res, qr/Added sync "samedb"/, $t);
## Create new relgroups, relations, and a sync
$t = q{Created a new relgroup mrelgroup};
$res = $bct->ctl('bucardo add relgroup mrelgroup mtest');
like ($res, qr/Created relgroup "mrelgroup"/, $t);
$t = q{Created a new sync for mrelgroup};
$res = $bct->ctl('bucardo add sync msync relgroup=mrelgroup dbs=A:source,B:source status=inactive');
like ($res, qr/Added sync "msync"/, $t);
## Add a row to A, to make sure it does not go anywhere with inactive syncs
$bct->add_row_to_database('A', 1);
## Clean out the droptest table for later testing
$dbhA->do('TRUNCATE TABLE droptest_bucardo');
$dbhA->commit();
sub d {
my $msg = shift || '?';
my $time = scalar localtime;
diag "$time: $msg";
}
## Start up Bucardo. All syncs are inactive, so nothing should happen,
## and Bucardo should exit
$bct->restart_bucardo($dbhX, 'bucardo_stopped');
# Nothing should have been copied to B, C, or D, yet.
$bct->check_for_row([], [qw/B C D/]);
## Activate the pgtest1 and samedb syncs
is $bct->ctl('bucardo update sync pgtest1 status=active'), '', 'Activate pgtest1';
is $bct->ctl('bucardo update sync samedb status=active'), '', 'Activate samedb';
## Start listening for a syncdone message
## Bucardo should fire the sync off right away without a kick
$dbhX->do('LISTEN bucardo_syncdone_pgtest1');
$dbhX->do('LISTEN bucardo_syncdone_samedb');
$dbhX->commit();
## Create a lock file to test the forced file locking
my $lockfile = 'pid/bucardo-force-lock-pgtest1';
open my $fh, '>', $lockfile or die qq{Could not create "$lockfile": $!\n};
close $fh;
## Start up Bucardo again
$bct->restart_bucardo($dbhX);
## Wait for our sync to finish
$bct->wait_for_notice($dbhX, 'bucardo_syncdone_pgtest1');
## See if things are on the other databases
$bct->check_for_row([[1]], [qw/ B C D/]);
## Check that our "samedb" process worked
$t = q{Replicating to the same database via customname works};
$SQL = 'SELECT inty FROM bucardo_test1_copy';
$res = $dbhA->selectall_arrayref($SQL);
is_deeply($res, [[1]], $t);
## Make sure triggers and rules did not fire
$SQL = 'SELECT * FROM droptest_bucardo';
$sth = $dbhB->prepare($SQL);
$count = $sth->execute();
if ($count >= 1) {
diag Dumper $sth->fetchall_arrayref({});
BAIL_OUT "Found rows ($count) in the droptest table!";
}
$sth->finish();
ok ('No rows found in the droptest table: triggers and rules were disabled');
## Switch to a 2 source sync
is $bct->ctl('bucardo update sync pgtest1 status=inactive'), '', 'Set pgtest1 status=inactive';
is $bct->ctl('bucardo update sync pgtest5 status=active'), '', 'Set pgtest5 status=active';
is $bct->ctl('bucardo deactivate pgtest1'), "Deactivating sync pgtest1\n",
'Deactivate pgtest1';
is $bct->ctl('bucardo activate pgtest5 0'), "Activating sync pgtest5...OK\n",
'Activate pgtest5';
## Add some rows to both masters, make sure it goes everywhere
$bct->add_row_to_database('A', 3);
$bct->add_row_to_database('B', 4);
## Kick off the sync.
my $timer_regex = qr/\[\d+\s*s\]\s+(?:[\b]{6}\[\d+\s*s\]\s+)*/;
like $bct->ctl('bucardo kick sync pgtest5 0'),
qr/^Kick\s+pgtest5:\s+${timer_regex}DONE!/,
'Kick pgtest5' or die 'Sync failed, no point continuing';
## All rows should be on A and B.
my $expected = [[1],[3],[4]];
$bct->check_for_row($expected, [qw/A B/]);
# But new rows should not be on C or D.
$bct->check_for_row([[1]], [qw/C D/]);
## Remove the test rows from above
$bct->remove_row_from_database('A', [3,4]);
$bct->remove_row_from_database('B', [3,4]);
## Switch to a 2 source, 2 target sync
is $bct->ctl('bucardo update sync pgtest5 status=inactive'), '',
'set pgtest5 status=inactive';
is $bct->ctl('bucardo update sync pgtest2 status=active'), '',
'Set pgtest2 status=active';
is $bct->ctl('bucardo deactivate sync pgtest5'), "Deactivating sync pgtest5\n",
'Deactivate pgtest5';
is $bct->ctl('bucardo activate sync pgtest2 0'), "Activating sync pgtest2...OK\n",
'Activate pgtest2';
## Clear the deleted rows above so we have a clean test below
like $bct->ctl('bucardo kick sync pgtest2 0'),
qr/^Kick\s+pgtest2:\s+${timer_regex}DONE!/,
'Kick pgtest2' or die 'Sync failed, no point continuing';
## Add some rows to both masters, make sure it goes everywhere
for my $num (2..4) {
$bct->add_row_to_database('A', $num);
}
for my $num (5..10) {
$bct->add_row_to_database('B', $num);
}
## Kick off the sync. Everything should go to A, B, C, and D
like $bct->ctl('bucardo kick sync pgtest2 0'),
qr/^Kick\s+pgtest2:\s+${timer_regex}DONE!/,
'Kick pgtest2 again' or die 'Sync failed, no point continuing';
## Kick off old sync. Should fail, as the sync is inactive
$t = q{Inactive sync pgtest3 should not reject kick};
$res = $bct->ctl('bucardo kick sync pgtest3 0');
like($res, qr/^Cannot kick inactive sync/, $t);
## All rows should be on A, B, C, and D
$expected = [];
push @$expected, [$_] for 1..10;
$bct->check_for_row($expected, [qw/A B C D/]);
## Deactivate pgtest2, bring up pgtest3
is $bct->ctl('bucardo update sync pgtest2 status=inactive'), '',
'Set pgtest2 status=inactive';
is $bct->ctl('bucardo update sync pgtest3 status=active'), '',
'Set pgtest3 status=active';
is $bct->ctl('bucardo deactivate sync pgtest2'),
"Deactivating sync pgtest2\n",
'Deactivate pgtest2';
is $bct->ctl('bucardo activate sync pgtest3 0'),
"Activating sync pgtest3...OK\n",
'Activate pgtest3';
## Kick off the sync to pick up the deltas from the previous runs
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3' or die 'Sync failed, no point continuing';
## This one has three sources: A, B, and C. Remove rows from each
$bct->remove_row_from_database('A', 10);
$bct->remove_row_from_database('A', 9);
$bct->remove_row_from_database('A', 8);
$bct->remove_row_from_database('B', 6);
$bct->remove_row_from_database('B', 5);
$bct->remove_row_from_database('B', 4);
$bct->remove_row_from_database('C', 2);
$bct->remove_row_from_database('C', 1);
## Kick it off
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3 again' or die 'Sync failed, no point continuing';
## Only rows left everywhere should be 3 and 7
$bct->check_for_row([[3],[7]], [qw/A B C D/]);
## Cause a conflict: same row on A, B, and C.
$bct->add_row_to_database('A', 1);
$bct->add_row_to_database('B', 1);
$bct->add_row_to_database('A', 2);
$bct->add_row_to_database('B', 2);
$bct->add_row_to_database('C', 2);
## Kick and check everyone is the same
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3 yet again' or die 'Sync failed, no point continuing';
$bct->check_for_row([[1],[2],[3],[7]], [qw/A B C D/]);
## Change sequence information, make sure it gets out to everyone
if ($dbhA->{pg_server_version} < 80400) {
$dbhA->do('alter sequence bucardo_test_seq1 restart 25 minvalue 10 maxvalue 8675');
$dbhB->do('alter sequence bucardo_test_seq2 restart 250 minvalue 100 maxvalue 86753');
} else {
$dbhA->do('alter sequence bucardo_test_seq1 start 20 restart 25 minvalue 10 maxvalue 8675');
$dbhB->do('alter sequence bucardo_test_seq2 start 200 restart 250 minvalue 100 maxvalue 86753');
}
$dbhA->commit();
$dbhB->commit();
$dbhC->do(q{SELECT setval('"Bucardo_test_seq3"', 12345)});
$dbhC->commit();
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3 once more' or die 'Sync failed, no point continuing';
$bct->check_sequences_same([qw/A B C D/]);
## Create a PK conflict and let B "win" due to the timestamp
$SQL = 'UPDATE bucardo_test1 SET data1 = ? WHERE id = ?';
$dbhB->do($SQL, {}, 'Bravo', 3);
$dbhC->do($SQL, undef, 'Charlie', 3);
$dbhA->do($SQL, undef, 'Alpha', 3);
## Order of commits should not matter: the timestamp comes from the start of the transaction
$dbhC->commit();
$dbhB->commit();
$dbhA->commit();
## Just in case, make sure 'bucardo upgrade' does not mess anything up
$bct->ctl('bucardo upgrade');
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3 LIKE A BOSS' or die 'Sync failed, no point continuing';
$bct->check_for_row([[1],[2],[3],[7]], [qw/A B C D/]);
$SQL = 'SELECT data1 FROM bucardo_test1 WHERE id = ?';
$val = $dbhA->selectall_arrayref($SQL, undef, 3)->[0][0];
$t = 'Conflict resolution respects earliest transaction time for A';
is ($val, 'Charlie', $t);
$t = 'Conflict resolution respects earliest transaction time for B';
$val = $dbhB->selectall_arrayref($SQL, undef, 3)->[0][0];
is ($val, 'Charlie', $t);
$t = 'Conflict resolution respects earliest transaction time for C';
$val = $dbhC->selectall_arrayref($SQL, undef, 3)->[0][0];
is ($val, 'Charlie', $t);
if ($dbhA->{pg_server_version} < 80400) {
## Truncate triggers do not work, so we will delete instead
$bct->delete_all_tables('A');
}
else {
## Truncate on A:source goes to all other nodes
$bct->truncate_all_tables('A');
## Just for fun, let C win a truncation "contest"
$dbhC->do('TRUNCATE TABLE bucardo_test5');
## We commit everyone as the truncates will block on open transactions
$dbhX->commit(); $dbhA->commit(); $dbhB->commit(); $dbhC->commit(); $dbhD->commit();
}
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3 like a mofo' or die 'Sync failed, no point continuing';
$bct->check_for_row([], [qw/A B C D/], 'truncate A');
if ($dbhA->{pg_server_version} < 80400) {
## Truncate triggers do not work, so we will delete instead
$bct->delete_all_tables('A');
## We do this to emulate all the stuff below
$bct->add_row_to_database('A', 7);
$bct->add_row_to_database('A', 3);
SKIP: {
skip 'Skipping truncate tests', 5;
}
$dbhA->commit();
}
else {
## A truncate plus delta rows will truncate all others but keep delta rows
$bct->add_row_to_database('A', 1);
$bct->add_row_to_database('B', 2);
$bct->add_row_to_database('C', 3);
$bct->add_row_to_database('D', 4);
## Order matters: the last one should "win" and thus replicate subsequent changes
for my $d (qw/ A B C D /) {
$bct->truncate_all_tables($d);
}
## Now add some things back to each one
$bct->add_row_to_database('A', 5);
$bct->add_row_to_database('B', 6);
$bct->add_row_to_database('C', 7);
$bct->add_row_to_database('D', 8);
## Kick off the sync. C should win (D is target), truncate the others, then propagate '7'
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3 like a it\'s going out of style'
or die 'Sync failed, no point continuing';
$bct->check_for_row([[7]], [qw/A B C D/], 'truncate D');
}
## Make sure we can go back to normal mode after a truncate
$bct->add_row_to_database('A', 2);
$bct->add_row_to_database('B', 3);
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3 like it hurts' or die 'Sync failed, no point continuing';
$bct->check_for_row([[2],[3],[7]], [qw/A B C D/]);
## Tests of customcols
$t = q{add customcols returns expected message};
$res = $bct->ctl('bucardo add customcols bucardo_test1 "SELECT id, data1, inty*30 AS inty"');
like($res, qr/\QNew columns for public.bucardo_test1: "SELECT id, data1, inty*30 AS inty"/, $t);
## Also test the rebuild_index functionality
$res = $bct->ctl('bucardo update sync pgtest3 rebuild_index=1');
## We need to restart Bucardo entirely to change this. Someday, a reload sync will be enough.
$bct->restart_bucardo($dbhX);
$bct->add_row_to_database('A', 1);
like $bct->ctl('bucardo kick sync pgtest3 0'),
qr/^Kick\s+pgtest3:\s+${timer_regex}DONE!/,
'Kick pgtest3 again for the road' or die 'Sync failed, no point continuing';
$bct->check_for_row([[1],[2],[3],[7]], [qw/A B C/]);
$bct->check_for_row([[1],[2],[3],[7]], [qw/D/], 'customcols', '!test1');
$bct->check_for_row([[2],[3],[7],[30]], [qw/D/], 'customcols', 'test1');
unlink $service_temp_filename;
$bct->ctl('bucardo stop');
pass('Finished with testing');
exit;
Bucardo-5.4.1/t/02-bctl-dbg.t0000644000175000017500000001307512563002233014061 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test adding, dropping, and changing dbgroups via bucardo
## Tests the main subs: add_dbgroup, remove_dbgroup, update_dbgroup, list_dbgroups
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More tests => 25;
use vars qw/$t $res $command $dbhX $dbhA $dbhB/;
use BucardoTesting;
my $bct = BucardoTesting->new({notime=>1})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = '';
## Make sure A and B are started up
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Grab connection information for each database
my ($dbuserA,$dbportA,$dbhostA) = $bct->add_db_args('A');
my ($dbuserB,$dbportB,$dbhostB) = $bct->add_db_args('B');
## Tests of basic 'add dbgroup' usage
$t = 'Add dbgroup with no argument gives expected help message';
$res = $bct->ctl('bucardo add dbg');
like ($res, qr/add dbgroup/, $t);
$t = q{Add dbgroup accepts both 'add dbg' and 'add dbgroup'};
$res = $bct->ctl('bucardo add dbgroup');
like ($res, qr/add dbgroup/, $t);
$t = q{Add dbgroup fails with invalid characters};
$res = $bct->ctl('bucardo add dbgroup foo^barz');
like ($res, qr/Invalid characters/, $t);
$t = 'Add dbgroup works';
$res = $bct->ctl('bucardo add dbg foobar');
like ($res, qr/Created dbgroup "foobar"/, $t);
$t = q{Adding a dbgroup with the same name fails};
$res = $bct->ctl('bucardo add dbg foobar');
is ($res, '', $t);
$t = 'Listing of dbgroups looks correct';
$res = $bct->ctl('bucardo list dbgroups');
chomp $res;
is ($res, 'dbgroup: foobar', $t);
$t = q{Listing of dbgroups with the 'dbg' alias works};
$res = $bct->ctl('bucardo list dbg');
chomp $res;
is ($res, 'dbgroup: foobar', $t);
$t = q{Adding an invalid database via add dbgroup gives expected message};
$res = $bct->ctl('bucardo add dbgroup foobar A');
like ($res, qr/"A" does not exist/, $t);
$t = q{Adding a database via add dbgroup gives expected message};
$bct->ctl("bucardo add db A dbname=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA");
$res = $bct->ctl('bucardo add dbgroup foobar A');
like ($res, qr/Added database "A" to dbgroup "foobar" as target/, $t);
$t = q{Adding a database in source role via add dbgroup gives expected message};
$bct->ctl("bucardo add db B dbname=bucardo_test user=$dbuserB port=$dbportB host=$dbhostB");
$res = $bct->ctl('bucardo add dbgroup foobar B:master');
like ($res, qr/Added database "B" to dbgroup "foobar" as source/, $t);
$t = 'Listing of dbgroups looks correct';
$res = $bct->ctl('bucardo list dbgroups');
chomp $res;
is ($res, 'dbgroup: foobar Members: A:target B:source', $t);
## Remove
$t = 'Removal of non-existent dbgroup gives expected message';
$res = $bct->ctl('bucardo remove dbgroup bunko');
like ($res, qr/No such dbgroup: bunko/, $t);
$t = 'Removal of a dbgroup works';
$res = $bct->ctl('bucardo remove dbgroup foobar');
like ($res, qr/Removed dbgroup "foobar"/, $t);
$t = 'Removal of two dbgroups works';
$bct->ctl('bucardo add dbgroup foobar1');
$bct->ctl('bucardo add dbgroup foobar2');
$res = $bct->ctl('bucardo remove dbgroup foobar1 foobar2');
like ($res, qr/Removed dbgroup "foobar1".*Removed dbgroup "foobar2"/s, $t);
$t = 'Removal of dbgroup fails if used in a sync';
$bct->ctl('bucardo add herd therd bucardo_test1');
$bct->ctl('bucardo add dbgroup foobar3 A:source B');
$bct->ctl('bucardo add sync mysync herd=therd dbs=foobar3');
$res = $bct->ctl('bucardo remove dbgroup foobar3');
$res =~ s/\s+$//ms;
is ($res, q/Error running bucardo: Cannot remove dbgroup "foobar3": it is being used by one or more syncs/, $t);
$t = 'Removal of dbgroup works if used in a sync and the --force argument used';
$res = $bct->ctl('bucardo remove dbgroup foobar3 --force');
like ($res, qr/Dropping all syncs that reference the dbgroup "foobar3".*Removed dbgroup "foobar3"/s, $t);
## Update
$bct->ctl('bucardo add dbgroup foobar');
$t = 'Update dbgroup with no arguments gives expected message';
$res = $bct->ctl('bucardo update dbgroup foobar');
like ($res, qr/update/, $t);
$t = 'Update dbgroup with invalid group gives expected message';
$res = $bct->ctl('bucardo update dbgroup foobar3 baz');
like ($res, qr/Could not find a dbgroup named "foobar3"/, $t);
$t = 'Update dbgroup works with adding a single database';
$res = $bct->ctl('bucardo update dbgroup foobar A');
like ($res, qr/Added database "A" to dbgroup "foobar" as target/, $t);
$t = 'Update dbgroup works with adding multiple databases';
$res = $bct->ctl('bucardo update dbgroup foobar A:master B:master');
like ($res, qr/Changed role of database "A" in dbgroup "foobar" from target to source.*Added database "B" to dbgroup "foobar" as source/s, $t);
$res = $bct->ctl('bucardo list dbgroup');
like ($res, qr/dbgroup: foobar Members: A:source B:source/s, $t);
$t = 'Update dbgroup fails when new name is invalid';
$res = $bct->ctl('bucardo update dbgroup foobar newname=foobaz#');
like ($res, qr/Invalid dbgroup name "foobaz#"/, $t);
$t = 'Update dbgroup works when changing the name';
$res = $bct->ctl('bucardo update dbgroup foobar name=foobaz');
like ($res, qr/Changed dbgroup name from "foobar" to "foobaz"/, $t);
$t = q{Removing all dbgroups};
$res = $bct->ctl('bucardo remove dbg foobaz');
like ($res, qr/Removed dbgroup "foobaz"/, $t);
$t = q{List database returns correct information};
$res = $bct->ctl('bucardo list dbgroups');
like ($res, qr/No dbgroups/, $t);
exit;
END {
$bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
}
Bucardo-5.4.1/t/02-bctl-db.t0000644000175000017500000002555112563002233013714 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test adding, dropping, and changing databases via bucardo
## Tests the main subs: add_database, list_databases, update_database, remove_database
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More tests => 49;
use vars qw/$t $res $command $dbhX $dbhA $dbhB/;
use BucardoTesting;
my $bct = BucardoTesting->new({notime=>1})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = '';
## Make sure A and B are started up
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Grab connection information for each database
my ($dbuserA,$dbportA,$dbhostA) = $bct->add_db_args('A');
my ($dbuserB,$dbportB,$dbhostB) = $bct->add_db_args('B');
## Tests of basic 'add database' usage
$t = 'Add database with no argument gives expected help message';
$res = $bct->ctl('bucardo add db');
like ($res, qr/bucardo add db/, $t);
$t = q{Add database accepts both 'add database' and 'add db'};
$res = $bct->ctl('bucardo add database');
like ($res, qr/bucardo add db/, $t);
$t = q{Add database fails if not given a dbname};
$res = $bct->ctl('bucardo add database foobar');
like ($res, qr/must supply a database name/, $t);
$t = q{Add database fails for an invalid port};
$res = $bct->ctl('bucardo add database foo dbname=bar dbport=1');
like ($res, qr/Connection .+ failed.*could not connect to server/s, $t);
$t = q{Add database fails for non-existent host};
$res = $bct->ctl("bucardo add database bucardo_test dbname=bucardo_test user=$dbuserA port=$dbportA host=badbucardohost");
like ($res, qr/Connection .+ failed/s, $t); ## Could be timeout or bad hostname...
$t = q{Add database fails for non-existent database};
$res = $bct->ctl("bucardo add database foo dbname=bar user=$dbuserA port=$dbportA host=$dbhostA");
like ($res, qr/Connection .+ failed.*database "bar" does not exist/s, $t);
$t = q{Add database fails for non-existent user};
$res = $bct->ctl("bucardo add database bucardo_test dbname=bucardo_test user=nobob port=$dbportA host=$dbhostA");
like ($res, qr/Connection .+ failed.* "nobob" does not exist/s, $t);
$t = q{Add database works for non-existent cluster with --force flag};
$res = $bct->ctl('bucardo add database foo dbname=bar --force');
like ($res, qr/add anyway.*Added database "foo"/s, $t);
$t = 'Add database works for cluster A';
$res = $bct->ctl("bucardo add db A dbname=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA");
is ($res, qq{Added database "A"\n}, $t);
$t = 'Upgrade correctly reports no schema changes are needed';
$res = $bct->ctl("bucardo upgrade");
like ($res, qr/No schema changes were needed/, $t);
$t = q{Add database fails if using the same internal name};
$res = $bct->ctl("bucardo add db A dbname=postgres user=$dbuserA port=$dbportA host=$dbhostA");
like ($res, qr/Cannot add database: the name "A" already exists/, $t);
$t = q{Add database works if same parameters given but different DB};
$res = $bct->ctl("bucardo add db A2 dbname=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA");
like ($res, qr/Added database "A2"/, $t);
$t = 'Add database works for cluster B works with ssp=false';
$res = $bct->ctl("bucardo add db B dbname=bucardo_test user=$dbuserB port=$dbportB host=$dbhostB ssp=0");
like ($res, qr/Added database "B"/, $t);
$t = 'List databases gives expected results';
$res = $bct->ctl('bucardo list databases');
my $statA = qq{Database: A\\s+Status: active\\s+Conn: psql -p $dbportA -U $dbuserA -d bucardo_test -h $dbhostA};
my $statA2 = qq{Database: A2\\s+Status: active\\s+Conn: psql -p $dbportA -U $dbuserA -d bucardo_test -h $dbhostA};
my $statB = qq{Database: B\\s+Status: active\\s+Conn: psql -p $dbportB -U $dbuserB -d bucardo_test -h $dbhostB \\(SSP is off\\)};
my $statz = qq{Database: foo\\s+Status: active\\s+Conn: psql .*-d bar};
my $regex = qr{$statA\n$statA2\n$statB\n$statz}s;
like ($res, $regex, $t);
## Clear them out for some more testing
$t = q{Remove database works};
$res = $bct->ctl('bucardo remove db A B');
is ($res, qq{Removed database "A"\nRemoved database "B"\n}, $t);
## Tests of add database with group modifier
$t = 'Add database works when adding to a new dbgroup - role is source';
$res = $bct->ctl("bucardo add db A dbname=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA group=group1");
like ($res, qr/Added database "A".*Created dbgroup "group1".*Added database "A" to dbgroup "group1" as source/s, $t);
$t = 'Add database works when adding to an existing dbgroup - role is target';
$res = $bct->ctl("bucardo add db B dbname=bucardo_test user=$dbuserB port=$dbportB host=$dbhostB group=group1");
like ($res, qr/Added database "B" to dbgroup "group1" as target/s, $t);
$t = 'Add database works when adding to an existing dbgroup as role source';
$bct->ctl('bucardo remove db B');
$res = $bct->ctl("bucardo add db B dbname=bucardo_test user=$dbuserB port=$dbportB host=$dbhostB group=group1:source");
like ($res, qr/Added database "B" to dbgroup "group1" as source/s, $t);
$t = q{Adding a database into a new group works with 'dbgroup'};
$bct->ctl('bucardo remove db B');
$res = $bct->ctl("bucardo add db B dbname=bucardo_test user=$dbuserB port=$dbportB host=$dbhostB dbgroup=group1:replica");
like ($res, qr/Added database "B" to dbgroup "group1" as target/s, $t);
## Tests for 'remove database'
$t = q{Remove database gives expected message when database does not exist};
$res = $bct->ctl('bucardo remove db foobar');
like ($res, qr/No such database "foobar"/, $t);
$t = q{Remove database works};
$res = $bct->ctl('bucardo remove db B');
like ($res, qr/Removed database "B"/, $t);
$t = q{Able to remove more than one database at a time};
$bct->ctl("bucardo add db B dbname=bucardo_test user=$dbuserB port=$dbportB host=$dbhostB");
$res = $bct->ctl('bucardo remove db A A2 B foo');
like ($res, qr/Removed database "A"\nRemoved database "A2"\nRemoved database "B"/ms, $t);
## Tests for 'list databases'
$t = q{List database returns correct message when no databases};
$res = $bct->ctl('bucardo list db');
like ($res, qr/No databases/, $t);
$bct->ctl("bucardo add db B dbname=bucardo_test user=$dbuserB port=$dbportB host=$dbhostB ssp=1");
$t = q{List databases shows the server_side_prepare setting};
$res = $bct->ctl('bucardo list database B -vv');
like ($res, qr/server_side_prepares = 1/s, $t);
$t = q{List databases accepts 'db' alias};
$res = $bct->ctl('bucardo list db');
like ($res, qr/Database: B/, $t);
## Tests for the "addall" modifiers
$t = q{Add database works with 'addalltables'};
$command =
"bucardo add db A dbname=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA addalltables";
$res = $bct->ctl($command);
like ($res, qr/Added database "A"\nNew tables added: \d/s, $t);
$t = q{Remove database fails when it has referenced tables};
$res = $bct->ctl('bucardo remove db A');
like ($res, qr/remove all tables that reference/, $t);
$t = q{Remove database works when it has referenced tables and using --force};
$res = $bct->ctl('bucardo remove db A --force');
like ($res, qr/that reference database "A".*Removed database "A"/s, $t);
$t = q{Add database with 'addallsequences' works};
$res = $bct->ctl("bucardo remove dbgroup abc");
$command =
"bucardo add db A dbname=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA addallsequences";
$res = $bct->ctl($command);
like ($res, qr/Added database "A"\nNew sequences added: \d/s, $t);
$t = q{Remove database respects the --quiet flag};
$res = $bct->ctl('bucardo remove db B --quiet');
is ($res, '', $t);
$t = q{Add database respects the --quiet flag};
$command =
"bucardo add db B dbname=bucardo_test user=$dbuserB port=$dbportB host=$dbhostB --quiet";
$res = $bct->ctl($command);
is ($res, '', $t);
$t = q{Update database gives proper error with no db};
$res = $bct->ctl('bucardo update db');
like ($res, qr/bucardo update/, $t);
$t = q{Update database gives proper error with no items};
$res = $bct->ctl('bucardo update db foobar');
like ($res, qr/bucardo update/, $t);
$t = q{Update database gives proper error with invalid database};
$res = $bct->ctl('bucardo update db foobar a=b');
like ($res, qr/Could not find a database named "foobar"/, $t);
$t = q{Update database gives proper error with invalid format};
$res = $bct->ctl('bucardo update db A blah blah');
like ($res, qr/update db:/, $t);
$res = $bct->ctl('bucardo update db A blah123#=123');
like ($res, qr/update db:/, $t);
$t = q{Update database gives proper error with invalid items};
$res = $bct->ctl('bucardo update db A foobar=123');
like ($res, qr/Cannot change "foobar"/, $t);
$t = q{Update database gives proper error with forbidden items};
$res = $bct->ctl('bucardo update db A cdate=123');
like ($res, qr/Sorry, the value of cdate cannot be changed/, $t);
$t = q{Update database works with a simple set};
$res = $bct->ctl('bucardo update db A port=1234');
like ($res, qr/Changed bucardo.db dbport from \d+ to 1234/, $t);
$t = q{Update database works when no change made};
$res = $bct->ctl('bucardo update db A port=1234');
like ($res, qr/No change needed for dbport/, $t);
$t = q{Update database works with multiple items};
$res = $bct->ctl('bucardo update db A port=12345 user=bob');
like ($res, qr/Changed bucardo.db dbport from \d+ to 1234/, $t);
$t = 'Update database works when adding to a new group';
$res = $bct->ctl('bucardo update db A group=group5');
like ($res, qr/Created dbgroup "group5".*Added database "A" to dbgroup "group5" as target/s, $t);
$t = 'Update database works when adding to an existing group';
$res = $bct->ctl('bucardo update db B group=group5');
like ($res, qr/Added database "B" to dbgroup "group5" as target/, $t);
$t = 'Update database works when changing roles';
$res = $bct->ctl('bucardo update db A group=group5:master');
like ($res, qr/Changed role for database "A" in dbgroup "group5" from target to source/, $t);
$t = 'Update database works when removing from a group';
$res = $bct->ctl('bucardo update db B group=group2:replica');
## new group, correct role, remove from group1!
like ($res, qr/Created dbgroup "group2".*Added database "B" to dbgroup "group2" as target.*Removed database "B" from dbgroup "group5"/s, $t);
$res = $bct->ctl('bucardo update db A status=inactive DBport=12345');
like ($res, qr/No change needed for dbport.*Changed bucardo.db status from active to inactive/s, $t);
$t = q{List database returns correct information};
$res = $bct->ctl('bucardo list dbs');
like ($res, qr/Database: A.*Status: inactive.*Database: B.*Status: active/s, $t);
$t = q{Remove database works};
$res = $bct->ctl('bucardo remove db A B --force');
like ($res, qr/that reference database "A".*Removed database "A".*Removed database "B"/s, $t);
$t = q{List database returns correct information};
$res = $bct->ctl('bucardo list dbs');
like ($res, qr/No databases/, $t);
exit;
END {
$bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
}
Bucardo-5.4.1/t/ctest3.pl0000644000175000017500000000000012563002233013521 0ustar greggregBucardo-5.4.1/t/02-bctl-customname.t0000644000175000017500000000775412427203642015515 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test adding, dropping, and listing customnames via bucardo
## Tests the main subs: add_customname, list_customname, and remove_customname
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More tests => 18;
use vars qw/$t $res $command $dbhX $dbhA $dbhB/;
use BucardoTesting;
my $bct = BucardoTesting->new({notime=>1})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = '';
## Make sure A and B are started up
$dbhA = $bct->repopulate_cluster('A');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Grab connection information for each database
my ($dbuserA,$dbportA,$dbhostA) = $bct->add_db_args('A');
## Add database A along with all tables
$command =
"bucardo add db A dbname=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA addalltables";
$res = $bct->ctl($command);
like ($res, qr/Added database "A"\nNew tables added: \d/s, $t);
$t = 'Add customname with no argument gives expected help message';
$res = $bct->ctl('bucardo add customname');
like ($res, qr/add customname/, $t);
$t = 'Add customname with a single argument gives expected help message';
$res = $bct->ctl('bucardo add customname foobar');
like ($res, qr/add customname/, $t);
$t = 'Add customname with an invalid table name gives expected error message';
$res = $bct->ctl('bucardo add customname nosuchtable foobar');
like ($res, qr/Could not find/, $t);
$t = 'Add customname with an invalid table number gives expected error message';
$res = $bct->ctl('bucardo add customname 12345 foobar');
like ($res, qr/Could not find/, $t);
$t = 'Add customname with an invalid sync gives expected error message';
$res = $bct->ctl('bucardo add customname bucardo_test1 foobar sync=abc');
like ($res, qr/No such sync/, $t);
$t = 'Add customname with an invalid database gives expected error message';
$res = $bct->ctl('bucardo add customname bucardo_test1 foobar database=abc');
like ($res, qr/No such database/, $t);
$t = 'Add customname with an invalid db gives expected error message';
$res = $bct->ctl('bucardo add customname bucardo_test1 foobar db=abc');
like ($res, qr/No such database/, $t);
$t = 'Add customname with a valid name works';
$res = $bct->ctl('bucardo add customname bucardo_test1 foobar');
like ($res, qr/Transformed public.bucardo_test1 to foobar/, $t);
$t = 'List customname shows the expected output';
$res = $bct->ctl('bucardo list customname');
like ($res, qr/1\. Table: public.bucardo_test1 => foobar/, $t);
$t = 'List customname shows the expected output with no matching entries';
$res = $bct->ctl('bucardo list customname anc');
like ($res, qr/No matching/, $t);
$t = 'List customname shows the expected output using an exact name';
$res = $bct->ctl('bucardo list customname public.bucardo_test1');
like ($res, qr/1\. Table: public.bucardo_test1 => foobar/, $t);
$t = 'List customname shows the expected output using a regex';
$res = $bct->ctl('bucardo list customname pub%');
like ($res, qr/1\. Table: public.bucardo_test1 => foobar/, $t);
$t = q{Remove customname with no argument gives expected help message};
$res = $bct->ctl('bucardo remove customname');
like ($res, qr/bucardo remove/, $t);
$t = q{Remove customname with non-numeric argument gives expected help message};
$res = $bct->ctl('bucardo remove customname foobar');
like ($res, qr/bucardo remove/, $t);
$t = q{Remove customname with invalid argument gives expected error message};
$res = $bct->ctl('bucardo remove customname 1234');
like ($res, qr/number 1234 does not exist/, $t);
$t = q{Remove customname with valid argument gives expected message};
$res = $bct->ctl('bucardo remove customname 1');
like ($res, qr/Removed customcode 1: public.bucardo_test1 => foobar/, $t);
$t = 'List customname shows the expected output';
$res = $bct->ctl('bucardo list customname');
like ($res, qr/No customnames have been added yet/, $t);
exit;
END {
$bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
}
Bucardo-5.4.1/t/20-mongo.t0000644000175000017500000002612212563002233013517 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test using MongoDB as a database target
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use vars qw/ $bct $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t %pkey $SQL %sth %sql/;
## Must have the MongoDB module
my $evalok = 0;
eval {
require MongoDB;
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => 'Cannot test mongo unless the Perl module MongoDB is installed');
}
## MongoDB must be up and running
$evalok = 0;
my $conn;
eval {
$conn = MongoDB::Connection->new({});
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => 'Cannot test mongo as we cannot connect to a running Mongo db');
}
use BucardoTesting;
## For now, remove the bytea table type as we don't have full mongo support yet
delete $tabletype{bucardo_test8};
## Also cannot handle multi-column primary keys
delete $tabletype{bucardo_test2};
my $numtabletypes = keys %tabletype;
plan tests => 148;
## Make sure we start clean by dropping the test database
my $dbname = 'bucardotest';
my $db = $conn->get_database($dbname);
$db->drop;
$t = qq{Test database "$dbname" has no collections};
my @names = $db->collection_names;
is_deeply (\@names, [], $t);
$bct = BucardoTesting->new() or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = 'mongo';
pass("*** Beginning mongo tests");
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
}
## Get Postgres database A and B and C created
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Tell Bucardo about these databases
## Three Postgres databases will be source, source, and target
for my $name (qw/ A B C /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
$t = 'Adding mongo database M works';
$command =
"bucardo add db M dbname=$dbname type=mongo";
$res = $bct->ctl($command);
like ($res, qr/Added database "M"/, $t);
## Teach Bucardo about all pushable tables, adding them to a new relgroup named "therd"
$t = q{Adding all tables on the master works};
$command =
"bucardo add tables all db=A relgroup=therd pkonly";
$res = $bct->ctl($command);
like ($res, qr/Creating relgroup: therd.*New tables added: \d/s, $t);
## Add a suffix to the end of each mongo target table
$SQL = q{INSERT INTO bucardo.customname(goat,newname,db)
SELECT id,tablename||'_pg','M' FROM goat};
$dbhX->do($SQL);
## Add all sequences, and add them to the newly created relgroup
$t = q{Adding all sequences on the master works};
$command =
"bucardo add sequences all db=A relgroup=therd";
$res = $bct->ctl($command);
like ($res, qr/New sequences added: \d/, $t);
## Create a new dbgroup
$t = q{Created a new dbgroup};
$command =
"bucardo add dbgroup md A:source B:source C M";
$res = $bct->ctl($command);
like ($res, qr/Created dbgroup "md"/, $t);
## Create a new sync
$t = q{Created a new sync};
$command =
"bucardo add sync mongo relgroup=therd dbs=md autokick=false";
$res = $bct->ctl($command);
like ($res, qr/Added sync "mongo"/, $t);
## Start up Bucardo with this new sync
$bct->restart_bucardo($dbhX);
## Get the statement handles ready for each table type
for my $table (sort keys %tabletype) {
$pkey{$table} = $table =~ /test5/ ? q{"id space"} : 'id';
## INSERT
for my $x (1..6) {
$SQL = $table =~ /X/
? qq{INSERT INTO "$table"($pkey{$table}) VALUES (?)}
: qq{INSERT INTO "$table"($pkey{$table},data1,inty) VALUES (?,'foo',$x)};
$sth{insert}{$x}{$table}{A} = $dbhA->prepare($SQL);
if ('BYTEA' eq $tabletype{$table}) {
$sth{insert}{$x}{$table}{A}->bind_param(1, undef, {pg_type => PG_BYTEA});
}
}
## SELECT
$sql{select}{$table} = qq{SELECT inty FROM "$table" ORDER BY $pkey{$table}};
$table =~ /X/ and $sql{select}{$table} =~ s/inty/$pkey{$table}/;
## DELETE ALL
$SQL = qq{DELETE FROM "$table"};
$sth{deleteall}{$table}{A} = $dbhA->prepare($SQL);
## DELETE ONE
$SQL = qq{DELETE FROM "$table" WHERE inty = ?};
$sth{deleteone}{$table}{A} = $dbhA->prepare($SQL);
## TRUNCATE
$SQL = qq{TRUNCATE TABLE "$table"};
$sth{truncate}{$table}{A} = $dbhA->prepare($SQL);
## UPDATE
$SQL = qq{UPDATE "$table" SET inty = ?};
$sth{update}{$table}{A} = $dbhA->prepare($SQL);
}
## Add one row per table type to A
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
}
## Before the commit on A, B and C should be empty
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
$t = qq{B has not received rows for table $table before A commits};
$res = [];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
$dbhB->commit();
$dbhC->commit();
## Commit, then kick off the sync
$dbhA->commit();
$bct->ctl('bucardo kick mongo 0');
$bct->ctl('bucardo kick mongo 0');
## Check B and C for the new rows
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
$t = qq{Row with pkey of type $type gets copied to B};
$res = [[1]];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
$dbhB->commit();
$dbhC->commit();
## Check that mongo has the new collection names
my %col;
@names = $db->collection_names;
for (@names) {
$col{$_} = 1;
}
## Set the modified table names
my %tabletype2;
for my $table (keys %tabletype) {
my $newname = $table.'_pg';
$tabletype2{$newname} = $tabletype{$table};
}
for my $table (sort keys %tabletype2) {
$t = "Table $table has a mongodb collection";
ok(exists $col{$table}, $t);
}
## Check that mongo has the new rows
for my $table (sort keys %tabletype2) {
$t = "Mongo collection $table has correct number of rows after insert";
my $col = $db->get_collection($table);
my @rows = $col->find->all;
my $count = @rows;
is ($count, 1, $t);
## Remove the mongo internal id column
delete $rows[0]->{_id};
$t = "Mongo collection $table has correct entries";
my $type = $tabletype2{$table};
my $id = $val{$type}{1};
my $pkeyname = $table =~ /test5/ ? 'id space' : 'id';
## For now, binary is stored in escaped form, so we skip this one
next if $table =~ /test8/;
is_deeply(
$rows[0],
{
$pkeyname => $id,
inty => 1,
data1 => 'foo',
},
$t);
}
## Update each row
for my $table (keys %tabletype) {
$sth{update}{$table}{A}->execute(42);
}
$dbhA->commit();
$bct->ctl('bucardo kick mongo 0');
for my $table (keys %tabletype2) {
$t = "Mongo collection $table has correct number of rows after update";
my $col = $db->get_collection($table);
my @rows = $col->find->all;
my $count = @rows;
is ($count, 1, $t);
$t = "Mongo collection $table has updated value";
is ($rows[0]->{inty}, 42, $t);
}
## Delete each row
for my $table (keys %tabletype) {
$sth{deleteall}{$table}{A}->execute();
}
$dbhA->commit();
$bct->ctl('bucardo kick mongo 0');
for my $table (keys %tabletype2) {
$t = "Mongo collection $table has correct number of rows after delete";
my $col = $db->get_collection($table);
my @rows = $col->find->all;
my $count = @rows;
is ($count, 0, $t);
}
## Insert two rows, then delete one of them
## Add one row per table type to A
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
my $val2 = $val{$type}{2};
$sth{insert}{2}{$table}{A}->execute($val2);
}
$dbhA->commit();
$bct->ctl('bucardo kick mongo 0');
for my $table (keys %tabletype2) {
$t = "Mongo collection $table has correct number of rows after double insert";
my $col = $db->get_collection($table);
my @rows = $col->find->all;
my $count = @rows;
is ($count, 2, $t);
}
## Delete one of the rows
for my $table (keys %tabletype) {
$sth{deleteone}{$table}{A}->execute(2); ## inty = 2
}
$dbhA->commit();
$bct->ctl('bucardo kick mongo 0');
for my $table (keys %tabletype2) {
$t = "Mongo collection $table has correct number of rows after single deletion";
my $col = $db->get_collection($table);
my @rows = $col->find->all;
my $count = @rows;
is ($count, 1, $t);
}
## Insert two more rows, then truncate
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val3 = $val{$type}{3};
$sth{insert}{3}{$table}{A}->execute($val3);
my $val4 = $val{$type}{4};
$sth{insert}{4}{$table}{A}->execute($val4);
}
$dbhA->commit();
$bct->ctl('bucardo kick mongo 0');
for my $table (keys %tabletype2) {
$t = "Mongo collection $table has correct number of rows after more inserts";
my $col = $db->get_collection($table);
my @rows = $col->find->all;
my $count = @rows;
is ($count, 3, $t);
}
for my $table (keys %tabletype) {
$sth{truncate}{$table}{A}->execute();
}
$dbhA->commit();
$bct->ctl('bucardo kick mongo 0');
for my $table (keys %tabletype2) {
$t = "Mongo collection $table has correct number of rows after truncate";
my $col = $db->get_collection($table);
my @rows = $col->find->all;
my $count = @rows;
is ($count, 0, $t);
}
## Test customname again
undef %tabletype2;
for my $table (keys %tabletype) {
my $newname = $table.'_pg2';
$tabletype2{$newname} = $tabletype{$table};
}
## Test of customname options
$dbhX->do('DELETE FROM bucardo.customname');
## Add a new suffix to the end of each table in this sync for mongo
$SQL = q{INSERT INTO bucardo.customname(goat,newname,db,sync)
SELECT id,tablename||'_pg2','M','mongo' FROM goat};
$dbhX->do($SQL);
$dbhX->commit();
$bct->ctl('reload sync mongo');
## Insert two rows
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val3 = $val{$type}{3};
$sth{insert}{3}{$table}{A}->execute($val3);
my $val4 = $val{$type}{4};
$sth{insert}{4}{$table}{A}->execute($val4);
}
$dbhA->commit();
$bct->ctl('bucardo kick mongo 0');
for my $table (keys %tabletype2) {
$t = "Mongo collection $table has correct number of rows after insert";
my $col = $db->get_collection($table);
my @rows = $col->find->all;
my $count = @rows;
is ($count, 2, $t);
}
$t=q{Using customname, we can force a text string to an int};
my $CS = 'SELECT id, data1 AS data2inty::INTEGER, inty, email FROM bucardo.bucardo_test2';
## Set this one for this db and this sync
$bct->ctl('bucardo add cs db=M sync=mongo table=ttable');
$t=q{Using customname, we can restrict the columns sent};
$t=q{Using customname, we can add new columns and modify others};
## Set this one for all syncs
pass('Done with mongo testing');
exit;
Bucardo-5.4.1/t/40-conflict.t0000644000175000017500000001476512563002233014215 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test of conflicts
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use vars qw/ $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t $SQL %pkey %sth %sql $sth $count $val /;
use BucardoTesting;
my $bct = BucardoTesting->new({location => 'conflict'})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
}
## Get A, B, and C created, emptied out, and repopulated with sample data
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
$dbhD = $bct->repopulate_cluster('D');
## Store into hashes for convenience
my %dbh = (A=>$dbhA, B=>$dbhB, C=>$dbhC, D=>$dbhD);
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Teach Bucardo about three databases
for my $name (qw/ A B C D/) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
$bct->ctl('bucardo remove dbgroup ctest');
$bct->ctl('bucardo remove relgroup ctest');
## Create a new dbgroup with three sources and one target
$t = q{Created a new dbgroup ctest for ( A <=> B <=> C ) -> D};
$res = $bct->ctl('bucardo add dbgroup ctest A:source B:source C:source D:target');
like ($res, qr/Created dbgroup "ctest"/, $t);
## Create a new relgroup with all tables
$t = q{Created a new relgroup ctest};
$res = $bct->ctl('bucardo add relgroup ctest all');
like ($res, qr/Created relgroup "ctest"/, $t);
## Create a new sync
$t = q{Created a new sync named ctest};
$res = $bct->ctl('bucardo add sync ctest dbgroup=ctest relgroup=ctest autokick=false');
like ($res, qr/Added sync "ctest"/, $t);
## Start listening for a syncdone message
$dbhX->do('LISTEN bucardo_syncdone_ctest');
$dbhX->commit();
## Start up Bucardo
$bct->restart_bucardo($dbhX);
## No conflict, just update some rows to make sure the sync is working
$bct->add_row_to_database('A', 1);
$bct->ctl('bucardo kick sync ctest 10');
$bct->check_for_row([[1]], [qw/ B C D/]);
## Create a conflict
$bct->add_row_to_database('A', 2);
$bct->add_row_to_database('B', 2);
$bct->add_row_to_database('C', 2);
$bct->ctl('bucardo kick sync ctest 10');
$bct->check_for_row([[1],[2]], [qw/ A B C D/]);
$t = q{Cannot set conflict handler to invalid database name};
$res = $bct->ctl('bucardo update sync ctest conflict="a b c"');
like($res, qr{is not a db for this sync}, $t);
## Create another conflict, but change our tactics
$t = q{Set conflict handler to valid database name list};
$res = $bct->ctl('bucardo update sync ctest conflict="C A B"');
like($res, qr{Set conflict strategy}, $t);
$bct->ctl('bucardo reload sync ctest');
$bct->update_row_in_database('A', 1, 111);
$bct->update_row_in_database('C', 1, 333);
$bct->update_row_in_database('B', 1, 222);
## Database C should be the winner
$bct->ctl('bucardo kick sync ctest 10');
$bct->check_for_row([[2],[333]], [qw/ A B C D/]);
## Same thing, but C is not changed, so A should win
$bct->update_row_in_database('A', 1, 1111);
$bct->update_row_in_database('B', 1, 2222);
$bct->ctl('bucardo kick sync ctest 10');
$bct->check_for_row([[2],[1111]], [qw/ A B C D/]);
## Test of the default conflict strategy
$bct->update_row_in_database('B', 1, 102);
$bct->update_row_in_database('A', 2, 201);
$bct->update_row_in_database('B', 2, 202);
$bct->add_row_to_database('A', 3);
$bct->update_row_in_database('A', 3, 301);
$bct->update_row_in_database('C', 2, 203);
$t = q{Set conflict strategy to 'bucardo_latest'};
$res = $bct->ctl('bucardo update sync ctest conflict=latest');
like($res, qr{Set conflict strategy to 'bucardo_latest'}, $t);
$t = q{Reloaded sync ctest};
$res = $bct->ctl('bucardo reload sync ctest');
like($res, qr{success}, $t);
## Database B should be the winner for 1, C for 2, and A for 3
$bct->ctl('bucardo kick sync ctest 10');
$bct->check_for_row([[102],[203],[301]], [qw/ A B C D /]);
## Test of conflict handler 'bucardo_latest_all_tables'
$t = q{Set conflict strategy to 'bucardo_latest_all_tables'};
$res = $bct->ctl('bucardo update sync ctest conflict=latest_all');
like($res, qr{Set conflict strategy to 'bucardo_latest_all_tables'}, $t);
$t = q{Reloaded sync ctest};
$res = $bct->ctl('bucardo reload sync ctest');
like($res, qr{success}, $t);
$bct->update_row_in_database('B', 1, 102);
$bct->update_row_in_database('A', 2, 201);
$bct->update_row_in_database('B', 2, 202);
$bct->update_row_in_database('A', 3, 301);
$bct->update_row_in_database('C', 2, 203);
## Database B should be the winner for 1, C for 2, and A for 3
$bct->ctl('bucardo kick sync ctest 10');
$bct->check_for_row([[102],[203],[301]], [qw/ A B C D /]);
## Use a custom conflict handler by adding a customcode to this sync
$t = q{Added new customcode ctest1 for conflict in the ctest sync};
$res = $bct->ctl('bucardo add customcode ctest1 whenrun=conflict sync=ctest src_code=t/ctest1.pl');
like($res, qr{Added customcode "ctest1"}, $t);
$t = q{Reloaded sync ctest};
$res = $bct->ctl('bucardo reload sync ctest');
like($res, qr{success}, $t);
$bct->update_row_in_database('A', 2, 211);
$bct->update_row_in_database('B', 2, 212);
$bct->update_row_in_database('C', 2, 213);
$bct->update_row_in_database('A', 1, 111);
$bct->update_row_in_database('C', 1, 113);
$bct->ctl('bucardo kick sync ctest 10');
$bct->check_for_row([[111],[212],[301]], [qw/ A B C D /]);
## Test customcode with specific winners per row
$t = q{Added new customcode ctest2 for conflict in the ctest sync};
$res = $bct->ctl('bucardo add customcode ctest2 whenrun=conflict relation=bucardo_test1 src_code=t/ctest2.pl');
like($res, qr{Added customcode "ctest2"}, $t);
$t = q{Reloaded sync ctest};
$res = $bct->ctl('bucardo reload sync ctest');
like($res, qr{success}, $t);
$bct->update_row_in_database('A', 1, 101);
$bct->update_row_in_database('B', 1, 102);
$bct->update_row_in_database('C', 1, 103);
$bct->update_row_in_database('A', 2, 221);
$bct->update_row_in_database('B', 2, 222);
$bct->update_row_in_database('C', 2, 223);
$bct->ctl('bucardo kick sync ctest 10');
## ctest2.pl sets B as winner inside the conflict hash
$bct->check_for_row([[102],[222],[301]], [qw/ A B C D /]);
## Test customcode on a goat only
done_testing();
exit;
Bucardo-5.4.1/t/02-bctl-herd.t0000644000175000017500000000670012563002233014244 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test adding, dropping, and changing relgroups via bucardo
## Tests the main subs: add_relgroup, list_relgroups, update_relgroup, remove_relgroup
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More tests => 7;
use vars qw/$t $res $command $dbhX $dbhA $dbhB/;
use BucardoTesting;
my $bct = BucardoTesting->new({notime=>1})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = '';
## Make sure A and B are started up
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Grab connection information for each database
my ($dbuserA,$dbportA,$dbhostA) = $bct->add_db_args('A');
my ($dbuserB,$dbportB,$dbhostB) = $bct->add_db_args('B');
## Tests of basic 'add relgroup' usage
$t = 'Add relgroup with no argument gives expected help message';
$res = $bct->ctl('bucardo add relgroup');
like ($res, qr/add relgroup/, $t);
$t = q{Add relgroup works for a new relgroup};
$res = $bct->ctl('bucardo add relgroup foobar');
like ($res, qr/Created relgroup "foobar"/, $t);
$t = q{Add relgroup gives expected message if relgroup already exists};
$res = $bct->ctl('bucardo add relgroup foobar');
like ($res, qr/Relgroup "foobar" already exists/, $t);
$t = q{Add relgroup gives expected message when adding a single table that does not exist};
$res = $bct->ctl('bucardo add relgroup foobar nosuchtable');
like ($res, qr/No databases have been added yet/, $t);
## Add two postgres databases
for my $name (qw/ A B /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
$t = q{Add relgroup works when adding a single table};
# If we do this here, we'll have problems. The next test adds a table called
# bucardo_test1, which will be found in this new bucardo_test database. But
# because there's no dot in the table name in the call adding the foobar herd,
# bucardo will try to find other tables with similar names, and will search in
# the newly-added database A to do so, where it will find and add a
# bucardo_test1 table. It will then try adding that table to the herd as well,
# and fail, because you can't have tables from different databases in the same
# herd. This behavior seems pessimal.
#$res = $bct->ctl("bucardo add database bucardo_test db=bucardo_test user=$dbuserA port=$dbportA host=$dbhostA addalltables");
$res = $bct->ctl('bucardo add relgroup foobar bucardo_test1');
is ($res, qq{Relgroup "foobar" already exists
Added the following tables or sequences:
public.bucardo_test1 (DB: A)
$newherd_msg "foobar":
public.bucardo_test1\n}, $t);
$t = q{Add relgroup works when adding multiple tables};
$t = q{Add relgroup works when adding a single sequence};
$t = q{Add relgroup works when adding multiple sequences};
$t = q{Add relgroup works when adding same name table and sequence};
$t = q{Add relgroup works when adding tables via schema wildcards};
$t = q{Add relgroup works when adding tables via table wildcards};
exit;
## end add relgroup?
exit;
END {
$bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
}
Bucardo-5.4.1/t/20-mysql.t0000644000175000017500000002663412601642760013565 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test using MySQL as a database target
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use vars qw/ $bct $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t %pkey $SQL %sth %sql/;
## Must have the DBD::mysql module
my $evalok = 0;
eval {
require DBD::mysql;
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => 'Cannot test MySQL unless the Perl module DBD::mysql is installed');
}
## MySQL must be up and running
$evalok = 0;
my $dbh;
my $dbuser = 'root';
eval {
$dbh = DBI->connect('dbi:mysql:database=test', $dbuser, '',
{AutoCommit=>1, PrintError=>0, RaiseError=>1});
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => "Cannot test MySQL as we cannot connect to a running MySQL database");
}
## Need to ensure this is really MySQL, not MariaDB
my $ver = $dbh->selectall_arrayref('SELECT version()')->[0][0];
if ($ver =~ /MariaDB/) {
plan (skip_all => "Cannot test MySQL: MySQL port is being used by MariaDB");
}
use BucardoTesting;
## For now, remove the bytea table type as we don't have full support yet
delete $tabletypemysql{bucardo_test8};
my $numtabletypes = keys %tabletypemysql;
plan tests => 151;
## Drop the test database if it exists
my $dbname = 'bucardo_test';
eval {
$dbh->do("DROP DATABASE $dbname");
};
## Create the test database
$dbh->do("CREATE DATABASE $dbname");
## Reconnect to the new database
$dbh = DBI->connect("dbi:mysql:database=$dbname", $dbuser, '',
{AutoCommit=>1, PrintError=>0, RaiseError=>1});
## Yes, this must be turned on manually!
$dbh->do("SET sql_mode='ANSI_QUOTES'");
## Create one table for each table type
for my $table (sort keys %tabletypemysql) {
my $pkeyname = $table =~ /test5/ ? q{"id space"} : 'id';
my $pkindex = $table =~ /test2/ ? '' : 'PRIMARY KEY';
$SQL = qq{
CREATE TABLE "$table" (
$pkeyname $tabletypemysql{$table} NOT NULL $pkindex};
$SQL .= $table =~ /X/ ? "\n)" : qq{,
data1 VARCHAR(100) NULL,
inty SMALLINT NULL,
booly BOOLEAN NULL, -- Alias for TINYINT
bite1 VARBINARY(999) NULL,
bite2 VARBINARY(999) NULL,
email VARCHAR(100) NULL UNIQUE
)
};
$dbh->do($SQL);
if ($table =~ /test2/) {
$dbh->do(qq{ALTER TABLE "$table" ADD CONSTRAINT multipk PRIMARY KEY ($pkeyname,data1)});
}
}
$bct = BucardoTesting->new() or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = 'mysql';
pass("*** Beginning MySQL tests");
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
$dbhD and $dbhD->disconnect();
}
## Get Postgres database A and B and C created
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Tell Bucardo about these databases
## Three Postgres databases will be source, source, and target
for my $name (qw/ A B C /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
$t = 'Adding mysql database Q works';
$command =
"bucardo add db Q dbname=$dbname type=mysql dbuser=$dbuser";
$res = $bct->ctl($command);
like ($res, qr/Added database "Q"/, $t);
## Teach Bucardo about all pushable tables, adding them to a new relgroup named "therd"
$t = q{Adding all tables on the master works};
$command =
"bucardo add tables all db=A relgroup=therd pkonly";
$res = $bct->ctl($command);
like ($res, qr/Creating relgroup: therd.*New tables added: \d/s, $t);
## Add all sequences, and add them to the newly created relgroup
$t = q{Adding all sequences on the master works};
$command =
"bucardo add sequences all db=A relgroup=therd";
$res = $bct->ctl($command);
like ($res, qr/New sequences added: \d/, $t);
## Create a new dbgroup
$t = q{Created a new dbgroup};
$command =
"bucardo add dbgroup qx A:source B:source C Q";
$res = $bct->ctl($command);
like ($res, qr/Created dbgroup "qx"/, $t);
## Create a new sync
$t = q{Created a new sync};
$command =
"bucardo add sync mysql relgroup=therd dbs=qx autokick=false";
$res = $bct->ctl($command);
like ($res, qr/Added sync "mysql"/, $t);
## Create a second sync, solely for multi-sync interaction issues
$bct->ctl('bucardo add dbgroup t1 A:source B C');
$bct->ctl('bucardo add sync tsync1 relgroup=therd dbs=t1 autokick=false status=inactive');
## Start up Bucardo with these new syncs
$bct->restart_bucardo($dbhX);
## Boolean values
my (@boolys) = qw( xxx true false null false true null );
## Get the statement handles ready for each table type
for my $table (sort keys %tabletypemysql) {
$pkey{$table} = $table =~ /test5/ ? q{"id space"} : 'id';
## INSERT
for my $x (1..6) {
$SQL = $table =~ /X/
? qq{INSERT INTO "$table"($pkey{$table}) VALUES (?)}
: qq{INSERT INTO "$table"($pkey{$table},data1,inty,booly) VALUES (?,'foo',$x,$boolys[$x])};
$sth{insert}{$x}{$table}{A} = $dbhA->prepare($SQL);
if ('BYTEA' eq $tabletypemysql{$table}) {
$sth{insert}{$x}{$table}{A}->bind_param(1, undef, {pg_type => PG_BYTEA});
}
}
## SELECT
$sql{select}{$table} = qq{SELECT inty, booly FROM "$table" ORDER BY $pkey{$table}};
$table =~ /X/ and $sql{select}{$table} =~ s/inty/$pkey{$table}/;
## DELETE ALL
$SQL = qq{DELETE FROM "$table"};
$sth{deleteall}{$table}{A} = $dbhA->prepare($SQL);
## DELETE ONE
$SQL = qq{DELETE FROM "$table" WHERE inty = ?};
$sth{deleteone}{$table}{A} = $dbhA->prepare($SQL);
## TRUNCATE
$SQL = qq{TRUNCATE TABLE "$table"};
$sth{truncate}{$table}{A} = $dbhA->prepare($SQL);
## UPDATE
$SQL = qq{UPDATE "$table" SET inty = ?};
$sth{update}{$table}{A} = $dbhA->prepare($SQL);
}
## Add one row per table type to A
for my $table (keys %tabletypemysql) {
my $type = $tabletypemysql{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
}
## Before the commit on A, B, C, and Q should be empty
for my $table (sort keys %tabletypemysql) {
my $type = $tabletypemysql{$table};
$t = qq{B has not received rows for table $table before A commits};
$res = [];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
bc_deeply($res, $dbh, $sql{select}{$table}, $t);
}
## Commit, then kick off the sync
$dbhA->commit();
$bct->ctl('bucardo kick mysql 0');
$bct->ctl('bucardo kick mysql 0');
## Check B and C for the new rows
for my $table (sort keys %tabletypemysql) {
my $type = $tabletypemysql{$table};
$t = qq{Row with pkey of type $type gets copied to B};
$res = [[1,1]];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
## Check that MySQL has the new rows
for my $table (sort keys %tabletypemysql) {
$t = "MySQL table $table has correct number of rows after insert";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
is ($count, 1, $t);
$t = "MySQL table $table has correct entries";
my $info = $sth->fetchall_arrayref({})->[0];
my $type = $tabletypemysql{$table};
my $id = $val{$type}{1};
my $pkeyname = $table =~ /test5/ ? 'id space' : 'id';
## For now, binary is stored in escaped form, so we skip this one
next if $table =~ /test8/;
## Datetime has no time zone thingy at the end
$tabletypemysql{$table} =~ /DATETIME/ and $id =~ s/\+.*//;
is_deeply(
$info,
{
$pkeyname => $id,
inty => 1,
booly => 1,
email => undef,
bite1 => undef,
bite2 => undef,
data1 => 'foo',
},
$t);
}
## Update each row
for my $table (keys %tabletypemysql) {
$sth{update}{$table}{A}->execute(42);
}
$dbhA->commit();
$bct->ctl('bucardo kick mysql 0');
for my $table (keys %tabletypemysql) {
$t = "MySQL table $table has correct number of rows after update";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
is ($count, 1, $t);
$t = "MySQL table $table has updated value";
my $info = $sth->fetchall_arrayref({})->[0];
is ($info->{inty}, 42, $t);
}
## Delete each row
for my $table (keys %tabletypemysql) {
$sth{deleteall}{$table}{A}->execute();
}
$dbhA->commit();
$bct->ctl('bucardo kick mysql 0');
for my $table (keys %tabletypemysql) {
$t = "MySQL table $table has correct number of rows after delete";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
(my $count = $sth->execute()) =~ s/0E0/0/;
$sth->finish();
is ($count, 0, $t);
}
## Insert two rows, then delete one of them
## Add one row per table type to A
for my $table (keys %tabletypemysql) {
my $type = $tabletypemysql{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
my $val2 = $val{$type}{2};
$sth{insert}{2}{$table}{A}->execute($val2);
}
$dbhA->commit();
$bct->ctl('bucardo kick mysql 0');
for my $table (keys %tabletypemysql) {
$t = "MySQL table $table has correct number of rows after double insert";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
$sth->finish();
is ($count, 2, $t);
}
## Delete one of the rows
for my $table (keys %tabletypemysql) {
$sth{deleteone}{$table}{A}->execute(2); ## inty = 2
}
$dbhA->commit();
$bct->ctl('bucardo kick mysql 0');
for my $table (keys %tabletypemysql) {
$t = "MySQL table $table has correct number of rows after single deletion";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
$sth->finish();
is ($count, 1, $t);
}
## Insert two more rows
for my $table (keys %tabletypemysql) {
my $type = $tabletypemysql{$table};
my $val3 = $val{$type}{3};
$sth{insert}{3}{$table}{A}->execute($val3);
my $val4 = $val{$type}{4};
$sth{insert}{4}{$table}{A}->execute($val4);
}
$dbhA->commit();
$bct->ctl('bucardo kick mysql 0');
for my $table (keys %tabletypemysql) {
$t = "MySQL table $table has correct number of rows after more inserts";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
is ($count, 3, $t);
$t = "MySQL table $table has updated values";
my $info = $sth->fetchall_arrayref({});
$info = [ sort { $a->{inty} <=> $b->{inty} } @$info ];
my ($val1, $val3, $val4) = @{$val{$tabletypemysql{$table}}}{1, 3, 4};
my $pkeyname = $table =~ /test5/ ? 'id space' : 'id';
my(@invar) = ( data1 => 'foo', 'email' => undef, bite1 => undef, bite2 => undef );
is_deeply ($info, [{ $pkeyname=>$val1, inty=>1, booly=>1, @invar },
{ $pkeyname=>$val3, inty=>3, booly=>undef, @invar },
{ $pkeyname=>$val4, inty=>4, booly=>0, @invar }], $t) || diag explain $info;
$sth->finish();
}
exit;
Bucardo-5.4.1/t/99-signature.t0000644000175000017500000000160212311341640014414 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test that our SIGNATURE file is valid - requires TEST_SIGNATURE env
use strict;
use warnings;
use Test::More;
select(($|=1,select(STDERR),$|=1)[1]);
if (! $ENV{RELEASE_TESTING}) {
plan (skip_all => 'Test skipped unless environment variable RELEASE_TESTING is set');
}
plan tests => 1;
SKIP: {
if (!eval { require Module::Signature; 1 }) {
skip 'Must have Module::Signature to test SIGNATURE file', 1;
}
elsif ( !-e 'SIGNATURE' ) {
fail 'SIGNATURE file was not found';
}
elsif ( ! -s 'SIGNATURE') {
fail 'SIGNATURE file was empty';
}
else {
my $ret = Module::Signature::verify();
if ($ret eq Module::Signature::SIGNATURE_OK()) {
pass 'Valid SIGNATURE file';
}
else {
fail 'Invalid SIGNATURE file';
}
}
}
Bucardo-5.4.1/t/40-customcode-exception.t0000644000175000017500000001343212563002233016543 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test of customcode to handle exceptions
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use vars qw/ $dbhX $dbhA $dbhB $dbhC $res $command $t $SQL %pkey %sth %sql $sth $count $val /;
use BucardoTesting;
my $bct = BucardoTesting->new({location => 'postgres'})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
#plan tests => 9999;
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
}
## Get A, B, and C created, emptied out, and repopulated with sample data
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
## Store into hashes for convenience
my %dbh = (A=>$dbhA, B=>$dbhB, C=>$dbhC);
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Teach Bucardo about three databases
for my $name (qw/ A B C /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
## Create a table with a non-primary key unique constraint
$SQL = q{DROP TABLE IF EXISTS employee CASCADE};
$dbhA->do($SQL); $dbhB->do($SQL); $dbhC->do($SQL);
$SQL = q{DROP TABLE IF EXISTS employee_conflict CASCADE};
$dbhA->do($SQL); $dbhB->do($SQL); $dbhC->do($SQL);
$SQL = q{
CREATE TABLE employee (
id SERIAL PRIMARY KEY,
fullname TEXT,
email TEXT UNIQUE
);
};
$dbhA->do($SQL); $dbhB->do($SQL); $dbhC->do($SQL);
$SQL = q{CREATE TABLE employee_conflict (LIKE employee)};
$dbhA->do($SQL); $dbhB->do($SQL); $dbhC->do($SQL);
$dbhA->commit();$dbhB->commit();$dbhC->commit();
## Create a new herd for the table
$t = q{Adding tables to new herd 'exherd' works};
$res = $bct->ctl(q{bucardo add table employee herd=exherd});
like ($res, qr/Created the relgroup named "exherd".*are now part of/s, $t);
## Create a new dbgroup going from A to B to C
$t = q{Created a new dbgroup exabc for A <=> B <=> C};
$res = $bct->ctl('bucardo add dbgroup exabc A:source B:source C:source');
like ($res, qr/Created dbgroup "exabc"/, $t);
## Create a new sync
$t = q{Created a new sync for dbgroup exabc};
$res = $bct->ctl('bucardo add sync exabc relgroup=exherd dbs=exabc status=active autokick=false');
like ($res, qr/Added sync "exabc"/, $t);
## Start listening for a syncdone message
$dbhX->do('LISTEN bucardo_syncdone_exabc');
$dbhX->commit();
## Start up Bucardo
$bct->restart_bucardo($dbhX);
## Add some rows and verify that basic replication is working
$SQL = 'INSERT INTO employee (id,fullname,email) VALUES (?,?,?)';
my $insert_ea = $dbhA->prepare($SQL);
my $insert_eb = $dbhB->prepare($SQL);
my $insert_ec = $dbhC->prepare($SQL);
$insert_ea->execute(100, 'Alice', 'alice@acme' );
$insert_eb->execute(101, 'Bob', 'bob@acme' );
$dbhA->commit(); $dbhB->commit(); $dbhC->commit();
$bct->ctl('bucardo kick sync exabc 0');
## We cool?
$SQL = 'SELECT id FROM employee ORDER BY id';
for my $db (qw/ A B C /) {
my $dbh = $dbh{$db};
my $result = $dbh->selectall_arrayref($SQL);
$t = qq{Database $db has expected rows};
is_deeply ($result, [[100],[101]], $t);
}
## Cause a unique index violation and confirm the sync dies
$insert_eb->execute(102, 'Mallory1', 'mallory@acme' );
$insert_ec->execute(103, 'Mallory2', 'mallory@acme' );
$dbhA->commit(); $dbhB->commit(); $dbhC->commit();
$bct->ctl('bucardo kick sync exabc 0');
## Check the status - should be bad
$res = $bct->ctl('bucardo status exabc');
$t = q{Sync exabc is marked as bad after a failed run};
like ($res, qr{Current state\s+:\s+Bad}, $t);
$t = q{Sync exabc shows a duplicate key violation};
like ($res, qr{ERROR.*employee_email_key}, $t);
## Add in a customcode exception handler
$res = $bct->ctl('bucardo add customcode email_exception whenrun=exception src_code=t/customcode.exception.bucardotest.pl sync=exabc getdbh=1');
$t = q{Customcode exception handler was added for sync exabc};
like ($res, qr{Added customcode "email_exception"}, $t);
# $res = $bct->ctl('update customcode email_exception status=inactive');
# diag Dumper $res;
# exit;
## Reload the sync and verify the exception handler allows the sync to continue
$bct->ctl('bucardo reload exabc');
$bct->ctl('bucardo kick sync exabc 0');
## Status should now be good
$res = $bct->ctl('bucardo status exabc');
$t = q{Sync exabc is marked as good after a exception-handled run};
like ($res, qr{Current state\s+:\s+Good}, $t);
## Make sure all the rows are as we expect inside employee
## We cool?
$SQL = 'SELECT id,email,fullname FROM employee ORDER BY id';
for my $db (qw/ A B C /) {
my $dbh = $dbh{$db};
my $result = $dbh->selectall_arrayref($SQL);
$t = qq{Database $db has expected rows in employee};
is_deeply ($result,[
[100,'alice@acme','Alice'],
[101,'bob@acme','Bob'],
[102,'mallory@acme','Mallory1']
],$t);
}
## Make sure all the rows are as we expect inside employee_conflict
$SQL = 'SELECT id,email,fullname FROM employee_conflict';
for my $db (qw/ C /) {
my $dbh = $dbh{$db};
my $result = $dbh->selectall_arrayref($SQL);
$t = qq{Database $db has expected rows in employee_conflict};
is_deeply ($result,[
[103,'mallory@acme','Mallory2']
],$t);
}
## Test disabling the customcode
like $bct->ctl('update customcode email_exception status=inactive'),
qr/\QChanged customcode "email_exception" status from 'active' to 'inactive'/,
'Change email_exception status to "inactive"';
## Test goat-level customcode
done_testing();
exit;
Bucardo-5.4.1/t/10-makedelta.t0000644000175000017500000001341112601642760014333 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test makedelta functionality
use 5.008003;
use strict;
use warnings;
use lib 't','.';
use DBD::Pg;
use Test::More tests => 51;
use BucardoTesting;
my $bct = BucardoTesting->new({ location => 'makedelta' })
or BAIL_OUT "Creation of BucardoTesting object failed\n";
END { $bct->stop_bucardo if $bct }
ok my $dbhA = $bct->repopulate_cluster('A'), 'Populate cluster A';
ok my $dbhB = $bct->repopulate_cluster('B'), 'Populate cluster B';
ok my $dbhC = $bct->repopulate_cluster('C'), 'Populate cluster C';
ok my $dbhX = $bct->setup_bucardo('A'), 'Set up Bucardo';
END { $_->disconnect for grep { $_ } $dbhA, $dbhB, $dbhC, $dbhX }
# Teach Bucardo about the databases.
for my $db (qw(A B C)) {
my ($user, $port, $host) = $bct->add_db_args($db);
like $bct->ctl(
"bucardo add db $db dbname=bucardo_test user=$user port=$port host=$host"
), qr/Added database "$db"/, qq{Add database "$db" to Bucardo};
}
# Let's just deal with table bucardo_test1 (single column primary key)
# and bucardo_test2 (multi-column primary key).
# Create bucardo_test4 with makedelta off.
for my $num (1, 2, 4) {
my $md = $num == 4 ? 'off' : 'on';
like $bct->ctl("bucardo add table bucardo_test$num db=A relgroup=myrels makedelta=$md"),
qr/Added the following tables/, "Add table bucardo_test$num";
}
# Create a sync for multi-master replication between A and B
like $bct->ctl('bucardo add sync deltatest1 relgroup=myrels dbs=A:source,B:source'),
qr/Added sync "deltatest1"/, 'Create sync "deltatest1"';
# Create a sync for replication from B to C
like $bct->ctl('bucardo add sync deltatest2 relgroup=myrels dbs=B,C autokick=no'),
qr/Added sync "deltatest2"/, 'Create sync "deltatest2"';
# Create an inactive sync from C to A. This is so makedelta on C tables works
like $bct->ctl('bucardo add sync deltafake relgroup=myrels dbs=C,A status=inactive autokick=no'),
qr/Added sync "deltafake"/, 'Create sync "deltafake"';
# Listen in on things.
ok $dbhX->do('LISTEN bucardo_syncdone_deltatest1'),
'Listen for syncdone_deltatest1';
ok $dbhX->do('LISTEN bucardo_syncdone_deltatest2'),
'Listen for syncdone_deltatest2';
ok $dbhX->do('LISTEN bucardo_syncdone_deltatest3'),
'Listen for syncdone_deltatest3';
# Start up Bucardo and wait for initial syncs to finish.
ok $bct->restart_bucardo($dbhX), 'Bucardo should start';
ok $bct->wait_for_notice($dbhX, [qw(
syncdone_deltatest1
)]), 'The deltatest1 sync finished';
# Should have no rows.
$bct->check_for_row([], [qw(A B C)], undef, 'test[124]$');
# Let's add some data into A.bucardo_test1.
ok $dbhA->do(q{INSERT INTO bucardo_test1 (id, data1) VALUES (1, 'foo')}),
'Insert a row into test1 on A';
$dbhA->commit;
ok $bct->wait_for_notice($dbhX, [qw(
syncdone_deltatest1
)]), 'The deltatest1 sync has finished';
## Bucardo will not fire off deltatest2 itself, so we kick it
$bct->ctl('bucardo kick sync deltatest2 0');
ok $bct->wait_for_notice($dbhX, [qw(
syncdone_deltatest2
)]), 'The deltatest2 sync has finished';
# The row should be in A and B, as well as C!
is_deeply $dbhB->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test1'
), [[1, 'foo']], 'Should have the test1 row in B';
is_deeply $dbhC->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test1'
), [[1, 'foo']], 'Second sync moved row from B to C';
# Now let's insert into test2 on B.
# This will cause both syncs to fire
# deltatest1 (A<=>B) will copy the row from B to A
# deltatest2 (B=>C) will copy the row from B to C
ok $dbhB->do(q{INSERT INTO bucardo_test2 (id, data1) VALUES (2, 'foo')}),
'Insert a row into test2 on B';
$dbhB->commit;
## Sync deltatest2 is not automatic, so we need to kick it
# Kick off the second sync
$bct->ctl('bucardo kick sync deltatest2 0');
ok $bct->wait_for_notice($dbhX, [qw(
syncdone_deltatest1
syncdone_deltatest2
)]), 'The deltatest1 and deltatest2 syncs finished';
is_deeply $dbhA->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test2'
), [[2, 'foo']], 'Should have the A test2 row in A';
is_deeply $dbhC->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test2'
), [[2, 'foo']], 'Should have the A test2 row in C';
# Finally, try table 4, which has no makedelta.
ok $dbhA->do(q{INSERT INTO bucardo_test4 (id, data1) VALUES (3, 'foo')}),
'Insert a row into test4 on A';
$dbhA->commit;
ok $bct->wait_for_notice($dbhX, [qw(
syncdone_deltatest1
)]), 'The deltatest1 sync finished';
# Kick off the second sync
$bct->ctl('bucardo kick sync deltatest2 0');
is_deeply $dbhB->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test4'
), [[3, 'foo']], 'Should have the test4 row in B';
is_deeply $dbhC->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test4'
), [], 'Should have no test4 row row in C';
$dbhA->commit();
$dbhB->commit();
$dbhC->commit();
##############################################################################
# Okay, what if we have C be a target from either A or B?
like $bct->ctl('bucardo remove sync deltatest2'),
qr/Removed sync "deltatest2"/, 'Remove sync "deltatest2"';
like $bct->ctl('bucardo add sync deltatest3 relgroup=myrels dbs=A:source,B:source,C'),
qr/Added sync "deltatest3"/, 'Created sync "deltatest3"';
ok $bct->restart_bucardo($dbhX), 'Bucardo restarted';
ok $dbhA->do(q{INSERT INTO bucardo_test2 (id, data1) VALUES (3, 'howdy')}),
'Insert a row into test2 on A';
$dbhA->commit;
ok $bct->wait_for_notice($dbhX, [qw(
syncdone_deltatest1
syncdone_deltatest3
)]), 'Syncs deltatest1 and deltatest3 finished';
is_deeply $dbhB->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test2'
), [[2, 'foo'], [3, 'howdy']], 'Should have the A test2 row in B';
is_deeply $dbhC->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test2'
), [[2, 'foo'], [3, 'howdy']], 'Should have the A test2 row in C';
Bucardo-5.4.1/t/30-crash.t0000644000175000017500000000717412563002233013507 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test what happens when one or more of the databases goes kaput
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use vars qw/ $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t $SQL $sth $count /;
use BucardoTesting;
my $bct = BucardoTesting->new({location => 'crash'})
or BAIL_OUT "Creation of BucardoTesting object failed\n";
pass("*** Beginning crash tests");
END {
$bct and $bct->stop_bucardo();
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
$dbhD and $dbhD->disconnect();
}
## Get A, B, C, and D created, emptied out, and repopulated with sample data
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
$dbhD = $bct->repopulate_cluster('D');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Teach Bucardo about four databases
for my $name (qw/ A B C D /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
## Put all pk tables into a relgroup
$t = q{Adding all PK tables on the master works};
$res = $bct->ctl(q{bucardo add tables '*bucardo*test*' '*Bucardo*test*' db=A relgroup=allpk pkonly});
like ($res, qr/Created the relgroup named "allpk".*are now part of/s, $t);
## We want to start with two non-overlapping syncs, so we can make sure a database going down
## in one sync does not bring down the other sync
$t = q{Created a new dbgroup A -> B};
$res = $bct->ctl('bucardo add dbgroup ct1 A:source B:target');
like ($res, qr/Created dbgroup "ct1"/, $t);
$t = q{Created a new dbgroup C -> D};
$res = $bct->ctl('bucardo add dbgroup ct2 C:source D:target');
like ($res, qr/Created dbgroup "ct2"/, $t);
$t = q{Created a new sync cts1 for A -> B};
$res = $bct->ctl('bucardo add sync cts1 relgroup=allpk dbs=ct1 autokick=false');
like ($res, qr/Added sync "cts1"/, $t);
$t = q{Created a new sync cts2 for C -> D};
$res = $bct->ctl('bucardo add sync cts2 relgroup=allpk dbs=ct2 autokick=false');
like ($res, qr/Added sync "cts2"/, $t);
## Start up Bucardo.
$bct->restart_bucardo($dbhX);
## Add a row to A and C
$bct->add_row_to_database('A', 22);
$bct->add_row_to_database('C', 25);
## Kick the syncs
$bct->ctl('bucardo kick sync cts1 0');
$bct->ctl('bucardo kick sync cts2 0');
## Make sure the new rows are on the targets
$bct->check_for_row([[22]], [qw/ B /]);
$bct->check_for_row([[25]], [qw/ D /]);
## Pull the plug on B. First, let's cleanly disconnect ourselves
$dbhB->disconnect();
sleep 2; ## Design a better system using pg_ping and a timeout
$bct->shutdown_cluster('B');
sleep 5; ## Again, need a better system - have shutdown_cluster take an arg?
## Add a row to A and C again, then kick the syncs
$bct->add_row_to_database('A', 26);
$bct->add_row_to_database('C', 27);
$bct->ctl('bucardo kick sync cts1 0');
$bct->ctl('bucardo kick sync cts2 0');
## D should have the new row
$bct->check_for_row([[25],[27]], [qw/ D/]);
## C should not have the new row
## Bring the dead database back up
$bct->start_cluster('C');
sleep 1; ## better
## B will not have the new row right away
$bct->check_for_row([[22]], [qw/ B /]);
## But once the MCP detects B is back up, the sync should get kicked
sleep 2;
$bct->check_for_row([[22]], [qw/ B /]);
sleep 2;
$bct->ctl('bucardo stop');
done_testing();
Bucardo-5.4.1/t/20-oracle.t0000644000175000017500000002372012563002233013646 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test using Oracle as a database target
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use vars qw/ $bct $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t %pkey $SQL %sth %sql/;
## Must have the DBD::Oracle module
my $evalok = 0;
eval {
require DBD::Oracle;
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => 'Cannot test Oracle unless the Perl module DBD::Oracle is installed');
}
## Oracle must be up and running
$evalok = 0;
my $dbh;
my $dbuser = 'system';
my $dbname = $dbuser;
my $sid = 'o';
my $host = '127.0.0.1';
my $pass = 'abcde';
eval {
$dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $dbuser, $pass,
{AutoCommit=>0, PrintError=>0, RaiseError=>1});
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => "Cannot test Oracle as we cannot connect to a running Oracle database: $@");
}
use BucardoTesting;
## For now, remove some tables that don't work
for my $num (3,5,6,8,10) {
delete $tabletype{"bucardo_test$num"};
}
my $numtabletypes = keys %tabletype;
plan tests => 62;
## Create one table for each table type
for my $table (sort keys %tabletype) {
my $pkeyname = $table =~ /test5/ ? q{"id space"} : 'id';
my $pkindex = $table =~ /test2/ ? '' : 'PRIMARY KEY';
eval {
$dbh->do("DROP TABLE $table");
};
$@ and $dbh->rollback();
$SQL = qq{
CREATE TABLE $table (
$pkeyname $tabletypeoracle{$table} NOT NULL $pkindex};
$SQL .= $table =~ /X/ ? "\n)" : qq{,
data1 NVARCHAR2(100) NULL,
inty SMALLINT NULL,
bite1 BLOB NULL,
bite2 BLOB NULL,
email NVARCHAR2(100) NULL UNIQUE
)
};
$dbh->do($SQL);
if ($table =~ /test2/) {
$dbh->do(qq{ALTER TABLE $table ADD CONSTRAINT "multipk" PRIMARY KEY ($pkeyname,data1)});
}
}
$bct = BucardoTesting->new() or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = 'oracle';
pass("*** Beginning oracle tests");
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
}
## Get Postgres database A and B and C created
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Tell Bucardo about these databases
## Three Postgres databases will be source, source, and target
for my $name (qw/ A B C /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
$t = 'Adding oracle database Q works';
$command =
"bucardo add db Q dbname=$dbuser type=oracle dbuser=$dbuser dbhost=$host conn=sid=$sid dbpass=$pass";
$res = $bct->ctl($command);
like ($res, qr/Added database "Q"/, $t);
## Teach Bucardo about all pushable tables, adding them to a new relgroup named "therd"
$t = q{Adding all tables on the master works};
$command =
"bucardo add tables all db=A relgroup=therd pkonly";
$res = $bct->ctl($command);
like ($res, qr/Creating relgroup: therd.*New tables added: \d/s, $t);
## Add all sequences, and add them to the newly created relgroup
$t = q{Adding all sequences on the master works};
$command =
"bucardo add sequences all db=A relgroup=therd";
$res = $bct->ctl($command);
like ($res, qr/New sequences added: \d/, $t);
## Create a new dbgroup
$t = q{Created a new dbgroup};
$command =
"bucardo add dbgroup qx A:source B:source C Q";
$res = $bct->ctl($command);
like ($res, qr/Created dbgroup "qx"/, $t);
## Create a new sync
$t = q{Created a new sync};
$command =
"bucardo add sync oracle relgroup=therd dbs=qx autokick=false";
$res = $bct->ctl($command);
like ($res, qr/Added sync "oracle"/, $t);
## Create a second sync, solely for multi-sync interaction issues
$bct->ctl('bucardo add dbgroup t1 A:source B C');
$bct->ctl('bucardo add sync tsync1 relgroup=therd dbs=t1 autokick=false status=inactive');
## Start up Bucardo with these new syncs
$bct->restart_bucardo($dbhX);
## Get the statement handles ready for each table type
for my $table (sort keys %tabletype) {
$pkey{$table} = $table =~ /test5/ ? q{"id space"} : 'id';
## INSERT
for my $x (1..6) {
$SQL = $table =~ /X/
? "INSERT INTO $table($pkey{$table}) VALUES (?)"
: "INSERT INTO $table($pkey{$table},data1,inty) VALUES (?,'foo',$x)";
$sth{insert}{$x}{$table}{A} = $dbhA->prepare($SQL);
if ('BYTEA' eq $tabletype{$table}) {
$sth{insert}{$x}{$table}{A}->bind_param(1, undef, {pg_type => PG_BYTEA});
}
}
## SELECT
$sql{select}{$table} = "SELECT inty FROM $table ORDER BY $pkey{$table}";
$table =~ /X/ and $sql{select}{$table} =~ s/inty/$pkey{$table}/;
## DELETE ALL
$SQL = "DELETE FROM $table";
$sth{deleteall}{$table}{A} = $dbhA->prepare($SQL);
## DELETE ONE
$SQL = "DELETE FROM $table WHERE inty = ?";
$sth{deleteone}{$table}{A} = $dbhA->prepare($SQL);
## TRUNCATE
$SQL = "TRUNCATE TABLE $table";
$sth{truncate}{$table}{A} = $dbhA->prepare($SQL);
## UPDATE
$SQL = "UPDATE $table SET inty = ?";
$sth{update}{$table}{A} = $dbhA->prepare($SQL);
}
## Add one row per table type to A
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
}
## Before the commit on A, B and C should be empty
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
$t = qq{B has not received rows for table $table before A commits};
$res = [];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
## Commit, then kick off the sync
$dbhA->commit();
$bct->ctl('bucardo kick oracle 0');
$bct->ctl('bucardo kick oracle 0');
## Check B and C for the new rows
for my $table (sort keys %tabletype) {
my $type = $tabletype{$table};
$t = qq{Row with pkey of type $type gets copied to B};
$res = [[1]];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
## Check that Oracle has the new rows
for my $table (sort keys %tabletype) {
$t = "Oracle table $table has correct number of rows after insert";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
#is ($count, 1, $t);
$t = "Oracle table $table has correct entries";
my $info = $sth->fetchall_arrayref({})->[0];
my $type = $tabletype{$table};
my $id = $val{$type}{1};
my $pkeyname = $table =~ /test5/ ? 'ID SPACE' : 'ID';
## Datetime has no time zone thingy at the end
$tabletypeoracle{$table} =~ /DATETIME/ and $id =~ s/\+.*//;
is_deeply(
$info,
{
$pkeyname => $id,
INTY => 1,
EMAIL => undef,
BITE1 => undef,
BITE2 => undef,
DATA1 => 'foo',
},
$t);
}
## Update each row
for my $table (keys %tabletype) {
$sth{update}{$table}{A}->execute(42);
}
$dbhA->commit();
$bct->ctl('bucardo kick oracle 0');
for my $table (keys %tabletype) {
$t = "Oracle table $table has correct number of rows after update";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
#is ($count, 1, $t);
$t = "Oracle table $table has updated value";
my $info = $sth->fetchall_arrayref({})->[0];
is ($info->{INTY}, 42, $t);
}
## Delete each row
for my $table (keys %tabletype) {
$sth{deleteall}{$table}{A}->execute();
}
$dbhA->commit();
$bct->ctl('bucardo kick oracle 0');
for my $table (keys %tabletype) {
$t = "Oracle table $table has correct number of rows after delete";
$SQL = "SELECT * FROM $table";
my $sth = $dbh->prepare($SQL);
(my $count = $sth->execute()) =~ s/0E0/0/;
$sth->finish();
is ($count, 0, $t);
}
## Insert two rows, then delete one of them
## Add one row per table type to A
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
my $val2 = $val{$type}{2};
$sth{insert}{2}{$table}{A}->execute($val2);
}
$dbhA->commit();
$bct->ctl('bucardo kick oracle 0');
for my $table (keys %tabletype) {
$t = "Oracle table $table has correct number of rows after double insert";
$SQL = "SELECT count(*) FROM $table";
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $count = $sth->fetchall_arrayref()->[0][0];
is ($count, 2, $t);
}
## Delete one of the rows
for my $table (keys %tabletype) {
$sth{deleteone}{$table}{A}->execute(2); ## inty = 2
}
$dbhA->commit();
$bct->ctl('bucardo kick oracle 0');
for my $table (keys %tabletype) {
$t = "Oracle table $table has correct number of rows after single deletion";
$SQL = "SELECT count(*) FROM $table";
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $count = $sth->fetchall_arrayref()->[0][0];
is ($count, 1, $t);
}
## Insert two more rows, then truncate
for my $table (keys %tabletype) {
my $type = $tabletype{$table};
my $val3 = $val{$type}{3};
$sth{insert}{3}{$table}{A}->execute($val3);
my $val4 = $val{$type}{4};
$sth{insert}{4}{$table}{A}->execute($val4);
}
$dbhA->commit();
$bct->ctl('bucardo kick oracle 0');
for my $table (keys %tabletype) {
$t = "Oracle table $table has correct number of rows after more inserts";
$SQL = "SELECT count(*) FROM $table";
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $count = $sth->fetchall_arrayref()->[0][0];
is ($count, 3, $t);
}
$dbh->disconnect();
pass 'Finished Oracle tests';
exit;
Bucardo-5.4.1/t/01-basic.t0000644000175000017500000000301212563002233013451 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Basic tests of Things That Should Always Work
## Any failures of important files immediately call BAIL_OUT
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use Test::More;
use BucardoTesting;
my @important_files = qw{Bucardo.pm bucardo };
opendir my $dh, 't' or die qq{Could not open the 't' directory: are you running this from the right place?\n};
my @test_files = grep { /\.t$/ } readdir $dh;
closedir $dh or warn qq{Could not close the 't' directory: $!\n};
opendir $dh, 'scripts' or die qq{Could not open the 'scripts' directory};
my @script_files = grep { /^[a-z]/ } readdir $dh;
closedir $dh or warn qq{Could not close the 'scripts' directory: $!\n};
if (! eval { require CGI; } ) {
@script_files = grep { ! /bucardo-report/ } @script_files;
}
plan tests => @important_files + @test_files + @script_files;
for my $file (@important_files) {
my $t=qq{File $file compiles without errors};
eval {
require $file;
};
is($@, q{}, $t);
$@ and BAIL_OUT qq{Cannot continue until $file compiles cleanly\n};
}
for my $file (@test_files) {
my $t=qq{File $file compiles without errors};
my $com = "perl -c t/$file 2>&1";
my $res = qx{$com};
chomp $res;
is($res, qq{t/$file syntax OK}, $t);
}
for my $file (@script_files) {
my $t=qq{File $file compiles without errors};
my $com = "perl -c scripts/$file 2>&1";
my $res = qx{$com};
chomp $res;
is($res, qq{scripts/$file syntax OK}, $t);
}
exit;
Bucardo-5.4.1/t/98-cleanup.t0000644000175000017500000000246512563002233014052 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Cleanup any mess we made
use 5.008003;
use strict;
use warnings;
use Test::More;
use File::Path 'rmtree';
if ($ENV{BUCARDO_NOCLEANUP}) {
diag 'Skipping cleanup because BUCARDO_NOCLEANUP is set';
done_testing();
exit;
}
opendir my $dh, '.' or die qq{Could not opendir?: $!\n};
for my $dir (readdir $dh) {
next if $dir !~ /^bucardo_test_database_[A-Z]/ or ! -d $dir;
my $pidfile = "$dir/postmaster.pid";
if (-e $pidfile) {
open my $fh, '<', $pidfile or die qq{Could not open "$pidfile": $!\n};
<$fh> =~ /^(\d+)/ or die qq{File "$pidfile" did not start with a number!\n};
my $pid = $1;
close $fh or die qq{Could not close "$pidfile": $!\n};
kill 15 => $pid;
sleep 1;
if (kill 0 => $pid) {
kill 9 => $pid;
}
}
rmtree($dir);
}
pass 'Test databases are shut down';
my $dir = "/tmp/bucardo_testing_$ENV{USER}";
if (-d $dir) {
opendir my $dh, $dir or die qq{Could not open directory "$dir": $!\n};
for my $file (grep { /^\w/ } readdir($dh)) {
unlink "$dir/$file";
}
closedir $dh or die qq{Could not open directory "$dir": $!\n};
rmdir $dir;
}
pass "Removed directory $dir";
unlink ;
done_testing();
exit;
Bucardo-5.4.1/t/20-mariadb.t0000644000175000017500000002712112601642760014007 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Test using MariaDB as a database target
## It should be a dropin for MySQL, but we break it out just in case
use 5.008003;
use strict;
use warnings;
use Data::Dumper;
use lib 't','.';
use DBD::Pg;
use Test::More;
use MIME::Base64;
use vars qw/ $bct $dbhX $dbhA $dbhB $dbhC $dbhD $res $command $t %pkey $SQL %sth %sql/;
## Must have the DBD::mysql module
my $evalok = 0;
eval {
require DBD::mysql;
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => 'Cannot test MariaDB unless the Perl module DBD::mysql is installed');
}
## MariaDB must be up and running
$evalok = 0;
my $dbh;
my $dbuser = 'root';
eval {
$dbh = DBI->connect('dbi:mysql:database=test', $dbuser, '',
{AutoCommit=>1, PrintError=>0, RaiseError=>1});
$evalok = 1;
};
if (!$evalok) {
plan (skip_all => "Cannot test MariaDB as we cannot connect to a running MariaDB database");
}
## Need to ensure this is really MariaDB, not MySQL
my $ver = $dbh->selectall_arrayref('SELECT version()')->[0][0];
if ($ver !~ /MariaDB/) {
plan (skip_all => "Cannot test MariaDB: MySQL port is being used by MySQL");
}
use BucardoTesting;
## For now, remove the bytea table type as we don't have full support yet
delete $tabletypemariadb{bucardo_test8};
my $numtabletypes = keys %tabletypemariadb;
plan tests => 151;
## Drop the test database if it exists
my $dbname = 'bucardo_test';
eval {
$dbh->do("DROP DATABASE $dbname");
};
## Create the test database
$dbh->do("CREATE DATABASE $dbname");
## Reconnect to the new database
$dbh = DBI->connect("dbi:mysql:database=$dbname", $dbuser, '',
{AutoCommit=>1, PrintError=>0, RaiseError=>1});
## Yes, this must be turned on manually!
$dbh->do("SET sql_mode='ANSI_QUOTES'");
## Create one table for each table type
for my $table (sort keys %tabletypemariadb) {
my $pkeyname = $table =~ /test5/ ? q{"id space"} : 'id';
my $pkindex = $table =~ /test2/ ? '' : 'PRIMARY KEY';
$SQL = qq{
CREATE TABLE "$table" (
$pkeyname $tabletypemariadb{$table} NOT NULL $pkindex};
$SQL .= $table =~ /X/ ? "\n)" : qq{,
data1 VARCHAR(100) NULL,
inty SMALLINT NULL,
booly BOOLEAN NULL, -- Alias for TINYINT
bite1 VARBINARY(999) NULL,
bite2 VARBINARY(999) NULL,
email VARCHAR(100) NULL UNIQUE
)
};
$dbh->do($SQL);
if ($table =~ /test2/) {
$dbh->do(qq{ALTER TABLE "$table" ADD CONSTRAINT multipk PRIMARY KEY ($pkeyname,data1)});
}
}
$bct = BucardoTesting->new() or BAIL_OUT "Creation of BucardoTesting object failed\n";
$location = 'mariadb';
pass("*** Beginning MariaDB tests");
END {
$bct and $bct->stop_bucardo($dbhX);
$dbhX and $dbhX->disconnect();
$dbhA and $dbhA->disconnect();
$dbhB and $dbhB->disconnect();
$dbhC and $dbhC->disconnect();
$dbhD and $dbhD->disconnect();
}
## Get Postgres database A and B and C created
$dbhA = $bct->repopulate_cluster('A');
$dbhB = $bct->repopulate_cluster('B');
$dbhC = $bct->repopulate_cluster('C');
## Create a bucardo database, and install Bucardo into it
$dbhX = $bct->setup_bucardo('A');
## Tell Bucardo about these databases
## Three Postgres databases will be source, source, and target
for my $name (qw/ A B C /) {
$t = "Adding database from cluster $name works";
my ($dbuser,$dbport,$dbhost) = $bct->add_db_args($name);
$command = "bucardo add db $name dbname=bucardo_test user=$dbuser port=$dbport host=$dbhost";
$res = $bct->ctl($command);
like ($res, qr/Added database "$name"/, $t);
}
$t = 'Adding mariadb database Q works';
$command =
"bucardo add db Q dbname=$dbname type=mariadb dbuser=$dbuser";
$res = $bct->ctl($command);
like ($res, qr/Added database "Q"/, $t);
## Teach Bucardo about all pushable tables, adding them to a new relgroup named "therd"
$t = q{Adding all tables on the master works};
$command =
"bucardo add tables all db=A relgroup=therd pkonly";
$res = $bct->ctl($command);
like ($res, qr/Creating relgroup: therd.*New tables added: \d/s, $t);
## Add all sequences, and add them to the newly created relgroup
$t = q{Adding all sequences on the master works};
$command =
"bucardo add sequences all db=A relgroup=therd";
$res = $bct->ctl($command);
like ($res, qr/New sequences added: \d/, $t);
## Create a new dbgroup
$t = q{Created a new dbgroup};
$command =
"bucardo add dbgroup qx A:source B:source C Q";
$res = $bct->ctl($command);
like ($res, qr/Created dbgroup "qx"/, $t);
## Create a new sync
$t = q{Created a new sync};
$command =
"bucardo add sync mariadb relgroup=therd dbs=qx autokick=false";
$res = $bct->ctl($command);
like ($res, qr/Added sync "mariadb"/, $t);
## Create a second sync, solely for multi-sync interaction issues
$bct->ctl('bucardo add dbgroup t1 A:source B C');
$bct->ctl('bucardo add sync tsync1 relgroup=therd dbs=t1 autokick=false status=inactive');
## Start up Bucardo with these new syncs
$bct->restart_bucardo($dbhX);
## Boolean values
my (@boolys) = qw( xxx true false null false true null );
## Get the statement handles ready for each table type
for my $table (sort keys %tabletypemariadb) {
$pkey{$table} = $table =~ /test5/ ? q{"id space"} : 'id';
## INSERT
for my $x (1..6) {
$SQL = $table =~ /X/
? qq{INSERT INTO "$table"($pkey{$table}) VALUES (?)}
: qq{INSERT INTO "$table"($pkey{$table},data1,inty,booly) VALUES (?,'foo',$x,$boolys[$x])};
$sth{insert}{$x}{$table}{A} = $dbhA->prepare($SQL);
if ('BYTEA' eq $tabletypemariadb{$table}) {
$sth{insert}{$x}{$table}{A}->bind_param(1, undef, {pg_type => PG_BYTEA});
}
}
## SELECT
$sql{select}{$table} = qq{SELECT inty, booly FROM "$table" ORDER BY $pkey{$table}};
$table =~ /X/ and $sql{select}{$table} =~ s/inty/$pkey{$table}/;
## DELETE ALL
$SQL = qq{DELETE FROM "$table"};
$sth{deleteall}{$table}{A} = $dbhA->prepare($SQL);
## DELETE ONE
$SQL = qq{DELETE FROM "$table" WHERE inty = ?};
$sth{deleteone}{$table}{A} = $dbhA->prepare($SQL);
## TRUNCATE
$SQL = qq{TRUNCATE TABLE "$table"};
$sth{truncate}{$table}{A} = $dbhA->prepare($SQL);
## UPDATE
$SQL = qq{UPDATE "$table" SET inty = ?};
$sth{update}{$table}{A} = $dbhA->prepare($SQL);
}
## Add one row per table type to A
for my $table (keys %tabletypemariadb) {
my $type = $tabletypemariadb{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
}
## Before the commit on A, B, C, and Q should be empty
for my $table (sort keys %tabletypemariadb) {
my $type = $tabletypemariadb{$table};
$t = qq{B has not received rows for table $table before A commits};
$res = [];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
bc_deeply($res, $dbh, $sql{select}{$table}, $t);
}
## Commit, then kick off the sync
$dbhA->commit();
$bct->ctl('bucardo kick mariadb 0');
$bct->ctl('bucardo kick mariadb 0');
## Check B and C for the new rows
for my $table (sort keys %tabletypemariadb) {
my $type = $tabletypemariadb{$table};
$t = qq{Row with pkey of type $type gets copied to B};
$res = [[1,1]];
bc_deeply($res, $dbhB, $sql{select}{$table}, $t);
bc_deeply($res, $dbhC, $sql{select}{$table}, $t);
}
## Check that MariaDB has the new rows
for my $table (sort keys %tabletypemariadb) {
$t = "MariaDB table $table has correct number of rows after insert";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
is ($count, 1, $t);
$t = "MariaDB table $table has correct entries";
my $info = $sth->fetchall_arrayref({})->[0];
my $type = $tabletypemariadb{$table};
my $id = $val{$type}{1};
my $pkeyname = $table =~ /test5/ ? 'id space' : 'id';
## For now, binary is stored in escaped form, so we skip this one
next if $table =~ /test8/;
## Datetime has no time zone thingy at the end
$tabletypemariadb{$table} =~ /DATETIME/ and $id =~ s/\+.*//;
is_deeply(
$info,
{
$pkeyname => $id,
inty => 1,
booly => 1,
email => undef,
bite1 => undef,
bite2 => undef,
data1 => 'foo',
},
$t);
}
## Update each row
for my $table (keys %tabletypemariadb) {
$sth{update}{$table}{A}->execute(42);
}
$dbhA->commit();
$bct->ctl('bucardo kick mariadb 0');
for my $table (keys %tabletypemariadb) {
$t = "MariaDB table $table has correct number of rows after update";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
is ($count, 1, $t);
$t = "MariaDB table $table has updated value";
my $info = $sth->fetchall_arrayref({})->[0];
is ($info->{inty}, 42, $t);
}
## Delete each row
for my $table (keys %tabletypemariadb) {
$sth{deleteall}{$table}{A}->execute();
}
$dbhA->commit();
$bct->ctl('bucardo kick mariadb 0');
for my $table (keys %tabletypemariadb) {
$t = "MariaDB table $table has correct number of rows after delete";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
(my $count = $sth->execute()) =~ s/0E0/0/;
$sth->finish();
is ($count, 0, $t);
}
## Insert two rows, then delete one of them
## Add one row per table type to A
for my $table (keys %tabletypemariadb) {
my $type = $tabletypemariadb{$table};
my $val1 = $val{$type}{1};
$sth{insert}{1}{$table}{A}->execute($val1);
my $val2 = $val{$type}{2};
$sth{insert}{2}{$table}{A}->execute($val2);
}
$dbhA->commit();
$bct->ctl('bucardo kick mariadb 0');
for my $table (keys %tabletypemariadb) {
$t = "MariaDB table $table has correct number of rows after double insert";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
$sth->finish();
is ($count, 2, $t);
}
## Delete one of the rows
for my $table (keys %tabletypemariadb) {
$sth{deleteone}{$table}{A}->execute(2); ## inty = 2
}
$dbhA->commit();
$bct->ctl('bucardo kick mariadb 0');
for my $table (keys %tabletypemariadb) {
$t = "MariaDB table $table has correct number of rows after single deletion";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
$sth->finish();
is ($count, 1, $t);
}
## Insert two more rows
for my $table (keys %tabletypemariadb) {
my $type = $tabletypemariadb{$table};
my $val3 = $val{$type}{3};
$sth{insert}{3}{$table}{A}->execute($val3);
my $val4 = $val{$type}{4};
$sth{insert}{4}{$table}{A}->execute($val4);
}
$dbhA->commit();
$bct->ctl('bucardo kick mariadb 0');
for my $table (keys %tabletypemariadb) {
$t = "MariaDB table $table has correct number of rows after more inserts";
$SQL = qq{SELECT * FROM "$table"};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
is ($count, 3, $t);
$t = "MariaDB table $table has updated values";
my $info = $sth->fetchall_arrayref({});
$info = [ sort { $a->{inty} <=> $b->{inty} } @$info ];
my ($val1, $val3, $val4) = @{$val{$tabletypemariadb{$table}}}{1, 3, 4};
my $pkeyname = $table =~ /test5/ ? 'id space' : 'id';
my(@invar) = ( data1 => 'foo', 'email' => undef, bite1 => undef, bite2 => undef );
is_deeply ($info, [{ $pkeyname=>$val1, inty=>1, booly=>1, @invar },
{ $pkeyname=>$val3, inty=>3, booly=>undef, @invar },
{ $pkeyname=>$val4, inty=>4, booly=>0, @invar }], $t) || diag explain $info;
$sth->finish();
}
exit;
Bucardo-5.4.1/t/40-serializable.t0000644000175000017500000001147012563002233015050 0ustar greggreg#!/usr/bin/perl -w
use strict;
use warnings;
use lib 't';
use Test::More;
use BucardoTesting;
use Data::Dumper;
my $bct = BucardoTesting->new({location => 'postgres'})
or BAIL_OUT 'Creation of BucardoTesting object failed';
END { $bct->stop_bucardo if $bct }
my $dbh = $bct->empty_cluster('A');
END { $dbh->disconnect if $dbh }
# Skip the tests if we can't mock the serialization failure.
plan skip_all => "Cannot mock serialization failure on Postgres $dbh->{pg_server_version}"
if $dbh->{pg_server_version} < 80400;
# We are a go!
plan tests => 45;
$dbh->disconnect;
$dbh = undef;
ok my $dbhA = $bct->repopulate_cluster('A'), 'Populate cluster A';
ok my $dbhB = $bct->repopulate_cluster('B'), 'Populate cluster B';
ok my $dbhX = $bct->setup_bucardo('A'), 'Set up Bucardo';
END { $_->disconnect for grep { $_ } $dbhA, $dbhB, $dbhX }
# Teach Bucardo about the databases.
for my $db (qw(A B)) {
my ($user, $port, $host) = $bct->add_db_args($db);
like $bct->ctl(
"bucardo add db $db dbname=bucardo_test user=$user port=$port host=$host"
), qr/Added database "$db"/, qq{Add database "$db" to Bucardo};
}
# Let's just deal with table bucardo_test1 and bucardo_test2.
for my $num (1, 2) {
like $bct->ctl("bucardo add table bucardo_test$num db=A relgroup=myrels"),
qr/Added the following tables/, "Add table bucardo_test$num";
}
# Create a new dbgroup going from A to B
like $bct->ctl('bucardo add dbgroup serial1 A:source B:target'),
qr/Created dbgroup "serial1"/, 'Create relgroup serial1';
# Create a sync for this group.
like $bct->ctl('bucardo add sync serialtest1 relgroup=myrels dbs=serial1'),
qr/Added sync "serialtest1"/, 'Create sync "serialtest1"';
# Set up a rule to mock a serialization failure on B.bucardo_test2.
ok $bct->mock_serialization_failure($dbhB, 'bucardo_test2'),
'Mock serialization failure on bucardo_test2';
END {
$bct->unmock_serialization_failure($dbhB, 'bucardo_test2')
if $bct && $dbhB;
}
# Listen in on things.
ok $dbhX->do('LISTEN bucardo_syncdone_serialtest1'),
'Listen for syncdone';
ok $dbhX->do('LISTEN bucardo_syncsleep_serialtest1'),
'Listen for syncsleep';
# Start up Bucardo.
ok $bct->restart_bucardo($dbhX), 'Bucardo should start';
ok $bct->wait_for_notice($dbhX, 'bucardo_syncdone_serialtest1'),
'The sync should finish';
# Should have no rows.
$bct->check_for_row([], [qw(A B)], undef, 'test[12]$');
# Make sure the sync was recorded.
ok my $runs = $dbhX->selectall_arrayref(
'SELECT * FROM syncrun ORDER BY started',
{ Slice => {} },
), 'Get list of syncruns';
is @{ $runs }, 1, 'Should have one syncrun';
ok $runs->[0]{ended}, 'It should have an "ended" value';
ok $runs->[0]{lastempty}, 'It should be marked "last empty"';
like $runs->[0]{status}, qr/^No delta rows found/,
'Its status should be "No delta rows found"';
# Let's add some data into A.bucardo_test1.
$dbhX->commit;
ok $dbhA->do(q{INSERT INTO bucardo_test1 (id, data1) VALUES (1, 'foo')}),
'Insert a row into test1';
$dbhA->commit;
ok $bct->wait_for_notice($dbhX, 'bucardo_syncdone_serialtest1'),
'Second sync should finish';
# The row should be in both databases.
is_deeply $dbhB->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test1'
), [[1, 'foo']], 'Should have the test1 row in B';
# Should have two syncrun records now.
ok $runs = $dbhX->selectall_arrayref(
'SELECT * FROM syncrun ORDER BY started',
{ Slice => {} },
), 'Get list of syncruns';
is @{ $runs }, 2, 'Should have two syncruns';
ok $runs->[1]{ended}, 'New run should have an "ended" value';
ok $runs->[1]{lastgood}, 'It should be marked "last good"';
like $runs->[1]{status}, qr/^Complete/, 'Its status should be "Complete"';
# Excellent. Now let's insert into test2.
$dbhX->commit;
ok $dbhA->do(q{INSERT INTO bucardo_test2 (id, data1) VALUES (2, 'foo')}),
'Insert a row into test2';
$dbhA->commit;
ok $bct->wait_for_notice($dbhX, 'bucardo_syncsleep_serialtest1'),
'Should get a syncsleep message';
ok $bct->wait_for_notice($dbhX, 'bucardo_syncdone_serialtest1'),
'Then the third sync should finish';
is_deeply $dbhB->selectall_arrayref(
'SELECT id, data1 FROM bucardo_test2'
), [[2, 'foo']], 'Should have the B test2 row despite serialization failure';
# Should have four syncrun records now.
ok $runs = $dbhX->selectall_arrayref(
'SELECT * FROM syncrun ORDER BY started',
{ Slice => {} },
), 'Get list of syncruns';
is @{ $runs }, 4, 'Should have four syncruns';
ok $runs->[2]{ended}, 'Third run should have an "ended" value';
ok $runs->[2]{lastbad}, 'Third run should be marked "last bad"';
like $runs->[2]{status}, qr/^Failed/, 'Third run status should be "Bad"';
ok $runs->[3]{ended}, 'Fourth run should have an "ended" value';
ok $runs->[3]{lastgood}, 'Fourth run should be marked "last good"';
like $runs->[3]{status}, qr/^Complete/, 'Fourth run status should be "Complete"';
Bucardo-5.4.1/t/customcode.exception.bucardotest.pl0000644000175000017500000000444212427203642021020 0ustar greggreg#! perl
## Sample exception handler
## For this example, we will fix unique violations on an email column
use strict;
use warnings;
use Data::Dumper;
my $info = shift;
## Do nothing unless this is the exact error we were designed to handle
return if $info->{error_string} !~ /violates unique constraint "employee_email_key"/o;
## Grab all the primary keys involved in the sync
my %pk;
for my $dbname ( keys %{ $info->{deltabin} }) {
for my $pkey (keys %{ $info->{deltabin}{$dbname} }) {
$pk{$pkey}++;
}
}
## Very unlikely to happen, but we will check anyway:
if (! keys %pk) {
$info->{warning} = 'No database records found!';
return;
}
## We need to get information from every database on each involved record
my $SQL = sprintf 'SELECT id,email FROM employee WHERE id IN (%s)',
(join ',' => sort keys %pk);
## Emails must be unique, so each must be associated with only one primary key (id)
my %emailpk;
## This is in the preferred order of databases
## Thus, any "conflicts" means A > B > C
for my $db (qw/ A B C /) {
my $dbh = $info->{dbh}{$db};
my $sth = $dbh->prepare($SQL);
$sth->execute();
my $rows = $sth->fetchall_arrayref();
for my $row (@$rows) {
my ($id,$email) = @$row;
## This a new email? All is good, just move on
if (! exists $emailpk{$email}) {
$emailpk{$email} = [$id, $db];
next;
}
## This email already exists. If the same PK, no problem
my ($oldid,$olddb) = @{ $emailpk{$email} };
if ($oldid == $id) {
next;
}
## We have the same email with different PKs! Time to get busy
$info->{message} .= "Found problem with email $email. ";
$info->{message} .= "Exists as PK $oldid on db $olddb, but as PK $id on $db!";
## Store it away in a separate table
my $SQL = 'INSERT INTO employee_conflict SELECT * FROM employee WHERE id = ?';
$sth = $dbh->prepare($SQL);
$sth->execute($id);
## Now delete it from this database!
$SQL = 'DELETE FROM employee WHERE id = ?';
$sth = $dbh->prepare($SQL);
$sth->execute($id);
## Note: we do not want to commit (and it is disallowed by DBIx::Safe)
}
}
## Let's retry now that things are cleaned up!
$info->{retry} = 1;
return;
Bucardo-5.4.1/Bucardo.pm.html0000644000175000017500000000465312601643143014422 0ustar greggreg
Bucardo - Postgres multi-master replication system
VERSION
This document describes version 5.4.1 of Bucardo
WEBSITE
The latest news and documentation can always be found at:
http://bucardo.org/
DESCRIPTION
Bucardo is a Perl module that replicates Postgres databases using a combination of Perl, a custom database schema, Pl/Perlu, and Pl/Pgsql.
Bucardo is unapologetically extremely verbose in its logging.
Full documentation can be found on the website, or in the files that came with this distribution. See also the documentation for the bucardo program.
DEPENDENCIES
DBI (1.51 or better)
DBD::Pg (2.0.0 or better)
Sys::Hostname
Sys::Syslog
DBIx::Safe ## Try 'yum install perl-DBIx-Safe' or visit bucardo.org
boolean
BUGS
Bugs should be reported to bucardo-general@bucardo.org. A list of bugs can be found at http://bucardo.org/bugs.html
CREDITS
Bucardo was originally developed and funded by Backcountry.com, who have been using versions of it in production since 2002. Jon Jensen <jon@endpoint.com> wrote the original version.
This software is free to use: see the LICENSE file for details.
Bucardo-5.4.1/README0000644000175000017500000000216212601643216012414 0ustar greggreg
Bucardo - a table-based replication system
DESCRIPTION:
------------
This is version 5.4.1 of Bucardo.
COPYRIGHT:
----------
Copyright (c) 2005-2015 Greg Sabino Mullane
REQUIREMENTS:
-------------
build, test, and install Perl 5 (at least 5.8.3)
build, test, and install Postgres (at least 8.2)
build, test, and install the DBI module (at least 1.51)
build, test, and install the DBD::Pg module (at least 2.0.0)
build, test, and install the DBIx::Safe module (at least 1.2.4)
You must have at least one database that has Pl/Pgsql and Pl/Perl installed.
Target databases may need Pl/Pgsql.
INSTALLATION:
-------------
To install this module type the following:
perl Makefile.PL
make
make test (but see below first)
make install
EXAMPLES:
---------
See the test suite in the t/ subdirectory for some examples.
WEBSITE:
-------
Please visit http://bucardo.org for complete documentation.
DEVELOPMENT:
------------
To follow or participate in the development of Bucardo, use:
git clone git://bucardo.org/bucardo.git/
Bucardo-5.4.1/bucardo.schema0000644000175000017500000030361112601643152014337 0ustar greggreg
-- Schema for the main Bucardo database
-- Version 5.4.1
-- Should be run as a superuser
-- This should not need to be run directly: use either
-- bucardo install
-- or
-- bucardo upgrade
\set ON_ERROR_STOP off
-- Create the bucardo user and database if they don't already exist
SET client_min_messages = 'FATAL';
CREATE USER bucardo SUPERUSER;
CREATE DATABASE bucardo OWNER bucardo;
\c bucardo bucardo
-- Create the base bucardo schema and languages
SET client_min_messages = 'FATAL';
CREATE LANGUAGE plpgsql;
CREATE LANGUAGE plperlu;
CREATE SCHEMA bucardo;
ALTER DATABASE bucardo SET search_path = bucardo, public;
SET standard_conforming_strings = 'ON';
-- The above were allowed to fail, because there is no harm if the objects
-- already existed. From this point forward however, we suffer no errors
\set ON_ERROR_STOP on
BEGIN;
SET client_min_messages = 'WARNING';
SET search_path TO bucardo;
SET escape_string_warning = 'OFF';
-- Try and create a plperlu function, then call it at the very end
-- Do not change this string, as the bucardo program parses it
CREATE OR REPLACE FUNCTION bucardo.plperlu_test()
RETURNS TEXT
LANGUAGE plperlu
AS $bc$
return 'Pl/PerlU was successfully installed';
$bc$;
--
-- Main bucardo configuration information
--
CREATE TABLE bucardo.bucardo_config (
name TEXT NOT NULL, -- short unique name, maps to %config inside Bucardo
setting TEXT NOT NULL,
about TEXT NULL, -- long description
type TEXT NULL, -- sync or goat
item TEXT NULL, -- which specific sync or goat
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.bucardo_config IS $$Contains configuration variables for a specific Bucardo instance$$;
CREATE UNIQUE INDEX bucardo_config_unique ON bucardo.bucardo_config(LOWER(name)) WHERE item IS NULL;
CREATE UNIQUE INDEX bucardo_config_unique_name ON bucardo.bucardo_config(name,item,type) WHERE item IS NOT NULL;
ALTER TABLE bucardo.bucardo_config ADD CONSTRAINT valid_config_type CHECK (type IN ('sync','goat'));
ALTER TABLE bucardo.bucardo_config ADD CONSTRAINT valid_config_isolation_level
CHECK (name <> 'isolation_level' OR (setting IN ('serializable','repeatable read')));
CREATE FUNCTION bucardo.check_bucardo_config()
RETURNS TRIGGER
LANGUAGE plpgsql
AS $bc$
BEGIN
NEW.setting = LOWER(NEW.setting);
IF (NEW.type IS NOT NULL and NEW.item IS NULL) THEN
RAISE EXCEPTION 'Must provide a specific %', NEW.type;
END IF;
IF (NEW.item IS NOT NULL and NEW.type IS NULL) THEN
RAISE EXCEPTION 'Must provide a type if giving a name';
END IF;
IF (NEW.name = 'sync' OR NEW.name = 'goat') THEN
RAISE EXCEPTION 'Invalid configuration name';
END IF;
RETURN NEW;
END;
$bc$;
COMMENT ON FUNCTION bucardo.check_bucardo_config() IS $$Basic sanity checks for configuration items$$;
CREATE TRIGGER check_bucardo_config
BEFORE INSERT OR UPDATE ON bucardo.bucardo_config
FOR EACH ROW EXECUTE PROCEDURE bucardo.check_bucardo_config();
-- Sleep times (all in seconds)
COPY bucardo.bucardo_config("name",setting,about)
FROM STDIN
WITH DELIMITER '|';
mcp_loop_sleep|0.2|How long does the main MCP daemon sleep between loops?
mcp_dbproblem_sleep|15|How many seconds to sleep before trying to respawn
mcp_vactime|60|How often in seconds do we check that a VAC is still running?
ctl_sleep|0.2|How long does the controller loop sleep?
kid_sleep|0.5|How long does a kid loop sleep?
kid_nodeltarows_sleep|0.5|How long do kids sleep if no delta rows are found?
kid_serial_sleep|0.5|How long to sleep in seconds if we hit a serialization error
kid_deadlock_sleep|0.5|How long to sleep in seconds if we hit a deadlock error
kid_restart_sleep|1|How long to sleep in seconds when restarting a kid?
endsync_sleep|1.0|How long do we sleep when custom code requests an endsync?
vac_sleep|120|How long does VAC process sleep between runs?
vac_run|30|How often does the VAC process run?
\.
-- Various timeouts (times are in seconds)
COPY bucardo.bucardo_config("name",setting,about)
FROM STDIN
WITH DELIMITER '|';
mcp_pingtime|60|How often do we ping check the MCP?
kid_pingtime|60|How often do we ping check the KID?
ctl_checkonkids_time|10|How often does the controller check on the kids health?
ctl_createkid_time|0.5|How long do we sleep to allow kids-on-demand to get on their feet?
tcp_keepalives_idle|0|How long to wait between each keepalive probe.
tcp_keepalives_interval|0|How long to wait for a response to a keepalive probe.
tcp_keepalives_count|0|How many probes to send. 0 indicates sticking with system defaults.
reload_config_timeout|30|How long to wait for reload_config to finish.
\.
-- Logging
COPY bucardo.bucardo_config(name,setting,about)
FROM STDIN
WITH DELIMITER '|';
log_microsecond|0|Show microsecond output in the timestamps?
log_showpid|1|Show PID in the log output?
log_showlevel|0|Show log level in the log output?
log_showline|0|Show line number in the log output?
log_showtime|3|Show timestamp in the log output? 0=off 1=seconds since epoch 2=scalar gmtime 3=scalar localtime
log_conflict_file|bucardo_conflict.log|Name of the conflict detail log file
log_showsyncname|1|Show the name of the sync next to the 'KID' prefix
log_level|NORMAL|How verbose to make the logging. Higher is more verbose.
warning_file|bucardo.warning.log|File containing all log lines starting with "Warning"
\.
-- Versioning
COPY bucardo.bucardo_config(name,setting,about)
FROM STDIN
WITH DELIMITER '|';
bucardo_initial_version|5.4.1|Bucardo version this schema was created with
bucardo_version|5.4.1|Current version of Bucardo
\.
-- Other settings:
COPY bucardo.bucardo_config(name,setting,about)
FROM STDIN
WITH DELIMITER '|';
bucardo_vac|1|Do we want the automatic VAC daemon to run?
default_email_from|nobody@example.com|Who the alert emails are sent as
default_email_to|nobody@example.com|Who to send alert emails to
default_email_host|localhost|Which host to send email through
default_email_port|25|Which port to send email through
default_conflict_strategy|bucardo_latest|Default conflict strategy for all syncs
email_debug_file||File to save a copy of all outgoing emails to
email_auth_user||User to use for email authentication via Net::SMTP
email_auth_pass||Password to use for email authentication via Net::SMTP
flatfile_dir|.|Directory to store the flatfile output inside of
host_safety_check||Regex to make sure we don't accidentally run where we should not
isolation_level|repeatable read|Default isolation level: can be serializable or repeatable read
piddir|/var/run/bucardo|Directory holding Bucardo PID files
quick_delta_check|1|Whether to do a quick scan of delta activity
reason_file|bucardo.restart.reason.txt|File to hold reasons for stopping and starting
semaphore_table|bucardo_status|Table to let apps know a sync is ongoing
statement_chunk_size|8000|How many primary keys to shove into a single statement
stats_script_url|http://www.bucardo.org/|Location of the stats script
stopfile|fullstopbucardo|Name of the semaphore file used to stop Bucardo processes
syslog_facility|LOG_LOCAL1|Which syslog facility level to use
\.
-- Unused at the moment:
COPY bucardo.bucardo_config(name,setting,about)
FROM STDIN
WITH DELIMITER '|';
autosync_ddl|newcol|Which DDL changing conditions do we try to remedy automatically?
\.
--
-- Keep track of every database we need to connect to
--
CREATE TABLE bucardo.db (
name TEXT NOT NULL, -- local name for convenience, not necessarily database name
CONSTRAINT db_name_pk PRIMARY KEY (name),
dbtype TEXT NOT NULL DEFAULT 'postgres',
dbhost TEXT NULL DEFAULT '',
dbport TEXT NULL DEFAULT '',
dbname TEXT NULL, -- the actual name of the database, not the primary key 'local' name
dbuser TEXT NULL,
dbpass TEXT NULL,
dbconn TEXT NOT NULL DEFAULT '', -- string to add to the generated dsn
dbservice TEXT NULL DEFAULT '',
pgpass TEXT NULL, -- local file with connection info same as pgpass
status TEXT NOT NULL DEFAULT 'active',
server_side_prepares BOOLEAN NOT NULL DEFAULT true,
makedelta BOOLEAN NOT NULL DEFAULT false,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.db IS $$Holds information about each database used in replication$$;
ALTER TABLE bucardo.db ADD CONSTRAINT db_status CHECK (status IN ('active','inactive','stalled'));
ALTER TABLE bucardo.db ADD CONSTRAINT db_service_valid CHECK (dbservice IS NOT NULL OR dbname IS NOT NULL AND dbuser IS NOT NULL AND dbhost IS NOT NULL AND dbport IS NOT NULL);
--
-- Databases can belong to zero or more named groups
--
CREATE TABLE bucardo.dbgroup (
name TEXT NOT NULL,
CONSTRAINT dbgroup_name_pk PRIMARY KEY (name),
about TEXT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.dbgroup IS $$Named groups of databases: used as 'targetgroup' for syncs$$;
CREATE TABLE bucardo.dbmap (
db TEXT NOT NULL,
CONSTRAINT dbmap_db_fk FOREIGN KEY (db) REFERENCES bucardo.db(name) ON UPDATE CASCADE ON DELETE CASCADE,
dbgroup TEXT NOT NULL,
CONSTRAINT dbmap_dbgroup_fk FOREIGN KEY (dbgroup) REFERENCES bucardo.dbgroup(name) ON UPDATE CASCADE ON DELETE CASCADE,
priority SMALLINT NOT NULL DEFAULT 0,
role TEXT NOT NULL DEFAULT 'target',
gang SMALLINT NOT NULL DEFAULT 1,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.dbmap IS $$Associates a database with one or more groups$$;
CREATE UNIQUE INDEX dbmap_unique ON bucardo.dbmap(db,dbgroup);
--
-- Track status information about each database
--
CREATE TABLE bucardo.db_connlog (
db TEXT NOT NULL,
CONSTRAINT db_connlog_dbid_fk FOREIGN KEY (db) REFERENCES bucardo.db(name) ON UPDATE CASCADE ON DELETE CASCADE,
conndate TIMESTAMPTZ NOT NULL DEFAULT now(), -- when we first connected to it
connstring TEXT NOT NULL,
status TEXT NOT NULL DEFAULT 'unknown',
CONSTRAINT db_connlog_status CHECK (status IN ('unknown', 'good', 'down', 'unreachable')),
version TEXT NULL
);
COMMENT ON TABLE bucardo.db_connlog IS $$Tracks connection attempts to each database when its information changes$$;
--
-- We need to track each item we want to replicate from or replicate to
--
CREATE SEQUENCE bucardo.goat_id_seq;
CREATE TABLE bucardo.goat (
id INTEGER NOT NULL DEFAULT nextval('goat_id_seq'),
CONSTRAINT goat_id_pk PRIMARY KEY (id),
db TEXT NOT NULL,
CONSTRAINT goat_db_fk FOREIGN KEY (db) REFERENCES bucardo.db(name) ON UPDATE CASCADE ON DELETE RESTRICT,
schemaname TEXT NOT NULL,
tablename TEXT NOT NULL,
reltype TEXT NOT NULL DEFAULT 'table',
pkey TEXT NULL,
qpkey TEXT NULL,
pkeytype TEXT NULL,
has_delta BOOLEAN NOT NULL DEFAULT false,
autokick BOOLEAN NULL, -- overrides sync-level autokick
conflict_strategy TEXT NULL,
makedelta TEXT NULL,
rebuild_index SMALLINT NULL, -- overrides sync-level rebuild_index
ghost BOOLEAN NOT NULL DEFAULT false, -- only drop triggers, do not replicate
analyze_after_copy BOOLEAN NOT NULL DEFAULT true,
vacuum_after_copy BOOLEAN NOT NULL DEFAULT true,
strict_checking BOOLEAN NOT NULL DEFAULT true,
delta_bypass BOOLEAN NOT NULL DEFAULT false,
delta_bypass_min BIGINT NULL,
delta_bypass_count BIGINT NULL,
delta_bypass_percent SMALLINT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.goat IS $$Holds information on each table or sequence that may be replicated$$;
ALTER TABLE bucardo.goat ADD CONSTRAINT has_schemaname CHECK (length(schemaname) > 1);
ALTER TABLE bucardo.goat ADD CONSTRAINT valid_reltype CHECK (reltype IN ('table','sequence'));
ALTER TABLE bucardo.goat ADD CONSTRAINT pkey_needs_type CHECK (pkey = '' OR pkeytype IS NOT NULL);
--
-- Set of filters for each goat.
--
CREATE SEQUENCE bucardo.bucardo_custom_trigger_id_seq;
CREATE TABLE bucardo.bucardo_custom_trigger (
id INTEGER NOT NULL DEFAULT nextval('bucardo_custom_trigger_id_seq'),
CONSTRAINT bucardo_custom_trigger_id_pk PRIMARY KEY (id),
goat INTEGER NOT NULL,
CONSTRAINT bucardo_custom_trigger_goat_fk FOREIGN KEY (goat) REFERENCES bucardo.goat(id) ON DELETE CASCADE,
trigger_name TEXT NOT NULL,
trigger_type TEXT NOT NULL,
trigger_language TEXT NOT NULL DEFAULT 'plpgsql',
trigger_body TEXT NOT NULL,
trigger_level TEXT NOT NULL,
status TEXT NOT NULL DEFAULT 'active',
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.bucardo_custom_trigger IS $$Used to override the default bucardo_delta trigger on a per-table basis$$;
ALTER TABLE bucardo.bucardo_custom_trigger ADD CONSTRAINT type_is_delta_or_trigger CHECK (trigger_type IN ('delta', 'triggerkick'));
ALTER TABLE bucardo.bucardo_custom_trigger ADD CONSTRAINT level_is_row_statement CHECK (trigger_level IN ('ROW', 'STATEMENT'));
CREATE UNIQUE INDEX bucardo_custom_trigger_goat_type_unique ON bucardo.bucardo_custom_trigger(goat, trigger_type);
--
-- A group of goats. Ideally arranged in some sort of tree.
--
CREATE TABLE bucardo.herd (
name TEXT NOT NULL,
CONSTRAINT herd_name_pk PRIMARY KEY (name),
about TEXT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.herd IS $$Named group of tables or sequences from the goat table: used as the 'source' for syncs$$;
--
-- Goats belong to zero or more herds. In most cases, they will
-- belong to a single herd if they are being replicated.
--
CREATE TABLE bucardo.herdmap (
herd TEXT NOT NULL,
CONSTRAINT herdmap_herd_fk FOREIGN KEY (herd) REFERENCES bucardo.herd(name) ON UPDATE CASCADE ON DELETE CASCADE,
goat INTEGER NOT NULL,
CONSTRAINT herdmap_goat_fk FOREIGN KEY (goat) REFERENCES bucardo.goat(id) ON DELETE CASCADE,
priority SMALLINT NOT NULL DEFAULT 0,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.herdmap IS $$Associates a goat with one or more herds$$;
CREATE UNIQUE INDEX bucardo_herdmap_unique ON bucardo.herdmap(herd,goat);
CREATE FUNCTION bucardo.herdcheck()
RETURNS TRIGGER
LANGUAGE plperlu
AS
$bc$
use strict; use warnings;
## Make sure that all goats in a herd are from the same database
my $new = $_TD->{new};
my $herdname = $new->{herd};
$herdname =~ s/'/''/go;
my $SQL = qq{
SELECT 1
FROM bucardo.herdmap h, bucardo.goat g
WHERE h.goat = g.id
AND h.herd='$herdname'
AND g.db != (SELECT db FROM bucardo.goat WHERE id = $new->{goat})
};
elog(DEBUG, "Running $SQL");
my $count = spi_exec_query($SQL)->{processed};
if ($count >= 1) {
elog(ERROR, "Cannot have relations from different databases in the same relgroup ($count)");
}
## Make sure that a herd contains at most one schemaname/tablename combination
$SQL = qq{
SELECT count(*) AS goats
FROM bucardo.herdmap h, bucardo.goat g
WHERE h.goat = g.id
AND g.id != $new->{goat}
AND h.herd = '$herdname'
AND g.tablename = (SELECT tablename FROM bucardo.goat WHERE id = $new->{goat})
AND g.schemaname = (SELECT schemaname FROM bucardo.goat WHERE id = $new->{goat})
};
elog(DEBUG, "Running $SQL");
$count = spi_exec_query($SQL)->{rows}[0]{goats};
if ($count >= 1) {
elog(ERROR, "Cannot have two relations with the same schema and table inside a relgroup (relgroup=$herdname) (relation=$new->{goat}) (count=$count)");
}
return;
$bc$;
CREATE TRIGGER herdcheck
AFTER INSERT OR UPDATE ON bucardo.herdmap
FOR EACH ROW EXECUTE PROCEDURE bucardo.herdcheck();
--
-- We need to know who is replicating to who, and how
--
CREATE TABLE bucardo.sync (
name TEXT NOT NULL UNIQUE,
CONSTRAINT sync_name_pk PRIMARY KEY (name),
herd TEXT NULL,
CONSTRAINT sync_herd_fk FOREIGN KEY (herd) REFERENCES bucardo.herd(name) ON UPDATE CASCADE ON DELETE RESTRICT,
dbs TEXT NULL,
CONSTRAINT sync_dbs_fk FOREIGN KEY (dbs) REFERENCES bucardo.dbgroup(name) ON UPDATE CASCADE ON DELETE RESTRICT,
stayalive BOOLEAN NOT NULL DEFAULT true, -- Does the sync controller stay connected?
kidsalive BOOLEAN NOT NULL DEFAULT true, -- Do the children stay connected?
conflict_strategy TEXT NOT NULL DEFAULT 'bucardo_latest',
copyextra TEXT NOT NULL DEFAULT '', -- e.g. WITH OIDS
deletemethod TEXT NOT NULL DEFAULT 'delete',
autokick BOOLEAN NOT NULL DEFAULT true, -- Are we issuing NOTICES via triggers?
checktime INTERVAL NULL, -- How often to check if we've not heard anything?
status TEXT NOT NULL DEFAULT 'active', -- Possibly CHECK / FK ('stopped','paused','b0rken')
rebuild_index SMALLINT NOT NULL DEFAULT 0, -- Load without indexes and then REINDEX table
priority SMALLINT NOT NULL DEFAULT 0, -- Higher is better
analyze_after_copy BOOLEAN NOT NULL DEFAULT true,
vacuum_after_copy BOOLEAN NOT NULL DEFAULT false,
strict_checking BOOLEAN NOT NULL DEFAULT true,
overdue INTERVAL NOT NULL DEFAULT '0 seconds'::interval,
expired INTERVAL NOT NULL DEFAULT '0 seconds'::interval,
track_rates BOOLEAN NOT NULL DEFAULT false,
onetimecopy SMALLINT NOT NULL DEFAULT 0,
lifetime INTERVAL NULL, -- force controller and kids to restart
maxkicks INTEGER NOT NULL DEFAULT 0, -- force controller and kids to restart
isolation_level TEXT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.sync IS $$Defines a single replication event from a herd to one or more target databases$$;
ALTER TABLE bucardo.sync ADD CONSTRAINT sync_deletemethod CHECK (deletemethod IN ('truncate', 'delete', 'truncate_cascade'));
-- Because NOTIFY is broke, make sure our names are simple:
ALTER TABLE bucardo.db ADD CONSTRAINT db_name_sane CHECK (name ~ E'^[a-zA-Z]\\w*$');
ALTER TABLE bucardo.dbgroup ADD CONSTRAINT dbgroup_name_sane CHECK (name ~ E'^[a-zA-Z]\\w*$');
ALTER TABLE bucardo.sync ADD CONSTRAINT sync_name_sane
CHECK (name ~ E'^[a-zA-Z]\\w*$' AND (lower(name) NOT IN ('pushdelta','fullcopy','swap','sync')));
ALTER TABLE bucardo.sync ADD CONSTRAINT sync_isolation_level
CHECK (isolation_level IS NULL OR (lower(isolation_level) IN ('serializable', 'repeatable read')));
CREATE SEQUENCE bucardo.clone_id_seq;
CREATE TABLE bucardo.clone (
id INTEGER NOT NULL DEFAULT nextval('clone_id_seq'),
CONSTRAINT clone_id_pk PRIMARY KEY (id),
sync TEXT NULL,
CONSTRAINT clone_sync_fk FOREIGN KEY (sync) REFERENCES bucardo.sync(name) ON UPDATE CASCADE ON DELETE CASCADE,
dbgroup TEXT NULL,
CONSTRAINT clone_dbgroup_fk FOREIGN KEY (dbgroup) REFERENCES bucardo.dbgroup(name) ON UPDATE CASCADE ON DELETE CASCADE,
relgroup TEXT NULL,
CONSTRAINT clone_relgroup_fk FOREIGN KEY (relgroup) REFERENCES bucardo.herd(name) ON UPDATE CASCADE ON DELETE CASCADE,
options TEXT NULL,
status TEXT NULL,
started TIMESTAMPTZ NULL,
ended TIMESTAMPTZ NULL,
summary TEXT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
CREATE SEQUENCE bucardo.customcode_id_seq;
CREATE TABLE bucardo.customcode (
id INTEGER NOT NULL DEFAULT nextval('customcode_id_seq'),
CONSTRAINT customcode_id_pk PRIMARY KEY (id),
name TEXT NOT NULL UNIQUE,
about TEXT NULL,
whenrun TEXT NOT NULL,
getdbh BOOLEAN NOT NULL DEFAULT true,
src_code TEXT NOT NULL,
status TEXT NOT NULL DEFAULT 'active',
priority SMALLINT NOT NULL DEFAULT 0,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.customcode IS $$Holds Perl subroutines that run via hooks in the replication process$$;
ALTER TABLE bucardo.customcode ADD CONSTRAINT customcode_whenrun
CHECK (whenrun IN ('before_txn',
'before_check_rows',
'before_trigger_disable',
'after_trigger_disable',
'after_table_sync',
'exception',
'conflict',
'before_trigger_enable',
'after_trigger_enable',
'after_txn',
'before_sync',
'after_sync'));
CREATE TABLE bucardo.customcode_map (
code INTEGER NOT NULL,
CONSTRAINT customcode_map_code_fk FOREIGN KEY (code) REFERENCES bucardo.customcode(id) ON DELETE CASCADE,
sync TEXT NULL,
CONSTRAINT customcode_map_sync_fk FOREIGN KEY (sync) REFERENCES bucardo.sync(name) ON UPDATE CASCADE ON DELETE SET NULL,
goat INTEGER NULL,
CONSTRAINT customcode_map_goat_fk FOREIGN KEY (goat) REFERENCES bucardo.goat(id) ON DELETE SET NULL,
active BOOLEAN NOT NULL DEFAULT true,
priority SMALLINT NOT NULL DEFAULT 0,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.customcode_map IS $$Associates a custom code with one or more syncs or goats$$;
ALTER TABLE bucardo.customcode_map ADD CONSTRAINT customcode_map_syncgoat
CHECK (sync IS NULL OR goat IS NULL);
CREATE UNIQUE INDEX customcode_map_unique_sync ON bucardo.customcode_map(code,sync) WHERE sync IS NOT NULL;
CREATE UNIQUE INDEX customcode_map_unique_goat ON bucardo.customcode_map(code,goat) WHERE goat IS NOT NULL;
--
-- Allow the target's names to differ from the source
--
CREATE SEQUENCE bucardo.customname_id_seq;
CREATE TABLE bucardo.customname (
id INTEGER NOT NULL DEFAULT nextval('customname_id_seq'),
CONSTRAINT customname_id_pk PRIMARY KEY (id),
goat INTEGER NOT NULL,
newname TEXT NULL,
db TEXT NULL,
sync TEXT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
ALTER TABLE bucardo.customname ADD CONSTRAINT customname_sane_name
CHECK (newname ~ E'^[a-zA-Z 0-9_.~]+$');
ALTER TABLE bucardo.customname
ADD CONSTRAINT customname_db_fk
FOREIGN KEY (db) REFERENCES bucardo.db (name)
ON UPDATE CASCADE ON DELETE CASCADE;
ALTER TABLE bucardo.customname
ADD CONSTRAINT customname_sync_fk
FOREIGN KEY (sync) REFERENCES bucardo.sync (name)
ON UPDATE CASCADE ON DELETE CASCADE;
ALTER TABLE bucardo.customname
ADD CONSTRAINT customname_goat_fk
FOREIGN KEY (goat) REFERENCES bucardo.goat (id)
ON UPDATE CASCADE ON DELETE CASCADE;
--
-- Allow the target's columns to differ from the source
--
CREATE SEQUENCE bucardo.customcols_id_seq;
CREATE TABLE bucardo.customcols (
id INTEGER NOT NULL DEFAULT nextval('customcols_id_seq'),
CONSTRAINT customcols_id_pk PRIMARY KEY (id),
goat INTEGER NOT NULL,
clause TEXT NULL,
db TEXT NULL,
sync TEXT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
ALTER TABLE bucardo.customcols
ADD CONSTRAINT customcols_db_fk
FOREIGN KEY (db) REFERENCES bucardo.db (name)
ON UPDATE CASCADE ON DELETE CASCADE;
ALTER TABLE bucardo.customcols
ADD CONSTRAINT customcols_sync_fk
FOREIGN KEY (sync) REFERENCES bucardo.sync (name)
ON UPDATE CASCADE ON DELETE CASCADE;
ALTER TABLE bucardo.customcols
ADD CONSTRAINT customcols_goat_fk
FOREIGN KEY (goat) REFERENCES bucardo.goat (id)
ON UPDATE CASCADE ON DELETE CASCADE;
--
-- Keep track of syncs as they run: provides instant and historical status information
--
CREATE TABLE bucardo.syncrun (
sync TEXT NULL,
truncates INTEGER NOT NULL DEFAULT 0,
deletes BIGINT NOT NULL DEFAULT 0,
inserts BIGINT NOT NULL DEFAULT 0,
conflicts BIGINT NOT NULL DEFAULT 0,
started TIMESTAMPTZ NOT NULL DEFAULT now(),
ended TIMESTAMPTZ NULL,
lastgood BOOLEAN NOT NULL DEFAULT false,
lastbad BOOLEAN NOT NULL DEFAULT false,
lastempty BOOLEAN NOT NULL DEFAULT false,
details TEXT NULL,
status TEXT NULL
);
COMMENT ON TABLE bucardo.syncrun IS $$Information about specific runs of syncs$$;
-- Link back to the sync table, but never lose the data even on a sync drop
ALTER TABLE bucardo.syncrun
ADD CONSTRAINT syncrun_sync_fk
FOREIGN KEY (sync) REFERENCES bucardo.sync (name)
ON UPDATE CASCADE ON DELETE SET NULL;
-- Is essentially a unique index, but we want to avoid any [b]locking
CREATE INDEX syncrun_sync_started ON syncrun(sync) WHERE ended IS NULL;
-- We often need the last good/bad/empty for a sync:
CREATE INDEX syncrun_sync_lastgood ON syncrun(sync) WHERE lastgood IS TRUE;
CREATE INDEX syncrun_sync_lastbad ON syncrun(sync) WHERE lastbad IS TRUE;
CREATE INDEX syncrun_sync_lastempty ON syncrun(sync) WHERE lastempty IS TRUE;
--
-- Keep track of which dbs are currently being used, for traffic control
--
CREATE TABLE bucardo.dbrun (
sync TEXT NOT NULL,
dbname TEXT NOT NULL,
pgpid INTEGER NOT NULL,
started TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.dbrun IS $$Information about which databases are being accessed$$;
CREATE INDEX dbrun_index ON bucardo.dbrun(sync);
CREATE FUNCTION bucardo.table_exists(text,text)
RETURNS BOOLEAN
LANGUAGE plpgsql
AS $bc$
BEGIN
PERFORM 1
FROM pg_catalog.pg_class c, pg_namespace n
WHERE c.relnamespace = n.oid
AND n.nspname = $1
AND c.relname = $2;
IF FOUND THEN RETURN true; END IF;
RETURN false;
END;
$bc$;
--
-- Return a safe/standard name for a table, for use in delta/track namings
--
CREATE OR REPLACE FUNCTION bucardo.bucardo_tablename_maker(text)
RETURNS TEXT
LANGUAGE plpgsql
IMMUTABLE
AS $bc$
DECLARE
tname TEXT;
newname TEXT;
hashed TEXT;
BEGIN
-- Change the first period to an underscore
SELECT INTO tname REPLACE($1, '.', '_');
-- Assumes max_identifier_length is 63
-- Because even if not, we'll still abbreviate for consistency and portability
SELECT INTO newname SUBSTRING(tname FROM 1 FOR 57);
IF (newname != tname) THEN
SELECT INTO newname SUBSTRING(tname FROM 1 FOR 46)
|| '!'
|| SUBSTRING(MD5(tname) FROM 1 FOR 10);
END IF;
-- We let Postgres worry about the quoting details
SELECT INTO newname quote_ident(newname);
RETURN newname;
END;
$bc$;
--
-- Return a created connection string from the db table
--
CREATE OR REPLACE FUNCTION bucardo.db_getconn(text)
RETURNS TEXT
LANGUAGE plperlu
SECURITY DEFINER
AS $bc$
## Given the name of a db, return the type, plus type-specific connection information
## Postgres: a connection string, username, password, and attribs
## Drizzle: a connection string, username, and password
## Mongo: "foo: bar" style connection information, one per line
## MariaDB: a connection string, username, and password
## MySQL: a connection string, username, and password
## Oracle: a connection string, username, and password
## Redis: "foo: bar" style connection information, one per line
## SQLite: a database file name
use strict;
use warnings;
use DBI;
my ($name, $SQL, $rv, $row, %db);
$name = shift;
$name =~ s/'/''/go;
$SQL = "SELECT * FROM bucardo.db WHERE name = '$name'";
$rv = spi_exec_query($SQL);
if (!$rv->{processed}) {
elog(ERROR, qq{Error: Could not find a database with a name of $name\n});
}
$row = $rv->{rows}[0];
for (qw(host port name user pass conn service)) {
$db{$_} = exists $row->{"db$_"} ? $row->{"db$_"} : '';
}
## Check that the port is numeric
if (defined $db{port} and length $db{port} and $db{port} !~ /^\d+$/) {
elog(ERROR, qq{Database port must be numeric, but got "$db{port}"\n});
}
my $dbtype = $row->{dbtype} || 'postgres';
if ($dbtype eq 'postgres') {
## If there is a dbfile and it exists, it overrides the rest
## Format = hostname:port:database:username:password
## http://www.postgresql.org/docs/current/static/libpq-pgpass.html
## We also check for one if no password is given
if (!defined $row->{dbpass}) {
my $passfile = $row->{pgpass} || '';
if (open my $pass, "<", $passfile) {
## We only do complete matches
my $match = "$row->{dbhost}:$row->{dbport}:$row->{dbname}:$row->{dbuser}";
while (<$pass>) {
if (/^$match:(.+)/) {
$row->{dbpass} = $1;
elog(DEBUG, "Found password in pgpass file $passfile for $match");
last;
}
}
}
}
## These may be specified in the service name
$db{service} = '' if ! defined $db{service};
if (! length($db{service})) {
length $db{name} or elog(ERROR, qq{Database name is mandatory\n});
length $db{user} or elog(ERROR, qq{Database username is mandatory\n});
}
my $connstring = "dbi:Pg:";
$db{host} ||= ''; $db{port} ||= ''; $db{pass} ||= ''; $db{user} ||= '';
$connstring .= join ';', map {
( $_ eq 'name' ? 'dbname' : $_ ) . "=$db{$_}";
} grep { length $db{$_} } qw/name host port service/;
$connstring .= ';' . $db{conn} if length $db{conn};
my $ssp = $row->{server_side_prepares};
$ssp = 1 if ! defined $ssp;
return "$dbtype\n$connstring\n$db{user}\n$db{pass}\n$ssp";
} ## end postgres
if ($dbtype eq 'drizzle') {
length $db{name} or elog(ERROR, qq{Database name is mandatory\n});
length $db{user} or elog(ERROR, qq{Database username is mandatory\n});
my $connstring = "dbi:drizzle:database=$db{name}";
$db{host} ||= ''; $db{port} ||= ''; $db{pass} ||= '';
length $db{host} and $connstring .= ";host=$db{host}";
length $db{port} and $connstring .= ";port=$db{port}";
length $db{conn} and $connstring .= ";$db{conn}";
return "$dbtype\n$connstring\n$db{user}\n$db{pass}";
} ## end drizzle
if ($dbtype eq 'mongo') {
my $connstring = "$dbtype\n";
for my $name (qw/ host port user pass /) {
defined $db{$name} and length $db{$name} and $connstring .= "$name: $db{$name}\n";
}
chomp $connstring;
return $connstring;
}
if ($dbtype eq 'mysql' or $dbtype eq 'mariadb') {
length $db{name} or elog(ERROR, qq{Database name is mandatory\n});
length $db{user} or elog(ERROR, qq{Database username is mandatory\n});
my $connstring = "dbi:mysql:database=$db{name}";
$db{host} ||= ''; $db{port} ||= ''; $db{pass} ||= '';
length $db{host} and $connstring .= ";host=$db{host}";
length $db{port} and $connstring .= ";port=$db{port}";
length $db{conn} and $connstring .= ";$db{conn}";
return "$dbtype\n$connstring\n$db{user}\n$db{pass}";
} ## end mysql/mariadb
if ($dbtype eq 'oracle') {
## We should loosen this up somewhere
length $db{name} or elog(ERROR, qq{Database name is mandatory\n});
length $db{user} or elog(ERROR, qq{Database username is mandatory\n});
## TODO: Support SID, other forms
my $connstring = "dbi:Oracle:dbname=$db{name}";
$db{host} ||= ''; $db{port} ||= ''; $db{conn} ||= ''; $db{pass} ||= '';
length $db{host} and $connstring .= ";host=$db{host}";
length $db{port} and $connstring .= ";port=$db{port}";
length $db{conn} and $connstring .= ";$db{conn}";
return "$dbtype\n$connstring\n$db{user}\n$db{pass}";
} ## end oracle
if ($dbtype eq 'redis') {
my $connstring = "$dbtype\n";
for my $name (qw/ host port user pass /) {
defined $db{$name} and length $db{$name} and $connstring .= "$name: $db{$name}\n";
}
chomp $connstring;
return $connstring;
}
if ($dbtype eq 'sqlite') {
## We should loosen this up somewhere
length $db{name} or elog(ERROR, qq{Database name is mandatory\n});
## TODO: Support SID, other forms
my $connstring = "dbi:SQLite:dbname=$db{name}";
return "$dbtype\n$connstring";
} ## end sqlite
return "Unknown database type: $dbtype";
$bc$;
--
-- Test a database connection, and log to the db_connlog table
--
CREATE FUNCTION bucardo.db_testconn(text)
RETURNS TEXT
LANGUAGE plperlu
SECURITY DEFINER
AS
$bc$
## Given the name of a db connection, construct the connection
## string for it and then connect to it and log the attempt
use strict; use warnings; use DBI;
my ($name, $SQL, $rv, $row, $dbh, %db, $version, $found);
$name = shift;
$name =~ s/'/''/g;
$SQL = "SELECT bucardo.db_getconn('$name') AS bob";
$rv = spi_exec_query($SQL);
if (!$rv->{processed}) {
elog(ERROR, qq{Error: Could not find a database with an name of $name\n});
}
$row = $rv->{rows}[0]{bob};
($db{type},$db{dsn},$db{user},$db{pass}) = split /\n/ => $row;
if ($db{type} ne 'postgres') {
return '';
}
my $safeconn = "$db{dsn} user=$db{user}"; ## No password for now
$safeconn =~ s/'/''/go;
(my $safename = $name) =~ s/'/''/go;
elog(DEBUG, "Connecting as $db{dsn} user=$db{user} $$");
eval {
$dbh = DBI->connect($db{dsn}, $db{user}, $db{pass},
{AutoCommit=>1, RaiseError=>1, PrintError=>0});
};
if ($@ or !$dbh) {
$SQL = "INSERT INTO db_connlog (db,connstring,status) VALUES ('$safename','$safeconn','unknown')";
spi_exec_query($SQL);
return "Failed to make database connection: $@";
}
$version = $dbh->{pg_server_version};
## Just in case, switch to read/write mode
$dbh->do('SET SESSION CHARACTERISTICS AS TRANSACTION READ WRITE');
## Install plpgsql if not there already
$SQL = q{SELECT 1 FROM pg_language WHERE lanname = 'plpgsql'};
my $sth = $dbh->prepare($SQL);
my $count = $sth->execute();
$sth->finish();
if ($count < 1) {
$dbh->do("CREATE LANGUAGE plpgsql");
}
$dbh->disconnect();
$SQL = "INSERT INTO db_connlog (db,connstring,status,version) VALUES ('$safename','$safeconn','good',$version)";
spi_exec_query($SQL);
return "Database connection successful";
$bc$;
--
-- Check the database connection if anything changes in the db table
--
CREATE FUNCTION bucardo.db_change()
RETURNS TRIGGER
LANGUAGE plperlu
SECURITY DEFINER
AS
$bc$
return if $_TD->{new}{status} eq 'inactive';
## Test connection to the database specified
my $name = $_TD->{new}{name};
$name =~ s/'/''/g;
spi_exec_query("SELECT bucardo.db_testconn('$name')");
return;
$bc$;
CREATE TRIGGER db_change
AFTER INSERT OR UPDATE ON bucardo.db
FOR EACH ROW EXECUTE PROCEDURE bucardo.db_change();
--
-- Setup the goat table after any change
--
CREATE OR REPLACE FUNCTION bucardo.validate_goat()
RETURNS TRIGGER
LANGUAGE plperlu
SECURITY DEFINER
AS
$bc$
## If a row in goat has changed, re-validate and set things up for that table
elog(DEBUG, "Running validate_goat");
use strict; use warnings; use DBI;
my ($SQL, $rv, $row, %db, $dbh, $sth, $count, $oid);
my $old = $_TD->{event} eq 'UPDATE' ? $_TD->{old} : 0;
my $new = $_TD->{new};
if (!defined $new->{db}) {
die qq{Must provide a db\n};
}
if (!defined $new->{tablename}) {
die qq{Must provide a tablename\n};
}
if (!defined $new->{schemaname}) {
die qq{Must provide a schemaname\n};
}
if ($new->{reltype} ne 'table') {
return;
}
my ($dbname,$schema,$table,$pkey) =
($new->{db}, $new->{schemaname}, $new->{tablename}, $new->{pkey});
## Do not allow pkeytype or qpkey to be set manually.
if (defined $new->{pkeytype} and (!$old or $new->{pkeytype} ne $old->{pkeytype})) {
die qq{Cannot set pkeytype manually\n};
}
if (defined $new->{qpkey} and (!$old or $new->{qpkey} ne $old->{qpkey})) {
die qq{Cannot set qpkey manually\n};
}
## If this is an update, we only continue if certain fields have changed
if ($old
and $old->{db} eq $new->{db}
and $old->{schemaname} eq $new->{schemaname}
and $old->{tablename} eq $new->{tablename}
and (defined $new->{pkey} and $new->{pkey} eq $old->{pkey})
) {
return;
}
(my $safedbname = $dbname) =~ s/'/''/go;
$SQL = "SELECT bucardo.db_getconn('$safedbname') AS apple";
$rv = spi_exec_query($SQL);
if (!$rv->{processed}) {
elog(ERROR, qq{Error: Could not find a database with an name of $dbname\n});
}
$row = $rv->{rows}[0]{apple};
($db{type},$db{dsn},$db{user},$db{pass},$db{ssp}) = split /\n/ => $row;
if ($db{type} ne 'postgres') {
elog(INFO, qq{Not checking database of type $db{type}});
}
elog(DEBUG, "Connecting in validate_goat as $db{dsn} user=$db{user} pid=$$ for table $schema.$table");
$dbh = DBI->connect($db{dsn}, $db{user}, $db{pass},
{AutoCommit=>0, RaiseError=>1, PrintError=>0});
$dbh or elog(ERROR, qq{Database connection "$db{dsn}" as user $db{user} failed: $DBI::errstr\n});
$db{ssp} or $dbh->{pg_server_prepare} = 0;
## Get column information for this table (and verify it exists)
$SQL = q{
SELECT c.oid, attnum, attname, quote_ident(attname) AS qattname, typname, atttypid
FROM pg_attribute a, pg_type t, pg_class c, pg_namespace n
WHERE c.relnamespace = n.oid
AND nspname = ? AND relname = ?
AND a.attrelid = c.oid
AND a.atttypid = t.oid
AND attnum > 0
};
$sth = $dbh->prepare($SQL);
$count = $sth->execute($schema,$table);
if ($count < 1) {
$sth->finish();
$dbh->disconnect();
die qq{Table not found at $db{dsn}: $schema.$table\n};
}
my $col = $sth->fetchall_hashref('attnum');
$oid = $col->{each %$col}{oid};
## Find all usable unique constraints for this table
$SQL = q{
SELECT indisprimary, indkey
FROM pg_index i
WHERE indisunique AND indpred IS NULL AND indexprs IS NULL AND indrelid = ?
ORDER BY indexrelid DESC
};
## DESC because we choose the "newest" index in case of a tie below
$sth = $dbh->prepare($SQL);
$count = 0+$sth->execute($oid);
my $cons = $sth->fetchall_arrayref({});
$dbh->rollback();
$dbh->disconnect();
elog(DEBUG, "Valid unique constraints found: $count\n");
if ($count < 1) {
## We have no usable constraints. The entries must be blank.
my $orignew = $new->{pkey};
$new->{pkey} = $new->{qpkey} = $new->{pkeytype} = '';
if (!$old) { ## This was an insert: just go
elog(DEBUG, "No usable constraints, setting pkey et. al. to blank");
return 'MODIFY';
}
## If pkey has been set to NULL, this was a specific reset request, so return
## If pkey ended up blank (no change, or changed to blank), just return
if (!defined $orignew or $orignew eq '') {
return 'MODIFY';
}
## The user has tried to change it something not blank, but this is not possible.
die qq{Cannot set pkey for table $schema.$table: no unique constraint found\n};
}
## Pick the best possible one. Primary keys are always the best choice.
my ($primary) = grep { $_->{indisprimary} } @$cons;
my $uniq;
if (defined $primary) {# and !$old and defined $new->{pkey}) {
$uniq = $primary;
}
else {
my (@foo) = grep { ! $_->{indisprimary} } @$cons;
$count = @foo;
## Pick the one with the smallest number of columns.
## In case of a tie, choose the one with the smallest column footprint
if ($count < 2) {
$uniq = $foo[0];
}
else {
my $lowest = 10_000;
for (@foo) {
my $cc = $_->{indkey} =~ y/ / /;
if ($cc < $lowest) {
$lowest = $cc;
$uniq = $_;
}
}
}
}
## This should not happen:
if (!defined $uniq) {
die "Could not find a suitable unique index for table $schema.$table\n";
}
my $found = 0;
## If the user is not trying a manual override, set the best one and leave
if ((!defined $new->{pkey} or !length $new->{pkey}) or ($old and $new->{pkey} eq $old->{pkey})) {
($new->{pkey} = $uniq->{indkey}) =~ s/(\d+)(\s+)?/$col->{$1}{attname} . ($2 ? '|' : '')/ge;
$found = 1;
}
else {
## They've attempted a manual override of pkey. Make sure it is valid.
for (@$cons) {
(my $name = $_->{indkey}) =~ s/(\d+)(\s+)?/$col->{$1}{attname} . ($2 ? '|' : '')/ge;
next unless $name eq $new->{pkey};
last;
}
}
if ($found) {
($new->{qpkey} = $uniq->{indkey}) =~ s/(\d+)(\s+)?/$col->{$1}{qattname} . ($2 ? '|' : '')/ge;
($new->{pkeytype} = $uniq->{indkey}) =~ s/(\d+)(\s+)?/$col->{$1}{typname} . ($2 ? '|' : '')/ge;
$new->{pkeytype} =~ s/int2/smallint/;
$new->{pkeytype} =~ s/int4/integer/;
$new->{pkeytype} =~ s/int8/bigint/;
return 'MODIFY';
}
die qq{Could not find a matching unique constraint that provides those columns\n};
$bc$; -- End of validate_goat()
CREATE TRIGGER validate_goat
BEFORE INSERT OR UPDATE ON bucardo.goat
FOR EACH ROW EXECUTE PROCEDURE bucardo.validate_goat();
--
-- Check that the goat tables are ready and compatible
--
CREATE OR REPLACE FUNCTION bucardo.validate_sync(text,integer)
RETURNS TEXT
LANGUAGE plperlu
SECURITY DEFINER
AS
$bc$
## Connect to all (active) databases used in a sync
## Verify table structures are the same
## Add delta relations as needed
use strict;
use warnings;
use DBI;
my $syncname = shift;
elog(LOG, "Starting validate_sync for $syncname");
## If force is set, we don't hesitate to drop indexes, etc.
my $force = shift || 0;
## Common vars
my ($rv,$SQL,%cache,$msg);
## Grab information about this sync from the database
(my $safesyncname = $syncname) =~ s/'/''/go;
$SQL = "SELECT * FROM sync WHERE name = '$safesyncname'";
$rv = spi_exec_query($SQL);
if (!$rv->{processed}) {
elog(ERROR, "No such sync: $syncname");
}
my $info = $rv->{rows}[0];
## Does this herd exist?
(my $herd = $info->{herd}) =~ s/'/''/go;
$SQL = qq{SELECT 1 FROM herd WHERE name = '$herd'};
$rv = spi_exec_query($SQL);
if (!$rv->{processed}) {
elog(ERROR, "No such relgroup: $herd");
}
## Grab information on all members of this herd
$SQL = qq{
SELECT id, db, schemaname, tablename, pkey, pkeytype, reltype,
autokick AS goatkick,
pg_catalog.quote_ident(db) AS safedb,
pg_catalog.quote_ident(schemaname) AS safeschema,
pg_catalog.quote_ident(tablename) AS safetable,
pg_catalog.quote_ident(pkey) AS safepkey
FROM goat g, herdmap h
WHERE g.id = h.goat
AND h.herd = '$herd'
};
$rv = spi_exec_query($SQL);
if (!$rv->{processed}) {
elog(WARNING, "Relgroup has no members: $herd");
return qq{Herd "$herd" for sync "$syncname" has no members: cannot validate};
}
## Create a simple hash so we can look up the information by schema then table name
my %goat;
for my $x (@{$rv->{rows}}) {
$goat{$x->{schemaname}}{$x->{tablename}} = $x;
}
## Map to the actual table names used by looking at the customname table
my %customname;
$SQL = q{SELECT goat,newname,db,COALESCE(db,'') AS db, COALESCE(sync,'') AS sync FROM bucardo.customname};
$rv = spi_exec_query($SQL);
for my $x (@{$rv->{rows}}) {
## Ignore if this is for some other sync
next if length $x->{sync} and $x->{sync} ne $syncname;
$customname{$x->{goat}}{$x->{db}} = $x->{newname};
}
## Grab information from each of the databases
my %db;
(my $dbs = $info->{dbs}) =~ s/'/''/go;
$SQL = qq{
SELECT m.db, m.role, pg_catalog.quote_ident(m.db) AS safedb, d.status, d.dbtype
FROM dbmap m
JOIN db d ON (d.name = m.db)
WHERE dbgroup = '$dbs'
};
$rv = spi_exec_query($SQL);
if (!@{$rv->{rows}}) {
elog(ERROR, qq{Could not find a dbgroup of $dbs});
}
## We also want to count up each type of role
my %role = (
source => 0,
target => 0,
fullcopy => 0,
);
for (@{$rv->{rows}}) {
$db{$_->{db}} = {
safename => $_->{safedb},
role => $_->{role},
status => $_->{status},
dbtype => $_->{dbtype},
};
$role{$_->{role}}++;
}
## No source databases? Does not compute!
if ($role{source} < 1) {
die "Invalid dbgroup: at least one database must have a role of 'source'!\n";
}
## Unless we are fullcopy, we must have PKs on each table
my $is_fullcopy = (! $role{target} and $role{fullcopy}) ? 1 : 0;
if (! $is_fullcopy) {
for my $schema (sort keys %goat) {
for my $table (sort keys %{$goat{$schema}}) {
next if $goat{$schema}{$table}{reltype} ne 'table';
if (! $goat{$schema}{$table}{pkey}) {
elog(ERROR, qq{Table "$schema.$table" must specify a primary key!});
}
}
}
}
my $run_sql = sub {
my ($sql,$dbh) = @_;
elog(DEBUG, "SQL: $sql");
$dbh->do($sql);
};
my $fetch1_sql = sub {
my ($sql,$dbh,@items) = @_;
$sql =~ s/\t/ /gsm;
if ($sql =~ /^(\s+)/m) {
(my $ws = $1) =~ s/[^ ]//g;
my $leading = length($ws);
$sql =~ s/^\s{$leading}//gsm;
}
my $sth = $dbh->prepare_cached($sql);
$sth->execute(@items);
return $sth->fetchall_arrayref()->[0][0];
};
## Determine the name of some functions we may need
my $namelen = length($syncname);
my $kickfunc = $namelen <= 48
? "bucardo_kick_$syncname" : $namelen <= 62
? "bkick_$syncname"
: sprintf 'bucardo_kick_%d', int (rand(88888) + 11111);
## Not used yet, but will allow for selective recreation of various items below
my %force;
## Open a connection to each active database
## Create the bucardo superuser if needed
## Install the plpgsql language if needed
## We do the source ones first as all their columns must exist on all other databases
for my $dbname (sort { ($db{$b}{role} eq 'source') <=> ($db{$a}{role} eq 'source') } keys %db) {
## Skip if this database is not active
next if $db{$dbname}{status} ne 'active';
## Skip if this is a flatfile
next if $db{$dbname}{dbtype} =~ /flat/;
## Skip if this is a non-supported database
next if $db{$dbname}{dbtype} =~ /drizzle|mariadb|mongo|mysql|oracle|redis|sqlite/;
## Figure out how to connect to this database
my $rv = spi_exec_query("SELECT bucardo.db_getconn('$dbname') AS conn");
$rv->{processed} or elog(ERROR, qq{Error: Could not find a database named "$dbname"\n});
my ($dbtype,$dsn,$user,$pass,$ssp) = split /\n/ => $rv->{rows}[0]{conn};
elog(DEBUG, "Connecting to $dsn as $user inside bucardo_validate_sync for language check");
my $dbh;
eval {
## Cache this connection so we only have to connect one time
$dbh = $cache{dbh}{$dbname} = DBI->connect
($dsn, $user, $pass, {AutoCommit=>0, RaiseError=>1, PrintError=>0});
};
if ($@) {
## If the error might be because the bucardo user does not exist yet,
## try again with the postgres user (and create the bucardo user!)
if ($@ =~ /"bucardo"/ and $user eq 'bucardo') {
elog(DEBUG, 'Failed connection, trying as user postgres');
my $tempdbh = DBI->connect($dsn, 'postgres', $pass, {AutoCommit=>0, RaiseError=>1, PrintError=>0});
$tempdbh->do('SET TRANSACTION READ WRITE');
$tempdbh->do('CREATE USER bucardo SUPERUSER');
$tempdbh->commit();
$tempdbh->disconnect();
## Reconnect the same as above, with the new bucardo user
$dbh = $cache{dbh}{$dbname} = DBI->connect
($dsn, $user, $pass, {AutoCommit=>0, RaiseError=>1, PrintError=>0});
warn "Created superuser bucardo on database $dbname\n";
} else {
## Any other connection error is a simple exception
die $@;
}
}
## If server_side_prepares is off for this database, set it now
$ssp or $dbh->{pg_server_prepare} = 0;
## Just in case this database is set to read-only
$dbh->do('SET TRANSACTION READ WRITE');
## To help comparisons, remove any unknown search_paths
$dbh->do('SET LOCAL search_path = pg_catalog');
## Prepare some common SQL:
my (%sth,$sth,$count,$x,%col);
## Does a named schema exist?
$SQL = q{SELECT 1 FROM pg_namespace WHERE nspname = ?};
$sth{hazschema} = $dbh->prepare($SQL);
## Does a named column exist on a specific table?
$SQL = q{SELECT 1 FROM pg_attribute WHERE attrelid = }
.q{(SELECT c.oid FROM pg_class c JOIN pg_namespace n ON (n.oid=c.relnamespace)}
.q{ AND nspname=? AND relname=?) AND attname = ?};
$sth{hazcol} = $dbh->prepare($SQL);
## Get a list of all tables and indexes in the bucardo schema for ease below
$SQL = q{SELECT c.oid,relkind,relname FROM pg_class c JOIN pg_namespace n ON (n.oid=c.relnamespace) WHERE nspname='bucardo'};
$sth = $dbh->prepare($SQL);
$sth->execute();
my (%btableoid, %bindexoid);
for my $row (@{$sth->fetchall_arrayref()}) {
if ($row->[1] eq 'r') {
$btableoid{$row->[2]} = $row->[0];
}
if ($row->[1] eq 'i') {
$bindexoid{$row->[2]} = $row->[0];
}
}
## Get a list of all functions in the bucardo schema
$SQL = q{SELECT p.oid,proname FROM pg_proc p JOIN pg_namespace n ON (n.oid=p.pronamespace) WHERE nspname='bucardo'};
$sth = $dbh->prepare($SQL);
$sth->execute();
my (%bfunctionoid);
for my $row (@{$sth->fetchall_arrayref()}) {
$bfunctionoid{$row->[1]} = $row->[0];
}
## Get a list of all triggers that start with 'bucardo'
$SQL = q{SELECT nspname, relname, tgname FROM pg_trigger t
JOIN pg_class c ON (c.oid=t.tgrelid)
JOIN pg_namespace n ON (n.oid = c.relnamespace)
WHERE tgname ~ '^bucardo'};
$sth = $dbh->prepare($SQL);
$sth->execute();
my (%btriggerinfo);
for my $row (@{$sth->fetchall_arrayref()}) {
$btriggerinfo{$row->[0]}{$row->[1]}{$row->[2]} = 1;
}
## Unless we are strictly fullcopy, put plpgsql in place on all source dbs
## We also will need a bucardo schema
my $role = $db{$dbname}{role};
if ($role eq 'source' and ! $is_fullcopy) {
## Perform the check for plpgsql
$SQL = q{SELECT count(*) FROM pg_language WHERE lanname = 'plpgsql'};
my $count = $dbh->selectall_arrayref($SQL)->[0][0];
if ($count < 1) {
$dbh->do('CREATE LANGUAGE plpgsql');
$dbh->commit();
warn "Created language plpgsql on database $dbname\n";
}
## Create the bucardo schema as needed
$sth = $sth{hazschema};
$count = $sth->execute('bucardo');
$sth->finish();
if ($count < 1) {
$dbh->do('CREATE SCHEMA bucardo');
}
my $newschema = $count < 1 ? 1 : 0;
my @functions = (
{ name => 'bucardo_tablename_maker', args => 'text', returns => 'text', vol => 'immutable', body => q{
DECLARE
tname TEXT;
newname TEXT;
hashed TEXT;
BEGIN
-- Change the first period to an underscore
SELECT INTO tname REPLACE($1, '.', '_');
-- Assumes max_identifier_length is 63
-- Because even if not, we'll still abbreviate for consistency and portability
SELECT INTO newname SUBSTRING(tname FROM 1 FOR 57);
IF (newname != tname) THEN
SELECT INTO newname SUBSTRING(tname FROM 1 FOR 46)
|| '!'
|| SUBSTRING(MD5(tname) FROM 1 FOR 10);
END IF;
-- We let Postgres worry about the quoting details
SELECT INTO newname quote_ident(newname);
RETURN newname;
END;
}
},
{ name => 'bucardo_tablename_maker', args => 'text, text', returns => 'text', vol => 'immutable', body => q{
DECLARE
newname TEXT;
BEGIN
SELECT INTO newname bucardo.bucardo_tablename_maker($1);
-- If it has quotes around it, we expand the quotes to include the prefix
IF (POSITION('"' IN newname) >= 1) THEN
newname = REPLACE(newname, '"', '');
newname = '"' || $2 || newname || '"';
ELSE
newname = $2 || newname;
END IF;
RETURN newname;
END;
}
},
{ name => 'bucardo_delta_names_helper', args => '', returns => 'trigger', vol => 'immutable', body => q{
BEGIN
IF NEW.deltaname IS NULL THEN
NEW.deltaname = bucardo.bucardo_tablename_maker(NEW.tablename, 'delta_');
END IF;
IF NEW.trackname IS NULL THEN
NEW.trackname = bucardo.bucardo_tablename_maker(NEW.tablename, 'track_');
END IF;
RETURN NEW;
END;
}
},
## Function to do a quick check of all deltas for a given sync
{ name => 'bucardo_delta_check', args => 'text, text', returns => 'SETOF TEXT', body => q{
DECLARE
myst TEXT;
myrec RECORD;
mycount INT;
BEGIN
FOR myrec IN
SELECT * FROM bucardo.bucardo_delta_names
WHERE sync = $1
ORDER BY tablename
LOOP
RAISE DEBUG 'GOT % and %', myrec.deltaname, myrec.tablename;
myst = $$
SELECT 1
FROM bucardo.$$ || myrec.deltaname || $$ d
WHERE NOT EXISTS (
SELECT 1
FROM bucardo.$$ || myrec.trackname || $$ t
WHERE d.txntime = t.txntime
AND (t.target = '$$ || $2 || $$'::text OR t.target ~ '^T:')
) LIMIT 1$$;
EXECUTE myst;
GET DIAGNOSTICS mycount = ROW_COUNT;
IF mycount>=1 THEN
RETURN NEXT '1,' || myrec.tablename;
ELSE
RETURN NEXT '0,' || myrec.tablename;
END IF;
END LOOP;
RETURN;
END;
}
},
## Function to write to the tracking table upon a truncation
{ name => 'bucardo_note_truncation', args => '', returns => 'trigger', body => q{
DECLARE
mytable TEXT;
myst TEXT;
BEGIN
INSERT INTO bucardo.bucardo_truncate_trigger(tablename,sname,tname,sync)
VALUES (TG_RELID, TG_TABLE_SCHEMA, TG_TABLE_NAME, TG_ARGV[0]);
SELECT INTO mytable
bucardo.bucardo_tablename_maker(TG_TABLE_SCHEMA || '.' || TG_TABLE_NAME, 'delta_');
myst = 'TRUNCATE TABLE bucardo.' || mytable;
EXECUTE myst;
SELECT INTO mytable
bucardo.bucardo_tablename_maker(TG_TABLE_SCHEMA || '.' || TG_TABLE_NAME, 'track_');
myst = 'TRUNCATE TABLE bucardo.' || mytable;
EXECUTE myst;
-- Not strictly necessary, but nice to have a clean slate
SELECT INTO mytable
bucardo.bucardo_tablename_maker(TG_TABLE_SCHEMA || '.' || TG_TABLE_NAME, 'stage_');
myst = 'TRUNCATE TABLE bucardo.' || mytable;
EXECUTE myst;
RETURN NEW;
END;
}
},
## Function to remove duplicated entries from the bucardo_delta tables
{ name => 'bucardo_compress_delta', args => 'text, text', returns => 'text', body => q{
DECLARE
mymode TEXT;
myoid OID;
myst TEXT;
got2 bool;
drows BIGINT = 0;
trows BIGINT = 0;
rnames TEXT;
rname TEXT;
rnamerec RECORD;
ids_where TEXT;
ids_sel TEXT;
ids_grp TEXT;
idnum TEXT;
BEGIN
-- Are we running in a proper mode?
SELECT INTO mymode current_setting('transaction_isolation');
IF (mymode <> 'serializable' AND mymode <> 'repeatable read') THEN
RAISE EXCEPTION 'This function must be run in repeatable read mode';
END IF;
-- Grab the oid of this schema/table combo
SELECT INTO myoid
c.oid FROM pg_class c JOIN pg_namespace n ON n.oid = c.relnamespace
WHERE nspname = $1 AND relname = $2;
IF NOT FOUND THEN
RAISE EXCEPTION 'No such table: %.%', $1, $2;
END IF;
ids_where = 'COALESCE(rowid,''NULL'') = COALESCE(id, ''NULL'')';
ids_sel = 'rowid AS id';
ids_grp = 'rowid';
FOR rnamerec IN SELECT attname FROM pg_attribute WHERE attrelid =
(SELECT oid FROM pg_class WHERE relname = 'bucardo_delta'
AND relnamespace =
(SELECT oid FROM pg_namespace WHERE nspname = 'bucardo') AND attname ~ '^rowid'
) LOOP
rname = rnamerec.attname;
rnames = COALESCE(rnames || ' ', '') || rname ;
SELECT INTO idnum SUBSTRING(rname FROM '[[:digit:]]+');
IF idnum IS NOT NULL THEN
ids_where = ids_where
|| ' AND ('
|| rname
|| ' = id'
|| idnum
|| ' OR ('
|| rname
|| ' IS NULL AND id'
|| idnum
|| ' IS NULL))';
ids_sel = ids_sel
|| ', '
|| rname
|| ' AS id'
|| idnum;
ids_grp = ids_grp
|| ', '
|| rname;
END IF;
END LOOP;
myst = 'DELETE FROM bucardo.bucardo_delta
USING (SELECT MAX(txntime) AS maxt, '||ids_sel||'
FROM bucardo.bucardo_delta
WHERE tablename = '||myoid||'
GROUP BY ' || ids_grp || ') AS foo
WHERE tablename = '|| myoid || ' AND ' || ids_where ||' AND txntime <> maxt';
RAISE DEBUG 'Running %', myst;
EXECUTE myst;
GET DIAGNOSTICS drows := row_count;
myst = 'DELETE FROM bucardo.bucardo_track'
|| ' WHERE NOT EXISTS (SELECT 1 FROM bucardo.bucardo_delta d WHERE d.txntime = bucardo_track.txntime)';
EXECUTE myst;
GET DIAGNOSTICS trows := row_count;
RETURN 'Compressed '||$1||'.'||$2||'. Rows deleted from bucardo_delta: '||drows||
' Rows deleted from bucardo_track: '||trows;
END;
} ## end of bucardo_compress_delta body
},
{ name => 'bucardo_compress_delta', args => 'text', returns => 'text', language => 'sql', body => q{
SELECT bucardo.bucardo_compress_delta(n.nspname, c.relname)
FROM pg_class c
JOIN pg_namespace n ON n.oid = c.relnamespace
WHERE relname = $1 AND pg_table_is_visible(c.oid);
}
},
{ name => 'bucardo_compress_delta', args => 'oid', returns => 'text', language => 'sql', body => q{
SELECT bucardo.bucardo_compress_delta(n.nspname, c.relname)
FROM pg_class c
JOIN pg_namespace n ON n.oid = c.relnamespace
WHERE c.oid = $1;
}
},
## The main vacuum function to clean up the delta and track tables
{ name => 'bucardo_purge_delta_oid', 'args' => 'text, oid', returns => 'text', body => q{
DECLARE
deltatable TEXT;
tracktable TEXT;
dtablename TEXT;
myst TEXT;
drows BIGINT = 0;
trows BIGINT = 0;
BEGIN
-- Store the schema and table name
SELECT INTO dtablename
quote_ident(nspname)||'.'||quote_ident(relname)
FROM pg_class c JOIN pg_namespace n ON (n.oid = c.relnamespace)
WHERE c.oid = $2;
-- See how many dbgroups are being used by this table
SELECT INTO drows
COUNT(DISTINCT target)
FROM bucardo.bucardo_delta_targets
WHERE tablename = $2;
RAISE DEBUG 'delta_targets rows found for %: %', dtablename, drows;
-- If no dbgroups, no point in going on, as we will never purge anything
IF drows < 1 THEN
RETURN 'Nobody is using table '|| dtablename ||', according to bucardo_delta_targets';
END IF;
-- Figure out the names of the delta and track tables for this relation
SELECT INTO deltatable
bucardo.bucardo_tablename_maker(dtablename, 'delta_');
SELECT INTO tracktable
bucardo.bucardo_tablename_maker(dtablename, 'track_');
-- Delete all txntimes from the delta table that:
-- 1) Have been used by all dbgroups listed in bucardo_delta_targets
-- 2) Have a matching txntime from the track table
-- 3) Are older than the first argument interval
myst = 'DELETE FROM bucardo.'
|| deltatable
|| ' USING (SELECT txntime AS tt FROM bucardo.'
|| tracktable
|| ' GROUP BY 1 HAVING COUNT(*) = '
|| drows
|| ') AS foo'
|| ' WHERE txntime = tt'
|| ' AND txntime < now() - interval '
|| quote_literal($1);
EXECUTE myst;
GET DIAGNOSTICS drows := row_count;
-- Now that we have done that, we can remove rows from the track table
-- which have no match at all in the delta table
myst = 'DELETE FROM bucardo.'
|| tracktable
|| ' WHERE NOT EXISTS (SELECT 1 FROM bucardo.'
|| deltatable
|| ' d WHERE d.txntime = bucardo.'
|| tracktable
|| '.txntime)';
EXECUTE myst;
GET DIAGNOSTICS trows := row_count;
RETURN 'Rows deleted from '
|| deltatable
|| ': '
|| drows
|| ' Rows deleted from '
|| tracktable
|| ': '
|| trows;
END;
} ## end of bucardo_purge_delta_oid body
},
{ name => 'bucardo_purge_delta', args => 'text', returns => 'text', body => q{
DECLARE
myrec RECORD;
myrez TEXT;
total INTEGER = 0;
BEGIN
SET LOCAL search_path = pg_catalog;
-- Grab all potential tables to be vacuumed by looking at bucardo_delta_targets
FOR myrec IN SELECT DISTINCT tablename FROM bucardo.bucardo_delta_targets LOOP
SELECT INTO myrez
bucardo.bucardo_purge_delta_oid($1, myrec.tablename);
RAISE NOTICE '%', myrez;
total = total + 1;
END LOOP;
RETURN 'Tables processed: ' || total;
END;
} ## end of bucardo_purge_delta body
},
{ name => 'bucardo_purge_sync_track', args => 'text', returns => 'text', body => q{
DECLARE
myrec RECORD;
myst TEXT;
BEGIN
PERFORM 1 FROM bucardo.bucardo_delta_names WHERE sync = $1 LIMIT 1;
IF NOT FOUND THEN
RAISE EXCEPTION 'No sync found named %', $1;
END IF;
FOR myrec IN SELECT DISTINCT tablename, deltaname, trackname
FROM bucardo.bucardo_delta_names WHERE sync = $1
ORDER BY tablename LOOP
myst = 'INSERT INTO bucardo.'
|| myrec.trackname
|| ' SELECT DISTINCT txntime, '
|| quote_literal($1)
|| ' FROM bucardo.'
|| myrec.deltaname;
RAISE DEBUG 'Running: %', myst;
EXECUTE myst;
END LOOP;
RETURN 'Complete';
END;
} ## end of bucardo_purge_sync_track body
},
); ## end of %functions
for my $info (@functions) {
my $funcname = $info->{name};
my ($oldmd5,$newmd5) = (0,1);
$SQL = 'SELECT md5(prosrc), md5(?) FROM pg_proc WHERE proname=? AND oidvectortypes(proargtypes)=?';
my $sthmd5 = $dbh->prepare($SQL);
$count = $sthmd5->execute(" $info->{body} ", $funcname, $info->{args});
if ($count < 1) {
$sthmd5->finish();
}
else {
($oldmd5,$newmd5) = @{$sthmd5->fetchall_arrayref()->[0]};
}
if ($oldmd5 ne $newmd5) {
my $language = $info->{language} || 'plpgsql';
my $volatility = $info->{vol} || 'VOLATILE';
$SQL = "
CREATE OR REPLACE FUNCTION bucardo.$funcname($info->{args})
RETURNS $info->{returns}
LANGUAGE $language
$volatility
SECURITY DEFINER
AS \$clone\$ $info->{body} \$clone\$";
elog(DEBUG, "Writing function $funcname($info->{args})");
$run_sql->($SQL,$dbh);
}
}
## Create the 'kickfunc' function as needed
if (exists $bfunctionoid{$kickfunc}) {
## We may want to recreate this function
if ($force{all} or $force{funcs} or $force{kickfunc}) {
$dbh->do(qq{DROP FUNCTION bucardo."$kickfunc"()});
delete $bfunctionoid{$kickfunc};
}
}
if (! exists $bfunctionoid{$kickfunc}) {
## We may override this later on with a custom function from bucardo_custom_trigger
## and we may not even use it all, but no harm in creating the stock one here
my $notice = $dbh->{pg_server_version} >= 90000
? qq{bucardo, 'kick_sync_$syncname'}
: qq{"bucardo_kick_sync_$syncname"};
$SQL = qq{
CREATE OR REPLACE FUNCTION bucardo."$kickfunc"()
RETURNS TRIGGER
VOLATILE
LANGUAGE plpgsql
AS \$notify\$
BEGIN
EXECUTE \$nn\$NOTIFY $notice\$nn\$;
RETURN NEW;
END;
\$notify\$;
};
$run_sql->($SQL,$dbh);
}
## Create the bucardo_delta_names table as needed
if (! exists $btableoid{'bucardo_delta_names'}) {
$SQL = qq{
CREATE TABLE bucardo.bucardo_delta_names (
sync TEXT,
tablename TEXT,
deltaname TEXT,
trackname TEXT,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
};
$run_sql->($SQL,$dbh);
$SQL = qq{CREATE UNIQUE INDEX bucardo_delta_names_unique ON bucardo.bucardo_delta_names (sync,tablename)};
$run_sql->($SQL,$dbh);
$SQL = qq{
CREATE TRIGGER bucardo_delta_namemaker
BEFORE INSERT OR UPDATE
ON bucardo.bucardo_delta_names
FOR EACH ROW EXECUTE PROCEDURE bucardo.bucardo_delta_names_helper();
};
$run_sql->($SQL,$dbh);
}
## Create the bucardo_delta_targets table as needed
if (! exists $btableoid{'bucardo_delta_targets'}) {
$SQL = qq{
CREATE TABLE bucardo.bucardo_delta_targets (
tablename OID NOT NULL,
target TEXT NOT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
};
$run_sql->($SQL,$dbh);
}
## Rename the target column from 'sync' as older versions used that
$sth = $sth{hazcol};
$count = $sth->execute('bucardo', 'bucardo_delta_targets', 'sync');
$sth->finish();
if (1 == $count) {
## Change the name!
$SQL = qq{ALTER TABLE bucardo.bucardo_delta_targets RENAME sync TO target};
$run_sql->($SQL,$dbh);
}
## Check for missing 'target' column in the bucardo_delta_target table
$sth = $sth{hazcol};
$count = $sth->execute('bucardo', 'bucardo_delta_targets', 'target');
$sth->finish();
if ($count < 1) {
## As the new column cannot be null, we have to delete existing entries!
## However, missing this column is a pretty obscure corner-case
$SQL = qq{DELETE FROM bucardo.bucardo_delta_targets};
$run_sql->($SQL,$dbh);
$SQL = qq{
ALTER TABLE bucardo.bucardo_delta_targets
ADD COLUMN target TEXT NOT NULL;
};
$run_sql->($SQL,$dbh);
}
## Get a list of oids and relkinds for all of our goats
## This is much faster than doing individually
$SQL = q{SELECT n.nspname,c.relname,relkind,c.oid FROM pg_class c JOIN pg_namespace n ON (n.oid = c.relnamespace) WHERE };
my @args;
for my $schema (sort keys %goat) {
for my $table (sort keys %{$goat{$schema}}) {
$SQL .= '(nspname = ? AND relname = ?) OR ';
push @args => $schema, $table;
}
}
$SQL =~ s/OR $//;
$sth = $dbh->prepare($SQL);
$sth->execute(@args);
my %tableoid;
my %sequenceoid;
for my $row (@{$sth->fetchall_arrayref()}) {
if ($row->[2] eq 'r') {
$tableoid{"$row->[0].$row->[1]"} = $row->[3];
}
if ($row->[2] eq 'S') {
$sequenceoid{"$row->[0].$row->[1]"} = $row->[3];
}
}
## Grab all the information inside of bucardo_delta_targets
my $targetname = "dbgroup $info->{dbs}";
$SQL = 'SELECT DISTINCT tablename FROM bucardo.bucardo_delta_targets WHERE target = ?';
$sth = $dbh->prepare($SQL);
$sth->execute($targetname);
my $targetoid = $sth->fetchall_hashref('tablename');
## Populate bucardo_delta_targets with this dbgroup name
$SQL = 'INSERT INTO bucardo.bucardo_delta_targets(tablename,target) VALUES (?,?)';
my $stha = $dbh->prepare($SQL);
for my $schema (sort keys %goat) {
for my $table (sort keys %{$goat{$schema}}) {
next if ! exists $tableoid{"$schema.$table"};
my $oid = $tableoid{"$schema.$table"};
next if exists $targetoid->{$oid};
$stha->execute($oid, $targetname);
}
}
## Delete any tables that are no longer in the database.
$dbh->do(q{
DELETE FROM bucardo.bucardo_delta_targets
WHERE tablename NOT IN (select oid from pg_class)
});
## Create the bucardo_truncate_trigger table as needed
if (! exists $btableoid{'bucardo_truncate_trigger'}) {
$SQL = qq{
CREATE TABLE bucardo.bucardo_truncate_trigger (
tablename OID NOT NULL,
sname TEXT NOT NULL,
tname TEXT NOT NULL,
sync TEXT NOT NULL,
replicated TIMESTAMPTZ NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
};
$run_sql->($SQL,$dbh);
$SQL = q{CREATE INDEX bucardo_truncate_trigger_index ON }
. q{bucardo.bucardo_truncate_trigger (sync, tablename) WHERE replicated IS NULL};
$run_sql->($SQL,$dbh);
}
## Create the bucardo_truncate_trigger_log table as needed
if (! exists $btableoid{'bucardo_truncate_trigger_log'}) {
$SQL = qq{
CREATE TABLE bucardo.bucardo_truncate_trigger_log (
tablename OID NOT NULL,
sname TEXT NOT NULL,
tname TEXT NOT NULL,
sync TEXT NOT NULL,
target TEXT NOT NULL,
replicated TIMESTAMPTZ NOT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
};
$run_sql->($SQL,$dbh);
}
if (exists $btableoid{'bucardo_sequences'}) {
## Check for older version of bucardo_sequences table
$SQL = q{SELECT count(*) FROM pg_attribute WHERE attname = 'targetname' }
.q{ AND attrelid = (SELECT c.oid FROM pg_class c, pg_namespace n }
.q{ WHERE n.oid = c.relnamespace AND n.nspname = 'bucardo' }
.q{ AND c.relname = 'bucardo_sequences')};
if ($dbh->selectall_arrayref($SQL)->[0][0] < 1) {
warn "Dropping older version of bucardo_sequences, then recreating empty\n";
$dbh->do('DROP TABLE bucardo.bucardo_sequences');
delete $btableoid{'bucardo_sequences'};
}
}
if (! exists $btableoid{'bucardo_sequences'}) {
$SQL = qq{
CREATE TABLE bucardo.bucardo_sequences (
schemaname TEXT NOT NULL,
seqname TEXT NOT NULL,
syncname TEXT NOT NULL,
targetname TEXT NOT NULL,
last_value BIGINT NOT NULL,
start_value BIGINT NOT NULL,
increment_by BIGINT NOT NULL,
max_value BIGINT NOT NULL,
min_value BIGINT NOT NULL,
is_cycled BOOL NOT NULL,
is_called BOOL NOT NULL
);
};
$run_sql->($SQL,$dbh);
$SQL = q{CREATE UNIQUE INDEX bucardo_sequences_tablename ON }
. q{bucardo.bucardo_sequences (schemaname, seqname, syncname, targetname)};
$run_sql->($SQL,$dbh);
}
} ## end not fullcopy / all global items
## Build another list of information for each table
## This saves us multiple lookups
$SQL = q{SELECT n.nspname,c.relname,relkind,c.oid FROM pg_class c JOIN pg_namespace n ON (n.oid = c.relnamespace) WHERE };
my $SQL2 = q{INSERT INTO bucardo.bucardo_delta_names VALUES };
my (@args,@tablelist);
for my $schema (sort keys %goat) {
for my $table (sort keys %{$goat{$schema}}) {
## Map to the actual table name used, via the customname table
my ($remoteschema,$remotetable) = ($schema,$table);
## The internal ID for this table
my $id = $goat{$schema}{$table}{id};
## Is this a source or target database?
## Only pure targets can have a customname
my $is_target = $role eq 'target';
if ($is_target and exists $customname{$id}) {
## If there is an entry for this particular database, use that
## Otherwise, if there is a database-wide one, use that
if (exists $customname{$id}{$dbname} or exists $customname{$id}{''}) {
$remotetable = $customname{$id}{$dbname} || $customname{$id}{''};
## If this has a dot, change the schema as well
## Otherwise, we simply use the existing schema
if ($remotetable =~ s/(.+)\.//) {
$remoteschema = $1;
}
}
}
$SQL .= '(nspname = ? AND relname = ?) OR ';
push @args => $remoteschema, $remotetable;
if ($goat{$schema}{$table}{reltype} eq 'table') {
push @tablelist => $syncname, $remoteschema, $remotetable;
}
} ## end each table
} ## end each schema
$SQL =~ s/OR $//;
$sth = $dbh->prepare($SQL);
$sth->execute(@args);
my (%goatoid,@tableoids);
for my $row (@{$sth->fetchall_arrayref()}) {
$goatoid{"$row->[0].$row->[1]"} = [$row->[2],$row->[3]];
push @tableoids => $row->[3] if $row->[2] eq 'r';
}
## Populate the bucardo_delta_names table for this sync
if ($role eq 'source' and ! $is_fullcopy and @tablelist) {
$SQL = 'DELETE FROM bucardo.bucardo_delta_names WHERE sync = ?';
$sth = $dbh->prepare($SQL);
$sth->execute($syncname);
$SQL = $SQL2;
my $number = @tablelist / 3;
$SQL .= q{(?,quote_ident(?)||'.'||quote_ident(?)),} x $number;
chop $SQL;
$sth = $dbh->prepare($SQL);
$sth->execute(@tablelist);
}
## Get column information about all of our tables
$SQL = q{
SELECT attrelid, attname, quote_ident(attname) AS qattname, atttypid, format_type(atttypid, atttypmod) AS ftype,
attnotnull, atthasdef, attnum,
(SELECT pg_get_expr(adbin, adrelid) FROM pg_attrdef WHERE adrelid=attrelid
AND adnum=attnum AND atthasdef) AS def
FROM pg_attribute
WHERE attrelid IN (COLIST) AND attnum > 0 AND NOT attisdropped
ORDER BY attnum
};
my $columninfo;
if (@tableoids) {
$SQL =~ s/COLIST/join ',' => @tableoids/e;
$sth = $dbh->prepare($SQL);
$sth->execute();
for my $row (@{ $sth->fetchall_arrayref({}) }) {
my $oid = $row->{attrelid};
$columninfo->{$oid}{$row->{attname}} = $row;
}
}
## Check out each table in turn
SCHEMA: for my $schema (sort keys %goat) {
## Does this schema exist?
$sth = $sth{hazschema};
$count = $sth->execute($schema);
$sth->finish();
if ($count < 1) {
die qq{Could not find schema "$schema" in database "$dbname"!\n};
}
TABLE: for my $table (sort keys %{$goat{$schema}}) {
## Map to the actual table name used, via the customname table
my ($remoteschema,$remotetable) = ($schema,$table);
## The internal ID for this table
my $id = $goat{$schema}{$table}{id};
## Is this a source or target database?
## Only pure targets can have a customname
my $is_target = $role eq 'target';
if ($is_target and exists $customname{$id}) {
## If there is an entry for this particular database, use that
## Otherwise, if there is a database-wide one, use that
if (exists $customname{$id}{$dbname} or exists $customname{$id}{''}) {
$remotetable = $customname{$id}{$dbname} || $customname{$id}{''};
## If this has a dot, change the schema as well
## Otherwise, we simply use the existing schema
if ($remotetable =~ s/(.+)\.//) {
$remoteschema = $1;
}
}
}
if (! exists $goatoid{"$remoteschema.$remotetable"}) {
die qq{Could not find "$remotetable" inside the "$remoteschema" schema on database "$dbname"!\n};
}
my ($relkind,$oid) = @{ $goatoid{"$remoteschema.$remotetable"} };
## Verify that this is the kind of relation we expect it to be
my $tinfo = $goat{$schema}{$table};
if ('r' eq $relkind) {
if ('table' ne $tinfo->{reltype}) {
die qq{Found "$remoteschema.$remotetable" on database "$dbname", but it's a table, not a $tinfo->{reltype}!};
}
}
elsif ('S' eq $relkind) {
if ('sequence' ne $tinfo->{reltype}) {
die qq{Found "$remoteschema.$remotetable" on database "$dbname", but it's a sequence, not a $tinfo->{reltype}!};
}
}
else {
die qq{Found "$remoteschema.$remotetable" on database "$dbname", but it's neither a table nor a sequence!};
}
## Nothing further needed if it's a sequence
next TABLE if $tinfo->{reltype} eq 'sequence';
## Get the escaped version of things
my $safeschema = $tinfo->{safeschema};
my $safetable = $tinfo->{safetable};
## Go through each column in the tables to check against the other databases
if (! exists $columninfo->{$oid}) {
$sth->finish();
die qq{Could not determine column information for table "$remoteschema.$remotetable"!\n};
}
my $colinfo = $columninfo->{$oid};
## Allow for 'dead' columns in the attnum ordering
## Turn the old keys (attname) into new keys (number)
$x=1;
for (sort { $colinfo->{$a}{attnum} <=> $colinfo->{$b}{attnum} } keys %$colinfo) {
$colinfo->{$_}{realattnum} = $x++;
}
## Things that will cause it to fail this sync
my @problem;
## Things that are problematic but not a show-stopper
my @warning;
## Is this the first time we've seen this table?
## If so, this becomes canonical entry
my $t = "$schema.$table";
if (! exists $col{$t}) {
$col{$t} = $colinfo; ## hashref: key is column name
$col{db} = $dbname;
}
else { ## Seen this before, so check against canonical list
## First, any columns that exist on a source but not this one is not allowed
for my $c1 (sort keys %{$col{$t}}) {
if (! exists $colinfo->{$c1}) {
push @problem => "Column $t.$c1 exists on db $col{db} but not on db $dbname";
}
}
## Any columns that exist here but not the original source may be a problem
for my $c2 (sort keys %$colinfo) {
if (! exists $col{$t}{$c2}) {
my $msg = "Column $t.$c2 exists on db $dbname but not on db $col{db}";
if ($role eq 'source') {
push @problem => $msg;
} else {
push @warning => $msg;
}
next; ## Skip to next column
}
my $c1 = $col{$t}{$c2};
## Must be in the same order so we can COPY smoothly
## Someday we can consider using a custom COPY list if the server supports it
if ($c1->{realattnum} != $c2->{realattnum}) {
push @problem => "Column $t.$c1 is in position $c2->{realattnum} on db $col{db}"
. " but in position $c1->{realattnum} on db $dbname";
}
## Must be the same (or very compatible) datatypes
if ($c1->{ftype} ne $c2->{ftype}) {
$msg = "Column $t.$c1 is type $c1->{ftype} on db $col{db} but type $c2->{ftype} on db $dbname";
## Carve out some known exceptions (but still warn about them)
## Allowed: varchar == text
if (($c1->{ftype} eq 'character varying' and $c2->{ftype} eq 'text') or
($c2->{ftype} eq 'character varying' and $c1->{ftype} eq 'text')) {
push @warning => $msg;
} else {
push @problem => $msg;
}
}
## Warn of a notnull mismatch
if ($c1->{attnotnull} != $c2->{attnotnull}) {
push @warning => sprintf 'Column %s on db %s is %s but %s on db %s',
"$t.$c1", $col{db},
$c1->{attnotnull} ? 'NOT NULL' : 'NULL',
$c2->{attnotnull} ? 'NOT NULL' : 'NULL',
$dbname;
}
## Warn of DEFAULT existence mismatch
if ($c1->{atthasdef} != $c2->{atthasdef}) {
push @warning => sprintf 'Column %s on db %s %s but %s on db %s',
"$t.$c1", $col{db},
$c1->{atthasdef} ? 'has a DEFAULT value' : 'has no DEFAULT value',
$c2->{attnotnull} ? 'has none' : 'does',
$dbname;
}
} ## end each column to check
} ## end check this against previous source db
if (@problem) {
$msg = "Column verification failed:\n";
$msg .= join "\n" => @problem;
die $msg;
}
if (@warning) {
$msg = "Warnings found on column verification:\n";
$msg .= join "\n" => @warning;
warn $msg;
}
## If this is not a source database, we don't need to go any further
next if $role ne 'source';
## If this is a fullcopy only sync, also don't need to go any further
next if $is_fullcopy;
## This is a source database and we need to track changes.
## First step: a way to add things to the bucardo_delta table
## We can only put a truncate trigger in if the database is 8.4 or higher
if ($dbh->{pg_server_version} >= 80400) {
## Figure out the name of this trigger
my $trunctrig = $namelen <= 42
? "bucardo_note_trunc_$syncname" : $namelen <= 54
? "btrunc_$syncname"
: sprintf 'bucardo_note_trunc_%d', int (rand(88888) + 11111);
if (! exists $btriggerinfo{$schema}{$table}{$trunctrig}) {
$SQL = qq{
CREATE TRIGGER "$trunctrig"
AFTER TRUNCATE ON "$schema"."$table"
FOR EACH STATEMENT EXECUTE PROCEDURE bucardo.bucardo_note_truncation('$syncname')
};
$run_sql->($SQL,$dbh);
}
}
$SQL = "SELECT bucardo.bucardo_tablename_maker(?)";
my $makername = $fetch1_sql->($SQL,$dbh,$schema.'_'.$table);
## Create this table if needed, with one column per PK columns
my $delta_table = "delta_$makername";
my $index1_name = "dex1_$makername";
my $index2_name = "dex2_$makername";
my $deltafunc = "delta_$makername";
my $track_table = "track_$makername";
my $index3_name = "dex3_$makername";
my $stage_table = "stage_$makername";
## Need to account for quoted versions, e.g. names with spaces
if ($makername =~ s/"//g) {
$delta_table = qq{"delta_$makername"};
$index1_name = qq{"dex1_$makername"};
$index2_name = qq{"dex2_$makername"};
$deltafunc = qq{"delta_$makername"};
$track_table = qq{"track_$makername"};
$index3_name = qq{"dex3_$makername"};
$stage_table = qq{"stage_$makername"};
}
## Also need non-quoted versions to feed to execute()
(my $noquote_delta_table = $delta_table) =~ s/^"(.+)"$/$1/;
(my $noquote_index1_name = $index1_name) =~ s/^"(.+)"$/$1/;
(my $noquote_index2_name = $index2_name) =~ s/^"(.+)"$/$1/;
(my $noquote_deltafunc = $deltafunc) =~ s/^"(.+)"$/$1/;
(my $noquote_track_table = $track_table) =~ s/^"(.+)"$/$1/;
(my $noquote_index3_name = $index3_name) =~ s/^"(.+)"$/$1/;
(my $noquote_stage_table = $stage_table) =~ s/^"(.+)"$/$1/;
if (! exists $btableoid{$noquote_delta_table}) {
## Create that table!
my $pkcols = join ',' => map { qq{"$_"} } split (/\|/ => $tinfo->{pkey});
$SQL = qq{
CREATE TABLE bucardo.$delta_table
AS SELECT $pkcols, now()::TIMESTAMPTZ AS txntime
FROM "$schema"."$table" LIMIT 0
};
$run_sql->($SQL,$dbh);
$SQL = qq{
ALTER TABLE bucardo.$delta_table
ALTER txntime SET NOT NULL,
ALTER txntime SET DEFAULT now()
};
$run_sql->($SQL, $dbh);
}
## Need an index on the txntime column
if (! exists $bindexoid{$noquote_index1_name}) {
$SQL = qq{CREATE INDEX $index1_name ON bucardo.$delta_table(txntime)};
$run_sql->($SQL, $dbh);
}
## Need an index on all other columns
if (! exists $bindexoid{$noquote_index2_name}) {
my $pkcols = join ',' => map { qq{"$_"} } split (/\|/ => $tinfo->{pkey});
$SQL = qq{CREATE INDEX $index2_name ON bucardo.$delta_table($pkcols)};
$run_sql->($SQL, $dbh);
}
## Track any change (insert/update/delete) with an entry in bucardo_delta
## Trigger function to add any changed primary key rows to this new table
## TODO: Check for too long of a name
## Function is same as the table name?
my @pkeys = split (/\|/ => $tinfo->{pkey});
if (! exists $bfunctionoid{$noquote_deltafunc}) {
my $new = join ',' => map { qq{NEW."$_"} } @pkeys;
my $old = join ',' => map { qq{OLD."$_"} } @pkeys;
my $clause = join ' OR ' => map { qq{OLD."$_" <> NEW."$_"} } @pkeys;
$SQL = qq{
CREATE OR REPLACE FUNCTION bucardo.$deltafunc()
RETURNS TRIGGER
LANGUAGE plpgsql
SECURITY DEFINER
VOLATILE
AS
\$clone\$
BEGIN
IF (TG_OP = 'INSERT') THEN
INSERT INTO bucardo.$delta_table VALUES ($new);
ELSIF (TG_OP = 'UPDATE') THEN
INSERT INTO bucardo.$delta_table VALUES ($old);
IF ($clause) THEN
INSERT INTO bucardo.$delta_table VALUES ($new);
END IF;
ELSE
INSERT INTO bucardo.$delta_table VALUES ($old);
END IF;
RETURN NULL;
END;
\$clone\$;
};
$run_sql->($SQL,$dbh);
}
## Check if the bucardo_delta is a custom function, and create if needed
$SQL = qq{SELECT trigger_language,trigger_body FROM bucardo_custom_trigger
WHERE goat=$tinfo->{id}
AND status='active'
AND trigger_type='delta'
};
elog(DEBUG, "Running $SQL");
$rv = spi_exec_query($SQL);
my $customdeltafunc = '';
if ($rv->{processed}) {
my $customdeltafunc = "bucardo_delta_$tinfo->{id}";
if (! exists $bfunctionoid{$customdeltafunc}) {
$SQL = qq{
CREATE OR REPLACE FUNCTION bucardo."$customdeltafunc"()
RETURNS TRIGGER
LANGUAGE $rv->{rows}[0]{trigger_language}
SECURITY DEFINER
VOLATILE
AS
\$clone\$
};
$SQL .= qq{ $rv->{rows}[0]{trigger_body} };
$SQL .= qq{ \$clone\$; };
$run_sql->($SQL,$dbh);
}
}
if (! exists $btriggerinfo{$schema}{$table}{'bucardo_delta'}) {
my $func = $customdeltafunc || $deltafunc;
$SQL = qq{
CREATE TRIGGER bucardo_delta
AFTER INSERT OR UPDATE OR DELETE ON "$schema"."$table"
FOR EACH ROW EXECUTE PROCEDURE bucardo.$func()
};
$run_sql->($SQL,$dbh);
}
## Now the 'track' table
if (! exists $btableoid{$noquote_track_table}) {
$SQL = qq{
CREATE TABLE bucardo.$track_table (
txntime TIMESTAMPTZ,
target TEXT
);
};
$run_sql->($SQL,$dbh);
}
## Need to index both columns of the txntime table
if (! exists $bindexoid{$noquote_index3_name}) {
$SQL = qq{CREATE INDEX $index3_name ON bucardo.$track_table(target text_pattern_ops, txntime)};
$run_sql->($SQL,$dbh);
}
## The 'stage' table, which feeds 'track' once targets have committed
if (! exists $btableoid{$noquote_stage_table}) {
my $unlogged = $dbh->{pg_server_version} >= 90100 ? 'UNLOGGED' : '';
$SQL = qq{
CREATE $unlogged TABLE bucardo.$stage_table (
txntime TIMESTAMPTZ,
target TEXT
);
};
$run_sql->($SQL,$dbh);
}
my $indexname = 'bucardo_delta_target_unique';
if (! exists $bindexoid{$indexname}) {
$dbh->do(qq{CREATE INDEX $indexname ON bucardo.bucardo_delta_targets(tablename,target)});
$bindexoid{$indexname} = 1;
}
## Override the 'autokick' kick trigger if needed
$SQL = qq{SELECT trigger_language,trigger_body,trigger_level FROM bucardo_custom_trigger
WHERE goat=$tinfo->{id}
AND status='active'
AND trigger_type='triggerkick'
};
elog(DEBUG, "Running $SQL");
$rv = spi_exec_query($SQL);
if ($rv->{processed}) {
my $custom_function_name = "bucardo_triggerkick_$tinfo->{id}";
if (! exists $bfunctionoid{$custom_function_name}) {
my $custom_trigger_level = $rv->{rows}[0]{trigger_level};
$SQL = qq{
CREATE OR REPLACE FUNCTION bucardo."$custom_function_name"()
RETURNS TRIGGER
LANGUAGE $rv->{rows}[0]{trigger_language}
AS \$notify\$
};
$SQL .= qq{ $rv->{rows}[0]{trigger_body} };
$SQL .= qq{ \$notify\$; };
}
}
## Add in the autokick triggers as needed
## Skip if autokick is false
if ($info->{autokick} eq 'f') {
if (exists $btriggerinfo{$schema}{$table}{$kickfunc}) {
$SQL = qq{DROP TRIGGER "$kickfunc" ON $safeschema.$safetable};
## This is important enough that we want to be verbose about it:
warn "Dropped trigger $kickfunc from table $safeschema.$safetable\n";
$run_sql->($SQL,$dbh);
delete $btriggerinfo{$schema}{$table}{$kickfunc};
}
next TABLE;
}
if (! exists $btriggerinfo{$schema}{$table}{$kickfunc}) {
my $ttrig = $dbh->{pg_server_version} >= 80400 ? ' OR TRUNCATE' : '';
my $custom_trigger_level = '';
my $custom_function_name = '';
if ($custom_trigger_level && $custom_function_name) {
$SQL = qq{
CREATE TRIGGER "$kickfunc" FIXMENAME
AFTER INSERT OR UPDATE OR DELETE$ttrig ON $safeschema.$safetable
FOR EACH $custom_trigger_level EXECUTE PROCEDURE bucardo."$custom_function_name"()
};
}
else {
$SQL = qq{
CREATE TRIGGER "$kickfunc"
AFTER INSERT OR UPDATE OR DELETE$ttrig ON $safeschema.$safetable
FOR EACH STATEMENT EXECUTE PROCEDURE bucardo."$kickfunc"()
};
}
$run_sql->($SQL,$dbh);
}
} ## end each TABLE
} ## end each SCHEMA
$dbh->commit();
} ## end connecting to each database
## Gather information from bucardo_config
my $config;
$SQL = 'SELECT name,setting FROM bucardo_config';
$rv = spi_exec_query($SQL);
for my $row (@{$rv->{rows}}) {
$config->{$row->{setting}} = $row->{value};
}
## Update the bucardo_delta_targets table as needed
## FIXME FROM old
#if ($info->{synctype} eq 'swap') {
## Add source to the target(s)
## MORE FIXME
#}
## Disconnect from all our databases
for (values %{$cache{dbh}}) {
$_->disconnect();
}
## Let anyone listening know that we just finished the validation
$SQL = qq{NOTIFY "bucardo_validated_sync_$syncname"};
spi_exec_query($SQL);
elog(LOG, "Ending validate_sync for $syncname");
return 'MODIFY';
$bc$;
-- end of validate_sync
CREATE OR REPLACE FUNCTION bucardo.validate_sync(text)
RETURNS TEXT
LANGUAGE SQL
AS
$bc$
SELECT bucardo.validate_sync($1,0);
$bc$;
CREATE OR REPLACE FUNCTION bucardo.validate_all_syncs(integer)
RETURNS INTEGER
LANGUAGE plpgsql
AS
$bc$
DECLARE count INTEGER = 0; myrec RECORD;
BEGIN
FOR myrec IN SELECT name FROM sync ORDER BY name LOOP
PERFORM bucardo.validate_sync(myrec.name, $1);
count = count + 1;
END LOOP;
RETURN count;
END;
$bc$;
CREATE OR REPLACE FUNCTION bucardo.validate_all_syncs()
RETURNS INTEGER
LANGUAGE SQL
AS
$bc$
SELECT bucardo.validate_all_syncs(0);
$bc$;
CREATE FUNCTION bucardo.validate_sync()
RETURNS TRIGGER
LANGUAGE plperlu
SECURITY DEFINER
AS $bc$
use strict; use warnings;
elog(DEBUG, "Starting validate_sync trigger");
my $new = $_TD->{new};
my $found=0;
## If insert, we always do the full validation:
if ($_TD->{event} eq 'INSERT') {
elog(DEBUG, "Found insert, will call validate_sync");
$found = 1;
}
else {
my $old = $_TD->{old};
for my $x (qw(name herd dbs autokick)) {
elog(DEBUG, "Checking on $x");
if (! defined $old->{$x}) {
next if ! defined $new->{$x};
}
elsif (defined $new->{$x} and $new->{$x} eq $old->{$x}) {
next;
}
$found=1;
last;
}
}
if ($found) {
spi_exec_query("SELECT validate_sync('$new->{name}')");
}
return;
$bc$;
CREATE TRIGGER validate_sync
AFTER INSERT OR UPDATE ON bucardo.sync
FOR EACH ROW EXECUTE PROCEDURE bucardo.validate_sync();
CREATE FUNCTION bucardo.bucardo_delete_sync()
RETURNS TRIGGER
LANGUAGE plperlu
SECURITY DEFINER
AS $bc$
use strict; use warnings;
elog(DEBUG, "Starting delete_sync trigger");
my $old = $_TD->{old};
my ($SQL, $rv, $sth, $count);
## Gather up a list of tables used in this sync, as well as the source database handle
(my $herd = $old->{herd}) =~ s/'/''/go;
## Does this herd exist?
$SQL = qq{SELECT 1 FROM herd WHERE name = '$herd'};
$rv = spi_exec_query($SQL);
if (!$rv->{processed}) {
#elog(ERROR, "Cannot delete: sync refers to an invalid relgroup: $herd");
}
$SQL = qq{
SELECT db, pg_catalog.quote_ident(schemaname) AS safeschema,
pg_catalog.quote_ident(tablename) AS safetable
FROM goat g, herdmap h
WHERE g.id = h.goat
AND h.herd = '$herd'
};
$rv = spi_exec_query($SQL);
if (!$rv->{processed}) {
elog(DEBUG, 'Relgroup has no members, so no further work needed');
return;
}
## TODO: Reach out and clean up remote databases as before if needed
return;
$bc$;
CREATE TRIGGER bucardo_delete_sync
AFTER DELETE ON bucardo.sync
FOR EACH ROW EXECUTE PROCEDURE bucardo.bucardo_delete_sync();
CREATE OR REPLACE FUNCTION bucardo.find_unused_goats()
RETURNS SETOF text
LANGUAGE plpgsql
AS $bc$
DECLARE
myrec RECORD;
BEGIN
FOR myrec IN
SELECT quote_ident(db) || '.' || quote_ident(schemaname) || '.' || quote_ident(tablename) AS t
FROM goat g
WHERE NOT EXISTS (SELECT 1 FROM herdmap h WHERE h.goat = g.id)
ORDER BY schemaname, tablename
LOOP
RETURN NEXT 'Not used in any herds: ' || myrec.t;
END LOOP;
FOR myrec IN
SELECT quote_ident(db) || '.' || quote_ident(schemaname) || '.' || quote_ident(tablename) AS t
FROM goat g
JOIN herdmap h ON h.goat = g.id
WHERE NOT EXISTS (SELECT 1 FROM sync WHERE source = h.herd)
ORDER BY schemaname, tablename
LOOP
RETURN NEXT 'Not used in source herd: ' || myrec.t;
END LOOP;
FOR myrec IN
SELECT quote_ident(db) || '.' || quote_ident(schemaname) || '.' || quote_ident(tablename) AS t
FROM goat g
JOIN herdmap h ON h.goat = g.id
WHERE NOT EXISTS (SELECT 1 FROM sync WHERE source = h.herd AND status = 'active')
ORDER BY schemaname, tablename
LOOP
RETURN NEXT 'Not used in source herd of active sync: ' || myrec.t;
END LOOP;
RETURN;
END;
$bc$;
-- Monitor how long data takes to move over, from commit to commit
CREATE TABLE bucardo.bucardo_rate (
sync TEXT NOT NULL,
goat INTEGER NOT NULL,
target TEXT NULL,
mastercommit TIMESTAMPTZ NOT NULL,
slavecommit TIMESTAMPTZ NOT NULL,
total INTEGER NOT NULL
);
COMMENT ON TABLE bucardo.bucardo_rate IS $$If track_rates is on, measure how fast replication occurs$$;
CREATE INDEX bucardo_rate_sync ON bucardo.bucardo_rate(sync);
-- Keep track of any upgrades as we go along
CREATE TABLE bucardo.upgrade_log (
action TEXT NOT NULL,
summary TEXT NOT NULL,
version TEXT NOT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.upgrade_log IS $$Historical record of upgrade actions$$;
INSERT INTO bucardo.upgrade_log(action,summary,version)
SELECT 'Initial install', '', setting
FROM bucardo.bucardo_config
WHERE name = 'bucardo_initial_version';
-- Allow users to insert messages in the Bucardo logs
CREATE FUNCTION bucardo.bucardo_log_message_notify()
RETURNS TRIGGER
LANGUAGE plpgsql
AS $bc$
BEGIN
EXECUTE 'NOTIFY "bucardo_log_message"';
RETURN NULL;
END;
$bc$;
CREATE TABLE bucardo.bucardo_log_message (
msg TEXT NOT NULL,
cdate TIMESTAMPTZ NOT NULL DEFAULT now()
);
COMMENT ON TABLE bucardo.bucardo_log_message IS $$Helper table for sending messages to the Bucardo logging system$$;
CREATE TRIGGER bucardo_log_message_trigger
AFTER INSERT ON bucardo.bucardo_log_message
FOR EACH STATEMENT EXECUTE PROCEDURE bucardo.bucardo_log_message_notify();
CREATE FUNCTION bucardo.magic_update()
RETURNS TEXT
LANGUAGE plpgsql
AS $bc$
DECLARE
myver INTEGER;
BEGIN
-- What version are we?
SELECT INTO myver setting FROM pg_settings WHERE name = 'server_version_num';
-- If we are 9.1 or better, change some tables to UNLOGGED
IF myver >= 90100 THEN
-- bucardo.dbrun: DROP, RECREATE, or SET an attribute?
END IF; -- end of Postgres 9.1 and up
RETURN ''::TEXT;
END;
$bc$;
SELECT bucardo.magic_update();
SELECT plperlu_test();
COMMIT;
--
-- END OF THE SCHEMA
--
Bucardo-5.4.1/.gitignore0000644000175000017500000000072612563002233013523 0ustar greggreg## Build constructs:
Makefile
Makefile.old
MANIFEST.bak
*.gz
blib/
none/
pm_to_blib
MYMETA.*
## Editor temporary files:
*~
*.swp
*#
.#*
## Git stuff
*.blame
/*.patch
*.diff
*.orig
*.rej
## Testing artifacts:
bucardo_test_database_*
*.log
log.bucardo
bucardo.restart.reason.*
test.*
bucardo_pgservice.tmp.*
pid/*
## Temporary files:
tmp/
*.tmp
*.asc
*.tar
pop
scrap
uno
dos
tres
cuatro
gitlog
## Local things:
notes.*
.bucardorc
opensourceshakespeare/
hot/
examples/Bucardo-5.4.1/bucardo0000755000175000017500000127735412601643436013127 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil; cperl-indent-level: 4-*-
## Script to control Bucardo
##
## Copyright 2006-2015 Greg Sabino Mullane
##
## 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.4.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;
}
my $had_stopfile = -e $STOPFILE;
## Just in case, stop it
stop_bucardo();
if ($had_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 3;
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) 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);
my $oldvalue = $DB->{$name}{$newname};
## We want certain booleans to appear as "off/on"
if ($setting =~ /makedelta|server_side_prepares/) {
$oldvalue = $oldvalue ? 'on' : 'off';
## Clean up, but lightly so invalid entries fall through for later
if ($newvalue =~ /^[1tT]/ or $newvalue =~ /^on/i) {
$newvalue = 'on';
}
elsif ($newvalue =~ /^[0fF]/ or $newvalue =~ /^off/i) {
$newvalue = 'off';
}
}
## 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;
}
## 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);
## Which tables were already in the herd, and which were just added
my (@oldnames,@newnames);
for my $name (sort keys %{ $goatlist->{relations} }) {
## Is it already part of this herd?
if (exists $HERD->{$herdname}{goat}{$name} and
$HERD->{$herdname}{goat}{$name}{reltype} eq $reltype) {
push @oldnames => $name;
next;
}
my $db = $goatlist->{relations}{$name}{goat}[0]{db};
my $pri = 0;
$count = $sth->execute($herdname,$pri,$name, $db);
push @newnames => $name;
}
if (@oldnames) {
$message .= qq{The following tables or sequences were already in the relgroup "$herdname":\n};
for (@oldnames) {
$message .= " $_\n";
}
}
if (@newnames) {
$message .= qq{The following tables or sequences are now part of the relgroup "$herdname":\n};
for (sort numbered_relations @newnames) {
$message .= " $_\n";
}
}
} ## end if herd
if (!$QUIET) {
print $message;
}
confirm_commit();
exit 0;
} ## end of add_table
sub remove_relation {
my $reltype = shift;
my $arg = shift || '';
my $doc_section = 'remove';
if (!@nouns and $arg ne 'all') {
usage_exit($doc_section);
}
my $db_filter;
for my $name ( @nouns ) {
next unless $name =~ /^db=(.*)/;
$db_filter = $1;
}
my @removed;
if ($arg eq 'all') {
if (! $bcargs->{batch}) {
print "Are you sure you want to remove all ${reltype}s? ";
exit if !~ /Y/i;
}
$SQL = q{DELETE FROM bucardo.goat WHERE id = ?};
$sth = $dbh->prepare($SQL);
for my $tid ( sort { $a <=> $b } keys %{$GOAT->{by_id}}) {
my $t = $GOAT->{by_id}{$tid};
next if $t->{reltype} ne $reltype;
$count = $sth->execute($tid);
if (1 == $count) {
push @removed => "$t->{schemaname}.$t->{tablename}";
}
}
}
else {
## Prepare our SQL
$SQL = q{DELETE FROM bucardo.goat WHERE reltype = ? AND schemaname||'.'||tablename = ?};
$SQL .= ' AND db = ?' if $db_filter;
$sth = $dbh->prepare($SQL);
## Bucardo won't fully support a table name that starts with "db=". Darn.
for my $name (grep { ! /^db=/ } @nouns) {
if ($name =~ /^\w[\w\d]*\.\w[\w\d]*$/) {
if (! exists $GOAT->{by_fullname}{$name}) {
print qq{No such $reltype: $name\n};
next;
}
eval {
if ($db_filter) {
$sth->execute($reltype, $name, $db_filter);
}
else {
$sth->execute($reltype, $name);
}
};
if ($@) {
die qq{Could not delete $reltype "$name"\n$@\n};
}
push @removed, $name;
}
else {
die qq{Please use the full schema.$reltype name\n};
}
}
}
if (@removed) {
print "Removed the following ${reltype}s:\n";
for my $name (sort numbered_relations @removed) {
print qq{ $name} . ($db_filter ? " (DB: $db_filter)" : '') . "\n";
}
confirm_commit();
}
else {
print "Nothing found to remove\n";
}
exit 0;
} ## end of remove_relation
sub update_table {
## Update one or more tables
## This may modify the bucardo.goat and bucardo.herdmap tables
## Arguments: two or more
## 1. Table to be updated
## 2+. Items to be adjusted (name=value)
## Returns: undef
## Example: bucardo update table quad ping=false
my @actions = @_;
my $doc_section = 'update/update table';
usage_exit($doc_section) unless @actions;
my $name = shift @actions;
## Recursively call ourselves for wildcards and 'all'
exit 0 if ! check_recurse($GOAT, $name, @actions);
## Make sure this table exists!
my @tables = find_goat_by_item($name, \@nouns);
if (!@tables) {
die qq{Didn't find any matching tables\n};
}
## If this is an array, then see how many matches we have
if ($#tables > 0) {
die qq{More than one matching table: please use a schema\n};
}
my $table = $tables[0];
## Store the id so we work with that alone whenever possible
my $id = $table->{id};
## Everything is a name=value setting after this point, except stuff that
## matches /^db=/
## We will ignore and allow noise word "set"
for my $arg (grep { ! /^db=/ } @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 ' ' => ( grep { ! /^db=/ } @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 (lc $newname eq 'herd' || lc $newname eq 'relgroup') {
## Track the changes and publish at the end
my @herdchanges;
## Grab the current hash of herds
my $oldherd = $table->{herd} || '';
## Keep track of what groups they end up in, so we can remove as needed
my %doneherd;
## Break apart into individual herds
for my $herd (split /\s*,\s*/ => $newvalue) {
## Note that we've found this herd
$doneherd{$herd}++;
## Does this herd exist?
if (! exists $HERD->{$herd}) {
create_herd($herd);
push @herdchanges => qq{Created relgroup "$herd"};
}
## Are we a part of it already?
if ($oldherd and exists $oldherd->{$herd}) {
$QUIET or print qq{No change: table "$name" already belongs to relgroup "$herd"\n};
}
else {
## We are not a part of this herd yet
add_goat_to_herd($herd, $id);
push @herdchanges => qq{Added table "$name" to relgroup "$herd"};
}
} ## end each herd specified
## See if we are removing any herds
if ($oldherd) {
for my $old (sort keys %$oldherd) {
next if exists $doneherd{$old};
## We do not want to remove herds here, but maybe in the future
## we can allow a syntax that does
next;
remove_table_from_herd($name, $old);
push @herdchanges => qq{Removed table "$name" from relgroup "$old"};
}
}
if (@herdchanges) {
for (@herdchanges) {
chomp;
$QUIET or print "$_\n";
}
confirm_commit();
}
## Go to the next setting
next;
} ## end of 'herd' adjustments
## This must exist in our hash
## We assume it is the first entry for now
## Someday be more intelligent about walking and adjusting all matches
if (! exists $table->{$newname}) {
print qq{Cannot change "$newname"\n};
next;
}
my $oldvalue = $table->{$newname};
## May be undef!
$oldvalue = 'NULL' if ! defined $oldvalue;
## 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.goat SET ';
$SQL .= join ',' => map { "$_=?" } sort keys %change;
$SQL .= ' WHERE id = ?';
my $sth = $dbh->prepare($SQL);
eval {
$sth->execute((map { $change{$_}[1] } sort keys %change), $id);
};
if ($@) {
$dbh->rollback();
$dbh->disconnect();
print "Sorry, failed to update the relation. Error was:\n$@\n";
exit 1;
}
for my $item (sort keys %change) {
my ($old,$new) = @{ $change{$item} };
print "Changed relation $item from $old to $new\n";
}
confirm_commit();
}
return;
} ## end of update_table
sub list_tables {
## Show information about all or some tables in the 'goat' table
## Arguments: none (reads nouns for a list of tables)
## Returns: 0 on success, -1 on error
## Example: bucardo list tables
my $doc_section = 'list';
## Might be no tables yet
if (! keys %$TABLE) {
print "No tables have been added yet\n";
return -1;
}
## If not doing all, keep track of which to show
my %matchtable;
my @filters = grep { /^db=/ } @nouns;
for my $term (grep { ! /^db=/ } @nouns) {
## Special case for all: same as no nouns at all, so simply remove them!
if ($term =~ /\ball\b/i) {
undef %matchtable;
undef @nouns;
last;
}
map { $matchtable{$_->{id}} = 1; } find_goat_by_item($term, \@filters);
} ## end each term
## No matches?
if (@nouns and ! keys %matchtable) {
print "No matching tables found\n";
return -1;
}
## Figure out the length of each item for a pretty display
my ($maxid,$maxname,$maxdb,$maxpk) = (1,1,1,1);
for my $row (values %$TABLE) {
my $id = $row->{id};
next if @nouns and ! exists $matchtable{$id};
$maxid = length $id if length $id > $maxid;
my $name = "$row->{schemaname}.$row->{tablename}";
$maxname = length $name if length $name > $maxname;
$maxdb = length $row->{db} if length $row->{db} > $maxdb;
$row->{ppk} = $row->{pkey} ? "$row->{pkey} ($row->{pkeytype})" : 'none';
$maxpk = length $row->{ppk} if length $row->{ppk} > $maxpk;
}
## Now do the actual printing
## Sort by schemaname then tablename
for my $row (sort numbered_relations values %$TABLE) {
next if @nouns and ! exists $matchtable{$row->{id}};
printf '%-*s Table: %-*s DB: %-*s PK: %-*s',
1+$maxid, "$row->{id}.",
$maxname, "$row->{schemaname}.$row->{tablename}",
$maxdb, $row->{db},
$maxpk, $row->{ppk};
if ($row->{sync}) {
printf ' Syncs: ';
print join ',' => sort keys %{ $row->{sync} };
}
if (defined $row->{autokick}) {
printf ' autokick:%s', $row->{autokick} ? 'true' : 'false';
}
if ($row->{rebuild_index}) {
print ' rebuild_index:true';
}
if ($row->{makedelta}) {
print " (makedelta:$row->{makedelta})";
}
print "\n";
$VERBOSE >= 2 and show_all_columns($row);
}
return 0;
} ## end of list_tables
##
## Herd-related subroutines: add, remove, update, list
##
sub add_herd {
## Add a herd aka relgroup. Inserts to the bucardo.herd table
## May also insert to the bucardo.herdmap and bucardo.goat tables
## Arguments: one or more
## 1. Name of the herd
## 2+ Names of tables or sequences to add. Can have wildcards
## Returns: undef
## Example: bucardo add herd foobar tab1 tab2
my $doc_section = 'add/add relgroup';
my $herdname = shift @nouns || '';
## Must have a name
usage_exit($doc_section) unless length $herdname;
## Create the herd if it does not exist
if (exists $HERD->{$herdname}) {
print qq{Relgroup "$herdname" already exists\n};
}
else {
create_herd($herdname);
$QUIET or print qq{Created relgroup "$herdname"\n};
}
## Everything else is tables or sequences to add to this herd
## How many arguments were we given?
my $nouncount = @nouns;
## No sense going on if no nouns!
if (! $nouncount) {
confirm_commit();
exit 0;
}
## Get the list of all requested tables, adding as needed
my $goatlist = get_goat_ids(args => \@nouns, noherd => $herdname);
## 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 .= " $_ (DB: $goatlist->{relations}{$_}{goat}[0]{db})\n";
}
}
## Now load all of these tables into this herd
$SQL = 'INSERT INTO bucardo.herdmap (herd,priority,goat) VALUES (?,?,'
. q{ (SELECT id FROM goat WHERE schemaname||'.'||tablename=? AND db=?))};
$sth = $dbh->prepare($SQL);
my (@oldnames, @newnames);
for my $name (sort keys %{ $goatlist->{relations} }) {
## Is it already part of this herd?
if (exists $HERD->{goat}{$name}) {
push @oldnames => $name;
next;
}
my @a;
eval {
@a = @{$goatlist->{relations}{$name}{goat}};
};
my $doneit;
for my $tmpgoat (@a) {
next if exists $doneit->{$tmpgoat->{id}};
my $db = $tmpgoat->{db};
my $pri = 0;
$count = $sth->execute($herdname,$pri,$name,$db);
push @newnames => $name;
$doneit->{$tmpgoat->{id}}++;
}
}
if (@oldnames) {
$message .= qq{The following tables or sequences were already in the relgroup "$herdname":\n};
for (@oldnames) {
$message .= " $_\n";
}
}
if (@newnames) {
$message .= qq{The following tables or sequences are now part of the relgroup "$herdname":\n};
for (@newnames) {
$message .= " $_\n";
}
}
if (!$QUIET) {
print $message;
}
confirm_commit();
exit 0;
} ## end of add_herd
sub remove_herd {
## Usage: remove herd herdname [herd2 herd3 ...]
## Arguments: none, parses nouns
## Returns: never, exits
my $doc_section = 'remove';
usage_exit($doc_section) unless @nouns;
my $herd = $global{herd};
for my $name (@nouns) {
if (! exists $herd->{$name}) {
die qq{No such relgroup: $name\n};
}
}
$SQL = 'DELETE FROM bucardo.herd WHERE name = ?';
$sth = $dbh->prepare($SQL);
for my $name (@nouns) {
eval {
$sth->execute($name);
};
if ($@) {
if ($@ =~ /"sync_source_herd_fk"/) {
die qq{Cannot delete relgroup "$name": must remove all syncs that reference it first\n};
}
die qq{Could not delete relgroup "$name"\n$@\n};
}
}
for my $name (@nouns) {
print qq{Removed relgroup "$name"\n};
}
$dbh->commit();
exit 0;
} ## end of remove_herd
sub add_goat_to_herd {
die "Adding to a relgroup not implemented yet\n";
}
sub list_herds {
## Show information about all or some subset of the 'herd' table
## Arguments: none, parses nouns for herd names
## Returns: 0 on success, -1 on error
my $doc_section = 'list';
## Any nouns are filters against the whole list
my $clause = generate_clause({col => 'name', items => \@nouns});
my $WHERE = $clause ? "WHERE $clause" : '';
$SQL = "SELECT * FROM bucardo.herd $WHERE ORDER BY name";
$sth = $dbh->prepare($SQL);
$count = $sth->execute();
if ($count < 1) {
$sth->finish();
printf "There are no%s relgroups.\n",
$WHERE ? ' matching' : '';
return -1;
}
$info = $sth->fetchall_arrayref({});
## Get sizing information
my $maxlen = 1;
for my $row (@$info) {
$maxlen = length $row->{name} if length $row->{name} > $maxlen;
}
for my $row (@$info) {
my $name = $row->{name};
my $h = $HERD->{$name};
printf 'Relgroup: %-*s ',
$maxlen, $name;
printf ' DB: %s ', $h->{db} if $h->{db};
## Got goats?
if (exists $h->{goat}) {
print ' Members: ';
print join ', ' => sort {
$h->{goat}{$b}{priority} <=> $h->{goat}{$a}{priority}
or $a cmp $b
} keys %{ $h->{goat} };
}
## Got syncs?
if (exists $h->{sync}) {
print "\n Used in syncs: ";
print join ', ' => sort keys %{$h->{sync}};
}
print "\n";
$VERBOSE >= 2 and show_all_columns($row);
}
return 0;
} ## end of list_herds
##
## Sync-related subroutines: add, remove, update, list
##
sub add_sync {
## Create a new sync by adding an entry to the bucardo.sync table
## Will add tables as needed to the bucardo.goat table
## Will create implicit relgroups as needed
## May modify the goat, herd, and herdmap tables
## Arguments: none (uses nouns)
## Returns: never, exits
my $sync_name = shift @nouns || '';
## If the sync name does not exist or is empty, show a help screen
my $doc_section = 'add/add sync';
usage_exit($doc_section) if ! length $sync_name;
## If this named sync already exists, throw an exception
if (exists $SYNC->{$sync_name}) {
die qq{A sync with the name "$sync_name" already exists\n};
}
## Store a list of messages we can output once we have no errors
my @message;
## Inputs and aliases, database column name, flags, default
my $validcols = qq{
name name 0 $sync_name
relgroup|herd relgroup 0 null
stayalive stayalive TF null
kidsalive kidsalive TF null
autokick|ping autokick TF null
checktime checktime interval null
strict_checking strict_checking TF null
status status =active|inactive null
priority priority numeric null
analyze_after_copy analyze_after_copy TF null
overdue overdue interval null
expired expired interval null
track_rates track_rates TF null
onetimecopy onetimecopy =0|1|2 null
lifetime lifetime interval null
maxkicks maxkicks numeric null
isolation_level|txnmode isolation_level 0 null
rebuild_index|rebuildindex rebuild_index numeric null
dbgroup dbgroup 0 null
conflict_strategy|standard_conflict|conflict conflict_strategy 0 null
relation|relations|table|tables tables 0 null
db|databases|database|databases|dbs dbs 0 null
};
my $morph = [
## Fullcopy syncs get some of their defaults overriden
## The controllers and kids never start automatically,
## and autokick is never on
{
field => 'synctype',
value => 'fullcopy',
new_defaults => 'autokick|F stayalive|F kidsalive|F',
},
## We need isolation level to be dash free for SQL
{
field => 'isolation_level',
dash_to_white => 1,
}
];
## Parse all of our arguments, and convert them per rules above
## We don't use cols and phs and vals in this particular sub!
## Others should be modified someday to also avoid them
my ($dbcols) = process_simple_args({
cols => $validcols,
list => \@nouns,
doc_section => $doc_section,
morph => $morph,
});
## We must know what to replicate: need a relgroup or a list of tables
if (! exists $dbcols->{relgroup} and ! exists $dbcols->{tables}) {
die "Must specify a relgroup (or a list of tables) for this sync\n";
}
## We must know where to replicate: need a dbgroup or a list of databases
if (! exists $dbcols->{dbgroup} and ! exists $dbcols->{dbs}) {
die "Need to specify which dbgroup (or list of databases) for this sync\n";
}
#### RELGROUP
## Determine what relgroup to use
## If one is given, use that; else create a new one
my $relgroup_name;
if (exists $dbcols->{relgroup}) {
## Simple case where they give us the exact relgroup
if (exists $HERD->{ $dbcols->{relgroup} }) {
## We cannot have both an existing relgroup and a list of tables
if (exists $dbcols->{tables}) {
die "Cannot specify an existing relgroup and a list of tables\n";
}
$relgroup_name = $dbcols->{relgroup};
}
## If the relgroup has commas, we treat it as a list of tables
## Otherwise, we create a new relgroup
elsif ($dbcols->{relgroup} !~ /,/) {
$relgroup_name = create_herd( $dbcols->{relgroup}, 'noreload' );
}
}
## DBGROUP
## Determine which dbgroup to use
## We create a unique name as needed later on
my $dbgroup_name;
if (exists $dbcols->{dbgroup}) {
## If this dbgroup already exists, we are done
if (exists $DBGROUP->{ $dbcols->{dbgroup} }) {
## We cannot have both an existing dbgroup and a list of databases
if (exists $dbcols->{dbs}) {
die "Cannot specify an existing dbgroup and a list of databases\n";
}
$dbgroup_name = $dbcols->{dbgroup};
}
## If the dbgroup has commas, we treat it as a list of databases
## Otherwise, we create a new dbgroup
elsif ($dbcols->{dbgroup} !~ /,/) {
$dbgroup_name = create_dbgroup( $dbcols->{dbgroup}, 'noreload' );
}
}
## Before we potentially create a unique dbgroup name
## we need to process all of our databases, to see
## if this combo matches an existing dbgroup
#### DB
## Parse the list of databases to use
## Databases can come from both dbs and dbgroup - the latter only if it has commas
my @dblist;
if (exists $dbcols->{dbs}) {
@dblist = split /\s*,\s*/ => $dbcols->{dbs};
}
if (exists $dbcols->{dbgroup} and $dbcols->{dbgroup} =~ /,/) {
push @dblist => split /\s*,\s*/ => $dbcols->{dbgroup};
}
## If this is a new dbgroup, databases must be given
if (!@dblist and defined $dbgroup_name and ! exists $DBGROUP->{ $dbgroup_name }) {
die qq{Must provide a list of databases to go into the new dbgroup\n};
}
my $dbtype = ''; ## the current database type (e.g. source, target)
my %db; ## used to build matching list below
my %rolecount; ## Keep track of types for later logic
my $db_for_lookups; ## Which database to search for new tables
for my $db (@dblist) {
## Set the default type of database: first is always source
$dbtype = $dbtype eq '' ? 'source' : 'target';
## Extract the type if it has one
if ($db =~ s/[=:](.+)//) {
$dbtype = $1;
}
## If this database is not known to us, throw an exception
if (! exists $DB->{$db}) {
## This may be a dbgroup: we allow this if it is the only entry!
if (exists $DBGROUP->{ $db } and ! defined $dblist[1]) {
$dbgroup_name = $db;
undef @dblist;
last;
}
die qq{Unknown database "$db"\n};
}
## Standardize and check the types
$dbtype = 'source'
if $dbtype =~ /^s/i or $dbtype =~ /^mas/i or $dbtype =~ /^pri/;
$dbtype = 'target'
if $dbtype =~ /^t/i or $dbtype =~ /^rep/i;
$dbtype = 'fullcopy'
if $dbtype =~ /^f/i;
if ($dbtype !~ /^(?:source|target|fullcopy)$/) {
die "Invalid database type: must be source, target, or fullcopy (not $dbtype)\n";
}
$db{$db} = $dbtype;
$rolecount{$dbtype}++;
$db_for_lookups = $db if $dbtype eq 'source';
}
## If we were given dbgroup only, we still need to populate rolecount
if (! @dblist) {
for my $d (values %{ $DBGROUP->{ $dbgroup_name }{db} }) {
$rolecount{$d->{role}}++;
}
}
## Do any existing groups match this list exactly?
## We only care about this if they don't have an explicit dbgroup set
if (! defined $dbgroup_name) {
my $newlist = join ',' => map { "$_=".$db{$_} } sort keys %db;
for my $gname (sort keys %$DBGROUP) {
my $innerjoin = join ',' =>
map { "$_=".$DBGROUP->{$gname}{db}{$_}{role} }
sort keys %{$DBGROUP->{$gname}{db}};
if ($innerjoin eq $newlist) {
push @message => qq{Using existing dbgroup "$gname"};
$dbgroup_name = $gname;
last;
}
}
}
## If we still don't have a dbgroup, create one based on the sync name
if (! defined $dbgroup_name) {
## We will use the name of the sync if free
## Otherwise, keep adding numbers to it until we get a free name
my $newname = $sync_name;
for my $x (2..10_000) {
last if ! exists $DBGROUP->{$newname};
$newname = "${sync_name}_$x";
}
$dbgroup_name = create_dbgroup( $newname, 'noreload' );
}
## Give a courtesy message is we created a new dbgroup
## Also associate our dbs with this new group
if (! exists $DBGROUP->{ $dbgroup_name }) {
push @message => qq{Created a new dbgroup named "$dbgroup_name"\n};
$SQL = 'INSERT INTO bucardo.dbmap(dbgroup,db,role) VALUES (?,?,?)';
$sth = $dbh->prepare($SQL);
for my $db (sort keys %db) {
$count = $sth->execute($dbgroup_name, $db, $db{$db});
if (1 != $count) {
die qq{Unable to add database "$db" to dbgroup "$dbgroup_name"\n};
}
}
}
## Make sure we only use what the bucardo.sync table needs: dbs
delete $dbcols->{dbgroup};
$dbcols->{dbs} = $dbgroup_name; ## Someday, rename this column!
## TABLES
## Determine the tables to use
## Always check the first found source database
## We can get a list of tables via the relgroup argument,
## or from a tables argument. Handle both ways.
my @tables;
if (exists $dbcols->{relgroup} and $dbcols->{relgroup} =~ /,/) {
@tables = split /\s*,\s*/ => $dbcols->{relgroup};
}
if (exists $dbcols->{tables}) {
for my $table (split /\s*,\s*/ => $dbcols->{tables}) {
push @tables => $table;
}
}
## Keep track of what we have already done
my %table;
for my $table (@tables) {
## Skip if we have seen this already
next if exists $table{$table};
## If this table already exists, we are done
if (exists $GOAT->{by_fullname}{$table}) {
$table{$table} = $GOAT->{by_fullname}{$table}->[0];
next;
}
my $result = get_goat_ids(args => [$table], dbcols => { db => $db_for_lookups} );
my $found = keys %{ $result->{match} };
for my $name (sort keys %{ $result->{new} }) {
push @message => qq{ Added table "$name"};
}
## If a specific table is not found, throw an exception
if (!$found and $table !~ /^all/) {
die qq{Could not find a relation named "$table"\n};
}
## Save each table's information for use below
for my $tname (sort keys %{ $result->{relations} }) {
$table{$tname} ||= $result->{relations}{$tname}{goat}[0];
}
}
## If we don't have a relgroup already, see if our list matches an existing one
if (! defined $relgroup_name and keys %table) {
my $newlist = join ',' =>
map { "$table{$_}{schemaname}.$table{$_}{tablename}"}
sort { "$table{$a}->{schemaname}.$table{$a}->{tablename}"
cmp "$table{$b}->{schemaname}.$table{$b}->{tablename}"}
keys %table;
for my $rname (sort keys %$RELGROUP) {
my $innerjoin = join ',' => sort keys %{$RELGROUP->{$rname}{goat}};
if ($innerjoin eq $newlist) {
push @message => qq{Using existing relgroup "$rname"};
$relgroup_name = $rname;
last;
}
}
}
## Now we can set a default relgroup based on the sync name if needed
## If we still don't have a relgroup, create one based on the sync name
if (! defined $relgroup_name) {
## We will use the name of the sync if free
## Otherwise, keep adding numbers to it until we get a free name
my $newname = $sync_name;
for my $x (2..10_000) {
last if ! exists $HERD->{$newname};
$newname = "${sync_name}_$x";
}
$relgroup_name = create_herd( $newname, 'noreload' );
}
## Give a courtesy message is we created a new relgroup
## Also associate our tables with this new group
if (! exists $HERD->{ $relgroup_name }) {
unshift @message => qq{Created a new relgroup named "$relgroup_name"\n};
$SQL = 'INSERT INTO bucardo.herdmap(herd,goat) VALUES (?,?)';
$sth = $dbh->prepare($SQL);
for my $t (sort keys %table) {
$count = $sth->execute($relgroup_name, $table{$t}{id});
if (1 != $count) {
die qq{Unable to add table "$t" to relgroup "$relgroup_name"\n};
}
}
}
## Make sure we use relgroup but not tables for the SQL below
delete $dbcols->{tables};
delete $dbcols->{relgroup};
$dbcols->{herd} = $relgroup_name;
## If this is a pure fullcopy sync, we want to turn stayalive and kidsalive off
if ($rolecount{'source'} == 1
and $rolecount{'fullcopy'}
and ! $rolecount{'target'}) {
$dbcols->{stayalive} = 0;
$dbcols->{kidsalive} = 0;
}
## Allow some alternate way to say things
my $cs = 'conflict_strategy';
if (exists $dbcols->{$cs}) {
$dbcols->{$cs} = 'bucardo_latest'
if $dbcols->{$cs} eq 'default' or $dbcols->{$cs} eq 'latest';
}
## Attempt to insert this into the database
my $columns = join ',' => keys %$dbcols;
my $qs = '?,' x keys %$dbcols;
chop $qs;
$SQL = "INSERT INTO bucardo.sync ($columns) VALUES ($qs)";
$DEBUG and warn "SQL: $SQL\n";
$sth = $dbh->prepare($SQL);
$DEBUG and warn Dumper values %$dbcols;
eval {
$count = $sth->execute(values %$dbcols);
};
if ($@) {
die "Failed to add sync: $@\n";
}
$QUIET or print qq{Added sync "$sync_name"\n};
## Now we can output our success messages if any
for my $msg (@message) {
chomp $msg;
$QUIET or print "$msg\n";
}
confirm_commit();
exit 0;
} ## end of add_sync
sub remove_sync {
## Usage: remove sync name [name2 name3 ...]
## Arguments: none (uses nouns)
## Returns: never, exits
my $doc_section = 'remove';
usage_exit($doc_section) unless @nouns;
## Make sure all named syncs exist
my $s = $global{sync};
for my $name (@nouns) {
if (! exists $s->{$name}) {
die qq{No such sync: $name\n};
}
}
## Make sure none of the syncs are currently running
## XXX Is there anything we can do to check that the sync is active?
$SQL = 'DELETE FROM bucardo.sync WHERE name = ?';
$sth = $dbh->prepare($SQL);
for my $name (@nouns) {
eval {
$sth->execute($name);
};
if ($@) {
if ($@ =~ /"goat_db_fk"/) {
die qq{Cannot delete sync "$name": must remove all tables that reference it first\n};
}
die qq{Could not delete sync "$name"\n$@\n};
}
}
for my $name (@nouns) {
print qq{Removed sync "$name"\n};
print "Note: table triggers (if any) are not automatically removed!\n";
}
$dbh->commit();
exit 0;
} ## end of remove_sync
sub update_sync {
## Update one or more syncs
## Arguments: none (reads nouns for a list of syncs)
## Returns: never, exits
my @actions = @_;
my $doc_section = 'update/update sync';
usage_exit($doc_section) unless @actions;
my $name = shift @actions;
## Recursively call ourselves for wildcards and 'all'
exit 0 if ! check_recurse($SYNC, $name, @actions);
## Make sure this sync exists!
if (! exists $SYNC->{$name}) {
die qq{Could not find a sync named "$name"\nUse 'list syncs' to see all available.\n};
}
my $changes = 0;
## Current information about this sync, including column names
my $syncinfo;
my %aliases = (
standard_conflict => 'conflict_strategy',
conflict => 'conflict_strategy',
ping => 'autokick',
relgroup => 'herd',
);
for my $action (@actions) {
## Skip noise words
next if $action =~ 'set';
## Allow for some simple shortcuts
if ($action =~/^inactiv/i) {
$action = 'status=inactive';
}
elsif ($action =~ /^activ/i) {
$action = 'status=active';
}
## Look for a standard foo=bar or foo:bar format
if ($action =~ /(.+?)\s*[=:]\s*(.+)/) {
my ($setting,$value) = (lc $1,$2);
## No funny characters please, just boring column names
$setting =~ /^[a-z_]+$/ or die "Invalid setting: $setting\n";
$setting = $aliases{$setting} || $setting;
## If we have not already, grab the current information for this sync
## We also use this to get the list of valid column names to modify
if (! defined $syncinfo) {
$SQL = 'SELECT * FROM sync WHERE name = ?';
$sth = $dbh->prepare($SQL);
$count = $sth->execute($name);
## Check count
$syncinfo = $sth->fetchall_arrayref({})->[0];
for my $col (qw/ cdate /) {
delete $syncinfo->{$col};
}
}
## Is this a valid column?
if (! exists $syncinfo->{$setting}) {
die "Invalid setting: $setting\n";
}
## Do any magic we need for specific items
if ($setting eq 'isolation_level') {
$value =~ s/_/ /g;
}
elsif ($setting eq 'conflict_strategy') {
## Allow some alternative names
$value = 'bucardo_latest' if $value eq 'default' or $value eq 'latest';
$value = 'bucardo_latest_all_tables' if $value eq 'latest_all';
## If the name does not start with bucardo, it must be a list of databases
if ($value !~ /^bucardo_/) {
my $dbs = $SYNC->{$name}{dblist};
for my $dbname (split /\s+/ => $value) {
if (! exists $dbs->{$dbname}) {
die qq{conflict_strategy should contain a list of databases, but "$dbname" is not a db for this sync!\n};
}
}
}
$QUIET or print qq{Set conflict strategy to '$value'\n};
}
## Try setting it
$SQL = "UPDATE sync SET $setting=? WHERE name = ?";
$sth = $dbh->prepare($SQL);
$sth->execute($value,$name);
$changes++;
next;
}
warn "\nUnknown action: $action\n";
usage_exit($doc_section);
}
confirm_commit() if $changes;
return;
} ## end of update_sync
sub list_syncs {
## Show information about all or some subset of the 'sync' table
## Arguments: none (reads nouns for a list of syncs)
## Returns: 0 on success, -1 on error
my $doc_section = 'list';
my $syncs = $global{sync};
## Do we have at least one name specified (if not, show all)
my $namefilter = 0;
for my $term (@nouns) {
## Filter out by status: only show active or inactive syncs
if ($term =~ /^(active|inactive)$/i) {
my $stat = lc $1;
for my $name (keys %$syncs) {
delete $syncs->{$name} if $syncs->{$name}{status} ne $stat;
}
next;
}
## Filter out by arbitrary attribute matches
if ($term =~ /(\w+)\s*=\s*(\w+)/) {
my ($attrib, $value) = (lc $1,$2);
for my $name (keys %$syncs) {
if (! exists $syncs->{$name}{$attrib}) {
my $message = "No such sync attribute: $attrib\n";
$message .= "Must be one of the following:\n";
my $names = join ',' =>
sort
grep { $_ !~ /\b(?:cdate|name)\b/ }
keys %{ $syncs->{$name} };
$message .= " $names\n";
die $message;
}
delete $syncs->{$name} if $syncs->{$name}{$attrib} ne $value;
}
next;
}
## Everything else should be considered a sync name
$namefilter = 1;
## Check for wildcards
if ($term =~ s/[*%]/.*/) {
for my $name (keys %$syncs) {
$syncs->{$name}{ok2show} = 1 if $name =~ /$term/;
}
next;
}
## Must be an exact match
for my $name (keys %$syncs) {
$syncs->{$name}{ok2show} = 1 if $name eq $term;
}
}
## If we filtered by name, remove all the non-matched ones
if ($namefilter) {
for my $name (keys %$syncs) {
delete $syncs->{$name} if ! exists $syncs->{$name}{ok2show};
}
}
## Nothing found? We're out of here
if (! keys %$syncs) {
print "No syncs found\n";
return -1;
}
## Determine the size of the output strings for pretty aligning later
my ($maxname, $maxherd, $maxdbs) = (2,2,2);
for my $name (keys %$syncs) {
my $s = $syncs->{$name}; $maxname = length $name if length $name > $maxname;
$maxherd = length $s->{herd}{name} if length $s->{herd}{name} > $maxherd;
$s->{d} = qq{DB group "$s->{dbs}"};
for (sort keys %{ $s->{dblist} }) {
$s->{d} .= " $_:$s->{dblist}{$_}{role}";
}
$maxdbs = length $s->{d} if length $s->{d} > $maxdbs;
}
## Now print them out in alphabetic order
for my $name (sort keys %$syncs) {
my $s = $syncs->{$name};
## Switch to multi-line if database info strings are over this
my $maxdbline = 50;
## Show basic information
printf qq{Sync %-*s Relgroup %-*s %s[%s]\n},
2+$maxname, qq{"$name"},
2+$maxherd, qq{"$s->{herd}{name}"},
$maxdbs > $maxdbline ? '' : " $s->{d} ",
ucfirst $s->{status};
## Print the second line if needed
if ($maxdbs > $maxdbline) {
print " $s->{d}\n";
}
## Show associated tables if in verbose mode
if ($VERBOSE >= 1) {
if (exists $s->{herd}{goat}) {
my $goathash = $s->{herd}{goat};
for my $relname (sort {
$goathash->{$b}{priority} <=> $goathash->{$a}{priority}
or $a cmp $b
}
keys %{ $goathash }) {
printf " %s %s\n",
ucfirst($goathash->{$relname}{reltype}),$relname;
}
}
}
## Show all the sync attributes
$VERBOSE >= 2 and show_all_columns($s);
} ## end of each sync
return 0;
} ## end of list_syncs
sub get_goat_ids {
## Returns the ids from the goat table for matching relations
## Also checks the live database and adds tables to the goat table as needed.
## Arguments: key-value pairs:
## - args: arrayref of names to match against. Can have wildcards. Can be 'all'
## - type: 'table' or 'sequence', depending on what we expect to find.
## - dbcols: optional hashref of fields to populate goat table with (e.g. autokick=1)
## - noherd: do not consider items if already in this herd for "all"
## Returns: a hash with:
## - relations: hash of goat objects, key is the fully qualified name
## - original: hash of search term(s) used to find this
## - goat: the goat object
## - nomatch: hash of non-matching terms
## - match: hash of matching terms
## - new: hash of newly added tables
my %arg = @_;
my $reltype = $arg{type};
my $names = $arg{args} or die 'Must have list of things to match';
my $dbcols = $arg{dbcols} || {};
my $noherd = $arg{noherd} || '';
## The final hash we return
my %relation;
## Args that produced a match
my %match;
## Args that produced no matches at all
my %nomatch;
## Keep track of which args we've already done, just in case there are dupes
my %seenit;
## Which tables we added to the goat table
my %new;
## Figure out which database to search in, unless already given
my $bestdb = (exists $dbcols->{db} and defined $dbcols->{db})
? $dbcols->{db} : find_best_db_for_searching();
## This check still makes sense: if no databases, there should be nothing in $GOAT!
if (! defined $bestdb) {
die "No databases have been added yet, so we cannot add tables!\n";
}
## Allow "tables=all" to become "all"
for my $item (@$names) {
$item = 'all' if $item =~ /^tables?=all/i;
}
my $rdbh = connect_database({name => $bestdb}) or die;
## SQL to find a table or a sequence
## We do not want pg_table_is_visible(c.oid) here
my $BASESQL = sub {
my $arg = shift || 'table';
## Assume we're talking about tables unless we say "sequence" explicitly
my $type = ( $arg eq 'sequence' ? 'S' : 'r' );
return qq{
SELECT nspname||'.'||relname AS name, relkind, c.oid, relhaspkey, nspname, relname
FROM pg_class c
JOIN pg_namespace n ON (n.oid = c.relnamespace)
WHERE relkind IN ('$type')
AND nspname <> 'information_schema'
AND nspname !~ '^pg_'
};
};
## Loop through each argument, and try and find matching goats
ITEM: for my $item (@$names) {
## In case someone entered duplicate arguments
next if $seenit{$item}++;
## Skip if this is not a tablename, but an argument of the form x=y
next if index($item, '=') >= 0;
## Determine if this item has a dot in it, and/or it is using wildcards
my $hasadot = index($item,'.') >= 0 ? 1 : 0;
my $hasstar = (index($item,'*') >= 0 or index($item,'%') >= 0) ? 1 : 0;
## Temporary list of matching items
my @matches;
## A list of tables to be bulk added to the goat table
my @addtable;
## We may mutate the arg, so stow away the original
my $original_item = $item;
## We look for matches in the existing $GOAT hash
## We may also check the live database afterwards
map {
push @matches, $_ if (! defined $reltype || $_->{reltype} eq $reltype);
} find_goat_by_item($item, \@nouns);
## Wildcards?
my $regex_item = $item;
## Setup the SQL to search the live database
if ($hasstar) {
## Change to a regexier form
$regex_item =~ s/\./\\./g;
$regex_item =~ s/[*%]/\.\*/g;
$regex_item = "^$regex_item" if $regex_item !~ /^[\^\.\%]/;
$regex_item .= '$' if $regex_item !~ /[\$\*]$/;
## Setup the SQL to search the live database
$SQL = $BASESQL->($reltype) . ($hasadot
? q{AND nspname||'.'||relname ~ ?}
: 'AND relname ~ ?');
} ## end wildcards
elsif ($hasadot) {
## A dot with no wildcards: exact match
## TODO: Allow foobar. to mean foobar.% ??
$SQL = $BASESQL->($reltype) . q{AND nspname||'.'||relname = ?};
}
else {
## No wildcards and no dot, so we match all tables regardless of the schema
$SQL = $BASESQL->($reltype);
$item eq 'all' or $SQL .= 'AND relname = ?';
}
## We do not check the live database if the match was exact
## *and* something was found. In all other cases, we go live.
if ($hasstar or !$hasadot or !@matches) {
debug(qq{NB! Found some existing matches; searching for other possibilities, because "$item" }
. ( $hasstar ? 'includes wildcard characters ' : '' )
. ( !$hasadot ? 'does not include a dot' : '' )) if @matches;
## Search the live database for matches
$sth = $rdbh->prepare($SQL);
$regex_item ||= $item;
if ('all' eq $item) {
($count = $sth->execute()) =~ s/0E0/0/;
}
else {
($count = $sth->execute($regex_item)) =~ s/0E0/0/;
}
debug(qq{Searched live database "$bestdb" for arg "$regex_item", count was $count});
debug(qq{SQL: $SQL}, 2);
debug(qq{Arg: $item ($regex_item)}, 2);
for my $row (@{ $sth->fetchall_arrayref({}) }) {
## The 'name' is combined "schema.relname"
my $name = $row->{name};
## Don't bother if we have already added this!
next if find_goat_by_item($name, [ "db=$bestdb" ]);
## If we are doing 'all', exclude the bucardo schema, and insist on a primary key
if ('all' eq $item) {
next if $name =~ /^bucardo\./;
if (!$row->{relhaspkey}) {
## Allow if we have a unique index on this table
$SQL = q{SELECT 1 FROM pg_index WHERE indisunique AND indrelid = }
. q{(SELECT c.oid FROM pg_class c JOIN pg_namespace n ON (n.oid = c.relnamespace) WHERE n.nspname=? AND c.relname=?)};
my $sthunique = $rdbh->prepare_cached($SQL);
$count = $sthunique->execute($row->{nspname},$row->{relname});
$sthunique->finish();
next if $count < 1;
}
}
## Document the string that led us to this one
$relation{$name}{original}{$item}++;
## Document the fact that we found this on a database
$new{$name}++;
## Mark this item as having produced a match
$match{$item}++;
## Set this table to be added to the goat table below
push @addtable, {name => $name, db => $bestdb, reltype => $row->{relkind}, dbcols => $dbcols};
}
}
## Add all the tables we just found from searching the live database
my $added_tables;
if (@addtable) {
$added_tables = add_items_to_goat_table(\@addtable);
}
for my $tmp (@$added_tables) {
push @matches, $GOAT->{by_id}{$tmp};
}
## If we asked for "all", add in all of our known tables (not already in this herd)
if ($names->[0] eq 'all') {
for (values %{ $GOAT->{by_db}{$bestdb} }) {
next if exists $_->{herd}{$noherd};
push @matches, $_;
}
}
## Populate the final hashes based on the match list
for my $match (@matches) {
next unless defined $match;
my $name;
if (ref $match eq 'HASH') {
$name = "$match->{schemaname}.$match->{tablename}";
}
else {
$name = $match;
}
$relation{$name}{original}{$original_item}++;
## This goat entry should be an array, if there are multiple goats
## with that name (e.g. from different databases)
if (exists $relation{$name}{goat}) {
push @{$relation{$name}{goat}}, $match;
}
else {
$relation{$name}{goat} = [ $match ];
}
$match{$item}++;
}
## If this item did not match anything, note that as well
if (! @matches and $names->[0] ne 'all') {
$nomatch{$original_item}++;
}
} ## end each given needle
return {
relations => \%relation,
nomatch => \%nomatch,
match => \%match,
new => \%new,
};
} ## end of get_goat_ids
sub add_items_to_goat_table {
## Given a list of tables, add them to the goat table as needed
## Arguments: one
## 1. Arrayref where keys are:
## - name: name of relation to add (mandatory)
## - db: the database name (mandatory)
## - reltype: table or sequence (optional, defaults to table)
## - dbcols: optional hashref of goat columns to set
## Returns: arrayref with all the new goat.ids
my $info = shift or die;
## Quick check if the entry is already there.
$SQL = 'SELECT id FROM bucardo.goat WHERE schemaname=? AND tablename=? AND db=?';
my $isthere = $dbh->prepare($SQL);
## SQL to add this new entry in
my $NEWGOATSQL = 'INSERT INTO bucardo.goat (schemaname,tablename,reltype,db) VALUES (?,?,?,?) RETURNING id';
my @newid;
for my $rel (sort { $a->{name} cmp $b->{name} } @$info) {
# XXX Is it safe to assume UTF8 encoding here? Probably not
my $name = $rel->{name};
if ($name !~ /^([-\w ]+)\.([-\w ]+)$/o) {
die qq{Invalid name, got "$name", but expected format "schema.relname"};
}
my ($schema,$table) = ($1,$2);
my $db = $rel->{db} or die q{Must provide a database};
my $reltype = $rel->{reltype} || 't';
$reltype = $reltype =~ /s/i ? 'sequence' : 'table';
## Adjust the SQL as necessary for this goat
$SQL = $NEWGOATSQL;
my @args = ($schema, $table, $reltype, $db);
if (exists $rel->{dbcols}) {
for my $newcol (sort keys %{ $rel->{dbcols} }) {
next if $newcol eq 'db';
$SQL =~ s/\)/,$newcol)/;
$SQL =~ s/\?,/?,?,/;
push @args => $rel->{dbcols}{$newcol};
}
}
$sth = $dbh->prepare($SQL);
($count = $sth->execute(@args)) =~ s/0E0/0/;
debug(qq{Added "$schema.$table" with db "$db", count was $count});
push @newid => $sth->fetchall_arrayref()->[0][0];
}
## Update the global
load_bucardo_info('force_reload');
## Return a list of goat IDs we've just added
# my %newlist;
# for my $id (@newid) {
# my $goat = $global{goat}{by_id}{$id};
# my $name = "$goat->{schemaname}.$goat->{tablename}";
# $newlist{$name} = $goat;
# }
return \@newid;
} ## end of add_items_to_goat_table
sub create_dbgroup {
## Creates a new entry in the bucardo.dbgroup table
## Caller should have alredy checked for existence
## Does not commit
## Arguments: two
## 1. Name of the new group
## 2. Boolean: if true, prevents the reload
## Returns: name of the new group
my ($name,$noreload) = @_;
$SQL = 'INSERT INTO bucardo.dbgroup(name) VALUES (?)';
$sth = $dbh->prepare($SQL);
eval {
$sth->execute($name);
};
if ($@) {
if ($@ =~ /dbgroup_name_sane/) {
print "Trying name $name\n";
print qq{Invalid characters in dbgroup name "$name"\n};
}
else {
print qq{Failed to create dbgroup "$name"\n$@\n};
}
exit 1;
}
## Reload our hashes
$noreload or load_bucardo_info(1);
return $name;
} ## end of create_dbgroup
sub get_arg_items {
## From an argument list, return all matching items
## Arguments: two
## 1. Arrayref of source items to match on
## 2. Arrayref of arguments
## Returns: an arrayref of matches, or an single scalar indicating what arg failed
my ($haystack, $needles) = @_;
my %match;
for my $needle (@$needles) {
my $hasadot = index($needle,'.') >= 0 ? 1 : 0;
my $hasstar = (index($needle,'*') >= 0 or index($needle,'%') >= 0) ? 1 : 0;
## Wildcards?
if ($hasstar) {
## Change to a regexier form
$needle =~ s/\*/\.\*/g;
## Count matches: if none found, we bail
my $found = 0;
for my $fullname (@$haystack) {
## If it has a dot, match the whole thing
if ($hasadot) {
if ($fullname =~ /^$needle$/) {
$match{$fullname} = $found++;
}
next;
}
## No dot, so match table part only
my ($schema,$table) = split /\./ => $fullname;
if ($table =~ /^$needle$/) {
$match{$fullname} = $found++;
}
}
return $needle if ! $found;
next;
} ## end wildcards
## If it has a dot, it must match exactly
if ($hasadot) {
if (grep { $_ eq $needle } @$haystack) {
$match{$needle} = 1;
next;
}
return $needle;
}
## No dot, so we match all tables regardless of the schema
my $found = 0;
for my $fullname (@$haystack) {
my ($schema,$table) = split /\./ => $fullname;
if ($table eq $needle) {
$match{$fullname} = $found++;
}
}
return $needle if ! $found;
} ## end each given needle
return \%match; ## May be undefined
} ## end of get_arg_items
sub clone {
## Put an entry in the clone table so the MCP can do some copyin'
## Arguments: none, parses nouns
## Returns: never, exits
my $doc_section = 'clone';
usage_exit($doc_section) unless @nouns;
## Examples:
## ./bucardo clone dbs=A:source,B,C relgroup=foo
## ./bucardo clone sync=foobar
## ./bucardo clone sync=foobar prime=A
## ./bucardo clone dbs=A,B,C,D relgroup=foo notruncate=B,C
## Optional sync to associate with:
my $sync;
## Optional database group to use:
my $dbgroup;
## The prime (winning) source database.
my $prime;
## Optonal relgroup. Can be a list of tables
my $relgroup;
## Optional options :)
my $options;
for my $word (@nouns) {
## Check for an optional sync name.
if ($word =~ /(?i)sync(?-i)\s*[:=]\s*(\w.*?)\s*$/) {
my $syncname = $1;
if (! exists $SYNC->{$syncname}) {
die qq{Invalid sync "$syncname"\n};
}
## Have we already specified a sync?
if (defined $sync) {
die qq{Cannot specify more than one sync\n};
}
$sync = $syncname;
next;
}
## Check for an optional dbgroup
if ($word =~ /(?i)dbg(?-i)\w*\s*[:=]\s*(\w.*?)\s*$/) {
my $dbgroupname = $1;
if (! exists $DBGROUP->{$dbgroupname}) {
die qq{Invalid database group "$dbgroupname"\n};
}
## Have we already specified a database group?
if (defined $dbgroup) {
die qq{Cannot specify more than one database group\n};
}
$dbgroup = $dbgroupname;
next;
}
## Check for an optional relgroup
if ($word =~ /(?i)(?:relgroup|table)s?(?-i)\w*\s*[:=]\s*(\w.*?)\s*$/) {
my $relgroupname = $1;
## May be a relgroup, or a list of tables
if (exists $RELGROUP->{$relgroupname}) {
$relgroup = $relgroupname;
next;
}
## Must be one or more tables. See if we can find them, and shove into a relgroup
## Go through all the items and try to find matches
## Assumes tables are all in CSV format
my @tablelist = split /\s*,\s*/ => $relgroupname;
my $goatlist = get_goat_ids(args => \@tablelist, type => 'table');
## Cannot proceed unless we have a match for every table
if (keys %{ $goatlist->{nomatch} }) {
print "Cannot clone because the following tables were not found:\n";
for my $badname (sort keys %{ $goatlist->{nomatch} }) {
print " $badname\n";
}
exit 1;
}
## We need to generate a relgroup name
## TODO: See if any existing relgroups match exactly
my $basename = 'clone_relgroup';
my $number = 1;
{
$relgroupname = "$basename$number";
last if ! exists $RELGROUP->{$relgroupname};
$number++;
redo;
}
$SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)';
$sth = $dbh->prepare($SQL);
$sth->execute($relgroupname);
$SQL = 'INSERT INTO bucardo.herdmap (herd,goat) VALUES (?,?)';
$sth = $dbh->prepare($SQL);
for my $goat (values %{ $goatlist->{relations} }) {
$sth->execute($relgroupname, $goat->{goat}[0]{id});
}
next;
}
## Check for a prime
if ($word =~ /(?i)prime(?-i)\w*\s*[:=]\s*(\w.*?)\s*$/) {
$prime = $1;
for my $candidate (split /\s*,\s*/ => $prime) {
## This must be a valid database
if (! exists $DB->{$candidate}) {
die qq{The prime option must specify a known database (not "$candidate")\n};
}
}
$options .= "prime=$prime;";
next;
}
die qq{Unknown option: $word\n};
} ## end checking each noun
## Must have at least one of sync or dbgroup
if (! defined $sync and ! defined $dbgroup) {
die qq{Must provide a sync or a database group\n};
}
## Generate a list of databases to make sure we know which is prime
my $dbrole;
if (defined $dbgroup) {
for my $row (values %{ $DBGROUP->{$dbgroup}{db} }) {
$dbrole->{ $row->{role} }{ $row->{db} } = 1;
}
}
else {
for my $db (values %{ $SYNC->{$sync}{dblist} }) {
$dbrole->{ $db->{role} }{ $db->{db} } = 1;
}
}
## If we have more than one source, make sure we know how to proceed
if (keys %{ $dbrole->{source}} > 1) {
## TODO: Allow more than one somehow
if (! defined $prime) {
warn qq{Must provide a prime so we know which database to copy from\n};
my $dblist = join ', ' => sort keys %{ $dbrole->{source} };
warn qq{Should be one of: $dblist\n};
exit 1;
}
}
## Clean up the options by removing any trailing semicolons
if (defined $options) {
$options =~ s/;$//;
}
$SQL = 'INSERT INTO bucardo.clone(status,sync,dbgroup,relgroup,options) VALUES (?,?,?,?,?) RETURNING id';
$sth = $dbh->prepare($SQL);
$sth->execute('new', $sync, $dbgroup, $relgroup, $options);
my $id = $sth->fetchall_arrayref()->[0][0];
## Tell the MCP there is a new clone
$dbh->do('NOTIFY bucardo_clone_ready');
confirm_commit();
$QUIET or print qq{Clone $id has been started. Track progress with "bucardo status clone $id"\n};
exit 0;
} ## end of clone
sub kick {
## Kick one or more syncs
## Arguments: none, parses nouns
## Returns: never, exits
my $doc_section = 'kick';
usage_exit($doc_section) unless @nouns;
my ($exitstatus, $retries, $do_retry) = (0,0,0);
RETRY: {
$dbh->rollback();
$exitstatus = 0;
SYNC: for my $sync (@syncs) {
my $relname = "bucardo_kick_sync_$sync";
## If this sync is not active, cowardly refuse to kick it
if ($SYNC->{$sync}{status} ne 'active') {
print qq{Cannot kick inactive sync "$sync"\n};
next SYNC;
}
$dbh->do(qq{NOTIFY "bucardo_kick_sync_$sync"});
my $done = "bucardo_syncdone_$sync";
my $killed = "bucardo_synckill_$sync";
if (! defined $adverb) {
$dbh->commit();
$QUIET or print qq{Kicked sync $sync\n};
next;
}
$QUIET or print qq{Kick $sync: };
$dbh->do(qq{LISTEN "$done"});
$dbh->do(qq{LISTEN "$killed"});
$dbh->commit();
my $time = time;
sleep 0.1;
my $timeout = (defined $adverb and $adverb > 0) ? $adverb : 0;
my $printstring = $NOTIMER ? '' : '[0 s] ';
print $printstring unless $QUIET or $NOTIMER;
my $oldtime = 0;
local $SIG{ALRM} = sub { die 'Timed out' };
$do_retry = 0;
eval {
if ($timeout) {
alarm $timeout;
}
WAITIN: {
my $lastwait = '';
if (time - $time != $oldtime) {
$oldtime = time - $time;
if (!$QUIET and !$NOTIMER) {
print "\b" x length($printstring);
$printstring =~ s/\d+/$oldtime/;
print $printstring;
}
}
for my $notice (@{ db_get_notices($dbh) }) {
my ($name) = @$notice;
if ($name eq $done) {
$lastwait = 'DONE!';
}
elsif ($name eq $killed) {
$lastwait = 'KILLED!';
$exitstatus = 2;
}
elsif ($name =~ /^bucardo_syncdone_${sync}_(.+)$/) {
my $new = sprintf '%s(%ds) ', $1, ceil(time-$time);
print $new unless $QUIET;
$printstring .= $new;
}
elsif ($name =~ /^bucardo_synckill_${sync}_(.+)$/) {
my $new = sprintf '%s KILLED (%ds) ', $1, ceil(time-$time);
print $new unless $QUIET;
$printstring .= $new;
$exitstatus = 2;
$lastwait = ' ';
}
}
$dbh->rollback();
if ($lastwait) {
print $lastwait unless $QUIET;
if ($lastwait ne 'DONE!' and $RETRY and ++$retries <= $RETRY) {
print "Retry #$retries\n";
$do_retry = 1;
die "Forcing eval to exit for retry attempt\n";
}
last WAITIN;
}
sleep($WAITSLEEP);
redo WAITIN;
} ## end of WAITIN
alarm 0 if $timeout;
};
alarm 0 if $timeout;
if ($do_retry) {
$do_retry = 0;
redo RETRY;
}
if (2 == $exitstatus) {
my $reason = show_why_sync_killed($sync);
$reason and print "\n$reason\n";
}
if ($@) {
if ($@ =~ /Timed out/o) {
$exitstatus = 1;
warn "Timed out!\n";
}
else {
$exitstatus = 3;
warn "Error: $@\n";
}
next SYNC;
}
next SYNC if $QUIET;
print "\n";
} ## end each sync
} ## end RETRY
exit $exitstatus;
} ## end of kick
sub pause_resume {
## Pause or resume one or more syncs
## Arguments: none, parses nouns
## Returns: never, exits
my $doc_section = 'pause';
usage_exit($doc_section) unless @nouns;
my $action = shift;
my @syncs_signalled;
for my $sync (@syncs) {
## Syncs can only be paused/resumed if they are active
my $status = $SYNC->{$sync}{status};
if ($status ne 'active') {
print qq{Cannot pause or resume sync "$sync" unless it is active (currently "$status")\n};
}
else {
$dbh->do(qq{NOTIFY "bucardo_${action}_sync_$sync"});
push @syncs_signalled => $sync;
}
}
$dbh->commit();
my $list = join ',' => @syncs_signalled;
$QUIET or print qq{Syncs ${action}d: $list\n};
exit 0;
} ## end of pause_resume
sub show_why_sync_killed {
## If a kick results in a "KILLED!" try and show why
## Arguments: one
## 1. Sync object
## Returns: message string
my $sync = shift;
$SQL = q{
SELECT * FROM bucardo.syncrun
WHERE sync = ?
AND lastbad
ORDER BY started DESC LIMIT 1
};
$sth = $dbh->prepare($SQL);
$count = $sth->execute($sync);
if ($count != 1) {
$sth->finish();
return '';
}
my $result = $sth->fetchall_arrayref({})->[0];
my $whydie = $result->{status} || '';
$whydie =~ s/\\n */\n /g;
$whydie =~ s/: ERROR:/:\n ERROR:/;
$whydie =~ s/ (at .+ line \d+\.)/\n $1/g;
$whydie =~ s/\t//g;
my $message = sprintf " Started: %s\n Ended: %s\n %s",
$result->{pid} || '?',
$result->{started} || '?',
$result->{ended} || '?',
$whydie;
return $message;
} ## end of show_why_sync_killed
sub status_all {
## Show status of all syncs in the database
## Arguments: none
## Returns: never, exits
## See if the MCP is running and what its PID is
if (! -e $PIDFILE) {
#print " (Bucardo does not appear to be currently running)\n";
}
else {
my $fh;
if (!open $fh, '<', $PIDFILE) {
print "\nERROR: Could not open $PIDFILE: $!";
}
else {
my $pid = <$fh>;
chomp $pid;
close $fh or warn qq{Could not close $PIDFILE: $!\n};
if ($pid =~ /^\d+$/) {
print "PID of Bucardo MCP: $pid";
}
else {
print "\nERROR: $PIDFILE contained: $pid";
}
}
}
print "\n";
if (! keys %$SYNC) {
print "No syncs have been created yet.\n";
exit 0;
}
my $orderby = $bcargs->{sort} || '1';
if ($orderby !~ /^\+?\-?\d$/) {
die "Invalid sort option, must be +- 1 through 9\n";
}
## Set the status for each sync if possible
my $max = set_sync_status();
## The titles
my %title = (
name => ' Name',
state => ' State',
lastgood => ' Last good',
timegood => ' Time',
dit => ($max->{truncate} ?
$max->{conflicts} ? ' Last I/D/T/C' : ' Last I/D/T' :
$max->{conflicts} ? ' Last I/D/C' :' Last I/D'),
lastbad => ' Last bad',
timebad => ' Time',
);
## Set the maximum as needed based on the titles
for my $name (keys %title) {
if (! exists $max->{$name}
or length($title{$name}) > $max->{$name}) {
$max->{$name} = length $title{$name};
}
}
## Account for our extra spacing by bumping everything up
for my $var (values %$max) {
$var += 2;
}
## Print the column headers
printf qq{%-*s %-*s %-*s %-*s %-*s %-*s %-*s\n},
$max->{name}, $title{name},
$max->{state}, $title{state},
$max->{lastgood}, $title{lastgood},
$max->{timegood}, $title{timegood},
$max->{dit}, $title{dit},
$max->{lastbad}, $title{lastbad},
$max->{timebad}, $title{timebad};
## Print a fancy dividing line
printf qq{%s+%s+%s+%s+%s+%s+%s\n},
'=' x $max->{name},
'=' x $max->{state},
'=' x $max->{lastgood},
'=' x $max->{timegood},
'=' x $max->{dit},
'=' x $max->{lastbad},
'=' x $max->{timebad};
## If fancy sorting desired, call the list ourself to sort
sub sortme {
my $sortcol = $bcargs->{sort} || 1;
+1 == $sortcol and return $a cmp $b;
-1 == $sortcol and return $b cmp $a;
my ($uno,$dos) = ($SYNC->{$a}, $SYNC->{$b});
## State
+3 == $sortcol and return ($uno->{state} cmp $dos->{state} or $a cmp $b);
-3 == $sortcol and return ($dos->{state} cmp $uno->{state} or $a cmp $b);
## Last good
+5 == $sortcol and return ($uno->{lastgoodsecs} <=> $dos->{lastgoodsecs} or $a cmp $b);
-5 == $sortcol and return ($dos->{lastgoodsecs} <=> $uno->{lastgoodsecs} or $a cmp $b);
## Good time
+6 == $sortcol and return ($uno->{lastgoodtime} <=> $dos->{lastgoodtime} or $a cmp $b);
-6 == $sortcol and return ($dos->{lastgoodtime} <=> $uno->{lastgoodtime} or $a cmp $b);
if ($sortcol == 7 or $sortcol == -7) {
my ($total1,$total2) = (0,0);
while ($uno->{dit} =~ /(\d+)/go) {
$total1 += $1;
}
while ($dos->{dit} =~ /(\d+)/go) {
$total2 += $1;
}
7 == $sortcol and return ($total1 <=> $total2 or $a cmp $b);
return ($total2 <=> $total1 or $a cmp $b);
}
## Last bad
+8 == $sortcol and return ($uno->{lastbadsecs} <=> $dos->{lastbadsecs} or $a cmp $b);
-8 == $sortcol and return ($dos->{lastbadsecs} <=> $uno->{lastbadsecs} or $a cmp $b);
## Bad time
+9 == $sortcol and return ($uno->{lastbadtime} <=> $dos->{lastbadtime} or $a cmp $b);
-9 == $sortcol and return ($dos->{lastbadtime} <=> $uno->{lastbadtime} or $a cmp $b);
return $a cmp $b;
}
for my $sync (sort sortme keys %$SYNC) {
my $s = $SYNC->{$sync};
## If this has been filtered out, skip it entirely
next if $s->{filtered};
## Populate any missing fields with an empty string
for my $name (keys %title) {
if (! exists $s->{$name}) {
$s->{$name} = '';
}
}
my $X = '|';
printf qq{%-*s$X%-*s$X%-*s$X%-*s$X%-*s$X%-*s$X%-*s\n},
$max->{name}," $sync ",
$max->{state}, " $s->{state} ",
$max->{lastgood}, " $s->{lastgood} ",
$max->{timegood}, " $s->{timegood} ",
$max->{dit}, " $s->{dit} ",
$max->{lastbad}, " $s->{lastbad} ",
$max->{timebad}, " $s->{timebad} ";
}
exit 0;
} ## end of status_all
sub status_detail {
## Show detailed information about one or more syncs
## Arguments: none, parses nouns
## Returns: never, exits
## Walk through and check each given sync
## It must either exist, or be a special key word
my @synclist;
for my $sync (@nouns) {
## Allow a special noise word: 'sync'
next if $sync eq 'sync';
## Add everything if we find the special word 'all'
if ($sync eq 'all') {
undef @synclist;
for my $sync (keys %$SYNC) {
## Turn off the filtering that set_sync_status may have added
$SYNC->{$sync}{filtered} = 0;
push @synclist => $sync;
}
last;
}
## If we don't know about this particular sync, give a warning
## We allow another special word: 'all'
if (!exists $SYNC->{$sync}) {
## If a number, skip for ease of "kick name #" toggling
$sync !~ /^\d+$/ and die "No such sync: $sync\n";
}
else {
push @synclist => $sync;
}
}
## Verify that all named syncs exist
my $max = set_sync_status({syncs => \@synclist});
## Present each in the order they gave
my $loops = 0;
for my $sync (@synclist) {
my $s = $SYNC->{$sync};
## Skip if it has been filtered out
next if $s->{filtered};
## Put a space between multiple entries
if ($loops++) {
print "\n";
}
print '=' x 70; print "\n";
my @items;
my $numtables = keys %{$s->{herd}{goat}};
my $sourcedb = $s->{herd}{db};
## Last good time, and number of rows affected
if (exists $s->{rowgood}) {
my $tt = pretty_time($s->{rowgood}{total_time});
push @items => ['Last good', "$s->{rowgood}{started_time} (time to run: $tt)"];
## Space out the numbers
$s->{dit} =~ s{/}{ / }g;
## Pretty comma formatting (based on ENV)
$s->{dit} =~ s/(\d+)/pretty_number($1)/ge;
## Change the title if we have any truncates
my $extra = $max->{truncates} ? '/truncates' : '';
## Change the title if we have any conflicts
$extra .= $max->{conflicts} ? '/conflicts' : '';
push @items => ["Rows deleted/inserted$extra", $s->{dit}];
}
## Last bad time, and the exact error
## The error should always be last, so we defer adding it to the queue
my $lasterror = '';
if (exists $s->{rowbad}) {
my $tt = pretty_time($s->{rowbad}{total_time});
push @items => ['Last bad', "$s->{rowbad}{started_time} (time until fail: $tt)"];
## Grab the error message, and strip out trailing whitespace
($lasterror = $s->{rowbad}{status}) =~ s/\s+$//;
## Add any newlines back in
$lasterror =~ s/\\n/\n/g;
## Remove starting whitespace
$lasterror =~ s/^\s+//;
}
## Undefined should be written as 'none'
for (qw/checktime/) {
$s->{$_} ||= 'None';
}
## Should be 'yes' or 'no'
for (qw/analyze_after_copy vacuum_after_copy stayalive kidsalive autokick/) {
$s->{$_} = (defined $s->{$_} and $s->{$_}) ? 'Yes' : 'No';
}
## If currently running, there should be a PID file
if (exists $s->{PIDFILE}) {
push @items => ['PID file' => $s->{PIDFILE}];
push @items => ['PID file created' => $s->{CREATED}];
}
## Build the display list
push @items => ['Sync name' => $sync];
push @items => ['Current state' => $s->{state}];
push @items => ['Source relgroup/database' => "$s->{herd}{name} / $sourcedb"];
push @items => ['Tables in sync' => $numtables];
push @items => ['Status' => ucfirst $s->{status}];
push @items => ['Check time' => $s->{checktime}];
push @items => ['Overdue time' => $s->{overdue}];
push @items => ['Expired time' => $s->{expired}];
push @items => ['Stayalive/Kidsalive' => "$s->{stayalive} / $s->{kidsalive}"];
push @items => ['Rebuild index' => $s->{rebuild_index} ? 'Yes' : 'No'];
push @items => ['Autokick' => $s->{autokick}];
push @items => ['Onetimecopy' => $s->{onetimecopy} ? 'Yes' : 'No'];
## Only show these if enabled
if ($s->{analyze_after_copy} eq 'Yes') {
push @items => ['Post-copy analyze', 'Yes'];
}
if ($s->{vacuum_after_copy} eq 'Yes') {
push @items => ['Post-copy vacuum', 'Yes'];
}
## Final items:
push @items => ['Last error:' => $lasterror];
## Figure out the maximum size of the left-hand items
my $leftmax = 0;
for (@items) {
$leftmax = length $_->[0] if length $_->[0] > $leftmax;
}
## Print it all out
for (@items) {
printf "%-*s : %s\n",
$leftmax, $_->[0], $_->[1];
}
print '=' x 70; print "\n";
}
exit 0;
} ## end of status_detail
sub append_reason_file {
## Add an entry to the 'reason' log file
## Arguments: one
## 1. Message to store
## Returns: undef
my $event = shift or die;
my $string = sprintf "%s | %-5s | %s\n", (scalar localtime), $event, $nouns;
open my $fh, '>', $REASONFILE or die qq{Could not open "$REASONFILE": $!\n};
print {$fh} $string;
close $fh or warn qq{Could not close $REASONFILE: $!\n};
open $fh, '>>', $REASONFILE_LOG or die qq{Could not open "$REASONFILE_LOG": $!\n};
print {$fh} $string;
close $fh or warn qq{Could not close $REASONFILE_LOG: $!\n};
return;
} ## end of append_reason_file
sub set_sync_status {
## Set detailed information about syncs from the syncrun table
## Arguments: zero or one (hashref)
## 1. Hashref containing a. syncs=arrarref of syncnames
## Returns: hashref indicating maximum lengths of inner information
## If a sync is filtered out via the 'syncs' argument, it is set to $s->{filtered} = 1
my $arg = shift || {};
## View the details of the syncs via the syncrun table
$SQL = qq{
SELECT *,
TO_CHAR(started,'$DATEFORMAT') AS started_time,
CASE WHEN current_date = ended::date
THEN TO_CHAR(ended,'$SHORTDATEFORMAT')
ELSE TO_CHAR(ended,'$DATEFORMAT') END AS ended_time,
ROUND(EXTRACT(epoch FROM ended)) AS ended_epoch,
EXTRACT(epoch FROM ended-started) AS total_time,
ROUND(EXTRACT(epoch FROM now()-started)) AS total_time_started,
ROUND(EXTRACT(epoch FROM now()-ended)) AS total_time_ended
FROM syncrun
WHERE sync = ?
AND ( lastgood IS TRUE
OR lastbad IS TRUE
OR lastempty IS TRUE
OR ended IS NULL)
};
$sth = $dbh->prepare($SQL);
## Find the maximum lengths of items so we can line things up pretty
my %max = (
name => 1,
state => 1,
dit => 1,
lastgood => 1,
timegood => 1,
lastbad => 1,
timebad => 1,
);
for my $sync (keys %$SYNC) {
my $s = $SYNC->{$sync};
## Sometimes we only want some of them
if ($arg->{syncs}) {
if (! grep { $_ eq $sync } @{$arg->{syncs}}) { ## no critic (ProhibitBooleanGrep)
$s->{filtered} = 1;
next;
}
}
$max{name} = length($sync) if length($sync) > $max{name};
$count = $sth->execute($sync);
if ($count < 1) {
$sth->finish;
$s->{state} = 'No records found';
$max{state} = length($s->{state}) if length($s->{state}) > $max{state};
next;
}
for my $row (@{ $sth->fetchall_arrayref({}) }) {
if ($row->{lastgood}) {
$s->{rowgood} = $row;
}
elsif ($row->{lastempty}) {
$s->{rowempty} = $row;
}
elsif ($row->{lastbad}) {
$s->{rowbad} = $row;
}
else {
$s->{runningrow} = $row;
}
}
## What is the state of this sync? First, is it still actively running?
if (exists $s->{runningrow}) {
$s->{state} = "$s->{runningrow}{status}";
}
else {
## What was the most recent run?
my $highepoch = 0;
undef $s->{latestrow};
my $wintype;
for my $type (qw/ bad good empty /) {
my $r = $s->{"row$type"};
next if ! defined $r;
my $etime = $r->{ended_epoch};
if ($etime >= $highepoch) {
$s->{latestrow} = $r;
$highepoch = $etime;
$wintype = $type;
}
}
if (! defined $s->{latestrow}) {
$s->{state} = 'Unknown';
$max{state} = length($s->{state}) if length($s->{state}) > $max{state};
next;
}
if ($wintype eq 'empty') {
# Empty is good, as far as status is concerned.
$s->{rowgood} = $s->{latestrow};
$wintype = 'good';
}
$s->{state} = ucfirst $wintype;
}
## deletes/inserts/truncates/conflicts
$s->{dit} = '';
if (exists $s->{rowgood}) {
$s->{dit} = "$s->{rowgood}{deletes}/$s->{rowgood}{inserts}";
if ($s->{rowgood}{truncates}) {
$max{truncates} = 1;
$s->{dit} .= "/$s->{rowgood}{truncates}";
}
if ($s->{rowgood}{conflicts}) {
$max{conflicts} = 1;
$s->{dit} .= "/$s->{rowgood}{conflicts}";
}
}
$s->{lastgood} = exists $s->{rowgood} ? $s->{rowgood}{ended_time} : 'none';
$s->{timegood} = exists $s->{rowgood} ? pretty_time($s->{rowgood}{total_time_ended}) : '';
$s->{lastbad} = exists $s->{rowbad} ? $s->{rowbad}{ended_time} : 'none';
$s->{timebad} = exists $s->{rowbad} ? pretty_time($s->{rowbad}{total_time_ended}) : '';
for my $var (qw/ state dit lastgood timegood lastbad timebad /) {
$max{$var} = length($s->{$var}) if length($s->{$var}) > $max{$var};
}
}
return \%max;
} ## end of set_sync_status
sub inspect {
## Inspect an item in the database
## Arguments: none, parses nouns
## Returns: never, exits
my $doc_section = 'inspect';
usage_exit($doc_section) unless @nouns;
my $thing = shift @nouns;
inspect_table() if $thing =~ /tab/i or $thing eq 't';
inspect_sync() if $thing =~ /sync/i or $thing eq 's';
inspect_herd() if $thing =~ /(?:relgr|herd)/i or $thing eq 'h';
usage_exit($doc_section);
return;
} ## end of inspect
sub inspect_table {
## Inspect an item from the goat table
## Arguments: none, parses nouns
## Returns: never, exits
my $doc_section = 'inspect';
usage_exit($doc_section) unless @nouns;
$SQL = q{SELECT * FROM bucardo.goat WHERE tablename=?};
my $sth_goat = $dbh->prepare($SQL);
$SQL = q{SELECT * FROM bucardo.goat WHERE schemaname = ? AND tablename=?};
my $sth_goat_schema = $dbh->prepare($SQL);
my @tables;
for my $name (@nouns) {
my $sthg;
if ($name =~ /(.+)\.(.+)/) {
$sthg = $sth_goat_schema;
$count = $sthg->execute($1,$2);
}
else {
$sthg = $sth_goat;
$count = $sthg->execute($name);
}
if ($count < 1) {
die "Unknown table: $name\n";
}
for my $row (@{$sthg->fetchall_arrayref({})}) {
push @tables, $row;
}
}
for my $t (@tables) {
my ($s,$t,$db,$id) = @$t{qw/schemaname tablename db id/};
print "Inspecting $s.$t on $db\n";
## Grab all other tables referenced by this one
my $tablist = get_reffed_tables($s,$t,$db);
## Check that each referenced table is in a herd with this table
my %seenit;
for my $tab (@$tablist) {
my ($type,$tab1,$tab2,$name,$def) = @$tab;
my $table = $type==1 ? $tab1 : $tab2;
if ($table !~ /(.+)\.(.+)/) {
die "Invalid table information\n";
}
my $schema = $1;
$table = $2;
next if $seenit{"$schema.$table.$type"}++;
## Make sure that each herd with this table also has this new table
my $ggoat = $global{goat};
my $hherd = $global{herd};
for my $herd (sort keys %{$ggoat->{by_id}{$id}{herd}}) {
$seenit{fktable} = 1;
next if exists $hherd->{$herd}{hasgoat}{$schema}{$table};
printf "Table %s.%s is in relgroup %s, but %s.%s (used as FK%s) is not\n",
$s, $t, $herd, $schema, $table,
$type == 1 ? '' : ' target';
}
if (! exists $seenit{fktable}) {
printf "Table %s.%s is used as FK%s by %s.%s\n",
$s,$t,$type==1 ? '' : ' target', $schema, $table;
delete $seenit{fktable};
}
}
}
exit 0;
} ## end of inspect_table
sub inspect_herd {
## Inspect an item from the herd table
## Arguments: none, parses nouns
## Returns: never, exits
my $doc_section = 'inspect';
usage_exit($doc_section) unless @nouns;
die "Not implemented yet\n";
} ## end of inspect_herd
sub inspect_sync {
## Inspect an item from the sync table
## Arguments: none, parses nouns
## Returns: never, exits
my $doc_section = 'inspect';
usage_exit($doc_section) unless @nouns;
die "Not implemented yet\n";
} ## end of inspect_sync
sub get_reffed_tables {
## Find all tables that are references by the given one
## Arguments: three
## 1. Schema name
## 2. Table name
## 3. Database name
## Returns: arrayref of tables from the database
my ($s,$t,$db) = @_;
my $rdbh = connect_database({name => $db});
## So we get the schemas
$rdbh->do('SET search_path = pg_catalog');
$SQL= q{
SELECT CASE WHEN conrelid=x.toid THEN 1 ELSE 2 END,
confrelid::regclass,
conrelid::regclass,
conname,
pg_get_constraintdef(oid, true)
FROM pg_constraint,
(SELECT c.oid AS toid FROM pg_class c JOIN pg_namespace n
ON (n.oid=c.relnamespace) WHERE nspname=? AND relname=?
) x
WHERE contype = 'f' AND
(confrelid = x.toid OR conrelid = x.toid)
};
$sth = $rdbh->prepare($SQL);
$count = $sth->execute($s,$t);
return $sth->fetchall_arrayref();
} ## end of get_reffed_tables
sub show_all_columns {
## Give a detailed listing of a particular row in the bucardo database
## Arguments: one
## 1. Hashref of information to display
## Returns: formatted, sorted, and indented list as a single string
my $row = shift or die;
my $maxkey = 1;
for my $key (keys %$row) {
next if ref $row->{$key};
$maxkey = length $key if length $key > $maxkey;
}
for my $key (sort {
($a eq 'src_code' and $b ne 'src_code' ? 1 : 0)
or
($a ne 'src_code' and $b eq 'src_code' ? -1 : 0)
or
$a cmp $b } keys %$row
) {
next if ref $row->{$key};
printf " %-*s = %s\n", $maxkey, $key,
defined $row->{$key} ? $row->{$key} : 'NULL';
}
return;
} ## end of show_all_columns
sub process_args {
## Break apart a string of args, return a clean hashref
## Arguments: one
## 1. List of arguments
## Returns: hashref
my $string = shift or return {};
$string .= ' ';
my %arg;
while ($string =~ m/(\w+)\s*[=:]\s*"(.+?)" /g) {
$arg{lc $1} = $2;
}
$string =~ s/\w+\s*=\s*".+?" / /g;
while ($string =~ m/(\w+)\s*[=:]\s*'(.+?)' /g) {
$arg{lc $1} = $2;
}
$string =~ s/\w+\s*=\s*'.+?' / /g;
while ($string =~ m/(\w+)\s*[=:]\s*(\S+)/g) {
$arg{lc $1} = $2;
}
$string =~ s/\w+\s*=\s*\S+/ /g;
if ($string =~ /\S/) {
$string =~ s/^\s+//;
$arg{extraargs} = [split /\s+/ => $string];
}
## Clean up and standardize the names
if (exists $arg{type}) {
$arg{type} = standardize_rdbms_name($arg{type});
}
return \%arg;
} ## end of process_args
sub list_clones {
## Show information about clones. Queries the bucardo.clone table
## Arguments: zero or more
## 1+ Clone id to view.
## Returns: 0 on success, -1 on error
## Example: bucardo list clones
## Might be no clones yet
if (! keys %$CLONE) {
print "No clones have been created yet\n";
return -1;
}
## Keep track of specific requests
my $cloneids;
for my $term (@nouns) {
if ($term =~ /^(\d+)$/) {
my $id = $1;
if (! exists $CLONE->{$id}) {
die qq{No such clone id "$id": try bucardo list clones\n};
}
$cloneids->{$id}++;
}
} ## end each term
## Print them out in numeric order
for my $clone (sort { $a->{id} <=> $b->{id} } values %$CLONE) {
## TODO: right justify numbers
next if keys %$cloneids and ! exists $cloneids->{$clone->{id}};
print "Clone #$clone->{id}";
print " Status: $clone->{status}";
defined $clone->{sync} and print " Sync: $clone->{sync}";
defined $clone->{dbgroup} and print " Dbgroup: $clone->{dbgroup}";
defined $clone->{relgroup} and print " Relgroup: $clone->{relgroup}";
defined $clone->{started} and print " Started: $clone->{pstarted}";
defined $clone->{ended} and print " Ended: $clone->{pstarted}";
if (defined $clone->{options}) {
print " $clone->{options}";
}
## Print last, on a new line:
defined $clone->{summary} and print "\n Summary: $clone->{summary}";
print "\n";
}
return 0;
} ## end of list_clones
sub list_customcodes {
## Show information about all or some subset of the 'customcode' table
## Arguments: none, parses nouns for customcodes
## Returns: 0 on success, -1 on error
my $doc_section = 'list';
## Any nouns are filters against the whole list
my $clause = generate_clause({col => 'name', items => \@nouns});
my $WHERE = $clause ? "WHERE $clause" : '';
$SQL = "SELECT * FROM bucardo.customcode $WHERE ORDER BY name";
$sth = $dbh->prepare($SQL);
$count = $sth->execute();
if ($count < 1) {
$sth->finish();
printf "There are no%s entries in the 'customcode' table.\n",
$WHERE ? ' matching' : '';
return -1;
}
$info = $sth->fetchall_arrayref({});
my ($maxname,$maxwhen) = (1,1);
for my $row (@$info) {
$maxname = length $row->{name} if length $row->{name} > $maxname;
$maxwhen = length $row->{whenrun} if length $row->{whenrun} > $maxwhen;
}
for my $row (@$info) {
my $name = $row->{name};
## We never show the actual source code unless verbosity is at least three!
if ($VERBOSE < 3) {
$row->{src_code} = 'Use -vvv to see the actual source code';
}
## We want to show all associates syncs and relations (when mapping is active)
my $info2 = $CUSTOMCODE->{$name} || {};
my ($synclist, $relationlist) = ('','');
if (exists $info2->{map}) {
$synclist = join ',' => sort map { $_->{sync} }
grep { defined $_->{sync} and $_->{active} }
@{ $info2->{map} };
$relationlist = join ',' => sort
map { "$GOAT->{by_id}{$_->{goat}}{schemaname}.$GOAT->{by_id}{$_->{goat}}{tablename}" }
grep { defined $_->{goat} and $_->{active} }
@{ $info2->{map} };
}
printf "Code: %-*s When run: %-*s Get dbh: %s Status: %s\n",
$maxname, $name,
$maxwhen, $row->{whenrun},
$row->{getdbh},
$row->{status};
if (length $synclist) {
print " Syncs: $synclist\n";
}
if (length $relationlist) {
print " Relations: $relationlist\n";
}
if (defined $row->{about} and $VERBOSE) {
(my $about = $row->{about}) =~ s/(.)^/$1 /gsm;
print " About: $about\n";
}
$VERBOSE >= 2 and show_all_columns($row);
}
return 0;
} ## end of list_customcodes
sub update_customcode {
## Update one or more customcodes
## Arguments: none (reads nouns for a list of customcodes)
## Returns: never, exits
my @actions = @_;
my $doc_section = 'update/update customcode';
usage_exit($doc_section) unless @actions;
my $name = shift @actions;
## Recursively call ourselves for wildcards and 'all'
exit 0 if ! check_recurse($SYNC, $name, @actions);
## Make sure this customcode exists!
if (! exists $CUSTOMCODE->{$name}) {
die qq{Could not find a customcode named "$name"\nUse 'list customcodes' to see all available.\n};
}
my $cc = $CUSTOMCODE->{$name};
my $changes = 0;
for my $action (@actions) {
## Look for a standard foo=bar or foo:bar format
if ($action =~ /(.+?)\s*[=:]\s*(.+)/) {
my ($setting,$value) = (lc $1,$2);
## No funny characters please, just boring column names
$setting =~ /^[a-z_]+$/ or die "Invalid setting: $setting\n";
my $srcfile;
## We only allow changing a strict subset of all the columns
if ($setting =~ /^(?:about|getdbh|name|priority|status|whenrun|src_code)$/) {
my $oldvalue = defined $cc->{$setting} ? $cc->{$setting} : '';
## Allow some variation for booleans, but transform to 0/1
if ($setting =~ /^(?:getdbh)$/) {
$value = $value =~ /^[1tTyY]/ ? 1 : 0;
}
## Some things can only be numbers
elsif ($setting =~ /^(?:priority)$/) {
if ($value !~ /^\d+$/) {
die qq{Customcode setting "$setting" must be a number!\n};
}
}
## And some are very specific indeed
elsif ('whenrun' eq $setting) {
my %whenrun = map { $_ => 1 } _whenrun_values();
die qq{Invalid value for setting "whenrun"\n}
unless $whenrun{$value};
}
elsif ('src_code' eq $setting) {
$srcfile = $value;
if (! -e $srcfile) {
warn qq{Could not find a file named "$srcfile"\n};
exit 2;
}
open my $fh, '<', $srcfile or die qq{Could not open "$srcfile": $!\n};
$value = '';
{ local $/; $value = <$fh>; } ## no critic (RequireInitializationForLocalVars)
close $fh or warn qq{Could not close "$srcfile": $!\n};
}
## Make the change, if it has changed
if ($value ne $oldvalue) {
$SQL = "UPDATE customcode SET $setting=? WHERE name = ?";
$sth = $dbh->prepare($SQL);
$sth->execute($value, $name);
$changes++;
if ('src_code' eq $setting) {
print qq{Changed customcode "$name" $setting with content of file "$srcfile"\n};
}
else {
print qq{Changed customcode "$name" $setting from '$oldvalue' to '$value'\n};
}
}
}
else {
warn "Cannot change attribute '$setting'\n";
usage_exit($doc_section);
}
next;
}
warn "\nUnknown action: $action\n";
usage_exit($doc_section);
}
confirm_commit() if $changes;
return;
} ## end of update_customcode
sub _whenrun_values {
return qw(
before_txn
before_check_rows
before_trigger_drop
after_trigger_drop
after_table_sync
exception
conflict
before_trigger_enable
after_trigger_enable
after_txn
before_sync
after_sync
);
}
sub list_sequences {
## Show information about all or some sequences in the 'goat' table
## Arguments: none (reads nouns for a list of sequences)
## Returns: 0 on success, -1 on error
my $doc_section = 'list';
my $clause = generate_clause({col => 'tablename', items => \@nouns});
my $WHERE = $clause ? "AND $clause" : '';
$SQL = "SELECT * FROM bucardo.goat WHERE reltype = 'sequence' $WHERE ORDER BY schemaname, tablename";
$sth = $dbh->prepare($SQL);
$count = $sth->execute();
if ($count < 1) {
$sth->finish();
printf "There are no%s sequences.\n",
$WHERE ? ' matching' : '';
return -1;
}
$info = $sth->fetchall_arrayref({});
my $maxq = 1;
for my $row (@$info) {
my $len = length "$row->{schemaname}.$row->{tablename}";
$maxq = $len if $len > $maxq;
}
for my $row (@$info) {
printf "Sequence: %-*s DB: %s\n",
$maxq, "$row->{schemaname}.$row->{tablename}",
$row->{db};
$VERBOSE >= 2 and show_all_columns($row);
}
return 0;
} ## end of list_sequences
sub pretty_time {
## Change seconds to a prettier display with hours, minutes, etc.
## Arguments: one
## 1. Number of seconds
## Returns: formatted string
my $secs = shift;
## Round up to the nearest second if decimal places are given
$secs = ceil($secs);
## If we cannot figure out the seconds, give up and return a question mark
return '?' if ! defined $secs or $secs !~ /^\-?\d+$/o or $secs < 0;
## Initialize days, hours, minutes, and seconds
my ($D,$H,$M,$S) = (0,0,0,0);
## Some people do not want days shown, so leave it as an option
if ($bcargs->{showdays}) {
if ($secs > 60*60*24) {
$D = int $secs/(60*60*24);
$secs -= $D*60*60*24;
}
}
## Show hours if there is > 1 hour
if ($secs > 60*60) {
$H = int $secs/(60*60);
$secs -= $H*60*60;
}
## Show minutes if there is > 1 minute
if ($secs > 60) {
$M = int $secs/60;
$secs -= $M*60;
}
$secs = int $secs;
my $answer = sprintf "%s%s%s${secs}s",$D ? "${D}d " : '',$H ? "${H}h " : '',$M ? "${M}m " : '';
## Detailed listings get compressed
if ((defined $COMPRESS and $COMPRESS) or (!defined $COMPRESS and !@nouns)) {
$answer =~ s/ //g;
}
return $answer;
} ## end of pretty_time
sub pretty_number {
## Format a raw number in a more readable style
## Arguments: one
## 1. Number
## Returns: formatted number
my $number = shift;
return $number if $number !~ /^\d+$/ or $number < 1000;
## If this is our first time here, find the correct separator
if (! defined $bcargs->{tsep}) {
my $lconv = localeconv();
$bcargs->{tsep} = $lconv->{thousands_sep} || ',';
}
## No formatting at all
return $number if '' eq $bcargs->{tsep} or ! $bcargs->{tsep};
(my $reverse = reverse $number) =~ s/(...)(?=\d)/$1$bcargs->{tsep}/g;
$number = reverse $reverse;
return $number;
} ## end of pretty_number
sub vate_sync {
## Activate or deactivate a sync
## Arguments: none (reads verbs and nouns)
## Returns: never, exits
my $name = lc $verb;
my $ucname = ucfirst $name;
@nouns or die qq{${name}_sync requires at least one sync name\n};
my $wait = (defined $adverb and $adverb eq '0') ? 1 : 0;
for my $sync (@syncs) {
(my $vname = $ucname) =~ s/e$/ing/;
$QUIET or print qq{$vname sync $sync};
my $done = "bucardo_${name}d_sync_$sync";
$dbh->do(qq{NOTIFY "bucardo_${name}_sync_$sync"});
if ($wait) {
print '...';
$dbh->do(qq{LISTEN "$done"});
}
$dbh->commit();
if (!$wait) {
print "\n";
next;
}
sleep 0.1;
wait_for_notice($dbh, $done);
print "OK\n";
} ## end each sync
exit 0;
} ## end of vate_sync
sub add_customcode {
## Add an entry to the bucardo.customcode table
## Arguments: none (uses nouns)
## Returns: never, exits
my $item_name = shift @nouns || '';
my $doc_section = 'add/add customcode';
usage_exit($doc_section) unless length $item_name;
## Inputs and aliases, database column name, flags, default
my $whenrun = join '|' => _whenrun_values();
my $validcols = qq{
name name 0 $item_name
about about 0 null
whenrun|when_run whenrun =$whenrun null
getdbh getdbh TF null
sync sync 0 skip
goat|table|relation goat 0 skip
status status =active|inactive skip
priority priority number skip
src_code src_code 0 skip
};
my ( $dbcols, $cols, $phs, $vals, $extras ) = process_simple_args({
cols => $validcols,
list => \@nouns,
doc_section => $doc_section,
});
my $newname = $dbcols->{name};
## Does this already exist?
if (exists $CUSTOMCODE->{$newname}) {
warn qq{Cannot create: customcode "$newname" already exists\n};
exit 2;
}
## We must have a "whenrun"
usage_exit($doc_section) unless $dbcols->{whenrun};
## We must have a src_code as a file
usage_exit($doc_section) unless $extras->{src_code};
my $tfile = $extras->{src_code};
if (! -e $tfile) {
warn qq{Could not find a file named "$tfile"\n};
exit 2;
}
open my $fh, '<', $tfile or die qq{Could not open "$tfile": $!\n};
my $src = '';
{ local $/; $src = <$fh>; } ## no critic (RequireInitializationForLocalVars)
close $fh or warn qq{Could not close "$tfile": $!\n};
## Attempt to insert this into the database
$SQL = "INSERT INTO bucardo.customcode ($cols,src_code) VALUES ($phs,?)";
$DEBUG and warn "SQL: $SQL\n";
$DEBUG and warn Dumper $vals;
$sth = $dbh->prepare($SQL);
eval {
$count = $sth->execute((map { $vals->{$_} } sort keys %$vals), $src);
};
if ($@) {
die "Failed to add customcode: $@\n";
}
my $finalmsg = '';
## See if any updates to customcode_map need to be made
## Only one of sync or goat can be specified
if ($extras->{sync} and $extras->{relation}) {
die qq{Sorry, you must specify a sync OR a relation, not both\n};
}
## Makes no sense to specify priority or active if no goat or sync
if (($extras->{priority} or $extras->{active}) and !$extras->{sync} and ! $extras->{relation}) {
die qq{You must specify a sync or a relation when using priority or active\n};
}
## Is this a valid sync?
if ($extras->{sync} and ! exists $SYNC->{$extras->{sync}}) {
die qq{Unknown sync: $extras->{sync}\n};
}
## Is this a valid gaot?
if ($extras->{relation} and ! exists $GOAT->{by_name}{$extras->{relation}}
and ! exists $GOAT->{by_table}{$extras->{relation}}) {
die qq{Unknown relation: $extras->{relation}\n};
}
## Add to the customcode_map table
if ($extras->{sync} or $extras->{relation}) {
$SQL = 'INSERT INTO customcode_map(code,';
my @vals;
for my $col (qw/sync priority active/) {
if ($extras->{$col}) {
$SQL .= "$col,";
push @vals => $extras->{$col};
}
}
if ($extras->{relation}) {
$SQL .= 'goat,';
push @vals => exists $GOAT->{by_name}{$extras->{relation}}
? $GOAT->{by_name}{$extras->{relation}}->[0]{id}
: $GOAT->{by_table}{$extras->{relation}}->[0]{id};
}
my $phs2 = '?,' x @vals;
$SQL .= ") VALUES ((SELECT currval('customcode_id_seq')),$phs2)";
$SQL =~ s/,\)/)/g;
$sth = $dbh->prepare($SQL);
eval {
$count = $sth->execute(@vals);
};
if ($@) {
die "Failed to add customcode_map: $@\n";
}
}
if (!$QUIET) {
print qq{Added customcode "$newname"\n};
$finalmsg and print $finalmsg;
}
confirm_commit();
exit 0;
} ## end of add_customcode
sub _list_databases {
## Quick list of available databases
## Arguments: none
## Returns: list of databases as a single string
return if ! keys %{ $DB };
warn "The following databases are available:\n";
for (sort keys %{ $DB }) {
next if $DB->{$_}{dbtype} ne 'postgres';
print "$_\n";
}
return;
} ## end of _list_databases
sub add_all_tables {
## Add all tables, returns output from add_all_goats
## Arguments: none
## Returns: output of inner sub
return add_all_goats('table');
} ## end of add_all_tables
sub add_all_sequences {
## Add all tables, returns output from add_all_goats
## Arguments: none
## Returns: output of inner sub
return add_all_goats('sequence');
} ## end of add_all_sequences
sub add_all_goats {
## Add all tables, or sequences
## Arguments: one
## 1. The type, table or sequence
## Returns: Srting indicating what was done
my $type = shift;
## Usage: add all table(s) | add all sequence(s)
## Options:
## --db: use this database (internal name from the db table)
## --schema or -n: limit to one or more comma-separated schemas
## --exclude-schema or -N: exclude these schemas
## --table or -t: limit to the given tables
## --exclude-table or -T: exclude these tables
## --relgroup: name of the herd to add new tables to
## pkonly: exclude tables with no pkey
## Returns: text string of results, with a newline
## Transform command-line args to traditional format
## e.g. db=foo becomes the equivalent of --db=foo
## foo becomes foo=1
for my $noun (@nouns) {
if ($noun =~ /(\w+)=(\w+)/) {
$bcargs->{$1} = $2;
}
else {
$bcargs->{$noun} = 1;
}
}
$bcargs->{herd} = delete $bcargs->{relgroup} || $bcargs->{herd};
## If no databases, cowardly refuse to continue
if (! keys %$DB) {
die "Sorry, cannot add any ${type}s until at least one database has been added\n";
}
## If there is more than one database, it should be selected via db=
my $db;
my $showdbs = 0;
if (exists $bcargs->{db}) {
if (! exists $DB->{$bcargs->{db}}) {
warn qq{Sorry, could not find a database named "$bcargs->{db}"\n};
$showdbs = 1;
}
else {
$db = $DB->{$bcargs->{db}};
}
}
elsif (keys %$DB == 1) {
($db) = values %$DB;
}
else {
## Grab the most likely candidate
my $bestdb = find_best_db_for_searching();
if (! $bestdb) {
warn "Please specify which database to use with the db= option\n";
$showdbs = 1;
}
else {
$db = $DB->{$bestdb};
}
}
if ($showdbs) {
_list_databases();
exit 1;
}
## Connect to the remote database
my $dbh2 = connect_database({name => $db->{name}});
## Query to pull all tables we may possibly need
my $kind = $type eq 'table' ? 'r' : 'S';
$SQL = q{SELECT nspname, relname FROM pg_catalog.pg_class c }
. q{JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace) }
. qq{WHERE relkind = '$kind' };
## We always exclude information_schema, system, and bucardo schemas
$SQL .= q{AND n.nspname <> 'information_schema' AND nspname !~ '^pg' AND nspname !~ '^bucardo'};
my @clause;
## If they gave a schema option, restrict the query by namespace
push @clause => generate_clause({col => 'nspname', items => $bcargs->{schema}});
## If they have asked to exclude schemas, append that to the namespace clause
push @clause => generate_clause({col => 'nspname', items => $bcargs->{'exclude-schema'}, not => 1});
## If they gave a table option, restrict the query by relname
push @clause => generate_clause({col => 'relname', items => $bcargs->{table}});
## If they have asked to exclude tables, append that to the relname clause
push @clause => generate_clause({col => 'relname', items => $bcargs->{'exclude-table'}, not => 1});
for my $c (@clause) {
next if ! $c;
$SQL .= "\nAND ($c)";
}
## Fetch all the items, warn if no matches are found
$VERBOSE >= 2 and warn "Query: $SQL\n";
$sth = $dbh2->prepare($SQL);
$count = $sth->execute();
if ($count < 1) {
warn "Sorry, no ${type}s were found\n";
}
## Grab all current tables or sequences from the goat table.
$SQL = qq{SELECT schemaname, tablename FROM bucardo.goat WHERE reltype= '$type' AND db = '$db->{name}'};
my %hastable;
for my $row (@{$dbh->selectall_arrayref($SQL)}) {
$hastable{$row->[0]}{$row->[1]}++;
}
## Do we have a herd request? Process it if so
my $herd = '';
my $addtoherd;
if ($bcargs->{herd}) {
$herd = $bcargs->{herd};
$SQL = 'SELECT 1 FROM bucardo.herd WHERE name = ?';
my $herdcheck = $dbh->prepare($SQL);
$count = $herdcheck->execute($herd);
$herdcheck->finish();
if ($count < 1) {
print "Creating relgroup: $herd\n";
$SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)';
$herdcheck = $dbh->prepare($SQL);
$herdcheck->execute($herd);
}
else {
$VERBOSE >= 1 and warn "Relgroup already exists: $herd\n";
}
$SQL = 'INSERT INTO bucardo.herdmap(herd,goat) VALUES (?,?)';
$addtoherd = $dbh->prepare($SQL);
}
## Get ready to add tables or sequences to the goat table
$SQL = q{INSERT INTO bucardo.goat (db,schemaname,tablename,reltype};
$SQL .= exists $bcargs->{makedelta} ? ',makedelta) VALUES (?,?,?,?,?)' : ') VALUES (?,?,?,?)';
my $addtable = $dbh->prepare($SQL);
## Walk through all returned tables from the remote database
my %count = (seenit => 0, added => 0);
my (%old, %new, %fail, $id);
for my $row (@{$sth->fetchall_arrayref()}) {
my ($S,$T) = @$row;
my $tinfo;
## Do we already have this one?
if (exists $hastable{$S}{$T}) {
$VERBOSE >= 2 and warn "Skipping $type already in relation: $S.$T\n";
$count{seenit}++;
$old{$S}{$T} = 1;
if ($herd) {
## In case this is not already in the herd, grab the id and jump down
$SQL = 'SELECT * FROM goat WHERE db=? AND schemaname=? AND tablename=? AND reltype=?';
$sth = $dbh->prepare($SQL);
$count = $sth->execute($db->{name},$S,$T,$type);
if ($count < 1) {
die qq{Could not find $type $S.$T in database "$db->{name}"!\n};
}
$tinfo = $sth->fetchall_arrayref({})->[0];
$id = $tinfo->{id};
goto HERD;
}
next;
}
$VERBOSE >= 2 and warn "Attempting to add relation $S.$T\n";
## We want a savepoint as we may retract the addition (e.g. no pkey and pkonly specified)
$dbh->do('SAVEPOINT newtable');
eval {
my @arg = ($db->{name},$S,$T,$type);
push @arg => $bcargs->{makedelta} if exists $bcargs->{makedelta};
$count = $addtable->execute(@arg);
};
if ($@) {
warn "$@\n";
if ($@ =~ /prepared statement.+already exists/) {
warn "This message usually indicates you are using pgbouncer\n";
warn "You can probably fix this problem by running:\n";
warn "$progname update db $db->{name} server_side_prepares=false\n";
warn "Then retry your command again\n\n";
}
exit 1;
}
if ($count != 1) {
$addtable->finish();
warn "Failed to add $type relation $S.$T!\n";
$fail{$S}{$T} = 1;
next;
}
$SQL = q{SELECT currval('bucardo.goat_id_seq')};
$id = $dbh->selectall_arrayref($SQL)->[0][0];
$VERBOSE >= 2 and warn "ID of new table $S.$T is $id\n";
## Grab it back from the database
$SQL = 'SELECT * FROM goat WHERE id = ?';
$sth = $dbh->prepare($SQL);
$sth->execute($id);
$tinfo = $sth->fetchall_arrayref({})->[0];
## If it has no primary key and pkonly is set, abandon this change
if ($bcargs->{pkonly} and 'table' eq $type and ! length $tinfo->{pkey}) {
$VERBOSE >= 1 and warn "Not adding table $S.$T: no pkey\n";
$dbh->do('ROLLBACK TO newtable');
next;
}
$count{added}++;
$new{$S}{$T} = 1;
HERD:
if ($herd) {
## Need to check again as the previous check above was only for brand new tables
if ($bcargs->{pkonly} and 'table' eq $type and ! length $tinfo->{pkey}) {
$VERBOSE >= 1 and warn "Not adding table $S.$T to relgroup: no pkey\n";
}
else {
$SQL = 'SELECT 1 FROM herdmap WHERE herd=? AND goat = ?';
$sth = $dbh->prepare($SQL);
$count = $sth->execute($herd, $id);
if ($count < 1) {
$addtoherd->execute($herd, $id);
print "Added $type $S.$T to relgroup $herd\n";
}
}
}
}
## Disconnect from the remote database
$dbh2->disconnect();
if ($VERBOSE >= 1) {
if (%new) {
print "New ${type}s:\n";
for my $s (sort keys %new) {
for my $t (sort keys %{$new{$s}}) {
print " $s.$t\n";
}
}
}
if (%fail) {
print "Failed to add ${type}s:\n";
for my $s (sort keys %fail) {
for my $t (sort keys %{$fail{$s}}) {
print " $s.$t\n";
}
}
}
}
my $message = "New ${type}s added: $count{added}\n";
if ($count{seenit}) {
$message .= "Already added: $count{seenit}\n";
}
return $message;
} ## end of add_all_goats
sub remove_customcode {
## Usage: remove customcode name [name2 name3 ...]
## Arguments: none (uses nouns)
## Returns: never, exits
my $doc_section = 'remove';
usage_exit($doc_section) unless @nouns;
## Make sure all named codes exist
my $code = $global{cc};
for my $name (@nouns) {
if (! exists $code->{$name}) {
die qq{No such code: $name\n};
}
}
$SQL = 'DELETE FROM bucardo.customcode WHERE name = ?';
$sth = $dbh->prepare($SQL);
for my $name (@nouns) {
eval {
$sth->execute($name);
};
if ($@) {
die qq{Could not delete customcode "$name"\n$@\n};
}
}
for my $name (@nouns) {
print qq{Removed customcode "$name"\n};
}
$dbh->commit();
exit 0;
} ## end of remove_customcode
sub clog {
## Output a message to stderr
## Arguments: one
## 1. Message
## Returns: undef
my $message = shift;
chomp $message;
warn "$message\n";
return;
} ## end of clog
sub schema_exists {
## Determine if a named schema exists
## Arguments: one
## 1. Schema name
## Returns: 0 or 1
my $schema = shift;
my $SQL = 'SELECT 1 FROM pg_catalog.pg_namespace WHERE nspname = ?';
my $sth = $dbh->prepare_cached($SQL);
my $count = $sth->execute($schema);
$sth->finish();
return $count < 1 ? 0 : 1;
} ## end of schema_exists
sub relation_exists {
## Determine if a named relation exists
## Arguments: two
## 1. Schema name
## 2. Relation name
## Returns: OID of the relation, or 0 if it does not exist
my ($schema,$name) = @_;
my $SQL = 'SELECT c.oid FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n '.
'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ?';
my $sth = $dbh->prepare_cached($SQL);
my $count = $sth->execute($schema,$name);
if ($count == 1) {
return $sth->fetchall_arrayref()->[0][0];
}
$sth->finish();
return 0;
} ## end of relation_exists
sub domain_exists {
## Determine if a named domain exists
## Arguments: two
## 1. Schema name
## 2. Domain name
## Returns: 0 or 1
my ($schema,$name) = @_;
my $SQL =
q{SELECT 1 FROM pg_catalog.pg_type t }
. q{JOIN pg_namespace n ON (n.oid = t.typnamespace) }
. q{WHERE t.typtype = 'd' AND n.nspname = ? AND t.typname = ?};
my $sth = $dbh->prepare_cached($SQL);
$count = $sth->execute($schema,$name);
$sth->finish();
return $count < 1 ? 0 : 1;
} ## end of domain_exists
sub config_exists {
## Checks if a configuration settings exists
## Arguments: one
## 1. Name of the setting
## Returns: 0 or 1
my $name = shift;
my $SQL = 'SELECT 1 FROM bucardo.bucardo_config WHERE name = ?';
my $sth = $dbh->prepare_cached($SQL);
my $count = $sth->execute($name);
$sth->finish();
return $count < 1 ? 0 : 1;
} ## end of config_exists
sub constraint_exists {
## Determine if a named constraint exists
## Arguments: three
## 1. Schema name
## 2. Table name
## 3. Constraint name
## Returns: 0 or 1
my ($schema,$table,$constraint) = @_;
my $SQL = 'SELECT 1 FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, pg_catalog.pg_constraint o '.
'WHERE n.oid=c.relnamespace AND c.oid=o.conrelid AND n.nspname = ? AND c.relname = ? AND o.conname = ?';
my $sth = $dbh->prepare_cached($SQL);
my $count = $sth->execute($schema,$table,$constraint);
$sth->finish();
return $count < 1 ? 0 : 1;
} ## end of constraint_exists
sub column_exists {
## Determine if a named column exists
## Arguments: three
## 1. Schema name
## 2. Table name
## 3. Column name
## Returns: 0 or 1
my ($schema,$table,$column) = @_;
my $SQL = 'SELECT 1 FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '.
'pg_catalog.pg_attribute a WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '.
'AND a.attname = ? AND a.attrelid = c.oid';
my $sth = $dbh->prepare_cached($SQL);
my $count = $sth->execute($schema,$table,$column);
$sth->finish();
return $count < 1 ? 0 : 1;
} ## end of column_exists
sub trigger_exists {
## Determine if a named trigger exists
## Arguments: one
## 1. Trigger name
## Returns: 0 or 1
my $name = shift;
my $SQL = 'SELECT 1 FROM pg_catalog.pg_trigger WHERE tgname = ?';
my $sth = $dbh->prepare_cached($SQL);
my $count = $sth->execute($name);
$sth->finish();
return $count < 1 ? 0 : 1;
} ## end of trigger_exists
sub function_exists {
## Determine if a named function exists
## Arguments: three
## 1. Schema name
## 2. Function name
## 3. Function arguments (as one CSV string)
## Returns: MD5 of the function source if found, otherwise an empty string
my ($schema,$name,$args) = @_;
$name = lc $name;
$SQL = 'SELECT md5(prosrc) FROM pg_proc p, pg_language l '.
'WHERE p.prolang = l.oid AND proname = ? AND oidvectortypes(proargtypes) = ?';
$sth = $dbh->prepare($SQL);
$count = $sth->execute($name,$args);
if ($count < 1) {
$sth->finish();
return '';
}
return $sth->fetchall_arrayref()->[0][0];
} ## end of function_exists
sub column_default {
## Return the default value for a column in a table
## Arguments: three
## 1. Schema name
## 2. Table name
## 3. Column name
## Returns: default value if available, otherwise an empty string
my ($schema,$table,$column) = @_;
my $SQL = 'SELECT pg_get_expr(adbin,adrelid) FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '.
'pg_catalog.pg_attribute a, pg_attrdef d '.
'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '.
'AND a.attname = ? AND a.attrelid = c.oid AND d.adnum = a.attnum AND d.adrelid = a.attrelid';
my $sth = $dbh->prepare_cached($SQL);
my $count = $sth->execute($schema,$table,$column);
if ($count < 1) {
$sth->finish();
return '';
}
return $sth->fetchall_arrayref()->[0][0];
} ## end of column_default
sub column_value {
## Return the value of a table's column
## Arguments: four
## 1. Schema name
## 2. Table name
## 3. Column name
## 4. Where clause
## Returns: value if available, otherwise an empty string
my ($schema,$table,$column,$where) = @_;
my $SQL = "SELECT $column FROM $schema.$table WHERE $where";
return $dbh->selectall_arrayref($SQL)->[0][0];
} ## end of column_value
sub column_type {
## Return the data type of a table column
## Arguments: three
## 1. Schema name
## 2. Table name
## 3. Column name
## Returns: data type if available, otherwise an empty string
my ($schema,$table,$column) = @_;
my $SQL = 'SELECT pg_catalog.format_type(a.atttypid, a.atttypmod) '.
'FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '.
'pg_catalog.pg_attribute a '.
'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '.
'AND a.attname = ? AND a.attrelid = c.oid';
my $sth = $dbh->prepare_cached($SQL);
my $count = $sth->execute($schema,$table,$column);
if ($count eq '0E0') {
$sth->finish();
return '';
}
return $sth->fetchall_arrayref()->[0][0];
} ## end of column_type
sub constraint_definition {
## Return the definition for a constraint
## Arguments: one
## 1. Constraint name
## Returns: definition if found, otherwise an empty string
my $name = shift;
my $SQL = qq{SELECT pg_get_constraintdef(oid,true) FROM pg_constraint WHERE conname = '$name'};
my $def = $dbh->selectall_arrayref($SQL)->[0][0];
## Nothing found? Just return an empty string
return '' if ! defined $def;
## Do some cleanups to standardize across versions and match bucardo.schema cleanly
$def =~ s/\((\(.+\))\)/$1/;
$def =~ s/= ANY \(ARRAY\[(.+)\]\)/IN ($1)/;
$def =~ s/<> ALL \(ARRAY\[(.+)\]\)/NOT IN ($1)/;
$def =~ s/::text//g;
$def =~ s/(\w+) ~ '/$1 ~ E'/g;
$def =~ s/CHECK \(\((\w+)\) <>/CHECK ($1 <>/;
return $def;
} ## end of constraint_definition
sub table_comment {
## Return the comment of a table
## Arguments: two
## 1. Schema name
## 2. Table name
## Returns: comment if available, otherwise an empty string
my ($schema,$relation) = @_;
my $SQL = q{SELECT description FROM pg_description WHERE objoid = (}
. q{ SELECT c.oid FROM pg_class c JOIN pg_namespace n ON (n.oid = c.relnamespace)}
. q{ WHERE n.nspname = ? AND c.relname = ?)};
my $sth = $dbh->prepare($SQL);
$count = $sth->execute($schema,$relation);
if ($count < 1) {
$sth->finish();
return '';
}
return $sth->fetchall_arrayref()->[0][0];
} ## end of table_comment
sub domain_comment {
## Return the comment of a domain
## Arguments: two
## 1. Schema name
## 2. Domain name
## Returns: comment if available, otherwise an empty string
my ($schema,$relation) = @_;
my $SQL = q{SELECT description FROM pg_description WHERE objoid = (}
. q{ SELECT t.oid FROM pg_type t JOIN pg_namespace n ON (n.oid = t.typnamespace)}
. q{ WHERE t.typtype = 'd' AND n.nspname = ? AND t.typname = ?)};
my $sth = $dbh->prepare($SQL);
$count = $sth->execute($schema,$relation);
if ($count < 1) {
$sth->finish();
return '';
}
return $sth->fetchall_arrayref()->[0][0];
} ## end of domain_comment
sub find_bucardo_schema {
## Locate the best bucardo.schema file and return a file handle and name for it
## Arguments: none
## Returns: file handle and location of the file
my $fh;
## Start by checking the current directory
my $schema_file = 'bucardo.schema';
return ($fh, $schema_file) if open $fh, '<', $schema_file;
## Check for a symlink path back to the right directory
if (-l $progname) {
my $dir = dirname( readlink $progname );
$schema_file = File::Spec->catfile( $dir, 'bucardo.schema' );
return ($fh, $schema_file) if open $fh, '<', $schema_file;
}
## Try /usr/local/share/bucardo
$schema_file = '/usr/local/share/bucardo/bucardo.schema';
return ($fh, $schema_file) if open $fh, '<', $schema_file;
## Try /usr/share/bucardo
$schema_file = '/usr/share/bucardo/bucardo.schema';
return ($fh, $schema_file) if open $fh, '<', $schema_file;
die "Could not find the bucardo.schema file!\n";
} ## end of find_bucardo_schema
sub table_definition {
## Pull the complete table definition from the bucardo.schema file
## Returns an arrayref of sequences, and the textual table def
## Arguments: one
## 1. Name of the table
## Returns: arrayref of sequences used, table definition
my $name = shift;
my $def = '';
my ($fh, $schema_file) = find_bucardo_schema();
my @seq;
while (<$fh>) {
if (!$def) {
if (/^CREATE TABLE $name/) {
$def .= $_;
}
}
else {
$def .= $_;
last if /^\);/;
}
}
close $fh or die qq{Could not close "$schema_file": $!\n};
while ($def =~ /nextval\('(.+?)'/g) {
push @seq => $1;
}
if (! length($def)) {
die "Could not find the table definition for $name\n";
}
return \@seq, $def;
} ## end of table_definition
sub generate_clause {
## Generate a snippet of SQL for a WHERE clause
## Arguments: one
## 1. Hashref of information
## Returns: new clause
my $arg = shift or die;
return '' if ! $arg->{items} or ! defined $arg->{items}[0];
my $col = $arg->{col} or die;
my $items = $arg->{items};
my ($NOT,$NOTR) = ('','');
if (exists $arg->{not}) {
$NOT = 'NOT ';
$NOTR = '!';
}
my $andor = exists $arg->{andor} ? uc($arg->{andor}) : $NOT ? 'AND' : 'OR';
my (@oneitem,@itemlist);
for my $name (@{$items}) {
$name =~ s/^\s*(.+?)\s*$/$1/;
## Break into schema and relation
my $schema = '';
if ($col eq 'tablename' and $name =~ s/(.+\w)\.(\w.+)/$2/) {
$schema = $1;
}
my $one = 1;
## Contains:
if ($name =~ s/^\*(.+)\*$/$1/) {
push @oneitem => "$col ${NOTR}~ " . qquote($1);
}
## Starts with:
elsif ($name =~ s/^\*(.+)/$1/) {
push @oneitem => "$col ${NOTR}~ " . qquote("$1\$");
}
## Ends with:
elsif ($name =~ s/(.+)\*$/$1/) {
push @oneitem => "$col ${NOTR}~ " . qquote("^$1");
}
else {
push @itemlist => qquote($name);
$one = 0;
}
if ($schema) {
my $col2 = 'schemaname';
my $old = $one ? pop @oneitem : pop @itemlist;
if ($schema =~ s/^\*(.+)\*$/$1/) {
push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote($1) . ')';
}
elsif ($schema =~ s/^\*(.+)/$1/) {
push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote("$1\$") . ')';
}
elsif ($schema =~ s/(.+)\*$/$1/) {
push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote("^$1") . ')';
}
else {
push @oneitem => "($col = $old AND $col2 = " . qquote($schema) . ')';
}
}
}
if (@itemlist) {
my $list = sprintf '%s %s%s (%s)', $col, $NOT, 'IN', (join ',' => @itemlist);
push @oneitem => $list;
}
my $SQL = join " $andor " => @oneitem;
return $SQL;
} ## end of generate_clause
sub qquote {
## Quick SQL quoting
## Arguments: one
## 1. String to be quoted
## Returns: modified string
my $thing = shift;
$thing =~ s/'/''/g;
return qq{'$thing'};
} ## end of qquote
sub upgrade {
## Make upgrades to an existing Bucardo schema to match the current version
## Arguments: none
## Returns: never, exits
## Ensure the bucardo.schema file is available and the correct version
my ($fh, $schema_file) = find_bucardo_schema();
my $schema_version = 0;
while (<$fh>) {
if (/\-\- Version (\d+\.\d+\.\d+)/) {
$schema_version = $1;
last;
}
}
if (! $schema_version) {
die qq{Could not find version number in the file "$schema_file"!\n};
}
if ($schema_version ne $VERSION) {
die qq{Cannot continue: bucardo is version $VERSION, but $schema_file is version $schema_version\n};
}
$dbh->do(q{SET escape_string_warning = 'OFF'});
if ($dbh->{pg_server_version} >= 80200) {
$dbh->do(q{SET standard_conforming_strings = 'ON'});
}
my $changes = 0;
## Quick sanity to make sure we don't try to cross the 4/5 boundary
if (!relation_exists('bucardo', 'syncrun')) {
print "Sorry, but Bucardo version 4 cannot be upgraded to version 5\n";
print "You will have to recreate your information (dbs, syncs, etc.)\n";
exit 1;
}
## Make sure the upgrade_log table is in place
if (!relation_exists('bucardo', 'upgrade_log')) {
my ($seqlist, $tabledef) = table_definition('bucardo.upgrade_log');
upgrade_and_log($tabledef,'CREATE TABLE bucardo.upgrade_log');
$dbh->commit();
}
my @old_sequences = (
'dbgroup_id_seq',
);
my @old_configs = (
'pidfile',
'upsert_attempts',
);
my @renamed_configs = (
['default_standard_conflict' => 'default_conflict_strategy'],
);
my @old_constraints = (
['bucardo', 'goat', 'goat_pkeytype_check'],
['bucardo', 'sync', 'sync_replica_allornone'],
['bucardo', 'sync', 'sync_disable_triggers_method'],
['bucardo', 'sync', 'sync_disable_rules_method'],
);
my @old_columns = (
['bucardo', 'dbmap', 'makedelta'],
['bucardo', 'sync', 'disable_rules'],
['bucardo', 'sync', 'disable_triggers'],
['bucardo', 'sync', 'makedelta'],
);
my @old_functions = (
['create_child_q', 'text'],
);
my @old_indexes = (
['bucardo', 'sync', 'sync_source_targetdb'],
['bucardo', 'sync', 'sync_source_targetgroup'],
);
my @old_views = (
'goats_in_herd',
);
my @new_columns = (
);
my @dropped_columns = (
['bucardo', 'sync', 'limitdbs'],
['bucardo', 'goat', 'customselect'],
['bucardo', 'sync', 'usecustomselect'],
['bucardo', 'sync', 'do_listen'],
['bucardo', 'customcode', 'getrows'],
);
my @altered_columns = (
['bucardo', 'goat', 'rebuild_index', 'BOOL2SMALLINT1'],
['bucardo', 'goat', 'schemaname', 'NO DEFAULT'],
['bucardo', 'sync', 'isolation_level', 'NO DEFAULT'],
['bucardo', 'sync', 'rebuild_index', 'BOOL2SMALLINT1'],
['bucardo', 'sync', 'standard_conflict', 'RENAME conflict_strategy'],
['bucardo', 'sync', 'ping', 'RENAME autokick'],
['bucardo', 'goat', 'ping', 'RENAME autokick'],
['bucardo', 'goat', 'standard_conflict', 'RENAME conflict_strategy'],
);
my @row_values = (
['bucardo_config','about',q{name = 'log_showtime'}, 1,
'Show timestamp in the log output? 0=off 1=seconds since epoch 2=scalar gmtime 3=scalar localtime'],
['bucardo_config', 'about', q{name = 'default_conflict_strategy'}, 1, 'Default conflict strategy for all syncs'],
);
my @drop_all_rules = (
);
## Drop all existing rules from a table:
for my $row (@drop_all_rules) {
my ($schema,$table) = @$row;
my $oid = relation_exists($schema,$table);
if (!$oid) {
warn "Could not find table $schema.$table to check!\n";
next;
}
$SQL = 'SELECT rulename FROM pg_catalog.pg_rewrite WHERE ev_class = ? ORDER BY rulename';
$sth = $dbh->prepare($SQL);
$count = $sth->execute($oid);
if ($count < 1) {
$sth->finish();
next;
}
for my $rule (map { $_->[0] } @{$sth->fetchall_arrayref()}) {
upgrade_and_log(qq{DROP RULE "$rule" ON $schema.$table});
clog "Dropped rule $rule on table $schema.$table";
$changes++;
}
}
## Drop any old views
for my $name (@old_views) {
next if !relation_exists('bucardo', $name);
upgrade_and_log("DROP VIEW $name");
clog "Dropped view $name";
$changes++;
}
## Drop any old sequences
for my $sequence (@old_sequences) {
next if !relation_exists('bucardo', $sequence);
upgrade_and_log("DROP SEQUENCE bucardo.$sequence");
clog "Dropped sequence: $sequence";
$changes++;
}
## Drop any old constraints
for my $con (@old_constraints) {
my ($schema, $table, $constraint) = @$con;
next if !constraint_exists($schema, $table, $constraint);
upgrade_and_log(qq{ALTER TABLE $schema.$table DROP CONSTRAINT "$constraint"});
clog "Dropped constraint $constraint ON $schema.$table";
$changes++;
}
## Parse the bucardo.schema file and verify the following types of objects exist:
## Functions, triggers, constraints, sequences, indexes, comments, and domains
my (@flist, @tlist, @ilist, @clist, @clist2, @slist, @tablelist, @comlist, @domlist, @collist);
my ($fname,$args,$fbody) = ('','','');
my ($tname,$tbody) = ('','');
my ($tablename,$tablebody) = ('','');
my ($altername,$alterbody,$alterstat) = ('','','');
seek $fh, 0, 0;
while (<$fh>) {
if ($fbody) {
if (/^(\$bc\$;)/) {
$fbody .= $1;
push @flist, [$fname, $args, $fbody];
$fbody = $fname = $args = '';
}
else {
$fbody .= $_;
}
next;
}
if ($tbody) {
$tbody .= $_;
if (/;/) {
push @tlist, [$tname, $tbody];
$tbody = $tname = '';
}
next;
}
if ($tablebody) {
$tablebody .= $_;
if (/^\s*CONSTRAINT\s+(\w+)\s+(.+?)\s*$/) {
my ($cname,$def) = ($1,$2);
$def =~ s/,$//;
$def =~ s/\bbucardo\.//;
push @clist2, [$tablename, $cname, $def];
}
elsif (/^\s+([a-z_]+)\s+([A-Z]+)\s*(NOT)? NULL(.*)/) {
my ($colname,$coltype,$isnull,$extra,$default) = ($1, $2, $3 ? 1 : 0, $4, undef);
if ($extra =~ /DEFAULT\s+([^,]+)/) {
$default = $1;
}
push @collist, ['bucardo', $tablename, $colname, $_, $default];
}
elsif (/;/) {
push @tablelist, [$tablename, $tablebody];
$tablebody = $tablename = '';
}
else {
die qq{Could not parse table definition: invalid column at line $. ($_)\n};
}
next;
}
if ($altername) {
$alterbody =~ s/\s+$//;
$alterbody ? s/^\s+/ / : s/^\s+//;
s/\s+$/ /;
$alterbody .= $_;
$alterstat .= $_;
if ($alterbody =~ s/;\s*$//) {
push @clist, [$altername->[0], $altername->[1], $alterbody, $alterstat];
$alterbody = $altername = $alterstat = '';
}
next;
}
if (/^CREATE (?:OR REPLACE )?FUNCTION\s+bucardo\.(.+?\))/) {
$fname = $1;
$fbody .= $_;
$fname =~ s/\((.*)\)// or die "No args found for function: $_\n";
$args = $1;
$args =~ s/,(\S)/, $1/g;
next;
}
if (/^CREATE TRIGGER (\S+)/) {
$tname = $1;
$tbody .= $_;
next;
}
if (/^CREATE TABLE bucardo\.(\w+)/) {
$tablename = $1;
$tablebody .= $_;
next;
}
if (/^CREATE (UNIQUE )?INDEX (\S+)/) {
push @ilist, [$1, $2, $_];
next;
}
if (/^ALTER TABLE bucardo\.(\S+)\s+ADD CONSTRAINT\s*(\S+)\s*(\S*.*)/) {
$altername = [$1,$2];
$alterbody = $3 || '';
$alterstat = $_;
next;
}
if (/^CREATE SEQUENCE bucardo\.(\w+)/) {
push @slist, [$1, $_];
next;
}
if (/^COMMENT ON (\w+) (\w+)\.(\w+) IS \$\$(.+)\$\$/) {
push @comlist, [lc $1, $2, $3, $4, $_];
next;
}
if (/^CREATE DOMAIN bucardo\.(\w+) (.+)/) {
push @domlist, [$1, $2];
next;
}
}
## Add any new domains, verify existing ones
for my $row (@domlist) {
my ($name,$def) = @$row;
next if domain_exists('bucardo', $name);
upgrade_and_log("CREATE DOMAIN bucardo.$name $def");
clog("Created domain: $name");
$changes++;
}
## Check for any added sequences
for my $row (@slist) {
my ($sname,$body) = @$row;
next if relation_exists('bucardo', $sname);
upgrade_and_log($body);
clog "Created sequence $sname";
$changes++;
}
## Check for any added tables
for my $row (@tablelist) {
my ($name,$body) = @$row;
next if relation_exists('bucardo', $name);
upgrade_and_log($body);
clog "Created table $name";
$changes++;
}
## Add new columns as needed from the schema
for my $row (@collist) {
my ($schema,$table,$column,$definition) = @$row;
next if column_exists($schema, $table, $column);
$definition =~ s/\-\-.+$//;
$definition =~ s/,\s*$//;
$definition =~ s/\s+/ /g;
upgrade_and_log("ALTER TABLE $schema.$table ADD COLUMN $definition");
clog "Created column: $schema.$table.$column";
$changes++;
}
## Add specific new columns as needed
for my $row (@new_columns) {
my ($schema,$table,$column,$def) = @$row;
next if column_exists($schema, $table, $column);
$def =~ s/\s+/ /g;
upgrade_and_log("ALTER TABLE $schema.$table ADD COLUMN $def");
clog "Created column: $schema.$table.$column";
$changes++;
}
## Drop columns as needed.
for my $row (@dropped_columns) {
my ($schema,$table,$column) = @$row;
next unless column_exists($schema, $table, $column);
upgrade_and_log("ALTER TABLE $schema.$table DROP COLUMN $column");
clog "Dropped column: $schema.$table.$column";
$changes++;
}
## Change any altered columns
for my $row (@altered_columns) {
my ($schema,$table,$column,$change) = @$row;
next if ! column_exists($schema, $table, $column);
if ($change eq 'NO DEFAULT') {
my $def = column_default($schema, $table, $column);
next if !$def;
upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column DROP DEFAULT");
clog "Removed DEFAULT ($def) from $schema.$table.$column";
$changes++;
}
elsif ($change =~ /^RENAME\s+(\w+)/) {
my $newname = $1;
next if column_exists($schema, $table, $newname);
upgrade_and_log("ALTER TABLE $schema.$table RENAME COLUMN $column TO $newname");
clog("Renamed $schema.$table.$column to $newname");
$changes++;
}
elsif ($change =~ /^DEFAULT\s+(.+)/) {
my $newname = $1;
my $oldname = column_default($schema, $table, $column);
next if $newname eq $oldname;
upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column SET DEFAULT $newname");
clog("Changed DEFAULT on $schema.$table.$column to $newname");
$changes++;
}
elsif ($change =~ /BOOL2SMALLINT(\d)/) {
my $defval = $1;
my $oldtype = column_type($schema, $table, $column);
next if $oldtype eq 'smallint';
upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column DROP DEFAULT");
upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column TYPE smallint "
. "USING CASE WHEN $column IS NULL OR $column IS FALSE THEN 0 ELSE $defval END");
upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column SET DEFAULT 0");
clog("Changed type of $schema.$table.$column to smallint");
$changes++;
}
else {
die qq{Do not know how to handle altered column spec of "$change"};
}
}
## Change any column defaults
## Add new columns as needed from the schema
for my $row (@collist) {
my ($schema,$table,$column,$definition,$default) = @$row;
next if ! column_exists($schema, $table, $column) or ! defined $default;
my $olddefault = column_default($schema, $table, $column);
$olddefault =~ s/::text//;
$olddefault =~ s/::regclass//;
$olddefault =~ s/'00:00:00'::interval/'0 seconds'::interval/;
next if $olddefault eq $default;
upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column SET DEFAULT $default");
clog "Set new default for $schema.$table.$column: $default";
$changes++;
}
## Drop any old columns
for my $row (@old_columns) {
my ($schema,$table,$column) = @$row;
next if !column_exists($schema, $table, $column);
upgrade_and_log("ALTER TABLE $schema.$table DROP COLUMN $column");
clog "Dropped column: $schema.$table.$column";
$changes++;
}
## Drop any old indexes
for my $row (@old_indexes) {
my ($schema,$table,$name) = @$row;
next if !relation_exists($schema, $name);
upgrade_and_log("DROP INDEX $name");
clog "Dropped index $name";
$changes++;
}
## Drop any old functions
for my $row (@old_functions) {
my ($name, $largs) = @$row;
next if ! function_exists('bucardo', $name, $largs);
clog "Dropped function $name($largs)";
upgrade_and_log(qq{DROP FUNCTION bucardo."$name"($largs)});
$changes++;
}
## Drop any old config items
for my $name (@old_configs) {
next if ! config_exists($name);
clog "Removed old bucardo_config name: $name";
upgrade_and_log(qq{DELETE FROM bucardo.bucardo_config WHERE name = '$name'});
$changes++;
}
## Rename configs.
for my $names (@renamed_configs) {
next if config_exists($names->[1]);
clog "Renamed bucardo_config $names->[0] to $names->[1]";
upgrade_and_log(qq{
UPDATE bucardo.bucardo_config
SET name = '$names->[1]'
WHERE name = '$names->[0]'
});
$changes++;
}
## Special case config renaming
if (config_exists('bucardo_current_version')) {
## was version and current_version; became initial_version and version
clog('Renaming bucardo_current_version to bucardo_version, and bucardo_version to bucardo_initial_version');
upgrade_and_log(q{UPDATE bucardo.bucardo_config SET name = 'bucardo_initial_version' WHERE name = 'bucardo_version'});
upgrade_and_log(q{UPDATE bucardo.bucardo_config SET name = 'bucardo_version' WHERE name = 'bucardo_current_version'});
}
## Check for any new config items
$SQL = 'SELECT setting FROM bucardo.bucardo_config WHERE lower(name) = ?';
my $cfgsth = $dbh->prepare($SQL);
$SQL = 'INSERT INTO bucardo.bucardo_config(name,setting,about) VALUES (?,?,?)';
my $newcfg = $dbh->prepare($SQL);
my %config;
my $inside = 0;
seek $fh, 0, 0;
while (<$fh>) {
chomp;
if (!$inside) {
if (/^WITH DELIMITER/) {
$inside = 1;
}
next;
}
if (/^\\/) {
$inside = 0;
next;
}
## Scoop
my ($name,$setting,$about) = split /\|/ => $_;
$config{$name} = [$setting,$about];
$count = $cfgsth->execute($name);
$cfgsth->finish();
if ($count eq '0E0') {
clog "Added new bucardo_config name: $name";
$changes++;
$newcfg->execute($name,$setting,$about);
}
}
close $fh or die qq{Could not close file "$file": $!\n};
## Apply any specific row changes
for my $row (@row_values) {
my ($table,$column,$where,$force,$value) = @$row;
my $val = column_value('bucardo',$table,$column,$where);
if (!defined $val) {
die "Failed to find $table.$column where $where!\n";
}
next if $val eq $value;
$SQL = sprintf "UPDATE bucardo.$table SET $column=%s WHERE $where",
$dbh->quote($value);
upgrade_and_log($SQL);
clog "New value set for bucardo.$table.$column WHERE $where";
$changes++;
}
$SQL = 'SELECT pg_catalog.md5(?)';
my $md5sth = $dbh->prepare($SQL);
for my $row (@flist) {
my ($name,$arg,$body) = @$row;
next if $name =~ /plperlu_test/;
my $oldbody = function_exists('bucardo',$name,$arg);
if (!$oldbody) {
upgrade_and_log($body,"CREATE FUNCTION $name($arg)");
clog "Added function $name($arg)";
$changes++;
next;
}
my $realbody = $body;
$realbody =~ s/.*?\$bc\$(.+)\$bc\$;/$1/sm;
$md5sth->execute($realbody);
my $newbody = $md5sth->fetchall_arrayref()->[0][0];
next if $oldbody eq $newbody;
$body =~ s/^CREATE FUNCTION/CREATE OR REPLACE FUNCTION/;
(my $short = $body) =~ s/^(.+?)\n.*/$1/s;
$dbh->do('SAVEPOINT bucardo_upgrade');
eval { upgrade_and_log($body,$short); };
if ($@) {
$dbh->do('ROLLBACK TO bucardo_upgrade');
(my $dropbody = $short) =~ s/CREATE OR REPLACE/DROP/;
$dropbody .= ' CASCADE';
upgrade_and_log($dropbody);
upgrade_and_log($body,$short);
}
else {
$dbh->do('RELEASE bucardo_upgrade');
}
clog "Updated function: $name($arg)";
$changes++;
}
## Check for any added triggers
for my $row (@tlist) {
my ($name,$body) = @$row;
next if trigger_exists($name);
upgrade_and_log($body);
clog "Created trigger $name";
$changes++;
}
## Check for any added indexes
for my $row (@ilist) {
my ($uniq,$name,$body) = @$row;
next if relation_exists('bucardo',$name);
upgrade_and_log($body);
clog "Created index $name";
$changes++;
}
## Check for any added constraints
for my $row (@clist) {
my ($tcname,$cname,$cdef,$body) = @$row;
if (! constraint_exists('bucardo', $tcname, $cname)) {
upgrade_and_log($body);
clog "Created constraint $cname on $tcname";
$changes++;
next;
}
## Clean up the constraint to make it match what comes back from the database:
$cdef =~ s/','/', '/g;
my $condef = constraint_definition($cname);
$condef =~ s{\\}{\\\\}g;
if ($condef ne $cdef) {
upgrade_and_log("ALTER TABLE $tcname DROP CONSTRAINT $cname");
upgrade_and_log("ALTER TABLE $tcname ADD CONSTRAINT $cname $cdef");
clog "Altered constraint $cname on $tcname";
clog "OLD: $condef\nNEW: $cdef\n";
$changes++;
}
}
## Check that any bare constraints (e.g. foreign keys) are unchanged
for my $row (@clist2) {
my ($tcname,$cname,$cdef) = @$row;
my $condef = constraint_definition($cname);
next if ! $condef or $condef eq $cdef;
if ($condef and $condef ne $cdef) {
upgrade_and_log("ALTER TABLE $tcname DROP CONSTRAINT $cname");
}
upgrade_and_log("ALTER TABLE $tcname ADD CONSTRAINT $cname $cdef");
my $action = $condef ? 'Altered' : 'Added';
clog "$action constraint $cname on $tcname";
$changes++;
}
## Check that object comments exist and match
for my $row (@comlist) {
my ($type,$schema,$relation,$comment,$full) = @$row;
my $current_comment =
$type eq 'table' ? table_comment($schema,$relation)
: $type eq 'domain' ? domain_comment($schema,$relation)
: 'Unkonwn type';
if ($current_comment ne $comment) {
upgrade_and_log($full);
clog (length $current_comment
? "Changed comment on $type $schema.$relation"
: "Added comment for $type $schema.$relation");
$changes++;
}
}
## The freezer.q_staging table is no longer needed, but we must empty it before dropping
if (relation_exists('freezer','q_staging')) {
upgrade_and_log('INSERT INTO freezer.master_q SELECT * FROM freezer.q_staging');
upgrade_and_log('DROP TABLE freezer.q_staging');
clog 'Dropped deprecated table freezer.q_staging';
$changes++;
}
## Make sure bucardo_config has the new schema version
$count = $cfgsth->execute('bucardo_version');
if ($count eq '0E0') {
$cfgsth->finish();
warn "Weird: could not find bucardo_version in the bucardo_config table!\n";
}
else {
my $curval = $cfgsth->fetchall_arrayref()->[0][0];
if ($curval ne $schema_version) {
$SQL = 'UPDATE bucardo.bucardo_config SET setting = ? WHERE name = ?';
my $updatecfg = $dbh->prepare($SQL);
$updatecfg->execute($schema_version, 'bucardo_version');
clog "Set bucardo_config.bucardo_version to $schema_version";
$changes++;
}
}
## Run the magic updater
$SQL = 'SELECT bucardo.magic_update()';
$sth = $dbh->prepare($SQL);
$sth->execute();
my $message = $sth->fetchall_arrayref()->[0][0];
if (length $message) {
clog $message;
$changes++;
}
if ($changes) {
printf "Okay to commit $changes %s? ", $changes==1 ? 'change' : 'changes';
exit if !~ /Y/i;
$dbh->commit();
print "Changes have been commited\n";
}
else {
print "No schema changes were needed\n";
exit 1;
}
print "Don't forget to run '$progname validate all' as well: see the UPGRADE file for details\n";
exit 0;
} ## end of upgrade
sub upgrade_and_log {
## Put an entry in the bucardo.upgrade_log table
## Arguments: two
## 1. Type of action
## 2. Optional message
## Returns: undef
my $action = shift;
my $short = shift || $action;
eval {
$dbh->do($action);
};
if ($@) {
my $line = (caller)[2];
die "From line $line, action $action\n$@\n";
}
$SQL = 'INSERT INTO bucardo.upgrade_log(action,version,summary) VALUES (?,?,?)';
eval {
$sth = $dbh->prepare($SQL);
$sth->execute($action,$VERSION,$short);
};
if ($@) {
my $line = (caller)[2];
die "From line $line, insert to upgrade_log failed\n$@\n";
}
return;
} ## end of upgrade_and_log
sub usage_exit {
## Grab the help string for a specific item
## Arguments: one
## 1. The thing we want help on
## Returns: nothing
my $name = shift or die;
my $exitval = defined $_[0] ? shift : 1;
if ($name =~ m{/!}) {
# Bug in Pod::Usage prevents these from working properly. Force it
# to use Pod::PlainText.
# https://rt.perl.org/rt3//Public/Bug/Display.html?id=115534
require Pod::Usage;
require Pod::PlainText;
unshift @Pod::Usage::ISA => 'Pod::PlainText';
}
_pod2usage(
'-sections' => "COMMAND DETAILS/$name",
'-exitval' => $exitval,
);
return;
} ## end of usage_exit
sub connect_database {
## Connect to a datbase and return a dbh
## Arguments: one
## 1. Hashref of connection arguments (optional)
## Returns: database handle
my $dbh2;
my $opt = shift || {};
## If given just a name, transform to a hash
if (! ref $opt) {
$opt = { name => $opt };
}
if (! exists $DB->{$opt->{name}}) {
die qq{Unknown database "$opt->{name}": try bucardo list dbs\n};
}
if (exists $opt->{name}) {
$SQL = qq{SELECT bucardo.db_getconn('$opt->{name}')};
my $conn = $dbh->selectall_arrayref($SQL)->[0][0];
my ($type,$dsn,$user,$pass) = split /\n/ => $conn;
if ($type ne 'postgres') {
die "Cannot return a handle for database type $type\n";
}
eval {
$dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
};
if ($@) {
## The bucardo user may not exist yet.
if ($user eq 'bucardo' and $@ =~ /FATAL/ and $@ =~ /bucardo/) {
$user = 'postgres';
$dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
$dbh2->do('CREATE USER bucardo SUPERUSER');
$dbh2->commit();
$user = 'bucardo';
$dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
}
else {
die $@;
}
}
}
return $dbh2;
} ## end of connect_database
sub config {
## View or change a value inside the bucardo_config table
## Arguments: none, reads nouns
## Returns: never, exits
my $setusage = "Usage: $progname set setting=value [setting=value ...]\n";
## Allow for old syntax
if ($verb eq 'config') {
## Plain old "config" means the same as "show all"
if (!@nouns) {
@nouns = ('show','all');
}
$verb = shift @nouns;
}
if (!@nouns) {
$verb eq 'set' and die $setusage;
die "Usage: $progname show [settting2 ...]\n";
}
$SQL = 'SELECT * FROM bucardo.bucardo_config';
$sth = $dbh->prepare($SQL);
$sth->execute();
my $config = $sth->fetchall_hashref('name');
if ($verb eq 'show') {
my $all = $nouns[0] =~ /\ball\b/i ? 1 : 0;
my $maxsize = 3;
for my $s (keys %$config) {
next if ! $all and ! grep { $s =~ /$_/i } @nouns;
$maxsize = length $s if length $s > $maxsize;
}
for my $s (sort keys %$config) {
next if ! $all and ! grep { $s =~ /$_/i } @nouns;
printf "%-*s = %s\n", $maxsize, $s, $config->{$s}{setting};
}
exit 1;
}
$SQL = 'UPDATE bucardo.bucardo_config SET setting = ? WHERE name = ?';
$sth = $dbh->prepare($SQL);
for my $noun (@nouns) {
$noun =~ /(\w+)=(.+)/ or die $setusage;
my ($setting,$val) = (lc $1,$2);
if (! exists $config->{$setting}) {
die qq{Unknown setting "$setting"\n};
}
## Sanity checks
if ($setting eq 'log_level') {
if ($val !~ /^(?:terse|normal|verbose|debug)$/oi) {
die "Invalid log_level, must be terse, normal, verbose, or debug\n";
}
}
if ($setting eq 'default_standard_conflict' || $setting eq 'default_conflict_strategy') {
if ($val !~ /^(?:source|target|skip|random|latest|none)$/oi) {
## FIXME
#die "Invalid default_standard_conflict, must be none, source, target, skip, random, or latest\n";
}
if ($val =~ /none/i) {
$val = '';
}
$setting = 'default_conflict_strategy';
}
$sth->execute($val,$setting);
$QUIET or print qq{Set "$setting" to "$val"\n};
}
$dbh->commit();
exit 0;
} ## end of config
sub message {
## Add a message to the Bucardo logs, via the bucardo_log_message table
## Note: If no MCP processes are listening, the message will hang out until an MCP processes it
## Arguments: none (reads in nouns)
## Returns: never, exits
my $doc_section = 'message';
usage_exit($doc_section) unless length $nouns;
$SQL = 'INSERT INTO bucardo.bucardo_log_message(msg) VALUES (?)';
$sth = $dbh->prepare($SQL);
$sth->execute($nouns);
$dbh->commit();
$VERBOSE and print "Added message\n";
exit 0;
} ## end of message
sub db_get_notices {
## Gather up and return a list of asynchronous notices received since the last check
## Arguments: one
## 1. Database handle
## Returns: arrayref of notices, each an arrayref of name and pid
## If using 9.0 or greater, the payload becomes the name
my ($ldbh) = @_;
my ($n, @notices);
while ($n = $ldbh->func('pg_notifies')) {
my ($name, $pid, $payload) = @$n;
if ($ldbh->{pg_server_version} >= 9999990000) {
next if $name ne 'bucardo';
$name = $payload; ## presto!
}
push @notices => [$name, $pid];
}
return \@notices;
} ## end of db_get_notices
sub install {
## Install Bucardo into a database
## Arguments: none
## Returns: never, exits
if (! $bcargs->{batch}) {
print "This will install the bucardo database into an existing Postgres cluster.\n";
print "Postgres must have been compiled with Perl support,\n";
print "and you must connect as a superuser\n\n";
}
## Setup our default arguments for the installation choices
my $host = $bcargs->{dbhost} || $ENV{PGHOST} || '';
my $port = $bcargs->{dbport} || $ENV{PGPORT} || 5432;
my $user = $ENV{DBUSER} || 'postgres';
my $dbname = $bcargs->{dbname} || $ENV{DBNAME} || 'postgres';
## Make sure the bucardo.schema file is available, and extract some config items
my ($fh, $schema_file) = find_bucardo_schema();
my %confvar = (piddir => '');
while (<$fh>) {
for my $string (keys %confvar) {
if (/^$string\|(.+?)\|/) {
$confvar{$string} = $1;
}
}
}
close $fh or warn qq{Could not close "$schema_file": $!\n};
## Make sure each item has a default value
for my $key (keys %confvar) {
if (!$confvar{$key}) {
warn "Could not find default configuration for $key!\n";
}
}
## If the PID directory was not provided on the command line,
## use the value from the bucardo.schema file
my $piddir = $bcargs->{piddir} || $confvar{piddir};
## Keep looping until they are happy with the settings
GOOEY:
{
## We only don't print this in quiet and batch mode
if (! $QUIET or ! $bcargs->{batch}) {
print "Current connection settings:\n";
print "1. Host: $host\n";
print "2. Port: $port\n";
print "3. User: $user\n";
print "4. Database: $dbname\n";
print "5. PID directory: $piddir\n";
}
## If in batch mode, we accept everything right away and move on
last GOOEY if $bcargs->{batch};
print 'Enter a number to change it, P to proceed, or Q to quit: ';
my $ans = <>;
print "\n";
## If the answer starts with a number, try and apply it
## Can also provide the value right away
if ($ans =~ /^\s*(\d+)(.*)/) {
my ($num,$text) = (int $1,$2);
$text =~ s/^\s*(\S+)\s*$/$1/;
my $new = length $text ? $text : '';
## Host: allow anything
## Change empty string to '';
if (1 == $num) {
if (!length $new) {
print 'Change the host to: ';
$new = <>;
print "\n";
chomp $new;
}
$host = length $new ? $new : '';
print "Changed host to: $host\n";
}
## Port: only allow numbers
elsif (2 == $num) {
if (!length $new) {
print 'Change the port to: ';
$new = <>;
print "\n";
chomp $new;
}
if ($new !~ /^\d+$/) {
print "-->Sorry, but the port must be a number\n\n";
redo GOOEY;
}
$port = $new;
print "Changed port to: $port\n";
}
## User: allow anything except an empty string
elsif (3 == $num) {
if (!length $new) {
print 'Change the user to: ';
$new = <>;
print "\n";
chomp $new;
}
if (! length $new) {
print "-->Sorry, you must specify a user\n\n";
redo GOOEY;
}
$user = $new;
print "Changed user to: $user\n";
}
## Database: allow anything except an empty string
elsif (4 == $num) {
if (!length $new) {
print 'Change the database name to: ';
$new = <>;
print "\n";
chomp $new;
}
if (! length $new) {
print "-->Sorry, you must specify a database name\n\n";
redo GOOEY;
}
$dbname = $new;
print "Changed database name to: $dbname\n";
}
## PID directory: allow anything, as long as it starts with a slash
elsif (5 == $num) {
if (!length $new) {
print 'Change the PID directory to: ';
$new = <>;
print "\n";
chomp $new;
}
if (! length $new) {
print "-->Sorry, you must specify a directory\n\n";
redo GOOEY;
}
if ($new !~ m{^/}) {
print "-->Sorry, the PID directory must be absolute (start with a slash)\n";
redo GOOEY;
}
if (! -d $new) {
print "-->Sorry, that is not a valid directory\n";
redo GOOEY;
}
$piddir = $new;
print "Changed PID dir to: $piddir\n";
}
}
elsif ($ans =~ /^\s*Q/i) {
die "Goodbye!\n";
}
elsif ($ans =~ /^\s*P/i) {
## Check on the PID directory before going any further
## This is the only item that can be easily checked here
if (! -d $piddir) {
print "-->Sorry, that is not a valid PID directory\n";
redo GOOEY;
}
last GOOEY;
}
else {
print "-->Please enter Q to quit, P to proceed, or enter a number to change a setting\n";
}
redo GOOEY;
}
## Try to connect
my $PSQL = sprintf '%s -p %d -U %s -d %s',
$ENV{PGBINDIR} ? "$ENV{PGBINDIR}/psql" : 'psql',
$port, $user, $dbname;
$host !~ /&1};
## Dump any problems verbatim to stderr
my $delayed_warning;
if ($res =~ /FATAL|ERROR/ or $res =~ /psql:/) {
$delayed_warning = $res;
}
## Check for some common errors
if ($res =~ /role "(.+)" does not exist/) {
my $baduser = $1;
if ($baduser eq 'postgres' and exists $ENV{USER} and $ENV{USER} =~ /^[\w-]+$/) {
$user = $ENV{USER};
if (!$QUIET and !$bcargs->{batch}) {
print "Failed to connect as user 'postgres', will try '$user'\n";
}
}
else {
print "-->Sorry, please try using a different user\n\n";
exit 1 if $bcargs->{batch};
}
goto GOOEY;
}
## Check for some common errors
if ($res =~ /database "(.+)" does not exist/) {
my $baddb = $1;
if ($baddb ne 'postgres') {
if (!$QUIET and !$bcargs->{batch}) {
print "Failed to connect to database '$dbname', will try 'postgres'\n";
}
$dbname = 'postgres';
goto GOOEY;
}
}
if ($res !~ /(\d+)\.(\d+)(\S+)/) {
print "-->Sorry, unable to connect to the database\n\n";
warn $delayed_warning;
exit 1 if $bcargs->{batch};
goto GOOEY;
}
## At this point, we assume a good connection
## Assign the version variables
my ($maj,$min,$rev) = ($1,$2,$3);
## We need to be able to handle things such as 9.2devel
$rev =~ s/^\.//;
$rev =~ s/(\d+)\.\d+/$1/;
$QUIET or print "Postgres version is: $maj.$min\n";
## Bare minimum for the install is 8.1
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";
}
## Determine if we need to create the bucardo user
$COM = qq{$PSQL -c "SELECT 1 FROM pg_user WHERE usename = 'bucardo'"};
$res = qx{$COM 2>&1};
## If no number 1 seen, no bucardo user, so create it
if ($res !~ /1/) {
$QUIET or print "Creating superuser 'bucardo'\n";
## Generate a new random password
my $pass = generate_password();
$SQL = qq{CREATE USER bucardo SUPERUSER PASSWORD '$pass'};
$COM = qq{$PSQL -c "$SQL"};
$res = qx{$COM 2>&1};
## Put the new password into the .pgpass file
my $passfile = "$ENV{HOME}/.pgpass";
my $pfh;
if (open my $pfh, '>>', $passfile) {
printf {$pfh} "%s:%s:%s:%s:%s\n",
$host =~ /^\w/ ? $host : '*',
$port =~ /^\d/ ? $port : '*',
'*',
'bucardo',
$pass;
close $pfh or warn qq{Could not close file "$passfile": $!\n};
chmod 0600, $passfile;
}
else {
print qq{Could not append password information to file "$passfile"\n};
print qq{Password for user bucardo is: $pass\n};
print qq{You probably want to change it or put into a .pgpass file\n};
}
}
## Now we apply the bucardo.schema to the new database
$COM = "$PSQL -AX -qt -f $schema_file 2>&1";
print "Attempting to create and populate the bucardo database and schema\n"
if ! $bcargs->{batch};
$res= qx{$COM};
chomp $res;
## Detect case where bucardo is already there
## This probably needs to be i18n safe
if ($res =~ /relation .* already exists/) {
warn "\nINSTALLATION FAILED! Looks like you already have Bucardo installed there.\n";
warn "Try running 'bucardo upgrade' instead.\n";
warn "If you are trying to completely reinstall Bucardo,\n";
warn "drop the bucardo database, and the bucardo schema from all databases.\n\n";
exit 1;
}
if ($res =~ /"plperlu".*CREATE LANGUAGE/s) {
warn "\nINSTALLATION FAILED! ($res)\n\n";
warn "The Pl/PerlU language needs to be available\n";
warn "This is usually available as a separate package\n";
warn "For example, you might try: yum install postgresql-plperl\n";
warn "If compiling from source, add the --with-perl option to your ./configure command\n\n";
exit 1;
}
## This can actually happen for many reasons: lack of this message
## simply means something went wrong somewhere
if ($res !~ m{Pl/PerlU was successfully installed}) {
warn "\nINSTALLATION FAILED! ($res)\n\n";
exit 1;
}
## We made it! All downhill from here
print "Database creation is complete\n\n" if ! $bcargs->{batch};
## Whether or not we really need to, change some bucardo_config items:
my $BDSN = 'dbi:Pg:dbname=bucardo';
$host and $host ne '' and $BDSN .= ";host=$host";
$port and $BDSN .= ";port=$port";
$dbh = DBI->connect($BDSN, 'bucardo', '', {AutoCommit=>0,RaiseError=>1,PrintError=>0});
$dbh->do('SET search_path = bucardo');
$SQL = 'UPDATE bucardo.bucardo_config SET setting = ? WHERE name = ?';
$sth = $dbh->prepare($SQL);
$confvar{piddir} = $piddir;
for my $key (sort keys %confvar) {
$count = $sth->execute($confvar{$key}, $key);
if ($count != 1) {
warn "!! Failed to set $key to $confvar{$key}\n";
}
else {
print qq{Updated configuration setting "$key"\n} if ! $bcargs->{batch};
}
}
$dbh->commit();
$QUIET or print "Installation is now complete.\n";
## A little less verbose if in batch mode
if (! $bcargs->{batch}) {
print "If you see errors or need help, please email bucardo-general\@bucardo.org\n\n";
print "You may want to check over the configuration variables next, by running:\n";
print "$progname show all\n";
print "Change any setting by using: $progname set foo=bar\n\n";
}
exit 0;
} ## end of install
##
## Internal helper subs
##
sub debug {
## Print a debug line if needed
## Arguments: one or two
## 1. String to be printed
## 2. Required debug level: defaults to 1
## Returns: undef
return if ! $DEBUG;
my $string = shift;
my $level = shift || 1;
return if $DEBUG < $level;
chomp $string;
print " |DEBUG| $string\n";
return;
} ## end of debug
sub standardize_name {
## Return canonical version of certain names
## Normalizes abbreviations, misspelling, plurals, case, etc.
## Arguments: one
## 1. Name
## Returns: canonical name
my $name = shift;
return 'customcode' if $name =~ /^c?code/i or $name =~ /^custom_?code/i;
return 'customname' if $name =~ /^cname/i or $name =~ /^custom_?name/i;
return 'customcols' if $name =~ /^ccol/i or $name =~ /^custom_?col/i;
return 'dbgroup' if $name =~ /^dbg/i or $name =~ /^d.+group/i;
return 'database' if $name =~ /^db/i or $name =~ /^database/i;
return 'herd' if $name =~ /^(?:relgr|herd)/i;
return 'sync' if $name =~ /^s[yi]n[ck]/i;
return 'table' if $name =~ /^tab/i or $name =~ /^tbale/i;
return 'sequence' if $name =~ /^seq/i;
return 'all' if $name =~ /^all$/i;
return 'config' if $name =~ /^config/i;
return 'clone' if $name =~ /^clon/i;
return $name;
} ## end of standardize_name
sub generate_password {
## Generate a random 42 character password
## Arguments: none
## Returns: new password
my @chars = split // => q!ABCDEFGHJKMNPQRSTWXYZabcdefghjkmnpqrstwxyz23456789@#%^&(){}[];./!;
my $pass = join '' => @chars[map{ rand @chars }(1..42)];
return $pass;
} ## end of generate_password
sub process_simple_args {
## Process args to an inner function in the style of a=b
## Arguments: one
## 1. Custom hashref
## Returns: db column hashref, columns string, placeholders string,
## values string, and 'extra' hashref
my $arg = shift;
my $validcols = $arg->{cols} or die 'Need a list of valid cols!';
my $list = $arg->{list} or die 'Need a list of arguments!';
my $doc_section = $arg->{doc_section} or die 'Need a doc_section!';
my %item;
my %dbcol;
my %extra;
my %othername;
## Transform array of x=y into a hashref
my $xyargs = process_args(join ' ' => map { s/[=:]\s*(\w+ .*)/="$1"/; $_; } @$list);
## Parse the validcols string, and setup any non-null defaults
for my $row (split /\n/ => $validcols) {
next if $row !~ /\w/ or $row =~ /^#/;
$row =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(.+)/ or die "Invalid valid cols ($row)";
my ($args,$dbcol,$flag,$default) = ([split /\|/ => $1],$2,$3,$4);
my $alias = @{$args}[-1];
for my $name (@$args) {
$item{$name} = [$dbcol,$flag,$default];
$othername{$name} = $alias;
}
## Process environment variable default
if ($default =~ s/^ENV://) {
for my $env (split /\|/ => $default) {
if ($ENV{$env}) {
## Skip if it starts with PG and this is not postgres
next if $env =~ /^PG/ and exists $xyargs->{type} and $xyargs->{type} ne 'postgres';
$dbcol{$dbcol} = $ENV{$env};
last;
}
}
}
elsif ($default ne 'null' and $default ne 'skip') {
$dbcol{$dbcol} = $default;
}
}
for my $arg (sort keys %$xyargs) {
next if $arg eq 'extraargs';
if (! exists $item{$arg}) {
warn "Unknown option '$arg'\n";
usage_exit($doc_section);
}
(my $val = $xyargs->{$arg}) =~ s/^\s*(\S+)\s*$/$1/;
if ($item{$arg}[2] eq 'skip') {
$extra{$othername{$arg}} = $val;
next;
}
my ($dbcol,$flag,$default) = @{$item{$arg}};
if ($flag eq '0') {
## noop
}
elsif ($flag eq 'TF') {
$val =~ s/^\s*t(?:rue)*\s*$/1/i;
$val =~ s/^\s*f(?:alse)*\s*$/0/i;
$val =~ s/^\s*on*\s*$/1/i;
$val =~ s/^\s*off*\s*$/0/i;
$val =~ s/^\s*yes*\s*$/1/i;
$val =~ s/^\s*no*\s*$/0/i;
if ($val !~ /^[01]$/) {
die "Invalid value for '$arg': must be true or false\n";
}
}
elsif ($flag eq 'numeric') {
if ($val !~ /^\d+$/) {
die "Invalid value for '$arg': must be numeric\n";
}
}
elsif ($flag =~ /^=(.+)/) {
my $ok = 0;
for my $okval (split /\|/ => $1) {
if ($okval =~ /~/) { ## aliases - force to the first one
my @alias = split /~/ => $okval;
for my $al (@alias) {
if ($val eq $al) {
$ok = 1;
last;
}
}
if ($ok) {
$val = $alias[0];
last;
}
}
elsif (lc $val eq lc $okval) {
$ok = 1;
last;
}
}
if (!$ok) {
(my $arglist = $flag) =~ s/\|/ or /g;
$arglist =~ s/^=//;
$arglist =~ s/~\w+//g;
die "Invalid value for '$arg': must be one of $arglist\n";
}
}
elsif ($flag eq 'interval') {
## Nothing for now
}
else {
die "Unknown flag '$flag' for $arg";
}
## Value has survived our minimal checking. Store it and clobber any default
$dbcol{$dbcol} = $val;
}
## Apply any magic
if (exists $arg->{morph}) {
for my $mline (@{$arg->{morph}}) {
if (exists $mline->{field}) {
next unless exists $dbcol{$mline->{field}};
if (exists $mline->{new_defaults}) {
for my $change (split /\s+/ => $mline->{new_defaults}) {
my ($f,$v) = split /\|/ => $change;
next if exists $dbcol{$f};
$dbcol{$f} = $v;
}
}
if (exists $mline->{dash_to_white}) {
$dbcol{$mline->{field}} =~ s/_/ /g;
}
}
else {
die "Do not know how to handle that morph!\n";
}
}
}
## Automatic morphing magic
if (exists $item{status} and ! exists $dbcol{status}) {
for my $stat (qw/ active inactive /) {
if (grep { $_ eq $stat } @{ $xyargs->{extraargs} }) {
$dbcol{status} = $stat;
}
}
}
## Build the lists of columns and placeholders for the SQL statement
my ($cols,$phs,$vals) = ('','',{});
for my $col (sort keys %dbcol) {
$cols .= "$col,";
$phs .= '?,';
$vals->{$col} = $dbcol{$col};
}
$cols =~ s/,$//;
$phs =~ s/,$//;
return \%dbcol, $cols, $phs, $vals, \%extra;
} ## end of process_simple_args
sub check_recurse {
## Call a sub recursively depending on first argument
## Arguments: three or more
## 1. Type of thing (e.g. database)
## 2. Name of the thing
## 3. Any additional actions
## Returns: 0 or 1
my ($thing, $name, @actions) = @_;
my $caller = (caller(1))[3];
## If the name is 'all', recursively call on all objects of this type
if ($name =~ /all/i) {
for my $item (sort keys %$thing) {
&$caller($item, @actions);
}
return 0;
}
## If we have a wildcard, recursively call all matching databases
if ($name =~ s/[*%]/\.*/g) {
my @list = grep { $_ =~ /^$name$/ } keys %$thing;
if (! @list) {
die qq{No matching items found\n};
}
for my $item (sort @list) {
&$caller($item, @actions);
}
return 0;
}
return 1;
} ## end of check_recurse
sub extract_name_and_role {
## Given a group or db name with optional role information, return both
## Also returns optional list of other items, e.g. ABC:target:pri=2:gangs=2
## Arguments: one
## 1. Group or database name: 'foo' or 'foo:master'
## Returns: name, role name, and hashref of 'extra' info
my $name = shift or die;
## Role always defaults to 'target'
my $role = 'target';
## Check for a role attached to the group name
if ($name =~ s/:([^:]+)//) {
$role = lc $1;
}
## Look for any additional items
my %extra;
while ($name =~ s/:([^:]+)//) {
my $extra = $1;
if ($extra !~ /(\w+)=([\w\d]+)/) {
die qq{Invalid value "$extra"\n};
}
my ($lname,$val) = ($1,$2);
if ($lname =~ /make?delta/i) {
$extra{'makedelta'} = make_boolean($val);
}
elsif ($lname =~ /gang/i) {
$extra{'gang'} = $val;
}
elsif ($lname =~ /pri/i) {
$extra{'priority'} = $val;
}
else {
die qq{Unknown value "$lname": must be priority, gang, or makedelta\n};
}
}
## Valid group name?
if ($name !~ /^[\w\d]+$/) {
die "Invalid name: $name\n";
}
## Valid role name?
if ($role !~ /^(?:master|target|t|slave|rep|replica|source|s|fullcopy)$/) {
die "Invalid database role: $role\n";
}
## Standardize the names
$role = 'source' if $role =~ /^(?:master|s)$/;
$role = 'target' if $role =~ /^(?:slave|rep|replica|tar|t)$/;
return $name, $role, \%extra;
} ## end of extract_name_and_role
sub load_bucardo_info {
## Load of all information from the database into global hashes
## Arguments: one
## 1. Boolean: if true, force run even if we've run once already
## Returns: undef
my $force = shift || 0;
return if exists $global{db} and ! $force;
## Grab all database information
$SQL = 'SELECT *, EXTRACT(epoch FROM cdate) AS epoch FROM bucardo.db';
$sth = $dbh->prepare($SQL);
$sth->execute();
my $db = $sth->fetchall_hashref('name');
## Grab all database information
$SQL = 'SELECT * FROM bucardo.dbgroup';
$sth = $dbh->prepare($SQL);
$sth->execute();
my $dbgroup = $sth->fetchall_hashref('name');
## Figure out if each dbgroup is using multiple gangs
my %gang;
## Map databases to their groups
$SQL = 'SELECT * FROM bucardo.dbmap';
$sth = $dbh->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
$db->{$row->{db}}{group}{$row->{dbgroup}} = $row;
## Tally up the roles each database fills
$db->{$row->{db}}{roles}{$row->{role}}++;
## Mark if this db is ever used as a source, for help in adding table
$db->{$row->{db}}{issource}++ if $row->{role} eq 'source';
$dbgroup->{$row->{dbgroup}}{db}{$row->{db}} = $row;
## Figure out how many gangs each group has
$gang{$row->{dbgroup}}{$row->{gang}}++;
}
for my $group (keys %$dbgroup) {
$dbgroup->{$group}{gangs} = keys %{ $gang{$group} };
}
## Grab all goat information
$SQL = 'SELECT * FROM bucardo.goat';
$sth = $dbh->prepare($SQL);
$sth->execute();
my $goat;
$goat->{by_id} = $sth->fetchall_hashref('id');
$goat->{by_table} = {};
for my $key (%{$goat->{by_id}}) {
next if $key !~ /^\d/;
my $tname = $goat->{by_id}{$key}{tablename};
my $name = "$goat->{by_id}{$key}{schemaname}.$tname";
my $dbname = $goat->{by_id}{$key}{db};
## Index by database, so different databases containing matching object
## names can be handled
$goat->{by_db}{$dbname}{$name} = $goat->{by_id}{$key};
## Index by full object name
if (! exists $goat->{by_fullname}{$name}) {
$goat->{by_fullname}{$name} = [ $goat->{by_id}{$key} ];
}
else {
push @{$goat->{by_fullname}{$name}}, $goat->{by_id}{$key};
}
## Also want a table-only version:
$goat->{by_table}{$tname} = [] unless exists $goat->{by_table}{$tname};
push @{$goat->{by_table}{$tname}} => $goat->{by_id}{$key};
}
## Grab all herd information
$SQL = 'SELECT * FROM bucardo.herd';
$sth = $dbh->prepare($SQL);
$sth->execute();
my $herd = $sth->fetchall_hashref('name');
## Grab all herdmap information, stick into previous hashes
$SQL = 'SELECT * FROM bucardo.herdmap ORDER BY priority DESC, goat ASC';
$sth = $dbh->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
my ($g,$h,$p) = @$row{qw/goat herd priority/};
$goat->{by_id}{$g}{herd}{$h} = $p;
$herd->{$h}{goat}{"$goat->{by_id}{$g}{schemaname}.$goat->{by_id}{$g}{tablename}"} = {
id => $g,
priority => $p,
reltype => $goat->{by_id}{$g}{reltype},
schema => $goat->{by_id}{$g}{schemaname},
table => $goat->{by_id}{$g}{tablename},
};
my ($s,$t) = @{$goat->{by_id}{$g}}{qw/schemaname tablename/};
$herd->{$h}{hasgoat}{$s}{$t} = $p;
## Assign each herd to a datbase via its included goats
$herd->{$h}{db} = $goat->{by_id}{$g}{db};
}
## Grab all sync information
$SQL = 'SELECT * FROM bucardo.sync';
$sth = $dbh->prepare($SQL);
$sth->execute();
my $sync;
for my $row (@{$sth->fetchall_arrayref({})}) {
my ($name,$p,$sherd,$dbs) = @$row{qw/name priority herd dbs/};
$sync->{$name} = $row;
## Add in herd information
$sync->{$name}{herd} = $herd->{$sherd};
## Add this sync back to the herd
$herd->{$sherd}{sync}{$name}++;
## Grab the databases used by this sync
$sync->{$name}{dblist} = $dbgroup->{$dbs}{db};
## Map each database back to this sync, along with its type (source/target)
for my $dbname (keys %{ $sync->{$name}{dblist} }) {
$db->{$dbname}{sync}{$name} = $sync->{$name}{dblist}{$dbname};
}
## Note which syncs are used by each goat
for my $row2 (sort keys %{$row->{herd}{goat}}) {
$goat->{by_id}{$row2}{sync}{$name} = 1;
}
}
## Grab all customcode information
$SQL = 'SELECT * FROM bucardo.customcode';
$sth = $dbh->prepare($SQL);
$sth->execute();
my $cc = $sth->fetchall_hashref('name');
$SQL = 'SELECT * FROM bucardo.customcode_map';
$sth = $dbh->prepare($SQL);
$sth->execute();
my %codename;
for my $row (values %$cc) {
$codename{$row->{id}} = $row->{name};
}
for my $row (@{$sth->fetchall_arrayref({})}) {
my $codename = $codename{$row->{code}};
push @{$cc->{$codename}{map}} => $row;
}
## Grab all customname information
$SQL = q{SELECT c.id, c.goat, c.newname,
COALESCE(c.sync, '') AS sync,
COALESCE(c.db, '') AS db,
g.schemaname || '.' || g.tablename AS tname
FROM bucardo.customname c
JOIN goat g ON (g.id = c.goat)
};
$sth = $dbh->prepare($SQL);
$sth->execute();
$CUSTOMNAME = {};
for my $row (@{ $sth->fetchall_arrayref({}) }) {
## We store three versions
## Look things up by the internal customname id: used for 'delete customname'
## Only one entry per id
$CUSTOMNAME->{id}{$row->{id}} = $row;
## Look things up by the goat id: used to check for existing entries
## Can have multiple entries per goat
$CUSTOMNAME->{goat}{$row->{goat}}{$row->{db}}{$row->{sync}} = $row;
## A simple list of all rows: used for 'list customnames'
push @{ $CUSTOMNAME->{list} } => $row;
}
## Grab all customcols information
$SQL = q{SELECT c.id, c.goat, c.clause,
COALESCE(c.sync, '') AS sync,
COALESCE(c.db, '') AS db,
g.schemaname || '.' || g.tablename AS tname
FROM bucardo.customcols c
JOIN goat g ON (g.id = c.goat)
};
$sth = $dbh->prepare($SQL);
$sth->execute();
$CUSTOMCOLS = {};
for my $row (@{ $sth->fetchall_arrayref({}) }) {
## We store three versions: one for quick per-goat lookup,
## one by the assigned id, and one just a big list
push @{ $CUSTOMCOLS->{goat}{$row->{goat}}{$row->{clause}} } => $row;
$CUSTOMCOLS->{id}{$row->{id}} = $row;
push @{ $CUSTOMCOLS->{list} } => $row;
}
$global{cc} = $CUSTOMCODE = $cc;
$global{dbgroup} = $DBGROUP = $dbgroup;
$global{db} = $DB = $db;
$global{goat} = $GOAT = $goat;
$global{herd} = $HERD = $RELGROUP = $herd;
$global{sync} = $SYNC = $sync;
## Separate goat into tables and sequences
for my $id (keys %{$GOAT->{by_id}}) {
## Ids only please
next if $id !~ /^\d+$/;
my $type = $GOAT->{by_id}{$id}{reltype};
if ($type eq 'table') {
$TABLE->{$id} = $GOAT->{by_id}{$id};
}
elsif ($type eq 'sequence') {
$SEQUENCE->{$id} = $GOAT->{by_id}{$id};
}
else {
die "Unknown relation type $type!";
}
}
## Grab all clone information
$SQL = qq{SELECT *,
TO_CHAR(started,'$DATEFORMAT') AS pstarted,
TO_CHAR(ended,'$DATEFORMAT') AS pended
FROM bucardo.clone};
$sth = $dbh->prepare($SQL);
$sth->execute();
$CLONE = {};
for my $row (@{ $sth->fetchall_arrayref({}) }) {
$CLONE->{$row->{id}} = $row;
}
return;
} ## end of load_bucardo_info
sub transform_name {
## Change a given word to a more standard form
## Generally used for database column names, which follow some simple rules
## Arguments: one
## 1. Name to transform
## Returns: transformed name
my $name = shift;
## Complain right away if these are not standard characters
if ($name !~ /^[\w ]+$/) {
die "Invalid name: $name\n";
}
## Change to lowercase
$name = lc $name;
## Change dashes and spaces to underscores
$name =~ s{[- ]}{_}go;
## Compress all underscores
$name =~ s{__+}{_}go;
## Fix common spelling errors
$name =~ s{perpare}{prepare}go;
## Look up standard abbreviations
if (exists $alias{$name}) {
$name = $alias{$name};
}
return $name;
} ## end of transform_name
sub transform_value {
## Change a value to a more standard form
## Used for database column SET actions
## Arguments: one
## 1. Value
## Returns: transformed value
my $value = shift;
## Remove all whitespace on borders
$value =~ s/^\s*(\S+)\s*$/$1/;
## Change booleans to 0/1
$value =~ s/^(?:t|true)$/1/io;
$value =~ s/^(?:f|false)$/0/io;
return $value;
} ## end of transform_value
sub make_boolean {
## Transform some string into a strict boolean value
## Arguments: one
## 1. String to be analyzed
## Returns: the string literals 'true' or 'false' (unquoted)
my $value = shift;
$value = lc $value;
return 'true' if $value =~ /^(?:t|true|1|yes)$/o;
return 'false' if $value =~ /^f|false|0|no$/o;
die "Invalid value: must be 'true' of 'false'\n";
} ## end of make_boolean
sub standardize_rdbms_name {
## Make the database types standard: account for misspellings, case, etc.
## Arguments: one
## 1. Name of a database type
## Returns: modified name
my $name = shift;
$name =~ s/postgres.*/postgres/io;
$name =~ s/pg.*/postgres/io;
$name =~ s/driz?zle.*/drizzle/io;
$name =~ s/mongo.*/mongo/io;
$name =~ s/mysql.*/mysql/io;
$name =~ s/maria.*/mariadb/io;
$name =~ s/oracle.*/oracle/io;
$name =~ s/redis.*/redis/io;
$name =~ s/sqll?ite.*/sqlite/io;
return $name;
} ## end of standardize_rdbms_name
sub find_best_db_for_searching {
## Returns the db from $DB most likely to contain tables to add
## Basically, we use source ones first, then the date added
## Arguments: none
## Returns: database name or undef if no databases defined yet
for my $db (
map { $_->[0] }
sort {
## Source databases are always first
$a->[1] <=> $b->[1]
## First created are first
or $a->[2] <=> $b->[2]
## All else fails, sort by name
or $a->[0] cmp $b->[0] }
map { [
$_,
exists $DB->{$_}{issource} ? 0 : 1,
$DB->{$_}{epoch},
lc $_,
]
}
keys %{ $DB } ) {
return $db;
}
## Probably an error, but let the caller handle it:
return undef;
} ## end of find_best_db_for_searching
##
## Subs to perform common SQL actions
##
sub confirm_commit {
## Perform a database commit unless the user does not want it
## Arguments: none
## Returns: true for commit, false for rollback
## The dryrun option overrides everything else: we never commit
if ($bcargs->{dryrun}) {
$VERBOSE and print "In dryrun mode, so not going to commit database changes\n";
return 0;
}
if ($bcargs->{confirm}) {
print 'Commit the changes? Y/N ';
if ( !~ /Y/i) {
$dbh->rollback();
print "Changes have been rolled back\n";
return 0;
}
else {
$dbh->commit();
print "Changes have been committed\n";
}
}
else {
$dbh->commit();
}
return 1;
} ## end of confirm_commit
sub add_db_to_group {
## Add a database to a group
## Will create the group as needed
## Does not commit
## Arguments: two
## 1. Database name
## 2. Group name (may have :role specifier)
## Returns: group name and role name
my ($db,$fullgroup) = @_;
## Figure out the role. Defaults to target
my ($group,$role) = extract_name_and_role($fullgroup);
if (! exists $DBGROUP->{$group}) {
## Extra argument prevents load_bucardo_info from being called by the sub
create_dbgroup($group, 1);
}
$SQL = 'INSERT INTO bucardo.dbmap(db,dbgroup,role) VALUES (?,?,?)';
$sth = $dbh->prepare($SQL);
eval {
$sth->execute($db,$group,$role);
};
if ($@) {
my $message = qq{Cannot add database "$db" to dbgroup "$group"};
if ($@ =~ /"dbmap_unique"/) {
die qq{$message: already part of the group\n};
}
die qq{$message: $@\n};
}
## Reload our hashes
load_bucardo_info(1);
return $group, $role;
} ## end of add_db_to_group
sub remove_db_from_group {
## Removes a database from a group: deletes from bucardo.dbmap
## Does not commit
## Arguments: two
## 1. Database name
## 2. Group name
## 3. Boolean: if true, prevents the reload
## Returns: undef
my ($db,$group,$noreload) = @_;
$SQL = 'DELETE FROM bucardo.dbmap WHERE db=? AND dbgroup=?';
$sth = $dbh->prepare_cached($SQL);
$sth->execute($db, $group);
## Reload our hashes
$noreload or load_bucardo_info(1);
return;
} ## end of remove_db_from_group
sub change_db_role {
## Changes the role of a database: updates bucardo.dbmap
## Does not commit
## Arguments: four
## 1. New role
## 2. Name of the dbgroup
## 3. Name of the database
## 4. Boolean: if true, prevents the reload
## Returns: undef
my ($role,$group,$db,$noreload) = @_;
$SQL = 'UPDATE bucardo.dbmap SET role=? WHERE dbgroup=? AND db=?';
$sth = $dbh->prepare_cached($SQL);
$sth->execute($role,$group,$db);
## Reload our hashes
$noreload or load_bucardo_info(1);
return;
} ## end of change_db_role
sub update_dbmap {
## Update the values in the bucardo.dbmap table
## Arguments: three
## 1. Name of the database
## 2. Name of the dbgroup
## 3. Hashref of things to change
## Returns: undef
my ($db,$group,$changes) = @_;
## This should not need quoting as they are all [\w\d]
my $list = join ',' => map { "$_=$changes->{$_}" } sort keys %$changes;
$SQL = "UPDATE bucardo.dbmap SET $list WHERE db=? AND dbgroup=?";
$sth = $dbh->prepare($SQL);
$sth->execute($db, $group);
return;
} ## end of update_dbmap
sub create_herd {
## Creates a new entry in the bucardo.herd table
## Caller should have already checked for existence
## Does not commit
## Arguments: two
## 1. Name of the new herd
## 2. Boolean: if true, prevents the reload
## Returns: name of the herd just created
my ($name,$noreload) = @_;
$SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)';
$sth = $dbh->prepare($SQL);
eval {
$sth->execute($name);
};
if ($@) {
print qq{Failed to create relgroup "$name"\n$@\n};
exit 1;
}
## Reload our hashes
$noreload or load_bucardo_info(1);
return $name;
} ## end of create_herd
__END__
=head1 NAME
bucardo - utility script for controlling the Bucardo program
=head1 VERSION
This document describes version 5.4.1 of bucardo
=head1 USAGE
bucardo [] [] [] []
=head1 DESCRIPTION
The bucardo script is the main interaction to a running Bucardo instance. It
can be used to start and stop Bucardo, add new items, kick syncs, and even
install and upgrade Bucardo itself. For more complete documentation, please
view L.
=head1 COMMANDS
Run C<< bucardo help >> for additional details
=over
=item C
Installs the Bucardo configuration database.
=item C
Upgrades the Bucardo configuration database to the latest schema.
=item C<< start [] [] >>
Starts Bucardo.
=item C<< stop [] >>
Stops Bucardo.
=item C<< restart [] [] >>
Stops and starts Bucardo.
=item C<< list [] >>
Lists objects managed by Bucardo.
=item C<< add >>
Adds a new object.
=item C<< update >>
Updates an object.
=item C<< remove [...] >>
Removes one or more objects.
=item C<< kick [] [...] [] >>
Kicks off one or more syncs.
=item C
Sends a message to all CTL and KID processes asking them to reload the Bucardo
configuration.
=item C
Sends a message to all Bucardo processes asking them to reopen any log files
they may have open. Call this after you have rotated the log file(s).
=item C<< show all| [...] >>
Shows the current Bucardo settings.
=item C< [...] >>
Sets one or more configuration setting..
=item C<< ping [] >>
Sends a ping notice to the MCP process to see if it will respond.
=item C<< status [] [...] >>
Shows the brief status of syncs in a tabular format.
=item C<< activate [...] [] >>
Activates one or more named syncs.
=item C<< deactivate [...] [] >>
Deactivates one or more named syncs.
=item C<< message >>
Sends a message to the running Bucardo logs.
=item C<< reload [ [...]] >>
Sends a message to one or more sync processes, instructing them to reload.
=item C<< inspect [...] >>
Inspects one or more objects of a particular type.
=item C<< validate all| [...] >>
Validates one or more syncs.
=item C<< purge all| [
...] >>
Purges the delta and track tables for one or more tables, for one or more
databases.
=item C<< delta [] >>
Show the delta counts for each source target.
=item C<< help [ []] >>
Shows help.
=back
=head1 OPTIONS
-d --db-name NAME Database name.
-U --db-user USER Database user name.
-P --db-pass PASS Database password.
-h --db-host HOST Database server host name.
-p --db-port PORT Database server port number.
--bucardorc FILE Use specified .bucardorc file.
--no-bucardorc Do not use .bucardorc file.
--quiet Incremental quiet.
--verbose Incremental verbose mode.
-? --help Output basic help and exit.
--version Print the version number and exit.
--dryrun Do not perform any actual actions.
--confirm Require direct confirmation before changes.
=head1 COMMAND DETAILS
Most of the commands take parameters. These may be passed after the command
name and, where appropriate, an object name. Parameters take the form of
key/value pairs separated by an equal sign (C<=>). For example:
bucardo add db sea_widgets dbname=widgets host=db.example.com
Here C and are parameters.
Many of the commands also use command-line options, which are specified in the
normal way. For example, the C command could also be written
as:
bucardo add db sea_widgets --dbname widgets --dbhost db.example.com
However, parameters and options are not directly interchangeable in all cases.
See the documentation for individual commands for their supported options.
=head2 install
bucardo install
Installs the Bucardo schema from the file F into an existing Postgres cluster.
The user "bucardo" and database "bucardo" will be created first as needed. This is an
interactive installer, but you can supply the following values from the command line:
=over
=item C<--dbuser>
defaults to postgres
=item C<--dbname>
defaults to postgres
=item C<--dbport>
defaults to 5432
=item C<--pid-dir>
defaults to /var/run/bucardo/
=back
=head2 upgrade
bucardo upgrade
Upgrades an existing Bucardo installation to the current version of the bucardo database
script. Requires that bucardo and the F file be the same version. All
changes should be backwards compatible, but you may need to re-validate existing scripts
to make sure changes get propagated to all databases.
=head2 start
bucardo start "Reason"
Starts Bucardo. Fails if the MCP process is running (determined if its PID file is present).
Otherwise, starts cleanly by first issuing the equivalent of a stop to ask any existing Bucardo
processes to exit, and then starting a new Bucardo MCP process. A short reason and name should
be provided - these are written to the C file (F<./bucardo.restart.reason.txt> by
default) and sent in the email sent when Bucardo has been started up. It is also appended to
the reason log, which has the same name as the the C but ends in F<.log>.
The options for the C command are:
=over
=item C<--sendmail>
Tells Bucardo whether or not to send mail on interesting events: startup,
shutdown, and errors. Default is on.
=item C<--extra-name string>
A short string that will be appended to the version string as output by the
Bucardo process names. Mostly useful for debugging.
=item C<--log-destination destination>
Determines the destination for logging output. The supported values are:
=over
=item C
=item C
=item C
=item C
=item A file system directory.
=back
May be specified more than once, which is useful for, e.g., logging both to a
directory and to syslog. If C<--log-destination> is not specified at all, the
default is to log to files in F.
=item C<--log-separate>
Forces creation of separate log files for each Bucardo process of the form
"log.bucardo.X.Y", where X is the type of process (MCP, CTL, or KID), and Y is
the process ID.
=item C<--log-extension string>
Appends the given string to the end of the default log file name,
F. A dot is added before the name as well, so a log extension of
"rootdb" would produce a log file named F.
=item C<--log-clean>
Forces removal of all old log files before running.
=item C<--debug>
=item C<--no-debug>
Enable or disable debugging output. Disabled by default.
=item C<--exit-on-nosync>
=item C<--no-exit-on-nosync>
On startup, if Bucardo finds no active syncs, it normally will continue to
run, requiring a restart once syncs are added. This is useful for startup
scripts and whatnot.
If, however, you want it to exit when there are no active syncs, pass the
C<--exit-on-nosync> option. You can also be explicit that it should I
exit when there are no syncs by passing C<--no-exit-on-nosync>. This is the
default value.
=back
=head2 stop
bucardo stop "Reason"
Forces Bucardo to quit by creating a stop file which all MCP, CTL, and KID processes should
detect and cause them to exit. Note that active syncs will not exit right away, as they
will not look for the stop file until they have finished their current run. Typically,
you should scan the list of processes after running this program to make sure that all Bucardo
processes have stopped. One should also provide a reason for issuing the stop - usually
this is a short explanation and your name. This is written to the C file
(F<./bucardo.restart.reason.txt> by default) and is also used by Bucardo when it exits and
sends out mail about its death. It is also appended to the reason log, which has the same name
as the the C but ends in F<.log>.
=head2 restart
bucardo restart "Reason"
Stops bucardo, waits for the stop to complete, and then starts it again.
Supports the same options as /start>. Useful for start scripts. For
getting just CTL and KID processes to recognize newly added, updated, or
removed objects, use the C command, instead.
=head2 list
bucardo list
Lists summary information about Bucardo objects. The supported types are:
=over
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=back
The C option will list information about all object types.
The optional C option can be used to filter the list to only those
matching a regular expression.
=head2 add
bucardo add
Adds a new object to Bucardo. The C specifies the type of object to add,
while the C should be the name of the object. The supported types
include:
=over
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=back
=head3 add db
bucardo add db dbname=actual_name port=xxx host=xxx user=xxx
Adds one or more new databases. The C is the name by which the database will be
known to Bucardo, and must be unique. This may vary from the actual database
name, as multiple hosts might have databases with the same name. Multiple databases
can be added by separating the names with commas. Options that differ between the
databases should be separated by a matching commas. Example:
bucardo add db alpha,beta dbname=sales host=aa,bb user=bucardo
This command will attempt an immediate test connection to the added database(s).
The supported named parameters are:
=over
=item C
The actual name of the database. Required unless using a service file.
=item C
The type of the database. Defaults to C. Currently supported values are:
=over
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=back
=item C
The username Bucardo should use when connecting to this database.
=item C
The password Bucardo should use when connecting to this database. It is recommended
that you use a .pgpass file rather than entering the password here.
=item C
The host Bucardo should use when connecting to this database. Defaults to the value of the C<$PGHOSTADDR>
or C<$PGHOST> environment variables, if present.
=item C
The port Bucardo should use when connecting to this database. Defaults to the value of the C<$PGPORT>
environment variable, if present.
=item C
Additional connection parameters, e.g. C.
=item C
The service name Bucardo should use when connecting to this database.
=item C
Initial status of this database. Defaults to "active" but can be set to "inactive".
=item C
Name of the database group this database should belong to.
=item C
Automatically add all tables from this database.
=item C
Automatically add all sequences from this database.
=item C
=item C
Set to 1 or 0 to enable or disable server-side prepares. Defaults to 1.
=item C
Set to 1 or 0 to enable or disable makedelta. Defaults to 0.
=back
Additional parameters:
=over
=item C<--force>
Forces the database to be added without running a connection test.
=back
B As a convenience, if the C value is its default value,
"bucardo", in the event that Bucardo cannot connect to the database, it will
try connecting as "postgres" and create a superuser named "bucardo". This is
to make things easier for folks getting started with Bucardo, but will not
work if it cannot connect as "postgres", or if it the connection failed due to
an authentication failure.
=head3 add dbgroup
bucardo add dbgroup name db1:source db2:source db3:target ...
Adds one or more databases to the named dbgroup. If the dbgroup
doesn't exist, it will be created. The database parameters should specify
their roles, either "source" or "target".
=head3 add table
bucardo add table [schema].table db=actual_db_name
Adds a table object. The table information will be read from the specified
database. Supported parameters:
=over
=item C
The name of the database from which to read the table information. Should be a
name known to Bucardo, thanks to a previous call to C. Required.
=item C
Boolean indicating whether or not the table should automatically send kick
messages when it's modified. Overrides the C parameter of any syncs
of which the table is a part.
=item C
Boolean indicating whether or not to rebuild indexes after every sync. Off by
default. Optional.
=item C
Boolean indicating whether or not to analyze the table after every sync. Off
by default. Optional.
=item C
Boolean indicating whether or not to vacuum the table after every sync. Off by
default. Optional.
=item C
Adds the table to the named relgroup. If the relgroup does not
exist, it will be created. Optional.
=item C
Turns makedelta magic on or off. Value is a list of databases which need makedelta
for this table. Value can also be "on" to enable makedelta for all databases.
Defaults to "off".
=item C
Boolean indicating whether or not to be strict when comparing the table
between syncs. If the columns have different names or data types, the
validation will fail. But perhaps the columns are allowed to have different
names or data types. If so, disable C and column differences will
result in warnings rather than failing the validation. Defaults to true.
=back
=head3 add sequence
bucardo add sequence [schema].sequence relgroup=xxx
=over
=item C
The name of the database from which to read the sequence information. Should
be a name known to Bucardo, thanks to a previous call to C.
Required.
=item C
Adds the sequence to the named relgroup. If the relgroup does not
exist, it will be created. Optional.
=back
=head3 add all tables
bucardo add all tables [relgroup=xxx] [pkonly]
Adds all the tables in all known databases or in a specified database.
Excludes tables in the C, C, and C
schemas. (Yes, this means that you cannot replicate the Bucardo configuration
database using Bucardo. Sorry about that.) Supported options and parameters:
=over
=item C
=item C<--db>
Name of the database from which to find all the tables to add. If not
provided, tables will be added from all known databases.
=item C
=item C<--schema>
=item C<-n>
Limit to the tables in the specified comma-delimited list of schemas. The
options may be specified more than once.
=item C
=item C<--exclude-schema>
=item C<-N>
Exclude tables in the specified comma-delimited list of schemas. The options
may be specified more than once.
=item C
=item C<--table>
=item C<-t>
Limit to the specified tables. The options may be specified more than once.
=item C
=item C<--exclude-table>
=item C<-T>
Exclude the specified tables. The options may be specified more than once.
=item C
=item C<--relgroup>
Name of the relgroup to which to add new tables.
=item C
Exclude tables without primary keys.
=back
=head3 add all sequences
bucardo add all sequences relgroup=xxx
Adds all the sequences in all known databases or in a specified database.
Excludes sequences in the C, C, and C
schemas. (Yes, this means that you cannot replicate the Bucardo configuration
database using Bucardo. Sorry about that.) Supported options and parameters:
=over
=item C
=item C<--db>
Name of the database from which to find all the sequences to add. If not
provided, sequences will be added from all known databases.
=item C
=item C<--schema>
=item C<-n>
Limit to the sequences in the specified comma-delimited list of schemas. The
options may be specified more than once.
=item C
=item C<--exclude-schema>
=item C<-N>
Exclude sequences in the specified comma-delimited list of schemas. The
options may be specified more than once.
=item C
=item C<--relgroup>
Name of the relgroup to which to add new tables or sequences.
=back
=head3 add relgroup
bucardo add relgroup name
bucardo add relgroup name table, sequence, ...
Adds a relgroup. After the name, pass in an optional list of tables
and/or sequences and they will be added to the group.
=head3 add sync
bucardo add sync name relgroup=xxx dbs=xxx
Adds a sync, which is a named replication event containing information about
what to replicate from where to where. The supported parameters are:
=over
=item C
The name of a dbgroup or comma-delimited list of databases. All of the
specified databases will be synchronized. Required.
=item C
The name of a dbgroup. All of the databases within this group will be
part of the sync. If the dbgroup does not exists and a separate list
of databases is given, the group will be created and populated.
=item C
The name of a relgroup to synchronize. All of the tables and/or
sequences in the relgroup will be synchronized. Required unless C is
specified.
=item C
List of tables to add to the sync. This implicitly creates a relgroup
with the same name as the sync. Required unless C is specified.
=item C
Indicates whether or not the sync is active. Must be either "active" or
"inactive". Defaults to "active".
=item C
Boolean indicating whether or not to rebuild indexes after every sync.
Defaults to off.
=item C
Number of seconds a KID can live before being reaped. No limit by default.
=item C
Number of times a KID may be kicked before being reaped. No limit by default.
=item C
The conflict resolution strategy to use in the sync. Supported values:
=over
=item C
The rows on the "source" database always "win". In other words, in a conflict,
Bucardo copies rows from source to target.
=item C
The rows on the "target" database always win.
=item C
Any conflicting rows are simply not replicated. Not recommended for most
cases.
=item C
Each database has an equal chance of winning each time. This is the default.
=item C
The row that was most recently changed wins.
=item C
The sync is aborted on a conflict.
=back
=item C
Determines whether or not a sync should switch to a full copy mode for a
single run. Supported values are:
=over
=item 0: off
=item 1: always full copy
=item 2: only copy tables that are empty on the target
=back
=item C
Boolean indicating whether or not the sync processes (CTL) should be
persistent. Defaults to false.
=item C
Boolean indicating whether or not the sync child processes (KID) should be
persistent. Defaults to false.
=item C
Boolean indicating whether or not tables in the sync should automatically send
kick messages when they're modified. May be overridden by the C
parameter of individual tables.
=item C
An interval specifying the maximum time a sync should go before being
kicked. Useful for busy systems where you don't want the overhead of notify
triggers.
=item C
An integer indicating the priority of the sync. Lower numbers are higher
priority. Currently used only for display purposes.
=item C
Boolean indicating whether or not to analyze tables after every sync. Off by
default. Optional.
=item C
An interval specifying the amount of time after which the sync has not run
that it should be considered overdue. C issues a warning
when a sync has not been run in this amount of time.
=item C
An interval specifying the amount of time after which the sync has not run
that it should be considered expired. C issues a critical
message when a sync has not been run in this amount of time.
=item C
Boolean indicating whether or not to track synchronization rates.
=item C
Boolean indicating whether or not to rebuild indexes after every sync. Off by
default. Optional.
=item C
Boolean indicating whether or not to be strict when comparing tables in the
sync. If the columns have different names or data types, the validation will
fail. But perhaps the columns are allowed to have different names or data
types. If so, disable C and column differences will result in
warnings rather than failing the validation. Defaults to true.
=back
=head3 add customname
bucardo add customname oldname newname [db=name] [sync=name]
Creates a new Bucardo custom name mapping. This allows the tables involved in
replication to have different names on different databases. The C
must contain the schema as well as the table name (if the source database
supports schemas). The optional parameters limit it to one or more databases,
and/or to one or more syncs. Supported parameters:
=over
=item C
A sync to which to add the customname. May be specified multiple times.
=item C
=item C
A database for which to add the customname. May be specified multiple times.
=back
=head3 add customcols
bucardo add customcols tablename select_clause [sync=x db=x]
Specify the list of columns to select from when syncing. Rather than the
default C
=item C
=back
=head3 update customcode
bucardo update customcode setting=value
Updates an existing customcode. Items that can be changed are:
=over
=item C
A short description of the custom code.
=item C
Boolean indicating whether or not Perl L database handles should be
provided to the custom code subroutine. If true, database handles will be
provided under the C key of the hash reference passed to the subroutine.
The value under this key will be a hash reference mapping database names to
their respective handles.
=item C
The name of the custom code object.
=item C
Number indicating the priority in which order to execute custom codes. Lower numbers
are higher priority. Useful for subroutines that set C in order to
cancel the execution of subsequent custom codes for the same C.
=item C
The current status of this customcode. Anything other than "active" means the
code is not run.
=item C
A string indicating when the custom code should be run. Supported values include:
=over
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=item C
=back
=back
=head3 update db
bucardo udpate db port=xxx host=xxx user=xxx pass=xxx
Updates a database. The C is the name by which the database is known to
Bucardo. This may vary from the actual database name, as multiple hosts might
have databases with the same name.
The supported named parameters are:
=over
=item C
=item C
The actual name of the database.
=item C
=item C
The type of the database. Currently supported values are:
=over
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=back
=item C
=item C
=item C
The username Bucardo should use to connect to the database.
=item C
=item C
=item C
The password Bucardo should use when connecting to the database.
=item C
=item C
=item C
The host name to which to connect.
=item C
=item C
=item C
The port to which to connect.
=item C
=item C
=item C
Additional connection parameters, e.g., C. Optional.
=item C
Status of the database in Bucardo. Must be either "active" or "inactive".
=item C
=item C
=item C
Enable or disable server-side prepares. Pass 1 to enable them or 0 to disable
them.
=item C
Enable or disable makedelta for this database.
=item C
=item C
The service name to use for a Postgres database.
=item C
A comma-separated list of dbgroups to which to add the database. The
database will be removed from any other dbgroups of which it was previously a
member.
=back
=head3 update sync
bucardo update sync syncname relgroup=xxx dbs=xxx
Updates a sync, which is a named replication event containing information about
what to replicate from where to where. The supported parameters are:
=over
=item C
The name of the sync. Required.
=item C
The name of a dbgroup or comma-delimited list of databases.
=item C
The name of a relgroup to synchronize.
=item C
Indicates whether or not the sync is active. Must be either "active" or
"inactive". Note that this will not change the current run status of the sync,
just mark whether it should be active or inactive on the next reload. Use the
C and commands to actually activate or
deactivate a sync.
=item C
Boolean indicating whether or not to rebuild indexes after every sync.
=item C
Number of seconds a KID can live before being reaped.
=item C
Number of times a KID may be kicked before being reaped.
=item C
The transaction isolation level this sync should use.
Only choices are "serializable" and "repeatable read"
=item C
The conflict resolution strategy to use in the sync. Supported values:
=over
=item C
The rows on the "source" database always "win". In other words, in a conflict,
Bucardo copies rows from source to target.
=item C
The rows on the "target" database always win.
=item C
Any conflicting rows are simply not replicated. Not recommended for most
cases.
=item C
Each database has an equal chance of winning each time.
=item C
The row that was most recently changed wins.
=item C
The sync is aborted on a conflict.
=back
=item C
Determines whether or not a sync should switch to a full copy mode for a
single run. Supported values are:
=over
=item 0: off
=item 1: always full copy
=item 2: only copy tables that are empty on the target
=back
=item C
Boolean indicating whether or not the sync processes (CTL) should be
persistent.
=item C
Boolean indicating whether or not the sync child processes (KID) should be
persistent.
=item C
Boolean indicating whether or not tables in the sync should automatically send
kick messages when they're modified. May be overridden by the C
parameter of individual tables.
=item C
An interval specifying the maximum time a sync should go before being
kicked. Useful for busy systems where you don't want the overhead of notify
triggers.
=item C
An integer indicating the priority of the sync. Lower numbers are higher
priority. Currently used only for display purposes.
=item C
Boolean indicating whether or not to analyze tables after every sync. Off by
default.
=item C
An interval specifying the amount of time after which the sync has not run
that it should be considered overdue. C issues a warning
when a sync has not been run in this amount of time.
=item C
An interval specifying the amount of time after which the sync has not run
that it should be considered expired. C issues a critical
message when a sync has not been run in this amount of time.
=item C
Boolean indicating whether or not to track synchronization rates.
=item C
Boolean indicating whether or not to rebuild indexes after every sync.
=item C
Boolean indicating whether or not to be strict when comparing tables in the
sync. If the columns have different names or data types, the validation will
fail. But perhaps the columns are allowed to have different names or data
types. If so, disable C and column differences will result in
warnings rather than failing the validation. Defaults to true.
=back
=head3 update table
bucardo update table [schema].table db=actual_db_name
Updates a table object. The table information will be read from the specified
database. Supported parameters:
=over
=item C
The name of the database from which to read the table information. Should be a
name known to Bucardo.
=item C
The name of the schema in which the table is found.
=item C
The actual name of the table.
=item C
Boolean indicating whether or not the table should automatically send kick
messages when it's modified. Overrides the C parameter of any syncs
of which the table is a part.
=item C
Boolean indicating whether or not to rebuild indexes after every sync.
=item C
Boolean indicating whether or not to analyze the table after every sync.
=item C
Boolean indicating whether or not to vacuum the table after every sync.
=item C
Adds the table to the named relgroup. May be specified more than once.
The table will be removed from any other relgroups.
=item C
Specifies which databases need makedelta enabled for this table.
=item C
Boolean indicating whether or not to be strict when comparing the table
between syncs. If the columns have different names or data types, the
validation will fail. But perhaps the columns are allowed to have different
names or data types. If so, disable C and column differences will
result in warnings rather than failing the validation. Defaults to true.
=back
=head3 update sequence
bucardo update sequence [schema].sequence relgroup=xxx
=over
=item C
The name of the database where the sequence lives.
=item C
The name of the schema in which the sequence is found.
=item C
Adds the sequence to the named relgroup. May be speci
Removes one or more objects from Bucardo. Valid item types are;
=over
=item * C or C
Use the C<--force> option to clear out related tables and groups instead of
erroring out.
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=item * C
=back
=head2 kick
bucardo kick [timeout]
Tells one or more named syncs to fire as soon as possible. Note that this simply sends a request that
the sync fire: it may not start right away if the same sync is already running, or if the source or
target database has exceeded the number of allowed Bucardo connections. If the final argument is a
number, it is treated as a timeout. If this number is zero, the bucardo command will not return
until the sync has finished. For any other number, the sync will wait at most that number of seconds.
If any sync has not finished before the timeout, an exit value of 1 will be returned. Errors will
cause exit values of 2 or 3. In all other cases, an exit value of 0 will be returned.
If a timeout is given, the total completion time in seconds is also displayed. If the sync is going to
multiple targets, the time that each target takes from the start of the kick is also shown as each
target finishes. Options:
=over
=item C<--retry>
The number of times to retry a sync if it fails. Defaults to 0.
=item C<--retry-sleep>
How long to sleep, in seconds, between each retry attempt.
=item C<--notimer>
By default, kicks with a timeout argument give a running real-time summary of
time elapsed by using the backspace character. This may not be wanted if
running a kick, for example, via a cronjob, so turning --notimer on will
simply print the entire message without backspaces.
=back
=head2 pause
bucardo pause
bucardo pause all
bucardo resume
bucardo resume all
Tells one or more named syncs to temporarily pause, or to resume from a previous pause. This
only applies to active syncs and only takes effect if Bucardo is currently running. The
keyword 'all' can be used as well to pause or resume all known active syncs.
=head2 reload config
bucardo reload config
bucardo reload config 30
Sends a message to all CTL and KID processes asking them to reload the Bucardo
configuration. This configuration is a series of key/value pairs that
configure Bucardo's behavior, and not any of the objects managed by the
C, C, or C commands.
By default, Bucardo will send the message and then exit. Pass an optional
number and Bucardo will instead wait up to that length of time for all child
processes to report completion.
=head2 set
bucardo set setting1=value [setting2=value]
Sets one or more configuration setting table. Setting names are
case-insensitive. The available settings are:
=begin comment
How to generate this list:
psql -U bucardo -d bucardo -AXtc "SELECT regexp_replace(format(
E'=item C<%s>\n\n%s. Default: %s.\n',
name, about, CASE WHEN setting = '' THEN 'None' ELSE 'C<' || setting || '>' END
), '([.?])[.]', E'\\\\1') FROM bucardo_config ORDER BY name;"
=end comment
=over
=item C
Which DDL changing conditions do we try to remedy automatically? Default: C.
=item C
Current version of Bucardo. Default: C<5.4.1>.
=item C
Do we want the automatic VAC daemon to run? Default: C<1>.
=item C
Bucardo version this schema was created with. Default: C<5.4.1>.
=item C
How often does the controller check on the kids health? Default: C<10>.
=item C
How long do we sleep to allow kids-on-demand to get on their feet? Default: C<0.5>.
=item C
How long does the controller loop sleep? Default: C<0.2>.
=item C
Default conflict strategy for all syncs. Default: C.
=item C
Who the alert emails are sent as. Default: C.
=item C
Which host to send email through. Default: C.
=item C
Who to send alert emails to. Default: C.
=item C
File to save a copy of all outgoing emails to. Default: None.
=item C
How long do we sleep when custom code requests an endsync? Default: C<1.0>.
=item C
Directory to store the flatfile output inside of. Default: C<.>.
=item C
Regex to make sure we don't accidentally run where we should not. Default: None.
=item C
The transaction isolation level all sync should use. Defaults to 'serializable'.
The only other valid option is 'repeatable read'
=item C
How long to sleep in seconds if we hit a deadlock error. Default: C<0.5>.
Set to -1 to prevent the kid from retrying.
=item C
How long do kids sleep if no delta rows are found? Default: C<0.5>.
=item C
How often do we ping check the KID? Default: C<60>.
=item C
How long to sleep in seconds when restarting a kid? Default: C<1>.
=item C
How long to sleep in seconds if we hit a serialization error. Default: C<0.5>.
Set to -1 to prevent the kid from retrying.
=item C
How long does a kid loop sleep? Default: C<0.5>.
=item C
Name of the conflict detail log file. Default: C.
=item C
How verbose to make the logging. Higher is more verbose. Default: C.
=item C
Show microsecond output in the timestamps? Default: C<0>.
=item C
Show log level in the log output? Default: C<0>.
=item C
Show line number in the log output? Default: C<0>.
=item C
Show PID in the log output? Default: C<1>.
=item C
Show timestamp in the log output? 0=off 1=seconds since epoch 2=scalar gmtime 3=scalar localtime. Default: C<3>.
=item C
How many seconds to sleep before trying to respawn. Default: C<15>.
=item C
How long does the main MCP daemon sleep between loops? Default: C<0.2>.
=item C
How often do we ping check the MCP? Default: C<60>.
=item C
How often in seconds do we check that a VAC is still running? Default: C<60>.
=item C
Directory holding Bucardo PID files. Default: C.
=item C
File to hold reasons for stopping and starting. Default: C.
=item C
Number of seconds the C command should wait for the reload to complete.
Default: C<30>.
=item C
Table to let apps know a sync is ongoing. Default: C.
=item C
How many primary keys to shove into a single statement. Default: C<10000>.
=item C
Location of the stats script. Default: C.
=item C
Name of the semaphore file used to stop Bucardo processes. Default: C.
=item C
Which syslog facility level to use. Default: C.
=item C
How many probes to send. 0 indicates sticking with system defaults. Default: C<0>.
=item C
How long to wait between each keepalive probe. Default: C<0>.
=item C
How long to wait for a response to a keepalive probe. Default: C<0>.
=item C
How often does the VAC process run? Default: C<30>.
=item C
How long does VAC process sleep between runs? Default: C<120>.
=item C
File containing all log lines starting with "Warning". Default: C.
=back
=head2 show
bucardo show all| [...]
Shows the current Bucardo settings. Use the keyword "all" to see all the
settings, or specify one or more search terms. See L for complete
details on the configuration settings.
=head2 config
bucardo config show all| [...]
bucardo config set [...]
Deprecated interface for showing and setting configuration settings. Use the
L and L commands, instead.
=head2 ping
bucardo ping
bucardo ping 60
bucardo ping 0
Sends a ping notice to the MCP process to see if it will respond. By default, it will wait 15 seconds. A
numeric argument will change this timeout. Using a 0 as the timeout indicates waiting forever. If a response
was returned, the program will exit with a value of 0. If it times out, the value will be 1.
Returns a Nagios like message starting with "OK" or "CRITICAL" for success or failure.
=head2 status
bucardo status [syncname(s)] [--sort=#] [--show-days] [--compress]
Shows the brief status of all known syncs in a tabular format. If given one or more sync names,
shows detailed information for each one. To see detailed information for all syncs, simply
use "status all"
When showing brief information, the columns are:
=over
=item 1. B
The name of the sync
=item 2. B
The state of the sync. Can be 'Good', 'Bad', 'Empty', 'No records found',
'Unknown', or the run state for a currently-running sync.
=item 3. B
When the sync last successfully ran.
=item 4. B
=item C
=item C
=back
=head2 validate
bucardo validate all| [...]
Validates one or more syncs. Use the keyword "all" to validate all syncs, or
specify one or more syncs to validate.
Note that this command executes a subset of all the validation done when a
sync is started or activated.
=head2 purge
bucardo purge all|
[
...]
Purges the delta and track tables for one or more tables, for one or more
databases. Use the keyword "all" to validate all tables, or specify one or
more tables to validate.
=head2 delta
bucardo delta [total] [...]
Show the current delta count for each source target. Provide a list of databases
to limit it to just the given ones. Wildcards are allowed. Use the special name
"totals" to show only the grand total.
=head2 help
bucardo help
bucardo help
bucardo help
Get help. General help can be returned, as well as help for a single command
or a command and its action. Some examples:
bucard help list
bucard help add table
=head1 OPTIONS DETAILS
It is usually easier to set most of these options at the top of the script, or make an alias for them,
as they will not change very often if at all.
=over
=item C<-d>
=item C<--db-name>
bucardo --db-name widgets
bucardo -d bricolage
Name of the Bucardo database to which to connect.
=item C<-U>
=item C<--db-user>
bucardo --db-user postgres
bucardo -U Mom
User name to use when connecting to the Bucardo database.
=item C<-P>
=item C<--db-pass>
bucardo --db-pass s3cr1t
bucardo -P lolz
Password to use when connecting to the Bucardo database.
=item C<-h>
=item C<--db-host>
bucardo --db-host db.example.com
bucardo -h db2.example.net
Host name to use when connecting to the Bucardo database.
=item C<-p>
=item C<--db-port>
bucardo --db-port 7654
Port number to connect to when connecting to the Bucardo database.
=item C<--bucardorc>
bucardo --bucardorc myrcfile
Use the specified file for configuration instead of the default
F<./.bucardorc>.
=item C<--no-bucardorc>
Do not use the F<./.bucardorc> configuration file.
=item C<--verbose>
Makes bucardo run verbosely. Default is off.
=item C<--quiet>
Tells bucardo to be as quiet as possible. Default is off.
=item C<--help>
Shows a brief summary of usage for bucardo.
=back
=head1 FILES
In addition to command-line configurations, you can put any options inside of a file. The file F<.bucardorc> in
the current directory will be used if found. If not found, then the file F<~/.bucardorc> will be used. Finally,
the file /etc/bucardorc will be used if available. The format of the file is option = value, one per line. Any
line starting with a '#' will be skipped. Any values loaded from a bucardorc file will be overwritten by
command-line options. All bucardorc files can be ignored by supplying a C<--no-bucardorc> argument. A specific
file can be forced with the C<--bucardorc=file> option; if this option is set, bucardo will refuse to run
unless that file can be read.
=head1 ENVIRONMENT VARIABLES
The bucardo script uses I<$ENV{HOME}> to look for a F<.bucardorc> file.
=head1 BUGS
Bug reports and feature requests are always welcome, please visit
L, file L, or post to our
L.
=head1 SEE ALSO
Bucardo
=head1 COPYRIGHT
Copyright 2006-2015 Greg Sabino Mullane
This program is free to use, subject to the limitations in the LICENSE file.
=cut
Bucardo-5.4.1/Makefile.PL0000644000175000017500000000722112601643305013506 0ustar greggreguse ExtUtils::MakeMaker;
use strict;
use warnings;
use 5.008003;
## No version.pm for this one, as the prereqs are not loaded yet.
my $VERSION = '5.4.1';
WriteMakefile(
NAME => 'Bucardo',
clean => { FILES => 'log.bucardo.* *~ *.tmp outgoingmail.* bucardo_test_database*/ test.sqlite.db' },
ABSTRACT => 'Postgres asynchronous multi-master replication system',
AUTHOR => 'Greg Sabino Mullane ',
LICENSE => 'BSD',
PREREQ_PM => {
'boolean' => '0',
'DBD::Pg' => '2.0',
'DBI' => '1.51',
'DBIx::Safe' => '1.2.4',
'ExtUtils::MakeMaker' => '6.32',
'File::Spec' => '0',
'IO::Handle' => '1.24',
'List::Util' => '0',
'MIME::Base64' => '0',
'Net::SMTP' => '0',
'Pod::Parser' => '0',
'Pod::Usage' => '0',
'Sys::Hostname' => '1.11',
'Sys::Syslog' => '0.13',
'Test::Harness' => '2.03',
'Test::More' => '0.61',
'Time::HiRes' => '0',
},
NO_META => 1,
NEEDS_LINKING => 0,
VERSION_FROM => 'Bucardo.pm',
EXE_FILES => ['bucardo'],
MAN1PODS => { 'bucardo' => 'blib/man1/bucardo.1pm' },
NORECURS => 1,
);
package MY;
sub clean {
my $string = shift->SUPER::clean(@_);
$string =~ s{\t}{\tperl t/98-cleanup\.t\n\t};
$string .= qq{\n\nhtml : \n\t};
$string .= qq{\t\$(NOECHO) pod2html Bucardo.pm > Bucardo.pm.html\n};
$string .= qq{\t\$(NOECHO) pod2html bucardo > bucardo.html\n};
$string .= qq{\t\$(NOECHO) \$(RM_F) pod*.tmp pm_to_blib\n};
$string .= qq{\t\$(NOECHO) \$(PERL) -pi -e "s///" Bucardo.pm.html bucardo.html\n};
$string .= qq{\t\$(NOECHO) \$(PERL) -pi -e "s~\\`\\`(.+?)''~"\\1"~g" Bucardo.pm.html bucardo.html\n};
$string .= qq{\t\$(NOECHO) \$(ECHO) Created Bucardo.pm.html and bucardo.html\n};
return $string;
}
sub blibdirs {
my $string = shift->SUPER::blibdirs_target(@_);
$string = qq{INST_SHARE = blib/share\n\n$string};
$string =~ s{(blibdirs : .+)}{$1 \$(INST_SHARE)\$(DFSEP).exists};
$string .= qq{\$(INST_SHARE)\$(DFSEP).exists :: Makefile.PL\n};
$string .= qq{\t\$(NOECHO) \$(MKPATH) \$(INST_SHARE)\n};
$string .= qq{\t\$(NOECHO) \$(CHMOD) 755 \$(INST_SHARE)\n};
$string .= qq{\t\$(NOECHO) \$(TOUCH) \$(INST_SHARE)\$(DFSEP).exists\n};
$string .= qq{\t\$(CP) bucardo.schema \$(INST_SHARE)/bucardo.schema\n};
$string .= qq{\t-\$(NOECHO) \$(CHMOD) \$(PERM_RW) \$(INST_SHARE)/bucardo.schema\n};
return $string;
}
sub install {
my $string = shift->SUPER::install(@_);
my $vars = qq{DESTINSTALLSHARE = \$(INSTALL_BASE)/usr/local/share/bucardo\n};
$vars .= qq{DESTINSTALLSITESHARE = \$(INSTALL_BASE)/usr/local/share/bucardo\n};
$vars .= qq{DESTINSTALLVENDORSHARE = \$(INSTALL_BASE)/usr/share/bucardo\n};
if ($ENV{INSTALL_BUCARDODIR}) {
for my $dir (qw{SCRIPT LIB MAN1DIR MAN3DIR}) {
$vars .= qq{INSTALLSITE$dir=$ENV{INSTALL_BUCARDODIR}\n};
}
for my $dir (qw{SITEARCH ARCHLIB SITESHARE}) {
$vars .= qq{DESTINSTALL$dir=$ENV{INSTALL_BUCARDODIR}\n};
}
}
$string = "\n$vars\n$string";
$string =~ s{(\t"?\$\(INST_BIN\)"? "?\$\((DESTINSTALL.*?)BIN.+)"?}{$1\n\t\t\$(INST_SHARE) \$($2SHARE) \\}g;
return $string;
}
Bucardo-5.4.1/patches/0000755000175000017500000000000012601643631013163 5ustar greggregBucardo-5.4.1/patches/Bucardo.4.4.0.fix.search.path.patch.txt0000644000175000017500000000235712074706601022037 0ustar greggreg--- Bucardo.pm 2010/09/02 14:08:46 1.1
+++ Bucardo.pm 2010/09/02 14:09:47
@@ -1832,6 +1832,9 @@
push @{$g->{binarypkey}} => 0;
}
+ ## Turn off the search path, to help the checks below match up
+ $srcdbh->do('SET LOCAL search_path = pg_catalog');
+
## Check the source columns, and save them
$sth = $sth{checkcols};
$sth->execute($g->{oid});
@@ -1878,6 +1881,8 @@
push @{$g->{binarycols}}, $colinfo->{$colname}{order};
}
+ $srcdbh->do('RESET search_path');
+
} ## end if reltype is table
## If a sequence, grab all info as a hash
@@ -1976,6 +1981,9 @@
## Store away our oid, as we may need it later to access bucardo_delta
$g->{targetoid}{$db} = $oid;
+ ## Turn off the search path, to help the checks below match up
+ $dbh->do('SET LOCAL search_path = pg_catalog');
+
## Grab column information about this table
$sth = $dbh->prepare($SQL{checkcols});
$sth->execute($oid);
@@ -1987,6 +1995,8 @@
$targetcolinfo->{$_}{realattnum} = $x++;
}
+ $dbh->do('RESET search_path');
+
my $t = "$g->{schemaname}.$g->{tablename}";
## We'll state no problems until we are proved wrong
Bucardo-5.4.1/SIGNATURE0000644000175000017500000001057512601643626013034 0ustar greggregThis file contains message digests of all files listed in MANIFEST,
signed via the Module::Signature module, version 0.73.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
% cpansign -v
It will check each file's integrity, as well as the signature's
validity. If "==> Signature verified OK! <==" is not displayed,
the distribution may already have been compromised, and you should
not run its Makefile.PL or Build.PL.
-----BEGIN PGP SIGNED MESSAGE-----
Hash: RIPEMD160
SHA1 12f841cce1ed61f1f0e6cbf94705a3e864190c08 .gitignore
SHA1 ced2b8b630a3b6dcfb2c68ae8dd4714639b103d8 .perlcriticrc
SHA1 fc61555886322501708e3c4c2941cc75749016f5 Bucardo.pm
SHA1 972851f21071b427bd27dd4856e91826b3d06f35 Bucardo.pm.html
SHA1 9d44c618a302810e5f4acd5eaa88fba0ea1554fb Changes
SHA1 d7664cd55b0f30a7cd8c17c498d5983fbe9663ae INSTALL
SHA1 b1807c218088c3bbbb38cd69b9685a1f88236035 LICENSE
SHA1 87e3b1286899c2757aeb13e398fbd1e6ad719a7f MANIFEST
SHA1 5058d5e4a7b5e3d33b587ff78ccc8e7c355d7b20 MANIFEST.SKIP
SHA1 64bd1db27d68ff3460e70decfb14fb94caf2b67f META.yml
SHA1 bb10ef328469a9489b1f9e18ca999fa97d551b45 Makefile.PL
SHA1 c12f92b29750fb37871b33817568fe8481e53c92 README
SHA1 f8c71d62c860a54ded824301dbf566860015e8c5 README.dev
SHA1 ef2e8bb243ed4c84ab74e27114ff3555d4d62eb9 TODO
SHA1 31609418af80896bd4e853c36aecff8747e103da UPGRADE
SHA1 d2c55f666d4282de0919e565f030bf6ae3971cff bucardo
SHA1 5c1b3cc7c0d72eb6bacbfa149b3eafcab8a38cc7 bucardo.html
SHA1 69f52f99e9b4e1d80cd50b5bbc27c45224611622 bucardo.schema
SHA1 87bf175b3ad3949ee6d81d772161fe87cc08f2b4 dev/test_setup.sh
SHA1 664d7c1b0980c457a2c68e99836fefefe2b9885d dist/README
SHA1 e19aa6109330c654b5bef7bd0c4460d0d11dbdaa dist/bucardo-logfiles.patch
SHA1 43c18bb939bdac1b0544c1327eb30b07cd8abcc3 dist/bucardo.init
SHA1 a3dc67e2a474d9aa26fd766a3d56944e31b75e76 dist/bucardo.rc
SHA1 8955921ef4c5b62eb292b63a7c45c0349f93dc32 dist/bucardo.spec
SHA1 98e77ebb6f5d7477d1dc0a7ca2ed79f3f791df5e patches/Bucardo.4.4.0.fix.search.path.patch.txt
SHA1 a3ededc04228e30c6947b736de8fbe4d3c2a159e scripts/README
SHA1 7e293cb5852d1038195a93314704023effe742b5 scripts/bucardo-report
SHA1 81a5c4bdc0550d2d70087d2e82c1403caf5a202a scripts/bucardo_rrd
SHA1 8233a545068fa32b70878e42286218977812cbb9 scripts/check_bucardo_sync
SHA1 73c0f9c55c81a220390ea8cb1506e71f3eeb1972 scripts/slony_migrator.pl
SHA1 3496a6132a45cff4865d896291e19b447c5bae69 t/01-basic.t
SHA1 e08568d51bf87fa6de04c7566a42ee66c905058a t/02-bctl-customname.t
SHA1 ef075dc7a3d52685df65d8a5d61a9381b8b0e001 t/02-bctl-db.t
SHA1 4a7fbb3bcf10f2bb563f2636bbab15443ae701d9 t/02-bctl-dbg.t
SHA1 37729c122486c41b83e857b831aca823e3c9c352 t/02-bctl-herd.t
SHA1 b587340368c5343769d8c3b3bcacb0c197d0bc37 t/02-bctl-sync.t
SHA1 3e36a5268ad1a007c2930d12900217866d7a12c5 t/02-bctl-table.t
SHA1 fdb3335d09bc9e8341ebc37eeb78846e02be12bc t/10-fullcopy.t
SHA1 78827463a0066bdbfd30dc3f2ad09891e74fd2aa t/10-makedelta.t
SHA1 bf88e46db0ffbe5873f58ba4777635950bd42dd9 t/10-object-names.t
SHA1 0ef45c806789e9c5e6ee502a123e6d2e0fbf6b26 t/20-drizzle.t
SHA1 7b97f4770eca3543595a63df60da94d462ecdc19 t/20-mariadb.t
SHA1 67d20683eb071bd1107237e82ec2f8fe34ca01ac t/20-mongo.t
SHA1 d09fc4483b011e61484f1a54a5f4780b780ad6b7 t/20-mysql.t
SHA1 60b9b42680567972e0b29859a35a68c9b3a6ce2f t/20-oracle.t
SHA1 58584be9eeafc0bd184cb4f8b57d7cd79e65d412 t/20-postgres.t
SHA1 c6ce07a59d7e82fc31ec7c296a6813755f8083b4 t/20-redis.t
SHA1 5946c123bc4739767e28da9b6a3e95d884fc20bc t/20-sqlite.t
SHA1 732dc416fb10e39c0f2027dbcc4643d275520d3d t/30-crash.t
SHA1 19514e5532c340397edcc92cac6521da28c9f0fe t/30-delta.t
SHA1 2d6dde34c6d8c33960789fc5a237c545121a752c t/40-conflict.t
SHA1 9114652a9e6156abd6d24bfd83402b266c60920c t/40-customcode-exception.t
SHA1 7042e08ea5043e7e370027dfda38f37ee150bee7 t/40-serializable.t
SHA1 24669931f3b6f918fd66652b2b11cdb36bb00dce t/50-star.t
SHA1 9cf7c7658b82334607f7e10079282875f0ef20de t/98-cleanup.t
SHA1 14e82dad75a2ef2e261f9cb3c07c0e87d9ef8651 t/99-signature.t
SHA1 deb6475aaca311f9ceae45042beb2c4362be12f7 t/BucardoTesting.pm
SHA1 c86be756bac91b7512f8a926ceaa99a2990b9187 t/ctest1.pl
SHA1 7ed25a8353e5e6cad43d30dbac498427e8911ba1 t/ctest2.pl
SHA1 da39a3ee5e6b4b0d3255bfef95601890afd80709 t/ctest3.pl
SHA1 c8acd172c97d2df71ab8b4b3378be2bb59a872ef t/customcode.exception.bucardotest.pl
-----BEGIN PGP SIGNATURE-----
iEYEAREDAAYFAlYHR5YACgkQvJuQZxSWSsjNNwCglmylConfAr4XIEmwCtPnKx50
r0oAoOUjN7Nf6FuPblbSIjEdnIku1+I7
=VTxF
-----END PGP SIGNATURE-----
Bucardo-5.4.1/README.dev0000644000175000017500000002775012563002233013176 0ustar greggreg
This file is for those interested in developing Bucardo.
It is hoped that it will be a good introduction as well as a continual
reference. Suggestions are always welcome.
Sections:
* File List
* Editing
* Test Files
* Version Numbers
* New Files
* Making a New Release
* Tips and Tricks
===============
== File List ==
===============
Here is what each file in the distribution does:
* Text files:
Changes - lists changes made to each version. Please be consistent and use
tabs, not spaces, to indent. Try to list who found the bug, and who
fixed it (if not the same person). Put the person who made the actual
changes in brackets. This file contains a version number.
README.dev - you are reading it.
README - the main file that explains the module, where to get it, and guides
people in installing it. This file contain a version number.
TODO - Rough list of ideas on improving Bucardo.
SIGNATURE - Checksum verification via PGP, generated by Module::Signature.
INSTALL - Basic install instructions
UPGRADE - Basic upgrade instructions
* Build files:
Makefile.PL - Standard Perl file that creates the makefile via "perl Makefile.PL"
Note that this file also creates the html files. Contains a version number.
Makefile - Generated automatically by Makefile.PL
META.yml - YAML description file. Updated by hand and contains version
number in two places.
* Distribution files:
MANIFEST - lists which files should be included in the release tarball.
Used by the "make dist*" set of commands.
MANIFEST.SKIP - files that are known to be safe to exclude from the release
tarball. Used by the "make dist", "make distcheck" and "make skipcheck" commands.
* Program files:
Bucardo.pm - The main program. This is the core of Bucardo - everything else supports
this file. Contains a version number in two places.
bucardo - The main command-line interface to Bucardo. Contains a version number.
scripts/* - Various scripts
* Documentation files:
Bucardo.pm.html - generated by "make html" from the POD in Bucardo.pm
bucardo.html - generated by "make html" from the POD in bucardo
* Supporting files:
bucardo.schema - The schema for Bucardo. Contains a version number in two places.
.perlcriticrc - Customized Perl::Critic rules for the t/99perlcritic.t file.
.gitignore - Things we don't want git to look at
* Test files:
t/BucardoTesting.pm - Shared routines for setup and teardown.
t/00setup.t - Shared code for the Bucardo tests.
t/01basic.t - Test of very basic things.
t/02-simple.t - Very simply replication tests
t/03-goat.t - Test goat access methods.
t/04-pushdelta.t - Test pushdelta syncs.
t/02-monkey_with_db_table.t - Test db manipulation via bucardo
t/02-monkey_with_goat_table.t - Test goat manipulation via bucardo
t/02-monkey_with_herd.t - Test herd manipulation via bucardo
t/02-monkey_with_sync_table.t - Test sync manipulation via bucardo
t/05-fullcopy.t - Test fullcopy
t/06-multicolpk.t - Test multi-column primary keys
t/06-multicolpushdelta.t - Test multi-column primary keys for pushdelta syncs
t/07-multicolswap.t - Test multi-column primary keys for swap syncs
t/08-wildkick.t - Test kicking more than one sync at a time
t/09-uniqueconstraint.t - Test of customcode with pushdelta
t/10-makedelta.t - Test of makedelta functionality
t/12-addtable.t - Test adding new tables
t/13-ddl.t - Test pushing DDL (not complete yet)
t/14-truncate.t - Test of truncation replication (requires Postgres 8.4 or greater)
t/50-star.t - Test of star replication scheme
t/98-cleanup.t - Shuts down test databases. Called by "make distclean"
t/99-perlcritic.t - Uses Perl::Critic to check Bucardo.pm, bucardo, and all the
test files (including itself). Requires that TEST_CRITIC is set. It is recommended
that you get all the Perl::Critic policies via Bundle::Perl::Critic::IncludingOptionalDependencies.
t/99-pod.t - Verifies the POD of Pg.pm. Requires Test::POD version 0.95, and
Test::Pod::Coverage 1.04.
t/99-signature.t - Uses Module::Signature to verify SIGNATURE file. All tests are skipped
if the environment variable TEST_SIGNATURE is not set.
t/99-spellcheck.t - Spell checks all files and comments
t/99-yaml.t - Uses Test::YAML::Meta to verify the META.yml file.
* Developer test files are in the dev/ directory
=============
== Editing ==
=============
All the perl files should have a cperl pragma at the top of the file, for easy use in emacs.
Please use tabs and not spaces everywhere, and keep the indenting to the cperl standard.
When in doubt, use the guidelines from the Perl Best Practices book, with the following
exceptions:
* Use tabs, not spaces. When using spaces, make them 4 characters wide.
================
== Test Files ==
================
The test files are an important part of the module. Much work has gone into making
the tests as complete, thorough, and clean as possible. Please try to follow these
guidelines when developing:
* Whenever you add a new feature, no matter how minor, add a test. Better yet, add
many tests to make sure that it not only works correctly, but that it breaks when
it is supposed to (e.g. when it is fed the wrong output). Try to conceive of every
possible way your feature will be used and mis-used.
* If someone files a bug report that is not revealed by a test, please add one in,
no matter how simple the fix maybe, or how stupid the bug is.
* Don't create a new test file unless necessary - use the existing ones whenever possible.
* If you do create a new test, keep the name short, start it with a number and a dash,
and use an existing test as a template.
* Tests should be as "standalone" as possible. Most will call bucardo.test.pl to
automate setting up and tearing down supporting test infrastructure.
* Don't call DBI->connect inside of your tests, but use connect_database() from the
dbdpg_test_setup.pl file instead. If you don't want it to blow away and recreate the
current test table and other objects, use connect_database({nosetup => 1}).
* Use the standard format for tests, and always provide an appropriate output text.
Abbreviations are encouraged, but be consistent throughout the file.
* Make sure to test on different versions of PostgreSQL, DBI, and Perl. Use the SKIP
tag with an appropriate message if a test does not work on a particular version of
something.
* To run a single test, use: prove --blib . -v t/testname.t
=====================
== Version Numbers ==
=====================
Version numbers follow the Postgres convention: major, minor, and revision.
The major number should very, very rarely change, and is saved for the truly major changes
(e.g. those that may cause backwards compatibility problems). The minor revision is used to
indicate a change in functionality, new features, etc. The revision number is used for small
tweaks and bug fixes, and must be completely compatible with the version before it.
Version numbers are currently set in nine files:
README
Bucardo.pm (two places)
Bucardo.pm.html
bucardo
bucardo.html
bucardo.schema (three places)
Changes
Makefile.PL
META.yml (three places)
===============
== New Files ==
===============
If you are adding a new file to the distribution (and this should be a rare event),
please check that you have done the following items:
* Added it to via 'git add filename' and 'git commit'
* Added it to the MANIFEST file
* Added it to Makefile.PL if needed, to make sure all build dependencies are met
* Updated/created necessary tests for it
* Added it to the "File List" section above.
==========================
== Making a New Release ==
==========================
This is a comprehensive checklist of all the steps required to release a
new version, whether beta or regular. It is assumed you are very familiar with the
other sections referenced herein.
* Test on variety of versions of Postgres
* Make sure everything is up to date and committed in git.
* Update the versions in all relevant files. Use t/00_release.t to verify this.
* If a final version, put the release date into the Changes file.
* If a beta version, please put a large warning at the top of the README file. Here is a sample:
===================================================
WARNING!!
THIS IS A TEST VERSION (1.9.1_2) AND SHOULD BE USED
FOR TESTING PURPOSES ONLY. PLEASE USE A STABLE
VERSION (no underscore) BY VISITING:
http://bucardo.org
===================================================
* If not a beta version, remove the above warning as needed from the README.
* Completely update the Changes file
The best way to do this (other than doing it as you go along) is to check the git logs.
* Update the documentation
Make sure that anything new has been documented properly, usually as pod inside of Bucardo.pm
A good way to do this is to use the tests in 99-pod.t - they will run automatically as
part of the test suite if the right modules are installed.
* Make sure the wiki is updated as well.
* Run "perl Makefile.PL"
* Run "make html". This will create the html docs for Bucardo.pm and bucardo. Make sure you
git commit them if anything has changed.
* Run "make dist". Double check that the tarball created has the correct version name.
* Run "make distcheck". This will show you a list of all files that are in the current directory
but not inside the MANIFEST file (or the MANIFEST.SKIP file). If there are any new files here
that should be part of the distribution, add them to the MANIFEST file, commit your changes,
and then re-run. Note that files ending in ".tmp" are currently skipped, so this is a good
extension for any miscellaneous files you have that use often.
* Run "make skipcheck". This will show you a list of files that will not be packed into the
release tarball. Make sure there is nothing important here.
* Run "make disttest". This unpacks the tarball, then runs "make" and "make test" on it.
You may also want to remove the directory it creates later by using "make realclean"
* Update the SIGNATURE file with Module::Signature. This should be done as the
very last step. Running "make signature" will do the signing for you.
* Create a tag for the new version with "git tag".
Example: git tag -u 14964ac8 -m "Version 4.0.1" 4.0.1
* Create a new tarball with "make dist". Sign it: "gpg -ba "
* Put the tarball and detached sig file in the downloads directory on bucardo.org
* Update the wiki pages for the new version: Bucardo/Downloads, Bucardo/Changes
* Update the bucardo/latest_version.txt file on the website.
* Change the topic on #bucardo on irc.freenode.net
* Announce to the bucardo-announce list.
* Post to pgsql-announce if this is a major or important version.
* Post to the "PostgreSQL news"
https://www.postgresql.org/account/news/new/
The content should be roughly the same as the announcement.
* Update the Postgres wiki as needed
https://wiki.postgresql.org/wiki/Bucardo (may be other pages too)
* PostgreSQL weekly news summary
The maintainers of the weekly news are usually pretty good about catching the update
and adding it in. If not, bug them.
http://www.postgresql.org/community/weeklynews/
* Tell Greg to post on PlanetPostgresql.
* On the bucardo.org server:
Put the new tarball and tarball.asc file in place
Update the download page
Update any pages that refer to the latest version
Update the latest_release.txt file
* Add the new version to Bugzilla
* Mention on our Facebook page
=====================
== Tips and Tricks ==
=====================
Also known as, the section to put things that don't fit anywhere else. Anything
that may make life easier for other developers can go here.
To test different versions of Bucardo, set two environment variables
before running the tests:
PGBINDIR: Should be a directory holding Postgres binaries for the version you want,
especially initdb and pg_config.
LD_LIBRARY_PATH: Should point to the "lib" directory of the Postgres version you
want. May not be needed if the currently installed version is close enough
to the one you want to test.
Example:
make clean
export PGBINDIR=/home/greg/code/pg/8.0.26/bin/
export LD_LIBRARY_PATH=/home/greg/code/pg/8.0.26/lib/
prove --blib . t/20-postgres.t
Bucardo-5.4.1/scripts/0000755000175000017500000000000012601643631013223 5ustar greggregBucardo-5.4.1/scripts/check_bucardo_sync0000755000175000017500000001207212074706601016764 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Check the status of Bucardo through the stats page
##
## Copyright 2007 Greg Sabino Mullane
use strict;
use warnings;
use 5.8.0;
use Data::Dumper;
use Getopt::Long;
use File::Temp qw(tempfile);
File::Temp->safe_level( File::Temp::HIGH );
use lib "/usr/local/groundwork/nagios/libexec";
## Avoid the extraordinarily ill-named "utils.pm" from Nagios and do it ourself:
my %ERRORS=('OK'=>0,'WARNING'=>1,'CRITICAL'=>2,'UNKNOWN'=>3,'DEPENDENT'=>4);
my $USAGE =
qq{Usage: $0 --url [-t timeout] \n};
## Plus -d debugfile
my $VERBOSE = 0;
my $VERSION = '1.2';
my $WGET = '/usr/bin/wget';
my %opt;
## Default combined timeout option in seconds for wget
$opt{timeout} = 25;
$opt{verbose} = 0;
GetOptions(\%opt,
'version',
'verbose',
'help',
'url=s',
'timeout=i',
'delta=i',
'track=i',
'debug=s',
);
$opt{version} and print qq{$0 Version $VERSION\n} and exit $ERRORS{'OK'};
$opt{help} and print $USAGE and exit $ERRORS{'OK'};
$opt{url} or print "ERROR: No URL was passed in\n$USAGE" and exit $ERRORS{'UNKNOWN'};
## Special url shortcuts
if ($opt{url} eq 'all') {
$opt{url} = 'http://www.example.com/cgi-bin/bucardo-report?host=all';
}
my $MAX_DELTA = $opt{delta} || 50_000;
my $MAX_TRACK = $opt{track} || 50_000;
## If the url is not in a standard format, prepend 'http://'
my $url = $opt{url};
$url =~ m{^\w+://} or $url = qq{http://$url};
## Attempt to download the page
my ($tempfh, $tempfile);
if ($opt{debug}) {
if (! open $tempfh, '<', $opt{debug}) {
print qq{ERROR: Could not open debug file "$opt{debug}": $!\n};
exit $ERRORS{'WARNING'};
}
}
else {
($tempfh, $tempfile) = tempfile('/tmp/nagios_bucardocheck_XXXXXX', UNLINK => 1, SUFFIX => '.tmp');
my ($errfh, $errfile) = tempfile('/tmp/nagios_bucardocheck_XXXXXX', UNLINK => 1, SUFFIX => '.tmp');
my $COM = qq{$WGET --output-document=$tempfile --output-file=$errfile --timeout=$opt{timeout} "$opt{url}"};
$VERBOSE and warn "Running $COM\n";
system($COM);
my $error = '';
if (-s $errfile) {
my $res = seek $errfh, 0, 0;
{ local $/; $error = <$errfh>; }
if ($error =~ /Host not found/) {
## Mark as a warning because this is not our main job
print qq{ERROR: Could not find the host for "$url"\n};
exit $ERRORS{'WARNING'};
}
## Other common errors?
}
close $errfh or die qq{Could not close temp file $errfile: $!\n};
if (! -s $tempfile) {
print qq{ERROR: Zero-length download for "$url"\n};
exit $ERRORS{'UNKNOWN'};
}
}
seek $tempfh, 0, 0;
## Look for nagios blocks
my $inner=0;
my (%bc,$host);
while (<$tempfh>) {
if (!$inner) {
/Begin Nagios/ and ++$inner;
next;
}
if (/End Nagios/) {
$inner=0;
next;
}
if (/Host: (\w+)/) {
$host=$1;
}
elsif (/(Expired|Overdue|Death): (\d+)/) {
$bc{$host}{lc $1} = $2;
}
elsif (/bucardo_(delta|track) rows: (\d+)/) {
$bc{$host}{$1} = $2;
}
elsif (/(Expired|Overdue|Death) (\w+) \| (\w+) \| (.+)/) {
push @{$bc{$host}{lc$1.'detail'}}, {sync=>$2, target=>$3, time=>$4};
}
}
#print Dumper \%bc;
if (!%bc) {
print qq{ERROR: Nagios information not found\n};
}
my ($wmsg,$emsg,$wdetail,$edetail,$ddetail) = ('','','','','');
my $SEP=' ';
for my $host (sort keys %bc) {
my $B = $bc{$host};
## Check for overdue
if (exists $B->{overdue} and $B->{overdue} > 0) {
$wmsg .= "$host overdue: $B->{overdue} ";
$wdetail .= " $host overdue details: ";
for my $host
(
sort {
$a->{sync} cmp $b->{sync}
or $a->{target} cmp $b->{target}
}
@{$B->{overduedetail}}) {
$wdetail .= "$host->{sync}${SEP}$host->{target}${SEP}$host->{time} ";
}
}
## Check for expired
if (exists $B->{expired} and $B->{expired} > 0) {
$emsg .= "$host expired: $B->{expired} ";
$edetail .= " $host expired details: ";
for my $host
(
sort {
$a->{sync} cmp $b->{sync}
or $a->{target} cmp $b->{target}
}
@{$B->{expireddetail}}) {
$edetail .= "$host->{sync}${SEP}$host->{target}${SEP}$host->{time} ";
}
}
## Check for syncs that are dying
if (exists $B->{death} and $B->{death} > 0) {
$wmsg .= "$host failed syncs: $B->{death} ";
$ddetail .= " $host failure details: ";
if ($B->{deathdetail}) {
for my $host
(
sort {
$a->{sync} cmp $b->{sync}
or $a->{target} cmp $b->{target}
}
@{$B->{deathdetail}}) {
$ddetail .= "$host->{sync}${SEP}$host->{target}${SEP}$host->{time} ";
}
}
else {
$ddetail .= '???';
}
}
## Check for bloat in the support tables
if ($B->{delta} > $MAX_DELTA) {
$wmsg .= "$host bucardo_delta bloat: $B->{delta} ";
}
if ($B->{track} > $MAX_TRACK) {
$wmsg .= "$host bucardo_track bloat: $B->{track} ";
}
}
if (!$wmsg and !$emsg) {
print "All bucardo syncs are running normally\n";
exit $ERRORS{'OK'};
}
print "ERROR: Bucardo $emsg$wmsg$edetail$wdetail$ddetail\n";
$emsg or exit $ERRORS{'WARNING'};
exit $ERRORS{'CRITICAL'};
Bucardo-5.4.1/scripts/bucardo-report0000755000175000017500000015725412427203642016117 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Web-based report on Bucardo activity
##
## Copyright 2007-2009 Greg Sabino Mullane
use strict;
use warnings;
use Data::Dumper;
use IO::Handle;
use DBI;
use CGI;
BEGIN {
my $fingerofblame = 'your_email@example.com';
use CGI::Carp qw(fatalsToBrowser set_message);
set_message("Something went wrong?! Inconceivable! Email $fingerofblame to get 'er fixed.");
use Time::HiRes qw(gettimeofday tv_interval);
use vars qw($scriptstart);
$scriptstart = [gettimeofday()];
};
use vars qw($q @q %q %dbh $dbh $SQL $sth $info $x $cols @cols $t %info);
$q = new CGI; @q = $q->param; undef %q; for (@q) { $q{$_} = $q->param($_); }
for (qw(host showhost db sync syncinfo)) { delete $q{$_}; @{$q{$_}} = $q->param($_); }
my $PORT = $ENV{SERVER_PORT} != 80 ? ":$ENV{SERVER_PORT}" : '';
my $PROTO = $ENV{HTTPS} ? 'https' : 'http';
my $HERE = "$PROTO://$ENV{SERVER_NAME}$PORT$ENV{SCRIPT_NAME}";
my $DONEHEADER = 0;
my $old_q = "freezer.master_q";
my @otherargs = qw(started ended);
my @showargs = qw(showsql showexplain showanalyze daysback);
*STDOUT->autoflush(1);
print "Content-type: text/html\n\n";
my $MAXDAYSBACK = 7;
## Flags to document
## Basic stuff:
## host=
## host=;sync=
## host=;db=
## Most of the above can be combined to appear on one screen, e.g.
## host=;db=db1;db=db2;db=db3
## host=;sync=sync1
## More control:
## host=all - show current status of all known hosts (see )
## showhost= - force a host to be shown even if other args are given
## Detailed information
## host=;syncinfo= Detailed information about a specific sync
## host=;syncinfo=all Detailed information about all sync on a host
## Set with form boxes:
## started - go back in time a certain amount (e.g. 2h20m) or to a time (14:34) or a date (20071212 12:30)
## ended - same as started, but sets upper limit
## limit - maximum number of rows to return
## sort - which column to sort on
## Debugging:
## nonagios - do not produce the hidden nagios output
## shownagios - show the nagios output on the screen
## showsql - show SQL on the screen
## showexplain - show explain plan on the screen
## showanalyze - show explain analyze output on the screen
## hidetime - do not show the "Total time" at the bottom of the screen
## Read in the connection information
my (@dbs,%db,$tempdb);
while () {
next if /^#/ or ! /^([A-Z]+)\s*:\s*(.+)\s*$/;
my ($name,$value) = ($1,$2);
if ('DATABASE' eq $name) {
$tempdb = lc $value;
push @dbs, $tempdb;
}
$db{$tempdb}{$name} = $value;
}
## Common modifiers
my $WHERECLAUSE = '';
my (%where, @adjust, %adjust);
my %int = (s=>'second',m=>'minute','h'=>'hour',d=>'day',n=>'month',y=>'year');
my $validtime = join '|' => values %int, map { "${_}s" } values %int;
$validtime = qr{$validtime}i;
if (exists $q{started}) {
## May be negative offset
if ($q{started} =~ /\-?\d+\s*[smhd]/i) {
## May be multiples
my $time = '';
while ($q{started} =~ /(\d+)\s*([a-z]+)/gi) {
my ($offset,$int) = ($1, length $2>1 ? $2 : $2==1 ? $int{lc $2} : $int{lc $2}."s");
$int = "minutes" if $int eq "min";
$int =~ /^$validtime$/ or &Error("Unknown time period: $int");
$time .= "$offset $int ";
}
chop $time;
$where{started} = "started >= now() - '$time'::interval";
push @adjust, [Started => "-$time"];
$adjust{started} = $time;
}
## May be a simple time HH:MI[:SS]
elsif ($q{started} =~ /^\-?\s*(\d\d:[0123456]\d(?::?[0123456]\d)?)/) {
my $dbh = connect_database($q{host}->[0]);
my $yymmdd = $dbh->selectall_arrayref("select to_char(now(),'YYYYMMDD')")->[0][0];
my $time = "$yymmdd $1";
$where{started} = "started >= '$time'";
push @adjust, [Started => $time];
$adjust{started} = $time;
}
## May be a simple date of YYYYMMDD
elsif ($q{started} =~ /^\s*(\d\d\d\d\d\d\d\d)\s*$/) {
my $time = "$1 00:00";
$where{started} = "started >= '$time'";
push @adjust, [Started => $time];
$adjust{started} = $time;
}
## May be a date of YYYYMMDD HH:MI[:SS]
elsif ($q{started} =~ /^\s*(\d\d\d\d\d\d\d\d)\s+(\d\d?:[0123456]\d(?::?[0123456]\d)?)/) {
my $time = "$1 $2";
$where{started} = "started >= '$time'";
push @adjust, [Started => $time];
$adjust{started} = $time;
}
}
if (exists $where{started}) {
$WHERECLAUSE = "WHERE $where{started}";
}
if (exists $q{ended}) {
if ($q{ended} =~ /\-?\d+\s*[smhd]/i) {
my $time = '';
while ($q{ended} =~ /(\d+)\s*([a-z]+)/gi) {
my ($offset,$int) = ($1, length $2>1 ? $2 : $2==1 ? $int{lc $2} : $int{lc $2}."s");
$int = "minutes" if $int eq "min";
$int =~ /^$validtime$/ or &Error("Unknown time period: $int");
$time .= "$offset $int ";
}
chop $time;
$where{ended} = "started <= now() - '$time'::interval";
push @adjust, [Ended => "$time"];
$adjust{ended} = $time;
}
## May be a simple time HH:MI[:SS]
elsif ($q{ended} =~ /^\-?\s*(\d\d?:[0123456]\d(?::?[0123456]\d)?)/) {
my $dbh = connect_database($q{host}->[0]);
my $yymmdd = $dbh->selectall_arrayref("select to_char(now(),'YYYYMMDD')")->[0][0];
my $time = "$yymmdd $1";
$where{ended} = "started <= '$time'";
push @adjust, [Ended => $time];
$adjust{ended} = $time;
}
## May be a simple date of YYYYMMDD
elsif ($q{ended} =~ /^\s*(\d\d\d\d\d\d\d\d)\s*$/) {
my $time = "$1 00:00";
$where{ended} = "started >= '$time'";
push @adjust, [Ended => $time];
$adjust{ended} = $time;
}
## May be a date of YYYYMMDD HH:MI[:SS]
elsif ($q{ended} =~ /^\s*(\d\d\d\d\d\d\d\d)\s+(\d\d?:[0123456]\d(?::?[0123456]\d)?)/) {
my $time = "$1 $2";
$where{ended} = "started >= '$time'";
push @adjust, [Ended => $time];
$adjust{ended} = $time;
}
}
if (exists $where{ended}) {
$WHERECLAUSE .= $WHERECLAUSE ? " AND $where{ended}" : " WHERE $where{ended}";
}
$WHERECLAUSE and $WHERECLAUSE .= "\n";
my $DEFLIMIT = 300;
my $LIMIT = $DEFLIMIT;
if (exists $q{limit} and $q{limit} =~ /^\d+$/) {
$LIMIT = $q{limit};
$adjust{limit} = $q{limit};
## Keep this last
push @adjust, ['Maximum rows to pull' => $q{limit}];
}
my $SQLSTART =
qq{ sync,targetdb,
COALESCE(to_char(started, 'DDMon HH24:MI:SS'::text), '???'::text) AS started2,
COALESCE(to_char(ended, 'HH24:MI:SS'::text), '???'::text) AS ended2,
COALESCE(to_char(aborted, 'HH24:MI:SS'::text), ''::text) AS aborted2,
CASE WHEN aborted IS NOT NULL THEN to_char(aborted - started, 'MI:SS'::text) ELSE ''::text END AS atime,
CASE WHEN inserts IS NOT NULL THEN to_char(ended - started, 'MI:SS'::text) ELSE ''::text END AS runtime,
inserts, updates, deletes, COALESCE(whydie,'') AS whydie, pid, ppid,
started, ended, aborted, ended-started AS endinterval, aborted-started AS abortinterval,
extract(epoch FROM ended) AS endedsecs,
extract(epoch FROM started) AS startedsecs,
extract(epoch FROM aborted) AS abortedsecs,
extract(epoch FROM aborted-started) AS atimesecs,
extract(epoch FROM ended-started) AS runtimesecs,
CASE
WHEN started IS NULL THEN '? '
WHEN now()-ended <= '1 minute'::interval THEN ceil(extract(epoch FROM now()-ended))::text || 's'
WHEN now()-ended <= '100 minutes'::interval THEN ceil(extract(epoch FROM now()-ended)/60)::text || ' m'
WHEN now()-ended > '24 hours'::interval THEN ceil(extract(epoch FROM now()-ended)/60/60/24)::text || ' Days'
ELSE ceil(extract(epoch FROM now()-ended)/60/60)::text || ' h'
END AS minutes,
floor(CASE
WHEN ENDED IS NOT NULL THEN extract(epoch FROM now()-ended)
WHEN ABORTED IS NOT NULL THEN extract(epoch FROM now()-aborted)
WHEN STARTED IS NOT NULL THEN extract(epoch FROM now()-started)
ELSE extract(epoch FROM now()-cdate)
END) AS age
};
my $found=0;
## View one or more databases
if (@{$q{db}}) {
if (! @{$q{host}}) {
## Must have a host, unless there is only one
my $count = keys %db;
1==$count or &Error("Must specify a host");
}
for my $host (@{$q{host}}) {
for my $database (@{$q{db}}) {
&showdatabase($host,$database); $found++;
}
}
}
## View one or more syncs
if (@{$q{sync}}) {
if (! @{$q{host}}) {
## Must have a host, unless there is only one
my $count = keys %db;
1==$count or &Error("Must specify a host");
}
for my $host (@{$q{host}}) {
for my $sync (@{$q{sync}}) {
&showsync($host,$sync); $found++;
}
}
}
## View meta-information about a sync
if (@{$q{syncinfo}}) {
my @hostlist;
if (! @{$q{host}}) {
## Must have a host, unless there is only one
my $count = keys %db;
1==$count or &Error("Must specify a host");
push @hostlist, keys %db;
}
elsif (1==@{$q{host}} and $q{host}->[0] eq 'all') {
@hostlist = sort keys %db;
}
else {
@hostlist = @{$q{host}};
}
for my $host (@hostlist) {
next if $db{$host}{SKIP};
if (1==@{$q{syncinfo}} and $q{syncinfo}->[0] eq 'all') {
$dbh = connect_database($host);
$SQL = "SELECT name FROM bucardo.sync ORDER BY name WHERE status = 'active'";
for my $sync (@{$dbh->selectall_arrayref($SQL)}) {
&showsyncinfo($host,$sync->[0]); $found++;
}
}
else {
for my $sync (@{$q{syncinfo}}) {
&showsyncinfo($host,$sync); $found++;
}
}
}
}
## Don't show these if part of another query
if (exists $q{host} and !$found) {
## Hope nobody has named their host "all"
if (1==@{$q{host}} and $q{host}->[0] eq 'all') {
for (@dbs) {
&showhost($_); $found++;
}
}
else {
for (@{$q{host}}) {
&showhost($_); $found++;
}
}
}
## But they can be forced to show:
elsif (exists $q{showhost}) {
for (@{$q{showhost}}) {
&showhost($_); $found++;
}
}
if (!$found or exists $q{overview}) {
## Default action:
&Header("Bucardo stats");
print qq{
\n};
}
}
&Footer();
sub showhost {
my $host = shift;
exists $db{$host} or &Error("Unknown database: $host");
my $d = $db{$host};
return if $d->{SKIP};
&Header("Bucardo stats for $d->{DATABASE}");
my $maxdaysback = (exists $q{daysback} and $q{daysback} =~ /^\d$/) ? $q{daysback} : $MAXDAYSBACK;
## Connect to the main database to check on the health
$info{dcount} = '?'; $info{tcount} = '?';
unless ($q{norowcount}) {
$dbh = connect_database($host."_real");
$SQL = "SELECT 1,count(*) FROM bucardo.bucardo_delta UNION ALL SELECT 2,count(*) FROM bucardo.bucardo_track ORDER BY 1";
$info = $dbh->selectall_arrayref($SQL);
$info{dcount} = $info->[0][1];
$info{tcount} = $info->[1][1];
$dbh->disconnect();
}
print qq{
\n};
## Gather all sync information
$dbh = connect_database($host);
$SQL = "SELECT *, extract(epoch FROM checktime) AS checksecs, ".
"extract(epoch FROM overdue) AS overduesecs, ".
"extract(epoch FROM expired) AS expiredsecs ".
"FROM bucardo.sync";
$sth = $dbh->prepare($SQL);
$sth->execute();
my $sync = $sth->fetchall_hashref('name');
## Gather all database group information
$SQL = "SELECT dbgroup,db,priority FROM bucardo.dbmap ORDER BY dbgroup, priority, db";
my $dbg;
my $order = 1;
my $oldgroup = '';
for my $row (@{$dbh->selectall_arrayref($SQL)}) {
if ($oldgroup ne $row->[0]) {
$order = 0;
}
$dbg->{$row->[0]}{$row->[1]} = {order=>$order++, pri=>$row->[2]};
}
## Put the groups into the sync structure
for my $s (values %$sync) {
$s->{running} = undef;
if (defined $s->{targetgroup}) {
my $x = $dbg->{$s->{targetgroup}};
for my $t (keys %$x) {
for my $t2 (keys %{$x->{$t}}) {
$s->{dblist}{$t}{$t2} = $x->{$t}{$t2};
}
}
}
else {
$s->{dblist}{$s->{targetdb}} = {order=>1, pri=>1};
}
}
## Grab any that are queued but not started for each sync/target combo
$SQL = "SELECT $SQLSTART FROM (SELECT * FROM bucardo.q ".
"NATURAL JOIN (SELECT sync, targetdb, max(ended) AS ended FROM bucardo.q ".
"WHERE started IS NULL GROUP BY 1,2) q2) AS q3";
$sth = $dbh->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
$sync->{ $row->{sync} }{ dblist }{ $row->{targetdb} }{queued} = $row;
}
## Grab any that are currently in progress
$SQL = "SELECT $SQLSTART FROM (SELECT * FROM bucardo.q ".
"NATURAL JOIN (SELECT sync, targetdb, max(ended) AS ended FROM bucardo.q ".
"WHERE started IS NOT NULL and ENDED IS NULL GROUP BY 1,2) q2) AS q3";
$sth = $dbh->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
$sync->{ $row->{sync} }{ dblist }{ $row->{targetdb} }{current} = $row;
}
## Grab the last successful
$SQL = "SELECT $SQLSTART FROM (SELECT * FROM bucardo.q ".
"NATURAL JOIN (SELECT sync, targetdb, max(ended) AS ended FROM bucardo.q ".
"WHERE ended IS NOT NULL AND aborted IS NULL GROUP BY 1,2) q2) AS q3";
$sth = $dbh->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
$sync->{$row->{sync}}{dblist}{$row->{targetdb}}{success} = $row;
}
## Grab the last aborted
$SQL = "SELECT $SQLSTART FROM (SELECT * FROM bucardo.q ".
"NATURAL JOIN (SELECT sync, targetdb, max(ended) AS ended FROM bucardo.q ".
"WHERE aborted IS NOT NULL GROUP BY 1,2) q2) AS q3";
$sth = $dbh->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
$sync->{ $row->{sync} }{ dblist }{ $row->{targetdb} }{aborted} = $row;
}
## While we don't have all syncs, keep going backwards
my $TSQL = "SELECT $SQLSTART FROM (SELECT * FROM freezer.child_q_DATE ".
"NATURAL JOIN (SELECT sync, targetdb, max(ended) AS ended FROM freezer.child_q_DATE ".
"WHERE CONDITION GROUP BY 1,2) AS q2) AS q3";
my $done = 0;
my $daysback = 0;
WAYBACK: {
## Do we have all sync information yet?
## We want to find either 'success' or 'aborted' for each sync/target combo
$done = 1;
SYNC: for my $s (keys %$sync) {
next if $sync->{$s}{status} ne 'active';
my $list = $sync->{$s}{dblist};
for my $t (keys %$list) {
if (!exists $list->{$t}{success} and ! exists $list->{$t}{aborted}) {
$done = 0;
last SYNC;
}
}
} ## end check syncs
last WAYBACK if $done;
## Grab aborted runs from this time period
$SQL = "SELECT TO_CHAR(now()- interval '$daysback days', 'YYYYMMDD')";
my $date = $dbh->selectall_arrayref($SQL)->[0][0];
($SQL = $TSQL) =~ s/DATE/$date/g;
$SQL =~ s/CONDITION/aborted IS NOT NULL/;
$sth = $dbh->prepare($SQL);
eval {
$sth->execute();
};
if ($@) {
if ($@ =~ /relation .+ does not exist/) {
last WAYBACK;
}
die $@;
}
for my $row (@{$sth->fetchall_arrayref({})}) {
$sync->{ $row->{sync} }{ dblist }{ $row->{targetdb} }{aborted} = $row
if exists $sync->{$row->{sync}}{dblist}{$row->{targetdb}}
and ! exists $sync->{$row->{sync}}{dblist}{$row->{targetdb}}{aborted};
}
## Grab succesful runs from this time period
$SQL = "SELECT TO_CHAR(now()- interval '$daysback days', 'YYYYMMDD')";
$date = $dbh->selectall_arrayref($SQL)->[0][0];
($SQL = $TSQL) =~ s/DATE/$date/g;
$SQL =~ s/CONDITION/ended IS NOT NULL AND aborted IS NULL/;
$sth = $dbh->prepare($SQL);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
$sync->{ $row->{sync} }{ dblist }{ $row->{targetdb} }{success} = $row
if exists $sync->{$row->{sync}}{dblist}{$row->{targetdb}}
and ! exists $sync->{$row->{sync}}{dblist}{$row->{targetdb}}{success};
}
last if $daysback >= $maxdaysback;
$daysback++;
redo;
} ## end of WAYBACK
## Quick count of problems for nagios
unless ($q{nonagios}) {
my %problem = (overdue => 0, expired => 0, death=>0);
my (@odetail,@edetail,@death);
for my $s (sort keys %$sync) {
next if $sync->{$s}{expiredsecs} == 0;
for my $t (sort {
$sync->{$s}{dblist}{$a}{order} <=> $sync->{$s}{dblist}{$b}{order}
} keys %{$sync->{$s}{dblist}}) {
my $x = $sync->{$s}{dblist}{$t};
my $sc = $x->{success}; ## may be undef
if (! defined $sc or ! exists $sc->{minutes}) {
$x->{expired} = 2;
$problem{expired}++;
push @edetail, "Expired $s | $t | ?\n";
next;
}
(my $shortmin = $sc->{minutes}) =~ s/\s//g;
## We have an age
if ($sc->{age} > $sync->{$s}{expiredsecs}) {
$x->{expired} = 1;
$problem{expired}++;
push @edetail, "Expired $s | $t | $shortmin\n";
}
elsif ($sc->{age} > $sync->{$s}{overduesecs}) {
$x->{overdue} = 1;
$problem{overdue}++;
push @odetail, "Overdue $s | $t | $shortmin\n";
}
if (length $sc->{whydie}) {
$x->{death} = 1;
$problem{death}++;
(my $flatdie = $sc->{whydie}) =~ s/\n/ /g;
push @death, "Death $s | $t | $flatdie\n";
}
}
}
print $q{shownagios} ? "
\n";
} ## end of D
sub runsql {
my $arg = shift;
my $SQL = $arg->{sql};
my $dbh = $arg->{dbh};
$sth = $dbh->prepare($SQL);
my $querystart = [gettimeofday()];
$sth->execute();
my $querytime = tv_interval($querystart);
my $fetchstart = [gettimeofday()];
$info = $sth->fetchall_arrayref({});
my $fetchtime = tv_interval($fetchstart);
if ($q{showsql}) {
print qq{
\n";
}
my $time = $dbh->selectall_arrayref("select to_char(now(),'DDMon HH24:MI:SS')")->[0][0];
print qq{};
return $info;
} ## end of runsql
sub showdatabase {
my ($host,$name) = @_;
exists $db{$host} or &Error("No such host: $host");
my $d = $db{$host};
&Header("$d->{DATABASE} Bucardo stats for target database $name");
print qq{
\n";
} ## end of showdatabase
sub showsync {
my ($host,$name) = @_;
exists $db{$host} or &Error("No such host: $host");
my $d = $db{$host};
&Header("$d->{DATABASE} Bucardo stats for sync $name");
## Default order by
my $OCOL = 2;
my $ODIR = $where{started} ? "ASC" : "DESC";
if (exists $q{sort} and $q{sort} =~ /^(\-?)(\d+)$/) {
$OCOL = $2;
$ODIR = (length $1 ? "DESC" : "ASC");
}
my $OCOL2 = $OCOL;
$OCOL2 = "started" if 2 == $OCOL;
$OCOL2 = "ended" if 3 == $OCOL;
$OCOL2 = "aborted" if 4 == $OCOL;
$dbh = connect_database($host);
## Quick check that this is a valid sync
$SQL = "SELECT * FROM bucardo.sync WHERE name = ?";
$sth = $dbh->prepare($SQL);
my $count = $sth->execute($name);
if ($count eq '0E0') {
&Error("That sync does not exist");
}
my $syncinfo = $sth->fetchall_arrayref({})->[0];
printf qq{
%sBucardo sync "%s"\n},
"$HERE?host=$host", $d->{DATABASE}, $HERE, "$HERE?host=$host;syncinfo=$name", $name;
my $space = ' ' x 10;
my $mouseover = qq{onmouseover="showgoat('info',+50)"};
my $mouseout = qq{onmouseout="hidegoat('info')"};
print qq{$space$space$space quickinfo $space$space
\n};
my $INFO = '';
for (sort keys %$syncinfo) {
next if ! defined $syncinfo->{$_} or ! length $syncinfo->{$_};
if ($_ eq 'conflict_code') {
$syncinfo->{conflict_code} = '(NOT SHOWN)';
}
$INFO .= qq{$_: $syncinfo->{$_} };
}
print qq{
$INFO
};
my $daysback = $q{daysback} || $d->{DAYSBACKSYNC} || 7;
$daysback =~ /^\d+$/ or &Error("Invalid number of days");
$SQL = "SELECT TO_CHAR(now()-'$daysback days'::interval, 'DD FMMonth YYYY')";
my $earliest = $dbh->selectall_arrayref($SQL)->[0][0];
my $oldwhere = " WHERE sync=\$1 AND cdate >= '$earliest'";
$SQL = $d->{SINGLE} ?
qq{SELECT
synctype,
$SQLSTART
FROM (SELECT * FROM bucardo.q WHERE sync=\$1 UNION ALL SELECT * FROM bucardo.$old_q $oldwhere) q
${WHERECLAUSE}ORDER BY $OCOL2 $ODIR, 1 ASC
LIMIT $LIMIT} :
qq{SELECT
targetdb,
$SQLSTART
FROM (SELECT * FROM bucardo.q WHERE sync=\$1 UNION ALL SELECT * FROM bucardo.$old_q $oldwhere) q
${WHERECLAUSE}ORDER BY $OCOL2 $ODIR, 1 ASC
LIMIT $LIMIT};
$SQL =~ s/\$1/$dbh->quote($name)/ge;
$info = runsql({dbh => $dbh, sql => $SQL, hidden => {host=>$host,sync=>$name}});
$cols = q{
Started
Ended
Aborted
Atime
Runtime
Inserts
Updates
Deletes
Whydie
};
@cols = map { s/^\s+//; $_ } grep /\w/ => split /\n/ => $cols;
unshift @cols, $d->{SINGLE} ? ('Sync type') : ('Database');
my $otherarg = '';
if ($LIMIT != $DEFLIMIT) {
$otherarg .= qq{;limit=$LIMIT};
}
for (@otherargs, @showargs) {
if (exists $q{$_} and length $q{$_}) {
$otherarg .= qq{;$_=$q{$_}};
}
}
for ($x=1; $cols[$x-1]; $x++) {
if (!@$info) {
print qq{$cols[$x-1]\n};
}
else {
my $c = 't0';
if ($x != $OCOL) {
print qq{$cols[$x-1]\n};
}
elsif ($ODIR eq "ASC") {
print qq{$cols[$x-1] ^\n};
}
else {
print qq{$cols[$x-1] v\n};
}
}
}
print qq{};
$t = "t2";
for (@$info) {
$t = $t eq "t1" ? "t2" : "t1";
print qq{};
if ($d->{SINGLE}) {
print qq{$_->{synctype}\n};
}
else {
print qq{$_->{targetdb}\n};
}
my $whydie = length $_->{whydie} ? "PID: $_->{pid} PPID: $_->{ppid} $_->{whydie}" : '';
print qq{
$_->{started2}
$_->{ended2}
$_->{aborted2}
$_->{atime}
$_->{runtime}
$_->{inserts}
$_->{updates}
$_->{deletes}
$whydie
};
}
print "\n";
} ## end of showsync
sub showsyncinfo {
my ($host,$name) = @_;
exists $db{$host} or &Error("No such host: $host");
my $d = $db{$host};
&Header("$d->{DATABASE} Bucardo information on sync $name");
printf qq{
\n},
"$HERE?host=$host", $d->{DATABASE}, $HERE, $name, "$HERE?host=$host;sync=$name";
$dbh = connect_database($host);
if (! exists $info{$host}{syncinfo}) {
$SQL = "SELECT * FROM bucardo.sync";
$sth = $dbh->prepare($SQL);
$sth->execute();
$info{$host}{syncinfo} = $sth->fetchall_hashref('name');
}
if (! exists $info{$host}{syncinfo}{$name}) {
&Error("Sync not found: $name");
}
$info = $info{$host}{syncinfo}{$name};
## Grab all herds if not loaded
if (! exists $info{$host}{herds} ) {
$SQL = qq{
SELECT *
FROM bucardo.herdmap h, bucardo.goat g
WHERE g.id = h.goat
ORDER BY priority DESC, tablename ASC
};
$sth = $dbh->prepare_cached($SQL);
$sth->execute();
$info{$host}{herds} = $sth->fetchall_arrayref({});
}
## Get the goats for this herd:
my @goats = grep { $_->{herd} eq $info->{source} } @{$info{$host}{herds}};
my $goatinfo = qq{Goats in herd $info->{source}:};
for (@goats) {
$goatinfo .= sprintf qq{ $_->{tablename}%s%s},
$_->{ghost} ? " GHOST!" : '',
$_->{pkey} ? " (pkey: $_->{pkey})" : '';
}
my $target = qq{Target database:$info->{targetdb}};
if ($info->{targetgroup}) {
my $t = $info->{targetgroup};
if (! exists $info{$host}{dbs}{$t}) {
$SQL = "SELECT dm.db FROM bucardo.dbmap dm JOIN bucardo.db db ON db.name = dm.db WHERE dm.dbgroup = ? AND db.status = 'active' ORDER BY dm.priority DESC, dm.db ASC";
$sth = $dbh->prepare_cached($SQL);
$sth->execute($t);
$info{$host}{dbs}{$t} = $sth->fetchall_arrayref({});
}
my $dbinfo = "Databases in group $t:";
for (@{$info{$host}{dbs}{$t}}) {
$dbinfo .= " $_->{db}";
}
$target = qq{Target database group:};
$target .= qq{
$dbinfo
$t};
}
print qq{\n};
$x = $info->{name};
for (qw(ping kidsalive stayalive)) {
$info->{"YN$_"} = $info->{$_} ? "Yes" : "No";
}
my $fullcopy = '';
if ($info->{synctype} eq 'fullcopy') {
$fullcopy = qq{};
}
my $delta = '';
if ($info->{synctype} ne 'fullcopy') {
$delta = qq{};
}
print qq{
$delta
$fullcopy
};
print "
Delete method:
$info->{deletemethod}
Ping:
$info->{YNping}
Sync name:
$info->{name}
Status:
$info->{status}
Sync type:
$info->{synctype}
Source:
$goatinfo
$info->{source}
$target
Check time:
$info->{checktime}
Overdue limit:
$info->{overdue}
Expired limit:
$info->{expired}
Controller stays alive:
$info->{YNstayalive}
Kids stay alive:
$info->{YNkidsalive}
Priority:
$info->{priority}
\n";
} ## end of showsyncinfo
sub Header {
return if $DONEHEADER++;
my $title = shift || "Bucardo Stats";
print qq{
$title
};
} ## end of Header
sub Footer_Summary {
my $scripttime = tv_interval($scriptstart);
unless ($q{hidetime}) {
printf "
Total time: %.2f", $scripttime;
if (exists $info{dcount}) {
print " Rows in bucardo_delta: $info{dcount} Rows in bucardo_track: $info{tcount}";
}
print "
";
}
}
sub Footer {
print "\n";
exit;
} ## end of Footer
sub connect_database {
my $name = shift;
if (!exists $db{$name}) {
&Error("No such database: $name");
}
if (exists $dbh{$name}) {
return $dbh{$name};
}
my $d = $db{$name};
$dbh = DBI->connect_cached($d->{DSN},$d->{DBUSER},$d->{DBPASS}, {AutoCommit=>0,RaiseError=>1,PrintError=>0});
$dbh{$name} = $dbh;
## Be explicit: this is okay for this particular script
$dbh->{AutoCommit} = 1;
$dbh->do("SET statement_timeout = 0");
$dbh->do("SET constraint_exclusion = 'on'");
$dbh->do("SET random_page_cost = 1.2");
return $dbh;
} ## end of connect_database
sub Error {
my $msg = shift;
my $line = (caller)[2];
&Header("Error");
print qq{
Bucardo stats error
\n};
print qq{
$msg
\n};
&Footer();
}
__DATA__
## List each database you want to monitor here
## Format is NAME: VALUE
## DATABASE: Name of the database, will appear in the headers
## DSN: Connection information string.
## DBUSER: Who to connect as
## DBPASS: Password to connect with
## SINGLE: Optional, set to target database if that is the only one
## SKIP: Used for row counts, do not list anywhere
DATABASE: SampleDB1
DSN: dbi:Pg:database=bucardo;port=5432;host=sample1.example.com
DBUSER: bucardo_readonly
DBPASS: foobar
SINGLE: otherdb
DAYSBACK: 2
DAYSBACKSYNC: 3
DATABASE: OtherDB
DSN: dbi:Pg:database=bucardo;port=5432;host=sample2.example.com
DBUSER: bucardo_readonly
DBPASS: foobar
DAYSBACK: 5
DAYSBACKSYNC: 30
DAYSBACKDB: 30
Bucardo-5.4.1/scripts/README0000644000175000017500000000035512427203642014106 0ustar greggregThis directory contains various helper scripts.
* bucardo-report
Web-based report on Bucardo activity
* bucardo_rrd
Grab a bunch of Bucardo stats for cacti
* check_bucardo_sync
Check the status of Bucardo through the stats page
Bucardo-5.4.1/scripts/bucardo_rrd0000755000175000017500000001270312074706601015443 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Grab a bunch of Bucardo stats for cacti
##
## Copyright 2007 Greg Sabino Mullane
use strict;
use warnings;
use DBI;
our $VERSION = '1.0.1';
my $DBUSER = 'bucardo_readonly';
my $DBOPT = {AutoCommit=>0,RaiseError=>1,PrintError=>0};
my $verbose = 0;
my $dbh =
{
dbname1 => DBI->connect('dbi:Pg:dbname=dbname1', $DBUSER, '', $DBOPT),
bucardo => DBI->connect('dbi:Pg:dbname=bucardo', $DBUSER, '', $DBOPT),
};
## Specialized due to constraint exclusion funkiness:
my $minutesback = 5;
my $SQL = "SELECT now()-'$minutesback minutes'::interval";
my $ARG =
{
TS => $dbh->{bucardo}->selectall_arrayref($SQL)->[0][0],
};
$dbh->{bucardo}->do('SET constraint_exclusion = true');
my $info = {};
my $query;
my $db;
my @q;
while () {
next if /^\s*#/ or /^\s*$/;
if (/^DB:(\w+)/) {
my $newdb = $1;
push @q, [$db,$query] if defined $query;
$db = $newdb;
$query = '';
}
else {
$query .= $_;
}
}
push @q, [$db,$query] if defined $query and length $query;
for (@q) {
my ($db,$sql) = @$_;
chomp $sql;
$sql =~ s/ARG{(\w+)}/$ARG->{$1}/ge;
$verbose and warn "SQL: -->$sql<--\n";
my $sth = $dbh->{$db}->prepare($sql);
$sth->execute();
for my $row (@{$sth->fetchall_arrayref({})}) {
for my $key (keys %$row) {
$info->{$key} = $row->{$key};
}
last;
}
}
## Aggregate some info
$info->{swap_rows} = $info->{swap_inserts} + $info->{swap_updates} + $info->{swap_deletes};
$info->{total_rows} = $info->{swap_rows} + $info->{fullcopy_rows} + $info->{pushdelta_rows};
$info->{total_syncs} = $info->{swap_syncs} + $info->{fullcopy_syncs} + $info->{pushdelta_syncs};
## Track each type of abort error
$query = qq{
SELECT whydie
FROM bucardo.q
WHERE cdate >= '$ARG->{TS}'
AND aborted IS NOT NULL
UNION ALL
SELECT whydie
FROM freezer.master_q
WHERE cdate >= '$ARG->{TS}'
AND aborted IS NOT NULL
};
my %abort;
for (qw/ deadlock serialize route killed unknown/) {
$abort{$_} = 0;
}
$info->{aborts} = 0;
for my $row (@{$dbh->{bucardo}->selectall_arrayref($query)}) {
my $reason = $row->[0];
$info->{aborts}++;
$reason ||= '';
if ($reason =~ /deadlock/) {
$abort{deadlock}++;
}
elsif ($reason =~ /could not serialize/) {
$abort{serialize}++;
}
elsif ($reason =~ /route to host/) {
$abort{route}++;
}
elsif ($reason =~ /unexpectedly/) {
$abort{killed}++;
}
else {
$abort{unknown}++;
}
}
for (keys %abort) {
$info->{"abort_$_"} = $abort{$_};
}
for (values %$dbh) { $_->disconnect(); }
my $string = join ' ' => map { "$_:$info->{$_}" } sort keys %$info;
print "$string\n";
exit;
__DATA__
## Format: DB:database\ncommand
## Order is important
## Number of delta rows awaitin'
DB:bcs
SELECT count(*) AS deltarows FROM bucardo.bucardo_delta
## Number of track rows awaitin'
DB:bcs
SELECT count(*) AS trackrows FROM bucardo.bucardo_track
## Number of transactions yet to be synced
DB:bcs
SELECT count(distinct txntime) AS deltatxns FROM bucardo.bucardo_delta
## Number of swap inserts, updates, deletes in the last 5 minutes
DB:bucardo
SELECT coalesce(qi,0)+coalesce(fi,0) AS swap_inserts,
coalesce(qd,0)+coalesce(fd,0) AS swap_deletes,
coalesce(qu,0)+coalesce(fu,0) AS swap_updates
FROM
(SELECT sum(inserts) AS qi, sum(updates) AS qu, sum(deletes) AS qd FROM bucardo.q
WHERE cdate >= 'ARG{TS}' AND synctype = 'swap') AS a,
(SELECT sum(inserts) AS fi, sum(updates) AS fu, sum(deletes) AS fd FROM freezer.master_q
WHERE cdate >= 'ARG{TS}' AND synctype = 'swap') AS b;
## Number of fullcopy rows (always inserts) in last 5 minutes
DB:bucardo
SELECT coalesce(x,0)+coalesce(y,0) AS fullcopy_rows
FROM
(SELECT sum(inserts) AS x FROM bucardo.q
WHERE cdate >= 'ARG{TS}' AND synctype = 'fullcopy') AS a,
(SELECT sum(inserts) AS y FROM freezer.master_q
WHERE cdate >= 'ARG{TS}' AND synctype = 'fullcopy') AS b;
## Number of pushdelta rows (always inserts) in last 5 minutes
DB:bucardo
SELECT coalesce(x,0)+coalesce(y,0) AS pushdelta_rows
FROM
(SELECT sum(inserts) AS x FROM bucardo.q
WHERE cdate >= 'ARG{TS}' AND synctype = 'pushdelta') AS a,
(SELECT sum(inserts) AS y FROM freezer.master_q
WHERE cdate >= 'ARG{TS}' AND synctype = 'pushdelta') AS b;
## Number of swap syncs run in the last 5 minutes
DB:bucardo
SELECT x+y AS swap_syncs
FROM
(SELECT count(*) AS x
FROM bucardo.q
WHERE cdate >= 'ARG{TS}'
AND synctype = 'swap'
AND ended IS NOT NULL) AS a,
(SELECT count(*) AS y
FROM freezer.master_q
WHERE cdate >= 'ARG{TS}'
AND synctype = 'swap'
AND ended IS NOT NULL) AS b
## Number of fullcopy syncs run in the last 5 minutes
DB:bucardo
SELECT x+y AS fullcopy_syncs
FROM
(SELECT count(*) AS x
FROM bucardo.q
WHERE cdate >= 'ARG{TS}'
AND synctype = 'fullcopy'
AND ended IS NOT NULL) AS a,
(SELECT count(*) AS y
FROM freezer.master_q
WHERE cdate >= 'ARG{TS}'
AND synctype = 'fullcopy'
AND ended IS NOT NULL) AS b
## Number of swap sync run in the last 5 minutes
DB:bucardo
SELECT x+y AS pushdelta_syncs
FROM
(SELECT count(*) AS x
FROM bucardo.q
WHERE cdate >= 'ARG{TS}'
AND synctype = 'pushdelta'
AND ended IS NOT NULL) AS a,
(SELECT count(*) AS y
FROM freezer.master_q
WHERE cdate >= 'ARG{TS}'
AND synctype = 'pushdelta'
AND ended IS NOT NULL) AS b
## Number of PIDs created in last 5 minutes
DB:bucardo
SELECT count(*) AS pids
FROM bucardo.audit_pid WHERE birthdate >= 'ARG{TS}'
Bucardo-5.4.1/scripts/slony_migrator.pl0000755000175000017500000012274112427203642016642 0ustar greggreg#!/usr/bin/env perl
# -*-mode:cperl; indent-tabs-mode: nil-*-
## Slony migrator
##
## Greg Sabino Mullane , Joshua Tolley
## End Point Corporation http://www.endpoint.com/
## BSD licensed, see complete license at bottom of this script
## The latest version can be found in the Bucardo distribution at:
## http://www.bucardo.org/
##
## See the HISTORY section for other contributors
package slony_migrator;
use 5.006001;
use strict;
use warnings;
use Getopt::Long qw/GetOptions/;
Getopt::Long::Configure(qw/no_ignore_case/);
use File::Basename qw/basename/;
use File::Temp qw/tempfile tempdir/;
File::Temp->safe_level( File::Temp::MEDIUM );
use Cwd;
use Data::Dumper qw/Dumper/;
$Data::Dumper::Varname = 'SLONY';
$Data::Dumper::Indent = 2;
$Data::Dumper::Useqq = 1;
our $VERSION = '0.0.3';
use vars qw/ %opt $PSQL $res $COM $SQL $db /;
## If psql is not in your path, it is recommended that hardcode it here,
## as an alternative to the --PSQL option
$PSQL = '';
our $SLONIK = 'slonik';
## If this is true, $opt{PSQL} is disabled for security reasons
our $NO_PSQL_OPTION = 1;
## If true, we show how long each query took by default. Requires Time::HiRes to be installed.
$opt{showtime} = 0;
## Which user to connect as if --dbuser is not given
$opt{defaultuser} = 'postgres';
## Default time display format, used for last_vacuum and last_analyze
our $SHOWTIME = 'HH24:MI FMMonth DD, YYYY';
## Nothing below this line should need to be changed for normal usage.
## If you do find yourself needing to change something,
## please email the author as it probably indicates something
## that could be made into a command-line option or moved above.
our $ME = basename($0);
our $ME2 = 'slony_migrator.pl';
our $USAGE = qq{\nUsage: $ME \n Try "$ME --help" for a complete list of options\n\n};
## Global error string, mostly used for MRTG error handling
our $ERROR = '';
## For options that take a time e.g. --critical="10 minutes" Fractions are allowed.
our $timere = qr{^\s*(\d+(?:\.\d+)?)\s*(\w*)\s*$}i;
$opt{test} = 0;
$opt{timeout} = 10;
die $USAGE unless
GetOptions(
\%opt,
'version|V',
'verbose|v+',
'help|h',
'host|H=s@',
'port=s@',
'dbname|db=s@',
'dbuser|u=s@',
'dbpass=s@',
'timeout=i',
'PSQL=s',
'slonyschema=s',
'slonyset=i',
'slonik',
'bucardo',
'check',
)
and keys %opt
and ! @ARGV;
our $VERBOSE = $opt{verbose} || 0;
$VERBOSE >= 3 and warn Dumper \%opt;
if ($opt{version}) {
print qq{$ME2 version $VERSION\n};
exit 0;
}
if ($opt{help}) {
print qq{Usage: $ME2
Slony Migrator
This is version $VERSION.
Main functional options:
--bucardo print commands to migrate this Slony cluster to Bucardo replication
--slonik print slonik scripts to recreate this Slony cluster
Common connection options:
-H, --host=NAME hostname(s) to connect to; defaults to none (Unix socket)
-p, --port=NUM port(s) to connect to; defaults to 5432.
-db, --dbname=NAME database name(s) to connect to; defaults to 'postgres' or 'template1'
-u --dbuser=NAME database user(s) to connect as; defaults to 'postgres'
--dbpass=PASS database password(s); use a .pgpass file instead when possible
Other options:
--PSQL=FILE location of the psql executable; avoid using if possible
-v, --verbose verbosity level; can be used more than once to increase the level
-h, --help display this help information
-t X, --timeout=X how long in seconds before we timeout. Defaults to 10 seconds.
--check sanity checks the schema (experimental)
For a complete list of options and full documentation, please view the POD for this file.
Two ways to do this is to run:
pod2text $ME | less
pod2man $ME | man -l -
Or simply visit: http://bucardo.org/
};
exit 0;
}
## Die if Time::HiRes is needed but not found
if ($opt{showtime}) {
eval {
require Time::HiRes;
import Time::HiRes qw/gettimeofday tv_interval sleep/;
};
if ($@) {
die qq{Cannot find Time::HiRes, needed if 'showtime' is true\n};
}
}
## Everything from here on out needs psql, so find and verify a working version:
if ($NO_PSQL_OPTION) {
delete $opt{PSQL};
}
if (! defined $PSQL or ! length $PSQL) {
if (exists $opt{PSQL}) {
$PSQL = $opt{PSQL};
$PSQL =~ m{^/[\w\d\/]*psql$} or die qq{Invalid psql argument: must be full path to a file named psql\n};
-e $PSQL or die qq{Cannot find given psql executable: $PSQL\n};
}
else {
chomp($PSQL = qx{which psql});
$PSQL or die qq{Could not find a suitable psql executable\n};
}
}
-x $PSQL or die qq{The file "$PSQL" does not appear to be executable\n};
$res = qx{$PSQL --version};
$res =~ /^psql \(PostgreSQL\) (\d+\.\d+)/ or die qq{Could not determine psql version\n};
our $psql_version = $1;
$VERBOSE >= 1 and warn qq{psql=$PSQL version=$psql_version\n};
$opt{defaultdb} = $psql_version >= 7.4 ? 'postgres' : 'template1';
## Which schema is slony in?
my $schema = $opt{slonyschema} || find_slony_schema();
## Now determine the version of Slony we are dealing with
## Not needed, but a great sanity check
my ($postgres_version, $slony_version, $slony_node) = find_slony_version($schema);
## Next, we want to slurp a bunch of information from Slony tables
## Because no matter what we're doing, we're going to need some of it
## Things to grab:
## sl_set: Basic set information
## sl_node: Basic info on each node
## sl_nodelock: Which nodes are busy
## sl_path: How to reach each node
## sl_listen: What's listening where
## sl_subscribe: Who's subscribed to each set
my $slonyinfo = get_slony_info($schema);
sanitycheck() if defined $opt{check};
if (defined $opt{slonik}) {
print_slonik($slonyinfo);
}
elsif (defined $opt{bucardo}) {
make_bucardo_init($slonyinfo);
}
else {
printinfo();
}
exit 0;
sub sanitycheck {
print "Beginning sanity check...\n";
print " * Checking for triggers...\n";
for my $trigname (($schema.'_logtrigger', $schema.'_denyaccess')) {
my $SQL = qq{SELECT tab_relname
FROM (
SELECT tab_relname, tgname FROM $schema.sl_table
LEFT JOIN (
SELECT tgrelid, tgname FROM pg_trigger
WHERE tgname ~ '$trigname'
) f ON ( tab_reloid = tgrelid)) g
WHERE tgname IS NULL};
my $res = run_command($SQL);
for my $db (@{$res->{db}}) {
my $s = $db->{slurp};
for my $row (split /\n/ => $s) {
print "Table $row is missing the $trigname trigger in database at " . $db->{pname} . "\n";
}
}
}
my @tables = qw/ sl_path sl_subscribe sl_set sl_node sl_table sl_listen /;
print ' * Making sure ' . (join ' ', @tables) . " match between databases...\n";
for my $table (@tables) {
reduce(
sub {
print "Difference in $table instances between databases at \"" .
$_[0]{pname} . '" and "' . $_[1]{pname} . "\"\n"
if ( join ("\n", sort( split "\n", $_[0]{slurp})) ne join ("\n", sort( split "\n", $_[1]{slurp})));
},
@{$slonyinfo->{$table}{db}});
}
return;
}
sub reduce {
my $code = shift;
my $val = shift;
for (@_) { $val = $code->($val, $_); }
return $val;
}
sub printinfo {
print "Slony version: $slony_version\n";
print "psql version: $psql_version\n";
print "Postgres version: $postgres_version\n";
print "Slony schema: $schema\n";
print "Local node: $slony_node\n";
for my $slony_set (sort { $a <=> $b } keys %{$slonyinfo->{set}}) {
## Overall set information
my $s = $slonyinfo->{set}{$slony_set};
my $comm = $s->{comment} || '';
print "SET $slony_set: $comm\n";
if ($s->{locked}) {
print " This set is locked by txn $s->{locked}\n";
}
## The master
my $showconn = 1;
my $origin = $s->{origin};
my $master = $slonyinfo->{node}{$origin};
printf qq{* Master node: $origin Active: %s%s Comment: "%s"\n%s\n},
$master->{active} ? 'Yes' : 'No',
$master->{active} ? " PID: $master->{pid}" : '',
$master->{comment},
$showconn ? " ($slonyinfo->{path}{$origin}{conninfo})" : '';;
## All slaves subscribed to this set
for my $sub (keys %{$slonyinfo->{sub}}) {
next if $sub != $slony_set;
for my $slave (sort { $a <=> $b } keys %{$slonyinfo->{sub}{$sub}}) {
$s = $slonyinfo->{sub}{$sub}{$slave};
my $p = $slonyinfo->{path}{$slave};
my $active = find_slave_status($p->{conninfo}, $slave, $slony_set, $s->{provider});
printf qq{ ** Slave node: %2d Active: %3s Forward: %3s Provider: %2d Comment: "%s"\n %s\n},
$slave,
$active eq 't' ? 'Yes' : 'No',
$s->{forward} ? 'Yes' : 'No',
$s->{provider},
$slonyinfo->{node}{$slave}{comment},
$showconn ? " ($slonyinfo->{path}{$slave}{conninfo})" : '';
}
}
}
return;
} ## End of printinfo
sub pretty_size {
## Transform number of bytes to a SI display similar to Postgres' format
my $bytes = shift;
my $rounded = shift || 0;
return "$bytes bytes" if $bytes < 10240;
my @unit = qw/kB MB GB TB PB EB YB ZB/;
for my $p (1..@unit) {
if ($bytes <= 1024**$p) {
$bytes /= (1024**($p-1));
return $rounded ?
sprintf ('%d %s', $bytes, $unit[$p-2]) :
sprintf ('%.2f %s', $bytes, $unit[$p-2]);
}
}
return $bytes;
} ## end of pretty_size
sub run_command {
## Run a command string against each of our databases using psql
## Optional args in a hashref:
## "failok" - don't report if we failed
## "target" - use this targetlist instead of generating one
## "timeout" - change the timeout from the default of $opt{timeout}
## "regex" - the query must match this or we throw an error
## "emptyok" - it's okay to not match any rows at all
## "version" - alternate versions for different versions
## "dbnumber" - connect with an alternate set of params, e.g. port2 dbname2
my $string = shift || '';
my $arg = shift || {};
my $info = { command => $string, db => [], hosts => 0 };
$VERBOSE >= 3 and warn qq{Starting run_command with "$string"\n};
my (%host,$passfile,$passfh,$tempdir,$tempfile,$tempfh,$errorfile,$errfh);
my $offset = -1;
## Build a list of all databases to connect to.
## Number is determined by host, port, and db arguments
## Multi-args are grouped together: host, port, dbuser, dbpass
## Grouped are kept together for first pass
## The final arg in a group is passed on
##
## Examples:
## --host=a,b --port=5433 --db=c
## Connects twice to port 5433, using database c, to hosts a and b
## a-5433-c b-5433-c
##
## --host=a,b --port=5433 --db=c,d
## Connects four times: a-5433-c a-5433-d b-5433-c b-5433-d
##
## --host=a,b --host=foo --port=1234 --port=5433 --db=e,f
## Connects six times: a-1234-e a-1234-f b-1234-e b-1234-f foo-5433-e foo-5433-f
##
## --host=a,b --host=x --port=5432,5433 --dbuser=alice --dbuser=bob -db=baz
## Connects three times: a-5432-alice-baz b-5433-alice-baz x-5433-bob-baz
## The final list of targets:
my @target;
## Default connection options
my $conn =
{
host => [''],
port => [5432],
dbname => [$opt{defaultdb}],
dbuser => [$opt{defaultuser}],
dbpass => [''],
inputfile => [''],
};
my $gbin = 0;
GROUP: {
## This level controls a "group" of targets
## If we were passed in a target, use that and move on
if (exists $arg->{target}) {
push @target, $arg->{target};
last GROUP;
}
my %group;
my $foundgroup = 0;
for my $v (keys %$conn) {
my $vname = $v;
## Something new?
if ($arg->{dbnumber}) {
$v .= "$arg->{dbnumber}";
}
if (defined $opt{$v}->[$gbin]) {
my $new = $opt{$v}->[$gbin];
$new =~ s/\s+//g;
## Set this as the new default
$conn->{$vname} = [split /,/ => $new];
$foundgroup = 1;
}
$group{$vname} = $conn->{$vname};
}
if (!$foundgroup) { ## Nothing new, so we bail
last GROUP;
}
$gbin++;
## Now break the newly created group into individual targets
my $tbin = 0;
TARGET: {
my $foundtarget = 0;
## We know th
my %temptarget;
# map { $temptarget{$_} = '' } qw/port host dbname dbuser/;
for my $g (keys %group) {
if (defined $group{$g}->[$tbin]) {
$conn->{$g} = [$group{$g}->[$tbin]];
$foundtarget = 1;
}
$temptarget{$g} = $conn->{$g}[0] || '';
}
## Leave if nothing new
last TARGET if ! $foundtarget;
## Add to our master list
push @target, \%temptarget;
$tbin++;
redo;
} ## end TARGET
redo;
} ## end GROUP
if (! @target) {
die qq{No target databases found\n};
}
## Create a temp file to store our results
$tempdir = tempdir(CLEANUP => 1);
($tempfh,$tempfile) = tempfile('slony_bucardo_migrator.XXXXXXX', SUFFIX => '.tmp', DIR => $tempdir);
## Create another one to catch any errors
($errfh,$errorfile) = tempfile('slony_bucardo_migrator.XXXXXXX', SUFFIX => '.tmp', DIR => $tempdir);
for $db (@target) {
## Just to keep things clean:
truncate $tempfh, 0;
truncate $errfh, 0;
## Store this target in the global target list
push @{$info->{db}}, $db;
$db->{pname} = "port=$db->{port} host=$db->{host} db=$db->{dbname} user=$db->{dbuser}";
my @args = ('-q', '-U', "$db->{dbuser}", '-d', $db->{dbname}, '-t');
if ($db->{host} ne '') {
push @args => '-h', $db->{host};
$host{$db->{host}}++; ## For the overall count
}
push @args => '-p', $db->{port};
if (defined $db->{dbpass} and length $db->{dbpass}) {
## Make a custom PGPASSFILE. Far better to simply use your own .pgpass of course
($passfh,$passfile) = tempfile('nagios.XXXXXXXX', SUFFIX => '.tmp', DIR => $tempdir);
$VERBOSE >= 3 and warn "Created temporary pgpass file $passfile\n";
$ENV{PGPASSFILE} = $passfile;
printf $passfh "%s:%s:%s:%s:%s\n",
$db->{host} eq '' ? '*' : $db->{host},
$db->{port}, $db->{dbname},
$db->{dbuser}, $db->{dbpass};
close $passfh or die qq{Could not close $passfile: $!\n};
}
push @args, '-o', $tempfile;
## If we've got different SQL, use this first run to simply grab the version
## Then we'll use that info to pick the real query
if ($arg->{version}) {
$arg->{oldstring} = $string;
$string = 'SELECT version()';
}
if (defined $db->{inputfile} and length $db->{inputfile}) {
push @args, '-f', $db->{inputfile};
} else {
push @args, '-c', $string;
}
$VERBOSE >= 3 and warn Dumper \@args;
local $SIG{ALRM} = sub { die 'Timed out' };
my $timeout = $arg->{timeout} || $opt{timeout};
alarm 0;
my $start = $opt{showtime} ? [gettimeofday()] : 0;
eval {
alarm $timeout;
# print "$PSQL " . (join ' ', @args);
$res = system $PSQL => @args;
};
my $err = $@;
alarm 0;
if ($err) {
if ($err =~ /Timed out/) {
die qq{Command: "$string" timed out! Consider boosting --timeout higher than $timeout\n};
}
else {
die q{Unknown error inside of the "run_command" function};
}
}
$db->{totaltime} = sprintf '%.2f', $opt{showtime} ? tv_interval($start) : 0;
if ($res) {
$res >>= 8;
$db->{fail} = $res;
$VERBOSE >= 3 and !$arg->{failok} and warn qq{System call failed with a $res\n};
seek $errfh, 0, 0;
{
local $/;
$db->{error} = <$errfh> || '';
$db->{error} =~ s/\s*$//;
$db->{error} =~ s/^psql: //;
$ERROR = $db->{error};
}
if (!$db->{ok} and !$arg->{failok}) {
die "Query failed: $string\n";
}
}
else {
seek $tempfh, 0, 0;
{
local $/;
$db->{slurp} = <$tempfh>;
}
$db->{ok} = 1;
## Allow an empty query (no matching rows) if requested
if ($arg->{emptyok} and $db->{slurp} =~ /^\s*$/o) {
}
## If we were provided with a regex, check and bail if it fails
elsif ($arg->{regex}) {
if ($db->{slurp} !~ $arg->{regex}) {
die "Regex failed for query: $string\n";
}
}
}
## If we are running different queries based on the version,
## find the version we are using, replace the string as needed,
## then re-run the command to this connection.
if ($arg->{version}) {
if ($db->{error}) {
die $db->{error};
}
if ($db->{slurp} !~ /PostgreSQL (\d+\.\d+)/) {
die qq{Could not determine version of Postgres!\n};
}
$db->{version} = $1;
$string = $arg->{version}{$db->{version}} || $arg->{oldstring};
delete $arg->{version};
redo;
}
} ## end each database
# close $errfh or die qq{Could not close $errorfile: $!\n};
# close $tempfh or die qq{Could not close $tempfile: $!\n};
$info->{hosts} = keys %host;
$VERBOSE >= 3 and warn Dumper $info;
return $info;
} ## end of run_command
sub size_in_bytes { ## no critic (RequireArgUnpacking)
## Given a number and a unit, return the number of bytes.
my ($val,$unit) = ($_[0],lc substr($_[1]||'s',0,1));
return $val * ($unit eq 's' ? 1 : $unit eq 'k' ? 1024 : $unit eq 'm' ? 1024**2 :
$unit eq 'g' ? 1024**3 : $unit eq 't' ? 1024**4 :
$unit eq 'p' ? 1024**5 : $unit eq 'e' ? 1024**6 :
$unit eq 'z' ? 1024**7 : 1024**8);
} ## end of size_in_bytes
sub size_in_seconds {
my ($string,$type) = @_;
return '' if ! length $string;
if ($string !~ $timere) {
my $l = substr($type,0,1);
die qq{Value for '$type' must be a valid time. Examples: -$l 1s -$l "10 minutes"\n};
}
my ($val,$unit) = ($1,lc substr($2||'s',0,1));
my $tempval = sprintf '%.9f', $val * ($unit eq 's' ? 1 : $unit eq 'm' ? 60 : $unit eq 'h' ? 3600 : 86600);
$tempval =~ s/0+$//;
$tempval = int $tempval if $tempval =~ /\.$/;
return $tempval;
} ## end of size_in_seconds
sub get_slony_info {
## Extract some information from the Slony sl_ tables
## Returns a hashref
my $schema = shift;
my (%info, $info, $s);
## sl_node
$SQL = qq{SELECT no_id, no_active, no_comment FROM $schema.sl_node};
#$SQL = qq{SELECT no_id, no_active, no_spool, no_comment FROM $schema.sl_node};
$info = run_command($SQL);
$s = $info->{db}[0]{slurp};
for my $row (split /\n/ => $s) {
my @i = split /\s*\|\s*/ => $row;
my $id = int $i[0];
$info{node}{$id}{active} = $i[1] eq 't' ? 1 : 0;
# $info{node}{$id}{spool} = $i[2] eq 't' ? 1 : 0;
#$info{node}{$id}{comment} = $i[3];
$info{node}{$id}{comment} = $i[2];
}
$info{sl_node} = $info;
## sl_nodelock
$SQL = qq{SELECT nl_nodeid, nl_conncnt, nl_backendpid FROM $schema.sl_nodelock};
$info = run_command($SQL);
$s = $info->{db}[0]{slurp};
for my $row (split /\n/ => $s) {
my @i = split /\s*\|\s*/ => $row;
my $id = int $i[0];
$info{node}{$id}{connectnumber} = $i[1];
$info{node}{$id}{pid} = int $i[2];
}
$info{sl_nodelock} = $info;
## sl_set
$SQL = qq{SELECT set_id, set_origin, set_locked, set_comment FROM $schema.sl_set};
$info = run_command($SQL);
$s = $info->{db}[0]{slurp};
for my $row (split /\n/ => $s) {
my @i = split /\s*\|\s*/ => $row;
my $id = int $i[0];
$info{set}{$id}{origin} = $i[1];
$info{set}{$id}{locked} = $i[2];
$info{set}{$id}{comment} = $i[3];
}
$info{sl_set} = $info;
## sl_subscribe
$SQL = qq{SELECT sub_set, sub_provider, sub_receiver, sub_forward, sub_active FROM $schema.sl_subscribe};
$info = run_command($SQL);
$s = $info->{db}[0]{slurp};
for my $row (split /\n/ => $s) {
my @i = split /\s*\|\s*/ => $row;
my $id = int $i[0];
$info{sub}{$id}{$i[2]}{provider} = $i[1];
$info{sub}{$id}{$i[2]}{forward} = $i[3] ? 1 : 0;
$info{sub}{$id}{$i[2]}{active} = $i[4] ? 1 : 0;
}
$info{sl_subscribe} = $info;
## sl_path
$SQL = qq{SELECT pa_server, pa_client, pa_connretry, pa_conninfo FROM $schema.sl_path};
$info = run_command($SQL);
$s = $info->{db}[0]{slurp};
for my $row (split /\n/ => $s) {
my @i = split /\s*\|\s*/ => $row;
my $id = int $i[0];
$info{path}{$id}{client} = $i[1];
$info{path}{$id}{delay} = $i[2];
$info{path}{$id}{conninfo} = $i[3];
}
$info{sl_path} = $info;
## sl_listen
$SQL = qq{SELECT li_origin, li_provider, li_receiver FROM $schema.sl_listen};
$info = run_command($SQL);
$s = $info->{db}[0]{slurp};
for my $row (split /\n/ => $s) {
my @i = split /\s*\|\s*/ => $row;
my $id = int $i[0];
$info{listen}{$id}{provider} = $i[1];
$info{listen}{$id}{receiver} = $i[2];
}
$info{sl_listen} = $info;
## sl_table
$SQL = qq{SELECT tab_id, tab_nspname || '.' || tab_relname, tab_set, tab_idxname, tab_comment, set_origin FROM $schema.sl_table JOIN $schema.sl_set ON (set_id = tab_set) ORDER BY tab_set, tab_id};
$info = run_command($SQL);
$s = $info->{db}[0]{slurp};
for my $row (split /\n/ => $s) {
my @i = split /\s*\|\s*/ => $row;
my $id = int $i[0];
$info{table}{$id}{FQN} = $i[1];
$info{table}{$id}{set} = int $i[2];
$info{table}{$id}{key} = $i[3];
$info{table}{$id}{comment} = $i[4];
$info{table}{$id}{origin} = int $i[5];
}
$info{sl_table} = $info;
## sl_sequence
$SQL = qq{SELECT seq_id, seq_nspname || '.' || seq_relname, seq_set, seq_comment, set_origin FROM $schema.sl_sequence JOIN $schema.sl_set ON (set_id = seq_set) ORDER BY seq_set, seq_id};
$info = run_command($SQL);
$s = $info->{db}[0]{slurp};
for my $row (split /\n/ => $s) {
my @i = split /\s*\|\s*/ => $row;
my $id = int $i[0];
$info{sequence}{$id}{FQN} = $i[1];
$info{sequence}{$id}{set} = int $i[2];
$info{sequence}{$id}{comment} = $i[3];
$info{sequence}{$id}{origin} = int $i[4];
}
$info{sl_sequence} = $info;
return \%info;
} ## end of get_slony_info
sub find_slony_schema {
## Attempt to figure out the name of the Slony schema
## Returns the name of the schema, quoted if needed
## Dies if none found, or more than one found
$SQL = q{SELECT quote_ident(nspname) FROM pg_namespace WHERE oid IN}.
q{(SELECT pronamespace FROM pg_proc WHERE proname = 'slonyversion')};
my $info = run_command($SQL);
my $schema = '';
if (defined $info->{db}[0] and exists $info->{db}[0]{slurp}) {
(my @names) = map { s/\s//g; $_ } grep { /\S/ } split /\s*\|\s*/ => $info->{db}[0]{slurp};
if (@names) {
my $num = @names;
if ($num > 1) {
## Or should we simply show them all?
my $list = join ',' => map { qq{"$_"} } @names;
die "Please specify a slony scheme. We found: $list\n";
}
$schema = $names[0];
}
}
if (! length $schema) {
die "Could not find a slony schema, please specify one using the --slonyschema option\n";
}
return $schema;
} ## end of find_slony_schema
sub find_slony_version {
## Returns the version of Slony via the slonyversion() function
my $schema = shift; ## make global?
my $safeschema = $schema;
$safeschema =~ s/'/''/g;
$SQL = qq{SELECT version(), $schema.slonyversion(), $schema.getlocalnodeid('$safeschema')};
my $info = run_command($SQL, { regex => qr{([\d\.]+)} });
my ($pg_version, $sl_version, $sl_node) = (0,0,0);
if (defined $info->{db}[0] and exists $info->{db}[0]{slurp}) {
if ($info->{db}[0]{slurp} =~ /PostgreSQL (\S+).*\| ([\d\.]+)\s*\|\s*(\d+)/) {
($pg_version, $sl_version, $sl_node) = ($1,$2,$3);
}
}
## Usually due to an incorrect schema
$sl_version or die "Could not determine the version of Slony\n";
$sl_node or die "Could not determine the local Slony node\n";
$pg_version or die "Could not determine the version of Postgres\n";
return $pg_version, $sl_version, $sl_node;
} ## end of find_slony_version
sub find_slave_status {
my ($conninfo, $slave, $slony_set, $provider) = @_;
my ($info, %info);
# Create a new target for $PSQL query because
# sl_subscribe.sub_active is only meaningful on the slave
# parse out connection information from $conninfo
my %target = ();
# Figure out a way to fail gracefully if the port selection doesn't work
$target{port} = $conninfo =~ /port=(\d+)/ ? $1 : ($opt{port}[0] || 5432);
$target{host} = $conninfo =~ /host=(\S+)/ ? $1 : die 'No host found?';
$target{dbname} = $conninfo =~ /dbname=(\S+)/ ? $1 : die 'No dbname found?';
$target{dbuser} = $conninfo =~ /user=(\S+)/ ? $1 : die 'No dbuser found?';
eval {
my $SQL = qq{SELECT sub_active FROM $schema.sl_subscribe WHERE sub_receiver = $slave }.
qq{AND sub_provider = $provider AND sub_set = $slony_set};
$info = run_command($SQL, { target => \%target });
};
if ($@) {
print "Failed\n";
}
my $status = '';
if (defined $info->{db}[0] and exists $info->{db}[0]{slurp}) {
my (@statuses) = map { s/\s//g; $_ } grep { /\S/ } split /\s*\|\s*/ => $info->{db}[0]{slurp};
if (@statuses) {
my $num = @statuses;
if ($num > 1) {
die "Oops, found more than one subscription on set $slony_set to provider $provider from node $slave\n";
}
$status = $statuses[0];
}
}
if (!length $status) {
die qq{Could not figure out status of slave $slave};
}
return $status;
} ## end of find_slave_status
sub get_slony_set {
if (defined $opt{slonyset}) {
return $opt{slonyset};
}
my $slony_set;
my @sets = keys %{$slonyinfo->{set}};
if (@sets) {
my $num = @sets;
if ($num > 1) {
my $list = join ', ' => @sets;
die "Please specify a set with the --slonyset option. We found $list\n";
}
$slony_set = $sets[0];
}
return $slony_set;
} ## end of get_slony_set
#
# Slonyinfo helpers
#
sub get_conninfo {
my ($node) = @_;
unless (defined $slonyinfo->{path}{$node} and exists $slonyinfo->{path}{$node}{conninfo}) {
die "ERROR: Unable to find node $node. Are you sure that node exists?\n";
}
return ($slonyinfo->{path}{$node}{conninfo});
}
sub get_master {
my $slony_set = get_slony_set();
my $s = $slonyinfo->{set}{$slony_set}; ## or die
my $master = $s->{origin};
return $master;
}
# returns a string suitable for passing to slonik
sub create_store_paths {
my ($new_node, $new_conninfo) = @_;
my $paths;
# for each node in the slony network, create a store path to a new_node node
# store path ( server = ? , client = ? , conninfo = $conninfo ' );
foreach my $old_node (sort keys %{$slonyinfo->{node}}) {
my $old_conninfo = get_conninfo($old_node);
$paths .= qq{store path ( server=$old_node, client=$new_node, conninfo='$old_conninfo' );\n};
$paths .= qq{store path ( server=$new_node, client=$old_node, conninfo='$new_conninfo' );\n};
}
return $paths;
}
# generates all admin paths for all nodes
# returns a string suitable for passing to slonik
sub create_admin_paths {
# can indicate a node to skip
my ($skip_node) = @_;
my $connections;
# for each node in the slony network, create a store path to a new_node node
# store path ( server = ? , client = ? , conninfo = $conninfo ' );
foreach my $node (keys %{$slonyinfo->{node}}) {
next if (defined $skip_node and $node == $skip_node);
my $conninfo = get_conninfo($node);
$connections .= qq{node $node admin conninfo='$conninfo';\n}
}
return $connections;
}
#
# Utility functions
#
sub prompt_user {
my ($prompt_string, $default) = @_;
if ($default) {
print $prompt_string, '[', $default, ']: ';
} else {
print $prompt_string, ': ';
}
$| = 1;
$_ = ;
chomp;
if ("$default") {
return $_ ? $_ : $default # return $_ if it has a value
} else {
return $_;
}
}
sub make_bucardo_init {
my $info = shift;
my (@dbs, @herds, @syncs, @tables, @sequences);
my $cluster_name = $schema;
$cluster_name =~ s/^_//;
PATHS:
for my $p (keys %{$info->{path}}) {
my ($name, $conninfo) = ($cluster_name.'_'.$p, $info->{path}{$p}{conninfo});
if ($conninfo eq '') {
warn "Couldn't get connection info for database $name.";
next PATHS;
}
my @connopts = split /\s+/, $conninfo;
my ($dbname, $conn) = ('', '');
for my $opt (@connopts) {
my ($key, $value) = split /=/, $opt;
my $match;
if ($key eq 'dbname') { $dbname = $value; }
else {
for my $a (qw/host port user pass/) {
if ($key eq $a) {
$match = 1;
$conn .= " $a=$value";
}
}
$conn .= " $key=$value" unless defined $match;
}
}
$dbs[$p] = {
name => $name,
conninfo => $conninfo,
};
print "./bucardo add db $name dbname=$dbname $conn\n";
}
for my $set (@{ get_ordered_subscribes($info->{sub}, $info->{set}, $info->{node}) }) {
traverse_set($set, sub {
my $node = shift;
my $set_num = $set->{set_num};
my $db = $cluster_name . '_' . $node->{num};
my $herd = $cluster_name . '_node' . $node->{num} . '_set' . $set_num;
if (exists $node->{children} and $#{$node->{children}} > -1) {
map {
my $name = $info->{table}{$_}{FQN};
if ($info->{table}{$_}{set} == $set_num) {
print "./bucardo add table $name db=$db autokick=true conflict_strategy=source herd=$herd\n";
}
} keys %{$info->{table}};
map {
my $name = $info->{sequence}{$_}{FQN};
if ($info->{sequence}{$_}{set} == $set_num) {
print "./bucardo add sequence $name db=$db autokick=true conflict_strategy=source herd=$herd\n";
}
} keys %{$info->{sequence}};
for my $child (@{$node->{children}}) {
my $targetdbname = $cluster_name . '_' . $child;
my $syncname = $cluster_name . '_set' . $set_num . '_node' . $node->{num} . '_to_node' . $child;
my $childnode = $set->{$child};
print "./bucardo add sync $syncname source=$herd targetdb=$targetdbname type=pushdelta";
print " target_makedelta=on"
if (exists $childnode->{children} and $#{$childnode->{children}} > -1);
print "\n";
}
}
}, { include_origin => 1 });
}
return;
}
sub print_slonik {
my $info = shift;
my $cluster = $schema;
$cluster =~ s/^_//;
print "CLUSTER NAME = $cluster;\n";
my $master_id;
for my $p (keys %{$info->{path}}) {
not $master_id and $master_id = $p;
print "NODE $p ADMIN CONNINFO = '" . $info->{path}{$p}{conninfo} ."';\n";
}
# Set up nodes
print "INIT CLUSTER (ID = $master_id, COMMENT = '" . $info->{node}{$master_id}{comment} . "');\n";
for my $p (keys %{$info->{node}}) {
next if $p eq $master_id;
# TODO Make sure EVENT NODE is right, here
print "STORE NODE (ID = $p, EVENT NODE = $master_id, COMMENT = '" . $info->{node}{$p}{comment} ."');\n";
}
# Set up paths
for my $p (sort keys %{$info->{path}}) {
print "STORE PATH (SERVER = $p, CLIENT = " . $info->{path}{$p}{client} .
', CONNINFO = \'' . $info->{path}{$p}{conninfo} .
'\', CONNRETRY = ' . $info->{path}{$p}{delay} . ");\n";
}
print "ECHO 'Please start up replication nodes here';\n";
for my $p (sort keys %{$info->{set}}) {
print "TRY {
CREATE SET (ID = $p, ORIGIN = " . $info->{set}{$p}{origin} .
', COMMENT = \'' . $info->{set}{$p}{comment} . "');
} ON ERROR {
EXIT -1;
}\n";
}
for my $p (keys %{$info->{table}}) {
print "SET ADD TABLE (ID = $p, ORIGIN = " . $info->{table}{$p}{origin}
. ', SET ID = ' . $info->{table}{$p}{set}
. ', FULLY QUALIFIED NAME = \'' . $info->{table}{$p}{FQN}
. '\', KEY = \'' . $info->{table}{$p}{key}
. '\', COMMENT = \'' . $info->{table}{$p}{comment} . "');\n";
}
for my $p (keys %{$info->{sequence}}) {
print "SET ADD SEQUENCE (ID = $p, ORIGIN = " . $info->{sequence}{$p}{origin}
. ', SET ID = ' . $info->{sequence}{$p}{set}
. ', FULLY QUALIFIED NAME = \'' . $info->{sequence}{$p}{FQN}
. '\', COMMENT = \'' . $info->{sequence}{$p}{comment} . "');\n";
}
my $p = 0;
for my $set (@{ get_ordered_subscribes($info->{sub}, $info->{set}, $info->{node}) }) {
traverse_set($set, sub {
my $node = shift;
print "SUBSCRIBE SET (ID = $set->{set_num}, PROVIDER = $node->{parent}, RECEIVER = $node->{num}, "
. "FORWARD = " . ($node->{forward} ? 'YES' : 'NO') . ");\n";
}, {} );
}
return;
}
sub process_child {
my ($set, $node, $callback) = @_;
$callback->($node);
map { process_child($set, $set->{$_}, $callback) } @{$node->{children}};
return;
}
sub traverse_set {
my ($set, $callback, $args) = @_;
$callback->($set->{origin}) if (exists ($args->{include_origin}) and $args->{include_origin});
map { process_child($set, $set->{$_}, $callback) if (exists $set->{$_}) } @{$set->{origin}{children}};
return;
}
sub get_ordered_subscribes {
my ($subs, $sets, $nodes) = @_;
# Bucardo needs to know each set; slonik just needs to know a valid subscribe order
my @results;
#map { push @subs, $subs->{$_}; } keys %{ $subs };
for my $set_num (keys %$subs) {
my $origin = { num => $sets->{$set_num}{origin}, };
my $set = { set_num => $set_num, origin => $origin, $origin->{num} => $origin };
for my $sub (keys %{$subs->{$set_num}}) {
my $node;
my ($prov, $recv) = ($subs->{$set_num}{$sub}{provider}, $sub);
if (! exists ($set->{$recv})) {
$node = { num => $recv, forward => $subs->{$set_num}{$sub}{forward}, };
$set->{$recv} = $node;
}
else {
$node = $set->{$recv};
}
$node->{parent} = $prov;
if (! exists ($set->{$prov})) {
my $newnode = { num => $prov, forward => $subs->{$set_num}{$sub}{forward}, };
$set->{$prov} = $newnode;
}
push @{$set->{$prov}->{children}}, $recv;
}
push @results, $set;
}
return \@results;
}
=pod
=head1 NAME
B - Slony-to-Bucardo migration tool
=head1 SYNOPSIS
Provides information about a running Slony cluster, including a summary
description (default), Slonik scripts (the --slonik option), and
Slony-to-Bucardo migration scripts (the --bucardo option).
=head1 DESCRIPTION
Connects to a running Slony cluster and provides one of the following: A
summary of the sets and nodes involved in the cluster, a slonik script to
rebuild the cluster from scratch, or bucardo commands to build the same
cluster based on Bucardo. This last will allow migration from Slony to Bucardo.
=head1 OPTIONS FOR PRINCIPLE FUNCTIONS
=over 4
=item B<--bucardo>
Returns a list of bucardo commands which will allow migration of a Slony
cluster off of Slony and on to Bucardo. After installing Bucardo with
I, these scripts will tell Bucardo about all the tables
and sequences in the Slony sets, each node in the Slony cluster, and configure
Bucardo to replicate those objects in the same way Slony does. This includes
the use of cascaded replication.
=item B<--slonik>
Returns a Slonik script which will recreate the Slony cluster from scratch.
=back
=head1 DATABASE CONNECTION OPTIONS
=over 4
=item B<-H NAME> or B<--host=NAME>
Connect to the host indicated by NAME.
=item B<-p PORT> or B<--port=PORT>
Connects using the specified PORT number.
=item B<-db NAME> or B<--dbname=NAME>
Specifies which database to connect to. If no dbname option is provided,
defaults to 'postgres' if psql is version 8 or greater, and 'template1'
otherwise.
=item B<-u USERNAME> or B<--dbuser=USERNAME>
The name of the database user to connect as. If this is not provided, the
default is 'postgres'.
=item B<--dbpass=PASSWORD>
Provides the password to connect to the database with. Use of this option is highly discouraged.
Instead, one should use a .pgpass file.
=back
=head1 OTHER OPTIONS
Other options include:
=over 4
=item B<-t VAL> or B<--timeout=VAL>
Sets the timeout in seconds after which the script will abort whatever it is doing
and return an UNKNOWN status. The timeout is per Postgres cluster, not for the entire
script. The default value is 10; the units are always in seconds.
=item B<-h> or B<--help>
Displays a help screen with a summary of all actions and options.
=item B<-V> or B<--version>
Shows the current version.
=item B<-v> or B<--verbose>
Set the verbosity level. Can call more than once to boost the level. Setting it to three
or higher (in other words, issuing C<-v -v -v>) turns on debugging information for this
program which is sent to stderr.
=item B<--PSQL=PATH>
Tells the script where to find the psql program. Useful if you have more than
one version of the psql executable on your system, or if there is no psql program
in your path. Note that this option is in all uppercase. By default, this option
is I. To enable it, you must change the C<$NO_PSQL_OPTION> near the
top of the script to 0. Avoid using this option if you can, and instead hard-code
your psql location into the C<$PSQL> variable, also near the top of the script.
=back
=head1 DEPENDENCIES
Access to a working version of psql, and Perl v5.6.1 or later. Also the
Time::HiRes Perl module if C<$opt{showtime}> is set to true, which is the
default.
=head1 DEVELOPMENT
Development happens using the git system. You can clone the latest version by doing:
git clone http://bucardo.org/bucardo.git/
=head1 HISTORY
=over 4
=item B, first release
=back
=head1 BUGS AND LIMITATIONS
Slony paths aren't all captured, so --slonik output might need some tweaking to
work correctly
Please report any problems to josh@endpoint.com.
=head1 AUTHORS
Greg Sabino Mullane
Selena Decklemann
Joshua Tolley
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2007-2009 Greg Sabino Mullane .
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY
OF SUCH DAMAGE.
=cut
Bucardo-5.4.1/META.yml0000644000175000017500000000255112601643161013006 0ustar greggreg--- #YAML:1.0
name : Bucardo
version : 5.4.1
abstract : Postgres multi-master replication system
author:
- Greg Sabino Mullane
license : bsd
dynamic_config : 1
distribution_type : module
requires:
boolean : 0
DBD::Pg : 2.0
DBI : 1.51
DBIx::Safe : 1.2.4
ExtUtils::MakeMaker : 6.32
File::Spec : 0
IO::Handle : 1.24
List::Util : 0
MIME::Base64 : 0
Net::SMTP : 0
Pod::Parser : 0
Pod::Usage : 0
Sys::Hostname : 1.11
Sys::Syslog : 0.13
Time::HiRes : 0
build_requires:
Test::Harness : 2.03
Test::More : 0.61
Module::Signature : 0.50
provides:
Bucardo:
file : Bucardo.pm
version : 5.4.1
bucardo:
file : bucardo
version : 5.4.1
resources:
homepage : http://bucardo.org/index.html
MailingList : http://bucardo.org/list.html
bugtracker : https://github.com/bucardo/bucardo/issues
repository : http://bucardo.org/repo.html
license : http://bucardo.org/license.html
meta-spec:
version : 1.3
url : http://module-build.sourceforge.net/META-spec-v1.3.html
generated_by : emacs