1#!/usr/bin/env perl 2# -*-mode:cperl; indent-tabs-mode: nil; cperl-indent-level: 4-*- 3 4## Script to control Bucardo 5## 6## Copyright 2006-2020 Greg Sabino Mullane <greg@turnstep.com> 7## 8## Please see https://bucardo.org/ for full documentation 9## 10## Run with a --help argument for some basic instructions 11 12package bucardo; 13 14use strict; 15use warnings; 16use utf8; 17use 5.008003; 18use open qw( :std :utf8 ); 19use DBI; 20use IO::Handle qw/ autoflush /; 21use File::Basename qw/ dirname /; 22use Time::HiRes qw/ sleep gettimeofday tv_interval /; 23use POSIX qw/ ceil setsid localeconv /; 24use Config qw/ %Config /; 25use Encode qw/ decode /; 26use File::Spec; 27use Data::Dumper qw/ Dumper /; 28$Data::Dumper::Indent = 1; 29use Getopt::Long; 30Getopt::Long::Configure(qw/ no_ignore_case pass_through no_autoabbrev /); 31 32require I18N::Langinfo; 33 34our $VERSION = '5.6.0'; 35 36## For the tests, we want to check that it compiles without actually doing anything 37return 1 if $ENV{BUCARDO_TEST}; 38 39## No buffering on the standard streams 40*STDOUT->autoflush(1); 41*STDERR->autoflush(1); 42 43my $locale = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET()); 44 45for (@ARGV) { 46 $_ = decode($locale, $_); 47} 48 49## All the variables we use often and want to declare here without 'my' 50use vars qw/$dbh $SQL $sth %sth $count $info %global $SYNC $GOAT $TABLE $SEQUENCE $DB $DBGROUP $HERD $RELGROUP 51 $CUSTOMCODE $CUSTOMNAME $CUSTOMCOLS $CLONE /; 52 53## How to show dates from the database, e.g. start time of a sync 54my $DATEFORMAT = $ENV{BUCARDO_DATEFORMAT} || q{Mon DD, YYYY HH24:MI:SS}; 55my $SHORTDATEFORMAT = $ENV{BUCARDO_SHORTDATEFORMAT} || q{HH24:MI:SS}; 56 57## How long (in seconds) we hang out between checks after a kick - or when waiting for notices 58my $WAITSLEEP = 1; 59 60## Determine how we were called 61## If we were called from a different directory, and the base directory is in our path, 62## we strip out the directory part 63my $progname = $0; 64if (exists $ENV{PATH} and $progname =~ m{(.+)/(.+)}) { 65 my ($base, $name) = ($1,$2); 66 for my $seg (split /\:/ => $ENV{PATH}) { 67 if ($seg eq $base) { 68 $progname = $name; 69 last; 70 } 71 } 72} 73 74## We must have at least one argument to do anything 75help(1) unless @ARGV; 76 77## Default arguments - most are for the bc constructor 78my $bcargs = { 79 quiet => 0, 80 verbose => 0, 81 quickstart => 0, 82 bcverbose => 1, 83 dbname => 'bucardo', 84 dbuser => 'bucardo', 85 dbpass => undef, 86 sendmail => 0, 87 extraname => '', 88 logseparate => 0, 89 logextension => '', 90 logclean => 0, 91 batch => 0, 92 }; 93 94## These options must come before the main GetOptions call 95my @opts = @ARGV; 96GetOptions( 97 $bcargs, 98 'no-bucardorc', 99 'bucardorc=s', 100); 101 102## Values are first read from a .bucardorc, either in the current dir, or the home dir. 103## If those do not exist, check for a global rc file 104## These will be overwritten by command-line args. 105my $file; 106if (! $bcargs->{'no-bucardorc'}) { 107 if ($bcargs->{bucardorc}) { 108 -e $bcargs->{bucardorc} or die qq{Could not find the file "$bcargs->{bucardorc}"\n}; 109 $file = $bcargs->{bucardorc}; 110 } 111 elsif (-e '.bucardorc') { 112 $file = '.bucardorc'; 113 } 114 elsif (defined $ENV{HOME} && -e "$ENV{HOME}/.bucardorc") { 115 $file = "$ENV{HOME}/.bucardorc"; 116 } 117 elsif (-e '/etc/bucardorc') { 118 $file = '/etc/bucardorc'; 119 } 120} 121if (defined $file) { 122 open my $rc, '<', $file or die qq{Could not open "$file": $!\n}; 123 while (<$rc>) { 124 125 ## Skip any lines starting with a hash 126 next if /^\s*#/; 127 128 ## Format is foo=bar or foo:bar, with whitespace allowed 129 if (/^\s*(\w[\w-]+)\s*[:=]\s*(.+?)\s*$/o) { 130 my ($name,$value) = ($1,$2); ## no critic (ProhibitCaptureWithoutTest) 131 $bcargs->{$name} = $name eq 'logdest' ? [$value] : $value; 132 } 133 else { 134 warn qq{Could not parse line $. of file "$file"\n}; 135 } 136 137 } 138 close $rc or die; 139} 140 141Getopt::Long::Configure(qw(no_pass_through autoabbrev)); 142GetOptions ## no critic (ProhibitCallsToUndeclaredSubs) 143 ($bcargs, 144 'verbose+', 145 'vv', 146 'vvv', 147 'vvvv', 148 'quiet+', 149 'quickstart', 150 'notimer', 151 'help|?', 152 'debug+', 153 'version', 154 'sort=i', 155 'showdays|show-days', 156 'compress', 157 'retry=i', 158 'retrysleep|retry-sleep=i', 159 'batch', 160 'dryrun|dry-run', 161 'confirm', 162 'tsep=s', 163 'exit-on-nosync!', 164 165 ## These are sent to the constructor: 166 'bcverbose', 167 'dbport|db-port|p=i', 168 'dbhost|db-host|h=s', 169 'dbname|db-name|d=s', 170 'dbuser|db-user|U=s', 171 'dbpass|db-pass|P=s', 172 'sendmail=i', 173 'extraname|extra-name=s', 174 175 'debugsyslog=i', # legacy 176 'debugdir=s', # legacy 177 'debugfile=i', # legacy 178 'cleandebugs=i', # legacy 179 180 181 'logdest|log-dest|log-destination=s@', # stderr, syslog, none, or file path 182 'logseparate|log-sep|log-separate|debugfilesep!', 183 'logextension|log-extension|log-ext|debugname=s', 184 'logclean|log-clean!', 185 'loglevel|log-level=s', 186 'logshowline|log-showline|log-show-line=s', 187 188 ## Used internally 189 'force', 190 'schema|n=s@', 191 'exclude-schema|N=s@', 192 'table|t=s@', 193 'exclude-table|T=s@', 194 'db|database=s', 195 'herd|relgroup=s', 196 'piddir|pid-dir=s', 197) or die "\n"; 198 199## If --help is set, ignore everything else, show help, then exit 200help() if $bcargs->{help}; 201 202## If --version is set, ignore everything else, show the version, and exit 203if ($bcargs->{version}) { 204 print "$progname version $VERSION\n"; 205 exit 0; 206} 207 208## Allow some options to be set by env 209if ($ENV{BUCARDO_CONFIRM} and ! exists $bcargs->{confirm}) { 210 $bcargs->{confirm} = $ENV{BUCARDO_CONFIRM}; 211} 212 213# Determine the logging destination. 214if (exists $bcargs->{logdest}) { 215 if (! ref $bcargs->{logdest}) { 216 $bcargs->{logdest} = [$bcargs->{logdest}]; 217 } 218} 219else { 220 if (exists $bcargs->{debugfile} && !delete $bcargs->{debugfile}) { 221 # Old --debugfile option can disable logging. 222 $bcargs->{logdest} = []; 223 } 224 elsif (my $dir = $bcargs->{debugdir}) { 225 # Old --debugdir option determines log directory. 226 $bcargs->{logdest} = [$dir]; 227 } 228 else { 229 # Default value. 230 $bcargs->{logdest} = ['/var/log/bucardo']; 231 } 232 233 if ($bcargs->{debugsyslog}) { 234 # Old --debugsyslog option enables syslog logging. 235 push @{ $bcargs->{logdest} } => 'syslog'; 236 } 237} 238 239# Handle legacy --cleandebugs option. 240$bcargs->{logclean} = 1 241 if delete $bcargs->{cleandebugs} && !exists $bcargs->{logclean}; 242 243## Sometimes we want to be as quiet as possible 244my $QUIET = delete $bcargs->{quiet}; 245 246## Quick shortcuts for lots of verbosity 247$bcargs->{vv} and $bcargs->{verbose} = 2; 248$bcargs->{vvv} and $bcargs->{verbose} = 3; 249$bcargs->{vvvv} and $bcargs->{verbose} = 4; 250 251## Set some global arguments 252my $VERBOSE = delete $bcargs->{verbose}; 253my $DEBUG = delete $bcargs->{debug} || $ENV{BUCARDO_DEBUG} || 0; 254 255## Do we compress time outputs by stripping out whitespace? 256my $COMPRESS = delete $bcargs->{compress} || 0; 257 258## Do we retry after a sleep period on failed kicks? 259my $RETRY = delete $bcargs->{retry} || 0; 260my $RETRYSLEEP = delete $bcargs->{retrysleep} || 0; 261 262## Allow people to turn off the cool timer when kicking syncs 263my $NOTIMER = delete $bcargs->{notimer} || 0; 264 265## Anything left over is the verb and noun(s) 266my $verb = shift || ''; 267 268## No verb? Show a help message and exit 269help(1, "Missing required command\n") unless $verb; 270 271## Standardize the verb as lowercase, and grab the rest of the args as the "nouns" 272$verb = lc $verb; 273my @nouns = @ARGV; 274 275## Allow alternate underscore format 276if ($verb =~ /^(\w+)_(\w+)$/) { 277 $verb = $1; 278 unshift @nouns => $2; 279} 280 281## Make a single string version, mostly for output in logs 282my $nouns = join ' ' => @nouns; 283## The verb may have a helper, usually a number 284my $adverb; 285 286## Installation must happen before we try to connect! 287install() if $verb =~ /instal/i; 288 289## Display more detailed help than --help 290superhelp() if $verb eq 'help'; 291 292my ($STOPFILE,$REASONFILE,$REASONFILE_LOG); 293 294## If we are trying a stop, and piddir is already set, do it now 295if ('stop' eq $verb and $bcargs->{piddir}) { 296 $STOPFILE = "$bcargs->{piddir}/fullstopbucardo"; 297 $REASONFILE = 'bucardo.restart.reason.txt'; 298 $REASONFILE_LOG = 'bucardo.restart.reason.log'; 299 stop(); 300} 301 302## For everything else, we need to connect to a previously installed Bucardo database 303 304## Create a quick data source name 305my $DSN = "dbi:Pg:dbname=$bcargs->{dbname}"; 306$bcargs->{dbhost} and length $bcargs->{dbhost} and $DSN .= ";host=$bcargs->{dbhost}"; 307$bcargs->{dbport} and length $bcargs->{dbport} and $DSN .= ";port=$bcargs->{dbport}"; 308 309## Connect to the database 310$dbh = DBI->connect($DSN, $bcargs->{dbuser}, $bcargs->{dbpass}, {AutoCommit=>0,RaiseError=>1,PrintError=>0}); 311 312## We only want to concern ourselves with things in the bucardo schema 313$dbh->do('SET search_path = bucardo'); 314 315## Make sure we find a valid Postgres version 316## Why do we check this after a successful install? 317## In case they get pg_dumped to a different (older) database. It has happened! :) 318check_version($dbh); ## dies on invalid version 319 320## Listen for the MCP. Not needed for old-school non-payload LISTEN/NOTIFY, but does no harm 321$dbh->do('LISTEN bucardo'); 322$dbh->commit(); 323 324## Set some global variables based on information from the bucardo_config table 325 326## The reason file records startup and shutdown messages 327$REASONFILE = get_config('reason_file'); 328($REASONFILE_LOG = $REASONFILE) =~ s{(?:[.][^.]+)?$}{.log}; 329 330## The directory Bucardo.pm writes PID and other information to 331my $PIDDIR = $bcargs->{piddir} || get_config('piddir'); 332 333## The PID file of the master control file (MCP) 334## If this exists, it is a good bet that Bucardo is currently running 335my $PIDFILE = "$PIDDIR/bucardo.mcp.pid"; 336 337## The stop file whose existence tells all Bucardo processes to exit immediately 338my $stopfile = get_config('stopfile'); 339$STOPFILE = "$PIDDIR/$stopfile"; 340 341## Aliases for terms people may shorten, misspell, etc. 342## Mostly used for database columns when doing an 'update' 343our %alias = ( 344 'ssp' => 'server_side_prepares', 345 'server_side_prepare' => 'server_side_prepares', 346 'port' => 'dbport', 347 'host' => 'dbhost', 348 'name' => 'dbname', 349 'user' => 'dbuser', 350 'pass' => 'dbpass', 351 'password' => 'dbpass', 352 'service' => 'dbservice', 353 'dsn' => 'dbdsn', 354); 355 356## Columns that cannot be changed: used in the update_* subroutines 357my %column_no_change = ( 358 'id' => 1, 359 'cdate' => 1, 360); 361 362## Regular expression for a valid dbgroup name 363my $re_dbgroupname = qr{\w[\w\d]*}; 364 365## Regular expression for a valid database name 366my $re_dbname = qr{\w[\w\d]*}; 367 368## Send a ping to the MCP to make sure it is alive and responding 369ping() if $verb eq 'ping'; 370 371## Make sure the Bucardo database has the latest schema 372upgrade() if $verb =~ /^upgr/ or $verb eq 'uprgade' or $verb eq 'ugprade'; 373 374## All the rest of the verbs require use of global information 375## Thus, we load everything right now 376load_bucardo_info(); 377 378## View the status of one or more syncs 379status_all() if $verb eq 'status' and ! @nouns; 380status_detail() if $verb eq 'status'; 381 382## Stop, start, or restart the main Bucardo daemon 383stop() if $verb eq 'stop'; 384start() if $verb eq 'start' or $verb eq 'strt'; 385restart() if $verb eq 'restart'; 386 387## Reload the configuration file 388reload_config() if $verb eq 'reload' and defined $nouns[0] and $nouns[0] eq 'config'; 389 390## Reload the mcp (if args, we want reload_sync) 391reload() if $verb eq 'reload' and ! defined $nouns[0]; 392 393# Reopen the log files 394reopen() if $verb eq 'reopen'; 395 396## Show information about something: database, table, sync, etc. 397list_item() if $verb eq 'list' or $verb eq 'l' or $verb eq 'lsit' or $verb eq 'liast' 398 or $verb eq 'lisy' or $verb eq 'lit'; 399 400## Add something 401add_item() if $verb eq 'add'; 402 403## Remove something 404remove_item() if $verb eq 'remove' or $verb eq 'delete' or $verb eq 'del'; 405 406## Update something 407update_item() if $verb eq 'update' or $verb eq 'upd' or $verb eq 'udpate'; 408 409## Inspect something 410inspect() if $verb eq 'inspect'; 411 412## Inject a message into the Bucardo logs 413message() if $verb eq 'message' or $verb eq 'msg'; 414 415## Show or set an item from the bucardo.config table 416config() if $verb eq 'set' or $verb eq 'show' or $verb eq 'config'; 417 418## Validate a sync 419validate() if $verb =~ /^vali/; 420 421## Purge the delta/track tables 422purge() if $verb eq 'purge'; 423 424## Clone a database 425clone() if $verb eq 'clone'; 426 427## View delta statistics 428count_deltas() if $verb eq 'delta' or $verb eq 'deltas'; 429 430## There are only a few valid verbs left, so we check for them now 431if ($verb ne 'kick' and $verb ne 'activate' and $verb ne 'deactivate' 432 and $verb ne 'reload' 433 and $verb ne 'pause' and $verb ne 'resume') { 434 ## Show help and exit 435 help(1, qq{Unknown command "$verb"\n}); 436} 437 438## For all remaining verbs, we expect a list of syncs with an optional decimal "timeout" 439 440## If there are no syncs, no sense in going on! 441if (! keys %$SYNC) { 442 die qq{No syncs have been created yet!\n}; 443} 444 445## The final list of syncs we are going to do something to 446my @syncs; 447 448## The fail msg on a non-match 449my $msg; 450 451## Loop through each noun and handle it 452SYNCMATCH: for my $sync (@nouns) { 453 454 ## Quick skipping of noise word 'sync' 455 next if $sync =~ /^syncs?$/; 456 457 ## If this is a number, it's a timeout, so set it and skip to the next noun 458 if ($sync =~ /^\d+$/) { 459 $adverb = $sync; 460 next SYNCMATCH; 461 } 462 463 ## If they want all syncs, grab them all and stop reading any more nouns 464 if ($sync eq 'all') { 465 undef @syncs; 466 for my $name (sort keys %$SYNC) { 467 push @syncs => $name; 468 } 469 last SYNCMATCH; 470 } 471 472 ## The rest are all ways of finding the sync they want 473 ## Change the name to a Perl-regex friendly form 474 (my $term = $sync) =~ s/%/\*/g; 475 $term =~ s/([^\.])\*/$1.*/g; 476 $term =~ s/^\*/.*/; 477 478 if ($term =~ /\*/) { 479 for my $name (sort keys %$SYNC) { 480 push @syncs => $name if $name =~ /^$term$/; 481 } 482 next SYNCMATCH; 483 } 484 485 ## Now that wildcards are out, we must have an absolute match 486 if (! exists $SYNC->{$sync}) { 487 $msg = qq{Sync "$sync" does not appear to exist\n}; 488 ## No sense in going on 489 last SYNCMATCH; 490 } 491 492 ## Got a direct match, so store it away 493 push @syncs => $sync; 494 495} 496 497## If syncs is empty, a regular expression search failed 498if (!@syncs) { 499 $msg = qq{No matching syncs were found\n}; 500} 501 502## If we have a message, something is wrong 503if (defined $msg) { 504 ## Be nice and print a list of active syncs 505 my @goodsyncs; 506 for my $s (sort keys %$SYNC) { 507 push @goodsyncs => $s if $SYNC->{$s}{status} eq 'active'; 508 } 509 if (@goodsyncs) { 510 $msg .= "Active syncs:\n"; 511 $msg .= join "\n" => map { " $_" } @goodsyncs; 512 } 513 die "$msg\n"; 514} 515 516## Activate or deactivate one or more syncs 517vate_sync() if $verb eq 'activate' or $verb eq 'deactivate'; 518 519## Kick one or more syncs 520kick() if $verb eq 'kick'; 521 522## Pause or resume one or more syncs 523pause_resume($verb) if $verb eq 'pause' or $verb eq 'resume'; 524 525## Reload one or more syncs 526reload_sync() if $verb eq 'reload'; 527 528 529## If we reach here (and we should not), display help and exit 530help(1); 531 532exit; 533 534## Everything from here on out is subroutines 535 536 537sub get_config { 538 539 ## Given a name, return the matching value from the bucardo_config table 540 ## Arguments: one 541 ## 1. setting name 542 ## Returns: bucardo_config.value string 543 544 my $name = shift; 545 546 $SQL = 'SELECT setting FROM bucardo.bucardo_config WHERE LOWER(name) = ?'; 547 $sth = $dbh->prepare_cached($SQL); 548 $count = $sth->execute(lc $name); 549 if ($count < 1) { 550 $sth->finish(); 551 die "Invalid bucardo_config setting: $name\n"; 552 } 553 return $sth->fetchall_arrayref()->[0][0]; 554 555} ## end of get_config 556 557 558sub numbered_relations { 559 560 ## Sorting function 561 ## Arguments: none (implicit $a / $b via Perl sorting) 562 ## Returns: winning value 563 ## Sorts relations of the form schema.table 564 ## in which we do alphabetical first, but switch to numeric order 565 ## for any numbers at the end of the schema or the table 566 ## Thus, public.foobar1 will come before public.foobar10 567 568 ## Pull in the names to be sorted, dereference as needed 569 my $uno = ref $a ? "$a->{schemaname}.$a->{tablename}" : $a; 570 my $dos = ref $b ? "$b->{schemaname}.$b->{tablename}" : $b; 571 572 ## Break apart the first item into schema and table 573 die if $uno !~ /(.+)\.(.+)/; 574 my ($schema1,$sbase1,$table1,$tbase1) = ($1,$1,$2,$2); 575 ## Store ending numbers if available: if not, use 0 576 my ($snum1, $tnum1) = (0,0); 577 $sbase1 =~ s/(\d+)$// and $snum1 = $1; 578 $tbase1 =~ s/(\d+)$// and $tnum1 = $1; 579 580 ## Break apart the second item into schema and table 581 die if $dos !~ /(.+)\.(.+)/; 582 my ($schema2,$sbase2,$table2,$tbase2) = ($1,$1,$2,$2); 583 my ($snum2, $tnum2) = (0,0); 584 $sbase2 =~ s/(\d+)$// and $snum2 = $1; 585 $tbase2 =~ s/(\d+)$// and $tnum2 = $1; 586 587 return ( 588 $sbase1 cmp $sbase2 589 or $snum1 <=> $snum2 590 or $tbase1 cmp $tbase2 591 or $tnum1 <=> $tnum2); 592 593} ## end of numbered_relations 594 595 596sub check_version { 597 598 ## Quick check that we have the minumum supported version 599 ## This is for the bucardo database itself 600 ## Arguments: one 601 ## 1. Database handle 602 ## Returns: undef (may die if the version is not good) 603 604 my $dbh = shift; 605 my $res = $dbh->selectall_arrayref('SELECT version()')->[0][0]; 606 if ($res !~ /\D+(\d+)(.+?)\s/) { 607 die "Sorry, unable to determine the database version\n"; 608 } 609 my ($maj,$extra) = ($1,$2); 610 if ($maj < 8 or (8 == $maj and $extra =~ /\.0/)) { 611 die "Sorry, Bucardo requires Postgres version 8.1 or higher.\n"; 612 } 613 614 return; 615 616} ## end of check_version 617 618sub _pod2usage { 619 require Pod::Usage; 620 Pod::Usage::pod2usage( 621 '-verbose' => 99, 622 '-exitval' => 2, 623 @_ 624 ); 625 return; 626} 627 628sub help { 629 630 my ($exitval, $message) = @_; 631 632 ## Give detailed help about usage of this program 633 ## Arguments: none 634 ## Returns: never, always exits 635 636 ## Nothing to do if we are being quiet 637 exit 0 if $QUIET; 638 639 _pod2usage( 640 '-message' => $message, 641 '-sections' => '^(?:USAGE|COMMANDS|OPTIONS)$', 642 '-exitval' => $exitval || 0, 643 ); 644 645 return; 646 647} ## end of help 648 649sub superhelp { 650 651 ## Show detailed help by examining the verb and nouns 652 ## Arguments: none 653 ## Returns: never, always exits 654 655 ## If there are no nouns, we can only show the generic help 656 help() if ! @nouns; 657 658 # Make sure all commands and actions, as well as their aliases, are here. 659 my %names = ( 660 ( map { $_ => 'relgroup' } qw(relgroup herd) ), 661 ( map { $_ => 'db' } qw(db database) ), 662 ( map { $_ => 'list' } qw(l lsit liast lisy lit) ), 663 ( map { $_ => 'upgrade' } qw(upgrade uprgade ugprade) ), 664 ( map { $_ => 'start' } qw(start strt) ), 665 ( map { $_ => 'remove' } qw(remove delete del) ), 666 ( map { $_ => 'update' } qw(update upd udpate) ), 667 map { $_ => $_ } qw( 668 activate 669 add 670 all 671 config 672 customcode 673 customcols 674 customname 675 dbgroup 676 deactivate 677 delta 678 help 679 inspect 680 install 681 kick 682 list 683 message 684 ping 685 purge 686 reload 687 reload 688 restart 689 sequence 690 sequences 691 set 692 show 693 status 694 stop 695 sync 696 table 697 tables 698 validate 699 ), 700 ); 701 702 # Standardize names. 703 my @names; 704 for my $noun (@nouns) { 705 push @names => $names{ lc $noun } || $names{ standardize_name($noun) } 706 || help( 1, 'Unknown command: ' . join ' ' => @nouns ); 707 } 708 709 my @command = ($names[0]); 710 if (@names > 1) { 711 ## Actions are documented in Pod as "=head3 $action $command". 712 push @command, join ' ', @names; 713 } 714 else { 715 ## Don't show subsections for commands that have them. 716 push @command, => '!.+' if $names[0] eq 'add' || $names[0] eq 'update'; 717 } 718 usage_exit(join('/' => @command), 0); 719 720 return; 721 722} ## end of superhelp 723 724 725sub ping { 726 727 ## See if the MCP is alive and responds to pings 728 ## Default is to wait 15 seconds 729 ## Arguments: none, but looks in @nouns for a timeout 730 ## Returns: never, exits 731 732 ## Set the default timeout, but override if any remaining args start with a number 733 my $timeout = 15; 734 for (@nouns) { 735 if (/^(\d+)/) { 736 $timeout = $1; 737 last; 738 } 739 } 740 741 $VERBOSE and print "Pinging MCP, timeout = $timeout\n"; 742 $dbh->do('LISTEN bucardo_mcp_pong'); 743 $dbh->do('NOTIFY bucardo_mcp_ping'); 744 $dbh->commit(); 745 my $starttime = time; 746 sleep 0.1; 747 748 ## Loop until we timeout or get a confirmation from the MCP 749 P:{ 750 ## Grab any notices that have come in 751 my $notify = $dbh->func('pg_notifies'); 752 if (defined $notify) { 753 ## Extract the PID that sent this notice 754 my ($name, $pid, $payload) = @$notify; 755 ## We are done: ping successful 756 $QUIET or print "OK: Got response from PID $pid\n"; 757 exit 0; 758 } 759 760 ## Rollback, sleep, and check for a timeout 761 $dbh->rollback(); 762 sleep 0.5; 763 my $totaltime = time - $starttime; 764 if ($timeout and $totaltime >= $timeout) { 765 ## We are done: ping failed 766 $QUIET or print "CRITICAL: Timed out ($totaltime s), no ping response from MCP\n"; 767 exit 1; 768 } 769 redo; 770 } 771 772 return; 773 774} ## end of ping 775 776 777sub start { 778 779 ## Attempt to start the Bucardo daemon 780 ## Arguments: none 781 ## Returns: undef 782 783 ## Write a note to the 'reason' log file 784 ## This will automatically write any nouns in as well 785 append_reason_file('start'); 786 787 ## Refuse to go on if we get a ping response within 5 seconds 788 $QUIET or print "Checking for existing processes\n"; 789 790 ## We refuse to start if the MCP PID file exists and looks valid 791 if (-e $PIDFILE) { 792 open my $fh, '<', $PIDFILE or die qq{Could not open "$PIDFILE": $!\n}; 793 my $pid = <$fh> =~ /(\d+)/ ? $1 : 0; 794 close $fh or warn qq{Could not close $PIDFILE: $!\n}; 795 796 $msg = qq{Cannot start, PID file "$PIDFILE" exists\n}; 797 if (!$pid) { 798 warn qq{File "$PIDFILE" does not start with a PID!\n}; 799 } 800 else { 801 ## We have a PID, see if it is still alive 802 my $res = kill 0 => $pid; 803 if (0 == $res) { 804 warn qq{Removing file "$PIDFILE" with stale PID $pid\n}; 805 unlink $PIDFILE; 806 $msg = ''; 807 } 808 } 809 810 if ($msg) { 811 $QUIET or print $msg; 812 813 append_reason_file('fail'); 814 815 exit 1; 816 } 817 } 818 819 ## Verify that the version in the database matches our version 820 my $dbversion = get_config('bucardo_version') 821 or die "Could not find Bucardo version!\n"; 822 if ($dbversion ne $VERSION) { 823 my $message = "Version mismatch: bucardo is $VERSION, but bucardo database is $dbversion\n"; 824 append_reason_file('fail'); 825 warn $message; 826 warn "Perhaps you need to run 'bucardo upgrade' ?\n"; 827 exit 1; 828 } 829 830 ## Create a new Bucardo daemon 831 ## If we are a symlink, put the source directory in our path 832 if (-l $progname and readlink $progname) { 833 my $dir = dirname( readlink $progname ); 834 unshift @INC, $dir; 835 } 836 require Bucardo; 837 $bcargs->{exit_on_nosync} = delete $bcargs->{'exit-on-nosync'} 838 if exists $bcargs->{'exit-on-nosync'}; 839 my $bc = Bucardo->new($bcargs); 840 841 ## Verify that the version of Bucardo.pm matches our version 842 my $pm_version = $bc->{version} || 'unknown'; 843 if ($VERSION ne $pm_version) { 844 my $message = "Version mismatch: bucardo is $VERSION, but Bucardo.pm is $pm_version\n"; 845 append_reason_file('fail'); 846 die $message; 847 } 848 849 my $had_stopfile = -e $STOPFILE; 850 851 ## Just in case, stop it 852 stop_bucardo(); 853 854 if ($had_stopfile) { 855 print qq{Removing file "$STOPFILE"\n} unless $QUIET; 856 } 857 unlink $STOPFILE; 858 859 $QUIET or print qq{Starting Bucardo\n}; 860 861 ## Disconnect from our local connection before we fork 862 $dbh->disconnect(); 863 864 ## Remove nouns from @opts. 865 ## XXX Will fail if an option value is the same as a noun. 866 my %remove = map { $_ => undef } @nouns; 867 @opts = grep { ! exists $remove{$_} } @opts; 868 869 ## Fork and setsid to disassociate ourselves from the daemon 870 if (fork) { 871 ## We are the kid, do nothing 872 } 873 else { 874 setsid() or die; 875 ## Here we go! 876 $bc->start_mcp( \@opts ); 877 } 878 879 exit 0; 880 881} ## end of start 882 883 884sub stop { 885 886 ## Attempt to stop the Bucardo daemon 887 ## Arguments: none 888 ## Returns: undef 889 890 ## Write a note to the 'reason' log file 891 append_reason_file('stop'); 892 893 print "Creating $STOPFILE ... " unless $QUIET; 894 stop_bucardo(); 895 print "Done\n" unless $QUIET; 896 897 ## If this was called directly, just exit now 898 exit 0 if $verb eq 'stop'; 899 900 return; 901 902} ## end of stop 903 904 905sub stop_bucardo { 906 907 ## Create the semaphore that tells all Bucardo processes to exit 908 ## Arguments: none 909 ## Returns: undef 910 911 ## Create the file, and write some quick debug information into it 912 ## The only thing the processe care about is if the file exists 913 open my $stop, '>', $STOPFILE or die qq{Could not create "$STOPFILE": $!\n}; 914 print {$stop} "Stopped by $progname on " . (scalar localtime) . "\n"; 915 close $stop or warn qq{Could not close "$STOPFILE": $!\n}; 916 917 return; 918 919} ## end of stop_bucardo 920 921 922sub restart { 923 924 ## Simple, really: stop, wait, start! 925 ## Arguments: none 926 ## Returns: undef 927 928 stop(); 929 sleep 3; 930 start(); 931 932 return; 933 934} ## end of restart 935 936 937sub reload { 938 939 ## Reload the MCP daemon 940 ## Effectively restarts everything 941 ## Arguments: none 942 ## Returns: never, exits 943 944 ## Is Bucardo active? 945 my $pong = 'bucardo_mcp_pong'; 946 $dbh->do("LISTEN $pong"); 947 $dbh->do('NOTIFY bucardo_mcp_ping'); 948 $dbh->commit(); 949 ## Wait a little bit, then scan for the confirmation message 950 sleep 0.1; 951 if (! wait_for_notice($dbh, $pong, 2)) { 952 die "Looks like Bucardo is not running, so there is no need to reload\n"; 953 } 954 955 ## We want to wait to hear from the MCP that it is done 956 my $done = 'bucardo_reloaded_mcp'; 957 $dbh->do("LISTEN $done"); 958 $dbh->do('NOTIFY bucardo_mcp_reload'); 959 $dbh->commit(); 960 961 ## Wait a little bit, then scan for the confirmation message 962 sleep 0.1; 963 my $timeout = $adverb || get_config('reload_config_timeout') || 30; 964 if (! wait_for_notice($dbh, $done, $timeout) ) { 965 die "Waited ${timeout}s, but Bucardo never confirmed the reload!\n" 966 . "HINT: Pass a longer timeout to the reload_config command or set the\n" 967 . "reload_config_timeout configuration setting to wait longer\n"; 968 } 969 print "DONE!\n"; 970 971 exit 0; 972 973} ## end of reload 974 975 976sub reload_config { 977 978 ## Reload configuration settings from the bucardo database, 979 ## then restart all controllers and kids 980 ## Arguments: none directly (but processes the nouns to check for numeric arg) 981 ## Returns: never, exits 982 983 ## Scan the nouns for a numeric argument. 984 ## If found, set as the adverb. 985 ## This will cause us to wait for confirmation or reload before exiting 986 for (@nouns) { 987 if (/^(\d+)$/) { 988 $adverb = $1; 989 last; 990 } 991 } 992 993 $QUIET or print qq{Forcing Bucardo to reload the bucardo_config table\n}; 994 995 ## Is Bucardo active? 996 my $pong = 'bucardo_mcp_pong'; 997 $dbh->do("LISTEN $pong"); 998 $dbh->do('NOTIFY bucardo_mcp_ping'); 999 $dbh->commit(); 1000 ## Wait a little bit, then scan for the confirmation message 1001 sleep 0.1; 1002 if (! wait_for_notice($dbh, $pong, 2)) { 1003 die "Looks like Bucardo is not running, so there is no need to reload\n"; 1004 } 1005 1006 ## We want to wait to hear from the MCP that it is done 1007 my $done = 'bucardo_reload_config_finished'; 1008 $dbh->do("LISTEN $done"); 1009 $dbh->do('NOTIFY bucardo_reload_config'); 1010 $dbh->commit(); 1011 1012 ## Wait a little bit, then scan for the confirmation message 1013 sleep 0.1; 1014 my $timeout = $adverb || get_config('reload_config_timeout') || 30; 1015 if (! wait_for_notice($dbh, $done, $timeout) ) { 1016 die "Waited ${timeout}s, but Bucardo never confirmed the configuration reload!\n" 1017 . "HINT: Pass a longer timeout to the reload_config command or set the\n" 1018 . "reload_config_timeout configuration setting to wait longer\n"; 1019 } 1020 print "DONE!\n"; 1021 1022 exit 0; 1023 1024} ## end of reload_config 1025 1026 1027sub wait_for_notice { 1028 1029 ## Keep hanging out until we get the notice we are waiting for 1030 ## Arguments: three 1031 ## 1. Database handle 1032 ## 2. String(s) to listen for 1033 ## 3. How long to wait (default is forever) 1034 ## Returns: 1 1035 ## If the strings argument is an array ref, this will return a hash ref 1036 ## where each key is a string we found, and the value is how many times we 1037 ## found it. Note that we return as soon as we've found at least one 1038 ## matching NOTIFY; we don't wait for the full timeout to see which 1039 ## messages show up. 1040 1041 my ($ldbh, $string, $howlong) = @_; 1042 my ($num_strings, %search_strings, %matches); 1043 my $found = 0; 1044 if (ref $string eq 'ARRAY') { 1045 $num_strings = scalar @$string; 1046 map { $search_strings{$_} = 1 } @$string; 1047 } 1048 else { 1049 $num_strings = 1; 1050 $search_strings{$string} = 1; 1051 } 1052 1053 my $start_time = [gettimeofday]; 1054 1055 WAITIN: { 1056 for my $notice (@{ db_get_notices($ldbh) }) { 1057 my ($name) = @$notice; 1058 if (exists $search_strings{$name}) { 1059 $found = 1; 1060 $matches{$name}++; 1061 } 1062 } 1063 last WAITIN if $found; 1064 1065 if (defined $howlong) { 1066 my $elapsed = tv_interval( $start_time ); 1067 return 0 if ($elapsed >= $howlong and (scalar keys %matches == 0)); 1068 } 1069 1070 $dbh->commit(); 1071 sleep($WAITSLEEP); 1072 redo; 1073 } 1074 1075 if (scalar keys %matches) { 1076 if ($num_strings == 1) { 1077 return 1; 1078 } 1079 else { 1080 return \%matches; 1081 } 1082 } 1083 else { 1084 if ($num_strings == 1) { 1085 return 0; 1086 } 1087 else { 1088 return {}; 1089 } 1090 } 1091} ## end of wait_for_notice 1092 1093 1094sub reload_sync { 1095 1096 ## Ask for one or more syncs to be reloaded 1097 ## Arguments: none directly (but processes the nouns for a list of syncs) 1098 ## Returns: never, exits 1099 1100 my $doc_section = 'reload'; 1101 usage_exit($doc_section) unless @nouns; 1102 1103 for my $syncname (@nouns) { 1104 1105 ## Be nice and allow things like $0 reload sync foobar 1106 next if $syncname eq 'sync'; 1107 1108 ## Make sure this sync exists, and grab its status 1109 $SQL = 'SELECT status FROM bucardo.sync WHERE name = ?'; 1110 $sth = $dbh->prepare($SQL); 1111 $count = $sth->execute($syncname); 1112 if ($count != 1) { 1113 warn "Invalid sync: $syncname\n"; 1114 $sth->finish(); 1115 next; 1116 } 1117 my $status = $sth->fetch()->[0]; 1118 1119 ## Skip any syncs that are not active 1120 if ($status ne 'active') { 1121 warn qq{Cannot reload: status of sync "$syncname" is $status\n}; 1122 next; 1123 } 1124 1125 ## We wait for the MCP to tell us that each sync is done reloading 1126 my $done = "bucardo_reloaded_sync_$syncname"; 1127 my $err = "bucardo_reload_error_sync_$syncname"; 1128 print "Reloading sync $syncname..."; 1129 $dbh->do(qq{LISTEN "$done"}); 1130 $dbh->do(qq{LISTEN "$err"}); 1131 $dbh->do(qq{NOTIFY "bucardo_reload_sync_$syncname"}); 1132 $dbh->commit(); 1133 1134 ## Sleep a little, then wait until we hear a confirmation from the MCP 1135 sleep 0.1; 1136 my $res = wait_for_notice($dbh, [$err, $done], 10); 1137 if ($res == 0 or scalar keys %$res == 0) { 1138 print "Reload of sync $syncname failed; reload response message never received\n"; 1139 } 1140 elsif (exists $res->{$done}) { 1141 print "Reload of sync $syncname successful\n"; 1142 } 1143 elsif (exists $res->{$err}) { 1144 print "Reload of sync $syncname failed\n"; 1145 } 1146 else { 1147 print "ERROR. Reload results unavailable, because something weird happened.\n"; 1148 } 1149 print "\n"; 1150 1151 } ## end each sync to be reloaded 1152 1153 exit 0; 1154 1155} ## end of reload_sync 1156 1157 1158sub reopen { 1159 1160 ## Signal the bucardo processes that they should reopen any log files 1161 ## Used after a log rotation 1162 ## Sends a USR2 to all Bucardo processes 1163 ## Arguments: none 1164 ## Returns: never, exits 1165 1166 open my $fh, '<', $PIDFILE 1167 or die qq{Could not open pid file $PIDFILE: is Bucardo running?\n}; 1168 1169 ## Grab the PID of the MCP 1170 if (<$fh> !~ /(\d+)/) { ## no critic 1171 die qq{Could not find a PID in file $PIDFILE!\n}; 1172 } 1173 close $fh or warn qq{Could not close $PIDFILE: $!\n}; 1174 1175 my $gid = getpgrp $1; 1176 $gid =~ /^\d+$/ or die qq{Unable to obtain the process group\n}; 1177 1178 ## Quick mapping of names to numbers so we can kill effectively 1179 my $x = 0; 1180 my %signumber; 1181 for (split(' ', $Config{sig_name})) { 1182 $signumber{$_} = $x++; 1183 } 1184 1185 my $signumber = $signumber{USR2}; 1186 1187 ## The minus indicates we are sending to the whole group 1188 my $num = kill -$signumber, $gid; 1189 if ($num < 1) { 1190 warn "Unable to signal any processed with USR2\n"; 1191 exit 1; 1192 } 1193 $QUIET or print "Sent USR2 to Bucardo processes\n"; 1194 1195 exit 0; 1196 1197} ## end of reopen 1198 1199 1200sub validate { 1201 1202 ## Attempt to validate one or more syncs 1203 ## Arguments: none directly (but processes the nouns for a list of syncs) 1204 ## Returns: never, exits 1205 1206 my $doc_section = 'validate'; 1207 usage_exit($doc_section) unless @nouns; 1208 1209 ## Build the list of syncs to validate 1210 my @synclist; 1211 1212 ## Nothing specific is the same as 'all' 1213 if ($nouns[0] eq 'all' and ! defined $nouns[1]) { 1214 @synclist = sort keys %$SYNC; 1215 if (! @synclist) { 1216 print "Sorry, there are no syncs to validate!\n"; 1217 exit 0; 1218 } 1219 } 1220 else { 1221 for my $name (@nouns) { 1222 1223 ## Be nice and allow things like $0 validate sync foobar 1224 next if $name eq 'sync'; 1225 1226 if (! exists $SYNC->{$name}) { 1227 die qq{Sorry, there is no sync named "$name"\n}; 1228 } 1229 push @synclist => $name; 1230 } 1231 } 1232 1233 ## Get the largest sync name so we can line up the dots all pretty 1234 my $maxsize = 1; 1235 for my $name (@synclist) { 1236 $maxsize = length $name if length $name > $maxsize; 1237 } 1238 $maxsize += 3; 1239 1240 ## Loop through and validate each in turn, 1241 ## waiting for a positive response from the MCP 1242 my $exitval = 0; 1243 for my $name (@synclist) { 1244 1245 printf "Validating sync $name %s ", 1246 '.' x ($maxsize - length $name); 1247 1248 my ($evalok, $success); 1249 eval { 1250 my ($message) = $dbh->selectrow_array( 1251 'SELECT validate_sync(?)', 1252 undef, $name 1253 ); 1254 $dbh->commit; 1255 if ($message eq 'MODIFY') { 1256 $success = 1; 1257 } 1258 else { 1259 warn "$message\n"; 1260 $exitval++; 1261 } 1262 $evalok = 1; 1263 }; 1264 1265 if ($evalok) { 1266 print "OK\n" if $success; 1267 } 1268 else { 1269 warn $dbh->errstr || $@; 1270 $exitval++; 1271 } 1272 1273 } 1274 1275 exit $exitval; 1276 1277} ## end of validate 1278 1279 1280sub count_deltas { 1281 1282 ## Count up rows in the delta tables 1283 ## Does not remove "unvacuumed" rows: assumes delta tables are getting emptied out by VAC 1284 ## Arguments: optional 1285 ## Returns: nothing, exits 1286 1287 ## May want to see totals only 1288 my $total_only = (defined $nouns[0] and $nouns[0] =~ /totals?/i) ? 1 : 0; 1289 1290 ## See if we want to limit it to specific databases 1291 my %dblimit; 1292 for my $name (@nouns) { 1293 1294 ## Do not limit if doing a total, even if other names are specified 1295 next if $total_only; 1296 1297 ## Allow wildcards 1298 if ($name =~ s/[%*]/.*/) { 1299 for (grep { $_ =~ /$name/ } keys %$DB) { 1300 $dblimit{$_}++; 1301 } 1302 } 1303 elsif (exists $DB->{$name}) { 1304 $dblimit{$name}++; 1305 } 1306 } 1307 1308 ## No matches means we stop right away 1309 if (@nouns and !keys %dblimit and !$total_only) { 1310 warn qq{No matching databases were found: try "bucardo list dbs"\n}; 1311 exit 1; 1312 } 1313 1314 my $total = { grand => 0 }; 1315 1316 for my $dbname (sort keys %$DB) { 1317 my $db = $DB->{$dbname}; 1318 1319 ## Only sources should get checked 1320 if (! $db->{issource}) { 1321 if (delete $dblimit{$dbname}) { 1322 print "Skipping database $dbname: not a source\n"; 1323 } 1324 elsif ($VERBOSE >= 1) { 1325 print "Skipping $dbname: not a source\n"; 1326 } 1327 next; 1328 } 1329 1330 ## If we are limiting, possibly skip this one 1331 next if keys %dblimit and ! exists $dblimit{$dbname}; 1332 1333 ## Make sure it has a bucardo schema. 1334 ## May not if validate_sync has never been run! 1335 my $dbh = connect_database($dbname); 1336 1337 if (! schema_exists('bucardo')) { 1338 warn "Cannot check database $dbname: no bucardo schema!\n"; 1339 next; 1340 } 1341 1342 ## Grab all potential delta tables 1343 $SQL = 'SELECT deltaname FROM bucardo.bucardo_delta_names'; 1344 for my $row (@{ $dbh->selectall_arrayref($SQL) }) { 1345 my $tname = $row->[0]; 1346 $SQL = "SELECT count(*) FROM bucardo.$tname"; 1347 $count = $dbh->selectall_arrayref($SQL)->[0][0]; 1348 $total->{grand} += $count; 1349 $total->{database}{$dbname} += $count; 1350 if ($db->{status} ne 'active') { 1351 $total->{databaseinactive}{$dbname} = 1; 1352 } 1353 } 1354 $dbh->disconnect(); 1355 } 1356 1357 ## Stop here if we did not actually scan any databases because they are all non-source 1358 if (! keys %{ $total->{database} }) { 1359 print "No databases to check\n"; 1360 exit 1; 1361 } 1362 1363 ## Figure out our sizes for a pretty alignment 1364 my $grandmessage = 'Total deltas across all targets'; 1365 my $dbmessage = 'Total deltas for database'; 1366 my $size = { db => 0, largest => length $grandmessage, }; 1367 for my $db (keys %{ $total->{database} }) { 1368 $size->{db} = length $db if length $db > $size->{db}; 1369 my $len = length " $dbmessage $db"; 1370 $size->{largest} = $len if $len > $size->{largest}; 1371 } 1372 1373 printf "%*s: %s\n", $size->{largest}, $grandmessage, pretty_number($total->{grand}); 1374 1375 ## Break it down by database 1376 for my $db (sort keys %{ $total->{database} }) { 1377 next if $total_only; 1378 printf "%*s: %s%s\n", 1379 $size->{largest}, 1380 " $dbmessage $db", 1381 pretty_number($total->{database}{$db}), 1382 $total->{databaseinactive}{$db} ? ' (not active)' : ''; 1383 } 1384 1385 exit 0; 1386 1387} ## end of count_deltas 1388 1389 1390sub purge { 1391 1392 ## Purge the delta and track tables for one or more tables, for one or more databases 1393 ## Arguments: variable 1394 ## Returns: never, exits 1395 1396 ## TODO: databases, tables, timeslices 1397 1398 my $doc_section = 'purge'; 1399 1400 ## Nothing specific is the same as 'all' 1401 my $doall = 0; 1402 if (!@nouns or ($nouns[0] eq 'all' and ! defined $nouns[1])) { 1403 $doall = 1; 1404 for my $dbname (sort keys %$DB) { 1405 my $db = $DB->{$dbname}; 1406 ## Do not purge inactive databases 1407 next if $db->{status} ne 'active'; 1408 1409 ## Do not purge unless they are a source 1410 next if ! $db->{issource}; 1411 1412 print "Checking db $dbname\n"; 1413 1414 ## Make sure it has a bucardo schema. 1415 ## May not if validate_sync has never been run! 1416 my $dbh = connect_database($dbname); 1417 1418 if (! schema_exists('bucardo')) { 1419 warn "Cannot purge database $dbname: no bucardo schema!\n"; 1420 next; 1421 } 1422 1423 ## Run the purge_delta on this database 1424 $SQL = 'SELECT bucardo.bucardo_purge_delta(?)'; 1425 $sth = $dbh->prepare($SQL); 1426 $sth->execute('1 second'); 1427 my $results = $sth->fetchall_arrayref()->[0][0]; 1428 ## Dump the resulting message back to the user 1429 ## Should be like this: Tables processed: 3 1430 print "$dbname: $results\n"; 1431 1432 $dbh->commit(); 1433 1434 } 1435 } 1436 if (! $doall) { 1437 for my $name (@nouns) { 1438 die "Purging name $name\n"; 1439 } 1440 } 1441 1442 exit 0; 1443 1444} ## end of purge 1445 1446 1447sub add_item { 1448 1449 ## Add an item to the internal bucardo database 1450 ## Arguments: none directly (but processes the nouns) 1451 ## Returns: never, exits 1452 1453 my $doc_section = 'add/!.+'; 1454 usage_exit($doc_section) unless @nouns; 1455 1456 ## First word is the type of thing we are adding 1457 my $thing = shift @nouns; 1458 1459 ## Account for variations and abbreviations 1460 $thing = standardize_name($thing); 1461 1462 ## All of these will exit and do not return 1463 add_customcode() if $thing eq 'customcode'; 1464 add_customname() if $thing eq 'customname'; 1465 add_customcols() if $thing eq 'customcols'; 1466 add_database() if $thing eq 'database'; 1467 add_dbgroup() if $thing eq 'dbgroup'; 1468 add_herd() if $thing eq 'herd'; 1469 add_sync() if $thing eq 'sync'; 1470 1471 ## The rest is tables and sequences 1472 ## We need to support 'add table all' as well as 'add all tables' 1473 1474 my $second_arg = $nouns[0] || ''; 1475 1476 ## Rearrange the args as needed, and determine if we want 'all' 1477 my $do_all = 0; 1478 1479 if ($thing eq 'all') { 1480 $do_all = 1; 1481 $thing = shift @nouns; 1482 $thing = standardize_name($thing); 1483 } 1484 elsif (lc $second_arg eq 'all') { 1485 $do_all = 1; 1486 shift @nouns; 1487 } 1488 1489 ## Quick check in case someone thinks they should add a goat 1490 if ($thing =~ /^goat/i) { 1491 warn qq{Cannot add a goat: use add table or add sequence instead\n}; 1492 exit 1; 1493 } 1494 1495 ## Add a table 1496 if ($thing eq 'table') { 1497 if ($do_all) { 1498 ## Add all the tables, and return the output 1499 print add_all_tables(); 1500 ## The above does not commit, so make sure we do it here 1501 confirm_commit(); 1502 exit 0; 1503 } 1504 else { 1505 add_table('table'); 1506 } 1507 } 1508 1509 ## Add a sequence 1510 if ($thing eq 'sequence') { 1511 if ($do_all) { 1512 ## Add all the sequences, and return the output 1513 print add_all_sequences(); 1514 ## The above does not commit, so make sure we do it here 1515 $dbh->commit(); 1516 exit 0; 1517 } 1518 else { 1519 add_table('sequence'); 1520 } 1521 } 1522 1523 ## Anything past this point is an error 1524 if ($do_all) { 1525 warn qq{The 'all' option can only be used with 'table' and 'sequence'\n}; 1526 exit 1; 1527 } 1528 1529 usage_exit($doc_section); 1530 1531 return; 1532 1533} ## end of add_item 1534 1535 1536sub update_item { 1537 1538 ## Update some object in the database 1539 ## This merely passes control on to the more specific update_ functions 1540 ## Arguments: none (but parses nouns) 1541 ## Returns: undef 1542 1543 my $doc_section = 'update/!.+'; 1544 1545 ## Must have at least three nouns 1546 usage_exit($doc_section) if @nouns < 3; 1547 1548 ## What type of thing are we updating? 1549 my $thing = shift @nouns; 1550 1551 ## Account for variations and abbreviations 1552 $thing = standardize_name($thing); 1553 1554 my $code = $thing eq 'customcode' ? \&update_customcode 1555 : $thing eq 'database' ? \&update_database 1556 : $thing eq 'dbgroup' ? \&update_dbgroup 1557 : $thing eq 'sync' ? \&update_sync 1558 : $thing eq 'table' ? \&update_table 1559 : $thing eq 'sequence' ? \&update_table 1560 : usage_exit($doc_section) 1561 ; 1562 1563 ## The update function returns, due to recursion, so we must exit. 1564 $code->(@nouns); 1565 1566 exit 0; 1567 1568} ## end of update_item 1569 1570 1571sub list_item { 1572 1573 ## Show information about one or more items in the bucardo database 1574 ## Arguments: none, but parses nouns 1575 ## Returns: 0 on success, -1 on error 1576 1577 my $doc_section = 'list'; 1578 usage_exit($doc_section) unless @nouns; 1579 1580 ## First word is the type if thing we are listing 1581 my $thing = shift @nouns; 1582 1583 ## Account for variations and abbreviations 1584 $thing = standardize_name($thing); 1585 1586 SWITCH: { 1587 $thing eq 'clone' and do { 1588 list_clones(); 1589 last SWITCH; 1590 }; 1591 $thing eq 'config' and do { 1592 $verb = 'config'; 1593 config(); 1594 exit; 1595 }; 1596 $thing eq 'customcode' and do { 1597 list_customcodes(); 1598 last SWITCH; 1599 }; 1600 $thing eq 'customname' and do { 1601 list_customnames(); 1602 last SWITCH; 1603 }; 1604 $thing eq 'customcols' and do { 1605 list_customcols(); 1606 last SWITCH; 1607 }; 1608 ## The dbgroup must be checked before the database (dbg vs db) 1609 $thing eq 'dbgroup' and do { 1610 list_dbgroups(); 1611 last SWITCH; 1612 }; 1613 $thing eq 'database' and do { 1614 list_databases(); 1615 last SWITCH; 1616 }; 1617 $thing eq 'herd' and do { 1618 list_herds(); 1619 last SWITCH; 1620 }; 1621 $thing eq 'sync' and do { 1622 list_syncs(); 1623 last SWITCH; 1624 }; 1625 $thing eq 'table' and do { 1626 list_tables(); 1627 last SWITCH; 1628 }; 1629 $thing eq 'sequence' and do { 1630 list_sequences(); 1631 last SWITCH; 1632 }; 1633 $thing eq 'all' and do { 1634 ## Not shown on purpose: clones 1635 if (keys %$CUSTOMCODE) { 1636 print "-- customcodes:\n"; list_customcodes(); 1637 } 1638 if (keys %$CUSTOMNAME) { 1639 print "-- customnames:\n"; list_customnames(); 1640 } 1641 if (keys %$CUSTOMCOLS) { 1642 print "-- customcols:\n"; list_customcols(); 1643 } 1644 print "-- dbgroups:\n"; list_dbgroups(); 1645 print "-- databases:\n"; list_databases(); 1646 print "-- relgroup:\n"; list_herds(); 1647 print "-- syncs:\n"; list_syncs(); 1648 print "-- tables:\n"; list_tables(); 1649 print "-- sequences:\n"; list_sequences(); 1650 print "\n"; 1651 last SWITCH; 1652 }; 1653 1654 ## catch all 1655 ## Cannot list anything else 1656 usage_exit($doc_section); 1657 1658 } # SWITCH 1659 1660 exit 0; 1661 1662} ## end of list_item 1663 1664 1665sub remove_item { 1666 1667 ## Delete from the bucardo database 1668 ## Arguments: none, but parses nouns 1669 ## Returns: never, exits 1670 1671 my $doc_section = 'remove'; 1672 usage_exit($doc_section) unless @nouns; 1673 1674 ## First word is the type if thing we are removing 1675 my $thing = shift @nouns; 1676 ## Account for variations and abbreviations 1677 $thing = standardize_name($thing); 1678 my $second_arg = $nouns[0] || ''; 1679 1680 ## Allow the keyword 'all' to appear before or after the noun 1681 my $do_all = 0; 1682 if ($thing eq 'all') { 1683 $do_all = 1; 1684 $thing = shift @nouns; 1685 $thing = standardize_name($thing); 1686 } 1687 elsif (lc $second_arg eq 'all') { 1688 $do_all = 1; 1689 shift @nouns; 1690 } 1691 1692 my $arg = $do_all ? 'all' : ''; 1693 1694 ## All of these will exit and do not return 1695 remove_customcode($arg) if $thing eq 'customcode'; 1696 remove_customname($arg) if $thing eq 'customname'; 1697 remove_customcols($arg) if $thing eq 'customcols'; 1698 ## The dbgroup must be checked before the database (dbg vs db) 1699 remove_database($arg) if $thing eq 'database'; 1700 remove_dbgroup($arg) if $thing eq 'dbgroup'; 1701 remove_herd($arg) if $thing eq 'herd'; 1702 remove_sync($arg) if $thing eq 'sync'; 1703 1704 remove_relation('table', $arg) if $thing eq 'table'; 1705 remove_relation('sequence', $arg) if $thing eq 'sequence'; 1706 1707 ## Do not know how to remove anything else 1708 usage_exit($doc_section); 1709 1710 return; 1711 1712} ## end of remove_item 1713 1714 1715## 1716## Database-related subroutines: add, remove, update, list 1717## 1718 1719sub add_database { 1720 1721 ## Add one or more databases. Inserts to the bucardo.db table 1722 ## By default, we do a test connection as well (turn off with the --force argument) 1723 ## Arguments: two or more 1724 ## 1. The internal name Bucardo uses to refer to this database 1725 ## 2+ name=value parameters, dash-dash arguments 1726 ## Returns: undef 1727 ## Example: bucardo add db nyc1 dbname=nyc1 dbhost=nyc1.example.com dbgroup=sales 1728 ## Example: bucardo add dbs nyc1,nyc2 dbname=nyc1,nyc2 dbgroup=sales 1729 1730 ## Grab our generic usage message 1731 my $doc_section = 'add/add db'; 1732 1733 ## The first word is the internal name (bucardo.db.name) - may have commas 1734 my $item_name = shift @nouns || ''; 1735 1736 ## No name is a problem 1737 usage_exit($doc_section) unless length $item_name; 1738 1739 ## We may have more than one database specified at once 1740 ## Assign to an array, and set the role as well in case a dbgroup is set 1741 my $db_names = []; 1742 my $newsource = 0; 1743 for my $entry (split /\s*,\s*/ => $item_name) { 1744 ## First database defaults to source, others to targets 1745 if (! @$db_names and $entry !~ /:/) { 1746 $entry .= ':source'; 1747 $newsource = 1; 1748 } 1749 push @{ $db_names } => [ extract_name_and_role($entry) ]; 1750 } 1751 1752 ## Inputs and aliases, database column name, flags, default value 1753 my $validcols = q{ 1754 db|dbname dbname 0 null 1755 type|dbtype dbtype 0 postgres 1756 pass|password|dbpass dbpass 0 null 1757 host|dbhost|pghost dbhost 0 ENV:PGHOSTADDR|PGHOST 1758 port|dbport|pgport dbport 0 ENV:PGPORT 1759 conn|dbconn|pgconn dbconn 0 null 1760 service|dbservice dbservice 0 null 1761 dsn|dbdsn dbdsn 0 null 1762 stat|status status =active|inactive null 1763 group|dbgroup dbgroup 0 null 1764 addalltables none 0 null 1765 addallsequences none 0 null 1766 server_side_prepares|ssp server_side_prepares TF null 1767 makedelta makedelta TF null 1768 }; 1769 1770 ## Include the value for the dbuser only if a service or dsn is not specified, or 1771 ## a user was explicitly included. In other words, don't default the user 1772 ## name when there's a service. 1773 $validcols .= "user|username|dbuser dbuser 0 bucardo\n" 1774 if ((! grep { /^(db)?service=/ or /dsn/ } @nouns) || grep { /^(db)?user(name)?=/ } @nouns); 1775 1776 my ($dbcols) = process_simple_args({ 1777 cols => $validcols, 1778 list => \@nouns, 1779 doc_section => $doc_section, 1780 }); 1781 1782 ## Must have a database name unless using a service or dsn 1783 if (! exists $dbcols->{dbname} && ! exists $dbcols->{dbservice} && ! exists $dbcols->{dbdsn}) { 1784 print qq{Cannot add database: must supply a database name to connect to\n}; 1785 exit 1; 1786 } 1787 1788 ## Cannot add if already there 1789 for my $db (map { $_->[0] } @$db_names) { 1790 if (exists $DB->{ $db }) { 1791 print qq{Cannot add database: the name "$db" already exists\n}; 1792 exit 1; 1793 } 1794 } 1795 1796 ## Clean up and standardize the type name 1797 my $dbtype = $dbcols->{dbtype} = standardize_rdbms_name($dbcols->{dbtype}); 1798 1799 ## If we have a service or DSN, strip the host and port as they may have been set via ENV 1800 if (exists $dbcols->{dbservice} or exists $dbcols->{dbdsn}) { 1801 delete $dbcols->{dbport}; 1802 delete $dbcols->{dbhost}; 1803 } 1804 1805 ## We do not want some things to hang around in the dbcols hash 1806 my $dbgroup = delete $dbcols->{dbgroup}; 1807 1808 ## Map each value into individual databases 1809 my %dbinfo; 1810 for my $k (sort keys %$dbcols) { 1811 ## Each db in db_names needs to have an associated value for each dbcol entry 1812 ## Hence, we only use dbcols to build list of columns: values are kept in a hash 1813 next if $dbcols->{$k} !~ /,/; 1814 my @list = split /\s*,\s*/ => $dbcols->{$k}; 1815 my $value; 1816 ## The dbnames can contain role information: strip it out from here 1817 if ('dbname' eq $k) { 1818 @list = map { [extract_name_and_role($_)]->[0] } @list; 1819 } 1820 for (my $x=0; defined $db_names->[$x]; $x++) { 1821 $value = $list[$x] if defined $list[$x]; 1822 $dbinfo{$k}[$x] = $value; 1823 } 1824 } 1825 1826 ## Attempt to insert into the bucardo.db table 1827 my $columns = join ',' => keys %$dbcols; 1828 my $qs = '?,' x keys %$dbcols; 1829 $SQL = "INSERT INTO bucardo.db (name,$columns) VALUES (${qs}?)"; 1830 debug("SQL: $SQL"); 1831 $sth = $dbh->prepare($SQL); 1832 for (my $x = 0; defined $db_names->[$x]; $x++) { 1833 my @args; 1834 for my $key (keys %$dbcols) { 1835 push @args => exists $dbinfo{$key} ? $dbinfo{$key}->[$x] : $dbcols->{$key}; 1836 } 1837 my $evalok = 0; 1838 debug(Dumper $db_names->[$x]); 1839 debug(Dumper \@args); 1840 eval { 1841 $sth->execute($db_names->[$x][0], @args); 1842 $evalok = 1; 1843 }; 1844 1845 if (! $evalok) { 1846 1847 if ($@ =~ /"db_name_sane"/) { 1848 die qq{Invalid name: you cannot refer to this database as "$db_names->[$x]"\n}; 1849 } 1850 die "Failed to add database: $@\n"; 1851 } 1852 } 1853 1854 ## Store certain messages so we can output them in a desired order 1855 my $finalmsg = ''; 1856 1857 ## Test database handle 1858 my $testdbh; 1859 1860 ## May want to do a test connection to each databases 1861 TESTCONN: { 1862 1863 ## Nothing else to do for flatfiles 1864 last TESTCONN if 'flatfile' eq $dbtype; 1865 1866 ## Get the module name, the way to refer to its database 1867 ## This also makes sure we have a valid type 1868 my %dbtypeinfo = ( 1869 drizzle => ['DBD::drizzle', 'Drizzle database'], 1870 firebird => ['DBD::Firebird', 'Firebird database'], 1871 mongo => ['MongoDB', 'MongoDB'], 1872 mysql => ['DBD::mysql', 'MySQL database'], 1873 mariadb => ['DBD::mysql', 'MariaDB database'], 1874 oracle => ['DBD::Oracle', 'Oracle database'], 1875 postgres => ['DBD::Pg', 'PostgreSQL database'], 1876 redis => ['Redis', 'Redis database'], 1877 sqlite => ['DBD::SQLite', 'SQLite database'], 1878 ); 1879 if (! exists $dbtypeinfo{$dbtype}) { 1880 die qq{Unknown database type: $dbtype\n}; 1881 } 1882 my ($module,$fullname) = @{ $dbtypeinfo{$dbtype} }; 1883 1884 ## Gather connection information from the database via db_getconn 1885 $SQL = 'SELECT bucardo.db_getconn(?)'; 1886 $sth = $dbh->prepare($SQL); 1887 for my $db (map { $_->[0] } @$db_names) { 1888 $sth->execute($db); 1889 my $dbconn = $sth->fetchall_arrayref()->[0][0]; 1890 1891 ## Must be able to load the Perl driver 1892 my $evalok = 0; 1893 eval { 1894 eval "require $module"; 1895 $evalok = 1; 1896 }; 1897 if (! $evalok) { 1898 die "Cannot add unless the Perl module '$module' is available: $@\n"; 1899 } 1900 1901 ## Reset for the evals below 1902 $evalok = 0; 1903 1904 ## Standard args for the DBI databases 1905 ## We put it here as we may move around with the Postgres bucardo user trick 1906 my ($type,$dsn,$user,$pass) = split /\n/ => $dbconn; 1907 1908 ## Handle all of the ones that do not use standard DBI first 1909 1910 if ('mongo' eq $dbtype) { 1911 1912 ## Catch this nice and early - but also have a check in Bucardo.pm 1913 my $gotboolean = 0; 1914 eval { 1915 require boolean; 1916 $gotboolean = 1; 1917 }; 1918 if (! $gotboolean) { 1919 warn qq{Unable to load the Perl 'boolean' module: needed for MongoDB support\n}; 1920 } 1921 1922 my $mongoURI = 'mongodb://'; 1923 1924 if ($dsn =~ s/^DSN://) { 1925 ## Just in case: 1926 if ($dsn !~ /^mongodb:/) { 1927 $mongoURI .= $dsn; 1928 } 1929 else { 1930 $mongoURI = $dsn; 1931 } 1932 } 1933 else { 1934 1935 my $mongodsn = {}; 1936 for my $line (split /\n/ => $dbconn) { 1937 next if $line !~ /(\w+):\s+(.+)/; 1938 $mongodsn->{$1} = $2; 1939 } 1940 1941 if (exists $mongodsn->{dbuser}) { 1942 my $pass = $mongodsn->{dbpass} || ''; 1943 $mongoURI .= "$mongodsn->{dbuser}:$pass\@"; 1944 } 1945 $mongoURI .= $mongodsn->{host} || 'localhost'; 1946 $mongoURI .= ":$mongodsn->{port}" if exists $mongodsn->{port}; 1947 } 1948 1949 my $mongoversion = $MongoDB::VERSION; 1950 my $oldversion = $mongoversion =~ /^0\./ ? 1 : 0; 1951 1952 eval { 1953 $testdbh = $oldversion ? MongoDB::MongoClient->new(host => $mongoURI) : MongoDB->connect($mongoURI); 1954 $evalok = 1; 1955 }; 1956 } 1957 1958 elsif ('redis' eq $dbtype) { 1959 1960 my $tempdsn = {}; 1961 for my $line (split /\n/ => $dbconn) { 1962 next if $line !~ /(\w+):\s+(.+)/; 1963 $tempdsn->{$1} = $2; 1964 } 1965 my $server; 1966 if (exists $tempdsn->{host}) { 1967 $server = $tempdsn->{host}; 1968 } 1969 if (exists $tempdsn->{port}) { 1970 $server .= ":$tempdsn->{port}"; 1971 } 1972 my @dsn; 1973 if (defined $server) { 1974 push @dsn => 'server', $server; 1975 } 1976 1977 my ($pass, $index); 1978 if (exists $tempdsn->{pass}) { 1979 $pass = $tempdsn->{pass}; 1980 } 1981 if (exists $tempdsn->{name} and $tempdsn->{name} !~ /\D/) { 1982 $index = $tempdsn->{name}; 1983 } 1984 1985 push @dsn => 'on_connect', sub { 1986 $_[0]->client_setname('bucardo'); 1987 $_[0]->auth($pass) if $pass; 1988 $_[0]->select($index) if $index; 1989 }; 1990 1991 $evalok = 0; 1992 eval { 1993 $testdbh = Redis->new(@dsn); 1994 $evalok = 1; 1995 }; 1996 } 1997 1998 ## Anything else must be something with a standard DBI driver 1999 else { 2000 $dsn =~ s/^DSN://; 2001 eval { 2002 $testdbh = DBI->connect($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0}); 2003 $evalok = 1; 2004 }; 2005 } 2006 2007 ## At this point, we have eval'd a connection 2008 if ($evalok) { 2009 ## Disconnect from DBI. 2010 $testdbh->disconnect if $module =~ /DBD/; 2011 } 2012 else { 2013 my $err = $DBI::errstr || $@; 2014 2015 ## For Postgres, we get a little fancy and try to account for instances 2016 ## where the bucardo user may not exist yet, by reconnecting and 2017 ## creating said user if needed. 2018 if ($DBI::errstr 2019 and 'postgres' eq $dbtype 2020 and $user eq 'bucardo' 2021 and $DBI::errstr =~ /bucardo/ 2022 and eval { require Digest::MD5; 1 }) { 2023 2024 # Try connecting as postgres instead. 2025 print qq{Connection to "$db" ($fullname) as user bucardo failed.\nError was: $DBI::errstr\n\n}; 2026 print qq{Will try to connect as user postgres and create superuser $user...\n\n}; 2027 my $dbh = eval { 2028 DBI->connect($dsn, 'postgres', $pass, {AutoCommit=>1,RaiseError=>1,PrintError=>0}); 2029 }; 2030 if ($dbh) { 2031 ## Create the bucardo user now. We'll need a password; 2032 ## create one if we don't have one. 2033 my $connok = 0; 2034 eval { 2035 my $newpass = $pass || generate_password(); 2036 my $encpass = Digest::MD5::md5_hex($newpass); 2037 $dbh->do(qq{CREATE USER $user SUPERUSER ENCRYPTED PASSWORD '$encpass'}); 2038 $dbh->disconnect; 2039 my $extrauser = $pass ? '' : qq{ with password "$newpass"}; 2040 warn "Created superuser '$user'$extrauser\n\n"; 2041 $pass = $newpass; 2042 $connok = 1; 2043 }; 2044 goto TESTCONN if $connok; 2045 $err = $DBI::errstr || $@; 2046 $msg = "Unable to create superuser $user"; 2047 } 2048 else { 2049 $err = $DBI::errstr || $@; 2050 $msg = 'Connection as postgres failed, too'; 2051 } 2052 } 2053 else { 2054 $msg = qq{Connection to "$db" ($fullname) failed}; 2055 } 2056 2057 die "$msg. You may force add it with the --force argument.\nError was: $err\n\n" 2058 unless $bcargs->{force}; 2059 warn "$msg, but will add anyway.\nError was: $err\n"; 2060 } 2061 } ## End each database to connect to 2062 2063 } ## end of TESTCONN 2064 2065 ## If we got a group, process that as well 2066 if (defined $dbgroup) { 2067 2068 ## If the dbnames had supplied role information, extract that now 2069 if (exists $dbcols->{dbname} and $dbcols->{dbname} =~ /:/) { 2070 my $x=0; 2071 for my $namerole (split /\s*,\s*/ => $dbcols->{dbname}) { 2072 my ($name,$role) = extract_name_and_role($namerole); 2073 debug("$namerole gave us $name and $role"); 2074 $db_names->[$x++][1] = $role; 2075 } 2076 } 2077 2078 ## If it has an attached role, strip it out and force that everywhere 2079 my $master_role = $dbgroup =~ s/:(\w+)// ? $1 : 0; 2080 2081 ## We need to store this away as the function below changes the global hash 2082 my $isnew = exists $DBGROUP->{$dbgroup} ? 0 : 1; 2083 my $firstrow = 1; 2084 for my $row (@$db_names) { 2085 2086 my ($db,$role) = @$row; 2087 2088 ## If we set this source ourself, change to target if the group already exists 2089 if ($firstrow) { 2090 $firstrow = 0; 2091 if ($newsource and ! $isnew) { 2092 $role = 'target'; 2093 } 2094 } 2095 2096 ## The master role trumps everything 2097 $role = $master_role if $master_role; 2098 2099 my ($newgroup, $newrole) = add_db_to_group($db, "$dbgroup:$role"); 2100 if ($isnew) { 2101 $finalmsg .= qq{Created dbgroup "$newgroup"\n}; 2102 $isnew = 0; 2103 } 2104 $finalmsg .= qq{ Added database "$db" to dbgroup "$newgroup" as $newrole\n}; 2105 } 2106 } 2107 2108 ## Adjust the db name so add_all_* can use it 2109 $bcargs->{db} = $db_names->[0][0]; 2110 2111 ## Make sure $DB gets repopulated for the add_all_* calls below 2112 load_bucardo_info(1); 2113 2114 ## Add in all tables for this database 2115 $finalmsg .= add_all_tables() if grep /addalltab/i, @nouns; 2116 2117 ## Add in all sequences for this database 2118 $finalmsg .= add_all_sequences() if grep /addallseq/i, @nouns; 2119 2120 if (!$QUIET) { 2121 my $list = join ',' => map { qq{"$_->[0]"} } @$db_names; 2122 printf qq{Added %s %s\n}, 2123 $list =~ /,/ ? 'databases' : 'database', $list; 2124 $finalmsg and print $finalmsg; 2125 } 2126 2127 confirm_commit(); 2128 2129 exit 0; 2130 2131} ## end of add_database 2132 2133 2134sub remove_database { 2135 2136 ## Remove one or more databases. Updates the bucardo.db table 2137 ## Use the --force argument to clear out related tables and groups 2138 ## Arguments: one or more 2139 ## 1+ Name of a database 2140 ## Returns: undef 2141 ## Example: bucardo remove db nyc1 nyc2 --force 2142 2143 my $doc_section = 'remove'; 2144 usage_exit($doc_section) unless @nouns; 2145 2146 ## Make sure all named databases exist 2147 for my $name (@nouns) { 2148 if (! exists $DB->{$name}) { 2149 die qq{No such database "$name"\n}; 2150 } 2151 } 2152 2153 ## Prepare the SQL to delete each database 2154 $SQL = 'DELETE FROM bucardo.db WHERE name = ?'; 2155 $sth = $dbh->prepare($SQL); 2156 2157 ## Loop through and attempt to delete each given database 2158 for my $name (@nouns) { 2159 ## Wrap in an eval so we can handle known exceptions 2160 my $evalok = 0; 2161 $dbh->pg_savepoint('try_remove_db'); 2162 eval { 2163 $sth->execute($name); 2164 $evalok = 1; 2165 }; 2166 if (! $evalok) { 2167 if ($bcargs->{force} and $@ =~ /"goat_db_fk"|"dbmap_db_fk"/) { 2168 $QUIET or warn qq{Dropping all tables and dbgroups that reference database "$name"\n}; 2169 $dbh->pg_rollback_to('try_remove_db'); 2170 $dbh->do('DELETE FROM bucardo.goat WHERE db = ' . $dbh->quote($name)); 2171 $dbh->do('DELETE FROM bucardo.dbmap WHERE db = ' . $dbh->quote($name)); 2172 ## Try the same query again 2173 eval { 2174 $sth->execute($name); 2175 }; 2176 } 2177 2178 ## We've failed: output a reasonable message when possible 2179 if ($@ =~ /"goat_db_fk"/) { 2180 die qq{Cannot delete database "$name": must remove all tables that reference it first (try --force)\n}; 2181 } 2182 if ($@ =~ /"dbmap_db_fk"/) { 2183 die qq{Cannot delete database "$name": must remove all dbmap references first (try --force)\n}; 2184 } 2185 $@ and die qq{Could not delete database "$name"\n$@\n}; 2186 } 2187 } 2188 2189 for my $name (@nouns) { 2190 $QUIET or print qq{Removed database "$name"\n}; 2191 } 2192 2193 confirm_commit(); 2194 2195 exit 0; 2196 2197} ## end of remove_database 2198 2199 2200sub update_database { 2201 2202 ## Update one or more databases. 2203 ## This may modify the bucardo.db, bucardo.dbgroup, and bucardo.dbmap tables 2204 ## Arguments: two plus 2205 ## 1. Name of the database to update. Can be "all" and can have wildcards 2206 ## 2+ What exactly we are updating. 2207 ## Returns: undef 2208 ## Example: bucardo update db nyc1 port=6543 group=nycservers:source,globals 2209 2210 my @actions = @_; 2211 2212 ## Grab our generic usage message 2213 my $doc_section = 'update/update db'; 2214 usage_exit($doc_section) unless @actions; 2215 2216 my $name = shift @actions; 2217 2218 ## Recursively call ourselves for wildcards and 'all' 2219 return if ! check_recurse($DB, $name, @actions); 2220 2221 ## Make sure this database exists! 2222 if (! exists $DB->{$name}) { 2223 die qq{Could not find a database named "$name"\nUse 'list dbs' to see all available.\n}; 2224 } 2225 2226 ## Everything is a name=value setting after this point 2227 ## We will ignore and allow noise word "set" 2228 for my $arg (@actions) { 2229 next if $arg =~ /set/i; 2230 next if $arg =~ /\w+=\w+/o; 2231 usage_exit($doc_section); 2232 } 2233 2234 ## Change the arguments into a hash 2235 my $args = process_args(join ' ' => @actions); 2236 2237 ## Track what changes we made 2238 my %change; 2239 2240 ## Walk through and handle each argument pair 2241 for my $setting (sort keys %$args) { 2242 2243 next if $setting eq 'extraargs'; 2244 2245 ## Change the name to a more standard form, to better figure out what they really mean 2246 ## This also excludes all non-alpha characters 2247 my $newname = transform_name($setting); 2248 2249 ## Exclude ones that cannot / should not be changed (e.g. cdate) 2250 if (exists $column_no_change{$newname}) { 2251 print "Sorry, the value of $setting cannot be changed\n"; 2252 exit 1; 2253 } 2254 2255 ## Standardize the values as well 2256 my $value = $args->{$setting}; 2257 my $newvalue = transform_value($value); 2258 my $oldvalue = $DB->{$name}{$newname}; 2259 2260 ## We want certain booleans to appear as "off/on" 2261 if ($setting =~ /makedelta|server_side_prepares/) { 2262 $oldvalue = $oldvalue ? 'on' : 'off'; 2263 ## Clean up, but lightly so invalid entries fall through for later 2264 if ($newvalue =~ /^[1tT]/ or $newvalue =~ /^on/i) { 2265 $newvalue = 'on'; 2266 } 2267 elsif ($newvalue =~ /^[0fF]/ or $newvalue =~ /^off/i) { 2268 $newvalue = 'off'; 2269 } 2270 } 2271 2272 ## Handle all the non-standard columns 2273 if ($newname =~ /^group/) { 2274 2275 ## Track the changes and publish at the end 2276 my @groupchanges; 2277 2278 ## Grab the current hash of groups 2279 my $oldgroup = $DB->{$name}{group} || ''; 2280 2281 ## Keep track of what groups they end up in, so we can remove as needed 2282 my %donegroup; 2283 2284 ## Break apart into individual groups 2285 for my $fullgroup (split /\s*,\s*/ => $newvalue) { 2286 2287 my ($group,$role,$extra) = extract_name_and_role($fullgroup); 2288 2289 ## Note that we've found this group 2290 $donegroup{$group}++; 2291 2292 ## Does this group exist? 2293 if (! exists $DBGROUP->{$group}) { 2294 create_dbgroup($group); 2295 push @groupchanges => qq{Created dbgroup "$group"}; 2296 } 2297 2298 ## Are we a part of it already? 2299 if ($oldgroup and exists $oldgroup->{$group}) { 2300 2301 ## Same role? 2302 my $oldrole = $oldgroup->{$group}{role}; 2303 if ($oldrole eq $role) { 2304 $QUIET or print qq{No change: database "$name" already belongs to dbgroup "$group" as $role\n}; 2305 } 2306 else { 2307 change_db_role($role,$group,$name); 2308 push @groupchanges => qq{Changed role for database "$name" in dbgroup "$group" from $oldrole to $role}; 2309 } 2310 } 2311 else { 2312 ## We are not a part of this group yet 2313 add_db_to_group($name, "$group:$role"); 2314 push @groupchanges => qq{Added database "$name" to dbgroup "$group" as $role}; 2315 } 2316 2317 ## Handle any extra modifiers 2318 if (keys %$extra) { 2319 update_dbmap($name, $group, $extra); 2320 my $list = join ',' => map { "$_=$extra->{$_}" } sort keys %$extra; 2321 push @groupchanges => qq{For database "$name" in dbgroup "$group", set $list}; 2322 } 2323 2324 } ## end each group specified 2325 2326 ## See if we are removing any groups 2327 if ($oldgroup) { 2328 for my $old (sort keys %$oldgroup) { 2329 next if exists $donegroup{$old}; 2330 2331 ## Remove this database from the group, but do not remove the group itself 2332 remove_db_from_group($name, $old); 2333 push @groupchanges => qq{Removed database "$name" from dbgroup "$old"}; 2334 } 2335 } 2336 2337 if (@groupchanges) { 2338 for (@groupchanges) { 2339 chomp; 2340 $QUIET or print "$_\n"; 2341 } 2342 confirm_commit(); 2343 } 2344 2345 ## Go to the next setting 2346 next; 2347 2348 } ## end of 'group' adjustments 2349 2350 ## This must exist in our hash 2351 if (! exists $DB->{$name}{$newname}) { 2352 print qq{Cannot change "$newname"\n}; 2353 next; 2354 } 2355 2356 ## Has this really changed? 2357 if ($oldvalue eq $newvalue) { 2358 print "No change needed for $newname\n"; 2359 next; 2360 } 2361 2362 ## Add to the queue. Overwrites previous ones 2363 $change{$newname} = [$oldvalue, $newvalue]; 2364 2365 } ## end each setting 2366 2367 ## If we have any changes, attempt to make them all at once 2368 if (%change) { 2369 my $SQL = 'UPDATE bucardo.db SET '; 2370 $SQL .= join ',' => map { "$_=?" } sort keys %change; 2371 $SQL .= ' WHERE name = ?'; 2372 my $sth = $dbh->prepare($SQL); 2373 eval { 2374 $sth->execute((map { $change{$_}[1] } sort keys %change), $name); 2375 }; 2376 if ($@) { 2377 $dbh->rollback(); 2378 $dbh->disconnect(); 2379 print "Sorry, failed to update the bucardo.db table. Error was:\n$@\n"; 2380 exit 1; 2381 } 2382 2383 for my $item (sort keys %change) { 2384 my ($old,$new) = @{ $change{$item} }; 2385 print "Changed bucardo.db $item from $old to $new\n"; 2386 } 2387 2388 confirm_commit(); 2389 } 2390 2391 return; 2392 2393} ## end of update_database 2394 2395 2396sub list_databases { 2397 2398 ## Show information about databases. Queries the bucardo.db table 2399 ## Arguments: zero or more 2400 ## 1+ Databases to view. Can be "all" and can have wildcards 2401 ## Returns: 0 on success, -1 on error 2402 ## Example: bucardo list db sale% 2403 2404 ## Might be no databases yet 2405 if (! keys %$DB) { 2406 print "No databases have been added yet\n"; 2407 return -1; 2408 } 2409 2410 ## If not doing all, keep track of which to show 2411 my %matchdb; 2412 2413 for my $term (@nouns) { 2414 2415 ## Special case for all: same as no nouns at all, so simply remove them! 2416 if ($term =~ /\ball\b/i) { 2417 undef %matchdb; 2418 undef @nouns; 2419 last; 2420 } 2421 2422 ## Check for wildcards 2423 if ($term =~ s/[*%]/.*/) { 2424 for my $name (keys %$DB) { 2425 $matchdb{$name} = 1 if $name =~ /^$term$/; 2426 } 2427 next; 2428 } 2429 2430 ## Must be an exact match 2431 for my $name (keys %$DB) { 2432 $matchdb{$name} = 1 if $name eq $term; 2433 } 2434 2435 } ## end each term 2436 2437 ## No matches? 2438 if (@nouns and ! keys %matchdb) { 2439 print "No matching databases found\n"; 2440 return -1; 2441 } 2442 2443 ## We only show the type if they are different from each other 2444 my %typecount; 2445 2446 ## Figure out the length of each item for a pretty display 2447 my ($maxdb,$maxtype,$maxstat,$maxlim1,$maxlim2,$showlim) = (1,1,1,1,1,0); 2448 for my $name (sort keys %$DB) { 2449 next if @nouns and ! exists $matchdb{$name}; 2450 my $info = $DB->{$name}; 2451 $typecount{$info->{dbtype}}++; 2452 $maxdb = length $info->{name} if length $info->{name} > $maxdb; 2453 $maxtype = length $info->{dbtype} if length $info->{dbtype} > $maxtype; 2454 $maxstat = length $info->{status} if length $info->{status} > $maxstat; 2455 } 2456 2457 ## Do we show types? 2458 my $showtypes = keys %typecount > 1 ? 1 : 0; 2459 2460 ## Now do the actual printing 2461 for my $name (sort keys %$DB) { 2462 next if @nouns and ! exists $matchdb{$name}; 2463 my $info = $DB->{$name}; 2464 my $type = sprintf 'Type: %-*s ', 2465 $maxtype, $info->{dbtype}; 2466 printf 'Database: %-*s %sStatus: %-*s ', 2467 $maxdb, $info->{name}, 2468 $showtypes ? $type : '', 2469 $maxstat, $info->{status}; 2470 my $showhost = length $info->{dbhost} ? " -h $info->{dbhost}" : ''; 2471 my $showport = $info->{dbport} =~ /\d/ ? " -p $info->{dbport}" : ''; 2472 my $dbname = length $info->{dbname} ? "-d $info->{dbname}" : ''; 2473 if (length $info->{dbconn}) { 2474 $dbname = qq{-d "dbname=$info->{dbname} $info->{dbconn}"}; 2475 } 2476 my $dbtype = $info->{dbtype}; 2477 if ($dbtype eq 'postgres') { 2478 my $showuser = defined $info->{dbuser} ? "-U $info->{dbuser}" : ''; 2479 my $showdb = defined $info->{dbname} ? " -d $info->{dbname}" : ''; 2480 my $showservice = (defined $info->{dbservice} and length $info->{dbservice}) 2481 ? qq{ "service=$info->{dbservice}"} : ''; 2482 my $showdsn = (defined $info->{dbdsn} and length $info->{dbdsn}) 2483 ? qq{ (DSN=$info->{dbdsn})} : ''; 2484 print "Conn: psql$showport $showuser$showdb$showhost$showservice$showdsn"; 2485 if (! $info->{server_side_prepares}) { 2486 print ' (SSP is off)'; 2487 } 2488 if ($info->{makedelta}) { 2489 print ' (makedelta on)'; 2490 } 2491 } 2492 if ($dbtype eq 'drizzle') { 2493 $showport = (length $info->{dbport} and $info->{dbport} != 3306) 2494 ? " --port $info->{dbport}" : ''; 2495 printf 'Conn: drizzle -u %s -D %s%s%s', 2496 $info->{dbuser}, 2497 $info->{dbname}, 2498 $showhost, 2499 $showport; 2500 } 2501 if ($dbtype eq 'flatfile') { 2502 print "Prefix: $info->{dbname}"; 2503 } 2504 if ($dbtype eq 'mongo') { 2505 if (length $info->{dbhost}) { 2506 print "Host: $info->{dbhost}"; 2507 } 2508 } 2509 if ($dbtype eq 'mysql' or $dbtype eq 'mariadb') { 2510 $showport = (length $info->{dbport} and $info->{dbport} != 3306) 2511 ? " --port $info->{dbport}" : ''; 2512 printf 'Conn: mysql -u %s -D %s%s%s', 2513 $info->{dbuser}, 2514 $info->{dbname}, 2515 $showhost, 2516 $showport; 2517 } 2518 if ($dbtype eq 'firebird') { 2519 printf 'Conn: isql-fb -u %s %s', 2520 $info->{dbuser}, 2521 $info->{dbname}; 2522 } 2523 if ($dbtype eq 'oracle') { 2524 printf 'Conn: sqlplus %s%s', 2525 $info->{dbuser}, 2526 $showhost ? qq{\@$showhost} : ''; 2527 } 2528 if ($dbtype eq 'redis') { 2529 my $showindex = (length $info->{dbname} and $info->{dbname} !~ /\D/) ? " -n $info->{dbname}" : ''; 2530 printf 'Conn: redis-cli %s%s%s', 2531 $showhost, 2532 $showport, 2533 $showindex; 2534 } 2535 if ($dbtype eq 'sqlite') { 2536 printf 'Conn: sqlite3 %s', 2537 $info->{dbname}; 2538 } 2539 2540 print "\n"; 2541 2542 if ($VERBOSE) { 2543 2544 ## Which dbgroups is this a member of? 2545 if (exists $info->{group}) { 2546 for my $group (sort keys %{ $info->{group} }) { 2547 my $i = $info->{group}{$group}; 2548 my $role = $i->{role}; 2549 my $pri = $i->{priority}; 2550 print " Belongs to dbgroup $group ($role)"; 2551 $pri and print " Priority:$pri"; 2552 print "\n"; 2553 } 2554 } 2555 2556 ## Which syncs are using it, and as what role 2557 if (exists $info->{sync}) { 2558 for my $syncname (sort keys %{ $info->{sync} }) { 2559 print " Used in sync $syncname in a role of $info->{sync}{$syncname}{role}\n"; 2560 } 2561 } 2562 2563 $VERBOSE >= 2 and show_all_columns($info); 2564 } 2565 } 2566 2567 return 0; 2568 2569} ## end of list_databases 2570 2571 2572## 2573## Database-group-related subroutines: add, remove, update, list 2574## 2575 2576sub add_dbgroup { 2577 2578 ## Add one or more dbgroups. Inserts to the bucardo.dbgroup table 2579 ## May also insert to the bucardo.dbmap table 2580 ## Arguments: one plus 2581 ## 1. The name of the group we are creating 2582 ## 2+ Databases to add to this group, with optional role information attached 2583 ## Returns: undef 2584 ## Example: bucardo add dbgroup nycservers nyc1:source nyc2:source lax1 2585 2586 ## Grab our generic usage message 2587 my $doc_section = 'add/add dbgroup'; 2588 2589 my $name = shift @nouns || ''; 2590 2591 ## Must have a name 2592 usage_exit($doc_section) unless length $name; 2593 2594 ## Create the group if it does not exist 2595 if (! exists $DBGROUP->{$name}) { 2596 create_dbgroup($name); 2597 $QUIET or print qq{Created dbgroup "$name"\n}; 2598 } 2599 2600 ## Add all these databases to the group 2601 for my $dblist (@nouns) { 2602 2603 for my $fulldb (split /\s*,\s*/ => $dblist) { 2604 2605 ## Figure out the optional role 2606 my ($db,$role) = extract_name_and_role($fulldb); 2607 2608 ## This database must exist! 2609 if (! exists $DB->{$db}) { 2610 print qq{The database "$db" does not exist\n}; 2611 exit 1; 2612 } 2613 2614 add_db_to_group($db, "$name:$role"); 2615 2616 $QUIET or print qq{Added database "$db" to dbgroup "$name" as $role\n}; 2617 } 2618 } 2619 2620 confirm_commit(); 2621 2622 exit 0; 2623 2624} ## end of add_dbgroup 2625 2626 2627sub remove_dbgroup { 2628 2629 ## Remove one or more entries from the bucardo.dbgroup table 2630 ## Arguments: one or more 2631 ## 1+ Name of a dbgroup 2632 ## Returns: undef 2633 ## Example: bucardo remove dbgroup sales 2634 2635 my $doc_section = 'remove'; 2636 2637 ## Must have at least one name 2638 usage_exit($doc_section) unless @nouns; 2639 2640 ## Make sure all the groups exist 2641 for my $name (@nouns) { 2642 if (! exists $DBGROUP->{$name}) { 2643 die qq{No such dbgroup: $name\n}; 2644 } 2645 } 2646 2647 ## Prepare the SQL to delete each group 2648 $SQL = q{DELETE FROM bucardo.dbgroup WHERE name = ?}; 2649 $sth = $dbh->prepare($SQL); 2650 2651 for my $name (@nouns) { 2652 ## Wrap in an eval so we can handle known exceptions 2653 eval { 2654 $sth->execute($name); 2655 }; 2656 if ($@) { 2657 if ($@ =~ /"sync_dbs_fk"/) { 2658 if ($bcargs->{force}) { 2659 $QUIET or warn qq{Dropping all syncs that reference the dbgroup "$name"\n}; 2660 $dbh->rollback(); 2661 $dbh->do('DELETE FROM bucardo.sync WHERE dbs = ' . $dbh->quote($name)); 2662 eval { 2663 $sth->execute($name); 2664 }; 2665 goto NEND if ! $@; 2666 } 2667 else { 2668 die qq{Cannot remove dbgroup "$name": it is being used by one or more syncs\n}; 2669 } 2670 } 2671 die qq{Could not delete dbgroup "$name"\n$@\n}; 2672 } 2673 NEND: 2674 $QUIET or print qq{Removed dbgroup "$name"\n}; 2675 } 2676 2677 confirm_commit(); 2678 2679 exit 0; 2680 2681} ## end of remove_dbgroup 2682 2683 2684sub update_dbgroup { 2685 2686 ## Update one or more dbgroups 2687 ## This may modify the bucardo.dbgroup and bucardo.dbmap tables 2688 ## Arguments: two or more 2689 ## 1. Group to be updated 2690 ## 2. Databases to be adjusted, or name change request (name=newname) 2691 ## Returns: undef 2692 ## Example: bucardo update dbgroup sales A:target 2693 2694 my @actions = @_; 2695 2696 my $doc_section = 'update/update dbgroup'; 2697 usage_exit($doc_section) unless @actions; 2698 2699 my $name = shift @actions; 2700 2701 ## Recursively call ourselves for wildcards and 'all' 2702 exit 0 if ! check_recurse($DBGROUP, $name, @actions); 2703 2704 ## Make sure this dbgroup exists! 2705 if (! exists $DBGROUP->{$name}) { 2706 die qq{Could not find a dbgroup named "$name"\nUse 'list dbgroups' to see all available.\n}; 2707 } 2708 2709 ## From this point on, we have either: 2710 ## 1. A rename request 2711 ## 2. A database to add/modify 2712 2713 ## Track dbs and roles 2714 my %dblist; 2715 2716 ## Track if we call confirm_commit or not 2717 my $changes = 0; 2718 2719 for my $action (@actions) { 2720 ## New name for this group? 2721 if ($action =~ /name=(.+)/) { 2722 my $newname = $1; 2723 if ($newname !~ /^$re_dbgroupname$/) { 2724 die qq{Invalid dbgroup name "$newname"\n}; 2725 } 2726 next if $name eq $newname; ## Duh 2727 $SQL = 'UPDATE bucardo.dbgroup SET name=? WHERE name=?'; 2728 $sth = $dbh->prepare($SQL); 2729 $sth->execute($newname, $name); 2730 $QUIET or print qq{Changed dbgroup name from "$name" to "$newname"\n}; 2731 $changes++; 2732 next; 2733 } 2734 2735 ## Assume the rest is databases to modify 2736 2737 ## Default role is always target 2738 my ($db,$role) = extract_name_and_role($action); 2739 $dblist{$db} = $role; 2740 } 2741 2742 ## Leave now if no databases to handle 2743 if (! %dblist) { 2744 $changes and confirm_commit(); 2745 exit 0; 2746 } 2747 2748 ## The old list of databases: 2749 my $oldlist = $DBGROUP->{$name}{db} || {}; 2750 2751 ## Walk through the old and see if any were changed or removed 2752 for my $db (sort keys %$oldlist) { 2753 if (! exists $dblist{$db}) { 2754 remove_db_from_group($db, $name); 2755 $QUIET or print qq{Removed database "$db" from dbgroup "$name"\n}; 2756 $changes++; 2757 next; 2758 } 2759 my $oldrole = $oldlist->{$db}{role}; 2760 my $newrole = $dblist{$db}; 2761 if ($oldrole ne $newrole) { 2762 change_db_role($newrole, $name, $db); 2763 $QUIET or print qq{Changed role of database "$db" in dbgroup "$name" from $oldrole to $newrole\n}; 2764 $changes++; 2765 } 2766 } 2767 2768 ## Walk through the new and see if any are truly new 2769 for my $db (sort keys %dblist) { 2770 next if exists $oldlist->{$db}; 2771 my $role = $dblist{$db}; 2772 add_db_to_group($db, "$name:$role"); 2773 $QUIET or print qq{Added database "$db" to dbgroup "$name" as $role\n}; 2774 $changes++; 2775 } 2776 2777 confirm_commit() if $changes; 2778 2779 return; 2780 2781} ## end of update_dbgroup 2782 2783 2784sub list_dbgroups { 2785 2786 ## Show information about all or some subset of the bucardo.dbgroup table 2787 ## Arguments: zero or more 2788 ## 1+ Groups to view. Can be "all" and can have wildcards 2789 ## Returns: 0 on success, -1 on error 2790 ## Example: bucardo list dbgroups 2791 2792 ## Might be no groups yet 2793 if (! keys %$DBGROUP) { 2794 print "No dbgroups have been added yet\n"; 2795 return -1; 2796 } 2797 2798 ## If not doing all, keep track of which to show 2799 my %matchdbg; 2800 2801 for my $term (@nouns) { 2802 2803 ## Special case for all: same as no nouns at all, so simply remove them! 2804 if ($term =~ /\ball\b/i) { 2805 undef %matchdbg; 2806 undef @nouns; 2807 last; 2808 } 2809 2810 ## Check for wildcards 2811 if ($term =~ s/[*%]/.*/) { 2812 for my $name (keys %$DBGROUP) { 2813 $matchdbg{$name} = 1 if $name =~ /$term/; 2814 } 2815 next; 2816 } 2817 2818 ## Must be an exact match 2819 for my $name (keys %$DBGROUP) { 2820 $matchdbg{$name} = 1 if $name eq $term; 2821 } 2822 2823 } ## end each term 2824 2825 ## No matches? 2826 if (@nouns and ! keys %matchdbg) { 2827 print "No matching dbgroups found\n"; 2828 return -1; 2829 } 2830 2831 ## Figure out the length of each item for a pretty display 2832 my ($maxlen) = (1); 2833 for my $name (sort keys %$DBGROUP) { 2834 next if @nouns and ! exists $matchdbg{$name}; 2835 my $info = $DBGROUP->{$name}; 2836 $maxlen = length $info->{name} if length $info->{name} > $maxlen; 2837 } 2838 2839 ## Print it 2840 for my $name (sort keys %$DBGROUP) { 2841 next if @nouns and ! exists $matchdbg{$name}; 2842 my $info = $DBGROUP->{$name}; 2843 ## Does it have associated databases? 2844 my $dbs = ''; 2845 if (exists $DBGROUP->{$name}{db}) { 2846 $dbs = ' Members:'; 2847 for my $dbname (sort keys %{ $DBGROUP->{$name}{db} }) { 2848 my $i = $DBGROUP->{$name}{db}{$dbname}; 2849 $dbs .= " $dbname:$i->{role}"; 2850 ## Only show the priority if <> 0 2851 if ($i->{priority} != 0) { 2852 $dbs .= ":pri=$i->{priority}"; 2853 } 2854 } 2855 } 2856 printf "dbgroup: %-*s%s\n", 2857 $maxlen, $name, $dbs; 2858 $VERBOSE >= 2 and show_all_columns($info); 2859 } 2860 2861 return 0; 2862 2863} ## end of list_dbgroups 2864 2865 2866## 2867## Customname-related subroutines: add, exists, remove, list 2868## 2869 2870sub add_customname { 2871 2872 ## Add an item to the customname table 2873 ## Arguments: none, parses nouns for tablename|goatid, syncname, database name 2874 ## Returns: never, exits 2875 ## Examples: 2876 ## bucardo add customname public.foobar foobarz 2877 ## bucardo add customname public.foobar foobarz sync=bee 2878 ## bucardo add customname public.foobar foobarz db=baz 2879 ## bucardo add customname public.foobar foobarz db=baz sync=bee 2880 2881 my $item_name = shift @nouns || ''; 2882 2883 my $doc_section = 'add/add customname'; 2884 2885 my $newname = shift @nouns || ''; 2886 2887 usage_exit($doc_section) unless length $item_name && length $newname; 2888 2889 ## Does this number or name exist? 2890 my $goat; 2891 if (exists $GOAT->{by_fullname}{$item_name}) { 2892 $goat = $GOAT->{by_fullname}{$item_name}; 2893 } 2894 elsif (exists $GOAT->{by_table}{$item_name}) { 2895 $goat = $GOAT->{by_table}{$item_name}; 2896 } 2897 elsif (exists $GOAT->{by_id}{$item_name}) { 2898 $goat = $GOAT->{by_id}{$item_name}; 2899 } 2900 else { 2901 print qq{Could not find a matching table for "$item_name"\n}; 2902 exit 1; 2903 } 2904 2905 ## If this is a ref due to it being an unqualified name, just use the first one 2906 $goat = $goat->[0] if ref $goat eq 'ARRAY'; 2907 my ($sname,$tname) = ($goat->{schemaname},$goat->{tablename}); 2908 2909 ## The new name can have a schema. If it does not, use the "old" one 2910 my $Sname; 2911 my $Tname = $newname; 2912 if ($Tname =~ /(.+)\.(.+)/) { 2913 ($Sname,$Tname) = ($1,$2); 2914 } 2915 else { 2916 $Sname = $sname; 2917 } 2918 2919 ## If the new name contains an equal sign, treat as an error 2920 usage_exit($doc_section) if $Tname =~ /=/; 2921 2922 ## Names cannot be the same 2923 if ($sname eq $Sname and $tname eq $Tname) { 2924 print qq{The new name cannot be the same as the old\n}; 2925 exit 1; 2926 } 2927 2928 ## Parse the rest of the arguments 2929 my (@sync,@db); 2930 for my $arg (@nouns) { 2931 ## Name of a sync 2932 if ($arg =~ /^sync\s*=\s*(.+)/) { 2933 my $sync = $1; 2934 if (! exists $SYNC->{$sync}) { 2935 print qq{No such sync: "$sync"\n}; 2936 exit 1; 2937 } 2938 push @sync => $sync; 2939 } 2940 elsif ($arg =~ /^(?:db|database)\s*=\s*(.+)/) { 2941 my $db = $1; 2942 if (! exists $DB->{$db}) { 2943 print qq{No such database: "$db"\n}; 2944 exit 1; 2945 } 2946 push @db => $db; 2947 } 2948 else { 2949 usage_exit($doc_section); 2950 } 2951 } 2952 2953 ## Loop through and start adding rows to customname 2954 my $goatid = $goat->{id}; 2955 2956 $SQL = "INSERT INTO bucardo.customname(goat,newname,db,sync) VALUES ($goatid,?,?,?)"; 2957 $sth = $dbh->prepare($SQL); 2958 2959 ## We may have multiple syncs or databases, so loop through 2960 my $x = 0; 2961 my @msg; 2962 { 2963 2964 ## Setup common message post scripts 2965 my $message = ''; 2966 defined $db[$x] and $message .= " (for database $db[$x])"; 2967 defined $sync[$x] and $message .= " (for sync $sync[$x])"; 2968 2969 ## Skip if this exact entry already exists 2970 if (customname_exists($goatid,$newname,$db[$x],$sync[$x])) { 2971 if (!$QUIET) { 2972 printf "Already have an entry for %s to %s%s\n", 2973 $item_name, $newname, $message; 2974 } 2975 next; 2976 } 2977 2978 $sth->execute($newname, $db[$x], $sync[$x]); 2979 push @msg => "Transformed $sname.$tname to $newname$message"; 2980 2981 ## Always go at least one round 2982 ## We go a second time if there is another sync or db waiting 2983 $x++; 2984 redo if defined $db[$x] or defined $sync[$x]; 2985 last; 2986 } 2987 2988 if (!$QUIET) { 2989 for (@msg) { 2990 chomp; ## Just in case we forgot above 2991 print "$_\n"; 2992 } 2993 } 2994 2995 confirm_commit(); 2996 2997 exit 0; 2998 2999} ## end of add_customname 3000 3001 3002sub remove_customname { 3003 3004 ## Remove one or more entries from the bucardo.customname table 3005 ## Arguments: one or more 3006 ## 1+ IDs to be deleted 3007 ## Returns: undef 3008 ## Example: bucardo remove customname 7 3009 3010 ## Grab our generic usage message 3011 my $doc_section = 'remove'; 3012 usage_exit($doc_section) unless @nouns; 3013 3014 ## Make sure each argument is a number 3015 for my $name (@nouns) { 3016 usage_exit($doc_section) if $name !~ /^\d+$/; 3017 } 3018 3019 ## We want the per-id hash here 3020 my $cn = $CUSTOMNAME->{id}; 3021 3022 ## Give a warning if a number does not exist 3023 for my $name (@nouns) { 3024 if (! exists $cn->{$name}) { 3025 $QUIET or warn qq{Customname number $name does not exist\n}; 3026 } 3027 } 3028 3029 ## Prepare the SQL to delete each customname 3030 $SQL = 'DELETE FROM bucardo.customname WHERE id = ?'; 3031 $sth = $dbh->prepare($SQL); 3032 3033 ## Go through and delete any that exist 3034 for my $number (@nouns) { 3035 3036 ## We've already handled these in the loop above 3037 next if ! exists $cn->{$number}; 3038 3039 ## Unlike other items, we do not need an eval, 3040 ## because it has no cascading dependencies 3041 $sth->execute($number); 3042 3043 my $cc = sprintf '%s => %s%s%s', 3044 $cn->{$number}{tname}, 3045 $cn->{$number}{newname}, 3046 (length $cn->{$number}{sync} ? " Sync: $cn->{$number}{sync}" : ''), 3047 (length $cn->{$number}{db} ? " Database: $cn->{$number}{db}" : ''); 3048 3049 $QUIET or print qq{Removed customcode $number: $cc\n}; 3050 3051 } 3052 3053 confirm_commit(); 3054 3055 exit 0; 3056 3057} ## end of remove_customname 3058 3059 3060sub customname_exists { 3061 3062 ## See if an entry already exists in the bucardo.customname table 3063 ## Arguments: four 3064 ## 1. Goat id 3065 ## 2. New name 3066 ## 3. Database name (can be null) 3067 ## 4. Sync name (can be null) 3068 ## Returns: true or false (1 or 0) 3069 3070 my ($id,$newname,$db,$sync) = @_; 3071 3072 ## Easy if there are no entries yet! 3073 return 0 if ! keys %$CUSTOMNAME; 3074 3075 my $cn = $CUSTOMNAME->{goat}; 3076 3077 ## Quick filtering by the goatid 3078 return 0 if ! exists $cn->{$id}; 3079 3080 my $matchdb = defined $db ? $db : ''; 3081 my $matchsync = defined $sync ? $sync : ''; 3082 3083 return exists $cn->{$id}{$matchdb}{$matchsync}; 3084 3085} ## end of customname_exists 3086 3087 3088sub list_customnames { 3089 3090 ## Show information about all or some subset of the bucardo.customname table 3091 ## Arguments: zero or more 3092 ## 1+ Names to view. Can be "all" and can have wildcards 3093 ## Returns: 0 on success, -1 on error 3094 ## Example: bucardo list customname 3095 3096 ## Grab our generic usage message 3097 my $doc_section = 'list'; 3098 3099 ## Might be no entries yet 3100 if (! keys %$CUSTOMNAME) { 3101 print "No customnames have been added yet\n"; 3102 return -1; 3103 } 3104 3105 my $cn = $CUSTOMNAME->{list}; 3106 3107 ## If not doing all, keep track of which to show 3108 my $matches = 0; 3109 3110 for my $term (@nouns) { 3111 3112 ## Special case for all: same as no nouns at all, so simply remove them! 3113 if ($term =~ /\ball\b/i) { 3114 undef @nouns; 3115 last; 3116 } 3117 3118 ## Check for wildcards 3119 if ($term =~ s/[*%]/.*/) { 3120 for my $row (@$cn) { 3121 if ($row->{tname} =~ /$term/) { 3122 $matches++; 3123 $row->{match} = 1; 3124 } 3125 } 3126 next; 3127 } 3128 3129 ## Must be an exact match 3130 for my $row (@$cn) { 3131 if ($row->{tname} eq $term) { 3132 $matches++; 3133 $row->{match} = 1; 3134 } 3135 } 3136 3137 } ## end each term 3138 3139 ## No matches? 3140 if (@nouns and ! $matches) { 3141 print "No matching customnames found\n"; 3142 return -1; 3143 } 3144 3145 ## Figure out the length of each item for a pretty display 3146 my ($maxid,$maxname,$maxnew,$maxsync,$maxdb) = (1,1,1,1,1); 3147 for my $row (@$cn) { 3148 next if @nouns and ! exists $row->{match}; 3149 $maxid = length $row->{id} if length $row->{id} > $maxid; 3150 $maxname = length $row->{tname} if length $row->{tname} > $maxname; 3151 $maxnew = length $row->{newname} if length $row->{newname} > $maxnew; 3152 $maxsync = length $row->{sync} if length $row->{sync} > $maxsync; 3153 $maxdb = length $row->{db} if length $row->{db} > $maxdb; 3154 } 3155 3156 ## Now do the actual printing 3157 ## Sort by tablename, then newname, then sync, then db 3158 for my $row (sort { 3159 $a->{tname} cmp $b->{tname} 3160 or 3161 $a->{newname} cmp $b->{newname} 3162 or 3163 $a->{sync} cmp $b->{sync} 3164 or 3165 $a->{db} cmp $b->{db} 3166 } @$cn) { 3167 next if @nouns and ! exists $row->{match}; 3168 printf '%-*s Table: %-*s => %-*s', 3169 1+$maxid, "$row->{id}.", 3170 $maxname, $row->{tname}, 3171 $maxnew, $row->{newname}; 3172 if ($row->{sync}) { 3173 printf ' Sync: %-*s', 3174 $maxsync, $row->{sync}; 3175 } 3176 if ($row->{db}) { 3177 printf ' Database: %-*s', 3178 $maxsync, $row->{db}; 3179 } 3180 print "\n"; 3181 3182 } 3183 3184 return 0; 3185 3186} ## end of list_customnames 3187 3188sub find_goat_by_item { 3189 3190 ## Finds a goat in the %GOAT hash, using one argument as a search key 3191 ## Arguments: name. Can be a goat id or a name, possibly including schema, or wildcards 3192 ## nouns. Ref to array of other args; right now only supports "db=###" 3193 ## Results: An array of goat objects that match these keys 3194 3195 my $name = shift; 3196 my $lnouns = shift; 3197 my @lnouns = ( defined $lnouns ? @$lnouns : ()); 3198 3199 $DEBUG and warn "Finding goats with name $name, noun: " . Dumper(@lnouns); 3200 3201 my @results; 3202 3203 ## Handle ID values 3204 if ($name =~ /^\d+$/) { 3205 $DEBUG and warn "$name is an ID value"; 3206 push @results, $GOAT->{by_id}{$name}; 3207 } 3208 ## Handle names, with or without schemas, and with or without wildcards 3209 else { 3210 $DEBUG and warn "$name is a name value"; 3211 3212 my @found_keys; 3213 3214 ## Find GOAT keys that may include matches 3215 map { 3216 if (exists $GOAT->{$_}{$name}) { 3217 push @found_keys, [ $_, $name ]; 3218 } 3219 } qw/by_table by_fullname/; 3220 3221 ## Handle wildcards 3222 if (index($name, '*') >= 0 || index($name, '%') >= 0) { 3223 my $reg_name = $name; 3224 3225 ## Change to a regexier form 3226 $reg_name =~ s/\./\\./g; 3227 $reg_name =~ s/[*%]/\.\*/g; 3228 $reg_name = "$reg_name" if $reg_name !~ /^[\^\.\%]/; 3229 $reg_name .= '$' if $reg_name !~ /[\$\*]$/; 3230 $DEBUG and warn "There's a wildcard here. This is the regex version: $reg_name"; 3231 3232 map { 3233 push @found_keys, [ 'by_fullname', $_ ]; 3234 } grep { /$reg_name/ } keys %{$GOAT->{by_fullname}}; 3235 } 3236 3237 ## The found goat keys point to arrayrefs. Turn all that into a 3238 ## one-dimensional array of goats 3239 $DEBUG and warn 'Found these candidate keys: '. Dumper(@found_keys); 3240 map { 3241 for my $b (@{$GOAT->{$_->[0]}{$_->[1]}}) { 3242 push(@results, $b); 3243 } 3244 } @found_keys; 3245 $DEBUG and warn q{Here are the goats we've found, before filtering: } . Dumper(@results); 3246 } 3247 3248 if (@results && defined $results[0] && @lnouns && defined $lnouns[0]) { 3249 my @filters = grep(/^(?:db|database)\s*=/, @lnouns); 3250 if (@filters) { 3251 ## The @lnouns array will only contain one db= value, even if the command includes several 3252 my $db_filter = $filters[0]; 3253 3254 $DEBUG and warn "Database filter starting value: $db_filter"; 3255 $db_filter =~ /^(?:db|database)\s*=\s*(.+)/; 3256 $db_filter = $1; 3257 $DEBUG and warn "Database filter value: $db_filter"; 3258 @results = grep { 3259 $DEBUG and warn "Comparing $_->{db} to filter value $db_filter"; 3260 $_->{db} eq $db_filter; 3261 } @results; 3262 } 3263 } 3264 3265 $DEBUG and warn 'Here are the filtered results: ' . Dumper(@results); 3266 @results = () if (@results and !defined $results[0]); 3267 3268 return @results; 3269 3270} ## end of find_goat_by_item 3271 3272## 3273## Customcols-related subroutines: add, exists, remove, list 3274## 3275 3276sub add_customcols { 3277 3278 ## Add an item to the customcols table 3279 ## Arguments: none, parses nouns for tablename|goatid, syncname, database name 3280 ## Returns: never, exits 3281 ## Examples: 3282 ## bucardo add customcols public.foobar "select a,b,c" 3283 ## bucardo add customcols public.foobar "select a,b,c" db=foo 3284 ## bucardo add customcols public.foobar "select a,b,c" db=foo sync=abc 3285 3286 my $item_name = shift @nouns || ''; 3287 3288 my $doc_section = 'add'; 3289 3290 ## Must have a clause as well 3291 my $clause = shift @nouns || ''; 3292 3293 usage_exit($doc_section) unless length $item_name && length $clause; 3294 3295 ## Does this number or name exist? 3296 my @candidate_goats = find_goat_by_item($item_name); 3297 if (! @candidate_goats) { 3298 print qq{Could not find a matching table for "$item_name"\n}; 3299 exit 1; 3300 } 3301 3302# The code lower in the function is meant to handle multiple matching goats, 3303# but if we didn't want that, this would bleat when we ran into multiple goats. 3304# if ($#candidate_goats > 0) { 3305# print qq{Could not uniquely identify the desired table for "$item_name"\n}; 3306# print qq{Possible choices:\n}; 3307# print "\tdb: $_->{db}\tschema: $_->{schemaname}\ttable: $_->{tablename}\n" 3308# for @candidate_goats; 3309# exit 1; 3310# } 3311 3312 my $goat = $candidate_goats[0]; 3313 my ($sname,$tname) = ($goat->{schemaname},$goat->{tablename}); 3314 3315 ## Make sure the clause looks sane 3316 if ($clause !~ /^\s*SELECT /i) { 3317 warn "\nThe clause must start with SELECT\n"; 3318 usage_exit($doc_section); 3319 } 3320 3321 ## Parse the rest of the arguments 3322 my (@sync,@db); 3323 for my $arg (@nouns) { 3324 ## Name of a sync 3325 if ($arg =~ /^sync\s*=\s*(.+)/) { 3326 my $sync = $1; 3327 if (! exists $SYNC->{$sync}) { 3328 print qq{No such sync: "$sync"\n}; 3329 exit 1; 3330 } 3331 push @sync => $sync; 3332 } 3333 elsif ($arg =~ /^(?:db|database)\s*=\s*(.+)/) { 3334 my $db = $1; 3335 if (! exists $DB->{$db}) { 3336 print qq{No such database: "$db"\n}; 3337 exit 1; 3338 } 3339 push @db => $db; 3340 } 3341 else { 3342 usage_exit($doc_section); 3343 } 3344 } 3345 3346 ## Loop through and start adding rows to customcols 3347 my $goatid = $goat->{id}; 3348 3349 $SQL = "INSERT INTO bucardo.customcols(goat,clause,db,sync) VALUES ($goatid,?,?,?)"; 3350 $sth = $dbh->prepare($SQL); 3351 3352 ## We may have multiple syncs or databases, so loop through 3353 my $x = 0; 3354 my @msg; 3355 { 3356 ## Skip if this exact entry already exists 3357 next if customcols_exists($goatid,$clause,$db[$x],$sync[$x]); 3358 3359 $count = $sth->execute($clause, $db[$x], $sync[$x]); 3360 my $message = qq{New columns for $sname.$tname: "$clause"}; 3361 defined $db[$x] and $message .= " (for database $db[$x])"; 3362 defined $sync[$x] and $message .= " (for sync $sync[$x])"; 3363 push @msg => $message; 3364 3365 ## Always go at least one round 3366 ## We go a second time if there is another sync or db waiting 3367 $x++; 3368 redo if defined $db[$x] or defined $sync[$x]; 3369 last; 3370 } 3371 3372 if (!$QUIET) { 3373 for (@msg) { 3374 chomp; ## Just in case we forgot above 3375 print "$_\n"; 3376 } 3377 } 3378 3379 confirm_commit(); 3380 3381 exit 0; 3382 3383} ## end of add_customcols 3384 3385 3386sub remove_customcols { 3387 3388 ## Remove one or more entries from the bucardo.customcols table 3389 ## Arguments: one or more 3390 ## 1+ IDs to be deleted 3391 ## Returns: undef 3392 ## Example: bucardo remove customcols 7 3393 3394 my $doc_section = 'remove'; 3395 usage_exit($doc_section) unless @nouns; 3396 3397 ## Make sure each argument is a number 3398 for my $name (@nouns) { 3399 usage_exit($doc_section) if $name !~ /^\d+$/; 3400 } 3401 3402 ## We want the per-id hash here 3403 my $cc = $CUSTOMCOLS->{id}; 3404 3405 ## Give a warning if a number does not exist 3406 for my $name (@nouns) { 3407 if (! exists $cc->{$name}) { 3408 $QUIET or warn qq{Customcols number $name does not exist\n}; 3409 } 3410 } 3411 3412 ## Prepare the SQL to delete each customcols 3413 $SQL = 'DELETE FROM bucardo.customcols WHERE id = ?'; 3414 $sth = $dbh->prepare($SQL); 3415 3416 ## Go through and delete any that exist 3417 for my $name (@nouns) { 3418 3419 ## We've already handled these in the loop above 3420 next if ! exists $cc->{$name}; 3421 3422 ## Unlike other items, we do not need an eval, 3423 ## because it has no cascading dependencies 3424 $sth->execute($name); 3425 3426 my $cc2 = sprintf '%s => %s%s%s', 3427 $cc->{$name}{tname}, 3428 $cc->{$name}{clause}, 3429 (length $cc->{$name}{sync} ? " Sync: $cc->{$name}{sync}" : ''), 3430 (length $cc->{$name}{db} ? " Database: $cc->{$name}{db}" : ''); 3431 3432 $QUIET or print qq{Removed customcols $name: $cc2\n}; 3433 3434 } 3435 3436 confirm_commit(); 3437 3438 exit 0; 3439 3440} ## end of remove_customcols 3441 3442 3443sub customcols_exists { 3444 3445 ## See if an entry already exists in the bucardo.customcols table 3446 ## Arguments: four 3447 ## 1. Goat id 3448 ## 2. Clause 3449 ## 3. Database name (can be null) 3450 ## 4. Sync name (can be null) 3451 ## Returns: true or false (1 or 0) 3452 3453 my ($id,$clause,$db,$sync) = @_; 3454 3455 ## Easy if there are no entries yet! 3456 return 0 if ! keys %$CUSTOMCOLS; 3457 3458 my $cc = $CUSTOMCOLS->{goat}; 3459 3460 ## Quick filtering by the goatid 3461 return 0 if ! exists $cc->{$id}; 3462 3463 ## And by the clause therein 3464 return 0 if ! exists $cc->{$id}{$clause}; 3465 3466 ## Is there a match for this db and sync combo? 3467 for my $row (@{ $cc->{$id}{$clause} }) { 3468 if (defined $db) { 3469 next if (! length $row->{db} or $row->{db} ne $db); 3470 } 3471 else { 3472 next if length $row->{db}; 3473 } 3474 if (defined $sync) { 3475 next if (! length $row->{sync} or $row->{sync} ne $sync); 3476 } 3477 else { 3478 next if length $row->{sync}; 3479 } 3480 3481 ## Complete match! 3482 return 1; 3483 } 3484 3485 return 0; 3486 3487} ## end of customcols_exists 3488 3489 3490sub list_customcols { 3491 3492 ## Show information about all or some subset of the bucardo.customcols table 3493 ## Arguments: zero or more 3494 ## 1+ Names to view. Can be "all" and can have wildcards 3495 ## Returns: 0 on success, -1 on error 3496 ## Example: bucardo list customcols 3497 3498 my $doc_section = 'list'; 3499 3500 ## Might be no entries yet 3501 if (! keys %$CUSTOMCOLS) { 3502 print "No customcols have been added yet\n"; 3503 return -1; 3504 } 3505 3506 my $cc = $CUSTOMCOLS->{list}; 3507 3508 ## If not doing all, keep track of which to show 3509 my $matches = 0; 3510 3511 for my $term (@nouns) { 3512 3513 ## Special case for all: same as no nouns at all, so simply remove them! 3514 if ($term =~ /\ball\b/i) { 3515 undef @nouns; 3516 last; 3517 } 3518 3519 ## Check for wildcards 3520 if ($term =~ s/[*%]/.*/) { 3521 for my $row (@$cc) { 3522 if ($row->{tname} =~ /$term/) { 3523 $matches++; 3524 $row->{match} = 1; 3525 } 3526 } 3527 next; 3528 } 3529 3530 ## Must be an exact match 3531 for my $row (@$cc) { 3532 if ($row->{tname} eq $term) { 3533 $matches++; 3534 $row->{match} = 1; 3535 } 3536 } 3537 3538 } ## end each term 3539 3540 ## No matches? 3541 if (@nouns and ! $matches) { 3542 print "No matching customcols found\n"; 3543 return -1; 3544 } 3545 3546 ## Figure out the length of each item for a pretty display 3547 my ($maxid,$maxname,$maxnew,$maxsync,$maxdb) = (1,1,1,1,1); 3548 for my $row (@$cc) { 3549 next if @nouns and ! exists $row->{match}; 3550 $maxid = length $row->{id} if length $row->{id} > $maxid; 3551 $maxname = length $row->{tname} if length $row->{tname} > $maxname; 3552 $maxnew = length $row->{clause} if length $row->{clause} > $maxnew; 3553 $maxsync = length $row->{sync} if length $row->{sync} > $maxsync; 3554 $maxdb = length $row->{db} if length $row->{db} > $maxdb; 3555 } 3556 3557 ## Now do the actual printing 3558 ## Sort by tablename, then newname, then sync, then db 3559 for my $row (sort { 3560 $a->{tname} cmp $b->{tname} 3561 or 3562 $a->{clause} cmp $b->{clause} 3563 or 3564 $a->{sync} cmp $b->{sync} 3565 or 3566 $a->{db} cmp $b->{db} 3567 } @$cc) { 3568 next if @nouns and ! exists $row->{match}; 3569 printf '%-*s Table: %-*s => %-*s', 3570 1+$maxid, "$row->{id}.", 3571 $maxname, $row->{tname}, 3572 $maxnew, $row->{clause}; 3573 if ($row->{sync}) { 3574 printf ' Sync: %-*s', 3575 $maxsync, $row->{sync}; 3576 } 3577 if ($row->{db}) { 3578 printf ' Database: %-*s', 3579 $maxsync, $row->{db}; 3580 } 3581 print "\n"; 3582 3583 } 3584 3585 return 0; 3586 3587} ## end of list_customcols 3588 3589 3590## 3591## Table-related subroutines: add, remove, update, list 3592## 3593 3594sub add_table { 3595 my $reltype = shift; 3596 3597 ## Add one or more tables or sequences. Inserts to the bucardo.goat table 3598 ## May also update the bucardo.herd and bucardo.herdmap tables 3599 ## Arguments: one. Also parses @nouns for table / sequence names 3600 ## 1. Type of object to be added: table, or sequence 3601 ## Returns: undef 3602 ## Example: bucardo add table pgbench_accounts foo% myschema.abc 3603 3604 ## Grab our generic usage message 3605 my $doc_section = 'add/add table'; 3606 usage_exit($doc_section) unless @nouns; 3607 3608 ## Inputs and aliases, database column name, flags, default 3609 my $validcols = q{ 3610 db db 0 null 3611 autokick|ping autokick TF null 3612 rebuild_index rebuild_index numeric null 3613 analyze_after_copy analyze_after_copy TF null 3614 makedelta makedelta 0 null 3615 herd|relgroup herd 0 skip 3616 strict_checking strict_checking TF 1 3617 }; 3618 3619 my ( $dbcols, $cols, $phs, $vals, $extra ) = process_simple_args({ 3620 cols => $validcols, 3621 list => \@nouns, 3622 doc_section => $doc_section, 3623 }); 3624 3625 ## Loop through all the args and attempt to add the tables 3626 ## This returns a hash with the following keys: relations, match, nomatch 3627 my $goatlist = get_goat_ids(args => \@nouns, type => $reltype, dbcols => $dbcols); 3628 3629 ## The final output. Store it up all at once for a single QUIET check 3630 my $message = ''; 3631 3632 ## We will be nice and indicate anything that did not match 3633 if (keys %{ $goatlist->{nomatch} }) { 3634 $message .= "Did not find matches for the following terms:\n"; 3635 for (sort keys %{ $goatlist->{nomatch} }) { 3636 $message .= " $_\n"; 3637 } 3638 } 3639 3640 ## Now we need to output which ones were recently added 3641 if (keys %{ $goatlist->{new} }) { 3642 $message .= "Added the following tables or sequences:\n"; 3643 for (sort keys %{ $goatlist->{new} }) { 3644 $message .= " $_\n"; 3645 } 3646 } 3647 3648 ## If they requested a herd and it does not exist, create it 3649 if (exists $extra->{relgroup}) { 3650 my $herdname = $extra->{relgroup}; 3651 if (! exists $HERD->{$herdname}) { 3652 $SQL = 'INSERT INTO bucardo.herd(name) VALUES(?)'; 3653 $sth = $dbh->prepare($SQL); 3654 $sth->execute($herdname); 3655 $message .= qq{Created the relgroup named "$herdname"\n}; 3656 } 3657 ## Now load all of these tables into this herd 3658 $SQL = 'INSERT INTO bucardo.herdmap (herd,priority,goat) VALUES (?,?,' 3659 . qq{ (SELECT id FROM goat WHERE schemaname||'.'||tablename=? AND db=? AND reltype='$reltype'))}; 3660 3661 $sth = $dbh->prepare($SQL); 3662 3663 ## Which tables were already in the herd, and which were just added 3664 my (@oldnames,@newnames); 3665 3666 for my $name (sort keys %{ $goatlist->{relations} }) { 3667 ## Is it already part of this herd? 3668 if (exists $HERD->{$herdname}{goat}{$name} and 3669 $HERD->{$herdname}{goat}{$name}{reltype} eq $reltype) { 3670 push @oldnames => $name; 3671 next; 3672 } 3673 my $db = $goatlist->{relations}{$name}{goat}[0]{db}; 3674 3675 my $pri = 0; 3676 3677 $count = $sth->execute($herdname,$pri,$name, $db); 3678 3679 push @newnames => $name; 3680 } 3681 3682 if (@oldnames) { 3683 $message .= qq{The following tables or sequences were already in the relgroup "$herdname":\n}; 3684 for (@oldnames) { 3685 $message .= " $_\n"; 3686 } 3687 } 3688 3689 if (@newnames) { 3690 $message .= qq{The following tables or sequences are now part of the relgroup "$herdname":\n}; 3691 for (sort numbered_relations @newnames) { 3692 $message .= " $_\n"; 3693 } 3694 } 3695 3696 } ## end if herd 3697 3698 if (!$QUIET) { 3699 print $message; 3700 } 3701 3702 confirm_commit(); 3703 3704 exit 0; 3705 3706} ## end of add_table 3707 3708 3709sub remove_relation { 3710 3711 my $reltype = shift; 3712 3713 my $arg = shift || ''; 3714 3715 my $doc_section = 'remove'; 3716 if (!@nouns and $arg ne 'all') { 3717 usage_exit($doc_section); 3718 } 3719 3720 my $db_filter; 3721 for my $name ( @nouns ) { 3722 next unless $name =~ /^db=(.*)/; 3723 $db_filter = $1; 3724 } 3725 3726 my @removed; 3727 3728 if ($arg eq 'all') { 3729 if (! $bcargs->{batch}) { 3730 print "Are you sure you want to remove all ${reltype}s? "; 3731 exit if <STDIN> !~ /Y/i; 3732 } 3733 3734 $SQL = q{DELETE FROM bucardo.goat WHERE id = ?}; 3735 $sth = $dbh->prepare($SQL); 3736 3737 for my $tid ( sort { $a <=> $b } keys %{$GOAT->{by_id}}) { 3738 my $t = $GOAT->{by_id}{$tid}; 3739 next if $t->{reltype} ne $reltype; 3740 $count = $sth->execute($tid); 3741 if (1 == $count) { 3742 push @removed => "$t->{schemaname}.$t->{tablename}"; 3743 } 3744 } 3745 } 3746 else { 3747 3748 ## Prepare our SQL 3749 $SQL = q{DELETE FROM bucardo.goat WHERE reltype = ? AND schemaname||'.'||tablename = ?}; 3750 $SQL .= ' AND db = ?' if $db_filter; 3751 $sth = $dbh->prepare($SQL); 3752 3753 ## Bucardo won't fully support a table name that starts with "db=". Darn. 3754 for my $name (grep { ! /^db=/ } @nouns) { 3755 if ($name =~ /^\w[\w\d]*\.\w[\w\d]*$/) { 3756 if (! exists $GOAT->{by_fullname}{$name}) { 3757 print qq{No such $reltype: $name\n}; 3758 next; 3759 } 3760 eval { 3761 if ($db_filter) { 3762 $sth->execute($reltype, $name, $db_filter); 3763 } 3764 else { 3765 $sth->execute($reltype, $name); 3766 } 3767 }; 3768 if ($@) { 3769 die qq{Could not delete $reltype "$name"\n$@\n}; 3770 } 3771 push @removed, $name; 3772 } 3773 else { 3774 die qq{Please use the full schema.$reltype name\n}; 3775 } 3776 } 3777 } 3778 3779 if (@removed) { 3780 print "Removed the following ${reltype}s:\n"; 3781 for my $name (sort numbered_relations @removed) { 3782 print qq{ $name} . ($db_filter ? " (DB: $db_filter)" : '') . "\n"; 3783 } 3784 confirm_commit(); 3785 } 3786 else { 3787 print "Nothing found to remove\n"; 3788 } 3789 3790 exit 0; 3791 3792} ## end of remove_relation 3793 3794 3795sub update_table { 3796 3797 ## Update one or more tables 3798 ## This may modify the bucardo.goat and bucardo.herdmap tables 3799 ## Arguments: two or more 3800 ## 1. Table to be updated 3801 ## 2+. Items to be adjusted (name=value) 3802 ## Returns: undef 3803 ## Example: bucardo update table quad ping=false 3804 3805 my @actions = @_; 3806 3807 my $doc_section = 'update/update table'; 3808 usage_exit($doc_section) unless @actions; 3809 3810 my $name = shift @actions; 3811 3812 ## Recursively call ourselves for wildcards and 'all' 3813 exit 0 if ! check_recurse($GOAT, $name, @actions); 3814 3815 ## Make sure this table exists! 3816 my @tables = find_goat_by_item($name, \@nouns); 3817 3818 if (!@tables) { 3819 die qq{Didn't find any matching tables\n}; 3820 } 3821 ## If this is an array, then see how many matches we have 3822 if ($#tables > 0) { 3823 die qq{More than one matching table: please use a schema\n}; 3824 } 3825 my $table = $tables[0]; 3826 3827 ## Store the id so we work with that alone whenever possible 3828 my $id = $table->{id}; 3829 3830 ## Everything is a name=value setting after this point, except stuff that 3831 ## matches /^db=/ 3832 ## We will ignore and allow noise word "set" 3833 for my $arg (grep { ! /^db=/ } @actions) { 3834 next if $arg =~ /set/i; 3835 next if $arg =~ /\w+=\w+/o; 3836 usage_exit($doc_section); 3837 } 3838 3839 ## Change the arguments into a hash 3840 my $args = process_args(join ' ' => ( grep { ! /^db=/ } @actions)); 3841 3842 ## Track what changes we made 3843 my %change; 3844 3845 ## Walk through and handle each argument pair 3846 for my $setting (sort keys %$args) { 3847 3848 next if $setting eq 'extraargs'; 3849 3850 ## Change the name to a more standard form, to better figure out what they really mean 3851 ## This also excludes all non-alpha characters 3852 my $newname = transform_name($setting); 3853 3854 ## Exclude ones that cannot / should not be changed (e.g. cdate) 3855 if (exists $column_no_change{$newname}) { 3856 print "Sorry, the value of $setting cannot be changed\n"; 3857 exit 1; 3858 } 3859 3860 ## Standardize the values as well 3861 my $value = $args->{$setting}; 3862 my $newvalue = transform_value($value); 3863 3864 ## Handle all the non-standard columns 3865 if (lc $newname eq 'herd' || lc $newname eq 'relgroup') { 3866 3867 ## Track the changes and publish at the end 3868 my @herdchanges; 3869 3870 ## Grab the current hash of herds 3871 my $oldherd = $table->{herd} || ''; 3872 3873 ## Keep track of what groups they end up in, so we can remove as needed 3874 my %doneherd; 3875 3876 ## Break apart into individual herds 3877 for my $herd (split /\s*,\s*/ => $newvalue) { 3878 3879 ## Note that we've found this herd 3880 $doneherd{$herd}++; 3881 3882 ## Does this herd exist? 3883 if (! exists $HERD->{$herd}) { 3884 create_herd($herd); 3885 push @herdchanges => qq{Created relgroup "$herd"}; 3886 } 3887 3888 ## Are we a part of it already? 3889 if ($oldherd and exists $oldherd->{$herd}) { 3890 $QUIET or print qq{No change: table "$name" already belongs to relgroup "$herd"\n}; 3891 } 3892 else { 3893 ## We are not a part of this herd yet 3894 add_goat_to_herd($herd, $id); 3895 push @herdchanges => qq{Added table "$name" to relgroup "$herd"}; 3896 } 3897 3898 } ## end each herd specified 3899 3900 ## See if we are removing any herds 3901 if ($oldherd) { 3902 for my $old (sort keys %$oldherd) { 3903 next if exists $doneherd{$old}; 3904 3905 ## We do not want to remove herds here, but maybe in the future 3906 ## we can allow a syntax that does 3907 next; 3908 3909 remove_table_from_herd($name, $old); 3910 push @herdchanges => qq{Removed table "$name" from relgroup "$old"}; 3911 } 3912 } 3913 3914 if (@herdchanges) { 3915 for (@herdchanges) { 3916 chomp; 3917 $QUIET or print "$_\n"; 3918 } 3919 confirm_commit(); 3920 } 3921 3922 ## Go to the next setting 3923 next; 3924 3925 } ## end of 'herd' adjustments 3926 3927 ## This must exist in our hash 3928 ## We assume it is the first entry for now 3929 ## Someday be more intelligent about walking and adjusting all matches 3930 if (! exists $table->{$newname}) { 3931 print qq{Cannot change "$newname"\n}; 3932 next; 3933 } 3934 my $oldvalue = $table->{$newname}; 3935 3936 ## May be undef! 3937 $oldvalue = 'NULL' if ! defined $oldvalue; 3938 3939 ## Has this really changed? 3940 if ($oldvalue eq $newvalue) { 3941 print "No change needed for $newname\n"; 3942 next; 3943 } 3944 3945 ## Add to the queue. Overwrites previous ones 3946 $change{$newname} = [$oldvalue, $newvalue]; 3947 3948 } ## end each setting 3949 3950 ## If we have any changes, attempt to make them all at once 3951 if (%change) { 3952 my $SQL = 'UPDATE bucardo.goat SET '; 3953 $SQL .= join ',' => map { "$_=?" } sort keys %change; 3954 $SQL .= ' WHERE id = ?'; 3955 my $sth = $dbh->prepare($SQL); 3956 eval { 3957 $sth->execute((map { $change{$_}[1] } sort keys %change), $id); 3958 }; 3959 if ($@) { 3960 $dbh->rollback(); 3961 $dbh->disconnect(); 3962 print "Sorry, failed to update the relation. Error was:\n$@\n"; 3963 exit 1; 3964 } 3965 3966 for my $item (sort keys %change) { 3967 my ($old,$new) = @{ $change{$item} }; 3968 print "Changed relation $item from $old to $new\n"; 3969 } 3970 3971 confirm_commit(); 3972 } 3973 3974 return; 3975 3976} ## end of update_table 3977 3978 3979sub list_tables { 3980 3981 ## Show information about all or some tables in the 'goat' table 3982 ## Arguments: none (reads nouns for a list of tables) 3983 ## Returns: 0 on success, -1 on error 3984 ## Example: bucardo list tables 3985 3986 my $doc_section = 'list'; 3987 3988 ## Might be no tables yet 3989 if (! keys %$TABLE) { 3990 print "No tables have been added yet\n"; 3991 return -1; 3992 } 3993 3994 ## If not doing all, keep track of which to show 3995 my %matchtable; 3996 3997 my @filters = grep { /^db=/ } @nouns; 3998 for my $term (grep { ! /^db=/ } @nouns) { 3999 4000 ## Special case for all: same as no nouns at all, so simply remove them! 4001 if ($term =~ /\ball\b/i) { 4002 undef %matchtable; 4003 undef @nouns; 4004 last; 4005 } 4006 4007 map { $matchtable{$_->{id}} = 1; } find_goat_by_item($term, \@filters); 4008 4009 } ## end each term 4010 4011 ## No matches? 4012 if (@nouns and ! keys %matchtable) { 4013 print "No matching tables found\n"; 4014 return -1; 4015 } 4016 4017 ## Figure out the length of each item for a pretty display 4018 my ($maxid,$maxname,$maxdb,$maxpk) = (1,1,1,1); 4019 for my $row (values %$TABLE) { 4020 my $id = $row->{id}; 4021 next if @nouns and ! exists $matchtable{$id}; 4022 $maxid = length $id if length $id > $maxid; 4023 my $name = "$row->{schemaname}.$row->{tablename}"; 4024 $maxname = length $name if length $name > $maxname; 4025 $maxdb = length $row->{db} if length $row->{db} > $maxdb; 4026 $row->{ppk} = $row->{pkey} ? "$row->{pkey} ($row->{pkeytype})" : 'none'; 4027 $maxpk = length $row->{ppk} if length $row->{ppk} > $maxpk; 4028 } 4029 ## Now do the actual printing 4030 ## Sort by schemaname then tablename 4031 for my $row (sort numbered_relations values %$TABLE) { 4032 next if @nouns and ! exists $matchtable{$row->{id}}; 4033 printf '%-*s Table: %-*s DB: %-*s PK: %-*s', 4034 1+$maxid, "$row->{id}.", 4035 $maxname, "$row->{schemaname}.$row->{tablename}", 4036 $maxdb, $row->{db}, 4037 $maxpk, $row->{ppk}; 4038 if ($row->{sync}) { 4039 printf ' Syncs: '; 4040 print join ',' => sort keys %{ $row->{sync} }; 4041 } 4042 if (defined $row->{autokick}) { 4043 printf ' autokick:%s', $row->{autokick} ? 'true' : 'false'; 4044 } 4045 if ($row->{rebuild_index}) { 4046 print ' rebuild_index:true'; 4047 } 4048 if ($row->{makedelta}) { 4049 print " (makedelta:$row->{makedelta})"; 4050 } 4051 print "\n"; 4052 4053 $VERBOSE >= 2 and show_all_columns($row); 4054 } 4055 4056 return 0; 4057 4058} ## end of list_tables 4059 4060 4061## 4062## Herd-related subroutines: add, remove, update, list 4063## 4064 4065sub add_herd { 4066 4067 ## Add a herd aka relgroup. Inserts to the bucardo.herd table 4068 ## May also insert to the bucardo.herdmap and bucardo.goat tables 4069 ## Arguments: one or more 4070 ## 1. Name of the herd 4071 ## 2+ Names of tables or sequences to add. Can have wildcards 4072 ## Returns: undef 4073 ## Example: bucardo add herd foobar tab1 tab2 4074 4075 my $doc_section = 'add/add relgroup'; 4076 4077 my $herdname = shift @nouns || ''; 4078 4079 ## Must have a name 4080 usage_exit($doc_section) unless length $herdname; 4081 4082 ## Create the herd if it does not exist 4083 if (exists $HERD->{$herdname}) { 4084 print qq{Relgroup "$herdname" already exists\n}; 4085 } 4086 else { 4087 create_herd($herdname); 4088 $QUIET or print qq{Created relgroup "$herdname"\n}; 4089 } 4090 4091 ## Everything else is tables or sequences to add to this herd 4092 4093 ## How many arguments were we given? 4094 my $nouncount = @nouns; 4095 4096 ## No sense going on if no nouns! 4097 if (! $nouncount) { 4098 confirm_commit(); 4099 exit 0; 4100 } 4101 4102 ## Get the list of all requested tables, adding as needed 4103 my $goatlist = get_goat_ids(args => \@nouns, noherd => $herdname); 4104 4105 ## The final output. Store it up all at once for a single QUIET check 4106 my $message = ''; 4107 4108 ## We will be nice and indicate anything that did not match 4109 if (keys %{ $goatlist->{nomatch} }) { 4110 $message .= "Did not find matches for the following terms:\n"; 4111 for (sort keys %{ $goatlist->{nomatch} }) { 4112 $message .= " $_\n"; 4113 } 4114 } 4115 4116 ## Now we need to output which ones were recently added 4117 if (keys %{ $goatlist->{new} }) { 4118 $message .= "Added the following tables or sequences:\n"; 4119 for (sort keys %{ $goatlist->{new} }) { 4120 $message .= " $_ (DB: $goatlist->{relations}{$_}{goat}[0]{db})\n"; 4121 } 4122 } 4123 4124 ## Now load all of these tables into this herd 4125 $SQL = 'INSERT INTO bucardo.herdmap (herd,priority,goat) VALUES (?,?,' 4126 . q{ (SELECT id FROM goat WHERE schemaname||'.'||tablename=? AND db=?))}; 4127 4128 $sth = $dbh->prepare($SQL); 4129 4130 my (@oldnames, @newnames); 4131 4132 for my $name (sort keys %{ $goatlist->{relations} }) { 4133 ## Is it already part of this herd? 4134 if (exists $HERD->{goat}{$name}) { 4135 push @oldnames => $name; 4136 next; 4137 } 4138 4139 my @a; 4140 eval { 4141 @a = @{$goatlist->{relations}{$name}{goat}}; 4142 }; 4143 4144 my $doneit; 4145 for my $tmpgoat (@a) { 4146 next if exists $doneit->{$tmpgoat->{id}}; 4147 my $db = $tmpgoat->{db}; 4148 my $pri = 0; 4149 4150 $count = $sth->execute($herdname,$pri,$name,$db); 4151 push @newnames => $name; 4152 $doneit->{$tmpgoat->{id}}++; 4153 } 4154 } 4155 4156 if (@oldnames) { 4157 $message .= qq{The following tables or sequences were already in the relgroup "$herdname":\n}; 4158 for (@oldnames) { 4159 $message .= " $_\n"; 4160 } 4161 } 4162 4163 if (@newnames) { 4164 $message .= qq{The following tables or sequences are now part of the relgroup "$herdname":\n}; 4165 for (@newnames) { 4166 $message .= " $_\n"; 4167 } 4168 } 4169 4170 if (!$QUIET) { 4171 print $message; 4172 } 4173 4174 confirm_commit(); 4175 4176 exit 0; 4177 4178} ## end of add_herd 4179 4180 4181sub remove_herd { 4182 4183 ## Usage: remove herd herdname [herd2 herd3 ...] 4184 ## Arguments: none, parses nouns 4185 ## Returns: never, exits 4186 4187 my $doc_section = 'remove'; 4188 usage_exit($doc_section) unless @nouns; 4189 4190 my $herd = $global{herd}; 4191 4192 for my $name (@nouns) { 4193 if (! exists $herd->{$name}) { 4194 die qq{No such relgroup: $name\n}; 4195 } 4196 } 4197 4198 $SQL = 'DELETE FROM bucardo.herd WHERE name = ?'; 4199 $sth = $dbh->prepare($SQL); 4200 for my $name (@nouns) { 4201 eval { 4202 $sth->execute($name); 4203 }; 4204 if ($@) { 4205 if ($@ =~ /"sync_source_herd_fk"/) { 4206 die qq{Cannot delete relgroup "$name": must remove all syncs that reference it first\n}; 4207 } 4208 die qq{Could not delete relgroup "$name"\n$@\n}; 4209 } 4210 } 4211 4212 for my $name (@nouns) { 4213 print qq{Removed relgroup "$name"\n}; 4214 } 4215 4216 $dbh->commit(); 4217 4218 exit 0; 4219 4220} ## end of remove_herd 4221 4222 4223sub add_goat_to_herd { 4224 die "Adding to a relgroup not implemented yet\n"; 4225} 4226 4227 4228sub list_herds { 4229 4230 ## Show information about all or some subset of the 'herd' table 4231 ## Arguments: none, parses nouns for herd names 4232 ## Returns: 0 on success, -1 on error 4233 4234 my $doc_section = 'list'; 4235 4236 ## Any nouns are filters against the whole list 4237 my $clause = generate_clause({col => 'name', items => \@nouns}); 4238 my $WHERE = $clause ? "WHERE $clause" : ''; 4239 $SQL = "SELECT * FROM bucardo.herd $WHERE ORDER BY name"; 4240 $sth = $dbh->prepare($SQL); 4241 $count = $sth->execute(); 4242 if ($count < 1) { 4243 $sth->finish(); 4244 printf "There are no%s relgroups.\n", 4245 $WHERE ? ' matching' : ''; 4246 return -1; 4247 } 4248 $info = $sth->fetchall_arrayref({}); 4249 4250 ## Get sizing information 4251 my $maxlen = 1; 4252 for my $row (@$info) { 4253 $maxlen = length $row->{name} if length $row->{name} > $maxlen; 4254 } 4255 4256 for my $row (@$info) { 4257 my $name = $row->{name}; 4258 my $h = $HERD->{$name}; 4259 printf 'Relgroup: %-*s ', 4260 $maxlen, $name; 4261 printf ' DB: %s ', $h->{db} if $h->{db}; 4262 ## Got goats? 4263 if (exists $h->{goat}) { 4264 print ' Members: '; 4265 print join ', ' => sort { 4266 $h->{goat}{$b}{priority} <=> $h->{goat}{$a}{priority} 4267 or $a cmp $b 4268 } keys %{ $h->{goat} }; 4269 } 4270 ## Got syncs? 4271 if (exists $h->{sync}) { 4272 print "\n Used in syncs: "; 4273 print join ', ' => sort keys %{$h->{sync}}; 4274 } 4275 print "\n"; 4276 $VERBOSE >= 2 and show_all_columns($row); 4277 } 4278 4279 return 0; 4280 4281} ## end of list_herds 4282 4283## 4284## Sync-related subroutines: add, remove, update, list 4285## 4286 4287 4288sub add_sync { 4289 4290 ## Create a new sync by adding an entry to the bucardo.sync table 4291 ## Will add tables as needed to the bucardo.goat table 4292 ## Will create implicit relgroups as needed 4293 ## May modify the goat, herd, and herdmap tables 4294 ## Arguments: none (uses nouns) 4295 ## Returns: never, exits 4296 4297 my $sync_name = shift @nouns || ''; 4298 4299 ## If the sync name does not exist or is empty, show a help screen 4300 my $doc_section = 'add/add sync'; 4301 usage_exit($doc_section) if ! length $sync_name; 4302 4303 ## If this named sync already exists, throw an exception 4304 if (exists $SYNC->{$sync_name}) { 4305 die qq{A sync with the name "$sync_name" already exists\n}; 4306 } 4307 4308 ## Store a list of messages we can output once we have no errors 4309 my @message; 4310 4311 ## Inputs and aliases, database column name, flags, default 4312 my $validcols = qq{ 4313 name name 0 $sync_name 4314 relgroup|herd relgroup 0 null 4315 stayalive stayalive TF null 4316 kidsalive kidsalive TF null 4317 autokick|ping autokick TF null 4318 checktime checktime interval null 4319 strict_checking strict_checking TF null 4320 status status =active|inactive null 4321 priority priority numeric null 4322 analyze_after_copy analyze_after_copy TF null 4323 overdue overdue interval null 4324 expired expired interval null 4325 track_rates track_rates TF null 4326 onetimecopy onetimecopy =0|1|2 null 4327 lifetime lifetime interval null 4328 maxkicks maxkicks numeric null 4329 isolation_level|txnmode isolation_level 0 null 4330 rebuild_index|rebuildindex rebuild_index numeric null 4331 dbgroup dbgroup 0 null 4332 4333 conflict_strategy|standard_conflict|conflict conflict_strategy 0 null 4334 relation|relations|table|tables tables 0 null 4335 db|databases|database|databases|dbs dbs 0 null 4336 }; 4337 4338 my $morph = [ 4339 ## Fullcopy syncs get some of their defaults overriden 4340 ## The controllers and kids never start automatically, 4341 ## and autokick is never on 4342 { 4343 field => 'synctype', 4344 value => 'fullcopy', 4345 new_defaults => 'autokick|F stayalive|F kidsalive|F', 4346 }, 4347 ## We need isolation level to be dash free for SQL 4348 { 4349 field => 'isolation_level', 4350 dash_to_white => 1, 4351 } 4352 ]; 4353 4354 ## Parse all of our arguments, and convert them per rules above 4355 ## We don't use cols and phs and vals in this particular sub! 4356 ## Others should be modified someday to also avoid them 4357 my ($dbcols) = process_simple_args({ 4358 cols => $validcols, 4359 list => \@nouns, 4360 doc_section => $doc_section, 4361 morph => $morph, 4362 }); 4363 4364 ## We must know what to replicate: need a relgroup or a list of tables 4365 if (! exists $dbcols->{relgroup} and ! exists $dbcols->{tables}) { 4366 die "Must specify a relgroup (or a list of tables) for this sync\n"; 4367 } 4368 4369 ## We must know where to replicate: need a dbgroup or a list of databases 4370 if (! exists $dbcols->{dbgroup} and ! exists $dbcols->{dbs}) { 4371 die "Need to specify which dbgroup (or list of databases) for this sync\n"; 4372 } 4373 4374 #### RELGROUP 4375 ## Determine what relgroup to use 4376 ## If one is given, use that; else create a new one 4377 my $relgroup_name; 4378 if (exists $dbcols->{relgroup}) { 4379 4380 ## Simple case where they give us the exact relgroup 4381 if (exists $HERD->{ $dbcols->{relgroup} }) { 4382 4383 ## We cannot have both an existing relgroup and a list of tables 4384 if (exists $dbcols->{tables}) { 4385 die "Cannot specify an existing relgroup and a list of tables\n"; 4386 } 4387 4388 $relgroup_name = $dbcols->{relgroup}; 4389 } 4390 4391 ## If the relgroup has commas, we treat it as a list of tables 4392 ## Otherwise, we create a new relgroup 4393 elsif ($dbcols->{relgroup} !~ /,/) { 4394 $relgroup_name = create_herd( $dbcols->{relgroup}, 'noreload' ); 4395 } 4396 4397 } 4398 4399 ## DBGROUP 4400 ## Determine which dbgroup to use 4401 ## We create a unique name as needed later on 4402 my $dbgroup_name; 4403 if (exists $dbcols->{dbgroup}) { 4404 4405 ## If this dbgroup already exists, we are done 4406 if (exists $DBGROUP->{ $dbcols->{dbgroup} }) { 4407 4408 ## We cannot have both an existing dbgroup and a list of databases 4409 if (exists $dbcols->{dbs}) { 4410 die "Cannot specify an existing dbgroup and a list of databases\n"; 4411 } 4412 4413 $dbgroup_name = $dbcols->{dbgroup}; 4414 } 4415 4416 ## If the dbgroup has commas, we treat it as a list of databases 4417 ## Otherwise, we create a new dbgroup 4418 elsif ($dbcols->{dbgroup} !~ /,/) { 4419 $dbgroup_name = create_dbgroup( $dbcols->{dbgroup}, 'noreload' ); 4420 } 4421 } 4422 4423 ## Before we potentially create a unique dbgroup name 4424 ## we need to process all of our databases, to see 4425 ## if this combo matches an existing dbgroup 4426 4427 #### DB 4428 ## Parse the list of databases to use 4429 ## Databases can come from both dbs and dbgroup - the latter only if it has commas 4430 my @dblist; 4431 if (exists $dbcols->{dbs}) { 4432 @dblist = split /\s*,\s*/ => $dbcols->{dbs}; 4433 } 4434 if (exists $dbcols->{dbgroup} and $dbcols->{dbgroup} =~ /,/) { 4435 push @dblist => split /\s*,\s*/ => $dbcols->{dbgroup}; 4436 } 4437 4438 ## If this is a new dbgroup, databases must be given 4439 if (!@dblist and defined $dbgroup_name and ! exists $DBGROUP->{ $dbgroup_name }) { 4440 die qq{Must provide a list of databases to go into the new dbgroup\n}; 4441 } 4442 4443 my $dbtype = ''; ## the current database type (e.g. source, target) 4444 my %db; ## used to build matching list below 4445 my %rolecount; ## Keep track of types for later logic 4446 my $db_for_lookups; ## Which database to search for new tables 4447 4448 for my $db (@dblist) { 4449 4450 ## Set the default type of database: first is always source 4451 $dbtype = $dbtype eq '' ? 'source' : 'target'; 4452 4453 ## Extract the type if it has one 4454 if ($db =~ s/[=:](.+)//) { 4455 $dbtype = $1; 4456 } 4457 4458 ## If this database is not known to us, throw an exception 4459 if (! exists $DB->{$db}) { 4460 ## This may be a dbgroup: we allow this if it is the only entry! 4461 if (exists $DBGROUP->{ $db } and ! defined $dblist[1]) { 4462 $dbgroup_name = $db; 4463 undef @dblist; 4464 last; 4465 } 4466 die qq{Unknown database "$db"\n}; 4467 } 4468 4469 ## Standardize and check the types 4470 $dbtype = 'source' 4471 if $dbtype =~ /^s/i or $dbtype =~ /^mas/i or $dbtype =~ /^pri/; 4472 $dbtype = 'target' 4473 if $dbtype =~ /^t/i or $dbtype =~ /^rep/i; 4474 $dbtype = 'fullcopy' 4475 if $dbtype =~ /^f/i; 4476 if ($dbtype !~ /^(?:source|target|fullcopy)$/) { 4477 die "Invalid database type: must be source, target, or fullcopy (not $dbtype)\n"; 4478 } 4479 4480 $db{$db} = $dbtype; 4481 $rolecount{$dbtype}++; 4482 4483 $db_for_lookups = $db if $dbtype eq 'source'; 4484 4485 } 4486 4487 ## If we were given dbgroup only, we still need to populate rolecount 4488 if (! @dblist) { 4489 for my $d (values %{ $DBGROUP->{ $dbgroup_name }{db} }) { 4490 $rolecount{$d->{role}}++; 4491 } 4492 } 4493 4494 ## Do any existing groups match this list exactly? 4495 ## We only care about this if they don't have an explicit dbgroup set 4496 if (! defined $dbgroup_name) { 4497 my $newlist = join ',' => map { "$_=".$db{$_} } sort keys %db; 4498 for my $gname (sort keys %$DBGROUP) { 4499 my $innerjoin = join ',' => 4500 map { "$_=".$DBGROUP->{$gname}{db}{$_}{role} } 4501 sort keys %{$DBGROUP->{$gname}{db}}; 4502 if ($innerjoin eq $newlist) { 4503 push @message => qq{Using existing dbgroup "$gname"}; 4504 $dbgroup_name = $gname; 4505 last; 4506 } 4507 } 4508 } 4509 4510 ## If we still don't have a dbgroup, create one based on the sync name 4511 if (! defined $dbgroup_name) { 4512 4513 ## We will use the name of the sync if free 4514 ## Otherwise, keep adding numbers to it until we get a free name 4515 my $newname = $sync_name; 4516 for my $x (2..10_000) { 4517 last if ! exists $DBGROUP->{$newname}; 4518 $newname = "${sync_name}_$x"; 4519 } 4520 4521 $dbgroup_name = create_dbgroup( $newname, 'noreload' ); 4522 } 4523 4524 ## Give a courtesy message if we created a new dbgroup 4525 ## Also associate our dbs with this new group 4526 if (! exists $DBGROUP->{ $dbgroup_name }) { 4527 push @message => qq{Created a new dbgroup named "$dbgroup_name"\n}; 4528 $SQL = 'INSERT INTO bucardo.dbmap(dbgroup,db,role) VALUES (?,?,?)'; 4529 $sth = $dbh->prepare($SQL); 4530 for my $db (sort keys %db) { 4531 $count = $sth->execute($dbgroup_name, $db, $db{$db}); 4532 if (1 != $count) { 4533 die qq{Unable to add database "$db" to dbgroup "$dbgroup_name"\n}; 4534 } 4535 } 4536 } 4537 4538 ## Make sure we only use what the bucardo.sync table needs: dbs 4539 delete $dbcols->{dbgroup}; 4540 $dbcols->{dbs} = $dbgroup_name; ## Someday, rename this column! 4541 4542 ## TABLES 4543 ## Determine the tables to use 4544 ## Always check the first found source database 4545 ## We can get a list of tables via the relgroup argument, 4546 ## or from a tables argument. Handle both ways. 4547 my @tables; 4548 4549 if (exists $dbcols->{relgroup} and $dbcols->{relgroup} =~ /,/) { 4550 @tables = split /\s*,\s*/ => $dbcols->{relgroup}; 4551 } 4552 if (exists $dbcols->{tables}) { 4553 for my $table (split /\s*,\s*/ => $dbcols->{tables}) { 4554 push @tables => $table; 4555 } 4556 } 4557 4558 ## Keep track of what we have already done 4559 my %table; 4560 4561 for my $table (@tables) { 4562 4563 ## Skip if we have seen this already 4564 next if exists $table{$table}; 4565 4566 ## If this table already exists, we are done 4567 if (exists $GOAT->{by_fullname}{$table}) { 4568 $table{$table} = $GOAT->{by_fullname}{$table}->[0]; 4569 next; 4570 } 4571 4572 my $result = get_goat_ids(args => [$table], dbcols => { db => $db_for_lookups} ); 4573 my $found = keys %{ $result->{match} }; 4574 4575 for my $name (sort keys %{ $result->{new} }) { 4576 push @message => qq{ Added table "$name"}; 4577 } 4578 4579 ## If a specific table is not found, throw an exception 4580 if (!$found and $table !~ /^all/) { 4581 die qq{Could not find a relation named "$table"\n}; 4582 } 4583 4584 ## Save each table's information for use below 4585 for my $tname (sort keys %{ $result->{relations} }) { 4586 $table{$tname} ||= $result->{relations}{$tname}{goat}[0]; 4587 } 4588 } 4589 4590 ## If we don't have a relgroup already, see if our list matches an existing one 4591 if (! defined $relgroup_name and keys %table) { 4592 my $newlist = join ',' => 4593 map { "$table{$_}{schemaname}.$table{$_}{tablename}"} 4594 sort { "$table{$a}->{schemaname}.$table{$a}->{tablename}" 4595 cmp "$table{$b}->{schemaname}.$table{$b}->{tablename}"} 4596 keys %table; 4597 for my $rname (sort keys %$RELGROUP) { 4598 my $innerjoin = join ',' => sort keys %{$RELGROUP->{$rname}{goat}}; 4599 if ($innerjoin eq $newlist) { 4600 push @message => qq{Using existing relgroup "$rname"}; 4601 $relgroup_name = $rname; 4602 last; 4603 } 4604 } 4605 } 4606 4607 ## Now we can set a default relgroup based on the sync name if needed 4608 ## If we still don't have a relgroup, create one based on the sync name 4609 if (! defined $relgroup_name) { 4610 4611 ## We will use the name of the sync if free 4612 ## Otherwise, keep adding numbers to it until we get a free name 4613 my $newname = $sync_name; 4614 for my $x (2..10_000) { 4615 last if ! exists $HERD->{$newname}; 4616 $newname = "${sync_name}_$x"; 4617 } 4618 4619 $relgroup_name = create_herd( $newname, 'noreload' ); 4620 } 4621 4622 ## Give a courtesy message if we created a new relgroup 4623 ## Also associate our tables with this new group 4624 if (! exists $HERD->{ $relgroup_name }) { 4625 4626 unshift @message => qq{Created a new relgroup named "$relgroup_name"\n}; 4627 4628 $SQL = 'INSERT INTO bucardo.herdmap(herd,goat) VALUES (?,?)'; 4629 $sth = $dbh->prepare($SQL); 4630 4631 for my $t (sort keys %table) { 4632 $count = $sth->execute($relgroup_name, $table{$t}{id}); 4633 if (1 != $count) { 4634 die qq{Unable to add table "$t" to relgroup "$relgroup_name"\n}; 4635 } 4636 } 4637 4638 4639 } 4640 4641 ## Make sure we use relgroup but not tables for the SQL below 4642 delete $dbcols->{tables}; 4643 delete $dbcols->{relgroup}; 4644 $dbcols->{herd} = $relgroup_name; 4645 4646 ## If this is a pure fullcopy sync, we want to turn stayalive and kidsalive off 4647 if ($rolecount{'source'} == 1 4648 and $rolecount{'fullcopy'} 4649 and ! $rolecount{'target'}) { 4650 $dbcols->{stayalive} = 0; 4651 $dbcols->{kidsalive} = 0; 4652 } 4653 4654 ## Allow some alternate way to say things 4655 my $cs = 'conflict_strategy'; 4656 if (exists $dbcols->{$cs}) { 4657 $dbcols->{$cs} = 'bucardo_latest' 4658 if $dbcols->{$cs} eq 'default' or $dbcols->{$cs} eq 'latest'; 4659 } 4660 4661 ## Attempt to insert this into the database 4662 my $columns = join ',' => keys %$dbcols; 4663 my $qs = '?,' x keys %$dbcols; 4664 chop $qs; 4665 $SQL = "INSERT INTO bucardo.sync ($columns) VALUES ($qs)"; 4666 $DEBUG and warn "SQL: $SQL\n"; 4667 $sth = $dbh->prepare($SQL); 4668 $DEBUG and warn Dumper values %$dbcols; 4669 eval { 4670 $count = $sth->execute(values %$dbcols); 4671 }; 4672 if ($@) { 4673 die "Failed to add sync: $@\n"; 4674 } 4675 4676 $QUIET or print qq{Added sync "$sync_name"\n}; 4677 4678 ## Now we can output our success messages if any 4679 for my $msg (@message) { 4680 chomp $msg; 4681 $QUIET or print "$msg\n"; 4682 } 4683 4684 confirm_commit(); 4685 4686 exit 0; 4687 4688} ## end of add_sync 4689 4690 4691sub remove_sync { 4692 4693 ## Usage: remove sync name [name2 name3 ...] 4694 ## Arguments: none (uses nouns) 4695 ## Returns: never, exits 4696 4697 my $doc_section = 'remove'; 4698 usage_exit($doc_section) unless @nouns; 4699 4700 ## Make sure all named syncs exist 4701 my $s = $global{sync}; 4702 for my $name (@nouns) { 4703 if (! exists $s->{$name}) { 4704 die qq{No such sync: $name\n}; 4705 } 4706 } 4707 4708 ## Make sure none of the syncs are currently running 4709 ## XXX Is there anything we can do to check that the sync is active? 4710 4711 $SQL = 'DELETE FROM bucardo.sync WHERE name = ?'; 4712 $sth = $dbh->prepare($SQL); 4713 4714 for my $name (@nouns) { 4715 eval { 4716 $sth->execute($name); 4717 }; 4718 if ($@) { 4719 if ($@ =~ /"goat_db_fk"/) { 4720 die qq{Cannot delete sync "$name": must remove all tables that reference it first\n}; 4721 } 4722 die qq{Could not delete sync "$name"\n$@\n}; 4723 } 4724 } 4725 4726 for my $name (@nouns) { 4727 print qq{Removed sync "$name"\n}; 4728 print "Note: table triggers (if any) are not automatically removed!\n"; 4729 } 4730 4731 $dbh->commit(); 4732 4733 exit 0; 4734 4735} ## end of remove_sync 4736 4737sub update_sync { 4738 4739 ## Update one or more syncs 4740 ## Arguments: none (reads nouns for a list of syncs) 4741 ## Returns: never, exits 4742 4743 my @actions = @_; 4744 4745 my $doc_section = 'update/update sync'; 4746 usage_exit($doc_section) unless @actions; 4747 4748 my $name = shift @actions; 4749 4750 ## Recursively call ourselves for wildcards and 'all' 4751 exit 0 if ! check_recurse($SYNC, $name, @actions); 4752 4753 ## Make sure this sync exists! 4754 if (! exists $SYNC->{$name}) { 4755 die qq{Could not find a sync named "$name"\nUse 'list syncs' to see all available.\n}; 4756 } 4757 4758 my $changes = 0; 4759 4760 ## Current information about this sync, including column names 4761 my $syncinfo; 4762 4763 my %aliases = ( 4764 standard_conflict => 'conflict_strategy', 4765 conflict => 'conflict_strategy', 4766 ping => 'autokick', 4767 relgroup => 'herd', 4768 ); 4769 4770 for my $action (@actions) { 4771 4772 ## Skip noise words 4773 next if $action =~ 'set'; 4774 4775 ## Allow for some simple shortcuts 4776 if ($action =~/^inactiv/i) { 4777 $action = 'status=inactive'; 4778 } 4779 elsif ($action =~ /^activ/i) { 4780 $action = 'status=active'; 4781 } 4782 4783 ## Look for a standard foo=bar or foo:bar format 4784 if ($action =~ /(.+?)\s*[=:]\s*(.+)/) { 4785 my ($setting,$value) = (lc $1,$2); 4786 4787 ## No funny characters please, just boring column names 4788 $setting =~ /^[a-z_]+$/ or die "Invalid setting: $setting\n"; 4789 $setting = $aliases{$setting} || $setting; 4790 4791 ## If we have not already, grab the current information for this sync 4792 ## We also use this to get the list of valid column names to modify 4793 if (! defined $syncinfo) { 4794 $SQL = 'SELECT * FROM sync WHERE name = ?'; 4795 $sth = $dbh->prepare($SQL); 4796 $count = $sth->execute($name); 4797 ## Check count 4798 $syncinfo = $sth->fetchall_arrayref({})->[0]; 4799 for my $col (qw/ cdate /) { 4800 delete $syncinfo->{$col}; 4801 } 4802 } 4803 4804 ## Is this a valid column? 4805 if (! exists $syncinfo->{$setting}) { 4806 die "Invalid setting: $setting\n"; 4807 } 4808 4809 ## Do any magic we need for specific items 4810 if ($setting eq 'isolation_level') { 4811 $value =~ s/_/ /g; 4812 } 4813 elsif ($setting eq 'conflict_strategy') { 4814 4815 ## Allow some alternative names 4816 $value = 'bucardo_latest' if $value eq 'default' or $value eq 'latest'; 4817 $value = 'bucardo_latest_all_tables' if $value eq 'latest_all'; 4818 4819 ## If the name does not start with bucardo, it must be a list of databases 4820 if ($value !~ /^bucardo_/) { 4821 my $dbs = $SYNC->{$name}{dblist}; 4822 $value =~ s/[,\s]+/ /g; 4823 for my $dbname (split / / => $value) { 4824 if (! exists $dbs->{$dbname}) { 4825 die qq{conflict_strategy should contain a list of databases, but "$dbname" is not a db for this sync!\n}; 4826 } 4827 } 4828 } 4829 4830 $QUIET or print qq{Set conflict strategy to '$value'\n}; 4831 } 4832 4833 ## Try setting it 4834 $SQL = "UPDATE sync SET $setting=? WHERE name = ?"; 4835 $sth = $dbh->prepare($SQL); 4836 $sth->execute($value,$name); 4837 $changes++; 4838 4839 next; 4840 } 4841 4842 warn "\nUnknown action: $action\n"; 4843 usage_exit($doc_section); 4844 } 4845 4846 confirm_commit() if $changes; 4847 4848 return; 4849 4850} ## end of update_sync 4851 4852 4853sub list_syncs { 4854 4855 ## Show information about all or some subset of the 'sync' table 4856 ## Arguments: none (reads nouns for a list of syncs) 4857 ## Returns: 0 on success, -1 on error 4858 4859 my $doc_section = 'list'; 4860 4861 my $syncs = $global{sync}; 4862 4863 ## Do we have at least one name specified (if not, show all) 4864 my $namefilter = 0; 4865 4866 for my $term (@nouns) { 4867 4868 ## Filter out by status: only show active or inactive syncs 4869 if ($term =~ /^(active|inactive)$/i) { 4870 my $stat = lc $1; 4871 for my $name (keys %$syncs) { 4872 delete $syncs->{$name} if $syncs->{$name}{status} ne $stat; 4873 } 4874 next; 4875 } 4876 4877 ## Filter out by arbitrary attribute matches 4878 if ($term =~ /(\w+)\s*=\s*(\w+)/) { 4879 my ($attrib, $value) = (lc $1,$2); 4880 for my $name (keys %$syncs) { 4881 if (! exists $syncs->{$name}{$attrib}) { 4882 my $message = "No such sync attribute: $attrib\n"; 4883 $message .= "Must be one of the following:\n"; 4884 my $names = join ',' => 4885 sort 4886 grep { $_ !~ /\b(?:cdate|name)\b/ } 4887 keys %{ $syncs->{$name} }; 4888 $message .= " $names\n"; 4889 die $message; 4890 } 4891 delete $syncs->{$name} if $syncs->{$name}{$attrib} ne $value; 4892 } 4893 next; 4894 } 4895 4896 ## Everything else should be considered a sync name 4897 $namefilter = 1; 4898 4899 ## Check for wildcards 4900 if ($term =~ s/[*%]/.*/) { 4901 for my $name (keys %$syncs) { 4902 $syncs->{$name}{ok2show} = 1 if $name =~ /$term/; 4903 } 4904 next; 4905 } 4906 4907 ## Must be an exact match 4908 for my $name (keys %$syncs) { 4909 $syncs->{$name}{ok2show} = 1 if $name eq $term; 4910 } 4911 4912 } 4913 4914 ## If we filtered by name, remove all the non-matched ones 4915 if ($namefilter) { 4916 for my $name (keys %$syncs) { 4917 delete $syncs->{$name} if ! exists $syncs->{$name}{ok2show}; 4918 } 4919 } 4920 4921 ## Nothing found? We're out of here 4922 if (! keys %$syncs) { 4923 print "No syncs found\n"; 4924 return -1; 4925 } 4926 4927 ## Determine the size of the output strings for pretty aligning later 4928 my ($maxname, $maxherd, $maxdbs) = (2,2,2); 4929 for my $name (keys %$syncs) { 4930 my $s = $syncs->{$name}; $maxname = length $name if length $name > $maxname; 4931 $maxherd = length $s->{herd}{name} if length $s->{herd}{name} > $maxherd; 4932 $s->{d} = qq{DB group "$s->{dbs}"}; 4933 for (sort keys %{ $s->{dblist} }) { 4934 $s->{d} .= " $_:$s->{dblist}{$_}{role}"; 4935 } 4936 $maxdbs = length $s->{d} if length $s->{d} > $maxdbs; 4937 } 4938 4939 ## Now print them out in alphabetic order 4940 for my $name (sort keys %$syncs) { 4941 my $s = $syncs->{$name}; 4942 4943 ## Switch to multi-line if database info strings are over this 4944 my $maxdbline = 50; 4945 4946 ## Show basic information 4947 printf qq{Sync %-*s Relgroup %-*s %s[%s]\n}, 4948 2+$maxname, qq{"$name"}, 4949 2+$maxherd, qq{"$s->{herd}{name}"}, 4950 $maxdbs > $maxdbline ? '' : " $s->{d} ", 4951 ucfirst $s->{status}; 4952 4953 ## Print the second line if needed 4954 if ($maxdbs > $maxdbline) { 4955 print " $s->{d}\n"; 4956 } 4957 4958 ## Show associated tables if in verbose mode 4959 if ($VERBOSE >= 1) { 4960 if (exists $s->{herd}{goat}) { 4961 my $goathash = $s->{herd}{goat}; 4962 for my $relname (sort { 4963 $goathash->{$b}{priority} <=> $goathash->{$a}{priority} 4964 or $a cmp $b 4965 } 4966 keys %{ $goathash }) { 4967 printf " %s %s\n", 4968 ucfirst($goathash->{$relname}{reltype}),$relname; 4969 } 4970 } 4971 } 4972 4973 ## Show all the sync attributes 4974 $VERBOSE >= 2 and show_all_columns($s); 4975 4976 } ## end of each sync 4977 4978 return 0; 4979 4980} ## end of list_syncs 4981 4982 4983sub get_goat_ids { 4984 4985 ## Returns the ids from the goat table for matching relations 4986 ## Also checks the live database and adds tables to the goat table as needed. 4987 ## Arguments: key-value pairs: 4988 ## - args: arrayref of names to match against. Can have wildcards. Can be 'all' 4989 ## - type: 'table' or 'sequence', depending on what we expect to find. 4990 ## - dbcols: optional hashref of fields to populate goat table with (e.g. autokick=1) 4991 ## - noherd: do not consider items if already in this herd for "all" 4992 ## Returns: a hash with: 4993 ## - relations: hash of goat objects, key is the fully qualified name 4994 ## - original: hash of search term(s) used to find this 4995 ## - goat: the goat object 4996 ## - nomatch: hash of non-matching terms 4997 ## - match: hash of matching terms 4998 ## - new: hash of newly added tables 4999 5000 my %arg = @_; 5001 my $reltype = $arg{type}; 5002 my $names = $arg{args} or die 'Must have list of things to match'; 5003 my $dbcols = $arg{dbcols} || {}; 5004 my $noherd = $arg{noherd} || ''; 5005 5006 ## The final hash we return 5007 my %relation; 5008 5009 ## Args that produced a match 5010 my %match; 5011 5012 ## Args that produced no matches at all 5013 my %nomatch; 5014 5015 ## Keep track of which args we've already done, just in case there are dupes 5016 my %seenit; 5017 5018 ## Which tables we added to the goat table 5019 my %new; 5020 5021 ## Figure out which database to search in, unless already given 5022 my $bestdb = (exists $dbcols->{db} and defined $dbcols->{db}) 5023 ? $dbcols->{db} : find_best_db_for_searching(); 5024 5025 ## This check still makes sense: if no databases, there should be nothing in $GOAT! 5026 if (! defined $bestdb) { 5027 die "No databases have been added yet, so we cannot add tables!\n"; 5028 } 5029 5030 ## Allow "tables=all" to become "all" 5031 for my $item (@$names) { 5032 $item = 'all' if $item =~ /^tables?=all/i; 5033 } 5034 5035 my $rdbh = connect_database({name => $bestdb}) or die; 5036 5037 ## SQL to find a table or a sequence 5038 ## We do not want pg_table_is_visible(c.oid) here 5039 my $BASESQL = sub { 5040 my $arg = shift || 'table'; 5041 ## Assume we're talking about tables unless we say "sequence" explicitly 5042 my $type = ( $arg eq 'sequence' ? 'S' : 'r' ); 5043 return qq{ 5044SELECT nspname||'.'||relname AS name, relkind, c.oid, coalesce(i.indisprimary, false) as relhaspkey, nspname, relname 5045FROM pg_class c 5046JOIN pg_namespace n ON (n.oid = c.relnamespace) 5047LEFT JOIN pg_index i ON (indrelid = c.oid AND indisprimary) 5048WHERE relkind IN ('$type') 5049AND nspname <> 'information_schema' 5050AND nspname !~ '^pg_' 5051}; 5052}; 5053 5054 ## Loop through each argument, and try and find matching goats 5055 ITEM: for my $item (@$names) { 5056 5057 ## In case someone entered duplicate arguments 5058 next if $seenit{$item}++; 5059 5060 ## Skip if this is not a tablename, but an argument of the form x=y 5061 next if index($item, '=') >= 0; 5062 5063 ## Determine if this item has a dot in it, and/or it is using wildcards 5064 my $hasadot = index($item,'.') >= 0 ? 1 : 0; 5065 my $hasstar = (index($item,'*') >= 0 or index($item,'%') >= 0) ? 1 : 0; 5066 5067 ## Temporary list of matching items 5068 my @matches; 5069 5070 ## A list of tables to be bulk added to the goat table 5071 my @addtable; 5072 5073 ## We may mutate the arg, so stow away the original 5074 my $original_item = $item; 5075 5076 ## We look for matches in the existing $GOAT hash 5077 ## We may also check the live database afterwards 5078 map { 5079 push @matches, $_ if (! defined $reltype || $_->{reltype} eq $reltype); 5080 } find_goat_by_item($item, \@nouns); 5081 5082 ## Wildcards? 5083 my $regex_item = $item; 5084 5085 ## Setup the SQL to search the live database 5086 if ($hasstar) { 5087 ## Change to a regexier form 5088 $regex_item =~ s/\./\\./g; 5089 $regex_item =~ s/[*%]/\.\*/g; 5090 $regex_item = "^$regex_item" if $regex_item !~ /^[\^\.\%]/; 5091 $regex_item .= '$' if $regex_item !~ /[\$\*]$/; 5092 5093 ## Setup the SQL to search the live database 5094 $SQL = $BASESQL->($reltype) . ($hasadot 5095 ? q{AND nspname||'.'||relname ~ ?} 5096 : 'AND relname ~ ?'); 5097 5098 } ## end wildcards 5099 elsif ($hasadot) { 5100 ## A dot with no wildcards: exact match 5101 ## TODO: Allow foobar. to mean foobar.% ?? 5102 $SQL = $BASESQL->($reltype) . q{AND nspname||'.'||relname = ?}; 5103 } 5104 else { 5105 ## No wildcards and no dot, so we match all tables regardless of the schema 5106 $SQL = $BASESQL->($reltype); 5107 $item eq 'all' or $SQL .= 'AND relname = ?'; 5108 } 5109 5110 ## We do not check the live database if the match was exact 5111 ## *and* something was found. In all other cases, we go live. 5112 if ($hasstar or !$hasadot or !@matches) { 5113 debug(qq{NB! Found some existing matches; searching for other possibilities, because "$item" } 5114 . ( $hasstar ? 'includes wildcard characters ' : '' ) 5115 . ( !$hasadot ? 'does not include a dot' : '' )) if @matches; 5116 ## Search the live database for matches 5117 $sth = $rdbh->prepare($SQL); 5118 $regex_item ||= $item; 5119 if ('all' eq $item) { 5120 ($count = $sth->execute()) =~ s/0E0/0/; 5121 } 5122 else { 5123 ($count = $sth->execute($regex_item)) =~ s/0E0/0/; 5124 } 5125 debug(qq{Searched live database "$bestdb" for arg "$regex_item", count was $count}); 5126 debug(qq{SQL: $SQL}, 2); 5127 debug(qq{Arg: $item ($regex_item)}, 2); 5128 for my $row (@{ $sth->fetchall_arrayref({}) }) { 5129 5130 ## The 'name' is combined "schema.relname" 5131 my $name = $row->{name}; 5132 5133 ## Don't bother if we have already added this! 5134 next if find_goat_by_item($name, [ "db=$bestdb" ]); 5135 5136 ## If we are doing 'all', exclude the bucardo schema, and insist on a primary key 5137 if ('all' eq $item) { 5138 next if $name =~ /^bucardo\./; 5139 if (!$row->{relhaspkey}) { 5140 ## Allow if we have a unique index on this table 5141 $SQL = q{SELECT 1 FROM pg_index WHERE indisunique AND indrelid = } 5142 . q{(SELECT c.oid FROM pg_class c JOIN pg_namespace n ON (n.oid = c.relnamespace) WHERE n.nspname=? AND c.relname=?)}; 5143 my $sthunique = $rdbh->prepare_cached($SQL); 5144 $count = $sthunique->execute($row->{nspname},$row->{relname}); 5145 $sthunique->finish(); 5146 next if $count < 1; 5147 } 5148 } 5149 5150 ## Document the string that led us to this one 5151 $relation{$name}{original}{$item}++; 5152 5153 ## Document the fact that we found this on a database 5154 $new{$name}++; 5155 5156 ## Mark this item as having produced a match 5157 $match{$item}++; 5158 5159 ## Set this table to be added to the goat table below 5160 push @addtable, {name => $name, db => $bestdb, reltype => $row->{relkind}, dbcols => $dbcols}; 5161 5162 } 5163 } 5164 5165 ## Add all the tables we just found from searching the live database 5166 my $added_tables; 5167 if (@addtable) { 5168 $added_tables = add_items_to_goat_table(\@addtable); 5169 } 5170 for my $tmp (@$added_tables) { 5171 push @matches, $GOAT->{by_id}{$tmp}; 5172 } 5173 5174 ## If we asked for "all", add in all of our known tables (not already in this herd) 5175 if ($names->[0] eq 'all') { 5176 for (values %{ $GOAT->{by_db}{$bestdb} }) { 5177 next if exists $_->{herd}{$noherd}; 5178 push @matches, $_; 5179 } 5180 } 5181 5182 ## Populate the final hashes based on the match list 5183 for my $match (@matches) { 5184 next unless defined $match; 5185 my $name; 5186 if (ref $match eq 'HASH') { 5187 $name = "$match->{schemaname}.$match->{tablename}"; 5188 } 5189 else { 5190 $name = $match; 5191 } 5192 $relation{$name}{original}{$original_item}++; 5193 5194 ## This goat entry should be an array, if there are multiple goats 5195 ## with that name (e.g. from different databases) 5196 if (exists $relation{$name}{goat}) { 5197 push @{$relation{$name}{goat}}, $match; 5198 } 5199 else { 5200 $relation{$name}{goat} = [ $match ]; 5201 } 5202 $match{$item}++; 5203 } 5204 5205 ## If this item did not match anything, note that as well 5206 if (! @matches and $names->[0] ne 'all') { 5207 $nomatch{$original_item}++; 5208 } 5209 5210 } ## end each given needle 5211 5212 return { 5213 relations => \%relation, 5214 nomatch => \%nomatch, 5215 match => \%match, 5216 new => \%new, 5217 }; 5218 5219} ## end of get_goat_ids 5220 5221 5222sub add_items_to_goat_table { 5223 5224 ## Given a list of tables, add them to the goat table as needed 5225 ## Arguments: one 5226 ## 1. Arrayref where keys are: 5227 ## - name: name of relation to add (mandatory) 5228 ## - db: the database name (mandatory) 5229 ## - reltype: table or sequence (optional, defaults to table) 5230 ## - dbcols: optional hashref of goat columns to set 5231 ## Returns: arrayref with all the new goat.ids 5232 5233 my $info = shift or die; 5234 5235 ## Quick check if the entry is already there. 5236 $SQL = 'SELECT id FROM bucardo.goat WHERE schemaname=? AND tablename=? AND db=?'; 5237 my $isthere = $dbh->prepare($SQL); 5238 5239 ## SQL to add this new entry in 5240 my $NEWGOATSQL = 'INSERT INTO bucardo.goat (schemaname,tablename,reltype,db) VALUES (?,?,?,?) RETURNING id'; 5241 5242 my @newid; 5243 5244 for my $rel (sort { $a->{name} cmp $b->{name} } @$info) { 5245 # XXX Is it safe to assume UTF8 encoding here? Probably not 5246 my $name = $rel->{name}; 5247 if ($name !~ /^([-\w ]+)\.([-\w ]+)$/o) { 5248 die qq{Invalid name, got "$name", but expected format "schema.relname"}; 5249 } 5250 my ($schema,$table) = ($1,$2); 5251 5252 my $db = $rel->{db} or die q{Must provide a database}; 5253 5254 my $reltype = $rel->{reltype} || 't'; 5255 $reltype = $reltype =~ /s/i ? 'sequence' : 'table'; 5256 5257 ## Adjust the SQL as necessary for this goat 5258 $SQL = $NEWGOATSQL; 5259 my @args = ($schema, $table, $reltype, $db); 5260 if (exists $rel->{dbcols}) { 5261 for my $newcol (sort keys %{ $rel->{dbcols} }) { 5262 next if $newcol eq 'db'; 5263 $SQL =~ s/\)/,$newcol)/; 5264 $SQL =~ s/\?,/?,?,/; 5265 push @args => $rel->{dbcols}{$newcol}; 5266 } 5267 } 5268 $sth = $dbh->prepare($SQL); 5269 ($count = $sth->execute(@args)) =~ s/0E0/0/; 5270 5271 debug(qq{Added "$schema.$table" with db "$db", count was $count}); 5272 5273 push @newid => $sth->fetchall_arrayref()->[0][0]; 5274 } 5275 5276 ## Update the global 5277 load_bucardo_info('force_reload'); 5278 5279 ## Return a list of goat IDs we've just added 5280# my %newlist; 5281# for my $id (@newid) { 5282# my $goat = $global{goat}{by_id}{$id}; 5283# my $name = "$goat->{schemaname}.$goat->{tablename}"; 5284# $newlist{$name} = $goat; 5285# } 5286 5287 return \@newid; 5288 5289 5290} ## end of add_items_to_goat_table 5291 5292 5293sub create_dbgroup { 5294 5295 ## Creates a new entry in the bucardo.dbgroup table 5296 ## Caller should have alredy checked for existence 5297 ## Does not commit 5298 ## Arguments: two 5299 ## 1. Name of the new group 5300 ## 2. Boolean: if true, prevents the reload 5301 ## Returns: name of the new group 5302 5303 my ($name,$noreload) = @_; 5304 5305 $SQL = 'INSERT INTO bucardo.dbgroup(name) VALUES (?)'; 5306 $sth = $dbh->prepare($SQL); 5307 eval { 5308 $sth->execute($name); 5309 }; 5310 if ($@) { 5311 if ($@ =~ /dbgroup_name_sane/) { 5312 print "Trying name $name\n"; 5313 print qq{Invalid characters in dbgroup name "$name"\n}; 5314 } 5315 else { 5316 print qq{Failed to create dbgroup "$name"\n$@\n}; 5317 } 5318 exit 1; 5319 } 5320 5321 ## Reload our hashes 5322 $noreload or load_bucardo_info(1); 5323 5324 return $name; 5325 5326} ## end of create_dbgroup 5327 5328 5329sub get_arg_items { 5330 5331 ## From an argument list, return all matching items 5332 ## Arguments: two 5333 ## 1. Arrayref of source items to match on 5334 ## 2. Arrayref of arguments 5335 ## Returns: an arrayref of matches, or an single scalar indicating what arg failed 5336 5337 my ($haystack, $needles) = @_; 5338 5339 my %match; 5340 5341 for my $needle (@$needles) { 5342 5343 my $hasadot = index($needle,'.') >= 0 ? 1 : 0; 5344 my $hasstar = (index($needle,'*') >= 0 or index($needle,'%') >= 0) ? 1 : 0; 5345 5346 ## Wildcards? 5347 if ($hasstar) { 5348 5349 ## Change to a regexier form 5350 $needle =~ s/\*/\.\*/g; 5351 5352 ## Count matches: if none found, we bail 5353 my $found = 0; 5354 for my $fullname (@$haystack) { 5355 ## If it has a dot, match the whole thing 5356 if ($hasadot) { 5357 if ($fullname =~ /^$needle$/) { 5358 $match{$fullname} = $found++; 5359 } 5360 next; 5361 } 5362 5363 ## No dot, so match table part only 5364 my ($schema,$table) = split /\./ => $fullname; 5365 if ($table =~ /^$needle$/) { 5366 $match{$fullname} = $found++; 5367 } 5368 } 5369 5370 return $needle if ! $found; 5371 5372 next; 5373 5374 } ## end wildcards 5375 5376 ## If it has a dot, it must match exactly 5377 if ($hasadot) { 5378 if (grep { $_ eq $needle } @$haystack) { 5379 $match{$needle} = 1; 5380 next; 5381 } 5382 return $needle; 5383 } 5384 5385 ## No dot, so we match all tables regardless of the schema 5386 my $found = 0; 5387 for my $fullname (@$haystack) { 5388 my ($schema,$table) = split /\./ => $fullname; 5389 if ($table eq $needle) { 5390 $match{$fullname} = $found++; 5391 } 5392 } 5393 return $needle if ! $found; 5394 5395 } ## end each given needle 5396 5397 5398 return \%match; ## May be undefined 5399 5400} ## end of get_arg_items 5401 5402 5403sub clone { 5404 5405 ## Put an entry in the clone table so the MCP can do some copyin' 5406 ## Arguments: none, parses nouns 5407 ## Returns: never, exits 5408 5409 my $doc_section = 'clone'; 5410 5411 usage_exit($doc_section) unless @nouns; 5412 5413 ## Examples: 5414 ## ./bucardo clone dbs=A:source,B,C relgroup=foo 5415 ## ./bucardo clone sync=foobar 5416 ## ./bucardo clone sync=foobar prime=A 5417 ## ./bucardo clone dbs=A,B,C,D relgroup=foo notruncate=B,C 5418 5419 ## Optional sync to associate with: 5420 my $sync; 5421 5422 ## Optional database group to use: 5423 my $dbgroup; 5424 5425 ## The prime (winning) source database. 5426 my $prime; 5427 5428 ## Optonal relgroup. Can be a list of tables 5429 my $relgroup; 5430 5431 ## Optional options :) 5432 my $options; 5433 5434 for my $word (@nouns) { 5435 5436 ## Check for an optional sync name. 5437 if ($word =~ /(?i)sync(?-i)\s*[:=]\s*(\w.*?)\s*$/) { 5438 my $syncname = $1; 5439 if (! exists $SYNC->{$syncname}) { 5440 die qq{Invalid sync "$syncname"\n}; 5441 } 5442 ## Have we already specified a sync? 5443 if (defined $sync) { 5444 die qq{Cannot specify more than one sync\n}; 5445 } 5446 5447 $sync = $syncname; 5448 next; 5449 } 5450 5451 ## Check for an optional dbgroup 5452 if ($word =~ /(?i)dbg(?-i)\w*\s*[:=]\s*(\w.*?)\s*$/) { 5453 my $dbgroupname = $1; 5454 if (! exists $DBGROUP->{$dbgroupname}) { 5455 die qq{Invalid database group "$dbgroupname"\n}; 5456 } 5457 ## Have we already specified a database group? 5458 if (defined $dbgroup) { 5459 die qq{Cannot specify more than one database group\n}; 5460 } 5461 $dbgroup = $dbgroupname; 5462 next; 5463 } 5464 5465 ## Check for an optional relgroup 5466 if ($word =~ /(?i)(?:relgroup|table)s?(?-i)\w*\s*[:=]\s*(\w.*?)\s*$/) { 5467 my $relgroupname = $1; 5468 ## May be a relgroup, or a list of tables 5469 if (exists $RELGROUP->{$relgroupname}) { 5470 $relgroup = $relgroupname; 5471 next; 5472 } 5473 ## Must be one or more tables. See if we can find them, and shove into a relgroup 5474 5475 ## Go through all the items and try to find matches 5476 ## Assumes tables are all in CSV format 5477 my @tablelist = split /\s*,\s*/ => $relgroupname; 5478 my $goatlist = get_goat_ids(args => \@tablelist, type => 'table'); 5479 5480 ## Cannot proceed unless we have a match for every table 5481 if (keys %{ $goatlist->{nomatch} }) { 5482 print "Cannot clone because the following tables were not found:\n"; 5483 for my $badname (sort keys %{ $goatlist->{nomatch} }) { 5484 print " $badname\n"; 5485 } 5486 exit 1; 5487 } 5488 5489 ## We need to generate a relgroup name 5490 ## TODO: See if any existing relgroups match exactly 5491 my $basename = 'clone_relgroup'; 5492 my $number = 1; 5493 { 5494 $relgroupname = "$basename$number"; 5495 last if ! exists $RELGROUP->{$relgroupname}; 5496 $number++; 5497 redo; 5498 } 5499 5500 $SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)'; 5501 $sth = $dbh->prepare($SQL); 5502 $sth->execute($relgroupname); 5503 5504 $SQL = 'INSERT INTO bucardo.herdmap (herd,goat) VALUES (?,?)'; 5505 $sth = $dbh->prepare($SQL); 5506 for my $goat (values %{ $goatlist->{relations} }) { 5507 $sth->execute($relgroupname, $goat->{goat}[0]{id}); 5508 } 5509 5510 next; 5511 } 5512 5513 ## Check for a prime 5514 if ($word =~ /(?i)prime(?-i)\w*\s*[:=]\s*(\w.*?)\s*$/) { 5515 $prime = $1; 5516 for my $candidate (split /\s*,\s*/ => $prime) { 5517 ## This must be a valid database 5518 if (! exists $DB->{$candidate}) { 5519 die qq{The prime option must specify a known database (not "$candidate")\n}; 5520 } 5521 } 5522 $options .= "prime=$prime;"; 5523 next; 5524 } 5525 5526 die qq{Unknown option: $word\n}; 5527 5528 } ## end checking each noun 5529 5530 ## Must have at least one of sync or dbgroup 5531 if (! defined $sync and ! defined $dbgroup) { 5532 die qq{Must provide a sync or a database group\n}; 5533 } 5534 5535 ## Generate a list of databases to make sure we know which is prime 5536 my $dbrole; 5537 if (defined $dbgroup) { 5538 for my $row (values %{ $DBGROUP->{$dbgroup}{db} }) { 5539 $dbrole->{ $row->{role} }{ $row->{db} } = 1; 5540 } 5541 } 5542 else { 5543 for my $db (values %{ $SYNC->{$sync}{dblist} }) { 5544 $dbrole->{ $db->{role} }{ $db->{db} } = 1; 5545 } 5546 } 5547 5548 ## If we have more than one source, make sure we know how to proceed 5549 if (keys %{ $dbrole->{source}} > 1) { 5550 ## TODO: Allow more than one somehow 5551 if (! defined $prime) { 5552 warn qq{Must provide a prime so we know which database to copy from\n}; 5553 my $dblist = join ', ' => sort keys %{ $dbrole->{source} }; 5554 warn qq{Should be one of: $dblist\n}; 5555 exit 1; 5556 } 5557 } 5558 5559 ## Clean up the options by removing any trailing semicolons 5560 if (defined $options) { 5561 $options =~ s/;$//; 5562 } 5563 5564 $SQL = 'INSERT INTO bucardo.clone(status,sync,dbgroup,relgroup,options) VALUES (?,?,?,?,?) RETURNING id'; 5565 $sth = $dbh->prepare($SQL); 5566 $sth->execute('new', $sync, $dbgroup, $relgroup, $options); 5567 my $id = $sth->fetchall_arrayref()->[0][0]; 5568 5569 ## Tell the MCP there is a new clone 5570 $dbh->do('NOTIFY bucardo_clone_ready'); 5571 5572 confirm_commit(); 5573 5574 $QUIET or print qq{Clone $id has been started. Track progress with "bucardo status clone $id"\n}; 5575 5576 exit 0; 5577 5578} ## end of clone 5579 5580 5581 5582sub kick { 5583 5584 ## Kick one or more syncs 5585 ## Arguments: none, parses nouns 5586 ## Returns: never, exits 5587 5588 my $doc_section = 'kick'; 5589 usage_exit($doc_section) unless @nouns; 5590 5591 my ($exitstatus, $retries, $do_retry) = (0,0,0); 5592 5593 RETRY: { 5594 $dbh->rollback(); 5595 $exitstatus = 0; 5596 SYNC: for my $sync (@syncs) { 5597 my $relname = "bucardo_kick_sync_$sync"; 5598 5599 ## If this sync is not active, cowardly refuse to kick it 5600 if ($SYNC->{$sync}{status} ne 'active') { 5601 print qq{Cannot kick inactive sync "$sync"\n}; 5602 next SYNC; 5603 } 5604 5605 $dbh->do(qq{NOTIFY "bucardo_kick_sync_$sync"}); 5606 my $done = "bucardo_syncdone_$sync"; 5607 my $killed = "bucardo_synckill_$sync"; 5608 if (! defined $adverb) { 5609 $dbh->commit(); 5610 $QUIET or print qq{Kicked sync $sync\n}; 5611 next; 5612 } 5613 5614 $QUIET or print qq{Kick $sync: }; 5615 $dbh->do(qq{LISTEN "$done"}); 5616 $dbh->do(qq{LISTEN "$killed"}); 5617 $dbh->commit(); 5618 5619 my $time = time; 5620 sleep 0.1; 5621 5622 my $timeout = (defined $adverb and $adverb > 0) ? $adverb : 0; 5623 5624 my $printstring = $NOTIMER ? '' : '[0 s] '; 5625 print $printstring unless $QUIET or $NOTIMER; 5626 my $oldtime = 0; 5627 local $SIG{ALRM} = sub { die 'Timed out' }; 5628 $do_retry = 0; 5629 eval { 5630 if ($timeout) { 5631 alarm $timeout; 5632 } 5633 WAITIN: { 5634 my $lastwait = ''; 5635 if (time - $time != $oldtime) { 5636 $oldtime = time - $time; 5637 if (!$QUIET and !$NOTIMER) { 5638 print "\b" x length($printstring); 5639 $printstring =~ s/\d+/$oldtime/; 5640 print $printstring; 5641 } 5642 } 5643 for my $notice (@{ db_get_notices($dbh) }) { 5644 my ($name) = @$notice; 5645 if ($name eq $done) { 5646 $lastwait = 'DONE!'; 5647 } 5648 elsif ($name eq $killed) { 5649 $lastwait = 'KILLED!'; 5650 $exitstatus = 2; 5651 } 5652 elsif ($name =~ /^bucardo_syncdone_${sync}_(.+)$/) { 5653 my $new = sprintf '%s(%ds) ', $1, ceil(time-$time); 5654 print $new unless $QUIET; 5655 $printstring .= $new; 5656 } 5657 elsif ($name =~ /^bucardo_synckill_${sync}_(.+)$/) { 5658 my $new = sprintf '%s KILLED (%ds) ', $1, ceil(time-$time); 5659 print $new unless $QUIET; 5660 $printstring .= $new; 5661 $exitstatus = 2; 5662 $lastwait = ' '; 5663 } 5664 } 5665 $dbh->rollback(); 5666 if ($lastwait) { 5667 print $lastwait unless $QUIET; 5668 if ($lastwait ne 'DONE!' and $RETRY and ++$retries <= $RETRY) { 5669 print "Retry #$retries\n"; 5670 $do_retry = 1; 5671 die "Forcing eval to exit for retry attempt\n"; 5672 } 5673 last WAITIN; 5674 } 5675 sleep($WAITSLEEP); 5676 redo WAITIN; 5677 5678 } ## end of WAITIN 5679 5680 alarm 0 if $timeout; 5681 }; 5682 5683 alarm 0 if $timeout; 5684 if ($do_retry) { 5685 $do_retry = 0; 5686 redo RETRY; 5687 } 5688 5689 if (2 == $exitstatus) { 5690 my $reason = show_why_sync_killed($sync); 5691 $reason and print "\n$reason\n"; 5692 } 5693 5694 if ($@) { 5695 if ($@ =~ /Timed out/o) { 5696 $exitstatus = 1; 5697 warn "Timed out!\n"; 5698 } 5699 else { 5700 $exitstatus = 3; 5701 warn "Error: $@\n"; 5702 } 5703 next SYNC; 5704 } 5705 next SYNC if $QUIET; 5706 5707 print "\n"; 5708 5709 } ## end each sync 5710 5711 } ## end RETRY 5712 5713 exit $exitstatus; 5714 5715} ## end of kick 5716 5717 5718sub pause_resume { 5719 5720 ## Pause or resume one or more syncs 5721 ## Arguments: none, parses nouns 5722 ## Returns: never, exits 5723 5724 my $doc_section = 'pause'; 5725 usage_exit($doc_section) unless @nouns; 5726 5727 my $action = shift; 5728 5729 my @syncs_signalled; 5730 for my $sync (@syncs) { 5731 5732 ## Syncs can only be paused/resumed if they are active 5733 my $status = $SYNC->{$sync}{status}; 5734 if ($status ne 'active') { 5735 print qq{Cannot pause or resume sync "$sync" unless it is active (currently "$status")\n}; 5736 } 5737 else { 5738 $dbh->do(qq{NOTIFY "bucardo_${action}_sync_$sync"}); 5739 push @syncs_signalled => $sync; 5740 } 5741 } 5742 5743 $dbh->commit(); 5744 5745 my $list = join ',' => @syncs_signalled; 5746 $QUIET or print qq{Syncs ${action}d: $list\n}; 5747 5748 exit 0; 5749 5750} ## end of pause_resume 5751 5752 5753sub show_why_sync_killed { 5754 5755 ## If a kick results in a "KILLED!" try and show why 5756 ## Arguments: one 5757 ## 1. Sync object 5758 ## Returns: message string 5759 5760 my $sync = shift; 5761 5762 $SQL = q{ 5763SELECT * FROM bucardo.syncrun 5764WHERE sync = ? 5765AND lastbad 5766ORDER BY started DESC LIMIT 1 5767}; 5768 $sth = $dbh->prepare($SQL); 5769 $count = $sth->execute($sync); 5770 if ($count != 1) { 5771 $sth->finish(); 5772 return ''; 5773 } 5774 5775 my $result = $sth->fetchall_arrayref({})->[0]; 5776 my $whydie = $result->{status} || ''; 5777 $whydie =~ s/\\n */\n /g; 5778 $whydie =~ s/: ERROR:/:\n ERROR:/; 5779 $whydie =~ s/ (at .+ line \d+\.)/\n $1/g; 5780 $whydie =~ s/\t/<tab>/g; 5781 my $message = sprintf " Started: %s\n Ended: %s\n %s", 5782 $result->{started} || '?', 5783 $result->{ended} || '?', 5784 $whydie; 5785 5786 return $message; 5787 5788} ## end of show_why_sync_killed 5789 5790 5791sub status_all { 5792 5793 ## Show status of all syncs in the database 5794 ## Arguments: none 5795 ## Returns: never, exits 5796 5797 ## See if the MCP is running and what its PID is 5798 if (! -e $PIDFILE) { 5799 #print " (Bucardo does not appear to be currently running)\n"; 5800 } 5801 else { 5802 my $fh; 5803 if (!open $fh, '<', $PIDFILE) { 5804 print "\nERROR: Could not open $PIDFILE: $!"; 5805 } 5806 else { 5807 my $pid = <$fh>; 5808 chomp $pid; 5809 close $fh or warn qq{Could not close $PIDFILE: $!\n}; 5810 if ($pid =~ /^\d+$/) { 5811 print "PID of Bucardo MCP: $pid"; 5812 } 5813 else { 5814 print "\nERROR: $PIDFILE contained: $pid"; 5815 } 5816 } 5817 } 5818 print "\n"; 5819 5820 if (! keys %$SYNC) { 5821 print "No syncs have been created yet.\n"; 5822 exit 0; 5823 } 5824 5825 my $orderby = $bcargs->{sort} || '1'; 5826 if ($orderby !~ /^\+?\-?\d$/) { 5827 die "Invalid sort option, must be +- 1 through 9\n"; 5828 } 5829 5830 ## Set the status for each sync if possible 5831 my $max = set_sync_status(); 5832 5833 ## The titles 5834 my %title = ( 5835 name => ' Name', 5836 state => ' State', 5837 lastgood => ' Last good', 5838 timegood => ' Time', 5839 dit => ($max->{truncate} ? 5840 $max->{conflicts} ? ' Last I/D/T/C' : ' Last I/D/T' : 5841 $max->{conflicts} ? ' Last I/D/C' :' Last I/D'), 5842 lastbad => ' Last bad', 5843 timebad => ' Time', 5844 ); 5845 5846 ## Set the maximum as needed based on the titles 5847 for my $name (keys %title) { 5848 if (! exists $max->{$name} 5849 or length($title{$name}) > $max->{$name}) { 5850 $max->{$name} = length $title{$name}; 5851 } 5852 } 5853 5854 ## Account for our extra spacing by bumping everything up 5855 for my $var (values %$max) { 5856 $var += 2; 5857 } 5858 5859 ## Print the column headers 5860 printf qq{%-*s %-*s %-*s %-*s %-*s %-*s %-*s\n}, 5861 $max->{name}, $title{name}, 5862 $max->{state}, $title{state}, 5863 $max->{lastgood}, $title{lastgood}, 5864 $max->{timegood}, $title{timegood}, 5865 $max->{dit}, $title{dit}, 5866 $max->{lastbad}, $title{lastbad}, 5867 $max->{timebad}, $title{timebad}; 5868 5869 ## Print a fancy dividing line 5870 printf qq{%s+%s+%s+%s+%s+%s+%s\n}, 5871 '=' x $max->{name}, 5872 '=' x $max->{state}, 5873 '=' x $max->{lastgood}, 5874 '=' x $max->{timegood}, 5875 '=' x $max->{dit}, 5876 '=' x $max->{lastbad}, 5877 '=' x $max->{timebad}; 5878 5879 ## If fancy sorting desired, call the list ourself to sort 5880 sub sortme { 5881 my $sortcol = $bcargs->{sort} || 1; 5882 5883 +1 == $sortcol and return $a cmp $b; 5884 -1 == $sortcol and return $b cmp $a; 5885 5886 my ($uno,$dos) = ($SYNC->{$a}, $SYNC->{$b}); 5887 5888 ## State 5889 +3 == $sortcol and return ($uno->{state} cmp $dos->{state} or $a cmp $b); 5890 -3 == $sortcol and return ($dos->{state} cmp $uno->{state} or $a cmp $b); 5891 5892 ## Last good 5893 +5 == $sortcol and return ($uno->{lastgoodsecs} <=> $dos->{lastgoodsecs} or $a cmp $b); 5894 -5 == $sortcol and return ($dos->{lastgoodsecs} <=> $uno->{lastgoodsecs} or $a cmp $b); 5895 5896 ## Good time 5897 +6 == $sortcol and return ($uno->{lastgoodtime} <=> $dos->{lastgoodtime} or $a cmp $b); 5898 -6 == $sortcol and return ($dos->{lastgoodtime} <=> $uno->{lastgoodtime} or $a cmp $b); 5899 5900 if ($sortcol == 7 or $sortcol == -7) { 5901 my ($total1,$total2) = (0,0); 5902 while ($uno->{dit} =~ /(\d+)/go) { 5903 $total1 += $1; 5904 } 5905 while ($dos->{dit} =~ /(\d+)/go) { 5906 $total2 += $1; 5907 } 5908 5909 7 == $sortcol and return ($total1 <=> $total2 or $a cmp $b); 5910 5911 return ($total2 <=> $total1 or $a cmp $b); 5912 } 5913 5914 ## Last bad 5915 +8 == $sortcol and return ($uno->{lastbadsecs} <=> $dos->{lastbadsecs} or $a cmp $b); 5916 -8 == $sortcol and return ($dos->{lastbadsecs} <=> $uno->{lastbadsecs} or $a cmp $b); 5917 5918 ## Bad time 5919 +9 == $sortcol and return ($uno->{lastbadtime} <=> $dos->{lastbadtime} or $a cmp $b); 5920 -9 == $sortcol and return ($dos->{lastbadtime} <=> $uno->{lastbadtime} or $a cmp $b); 5921 5922 5923 return $a cmp $b; 5924 5925 } 5926 5927 for my $sync (sort sortme keys %$SYNC) { 5928 5929 my $s = $SYNC->{$sync}; 5930 5931 ## If this has been filtered out, skip it entirely 5932 next if $s->{filtered}; 5933 5934 ## Populate any missing fields with an empty string 5935 for my $name (keys %title) { 5936 if (! exists $s->{$name}) { 5937 $s->{$name} = ''; 5938 } 5939 } 5940 5941 my $X = '|'; 5942 printf qq{%-*s$X%-*s$X%-*s$X%-*s$X%-*s$X%-*s$X%-*s\n}, 5943 $max->{name}," $sync ", 5944 $max->{state}, " $s->{state} ", 5945 $max->{lastgood}, " $s->{lastgood} ", 5946 $max->{timegood}, " $s->{timegood} ", 5947 $max->{dit}, " $s->{dit} ", 5948 $max->{lastbad}, " $s->{lastbad} ", 5949 $max->{timebad}, " $s->{timebad} "; 5950 } 5951 5952 exit 0; 5953 5954} ## end of status_all 5955 5956 5957sub status_detail { 5958 5959 ## Show detailed information about one or more syncs 5960 ## Arguments: none, parses nouns 5961 ## Returns: never, exits 5962 5963 ## Walk through and check each given sync 5964 ## It must either exist, or be a special key word 5965 5966 my @synclist; 5967 for my $sync (@nouns) { 5968 5969 ## Allow a special noise word: 'sync' 5970 next if $sync eq 'sync'; 5971 5972 ## Add everything if we find the special word 'all' 5973 if ($sync eq 'all') { 5974 undef @synclist; 5975 for my $sync (keys %$SYNC) { 5976 ## Turn off the filtering that set_sync_status may have added 5977 $SYNC->{$sync}{filtered} = 0; 5978 push @synclist => $sync; 5979 } 5980 last; 5981 } 5982 5983 ## If we don't know about this particular sync, give a warning 5984 ## We allow another special word: 'all' 5985 if (!exists $SYNC->{$sync}) { 5986 ## If a number, skip for ease of "kick name #" toggling 5987 $sync !~ /^\d+$/ and die "No such sync: $sync\n"; 5988 } 5989 else { 5990 push @synclist => $sync; 5991 } 5992 } 5993 5994 5995 ## Verify that all named syncs exist 5996 my $max = set_sync_status({syncs => \@synclist}); 5997 5998 ## Present each in the order they gave 5999 my $loops = 0; 6000 for my $sync (@synclist) { 6001 6002 my $s = $SYNC->{$sync}; 6003 6004 ## Skip if it has been filtered out 6005 next if $s->{filtered}; 6006 6007 ## Put a space between multiple entries 6008 if ($loops++) { 6009 print "\n"; 6010 } 6011 6012 print '=' x 70; print "\n"; 6013 6014 my @items; 6015 my $numtables = keys %{$s->{herd}{goat}}; 6016 6017 my $sourcedb = $s->{herd}{db}; 6018 6019 ## Last good time, and number of rows affected 6020 if (exists $s->{rowgood}) { 6021 my $tt = pretty_time($s->{rowgood}{total_time}); 6022 push @items => ['Last good', "$s->{rowgood}{started_time} (time to run: $tt)"]; 6023 6024 ## Space out the numbers 6025 $s->{dit} =~ s{/}{ / }g; 6026 ## Pretty comma formatting (based on ENV) 6027 $s->{dit} =~ s/(\d+)/pretty_number($1)/ge; 6028 6029 ## Change the title if we have any truncates 6030 my $extra = $max->{truncates} ? '/truncates' : ''; 6031 6032 ## Change the title if we have any conflicts 6033 $extra .= $max->{conflicts} ? '/conflicts' : ''; 6034 6035 push @items => ["Rows deleted/inserted$extra", $s->{dit}]; 6036 } 6037 6038 ## Last bad time, and the exact error 6039 ## The error should always be last, so we defer adding it to the queue 6040 my $lasterror = ''; 6041 if (exists $s->{rowbad}) { 6042 my $tt = pretty_time($s->{rowbad}{total_time}); 6043 push @items => ['Last bad', "$s->{rowbad}{started_time} (time until fail: $tt)"]; 6044 6045 ## Grab the error message, and strip out trailing whitespace 6046 ($lasterror = $s->{rowbad}{status}) =~ s/\s+$//; 6047 ## Add any newlines back in 6048 $lasterror =~ s/\\n/\n/g; 6049 ## Remove starting whitespace 6050 $lasterror =~ s/^\s+//; 6051 } 6052 6053 ## Undefined should be written as 'none' 6054 for (qw/checktime/) { 6055 $s->{$_} ||= 'None'; 6056 } 6057 6058 ## Should be 'yes' or 'no' 6059 for (qw/analyze_after_copy vacuum_after_copy stayalive kidsalive autokick/) { 6060 $s->{$_} = (defined $s->{$_} and $s->{$_}) ? 'Yes' : 'No'; 6061 } 6062 6063 ## If currently running, there should be a PID file 6064 if (exists $s->{PIDFILE}) { 6065 push @items => ['PID file' => $s->{PIDFILE}]; 6066 push @items => ['PID file created' => $s->{CREATED}]; 6067 } 6068 6069 ## Build the display list 6070 push @items => ['Sync name' => $sync]; 6071 push @items => ['Current state' => $s->{state}]; 6072 push @items => ['Source relgroup/database' => "$s->{herd}{name} / $sourcedb"]; 6073 push @items => ['Tables in sync' => $numtables]; 6074 push @items => ['Status' => ucfirst $s->{status}]; 6075 push @items => ['Check time' => $s->{checktime}]; 6076 push @items => ['Overdue time' => $s->{overdue}]; 6077 push @items => ['Expired time' => $s->{expired}]; 6078 push @items => ['Stayalive/Kidsalive' => "$s->{stayalive} / $s->{kidsalive}"]; 6079 push @items => ['Rebuild index' => $s->{rebuild_index} ? 'Yes' : 'No']; 6080 push @items => ['Autokick' => $s->{autokick}]; 6081 push @items => ['Onetimecopy' => $s->{onetimecopy} ? 'Yes' : 'No']; 6082 6083 ## Only show these if enabled 6084 if ($s->{analyze_after_copy} eq 'Yes') { 6085 push @items => ['Post-copy analyze', 'Yes']; 6086 } 6087 if ($s->{vacuum_after_copy} eq 'Yes') { 6088 push @items => ['Post-copy vacuum', 'Yes']; 6089 } 6090 6091 ## Final items: 6092 push @items => ['Last error:' => $lasterror]; 6093 6094 ## Figure out the maximum size of the left-hand items 6095 my $leftmax = 0; 6096 for (@items) { 6097 $leftmax = length $_->[0] if length $_->[0] > $leftmax; 6098 } 6099 6100 ## Print it all out 6101 for (@items) { 6102 printf "%-*s : %s\n", 6103 $leftmax, $_->[0], $_->[1]; 6104 } 6105 print '=' x 70; print "\n"; 6106 6107 6108 } 6109 exit 0; 6110 6111} ## end of status_detail 6112 6113 6114 6115 6116sub append_reason_file { 6117 6118 ## Add an entry to the 'reason' log file 6119 ## Arguments: one 6120 ## 1. Message to store 6121 ## Returns: undef 6122 6123 my $event = shift or die; 6124 6125 my $string = sprintf "%s | %-5s | %s\n", (scalar localtime), $event, $nouns; 6126 6127 open my $fh, '>', $REASONFILE or die qq{Could not open "$REASONFILE": $!\n}; 6128 print {$fh} $string; 6129 close $fh or warn qq{Could not close $REASONFILE: $!\n}; 6130 open $fh, '>>', $REASONFILE_LOG or die qq{Could not open "$REASONFILE_LOG": $!\n}; 6131 print {$fh} $string; 6132 close $fh or warn qq{Could not close $REASONFILE_LOG: $!\n}; 6133 6134 return; 6135 6136} ## end of append_reason_file 6137 6138 6139 6140 6141sub set_sync_status { 6142 6143 ## Set detailed information about syncs from the syncrun table 6144 ## Arguments: zero or one (hashref) 6145 ## 1. Hashref containing a. syncs=arrarref of syncnames 6146 ## Returns: hashref indicating maximum lengths of inner information 6147 ## If a sync is filtered out via the 'syncs' argument, it is set to $s->{filtered} = 1 6148 6149 my $arg = shift || {}; 6150 6151 ## View the details of the syncs via the syncrun table 6152 6153 $SQL = qq{ 6154SELECT *, 6155TO_CHAR(started,'$DATEFORMAT') AS started_time, 6156CASE WHEN current_date = ended::date 6157 THEN TO_CHAR(ended,'$SHORTDATEFORMAT') 6158 ELSE TO_CHAR(ended,'$DATEFORMAT') END AS ended_time, 6159ROUND(EXTRACT(epoch FROM ended)) AS ended_epoch, 6160EXTRACT(epoch FROM ended-started) AS total_time, 6161ROUND(EXTRACT(epoch FROM now()-started)) AS total_time_started, 6162ROUND(EXTRACT(epoch FROM now()-ended)) AS total_time_ended 6163FROM syncrun 6164WHERE sync = ? 6165AND ( lastgood IS TRUE 6166 OR lastbad IS TRUE 6167 OR lastempty IS TRUE 6168 OR ended IS NULL) 6169}; 6170 $sth = $dbh->prepare($SQL); 6171 6172 ## Find the maximum lengths of items so we can line things up pretty 6173 my %max = ( 6174 name => 1, 6175 state => 1, 6176 dit => 1, 6177 lastgood => 1, 6178 timegood => 1, 6179 lastbad => 1, 6180 timebad => 1, 6181 ); 6182 6183 for my $sync (keys %$SYNC) { 6184 6185 my $s = $SYNC->{$sync}; 6186 6187 ## Sometimes we only want some of them 6188 if ($arg->{syncs}) { 6189 if (! grep { $_ eq $sync } @{$arg->{syncs}}) { ## no critic (ProhibitBooleanGrep) 6190 $s->{filtered} = 1; 6191 next; 6192 } 6193 } 6194 6195 $max{name} = length($sync) if length($sync) > $max{name}; 6196 6197 $count = $sth->execute($sync); 6198 if ($count < 1) { 6199 $sth->finish; 6200 $s->{state} = 'No records found'; 6201 $max{state} = length($s->{state}) if length($s->{state}) > $max{state}; 6202 next; 6203 } 6204 for my $row (@{ $sth->fetchall_arrayref({}) }) { 6205 if ($row->{lastgood}) { 6206 $s->{rowgood} = $row; 6207 } 6208 elsif ($row->{lastempty}) { 6209 $s->{rowempty} = $row; 6210 } 6211 elsif ($row->{lastbad}) { 6212 $s->{rowbad} = $row; 6213 } 6214 else { 6215 $s->{runningrow} = $row; 6216 } 6217 } 6218 6219 ## What is the state of this sync? First, is it still actively running? 6220 if (exists $s->{runningrow}) { 6221 $s->{state} = "$s->{runningrow}{status}"; 6222 } 6223 else { 6224 ## What was the most recent run? 6225 my $highepoch = 0; 6226 undef $s->{latestrow}; 6227 my $wintype; 6228 for my $type (qw/ bad good empty /) { 6229 my $r = $s->{"row$type"}; 6230 next if ! defined $r; 6231 my $etime = $r->{ended_epoch}; 6232 if ($etime >= $highepoch) { 6233 $s->{latestrow} = $r; 6234 $highepoch = $etime; 6235 $wintype = $type; 6236 } 6237 } 6238 if (! defined $s->{latestrow}) { 6239 $s->{state} = 'Unknown'; 6240 $max{state} = length($s->{state}) if length($s->{state}) > $max{state}; 6241 next; 6242 } 6243 if ($wintype eq 'empty') { 6244 # Empty is good, as far as status is concerned. 6245 $s->{rowgood} = $s->{latestrow}; 6246 $wintype = 'good'; 6247 } 6248 $s->{state} = ucfirst $wintype; 6249 } 6250 6251 ## deletes/inserts/truncates/conflicts 6252 $s->{dit} = ''; 6253 if (exists $s->{rowgood}) { 6254 $s->{dit} = "$s->{rowgood}{deletes}/$s->{rowgood}{inserts}"; 6255 if ($s->{rowgood}{truncates}) { 6256 $max{truncates} = 1; 6257 $s->{dit} .= "/$s->{rowgood}{truncates}"; 6258 } 6259 if ($s->{rowgood}{conflicts}) { 6260 $max{conflicts} = 1; 6261 $s->{dit} .= "/$s->{rowgood}{conflicts}"; 6262 } 6263 } 6264 $s->{lastgood} = exists $s->{rowgood} ? $s->{rowgood}{ended_time} : 'none'; 6265 $s->{timegood} = exists $s->{rowgood} ? pretty_time($s->{rowgood}{total_time_ended}) : ''; 6266 $s->{lastbad} = exists $s->{rowbad} ? $s->{rowbad}{ended_time} : 'none'; 6267 $s->{timebad} = exists $s->{rowbad} ? pretty_time($s->{rowbad}{total_time_ended}) : ''; 6268 6269 for my $var (qw/ state dit lastgood timegood lastbad timebad /) { 6270 $max{$var} = length($s->{$var}) if length($s->{$var}) > $max{$var}; 6271 } 6272 } 6273 6274 return \%max; 6275 6276} ## end of set_sync_status 6277 6278 6279sub inspect { 6280 6281 ## Inspect an item in the database 6282 ## Arguments: none, parses nouns 6283 ## Returns: never, exits 6284 6285 my $doc_section = 'inspect'; 6286 usage_exit($doc_section) unless @nouns; 6287 my $thing = shift @nouns; 6288 6289 inspect_table() if $thing =~ /tab/i or $thing eq 't'; 6290 inspect_sync() if $thing =~ /sync/i or $thing eq 's'; 6291 inspect_herd() if $thing =~ /(?:relgr|herd)/i or $thing eq 'h'; 6292 6293 usage_exit($doc_section); 6294 6295 return; 6296 6297} ## end of inspect 6298 6299 6300sub inspect_table { 6301 6302 ## Inspect an item from the goat table 6303 ## Arguments: none, parses nouns 6304 ## Returns: never, exits 6305 6306 my $doc_section = 'inspect'; 6307 usage_exit($doc_section) unless @nouns; 6308 6309 $SQL = q{SELECT * FROM bucardo.goat WHERE tablename=?}; 6310 my $sth_goat = $dbh->prepare($SQL); 6311 $SQL = q{SELECT * FROM bucardo.goat WHERE schemaname = ? AND tablename=?}; 6312 my $sth_goat_schema = $dbh->prepare($SQL); 6313 my @tables; 6314 for my $name (@nouns) { 6315 my $sthg; 6316 if ($name =~ /(.+)\.(.+)/) { 6317 $sthg = $sth_goat_schema; 6318 $count = $sthg->execute($1,$2); 6319 } 6320 else { 6321 $sthg = $sth_goat; 6322 $count = $sthg->execute($name); 6323 } 6324 if ($count < 1) { 6325 die "Unknown table: $name\n"; 6326 } 6327 6328 for my $row (@{$sthg->fetchall_arrayref({})}) { 6329 push @tables, $row; 6330 } 6331 6332 } 6333 6334 for my $t (@tables) { 6335 my ($s,$t,$db,$id) = @$t{qw/schemaname tablename db id/}; 6336 print "Inspecting $s.$t on $db\n"; 6337 ## Grab all other tables referenced by this one 6338 my $tablist = get_reffed_tables($s,$t,$db); 6339 6340 ## Check that each referenced table is in a herd with this table 6341 6342 my %seenit; 6343 for my $tab (@$tablist) { 6344 my ($type,$tab1,$tab2,$name,$def) = @$tab; 6345 my $table = $type==1 ? $tab1 : $tab2; 6346 if ($table !~ /(.+)\.(.+)/) { 6347 die "Invalid table information\n"; 6348 } 6349 my $schema = $1; 6350 $table = $2; 6351 next if $seenit{"$schema.$table.$type"}++; 6352 6353 ## Make sure that each herd with this table also has this new table 6354 my $ggoat = $global{goat}; 6355 my $hherd = $global{herd}; 6356 for my $herd (sort keys %{$ggoat->{by_id}{$id}{herd}}) { 6357 $seenit{fktable} = 1; 6358 next if exists $hherd->{$herd}{hasgoat}{$schema}{$table}; 6359 printf "Table %s.%s is in relgroup %s, but %s.%s (used as FK%s) is not\n", 6360 $s, $t, $herd, $schema, $table, 6361 $type == 1 ? '' : ' target'; 6362 6363 } 6364 if (! exists $seenit{fktable}) { 6365 printf "Table %s.%s is used as FK%s by %s.%s\n", 6366 $s,$t,$type==1 ? '' : ' target', $schema, $table; 6367 delete $seenit{fktable}; 6368 } 6369 } 6370 } 6371 6372 exit 0; 6373 6374} ## end of inspect_table 6375 6376 6377sub inspect_herd { 6378 6379 ## Inspect an item from the herd table 6380 ## Arguments: none, parses nouns 6381 ## Returns: never, exits 6382 6383 my $doc_section = 'inspect'; 6384 usage_exit($doc_section) unless @nouns; 6385 6386 die "Not implemented yet\n"; 6387 6388} ## end of inspect_herd 6389 6390 6391sub inspect_sync { 6392 6393 ## Inspect an item from the sync table 6394 ## Arguments: none, parses nouns 6395 ## Returns: never, exits 6396 6397 my $doc_section = 'inspect'; 6398 usage_exit($doc_section) unless @nouns; 6399 6400 die "Not implemented yet\n"; 6401 6402} ## end of inspect_sync 6403 6404 6405sub get_reffed_tables { 6406 6407 ## Find all tables that are references by the given one 6408 ## Arguments: three 6409 ## 1. Schema name 6410 ## 2. Table name 6411 ## 3. Database name 6412 ## Returns: arrayref of tables from the database 6413 6414 my ($s,$t,$db) = @_; 6415 6416 my $rdbh = connect_database({name => $db}); 6417 6418 ## So we get the schemas 6419 $rdbh->do('SET search_path = pg_catalog'); 6420 6421 $SQL= q{ 6422SELECT CASE WHEN conrelid=x.toid THEN 1 ELSE 2 END, 6423 confrelid::regclass, 6424 conrelid::regclass, 6425 conname, 6426 pg_get_constraintdef(oid, true) 6427FROM pg_constraint, 6428(SELECT c.oid AS toid FROM pg_class c JOIN pg_namespace n 6429 ON (n.oid=c.relnamespace) WHERE nspname=? AND relname=? 6430) x 6431WHERE contype = 'f' AND 6432(confrelid = x.toid OR conrelid = x.toid) 6433}; 6434 6435 $sth = $rdbh->prepare($SQL); 6436 $count = $sth->execute($s,$t); 6437 return $sth->fetchall_arrayref(); 6438 6439} ## end of get_reffed_tables 6440 6441 6442 6443 6444sub show_all_columns { 6445 6446 ## Give a detailed listing of a particular row in the bucardo database 6447 ## Arguments: one 6448 ## 1. Hashref of information to display 6449 ## Returns: formatted, sorted, and indented list as a single string 6450 6451 my $row = shift or die; 6452 6453 my $maxkey = 1; 6454 for my $key (keys %$row) { 6455 next if ref $row->{$key}; 6456 $maxkey = length $key if length $key > $maxkey; 6457 } 6458 for my $key (sort { 6459 ($a eq 'src_code' and $b ne 'src_code' ? 1 : 0) 6460 or 6461 ($a ne 'src_code' and $b eq 'src_code' ? -1 : 0) 6462 or 6463 $a cmp $b } keys %$row 6464 ) { 6465 next if ref $row->{$key}; 6466 printf " %-*s = %s\n", $maxkey, $key, 6467 defined $row->{$key} ? $row->{$key} : 'NULL'; 6468 } 6469 6470 return; 6471 6472} ## end of show_all_columns 6473 6474 6475sub process_args { 6476 6477 ## Break apart a string of args, return a clean hashref 6478 ## Arguments: one 6479 ## 1. List of arguments 6480 ## Returns: hashref 6481 6482 my $string = shift or return {}; 6483 $string .= ' '; 6484 6485 my %arg; 6486 6487 while ($string =~ m/(\w+)\s*[=:]\s*"(.+?)" /g) { 6488 $arg{lc $1} = $2; 6489 } 6490 $string =~ s/\w+\s*=\s*".+?" / /g; 6491 6492 while ($string =~ m/(\w+)\s*[=:]\s*'(.+?)' /g) { 6493 $arg{lc $1} = $2; 6494 } 6495 $string =~ s/\w+\s*=\s*'.+?' / /g; 6496 6497 while ($string =~ m/(\w+)\s*[=:]\s*(\S+)/g) { 6498 $arg{lc $1} = $2; 6499 } 6500 $string =~ s/\w+\s*=\s*\S+/ /g; 6501 6502 if ($string =~ /\S/) { 6503 $string =~ s/^\s+//; 6504 $arg{extraargs} = [split /\s+/ => $string]; 6505 } 6506 6507 ## Clean up and standardize the names 6508 if (exists $arg{type}) { 6509 $arg{type} = standardize_rdbms_name($arg{type}); 6510 } 6511 6512 return \%arg; 6513 6514} ## end of process_args 6515 6516 6517sub list_clones { 6518 6519 ## Show information about clones. Queries the bucardo.clone table 6520 ## Arguments: zero or more 6521 ## 1+ Clone id to view. 6522 ## Returns: 0 on success, -1 on error 6523 ## Example: bucardo list clones 6524 6525 ## Might be no clones yet 6526 if (! keys %$CLONE) { 6527 print "No clones have been created yet\n"; 6528 return -1; 6529 } 6530 6531 ## Keep track of specific requests 6532 my $cloneids; 6533 6534 for my $term (@nouns) { 6535 6536 if ($term =~ /^(\d+)$/) { 6537 my $id = $1; 6538 if (! exists $CLONE->{$id}) { 6539 die qq{No such clone id "$id": try bucardo list clones\n}; 6540 } 6541 $cloneids->{$id}++; 6542 } 6543 6544 } ## end each term 6545 6546 ## Print them out in numeric order 6547 for my $clone (sort { $a->{id} <=> $b->{id} } values %$CLONE) { 6548 ## TODO: right justify numbers 6549 next if keys %$cloneids and ! exists $cloneids->{$clone->{id}}; 6550 print "Clone #$clone->{id}"; 6551 print " Status: $clone->{status}"; 6552 defined $clone->{sync} and print " Sync: $clone->{sync}"; 6553 defined $clone->{dbgroup} and print " Dbgroup: $clone->{dbgroup}"; 6554 defined $clone->{relgroup} and print " Relgroup: $clone->{relgroup}"; 6555 defined $clone->{started} and print " Started: $clone->{pstarted}"; 6556 defined $clone->{ended} and print " Ended: $clone->{pstarted}"; 6557 if (defined $clone->{options}) { 6558 print " $clone->{options}"; 6559 } 6560 ## Print last, on a new line: 6561 defined $clone->{summary} and print "\n Summary: $clone->{summary}"; 6562 print "\n"; 6563 } 6564 6565 return 0; 6566 6567} ## end of list_clones 6568 6569 6570sub list_customcodes { 6571 6572 ## Show information about all or some subset of the 'customcode' table 6573 ## Arguments: none, parses nouns for customcodes 6574 ## Returns: 0 on success, -1 on error 6575 6576 my $doc_section = 'list'; 6577 6578 ## Any nouns are filters against the whole list 6579 my $clause = generate_clause({col => 'name', items => \@nouns}); 6580 my $WHERE = $clause ? "WHERE $clause" : ''; 6581 $SQL = "SELECT * FROM bucardo.customcode $WHERE ORDER BY name"; 6582 $sth = $dbh->prepare($SQL); 6583 $count = $sth->execute(); 6584 if ($count < 1) { 6585 $sth->finish(); 6586 printf "There are no%s entries in the 'customcode' table.\n", 6587 $WHERE ? ' matching' : ''; 6588 return -1; 6589 } 6590 6591 $info = $sth->fetchall_arrayref({}); 6592 6593 my ($maxname,$maxwhen) = (1,1); 6594 for my $row (@$info) { 6595 $maxname = length $row->{name} if length $row->{name} > $maxname; 6596 $maxwhen = length $row->{whenrun} if length $row->{whenrun} > $maxwhen; 6597 } 6598 6599 for my $row (@$info) { 6600 my $name = $row->{name}; 6601 6602 ## We never show the actual source code unless verbosity is at least three! 6603 if ($VERBOSE < 3) { 6604 $row->{src_code} = 'Use -vvv to see the actual source code'; 6605 } 6606 6607 ## We want to show all associates syncs and relations (when mapping is active) 6608 my $info2 = $CUSTOMCODE->{$name} || {}; 6609 6610 my ($synclist, $relationlist) = ('',''); 6611 if (exists $info2->{map}) { 6612 $synclist = join ',' => sort map { $_->{sync} } 6613 grep { defined $_->{sync} and $_->{active} } 6614 @{ $info2->{map} }; 6615 $relationlist = join ',' => sort 6616 map { "$GOAT->{by_id}{$_->{goat}}{schemaname}.$GOAT->{by_id}{$_->{goat}}{tablename}" } 6617 grep { defined $_->{goat} and $_->{active} } 6618 @{ $info2->{map} }; 6619 } 6620 6621 printf "Code: %-*s When run: %-*s Get dbh: %s Status: %s\n", 6622 $maxname, $name, 6623 $maxwhen, $row->{whenrun}, 6624 $row->{getdbh}, 6625 $row->{status}; 6626 if (length $synclist) { 6627 print " Syncs: $synclist\n"; 6628 } 6629 if (length $relationlist) { 6630 print " Relations: $relationlist\n"; 6631 } 6632 if (defined $row->{about} and $VERBOSE) { 6633 (my $about = $row->{about}) =~ s/(.)^/$1 /gsm; 6634 print " About: $about\n"; 6635 } 6636 $VERBOSE >= 2 and show_all_columns($row); 6637 } 6638 6639 return 0; 6640 6641} ## end of list_customcodes 6642 6643 6644sub update_customcode { 6645 6646 ## Update one or more customcodes 6647 ## Arguments: none (reads nouns for a list of customcodes) 6648 ## Returns: never, exits 6649 6650 my @actions = @_; 6651 6652 my $doc_section = 'update/update customcode'; 6653 usage_exit($doc_section) unless @actions; 6654 6655 my $name = shift @actions; 6656 6657 ## Recursively call ourselves for wildcards and 'all' 6658 exit 0 if ! check_recurse($SYNC, $name, @actions); 6659 6660 ## Make sure this customcode exists! 6661 if (! exists $CUSTOMCODE->{$name}) { 6662 die qq{Could not find a customcode named "$name"\nUse 'list customcodes' to see all available.\n}; 6663 } 6664 6665 my $cc = $CUSTOMCODE->{$name}; 6666 6667 my $changes = 0; 6668 6669 for my $action (@actions) { 6670 ## Look for a standard foo=bar or foo:bar format 6671 if ($action =~ /(.+?)\s*[=:]\s*(.+)/) { 6672 my ($setting,$value) = (lc $1,$2); 6673 6674 ## No funny characters please, just boring column names 6675 $setting =~ /^[a-z_]+$/ or die "Invalid setting: $setting\n"; 6676 6677 my $srcfile; 6678 6679 ## We only allow changing a strict subset of all the columns 6680 if ($setting =~ /^(?:about|getdbh|name|priority|status|whenrun|src_code)$/) { 6681 my $oldvalue = defined $cc->{$setting} ? $cc->{$setting} : ''; 6682 ## Allow some variation for booleans, but transform to 0/1 6683 if ($setting =~ /^(?:getdbh)$/) { 6684 $value = $value =~ /^[1tTyY]/ ? 1 : 0; 6685 } 6686 ## Some things can only be numbers 6687 elsif ($setting =~ /^(?:priority)$/) { 6688 if ($value !~ /^\d+$/) { 6689 die qq{Customcode setting "$setting" must be a number!\n}; 6690 } 6691 } 6692 ## And some are very specific indeed 6693 elsif ('whenrun' eq $setting) { 6694 my %whenrun = map { $_ => 1 } _whenrun_values(); 6695 die qq{Invalid value for setting "whenrun"\n} 6696 unless $whenrun{$value}; 6697 } 6698 elsif ('src_code' eq $setting) { 6699 $srcfile = $value; 6700 if (! -e $srcfile) { 6701 warn qq{Could not find a file named "$srcfile"\n}; 6702 exit 2; 6703 } 6704 open my $fh, '<', $srcfile or die qq{Could not open "$srcfile": $!\n}; 6705 $value = ''; 6706 { local $/; $value = <$fh>; } ## no critic (RequireInitializationForLocalVars) 6707 close $fh or warn qq{Could not close "$srcfile": $!\n}; 6708 } 6709 ## Make the change, if it has changed 6710 if ($value ne $oldvalue) { 6711 $SQL = "UPDATE customcode SET $setting=? WHERE name = ?"; 6712 $sth = $dbh->prepare($SQL); 6713 $sth->execute($value, $name); 6714 $changes++; 6715 if ('src_code' eq $setting) { 6716 print qq{Changed customcode "$name" $setting with content of file "$srcfile"\n}; 6717 } 6718 else { 6719 print qq{Changed customcode "$name" $setting from '$oldvalue' to '$value'\n}; 6720 } 6721 } 6722 } 6723 else { 6724 warn "Cannot change attribute '$setting'\n"; 6725 usage_exit($doc_section); 6726 } 6727 6728 next; 6729 } 6730 6731 warn "\nUnknown action: $action\n"; 6732 usage_exit($doc_section); 6733 } 6734 6735 confirm_commit() if $changes; 6736 6737 return; 6738 6739} ## end of update_customcode 6740 6741sub _whenrun_values { 6742 return qw( 6743 before_txn 6744 before_check_rows 6745 before_trigger_drop 6746 after_trigger_drop 6747 after_table_sync 6748 exception 6749 conflict 6750 before_trigger_enable 6751 after_trigger_enable 6752 after_txn 6753 before_sync 6754 after_sync 6755 ); 6756} 6757 6758 6759 6760sub list_sequences { 6761 6762 ## Show information about all or some sequences in the 'goat' table 6763 ## Arguments: none (reads nouns for a list of sequences) 6764 ## Returns: 0 on success, -1 on error 6765 6766 my $doc_section = 'list'; 6767 6768 my $clause = generate_clause({col => 'tablename', items => \@nouns}); 6769 my $WHERE = $clause ? "AND $clause" : ''; 6770 $SQL = "SELECT * FROM bucardo.goat WHERE reltype = 'sequence' $WHERE ORDER BY schemaname, tablename"; 6771 $sth = $dbh->prepare($SQL); 6772 $count = $sth->execute(); 6773 if ($count < 1) { 6774 $sth->finish(); 6775 printf "There are no%s sequences.\n", 6776 $WHERE ? ' matching' : ''; 6777 return -1; 6778 } 6779 6780 $info = $sth->fetchall_arrayref({}); 6781 my $maxq = 1; 6782 for my $row (@$info) { 6783 my $len = length "$row->{schemaname}.$row->{tablename}"; 6784 $maxq = $len if $len > $maxq; 6785 } 6786 6787 for my $row (@$info) { 6788 printf "Sequence: %-*s DB: %s\n", 6789 $maxq, "$row->{schemaname}.$row->{tablename}", 6790 $row->{db}; 6791 $VERBOSE >= 2 and show_all_columns($row); 6792 } 6793 6794 6795 return 0; 6796 6797} ## end of list_sequences 6798 6799 6800sub pretty_time { 6801 6802 ## Change seconds to a prettier display with hours, minutes, etc. 6803 ## Arguments: one 6804 ## 1. Number of seconds 6805 ## Returns: formatted string 6806 6807 my $secs = shift; 6808 6809 ## Round up to the nearest second if decimal places are given 6810 $secs = ceil($secs); 6811 6812 ## If we cannot figure out the seconds, give up and return a question mark 6813 return '?' if ! defined $secs or $secs !~ /^\-?\d+$/o or $secs < 0; 6814 6815 ## Initialize days, hours, minutes, and seconds 6816 my ($D,$H,$M,$S) = (0,0,0,0); 6817 6818 ## Some people do not want days shown, so leave it as an option 6819 if ($bcargs->{showdays}) { 6820 if ($secs > 60*60*24) { 6821 $D = int $secs/(60*60*24); 6822 $secs -= $D*60*60*24; 6823 } 6824 } 6825 6826 ## Show hours if there is > 1 hour 6827 if ($secs > 60*60) { 6828 $H = int $secs/(60*60); 6829 $secs -= $H*60*60; 6830 } 6831 6832 ## Show minutes if there is > 1 minute 6833 if ($secs > 60) { 6834 $M = int $secs/60; 6835 $secs -= $M*60; 6836 } 6837 $secs = int $secs; 6838 my $answer = sprintf "%s%s%s${secs}s",$D ? "${D}d " : '',$H ? "${H}h " : '',$M ? "${M}m " : ''; 6839 6840 ## Detailed listings get compressed 6841 if ((defined $COMPRESS and $COMPRESS) or (!defined $COMPRESS and !@nouns)) { 6842 $answer =~ s/ //g; 6843 } 6844 6845 return $answer; 6846 6847} ## end of pretty_time 6848 6849 6850sub pretty_number { 6851 6852 ## Format a raw number in a more readable style 6853 ## Arguments: one 6854 ## 1. Number 6855 ## Returns: formatted number 6856 6857 my $number = shift; 6858 6859 return $number if $number !~ /^\d+$/ or $number < 1000; 6860 6861 ## If this is our first time here, find the correct separator 6862 if (! defined $bcargs->{tsep}) { 6863 my $lconv = localeconv(); 6864 $bcargs->{tsep} = $lconv->{thousands_sep} || ','; 6865 } 6866 6867 ## No formatting at all 6868 return $number if '' eq $bcargs->{tsep} or ! $bcargs->{tsep}; 6869 6870 (my $reverse = reverse $number) =~ s/(...)(?=\d)/$1$bcargs->{tsep}/g; 6871 $number = reverse $reverse; 6872 return $number; 6873 6874} ## end of pretty_number 6875 6876 6877 6878sub vate_sync { 6879 6880 ## Activate or deactivate a sync 6881 ## Arguments: none (reads verbs and nouns) 6882 ## Returns: never, exits 6883 6884 my $name = lc $verb; 6885 my $ucname = ucfirst $name; 6886 @nouns or die qq{${name}_sync requires at least one sync name\n}; 6887 6888 my $wait = (defined $adverb and $adverb eq '0') ? 1 : 0; 6889 for my $sync (@syncs) { 6890 (my $vname = $ucname) =~ s/e$/ing/; 6891 $QUIET or print qq{$vname sync $sync}; 6892 my $done = "bucardo_${name}d_sync_$sync"; 6893 $dbh->do(qq{NOTIFY "bucardo_${name}_sync_$sync"}); 6894 if ($wait) { 6895 print '...'; 6896 $dbh->do(qq{LISTEN "$done"}); 6897 } 6898 $dbh->commit(); 6899 if (!$wait) { 6900 print "\n"; 6901 next; 6902 } 6903 sleep 0.1; 6904 wait_for_notice($dbh, $done); 6905 print "OK\n"; 6906 } ## end each sync 6907 6908 exit 0; 6909 6910} ## end of vate_sync 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931sub add_customcode { 6932 6933 ## Add an entry to the bucardo.customcode table 6934 ## Arguments: none (uses nouns) 6935 ## Returns: never, exits 6936 6937 my $item_name = shift @nouns || ''; 6938 6939 my $doc_section = 'add/add customcode'; 6940 usage_exit($doc_section) unless length $item_name; 6941 6942 ## Inputs and aliases, database column name, flags, default 6943 my $whenrun = join '|' => _whenrun_values(); 6944 my $validcols = qq{ 6945 name name 0 $item_name 6946 about about 0 null 6947 whenrun|when_run whenrun =$whenrun null 6948 getdbh getdbh TF null 6949 sync sync 0 skip 6950 goat|table|relation goat 0 skip 6951 status status =active|inactive skip 6952 priority priority number skip 6953 src_code src_code 0 skip 6954 }; 6955 6956 my ( $dbcols, $cols, $phs, $vals, $extras ) = process_simple_args({ 6957 cols => $validcols, 6958 list => \@nouns, 6959 doc_section => $doc_section, 6960 }); 6961 6962 my $newname = $dbcols->{name}; 6963 6964 ## Does this already exist? 6965 if (exists $CUSTOMCODE->{$newname}) { 6966 warn qq{Cannot create: customcode "$newname" already exists\n}; 6967 exit 2; 6968 } 6969 6970 ## We must have a "whenrun" 6971 usage_exit($doc_section) unless $dbcols->{whenrun}; 6972 6973 ## We must have a src_code as a file 6974 usage_exit($doc_section) unless $extras->{src_code}; 6975 6976 my $tfile = $extras->{src_code}; 6977 if (! -e $tfile) { 6978 warn qq{Could not find a file named "$tfile"\n}; 6979 exit 2; 6980 } 6981 open my $fh, '<', $tfile or die qq{Could not open "$tfile": $!\n}; 6982 my $src = ''; 6983 { local $/; $src = <$fh>; } ## no critic (RequireInitializationForLocalVars) 6984 close $fh or warn qq{Could not close "$tfile": $!\n}; 6985 6986 ## Attempt to insert this into the database 6987 $SQL = "INSERT INTO bucardo.customcode ($cols,src_code) VALUES ($phs,?)"; 6988 $DEBUG and warn "SQL: $SQL\n"; 6989 $DEBUG and warn Dumper $vals; 6990 $sth = $dbh->prepare($SQL); 6991 eval { 6992 $count = $sth->execute((map { $vals->{$_} } sort keys %$vals), $src); 6993 }; 6994 if ($@) { 6995 die "Failed to add customcode: $@\n"; 6996 } 6997 6998 my $finalmsg = ''; 6999 7000 ## See if any updates to customcode_map need to be made 7001 7002 ## Only one of sync or goat can be specified 7003 if ($extras->{sync} and $extras->{relation}) { 7004 die qq{Sorry, you must specify a sync OR a relation, not both\n}; 7005 } 7006 7007 ## Makes no sense to specify priority or active if no goat or sync 7008 if (($extras->{priority} or $extras->{active}) and !$extras->{sync} and ! $extras->{relation}) { 7009 die qq{You must specify a sync or a relation when using priority or active\n}; 7010 } 7011 7012 ## Is this a valid sync? 7013 if ($extras->{sync} and ! exists $SYNC->{$extras->{sync}}) { 7014 die qq{Unknown sync: $extras->{sync}\n}; 7015 } 7016 7017 ## Is this a valid gaot? 7018 if ($extras->{relation} and ! exists $GOAT->{by_name}{$extras->{relation}} 7019 and ! exists $GOAT->{by_table}{$extras->{relation}} 7020 and ! exists $GOAT->{by_fullname}{$extras->{relation}} ) { 7021 die qq{Unknown relation: $extras->{relation}\n}; 7022 } 7023 7024 ## Add to the customcode_map table 7025 if ($extras->{sync} or $extras->{relation}) { 7026 $SQL = 'INSERT INTO customcode_map(code,'; 7027 my @vals; 7028 for my $col (qw/sync priority active/) { 7029 if ($extras->{$col}) { 7030 $SQL .= "$col,"; 7031 push @vals => $extras->{$col}; 7032 } 7033 } 7034 if ($extras->{relation}) { 7035 $SQL .= 'goat,'; 7036 push @vals => exists $GOAT->{by_name}{$extras->{relation}} 7037 ? $GOAT->{by_name}{$extras->{relation}}->[0]{id} 7038 : exists $GOAT->{by_table}{$extras->{relation}}->[0]{id} 7039 ? $GOAT->{by_table}{$extras->{relation}}->[0]{id} 7040 : $GOAT->{by_fullname}{$extras->{relation}}->[0]{id} 7041 } 7042 my $phs2 = '?,' x @vals; 7043 $SQL .= ") VALUES ((SELECT currval('customcode_id_seq')),$phs2)"; 7044 $SQL =~ s/,\)/)/g; 7045 $sth = $dbh->prepare($SQL); 7046 eval { 7047 $count = $sth->execute(@vals); 7048 }; 7049 if ($@) { 7050 die "Failed to add customcode_map: $@\n"; 7051 } 7052 } 7053 7054 if (!$QUIET) { 7055 print qq{Added customcode "$newname"\n}; 7056 $finalmsg and print $finalmsg; 7057 } 7058 7059 confirm_commit(); 7060 7061 exit 0; 7062 7063} ## end of add_customcode 7064 7065 7066 7067 7068 7069 7070 7071 7072 7073 7074 7075 7076 7077 7078 7079 7080sub _list_databases { 7081 7082 ## Quick list of available databases 7083 ## Arguments: none 7084 ## Returns: list of databases as a single string 7085 7086 return if ! keys %{ $DB }; 7087 warn "The following databases are available:\n"; 7088 for (sort keys %{ $DB }) { 7089 next if $DB->{$_}{dbtype} ne 'postgres'; 7090 print "$_\n"; 7091 } 7092 return; 7093 7094} ## end of _list_databases 7095 7096 7097sub add_all_tables { 7098 7099 ## Add all tables, returns output from add_all_goats 7100 ## Arguments: none 7101 ## Returns: output of inner sub 7102 7103 return add_all_goats('table'); 7104 7105} ## end of add_all_tables 7106 7107 7108sub add_all_sequences { 7109 7110 ## Add all tables, returns output from add_all_goats 7111 ## Arguments: none 7112 ## Returns: output of inner sub 7113 7114 return add_all_goats('sequence'); 7115 7116} ## end of add_all_sequences 7117 7118 7119sub add_all_goats { 7120 7121 ## Add all tables, or sequences 7122 ## Arguments: one 7123 ## 1. The type, table or sequence 7124 ## Returns: Srting indicating what was done 7125 7126 my $type = shift; 7127 7128 ## Usage: add all table(s) | add all sequence(s) 7129 ## Options: 7130 ## --db: use this database (internal name from the db table) 7131 ## --schema or -n: limit to one or more comma-separated schemas 7132 ## --exclude-schema or -N: exclude these schemas 7133 ## --table or -t: limit to the given tables 7134 ## --exclude-table or -T: exclude these tables 7135 ## --relgroup: name of the herd to add new tables to 7136 ## pkonly: exclude tables with no pkey 7137 ## Returns: text string of results, with a newline 7138 7139 ## Transform command-line args to traditional format 7140 ## e.g. db=foo becomes the equivalent of --db=foo 7141 ## foo becomes foo=1 7142 for my $noun (@nouns) { 7143 if ($noun =~ /(\w+)=(\w+)/) { 7144 $bcargs->{$1} = $2; 7145 } 7146 else { 7147 $bcargs->{$noun} = 1; 7148 } 7149 } 7150 7151 $bcargs->{herd} = delete $bcargs->{relgroup} || $bcargs->{herd}; 7152 7153 ## If no databases, cowardly refuse to continue 7154 if (! keys %$DB) { 7155 die "Sorry, cannot add any ${type}s until at least one database has been added\n"; 7156 } 7157 7158 ## If there is more than one database, it should be selected via db= 7159 my $db; 7160 my $showdbs = 0; 7161 if (exists $bcargs->{db}) { 7162 if (! exists $DB->{$bcargs->{db}}) { 7163 warn qq{Sorry, could not find a database named "$bcargs->{db}"\n}; 7164 $showdbs = 1; 7165 } 7166 else { 7167 $db = $DB->{$bcargs->{db}}; 7168 } 7169 } 7170 elsif (keys %$DB == 1) { 7171 ($db) = values %$DB; 7172 } 7173 else { 7174 ## Grab the most likely candidate 7175 my $bestdb = find_best_db_for_searching(); 7176 if (! $bestdb) { 7177 warn "Please specify which database to use with the db=<name> option\n"; 7178 $showdbs = 1; 7179 } 7180 else { 7181 $db = $DB->{$bestdb}; 7182 } 7183 } 7184 7185 if ($showdbs) { 7186 _list_databases(); 7187 exit 1; 7188 } 7189 7190 ## Connect to the remote database 7191 my $dbh2 = connect_database({name => $db->{name}}); 7192 7193 ## Query to pull all tables we may possibly need 7194 my $kind = $type eq 'table' ? 'r' : 'S'; 7195 $SQL = q{SELECT nspname, relname FROM pg_catalog.pg_class c } 7196 . q{JOIN pg_catalog.pg_namespace n ON (n.oid = c.relnamespace) } 7197 . qq{WHERE relkind = '$kind' }; 7198 7199 ## We always exclude information_schema, system, and bucardo schemas 7200 $SQL .= q{AND n.nspname <> 'information_schema' AND nspname !~ '^pg' AND nspname !~ '^bucardo'}; 7201 7202 my @clause; 7203 7204 ## If they gave a schema option, restrict the query by namespace 7205 push @clause => generate_clause({col => 'nspname', items => $bcargs->{schema}}); 7206 7207 ## If they have asked to exclude schemas, append that to the namespace clause 7208 push @clause => generate_clause({col => 'nspname', items => $bcargs->{'exclude-schema'}, not => 1}); 7209 7210 ## If they gave a table option, restrict the query by relname 7211 push @clause => generate_clause({col => 'relname', items => $bcargs->{table}}); 7212 7213 ## If they have asked to exclude tables, append that to the relname clause 7214 push @clause => generate_clause({col => 'relname', items => $bcargs->{'exclude-table'}, not => 1}); 7215 7216 for my $c (@clause) { 7217 next if ! $c; 7218 $SQL .= "\nAND ($c)"; 7219 } 7220 7221 ## Fetch all the items, warn if no matches are found 7222 $VERBOSE >= 2 and warn "Query: $SQL\n"; 7223 $sth = $dbh2->prepare($SQL); 7224 $count = $sth->execute(); 7225 if ($count < 1) { 7226 warn "Sorry, no ${type}s were found\n"; 7227 } 7228 7229 ## Grab all current tables or sequences from the goat table. 7230 $SQL = qq{SELECT schemaname, tablename FROM bucardo.goat WHERE reltype= '$type' AND db = '$db->{name}'}; 7231 my %hastable; 7232 for my $row (@{$dbh->selectall_arrayref($SQL)}) { 7233 $hastable{$row->[0]}{$row->[1]}++; 7234 } 7235 7236 ## Do we have a herd request? Process it if so 7237 my $herd = ''; 7238 my $addtoherd; 7239 if ($bcargs->{herd}) { 7240 $herd = $bcargs->{herd}; 7241 $SQL = 'SELECT 1 FROM bucardo.herd WHERE name = ?'; 7242 my $herdcheck = $dbh->prepare($SQL); 7243 $count = $herdcheck->execute($herd); 7244 $herdcheck->finish(); 7245 if ($count < 1) { 7246 print "Creating relgroup: $herd\n"; 7247 $SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)'; 7248 $herdcheck = $dbh->prepare($SQL); 7249 $herdcheck->execute($herd); 7250 } 7251 else { 7252 $VERBOSE >= 1 and warn "Relgroup already exists: $herd\n"; 7253 } 7254 $SQL = 'INSERT INTO bucardo.herdmap(herd,goat) VALUES (?,?)'; 7255 $addtoherd = $dbh->prepare($SQL); 7256 } 7257 7258 ## Get ready to add tables or sequences to the goat table 7259 $SQL = q{INSERT INTO bucardo.goat (db,schemaname,tablename,reltype}; 7260 $SQL .= exists $bcargs->{makedelta} ? ',makedelta) VALUES (?,?,?,?,?)' : ') VALUES (?,?,?,?)'; 7261 my $addtable = $dbh->prepare($SQL); 7262 7263 ## Walk through all returned tables from the remote database 7264 my %count = (seenit => 0, added => 0); 7265 my (%old, %new, %fail, $id); 7266 for my $row (@{$sth->fetchall_arrayref()}) { 7267 my ($S,$T) = @$row; 7268 my $tinfo; 7269 ## Do we already have this one? 7270 if (exists $hastable{$S}{$T}) { 7271 $VERBOSE >= 2 and warn "Skipping $type already in relation: $S.$T\n"; 7272 $count{seenit}++; 7273 $old{$S}{$T} = 1; 7274 if ($herd) { 7275 ## In case this is not already in the herd, grab the id and jump down 7276 $SQL = 'SELECT * FROM goat WHERE db=? AND schemaname=? AND tablename=? AND reltype=?'; 7277 $sth = $dbh->prepare($SQL); 7278 $count = $sth->execute($db->{name},$S,$T,$type); 7279 if ($count < 1) { 7280 die qq{Could not find $type $S.$T in database "$db->{name}"!\n}; 7281 } 7282 $tinfo = $sth->fetchall_arrayref({})->[0]; 7283 $id = $tinfo->{id}; 7284 goto HERD; 7285 } 7286 next; 7287 } 7288 7289 $VERBOSE >= 2 and warn "Attempting to add relation $S.$T\n"; 7290 ## We want a savepoint as we may retract the addition (e.g. no pkey and pkonly specified) 7291 $dbh->do('SAVEPOINT newtable'); 7292 eval { 7293 my @arg = ($db->{name},$S,$T,$type); 7294 push @arg => $bcargs->{makedelta} if exists $bcargs->{makedelta}; 7295 $count = $addtable->execute(@arg); 7296 }; 7297 if ($@) { 7298 warn "$@\n"; 7299 if ($@ =~ /prepared statement.+already exists/) { 7300 warn "This message usually indicates you are using pgbouncer\n"; 7301 warn "You can probably fix this problem by running:\n"; 7302 warn "$progname update db $db->{name} server_side_prepares=false\n"; 7303 warn "Then retry your command again\n\n"; 7304 } 7305 exit 1; 7306 } 7307 if ($count != 1) { 7308 $addtable->finish(); 7309 warn "Failed to add $type relation $S.$T!\n"; 7310 $fail{$S}{$T} = 1; 7311 next; 7312 } 7313 $SQL = q{SELECT currval('bucardo.goat_id_seq')}; 7314 $id = $dbh->selectall_arrayref($SQL)->[0][0]; 7315 $VERBOSE >= 2 and warn "ID of new table $S.$T is $id\n"; 7316 7317 ## Grab it back from the database 7318 $SQL = 'SELECT * FROM goat WHERE id = ?'; 7319 $sth = $dbh->prepare($SQL); 7320 $sth->execute($id); 7321 $tinfo = $sth->fetchall_arrayref({})->[0]; 7322 7323 ## If it has no primary key and pkonly is set, abandon this change 7324 if ($bcargs->{pkonly} and 'table' eq $type and ! length $tinfo->{pkey}) { 7325 $VERBOSE >= 1 and warn "Not adding table $S.$T: no pkey\n"; 7326 $dbh->do('ROLLBACK TO newtable'); 7327 next; 7328 } 7329 7330 $count{added}++; 7331 $new{$S}{$T} = 1; 7332 HERD: 7333 if ($herd) { 7334 ## Need to check again as the previous check above was only for brand new tables 7335 if ($bcargs->{pkonly} and 'table' eq $type and ! length $tinfo->{pkey}) { 7336 $VERBOSE >= 1 and warn "Not adding table $S.$T to relgroup: no pkey\n"; 7337 } 7338 else { 7339 $SQL = 'SELECT 1 FROM herdmap WHERE herd=? AND goat = ?'; 7340 $sth = $dbh->prepare($SQL); 7341 $count = $sth->execute($herd, $id); 7342 if ($count < 1) { 7343 $addtoherd->execute($herd, $id); 7344 print "Added $type $S.$T to relgroup $herd\n"; 7345 } 7346 } 7347 } 7348 7349 } 7350 7351 ## Disconnect from the remote database 7352 $dbh2->disconnect(); 7353 7354 if ($VERBOSE >= 1) { 7355 if (%new) { 7356 print "New ${type}s:\n"; 7357 for my $s (sort keys %new) { 7358 for my $t (sort keys %{$new{$s}}) { 7359 print " $s.$t\n"; 7360 } 7361 } 7362 } 7363 if (%fail) { 7364 print "Failed to add ${type}s:\n"; 7365 for my $s (sort keys %fail) { 7366 for my $t (sort keys %{$fail{$s}}) { 7367 print " $s.$t\n"; 7368 } 7369 } 7370 } 7371 } 7372 7373 my $message = "New ${type}s added: $count{added}\n"; 7374 if ($count{seenit}) { 7375 $message .= "Already added: $count{seenit}\n"; 7376 } 7377 7378 return $message; 7379 7380} ## end of add_all_goats 7381 7382 7383 7384 7385sub remove_customcode { 7386 7387 ## Usage: remove customcode name [name2 name3 ...] 7388 ## Arguments: none (uses nouns) 7389 ## Returns: never, exits 7390 7391 my $doc_section = 'remove'; 7392 usage_exit($doc_section) unless @nouns; 7393 7394 ## Make sure all named codes exist 7395 my $code = $global{cc}; 7396 for my $name (@nouns) { 7397 if (! exists $code->{$name}) { 7398 die qq{No such code: $name\n}; 7399 } 7400 } 7401 7402 $SQL = 'DELETE FROM bucardo.customcode WHERE name = ?'; 7403 $sth = $dbh->prepare($SQL); 7404 7405 for my $name (@nouns) { 7406 eval { 7407 $sth->execute($name); 7408 }; 7409 if ($@) { 7410 die qq{Could not delete customcode "$name"\n$@\n}; 7411 } 7412 } 7413 7414 for my $name (@nouns) { 7415 print qq{Removed customcode "$name"\n}; 7416 } 7417 7418 $dbh->commit(); 7419 7420 exit 0; 7421 7422 7423} ## end of remove_customcode 7424 7425 7426 7427 7428 7429 7430 7431 7432 7433 7434 7435sub clog { 7436 7437 ## Output a message to stderr 7438 ## Arguments: one 7439 ## 1. Message 7440 ## Returns: undef 7441 7442 my $message = shift; 7443 chomp $message; 7444 7445 warn "$message\n"; 7446 7447 return; 7448 7449} ## end of clog 7450 7451 7452sub schema_exists { 7453 7454 ## Determine if a named schema exists 7455 ## Arguments: one 7456 ## 1. Schema name 7457 ## Returns: 0 or 1 7458 7459 my $schema = shift; 7460 7461 my $SQL = 'SELECT 1 FROM pg_catalog.pg_namespace WHERE nspname = ?'; 7462 my $sth = $dbh->prepare_cached($SQL); 7463 my $count = $sth->execute($schema); 7464 $sth->finish(); 7465 7466 return $count < 1 ? 0 : 1; 7467 7468} ## end of schema_exists 7469 7470 7471sub relation_exists { 7472 7473 ## Determine if a named relation exists 7474 ## Arguments: two 7475 ## 1. Schema name 7476 ## 2. Relation name 7477 ## Returns: OID of the relation, or 0 if it does not exist 7478 7479 my ($schema,$name) = @_; 7480 7481 my $SQL = 'SELECT c.oid FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n '. 7482 'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ?'; 7483 my $sth = $dbh->prepare_cached($SQL); 7484 my $count = $sth->execute($schema,$name); 7485 if ($count == 1) { 7486 return $sth->fetchall_arrayref()->[0][0]; 7487 } 7488 $sth->finish(); 7489 7490 return 0; 7491 7492} ## end of relation_exists 7493 7494 7495sub domain_exists { 7496 7497 ## Determine if a named domain exists 7498 ## Arguments: two 7499 ## 1. Schema name 7500 ## 2. Domain name 7501 ## Returns: 0 or 1 7502 7503 my ($schema,$name) = @_; 7504 7505 my $SQL = 7506 q{SELECT 1 FROM pg_catalog.pg_type t } 7507 . q{JOIN pg_namespace n ON (n.oid = t.typnamespace) } 7508 . q{WHERE t.typtype = 'd' AND n.nspname = ? AND t.typname = ?}; 7509 my $sth = $dbh->prepare_cached($SQL); 7510 $count = $sth->execute($schema,$name); 7511 $sth->finish(); 7512 7513 return $count < 1 ? 0 : 1; 7514 7515} ## end of domain_exists 7516 7517 7518sub config_exists { 7519 7520 ## Checks if a configuration settings exists 7521 ## Arguments: one 7522 ## 1. Name of the setting 7523 ## Returns: 0 or 1 7524 7525 my $name = shift; 7526 7527 my $SQL = 'SELECT 1 FROM bucardo.bucardo_config WHERE name = ?'; 7528 my $sth = $dbh->prepare_cached($SQL); 7529 my $count = $sth->execute($name); 7530 $sth->finish(); 7531 7532 return $count < 1 ? 0 : 1; 7533 7534} ## end of config_exists 7535 7536 7537sub constraint_exists { 7538 7539 ## Determine if a named constraint exists 7540 ## Arguments: three 7541 ## 1. Schema name 7542 ## 2. Table name 7543 ## 3. Constraint name 7544 ## Returns: 0 or 1 7545 7546 my ($schema,$table,$constraint) = @_; 7547 7548 my $SQL = 'SELECT 1 FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, pg_catalog.pg_constraint o '. 7549 'WHERE n.oid=c.relnamespace AND c.oid=o.conrelid AND n.nspname = ? AND c.relname = ? AND o.conname = ?'; 7550 my $sth = $dbh->prepare_cached($SQL); 7551 my $count = $sth->execute($schema,$table,$constraint); 7552 $sth->finish(); 7553 7554 return $count < 1 ? 0 : 1; 7555 7556} ## end of constraint_exists 7557 7558 7559sub column_exists { 7560 7561 ## Determine if a named column exists 7562 ## Arguments: three 7563 ## 1. Schema name 7564 ## 2. Table name 7565 ## 3. Column name 7566 ## Returns: 0 or 1 7567 7568 my ($schema,$table,$column) = @_; 7569 7570 my $SQL = 'SELECT 1 FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '. 7571 'pg_catalog.pg_attribute a WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '. 7572 'AND a.attname = ? AND a.attrelid = c.oid'; 7573 my $sth = $dbh->prepare_cached($SQL); 7574 my $count = $sth->execute($schema,$table,$column); 7575 $sth->finish(); 7576 7577 return $count < 1 ? 0 : 1; 7578 7579} ## end of column_exists 7580 7581 7582sub trigger_exists { 7583 7584 ## Determine if a named trigger exists 7585 ## Arguments: one 7586 ## 1. Trigger name 7587 ## Returns: 0 or 1 7588 7589 my $name = shift; 7590 my $SQL = 'SELECT 1 FROM pg_catalog.pg_trigger WHERE tgname = ?'; 7591 my $sth = $dbh->prepare_cached($SQL); 7592 my $count = $sth->execute($name); 7593 $sth->finish(); 7594 return $count < 1 ? 0 : 1; 7595 7596} ## end of trigger_exists 7597 7598 7599sub function_exists { 7600 7601 ## Determine if a named function exists 7602 ## Arguments: three 7603 ## 1. Schema name 7604 ## 2. Function name 7605 ## 3. Function arguments (as one CSV string) 7606 ## Returns: MD5 of the function source if found, otherwise an empty string 7607 7608 my ($schema,$name,$args) = @_; 7609 7610 $name = lc $name; 7611 $SQL = 'SELECT md5(prosrc) FROM pg_proc p, pg_language l '. 7612 'WHERE p.prolang = l.oid AND proname = ? AND oidvectortypes(proargtypes) = ?'; 7613 $sth = $dbh->prepare($SQL); 7614 $count = $sth->execute($name,$args); 7615 if ($count < 1) { 7616 $sth->finish(); 7617 return ''; 7618 } 7619 7620 return $sth->fetchall_arrayref()->[0][0]; 7621 7622} ## end of function_exists 7623 7624 7625sub column_default { 7626 7627 ## Return the default value for a column in a table 7628 ## Arguments: three 7629 ## 1. Schema name 7630 ## 2. Table name 7631 ## 3. Column name 7632 ## Returns: default value if available, otherwise an empty string 7633 7634 my ($schema,$table,$column) = @_; 7635 my $SQL = 'SELECT pg_get_expr(adbin,adrelid) FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '. 7636 'pg_catalog.pg_attribute a, pg_attrdef d '. 7637 'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '. 7638 'AND a.attname = ? AND a.attrelid = c.oid AND d.adnum = a.attnum AND d.adrelid = a.attrelid'; 7639 my $sth = $dbh->prepare_cached($SQL); 7640 my $count = $sth->execute($schema,$table,$column); 7641 if ($count < 1) { 7642 $sth->finish(); 7643 return ''; 7644 } 7645 return $sth->fetchall_arrayref()->[0][0]; 7646 7647} ## end of column_default 7648 7649 7650sub column_value { 7651 7652 ## Return the value of a table's column 7653 ## Arguments: four 7654 ## 1. Schema name 7655 ## 2. Table name 7656 ## 3. Column name 7657 ## 4. Where clause 7658 ## Returns: value if available, otherwise an empty string 7659 7660 my ($schema,$table,$column,$where) = @_; 7661 7662 my $SQL = "SELECT $column FROM $schema.$table WHERE $where"; 7663 return $dbh->selectall_arrayref($SQL)->[0][0]; 7664 7665} ## end of column_value 7666 7667 7668sub column_type { 7669 7670 ## Return the data type of a table column 7671 ## Arguments: three 7672 ## 1. Schema name 7673 ## 2. Table name 7674 ## 3. Column name 7675 ## Returns: data type if available, otherwise an empty string 7676 7677 my ($schema,$table,$column) = @_; 7678 my $SQL = 'SELECT pg_catalog.format_type(a.atttypid, a.atttypmod) '. 7679 'FROM pg_catalog.pg_class c, pg_catalog.pg_namespace n, '. 7680 'pg_catalog.pg_attribute a '. 7681 'WHERE n.oid=c.relnamespace AND n.nspname = ? AND c.relname = ? '. 7682 'AND a.attname = ? AND a.attrelid = c.oid'; 7683 my $sth = $dbh->prepare_cached($SQL); 7684 my $count = $sth->execute($schema,$table,$column); 7685 if ($count eq '0E0') { 7686 $sth->finish(); 7687 return ''; 7688 } 7689 return $sth->fetchall_arrayref()->[0][0]; 7690 7691} ## end of column_type 7692 7693 7694sub constraint_definition { 7695 7696 ## Return the definition for a constraint 7697 ## Arguments: one 7698 ## 1. Constraint name 7699 ## Returns: definition if found, otherwise an empty string 7700 7701 my $name = shift; 7702 7703 my $SQL = qq{SELECT pg_get_constraintdef(oid,true) FROM pg_constraint WHERE conname = '$name'}; 7704 my $def = $dbh->selectall_arrayref($SQL)->[0][0]; 7705 7706 ## Nothing found? Just return an empty string 7707 return '' if ! defined $def; 7708 7709 ## Do some cleanups to standardize across versions and match bucardo.schema cleanly 7710 $def =~ s/\((\(.+\))\)/$1/; 7711 $def =~ s/= ANY \(ARRAY\[(.+)\]\)/IN ($1)/; 7712 $def =~ s/<> ALL \(ARRAY\[(.+)\]\)/NOT IN ($1)/; 7713 $def =~ s/::text//g; 7714 $def =~ s/(\w+) ~ '/$1 ~ E'/g; 7715 $def =~ s/CHECK \(\((\w+)\) <>/CHECK ($1 <>/; 7716 7717 return $def; 7718 7719} ## end of constraint_definition 7720 7721 7722sub table_comment { 7723 7724 ## Return the comment of a table 7725 ## Arguments: two 7726 ## 1. Schema name 7727 ## 2. Table name 7728 ## Returns: comment if available, otherwise an empty string 7729 7730 my ($schema,$relation) = @_; 7731 7732 my $SQL = q{SELECT description FROM pg_description WHERE objoid = (} 7733 . q{ SELECT c.oid FROM pg_class c JOIN pg_namespace n ON (n.oid = c.relnamespace)} 7734 . q{ WHERE n.nspname = ? AND c.relname = ?)}; 7735 7736 my $sth = $dbh->prepare($SQL); 7737 $count = $sth->execute($schema,$relation); 7738 if ($count < 1) { 7739 $sth->finish(); 7740 return ''; 7741 } 7742 return $sth->fetchall_arrayref()->[0][0]; 7743 7744} ## end of table_comment 7745 7746 7747sub domain_comment { 7748 7749 ## Return the comment of a domain 7750 ## Arguments: two 7751 ## 1. Schema name 7752 ## 2. Domain name 7753 ## Returns: comment if available, otherwise an empty string 7754 7755 my ($schema,$relation) = @_; 7756 7757 my $SQL = q{SELECT description FROM pg_description WHERE objoid = (} 7758 . q{ SELECT t.oid FROM pg_type t JOIN pg_namespace n ON (n.oid = t.typnamespace)} 7759 . q{ WHERE t.typtype = 'd' AND n.nspname = ? AND t.typname = ?)}; 7760 7761 my $sth = $dbh->prepare($SQL); 7762 $count = $sth->execute($schema,$relation); 7763 if ($count < 1) { 7764 $sth->finish(); 7765 return ''; 7766 } 7767 return $sth->fetchall_arrayref()->[0][0]; 7768 7769} ## end of domain_comment 7770 7771 7772sub find_bucardo_schema { 7773 7774 ## Locate the best bucardo.schema file and return a file handle and name for it 7775 ## Arguments: none 7776 ## Returns: file handle and location of the file 7777 7778 my $fh; 7779 7780 ## Start by checking the current directory 7781 my $schema_file = 'bucardo.schema'; 7782 return ($fh, $schema_file) if open $fh, '<', $schema_file; 7783 7784 ## Check for a symlink path back to the right directory 7785 if (-l $progname) { 7786 my $dir = dirname( readlink $progname ); 7787 $schema_file = File::Spec->catfile( $dir, 'bucardo.schema' ); 7788 return ($fh, $schema_file) if open $fh, '<', $schema_file; 7789 } 7790 7791 ## Try /usr/local/share/bucardo 7792 $schema_file = '/usr/local/share/bucardo/bucardo.schema'; 7793 return ($fh, $schema_file) if open $fh, '<', $schema_file; 7794 7795 ## Try /usr/share/bucardo 7796 $schema_file = '/usr/share/bucardo/bucardo.schema'; 7797 return ($fh, $schema_file) if open $fh, '<', $schema_file; 7798 7799 die "Could not find the bucardo.schema file!\n"; 7800 7801} ## end of find_bucardo_schema 7802 7803 7804sub table_definition { 7805 7806 ## Pull the complete table definition from the bucardo.schema file 7807 ## Returns an arrayref of sequences, and the textual table def 7808 ## Arguments: one 7809 ## 1. Name of the table 7810 ## Returns: arrayref of sequences used, table definition 7811 7812 my $name = shift; 7813 7814 my $def = ''; 7815 7816 my ($fh, $schema_file) = find_bucardo_schema(); 7817 my @seq; 7818 while (<$fh>) { 7819 if (!$def) { 7820 if (/^CREATE TABLE $name/) { 7821 $def .= $_; 7822 } 7823 } 7824 else { 7825 $def .= $_; 7826 last if /^\);/; 7827 } 7828 } 7829 close $fh or die qq{Could not close "$schema_file": $!\n}; 7830 while ($def =~ /nextval\('(.+?)'/g) { 7831 push @seq => $1; 7832 } 7833 7834 if (! length($def)) { 7835 die "Could not find the table definition for $name\n"; 7836 } 7837 7838 return \@seq, $def; 7839 7840} ## end of table_definition 7841 7842 7843sub generate_clause { 7844 7845 ## Generate a snippet of SQL for a WHERE clause 7846 ## Arguments: one 7847 ## 1. Hashref of information 7848 ## Returns: new clause 7849 7850 my $arg = shift or die; 7851 return '' if ! $arg->{items} or ! defined $arg->{items}[0]; 7852 7853 my $col = $arg->{col} or die; 7854 my $items = $arg->{items}; 7855 my ($NOT,$NOTR) = ('',''); 7856 if (exists $arg->{not}) { 7857 $NOT = 'NOT '; 7858 $NOTR = '!'; 7859 } 7860 my $andor = exists $arg->{andor} ? uc($arg->{andor}) : $NOT ? 'AND' : 'OR'; 7861 7862 my (@oneitem,@itemlist); 7863 for my $name (@{$items}) { 7864 $name =~ s/^\s*(.+?)\s*$/$1/; 7865 ## Break into schema and relation 7866 my $schema = ''; 7867 if ($col eq 'tablename' and $name =~ s/(.+\w)\.(\w.+)/$2/) { 7868 $schema = $1; 7869 } 7870 7871 my $one = 1; 7872 ## Contains: 7873 if ($name =~ s/^\*(.+)\*$/$1/) { 7874 push @oneitem => "$col ${NOTR}~ " . qquote($1); 7875 } 7876 ## Starts with: 7877 elsif ($name =~ s/^\*(.+)/$1/) { 7878 push @oneitem => "$col ${NOTR}~ " . qquote("$1\$"); 7879 } 7880 ## Ends with: 7881 elsif ($name =~ s/(.+)\*$/$1/) { 7882 push @oneitem => "$col ${NOTR}~ " . qquote("^$1"); 7883 } 7884 else { 7885 push @itemlist => qquote($name); 7886 $one = 0; 7887 } 7888 if ($schema) { 7889 my $col2 = 'schemaname'; 7890 my $old = $one ? pop @oneitem : pop @itemlist; 7891 if ($schema =~ s/^\*(.+)\*$/$1/) { 7892 push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote($1) . ')'; 7893 } 7894 elsif ($schema =~ s/^\*(.+)/$1/) { 7895 push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote("$1\$") . ')'; 7896 } 7897 elsif ($schema =~ s/(.+)\*$/$1/) { 7898 push @oneitem => "($old AND $col2 ${NOTR}~ " . qquote("^$1") . ')'; 7899 } 7900 else { 7901 push @oneitem => "($col = $old AND $col2 = " . qquote($schema) . ')'; 7902 } 7903 } 7904 } 7905 if (@itemlist) { 7906 my $list = sprintf '%s %s%s (%s)', $col, $NOT, 'IN', (join ',' => @itemlist); 7907 push @oneitem => $list; 7908 } 7909 my $SQL = join " $andor " => @oneitem; 7910 7911 return $SQL; 7912 7913} ## end of generate_clause 7914 7915 7916sub qquote { 7917 7918 ## Quick SQL quoting 7919 ## Arguments: one 7920 ## 1. String to be quoted 7921 ## Returns: modified string 7922 7923 my $thing = shift; 7924 7925 $thing =~ s/'/''/g; 7926 7927 return qq{'$thing'}; 7928 7929} ## end of qquote 7930 7931 7932sub upgrade { 7933 7934 ## Make upgrades to an existing Bucardo schema to match the current version 7935 ## Arguments: none 7936 ## Returns: never, exits 7937 7938 ## Ensure the bucardo.schema file is available and the correct version 7939 my ($fh, $schema_file) = find_bucardo_schema(); 7940 7941 my $schema_version = 0; 7942 while (<$fh>) { 7943 if (/\-\- Version (\d+\.\d+\.\d+)/) { 7944 $schema_version = $1; 7945 last; 7946 } 7947 } 7948 if (! $schema_version) { 7949 die qq{Could not find version number in the file "$schema_file"!\n}; 7950 } 7951 if ($schema_version ne $VERSION) { 7952 die qq{Cannot continue: bucardo is version $VERSION, but $schema_file is version $schema_version\n}; 7953 } 7954 7955 $dbh->do(q{SET escape_string_warning = 'OFF'}); 7956 if ($dbh->{pg_server_version} >= 80200) { 7957 $dbh->do(q{SET standard_conforming_strings = 'ON'}); 7958 } 7959 7960 my $changes = 0; 7961 7962 ## Quick sanity to make sure we don't try to cross the 4/5 boundary 7963 if (!relation_exists('bucardo', 'syncrun')) { 7964 print "Sorry, but Bucardo version 4 cannot be upgraded to version 5\n"; 7965 print "You will have to recreate your information (dbs, syncs, etc.)\n"; 7966 exit 1; 7967 } 7968 7969 ## Make sure the upgrade_log table is in place 7970 7971 if (!relation_exists('bucardo', 'upgrade_log')) { 7972 my ($seqlist, $tabledef) = table_definition('bucardo.upgrade_log'); 7973 upgrade_and_log($tabledef,'CREATE TABLE bucardo.upgrade_log'); 7974 $dbh->commit(); 7975 } 7976 7977 my @old_sequences = ( 7978 'dbgroup_id_seq', 7979 ); 7980 7981 my @old_configs = ( 7982 'pidfile', 7983 'upsert_attempts', 7984 ); 7985 7986 my @renamed_configs = ( 7987 ['default_standard_conflict' => 'default_conflict_strategy'], 7988 ); 7989 7990 my @old_constraints = ( 7991 ['bucardo', 'goat', 'goat_pkeytype_check'], 7992 ['bucardo', 'sync', 'sync_replica_allornone'], 7993 ['bucardo', 'sync', 'sync_disable_triggers_method'], 7994 ['bucardo', 'sync', 'sync_disable_rules_method'], 7995 ); 7996 7997 my @old_columns = ( 7998 ['bucardo', 'dbmap', 'makedelta'], 7999 ['bucardo', 'sync', 'disable_rules'], 8000 ['bucardo', 'sync', 'disable_triggers'], 8001 ['bucardo', 'sync', 'makedelta'], 8002 ); 8003 8004 my @old_functions = ( 8005 ['create_child_q', 'text'], 8006 ); 8007 8008 my @old_indexes = ( 8009 ['bucardo', 'sync', 'sync_source_targetdb'], 8010 ['bucardo', 'sync', 'sync_source_targetgroup'], 8011 ); 8012 8013 my @old_views = ( 8014 'goats_in_herd', 8015 ); 8016 8017 my @new_columns = ( 8018 ); 8019 8020 my @dropped_columns = ( 8021 ['bucardo', 'sync', 'limitdbs'], 8022 ['bucardo', 'goat', 'customselect'], 8023 ['bucardo', 'sync', 'usecustomselect'], 8024 ['bucardo', 'sync', 'do_listen'], 8025 ['bucardo', 'customcode', 'getrows'], 8026 ); 8027 8028 my @altered_columns = ( 8029 ['bucardo', 'goat', 'rebuild_index', 'BOOL2SMALLINT1'], 8030 ['bucardo', 'goat', 'schemaname', 'NO DEFAULT'], 8031 ['bucardo', 'sync', 'isolation_level', 'NO DEFAULT'], 8032 ['bucardo', 'sync', 'rebuild_index', 'BOOL2SMALLINT1'], 8033 ['bucardo', 'sync', 'standard_conflict', 'RENAME conflict_strategy'], 8034 ['bucardo', 'sync', 'ping', 'RENAME autokick'], 8035 ['bucardo', 'goat', 'ping', 'RENAME autokick'], 8036 ['bucardo', 'goat', 'standard_conflict', 'RENAME conflict_strategy'], 8037 ); 8038 8039 my @row_values = ( 8040 ['bucardo_config','about',q{name = 'log_showtime'}, 1, 8041 'Show timestamp in the log output? 0=off 1=seconds since epoch 2=scalar gmtime 3=scalar localtime'], 8042 ['bucardo_config', 'about', q{name = 'default_conflict_strategy'}, 1, 'Default conflict strategy for all syncs'], 8043 ); 8044 8045 my @drop_all_rules = ( 8046 ); 8047 8048 ## Drop all existing rules from a table: 8049 for my $row (@drop_all_rules) { 8050 my ($schema,$table) = @$row; 8051 my $oid = relation_exists($schema,$table); 8052 if (!$oid) { 8053 warn "Could not find table $schema.$table to check!\n"; 8054 next; 8055 } 8056 $SQL = 'SELECT rulename FROM pg_catalog.pg_rewrite WHERE ev_class = ? ORDER BY rulename'; 8057 $sth = $dbh->prepare($SQL); 8058 $count = $sth->execute($oid); 8059 if ($count < 1) { 8060 $sth->finish(); 8061 next; 8062 } 8063 for my $rule (map { $_->[0] } @{$sth->fetchall_arrayref()}) { 8064 upgrade_and_log(qq{DROP RULE "$rule" ON $schema.$table}); 8065 clog "Dropped rule $rule on table $schema.$table"; 8066 $changes++; 8067 } 8068 } 8069 8070 ## Drop any old views 8071 for my $name (@old_views) { 8072 next if !relation_exists('bucardo', $name); 8073 upgrade_and_log("DROP VIEW $name"); 8074 clog "Dropped view $name"; 8075 $changes++; 8076 } 8077 8078 ## Drop any old sequences 8079 for my $sequence (@old_sequences) { 8080 next if !relation_exists('bucardo', $sequence); 8081 upgrade_and_log("DROP SEQUENCE bucardo.$sequence"); 8082 clog "Dropped sequence: $sequence"; 8083 $changes++; 8084 } 8085 8086 ## Drop any old constraints 8087 for my $con (@old_constraints) { 8088 my ($schema, $table, $constraint) = @$con; 8089 next if !constraint_exists($schema, $table, $constraint); 8090 upgrade_and_log(qq{ALTER TABLE $schema.$table DROP CONSTRAINT "$constraint"}); 8091 clog "Dropped constraint $constraint ON $schema.$table"; 8092 $changes++; 8093 } 8094 8095 ## Parse the bucardo.schema file and verify the following types of objects exist: 8096 ## Functions, triggers, constraints, sequences, indexes, comments, and domains 8097 my (@flist, @tlist, @ilist, @clist, @clist2, @slist, @tablelist, @comlist, @domlist, @collist); 8098 my ($fname,$args,$fbody) = ('','',''); 8099 my ($tname,$tbody) = ('',''); 8100 my ($tablename,$tablebody) = ('',''); 8101 my ($altername,$alterbody,$alterstat) = ('','',''); 8102 seek $fh, 0, 0; 8103 while (<$fh>) { 8104 if ($fbody) { 8105 if (/^(\$bc\$;)/) { 8106 $fbody .= $1; 8107 push @flist, [$fname, $args, $fbody]; 8108 $fbody = $fname = $args = ''; 8109 } 8110 else { 8111 $fbody .= $_; 8112 } 8113 next; 8114 } 8115 if ($tbody) { 8116 $tbody .= $_; 8117 if (/;/) { 8118 push @tlist, [$tname, $tbody]; 8119 $tbody = $tname = ''; 8120 } 8121 next; 8122 } 8123 if ($tablebody) { 8124 $tablebody .= $_; 8125 if (/^\s*CONSTRAINT\s+(\w+)\s+(.+?)\s*$/) { 8126 my ($cname,$def) = ($1,$2); 8127 $def =~ s/,$//; 8128 $def =~ s/\bbucardo\.//; 8129 push @clist2, [$tablename, $cname, $def]; 8130 } 8131 elsif (/^\s+([a-z_]+)\s+([A-Z]+)\s*(NOT)? NULL(.*)/) { 8132 my ($colname,$coltype,$isnull,$extra,$default) = ($1, $2, $3 ? 1 : 0, $4, undef); 8133 if ($extra =~ /DEFAULT\s+([^,]+)/) { 8134 $default = $1; 8135 } 8136 push @collist, ['bucardo', $tablename, $colname, $_, $default]; 8137 } 8138 elsif (/;/) { 8139 push @tablelist, [$tablename, $tablebody]; 8140 $tablebody = $tablename = ''; 8141 } 8142 else { 8143 die qq{Could not parse table definition: invalid column at line $. ($_)\n}; 8144 } 8145 next; 8146 } 8147 if ($altername) { 8148 $alterbody =~ s/\s+$//; 8149 $alterbody ? s/^\s+/ / : s/^\s+//; 8150 s/\s+$/ /; 8151 $alterbody .= $_; 8152 $alterstat .= $_; 8153 if ($alterbody =~ s/;\s*$//) { 8154 push @clist, [$altername->[0], $altername->[1], $alterbody, $alterstat]; 8155 $alterbody = $altername = $alterstat = ''; 8156 } 8157 next; 8158 } 8159 if (/^CREATE (?:OR REPLACE )?FUNCTION\s+bucardo\.(.+?\))/) { 8160 $fname = $1; 8161 $fbody .= $_; 8162 $fname =~ s/\((.*)\)// or die "No args found for function: $_\n"; 8163 $args = $1; 8164 $args =~ s/,(\S)/, $1/g; 8165 next; 8166 } 8167 if (/^CREATE TRIGGER (\S+)/) { 8168 $tname = $1; 8169 $tbody .= $_; 8170 next; 8171 } 8172 if (/^CREATE TABLE bucardo\.(\w+)/) { 8173 $tablename = $1; 8174 $tablebody .= $_; 8175 next; 8176 } 8177 if (/^CREATE (UNIQUE )?INDEX (\S+)/) { 8178 push @ilist, [$1, $2, $_]; 8179 next; 8180 } 8181 if (/^ALTER TABLE bucardo\.(\S+)\s+ADD CONSTRAINT\s*(\S+)\s*(\S*.*)/) { 8182 $altername = [$1,$2]; 8183 $alterbody = $3 || ''; 8184 $alterstat = $_; 8185 next; 8186 } 8187 if (/^CREATE SEQUENCE bucardo\.(\w+)/) { 8188 push @slist, [$1, $_]; 8189 next; 8190 } 8191 if (/^COMMENT ON (\w+) (\w+)\.(\w+) IS \$\$(.+)\$\$/) { 8192 push @comlist, [lc $1, $2, $3, $4, $_]; 8193 next; 8194 } 8195 if (/^CREATE DOMAIN bucardo\.(\w+) (.+)/) { 8196 push @domlist, [$1, $2]; 8197 next; 8198 } 8199 } 8200 8201 ## Add any new domains, verify existing ones 8202 for my $row (@domlist) { 8203 my ($name,$def) = @$row; 8204 next if domain_exists('bucardo', $name); 8205 upgrade_and_log("CREATE DOMAIN bucardo.$name $def"); 8206 clog("Created domain: $name"); 8207 $changes++; 8208 } 8209 8210 ## Check for any added sequences 8211 for my $row (@slist) { 8212 my ($sname,$body) = @$row; 8213 next if relation_exists('bucardo', $sname); 8214 upgrade_and_log($body); 8215 clog "Created sequence $sname"; 8216 $changes++; 8217 } 8218 8219 ## Check for any added tables 8220 for my $row (@tablelist) { 8221 my ($name,$body) = @$row; 8222 next if relation_exists('bucardo', $name); 8223 upgrade_and_log($body); 8224 clog "Created table $name"; 8225 $changes++; 8226 } 8227 8228 ## Add new columns as needed from the schema 8229 for my $row (@collist) { 8230 my ($schema,$table,$column,$definition) = @$row; 8231 next if column_exists($schema, $table, $column); 8232 $definition =~ s/\-\-.+$//; 8233 $definition =~ s/,\s*$//; 8234 $definition =~ s/\s+/ /g; 8235 upgrade_and_log("ALTER TABLE $schema.$table ADD COLUMN $definition"); 8236 clog "Created column: $schema.$table.$column"; 8237 $changes++; 8238 } 8239 8240 ## Add specific new columns as needed 8241 for my $row (@new_columns) { 8242 my ($schema,$table,$column,$def) = @$row; 8243 next if column_exists($schema, $table, $column); 8244 $def =~ s/\s+/ /g; 8245 upgrade_and_log("ALTER TABLE $schema.$table ADD COLUMN $def"); 8246 clog "Created column: $schema.$table.$column"; 8247 $changes++; 8248 } 8249 8250 ## Drop columns as needed. 8251 for my $row (@dropped_columns) { 8252 my ($schema,$table,$column) = @$row; 8253 next unless column_exists($schema, $table, $column); 8254 upgrade_and_log("ALTER TABLE $schema.$table DROP COLUMN $column"); 8255 clog "Dropped column: $schema.$table.$column"; 8256 $changes++; 8257 } 8258 8259 ## Change any altered columns 8260 for my $row (@altered_columns) { 8261 my ($schema,$table,$column,$change) = @$row; 8262 next if ! column_exists($schema, $table, $column); 8263 if ($change eq 'NO DEFAULT') { 8264 my $def = column_default($schema, $table, $column); 8265 next if !$def; 8266 upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column DROP DEFAULT"); 8267 clog "Removed DEFAULT ($def) from $schema.$table.$column"; 8268 $changes++; 8269 } 8270 elsif ($change =~ /^RENAME\s+(\w+)/) { 8271 my $newname = $1; 8272 next if column_exists($schema, $table, $newname); 8273 upgrade_and_log("ALTER TABLE $schema.$table RENAME COLUMN $column TO $newname"); 8274 clog("Renamed $schema.$table.$column to $newname"); 8275 $changes++; 8276 } 8277 elsif ($change =~ /^DEFAULT\s+(.+)/) { 8278 my $newname = $1; 8279 my $oldname = column_default($schema, $table, $column); 8280 next if $newname eq $oldname; 8281 upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column SET DEFAULT $newname"); 8282 clog("Changed DEFAULT on $schema.$table.$column to $newname"); 8283 $changes++; 8284 } 8285 elsif ($change =~ /BOOL2SMALLINT(\d)/) { 8286 my $defval = $1; 8287 my $oldtype = column_type($schema, $table, $column); 8288 next if $oldtype eq 'smallint'; 8289 upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column DROP DEFAULT"); 8290 upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column TYPE smallint " 8291 . "USING CASE WHEN $column IS NULL OR $column IS FALSE THEN 0 ELSE $defval END"); 8292 upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column SET DEFAULT 0"); 8293 clog("Changed type of $schema.$table.$column to smallint"); 8294 $changes++; 8295 } 8296 else { 8297 die qq{Do not know how to handle altered column spec of "$change"}; 8298 } 8299 } 8300 8301 ## Change any column defaults 8302 ## Add new columns as needed from the schema 8303 for my $row (@collist) { 8304 my ($schema,$table,$column,$definition,$default) = @$row; 8305 next if ! column_exists($schema, $table, $column) or ! defined $default; 8306 my $olddefault = column_default($schema, $table, $column); 8307 $olddefault =~ s/::text//; 8308 $olddefault =~ s/::regclass//; 8309 $olddefault =~ s/'00:00:00'::interval/'0 seconds'::interval/; 8310 next if $olddefault eq $default; 8311 upgrade_and_log("ALTER TABLE $schema.$table ALTER COLUMN $column SET DEFAULT $default"); 8312 clog "Set new default for $schema.$table.$column: $default"; 8313 $changes++; 8314 } 8315 8316 8317 ## Drop any old columns 8318 for my $row (@old_columns) { 8319 my ($schema,$table,$column) = @$row; 8320 next if !column_exists($schema, $table, $column); 8321 upgrade_and_log("ALTER TABLE $schema.$table DROP COLUMN $column"); 8322 clog "Dropped column: $schema.$table.$column"; 8323 $changes++; 8324 } 8325 8326 ## Drop any old indexes 8327 for my $row (@old_indexes) { 8328 my ($schema,$table,$name) = @$row; 8329 next if !relation_exists($schema, $name); 8330 upgrade_and_log("DROP INDEX $name"); 8331 clog "Dropped index $name"; 8332 $changes++; 8333 } 8334 8335 ## Drop any old functions 8336 for my $row (@old_functions) { 8337 my ($name, $largs) = @$row; 8338 next if ! function_exists('bucardo', $name, $largs); 8339 clog "Dropped function $name($largs)"; 8340 upgrade_and_log(qq{DROP FUNCTION bucardo."$name"($largs)}); 8341 $changes++; 8342 } 8343 8344 ## Drop any old config items 8345 for my $name (@old_configs) { 8346 next if ! config_exists($name); 8347 clog "Removed old bucardo_config name: $name"; 8348 upgrade_and_log(qq{DELETE FROM bucardo.bucardo_config WHERE name = '$name'}); 8349 $changes++; 8350 } 8351 8352 ## Rename configs. 8353 for my $names (@renamed_configs) { 8354 next if config_exists($names->[1]); 8355 clog "Renamed bucardo_config $names->[0] to $names->[1]"; 8356 upgrade_and_log(qq{ 8357 UPDATE bucardo.bucardo_config 8358 SET name = '$names->[1]' 8359 WHERE name = '$names->[0]' 8360 }); 8361 $changes++; 8362 } 8363 8364 ## Special case config renaming 8365 if (config_exists('bucardo_current_version')) { 8366 ## was version and current_version; became initial_version and version 8367 clog('Renaming bucardo_current_version to bucardo_version, and bucardo_version to bucardo_initial_version'); 8368 upgrade_and_log(q{UPDATE bucardo.bucardo_config SET name = 'bucardo_initial_version' WHERE name = 'bucardo_version'}); 8369 upgrade_and_log(q{UPDATE bucardo.bucardo_config SET name = 'bucardo_version' WHERE name = 'bucardo_current_version'}); 8370 } 8371 8372 ## Check for any new config items 8373 $SQL = 'SELECT setting FROM bucardo.bucardo_config WHERE lower(name) = ?'; 8374 my $cfgsth = $dbh->prepare($SQL); 8375 $SQL = 'INSERT INTO bucardo.bucardo_config(name,setting,about) VALUES (?,?,?)'; 8376 my $newcfg = $dbh->prepare($SQL); 8377 my %config; 8378 my $inside = 0; 8379 seek $fh, 0, 0; 8380 while (<$fh>) { 8381 chomp; 8382 if (!$inside) { 8383 if (/^WITH DELIMITER/) { 8384 $inside = 1; 8385 } 8386 next; 8387 } 8388 if (/^\\/) { 8389 $inside = 0; 8390 next; 8391 } 8392 ## Scoop 8393 my ($name,$setting,$about) = split /\|/ => $_; 8394 $config{$name} = [$setting,$about]; 8395 $count = $cfgsth->execute($name); 8396 $cfgsth->finish(); 8397 if ($count eq '0E0') { 8398 clog "Added new bucardo_config name: $name"; 8399 $changes++; 8400 $newcfg->execute($name,$setting,$about); 8401 } 8402 } 8403 close $fh or die qq{Could not close file "$file": $!\n}; 8404 8405 ## Apply any specific row changes 8406 for my $row (@row_values) { 8407 my ($table,$column,$where,$force,$value) = @$row; 8408 my $val = column_value('bucardo',$table,$column,$where); 8409 if (!defined $val) { 8410 die "Failed to find $table.$column where $where!\n"; 8411 } 8412 next if $val eq $value; 8413 $SQL = sprintf "UPDATE bucardo.$table SET $column=%s WHERE $where", 8414 $dbh->quote($value); 8415 upgrade_and_log($SQL); 8416 clog "New value set for bucardo.$table.$column WHERE $where"; 8417 $changes++; 8418 } 8419 8420 $SQL = 'SELECT pg_catalog.md5(?)'; 8421 my $md5sth = $dbh->prepare($SQL); 8422 for my $row (@flist) { 8423 my ($name,$arg,$body) = @$row; 8424 next if $name =~ /plperlu_test/; 8425 my $oldbody = function_exists('bucardo',$name,$arg); 8426 if (!$oldbody) { 8427 upgrade_and_log($body,"CREATE FUNCTION $name($arg)"); 8428 clog "Added function $name($arg)"; 8429 $changes++; 8430 next; 8431 } 8432 my $realbody = $body; 8433 $realbody =~ s/.*?\$bc\$(.+)\$bc\$;/$1/sm; 8434 $md5sth->execute($realbody); 8435 my $newbody = $md5sth->fetchall_arrayref()->[0][0]; 8436 next if $oldbody eq $newbody; 8437 $body =~ s/^CREATE FUNCTION/CREATE OR REPLACE FUNCTION/; 8438 (my $short = $body) =~ s/^(.+?)\n.*/$1/s; 8439 $dbh->do('SAVEPOINT bucardo_upgrade'); 8440 eval { upgrade_and_log($body,$short); }; 8441 if ($@) { 8442 $dbh->do('ROLLBACK TO bucardo_upgrade'); 8443 (my $dropbody = $short) =~ s/CREATE OR REPLACE/DROP/; 8444 $dropbody .= ' CASCADE'; 8445 upgrade_and_log($dropbody); 8446 upgrade_and_log($body,$short); 8447 } 8448 else { 8449 $dbh->do('RELEASE bucardo_upgrade'); 8450 } 8451 clog "Updated function: $name($arg)"; 8452 $changes++; 8453 } 8454 8455 ## Check for any added triggers 8456 for my $row (@tlist) { 8457 my ($name,$body) = @$row; 8458 next if trigger_exists($name); 8459 upgrade_and_log($body); 8460 clog "Created trigger $name"; 8461 $changes++; 8462 } 8463 8464 ## Check for any added indexes 8465 for my $row (@ilist) { 8466 my ($uniq,$name,$body) = @$row; 8467 next if relation_exists('bucardo',$name); 8468 upgrade_and_log($body); 8469 clog "Created index $name"; 8470 $changes++; 8471 } 8472 8473 ## Check for any added constraints 8474 for my $row (@clist) { 8475 my ($tcname,$cname,$cdef,$body) = @$row; 8476 if (! constraint_exists('bucardo', $tcname, $cname)) { 8477 upgrade_and_log($body); 8478 clog "Created constraint $cname on $tcname"; 8479 $changes++; 8480 next; 8481 } 8482 8483 ## Clean up the constraint to make it match what comes back from the database: 8484 $cdef =~ s/','/', '/g; 8485 my $condef = constraint_definition($cname); 8486 $condef =~ s{\\}{\\\\}g; 8487 if ($condef ne $cdef) { 8488 upgrade_and_log("ALTER TABLE $tcname DROP CONSTRAINT $cname"); 8489 upgrade_and_log("ALTER TABLE $tcname ADD CONSTRAINT $cname $cdef"); 8490 clog "Altered constraint $cname on $tcname"; 8491 clog "OLD: $condef\nNEW: $cdef\n"; 8492 $changes++; 8493 } 8494 } 8495 8496 ## Check that any bare constraints (e.g. foreign keys) are unchanged 8497 for my $row (@clist2) { 8498 my ($tcname,$cname,$cdef) = @$row; 8499 my $condef = constraint_definition($cname); 8500 next if ! $condef or $condef eq $cdef; 8501 if ($condef and $condef ne $cdef) { 8502 upgrade_and_log("ALTER TABLE $tcname DROP CONSTRAINT $cname"); 8503 } 8504 upgrade_and_log("ALTER TABLE $tcname ADD CONSTRAINT $cname $cdef"); 8505 my $action = $condef ? 'Altered' : 'Added'; 8506 clog "$action constraint $cname on $tcname"; 8507 $changes++; 8508 } 8509 8510 ## Check that object comments exist and match 8511 for my $row (@comlist) { 8512 my ($type,$schema,$relation,$comment,$full) = @$row; 8513 my $current_comment = 8514 $type eq 'table' ? table_comment($schema,$relation) 8515 : $type eq 'domain' ? domain_comment($schema,$relation) 8516 : 'Unknown type'; 8517 if ($current_comment ne $comment) { 8518 upgrade_and_log($full); 8519 clog (length $current_comment 8520 ? "Changed comment on $type $schema.$relation" 8521 : "Added comment for $type $schema.$relation"); 8522 $changes++; 8523 } 8524 } 8525 8526 ## The freezer.q_staging table is no longer needed, but we must empty it before dropping 8527 if (relation_exists('freezer','q_staging')) { 8528 upgrade_and_log('INSERT INTO freezer.master_q SELECT * FROM freezer.q_staging'); 8529 upgrade_and_log('DROP TABLE freezer.q_staging'); 8530 clog 'Dropped deprecated table freezer.q_staging'; 8531 $changes++; 8532 } 8533 8534 ## Make sure bucardo_config has the new schema version 8535 $count = $cfgsth->execute('bucardo_version'); 8536 if ($count eq '0E0') { 8537 $cfgsth->finish(); 8538 warn "Weird: could not find bucardo_version in the bucardo_config table!\n"; 8539 } 8540 else { 8541 my $curval = $cfgsth->fetchall_arrayref()->[0][0]; 8542 if ($curval ne $schema_version) { 8543 $SQL = 'UPDATE bucardo.bucardo_config SET setting = ? WHERE name = ?'; 8544 my $updatecfg = $dbh->prepare($SQL); 8545 $updatecfg->execute($schema_version, 'bucardo_version'); 8546 clog "Set bucardo_config.bucardo_version to $schema_version"; 8547 $changes++; 8548 } 8549 } 8550 8551 ## Update default config settings per the parsed config 8552 $dbh->do('CREATE TEMPORARY TABLE stage_bucardo_config (name text primary key, setting text)'); 8553 $dbh->do('COPY stage_bucardo_config (name,setting) FROM STDIN'); 8554 while (my ($name,$rec) = each %config) { 8555 my $set = $rec->[0]; 8556 $dbh->pg_putcopydata("$name\t$set\n"); 8557 } 8558 $dbh->pg_putcopyend; 8559 $dbh->do('UPDATE bucardo_config c SET defval = s.setting FROM stage_bucardo_config s WHERE c.name = s.name'); 8560 8561 ## Run the magic updater 8562 $SQL = 'SELECT bucardo.magic_update()'; 8563 $sth = $dbh->prepare($SQL); 8564 $sth->execute(); 8565 my $message = $sth->fetchall_arrayref()->[0][0]; 8566 if (length $message) { 8567 clog $message; 8568 $changes++; 8569 } 8570 8571 if ($changes) { 8572 printf "Okay to commit $changes %s? ", $changes==1 ? 'change' : 'changes'; 8573 exit if <STDIN> !~ /Y/i; 8574 $dbh->commit(); 8575 print "Changes have been commited\n"; 8576 } 8577 else { 8578 print "No schema changes were needed\n"; 8579 exit 1; 8580 } 8581 8582 print "Don't forget to run '$progname validate all' as well: see the UPGRADE file for details\n"; 8583 8584 exit 0; 8585 8586} ## end of upgrade 8587 8588 8589sub upgrade_and_log { 8590 8591 ## Put an entry in the bucardo.upgrade_log table 8592 ## Arguments: two 8593 ## 1. Type of action 8594 ## 2. Optional message 8595 ## Returns: undef 8596 8597 my $action = shift; 8598 my $short = shift || $action; 8599 8600 eval { 8601 $dbh->do($action); 8602 }; 8603 if ($@) { 8604 my $line = (caller)[2]; 8605 die "From line $line, action $action\n$@\n"; 8606 } 8607 8608 $SQL = 'INSERT INTO bucardo.upgrade_log(action,version,summary) VALUES (?,?,?)'; 8609 eval { 8610 $sth = $dbh->prepare($SQL); 8611 $sth->execute($action,$VERSION,$short); 8612 }; 8613 if ($@) { 8614 my $line = (caller)[2]; 8615 die "From line $line, insert to upgrade_log failed\n$@\n"; 8616 } 8617 8618 return; 8619 8620} ## end of upgrade_and_log 8621 8622 8623sub usage_exit { 8624 8625 ## Grab the help string for a specific item 8626 ## Arguments: one 8627 ## 1. The thing we want help on 8628 ## Returns: nothing 8629 8630 my $name = shift or die; 8631 my $exitval = defined $_[0] ? shift : 1; 8632 8633 if ($name =~ m{/!}) { 8634 # Bug in Pod::Usage prevents these from working properly. Force it 8635 # to use Pod::PlainText. 8636 # https://rt.perl.org/rt3//Public/Bug/Display.html?id=115534 8637 require Pod::Usage; 8638 require Pod::PlainText; 8639 unshift @Pod::Usage::ISA => 'Pod::PlainText'; 8640 } 8641 8642 _pod2usage( 8643 '-sections' => "COMMAND DETAILS/$name", 8644 '-exitval' => $exitval, 8645 ); 8646 8647 return; 8648 8649} ## end of usage_exit 8650 8651 8652sub connect_database { 8653 8654 ## Connect to a datbase and return a dbh 8655 ## Arguments: one 8656 ## 1. Hashref of connection arguments (optional) 8657 ## Returns: database handle 8658 8659 my $dbh2; 8660 8661 my $opt = shift || {}; 8662 8663 ## If given just a name, transform to a hash 8664 if (! ref $opt) { 8665 $opt = { name => $opt }; 8666 } 8667 8668 if (! exists $DB->{$opt->{name}}) { 8669 die qq{Unknown database "$opt->{name}": try bucardo list dbs\n}; 8670 } 8671 8672 if (exists $opt->{name}) { 8673 $SQL = qq{SELECT bucardo.db_getconn('$opt->{name}')}; 8674 my $conn = $dbh->selectall_arrayref($SQL)->[0][0]; 8675 my ($type,$dsn,$user,$pass) = split /\n/ => $conn; 8676 8677 if ($type ne 'postgres') { 8678 die "Cannot return a handle for database type $type\n"; 8679 } 8680 8681 $dsn =~ s/DSN://; 8682 eval { 8683 $dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0}); 8684 }; 8685 if ($@) { 8686 ## The bucardo user may not exist yet. 8687 if ($user eq 'bucardo' and $@ =~ /FATAL/ and $@ =~ /bucardo/) { 8688 $user = 'postgres'; 8689 $dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0}); 8690 $dbh2->do('CREATE USER bucardo SUPERUSER'); 8691 $dbh2->commit(); 8692 $user = 'bucardo'; 8693 $dbh2 = DBI->connect_cached($dsn, $user, $pass, {AutoCommit=>0,RaiseError=>1,PrintError=>0}); 8694 } 8695 else { 8696 die $@; 8697 } 8698 } 8699 } 8700 8701 return $dbh2; 8702 8703} ## end of connect_database 8704 8705 8706sub config { 8707 8708 ## View or change a value inside the bucardo_config table 8709 ## Arguments: none, reads nouns 8710 ## Returns: never, exits 8711 8712 my $setusage = "Usage: $progname set setting=value [setting=value ...]\n"; 8713 8714 ## Allow for old syntax 8715 if ($verb eq 'config') { 8716 ## Plain old "config" means the same as "show all" 8717 if (!@nouns) { 8718 @nouns = ('show','all'); 8719 } 8720 $verb = shift @nouns; 8721 } 8722 8723 if (!@nouns) { 8724 $verb eq 'set' and die $setusage; 8725 die "Usage: $progname show <all|setting1> [settting2 ...]\n"; 8726 } 8727 8728 $SQL = 'SELECT * FROM bucardo.bucardo_config'; 8729 $sth = $dbh->prepare($SQL); 8730 $sth->execute(); 8731 my $config = $sth->fetchall_hashref('name'); 8732 if ($verb eq 'show') { 8733 my $all = $nouns[0] =~ /\ball\b/i ? 1 : 0; 8734 my $changed = $nouns[0] =~ /\bchanged\b/i ? 1 : 0; 8735 my $maxsize = 3; 8736 for my $s (keys %$config) { 8737 next if 8738 ($changed && $config->{$s}{setting} eq $config->{$s}{defval}) 8739 || (! $all and ! $changed and ! grep { $s =~ /$_/i } @nouns); 8740 8741 $maxsize = length $s if length $s > $maxsize; 8742 } 8743 for my $s (sort keys %$config) { 8744 next if 8745 ($changed && $config->{$s}{setting} eq $config->{$s}{defval}) 8746 || (! $all and ! $changed and ! grep { $s =~ /$_/i } @nouns); 8747 printf "%-*s = %s\n", $maxsize, $s, $config->{$s}{setting}; 8748 } 8749 exit 1; 8750 } 8751 8752 $SQL = 'UPDATE bucardo.bucardo_config SET setting = ? WHERE name = ?'; 8753 $sth = $dbh->prepare($SQL); 8754 8755 my %allow_mixed_case_config = map { $_ => 1 } qw( 8756 log_conflict_file 8757 warning_file 8758 email_debug_file 8759 flatfile_dir 8760 reason_file 8761 stats_script_url 8762 stopfile 8763 log_timer_format 8764 ); 8765 8766 for my $noun (@nouns) { 8767 $noun =~ /(\w+)=(.+)/ or die $setusage; 8768 my $setting = lc $1; 8769 my $val = $allow_mixed_case_config{$setting} ? $2 : lc $2; 8770 8771 if (! exists $config->{$setting}) { 8772 die qq{Unknown setting "$setting"\n}; 8773 } 8774 8775 ## Sanity checks 8776 if ($setting eq 'log_level') { 8777 if ($val !~ /^(?:terse|normal|verbose|debug)$/oi) { 8778 die "Invalid log_level, must be terse, normal, verbose, or debug\n"; 8779 } 8780 } 8781 if ($setting eq 'default_standard_conflict' || $setting eq 'default_conflict_strategy') { 8782 if ($val !~ /^(?:source|target|skip|random|latest|none)$/oi) { 8783 ## FIXME 8784 #die "Invalid default_standard_conflict, must be none, source, target, skip, random, or latest\n"; 8785 } 8786 if ($val =~ /none/i) { 8787 $val = ''; 8788 } 8789 $setting = 'default_conflict_strategy'; 8790 } 8791 8792 $sth->execute($val,$setting); 8793 $QUIET or print qq{Set "$setting" to "$val"\n}; 8794 8795 } 8796 8797 $dbh->commit(); 8798 8799 exit 0; 8800 8801} ## end of config 8802 8803 8804sub message { 8805 8806 ## Add a message to the Bucardo logs, via the bucardo_log_message table 8807 ## Note: If no MCP processes are listening, the message will hang out until an MCP processes it 8808 ## Arguments: none (reads in nouns) 8809 ## Returns: never, exits 8810 8811 my $doc_section = 'message'; 8812 usage_exit($doc_section) unless length $nouns; 8813 8814 $SQL = 'INSERT INTO bucardo.bucardo_log_message(msg) VALUES (?)'; 8815 $sth = $dbh->prepare($SQL); 8816 $sth->execute($nouns); 8817 $dbh->commit(); 8818 $VERBOSE and print "Added message\n"; 8819 8820 exit 0; 8821 8822} ## end of message 8823 8824 8825sub db_get_notices { 8826 8827 ## Gather up and return a list of asynchronous notices received since the last check 8828 ## Arguments: one 8829 ## 1. Database handle 8830 ## Returns: arrayref of notices, each an arrayref of name and pid 8831 ## If using 9.0 or greater, the payload becomes the name 8832 8833 my ($ldbh) = @_; 8834 8835 my ($n, @notices); 8836 8837 while ($n = $ldbh->func('pg_notifies')) { 8838 my ($name, $pid, $payload) = @$n; 8839 if ($ldbh->{pg_server_version} >= 9999990000) { 8840 next if $name ne 'bucardo'; 8841 $name = $payload; ## presto! 8842 } 8843 push @notices => [$name, $pid]; 8844 } 8845 8846 return \@notices; 8847 8848} ## end of db_get_notices 8849 8850 8851sub install { 8852 8853 ## Install Bucardo into a database 8854 ## Arguments: none 8855 ## Returns: never, exits 8856 8857 if (! $bcargs->{batch}) { 8858 print "This will install the bucardo database into an existing Postgres cluster.\n"; 8859 print "Postgres must have been compiled with Perl support,\n"; 8860 print "and you must connect as a superuser\n\n"; 8861 } 8862 8863 ## Setup our default arguments for the installation choices 8864 my $host = $bcargs->{dbhost} || $ENV{PGHOST} || '<none>'; 8865 my $port = $bcargs->{dbport} || $ENV{PGPORT} || 5432; 8866 my $user = $bcargs->{dbuser} || $ENV{DBUSER} || 'postgres'; 8867 my $dbname = $bcargs->{dbname} || $ENV{DBNAME} || 'postgres'; 8868 8869 ## Make sure the bucardo.schema file is available, and extract some config items 8870 my ($fh, $schema_file) = find_bucardo_schema(); 8871 my %confvar = (piddir => ''); 8872 while (<$fh>) { 8873 for my $string (keys %confvar) { 8874 if (/^$string\|(.+?)\|/) { 8875 $confvar{$string} = $1; 8876 } 8877 } 8878 } 8879 close $fh or warn qq{Could not close "$schema_file": $!\n}; 8880 8881 ## Make sure each item has a default value 8882 for my $key (keys %confvar) { 8883 if (!$confvar{$key}) { 8884 warn "Could not find default configuration for $key!\n"; 8885 } 8886 } 8887 8888 ## If the PID directory was not provided on the command line, 8889 ## use the value from the bucardo.schema file 8890 my $piddir = $bcargs->{piddir} || $confvar{piddir}; 8891 8892 ## Keep looping until they are happy with the settings 8893 GOOEY: 8894 { 8895 8896 ## We only don't print this in quiet and batch mode 8897 if (! $QUIET or ! $bcargs->{batch}) { 8898 print "Current connection settings:\n"; 8899 8900 print "1. Host: $host\n"; 8901 print "2. Port: $port\n"; 8902 print "3. User: $user\n"; 8903 print "4. Database: $dbname\n"; 8904 print "5. PID directory: $piddir\n"; 8905 } 8906 8907 ## If in batch mode, we accept everything right away and move on 8908 last GOOEY if $bcargs->{batch}; 8909 8910 print 'Enter a number to change it, P to proceed, or Q to quit: '; 8911 8912 my $ans = <>; 8913 print "\n"; 8914 8915 ## If the answer starts with a number, try and apply it 8916 ## Can also provide the value right away 8917 if ($ans =~ /^\s*(\d+)(.*)/) { 8918 my ($num,$text) = (int $1,$2); 8919 $text =~ s/^\s*(\S+)\s*$/$1/; 8920 my $new = length $text ? $text : ''; 8921 8922 ## Host: allow anything 8923 ## Change empty string to '<none>'; 8924 if (1 == $num) { 8925 if (!length $new) { 8926 print 'Change the host to: '; 8927 $new = <>; 8928 print "\n"; 8929 chomp $new; 8930 } 8931 $host = length $new ? $new : '<none>'; 8932 print "Changed host to: $host\n"; 8933 } 8934 8935 ## Port: only allow numbers 8936 elsif (2 == $num) { 8937 if (!length $new) { 8938 print 'Change the port to: '; 8939 $new = <>; 8940 print "\n"; 8941 chomp $new; 8942 } 8943 if ($new !~ /^\d+$/) { 8944 print "-->Sorry, but the port must be a number\n\n"; 8945 redo GOOEY; 8946 } 8947 $port = $new; 8948 print "Changed port to: $port\n"; 8949 } 8950 8951 ## User: allow anything except an empty string 8952 elsif (3 == $num) { 8953 if (!length $new) { 8954 print 'Change the user to: '; 8955 $new = <>; 8956 print "\n"; 8957 chomp $new; 8958 } 8959 if (! length $new) { 8960 print "-->Sorry, you must specify a user\n\n"; 8961 redo GOOEY; 8962 } 8963 $user = $new; 8964 print "Changed user to: $user\n"; 8965 } 8966 8967 ## Database: allow anything except an empty string 8968 elsif (4 == $num) { 8969 if (!length $new) { 8970 print 'Change the database name to: '; 8971 $new = <>; 8972 print "\n"; 8973 chomp $new; 8974 } 8975 if (! length $new) { 8976 print "-->Sorry, you must specify a database name\n\n"; 8977 redo GOOEY; 8978 } 8979 $dbname = $new; 8980 print "Changed database name to: $dbname\n"; 8981 } 8982 8983 ## PID directory: allow anything, as long as it starts with a slash 8984 elsif (5 == $num) { 8985 if (!length $new) { 8986 print 'Change the PID directory to: '; 8987 $new = <>; 8988 print "\n"; 8989 chomp $new; 8990 } 8991 if (! length $new) { 8992 print "-->Sorry, you must specify a directory\n\n"; 8993 redo GOOEY; 8994 } 8995 if ($new !~ m{^/}) { 8996 print "-->Sorry, the PID directory must be absolute (start with a slash)\n"; 8997 redo GOOEY; 8998 } 8999 if (! -d $new) { 9000 print "-->Sorry, that is not a valid directory\n"; 9001 redo GOOEY; 9002 } 9003 $piddir = $new; 9004 print "Changed PID dir to: $piddir\n"; 9005 } 9006 } 9007 elsif ($ans =~ /^\s*Q/i) { 9008 die "Goodbye!\n"; 9009 } 9010 elsif ($ans =~ /^\s*P/i) { 9011 ## Check on the PID directory before going any further 9012 ## This is the only item that can be easily checked here 9013 if (! -d $piddir) { 9014 print "-->Sorry, that is not a valid PID directory\n"; 9015 redo GOOEY; 9016 } 9017 last GOOEY; 9018 } 9019 else { 9020 print "-->Please enter Q to quit, P to proceed, or enter a number to change a setting\n"; 9021 } 9022 9023 redo GOOEY; 9024 9025 } 9026 9027 ## Try to connect 9028 my $PSQL = sprintf '%s -p %d -U %s -d %s', 9029 $ENV{PGBINDIR} ? "$ENV{PGBINDIR}/psql" : 'psql', 9030 $port, $user, $dbname; 9031 $host !~ /</ and $PSQL .= " --host=$host"; 9032 9033 ## We also want the version, so we grab that as the initial connection test 9034 my $COM = qq{$PSQL -AXtc "SELECT 'pg version: ' || version()"}; 9035 9036 my $res = qx{$COM 2>&1}; 9037 9038 ## Dump any problems verbatim to stderr 9039 my $delayed_warning; 9040 if ($res =~ /FATAL|ERROR/ or $res =~ /psql:/) { 9041 $delayed_warning = $res; 9042 } 9043 9044 ## Check for some common errors 9045 if ($res =~ /role "(.+)" does not exist/) { 9046 my $baduser = $1; 9047 if ($baduser eq 'postgres' and exists $ENV{USER} and $ENV{USER} =~ /^[\w-]+$/) { 9048 $user = $ENV{USER}; 9049 if (!$QUIET and !$bcargs->{batch}) { 9050 print "Failed to connect as user 'postgres', will try '$user'\n"; 9051 } 9052 } 9053 else { 9054 print "-->Sorry, please try using a different user\n\n"; 9055 exit 1 if $bcargs->{batch}; 9056 } 9057 goto GOOEY; 9058 } 9059 9060 ## Check for some common errors 9061 if ($res =~ /database "(.+)" does not exist/) { 9062 my $baddb = $1; 9063 if ($baddb ne 'postgres') { 9064 if (!$QUIET and !$bcargs->{batch}) { 9065 print "Failed to connect to database '$dbname', will try 'postgres'\n"; 9066 } 9067 $dbname = 'postgres'; 9068 goto GOOEY; 9069 } 9070 } 9071 9072 if ($res !~ /pg version: \D+(\d+)(.+?)\s/) { 9073 print "-->Sorry, unable to connect to the database\n\n"; 9074 warn $delayed_warning; 9075 exit 1 if $bcargs->{batch}; 9076 goto GOOEY; 9077 } 9078 9079 ## At this point, we assume a good connection 9080 ## The version check is really just to see if we are 8.1 or higher 9081 my ($maj,$extra) = ($1,$2); 9082 if ($maj < 8 or (8 == $maj and $extra =~ /\.0/)) { 9083 die "Sorry, Bucardo requires Postgres version 8.1 or higher.\n"; 9084 } 9085 9086 ## Determine if we need to create the bucardo user 9087 $COM = qq{$PSQL -c "SELECT 1 FROM pg_user WHERE usename = 'bucardo'"}; 9088 $res = qx{$COM 2>&1}; 9089 9090 ## If no number 1 seen, no bucardo user, so create it 9091 if ($res !~ /1/) { 9092 $QUIET or print "Creating superuser 'bucardo'\n"; 9093 9094 ## Generate a new random password 9095 my $pass = generate_password(); 9096 $SQL = qq{CREATE USER bucardo SUPERUSER PASSWORD '$pass'}; 9097 $COM = qq{$PSQL -c "$SQL"}; 9098 $res = qx{$COM 2>&1}; 9099 9100 ## Put the new password into the .pgpass file 9101 my $passfile = "$ENV{HOME}/.pgpass"; 9102 my $pfh; 9103 if (open my $pfh, '>>', $passfile) { 9104 printf {$pfh} "%s:%s:%s:%s:%s\n", 9105 $host =~ /^\w/ ? $host : '*', 9106 $port =~ /^\d/ ? $port : '*', 9107 '*', 9108 'bucardo', 9109 $pass; 9110 close $pfh or warn qq{Could not close file "$passfile": $!\n}; 9111 chmod 0600, $passfile; 9112 } 9113 else { 9114 print qq{Could not append password information to file "$passfile"\n}; 9115 print qq{Password for user bucardo is: $pass\n}; 9116 print qq{You probably want to change it or put into a .pgpass file\n}; 9117 } 9118 } 9119 9120 ## Now we apply the bucardo.schema to the new database 9121 $COM = "$PSQL -AX -qt -f $schema_file 2>&1"; 9122 9123 print "Attempting to create and populate the bucardo database and schema\n" 9124 if ! $bcargs->{batch}; 9125 9126 $res= qx{$COM}; 9127 chomp $res; 9128 9129 ## Detect case where bucardo is already there 9130 ## This probably needs to be i18n safe 9131 if ($res =~ /relation .* already exists/) { 9132 warn "\nINSTALLATION FAILED! Looks like you already have Bucardo installed there.\n"; 9133 warn "Try running 'bucardo upgrade' instead.\n"; 9134 warn "If you are trying to completely reinstall Bucardo,\n"; 9135 warn "drop the bucardo database, and the bucardo schema from all databases.\n\n"; 9136 exit 1; 9137 } 9138 9139 if ($res =~ /"plperlu".*CREATE LANGUAGE/s) { 9140 warn "\nINSTALLATION FAILED! ($res)\n\n"; 9141 warn "The Pl/PerlU language needs to be available\n"; 9142 warn "This is usually available as a separate package\n"; 9143 warn "For example, you might try: yum install postgresql-plperl\n"; 9144 warn "If compiling from source, add the --with-perl option to your ./configure command\n\n"; 9145 exit 1; 9146 } 9147 9148 ## This can actually happen for many reasons: lack of this message 9149 ## simply means something went wrong somewhere 9150 if ($res !~ m{Pl/PerlU was successfully installed}) { 9151 warn "\nINSTALLATION FAILED! ($res)\n\n"; 9152 exit 1; 9153 } 9154 9155 ## We made it! All downhill from here 9156 print "Database creation is complete\n\n" if ! $bcargs->{batch}; 9157 9158 ## Whether or not we really need to, change some bucardo_config items: 9159 my $BDSN = 'dbi:Pg:dbname=bucardo'; 9160 $host and $host ne '<none>' and $BDSN .= ";host=$host"; 9161 $port and $BDSN .= ";port=$port"; 9162 $dbh = DBI->connect($BDSN, 'bucardo', '', {AutoCommit=>0,RaiseError=>1,PrintError=>0}); 9163 $dbh->do('SET search_path = bucardo'); 9164 9165 $SQL = 'UPDATE bucardo.bucardo_config SET setting = ? WHERE name = ?'; 9166 $sth = $dbh->prepare($SQL); 9167 $confvar{piddir} = $piddir; 9168 for my $key (sort keys %confvar) { 9169 $count = $sth->execute($confvar{$key}, $key); 9170 if ($count != 1) { 9171 warn "!! Failed to set $key to $confvar{$key}\n"; 9172 } 9173 else { 9174 print qq{Updated configuration setting "$key"\n} if ! $bcargs->{batch}; 9175 } 9176 } 9177 $dbh->commit(); 9178 9179 $QUIET or print "Installation is now complete.\n"; 9180 ## A little less verbose if in batch mode 9181 if (! $bcargs->{batch}) { 9182 print "If you see errors or need help, please email bucardo-general\@bucardo.org\n\n"; 9183 9184 print "You may want to check over the configuration variables next, by running:\n"; 9185 print "$progname show all\n"; 9186 print "Change any setting by using: $progname set foo=bar\n\n"; 9187 } 9188 9189 exit 0; 9190 9191} ## end of install 9192 9193 9194## 9195## Internal helper subs 9196## 9197 9198sub debug { 9199 9200 ## Print a debug line if needed 9201 ## Arguments: one or two 9202 ## 1. String to be printed 9203 ## 2. Required debug level: defaults to 1 9204 ## Returns: undef 9205 9206 return if ! $DEBUG; 9207 9208 my $string = shift; 9209 my $level = shift || 1; 9210 9211 return if $DEBUG < $level; 9212 9213 chomp $string; 9214 9215 print " |DEBUG| $string\n"; 9216 9217 return; 9218 9219} ## end of debug 9220 9221 9222sub standardize_name { 9223 9224 ## Return canonical version of certain names 9225 ## Normalizes abbreviations, misspelling, plurals, case, etc. 9226 ## Arguments: one 9227 ## 1. Name 9228 ## Returns: canonical name 9229 9230 my $name = shift; 9231 9232 return 'customcode' if $name =~ /^c?code/i or $name =~ /^custom_?code/i; 9233 9234 return 'customname' if $name =~ /^cname/i or $name =~ /^custom_?name/i; 9235 9236 return 'customcols' if $name =~ /^ccol/i or $name =~ /^custom_?col/i; 9237 9238 return 'dbgroup' if $name =~ /^dbg/i or $name =~ /^d.+group/i; 9239 9240 return 'database' if $name =~ /^db/i or $name =~ /^database/i; 9241 9242 return 'herd' if $name =~ /^(?:relgr|herd)/i; 9243 9244 return 'sync' if $name =~ /^s[yi]n[ck]/i; 9245 9246 return 'table' if $name =~ /^tab/i or $name =~ /^tbale/i; 9247 9248 return 'sequence' if $name =~ /^seq/i; 9249 9250 return 'all' if $name =~ /^all$/i; 9251 9252 return 'config' if $name =~ /^config/i; 9253 9254 return 'clone' if $name =~ /^clon/i; 9255 9256 return $name; 9257 9258} ## end of standardize_name 9259 9260 9261sub generate_password { 9262 9263 ## Generate a random 42 character password 9264 ## Arguments: none 9265 ## Returns: new password 9266 9267 my @chars = split // => q!ABCDEFGHJKMNPQRSTWXYZabcdefghjkmnpqrstwxyz23456789@#%^&(){}[];./!; 9268 my $pass = join '' => @chars[map{ rand @chars }(1..42)]; 9269 9270 return $pass; 9271 9272} ## end of generate_password 9273 9274 9275sub process_simple_args { 9276 9277 ## Process args to an inner function in the style of a=b 9278 ## Arguments: one 9279 ## 1. Custom hashref 9280 ## Returns: db column hashref, columns string, placeholders string, 9281 ## values string, and 'extra' hashref 9282 9283 my $arg = shift; 9284 my $validcols = $arg->{cols} or die 'Need a list of valid cols!'; 9285 my $list = $arg->{list} or die 'Need a list of arguments!'; 9286 my $doc_section = $arg->{doc_section} or die 'Need a doc_section!'; 9287 9288 my %item; 9289 my %dbcol; 9290 my %extra; 9291 my %othername; 9292 9293 ## Transform array of x=y into a hashref 9294 my $xyargs = process_args(join ' ' => map { s/[=:]\s*(\w+ .*)/="$1"/; $_; } @$list); 9295 9296 ## Parse the validcols string, and setup any non-null defaults 9297 for my $row (split /\n/ => $validcols) { 9298 next if $row !~ /\w/ or $row =~ /^#/; 9299 $row =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(.+)/ or die "Invalid valid cols ($row)"; 9300 my ($args,$dbcol,$flag,$default) = ([split /\|/ => $1],$2,$3,$4); 9301 my $alias = @{$args}[-1]; 9302 for my $name (@$args) { 9303 $item{$name} = [$dbcol,$flag,$default]; 9304 $othername{$name} = $alias; 9305 } 9306 ## Process environment variable default 9307 if ($default =~ s/^ENV://) { 9308 for my $env (split /\|/ => $default) { 9309 if ($ENV{$env}) { 9310 9311 ## Skip if it starts with PG and this is not postgres 9312 next if $env =~ /^PG/ and exists $xyargs->{type} and $xyargs->{type} ne 'postgres'; 9313 9314 $dbcol{$dbcol} = $ENV{$env}; 9315 last; 9316 } 9317 } 9318 } 9319 elsif ($default ne 'null' and $default ne 'skip') { 9320 $dbcol{$dbcol} = $default; 9321 } 9322 } 9323 9324 for my $arg (sort keys %$xyargs) { 9325 9326 next if $arg eq 'extraargs'; 9327 9328 if (! exists $item{$arg}) { 9329 warn "Unknown option '$arg'\n"; 9330 usage_exit($doc_section); 9331 } 9332 9333 (my $val = $xyargs->{$arg}) =~ s/^\s*(\S+)\s*$/$1/; 9334 9335 if ($item{$arg}[2] eq 'skip') { 9336 $extra{$othername{$arg}} = $val; 9337 next; 9338 } 9339 9340 my ($dbcol,$flag,$default) = @{$item{$arg}}; 9341 if ($flag eq '0') { 9342 ## noop 9343 } 9344 elsif ($flag eq 'TF') { 9345 $val =~ s/^\s*t(?:rue)*\s*$/1/i; 9346 $val =~ s/^\s*f(?:alse)*\s*$/0/i; 9347 $val =~ s/^\s*on*\s*$/1/i; 9348 $val =~ s/^\s*off*\s*$/0/i; 9349 $val =~ s/^\s*yes*\s*$/1/i; 9350 $val =~ s/^\s*no*\s*$/0/i; 9351 if ($val !~ /^[01]$/) { 9352 die "Invalid value for '$arg': must be true or false\n"; 9353 } 9354 } 9355 elsif ($flag eq 'numeric') { 9356 if ($val !~ /^\d+$/) { 9357 die "Invalid value for '$arg': must be numeric\n"; 9358 } 9359 } 9360 elsif ($flag =~ /^=(.+)/) { 9361 my $ok = 0; 9362 for my $okval (split /\|/ => $1) { 9363 if ($okval =~ /~/) { ## aliases - force to the first one 9364 my @alias = split /~/ => $okval; 9365 for my $al (@alias) { 9366 if ($val eq $al) { 9367 $ok = 1; 9368 last; 9369 } 9370 } 9371 if ($ok) { 9372 $val = $alias[0]; 9373 last; 9374 } 9375 } 9376 elsif (lc $val eq lc $okval) { 9377 $ok = 1; 9378 last; 9379 } 9380 } 9381 if (!$ok) { 9382 (my $arglist = $flag) =~ s/\|/ or /g; 9383 $arglist =~ s/^=//; 9384 $arglist =~ s/~\w+//g; 9385 die "Invalid value for '$arg': must be one of $arglist\n"; 9386 } 9387 } 9388 elsif ($flag eq 'interval') { 9389 ## Nothing for now 9390 } 9391 else { 9392 die "Unknown flag '$flag' for $arg"; 9393 } 9394 9395 ## Value has survived our minimal checking. Store it and clobber any default 9396 $dbcol{$dbcol} = $val; 9397 9398 } 9399 9400 ## Apply any magic 9401 if (exists $arg->{morph}) { 9402 for my $mline (@{$arg->{morph}}) { 9403 if (exists $mline->{field}) { 9404 next unless exists $dbcol{$mline->{field}}; 9405 if (exists $mline->{new_defaults}) { 9406 for my $change (split /\s+/ => $mline->{new_defaults}) { 9407 my ($f,$v) = split /\|/ => $change; 9408 next if exists $dbcol{$f}; 9409 $dbcol{$f} = $v; 9410 } 9411 } 9412 if (exists $mline->{dash_to_white}) { 9413 $dbcol{$mline->{field}} =~ s/_/ /g; 9414 } 9415 } 9416 else { 9417 die "Do not know how to handle that morph!\n"; 9418 } 9419 } 9420 } 9421 9422 ## Automatic morphing magic 9423 if (exists $item{status} and ! exists $dbcol{status}) { 9424 for my $stat (qw/ active inactive /) { 9425 if (grep { $_ eq $stat } @{ $xyargs->{extraargs} }) { 9426 $dbcol{status} = $stat; 9427 } 9428 } 9429 } 9430 9431 ## Build the lists of columns and placeholders for the SQL statement 9432 my ($cols,$phs,$vals) = ('','',{}); 9433 for my $col (sort keys %dbcol) { 9434 $cols .= "$col,"; 9435 $phs .= '?,'; 9436 $vals->{$col} = $dbcol{$col}; 9437 } 9438 $cols =~ s/,$//; 9439 $phs =~ s/,$//; 9440 9441 return \%dbcol, $cols, $phs, $vals, \%extra; 9442 9443} ## end of process_simple_args 9444 9445 9446sub check_recurse { 9447 9448 ## Call a sub recursively depending on first argument 9449 ## Arguments: three or more 9450 ## 1. Type of thing (e.g. database) 9451 ## 2. Name of the thing 9452 ## 3. Any additional actions 9453 ## Returns: 0 or 1 9454 9455 my ($thing, $name, @actions) = @_; 9456 9457 my $caller = (caller(1))[3]; 9458 9459 ## If the name is 'all', recursively call on all objects of this type 9460 if ($name =~ /^all$/i) { 9461 for my $item (sort keys %$thing) { 9462 &$caller($item, @actions); 9463 } 9464 return 0; 9465 } 9466 9467 ## If we have a wildcard, recursively call all matching databases 9468 if ($name =~ s/[*%]/\.*/g) { 9469 my @list = grep { $_ =~ /^$name$/ } keys %$thing; 9470 if (! @list) { 9471 die qq{No matching items found\n}; 9472 } 9473 for my $item (sort @list) { 9474 &$caller($item, @actions); 9475 } 9476 return 0; 9477 } 9478 9479 return 1; 9480 9481} ## end of check_recurse 9482 9483 9484sub extract_name_and_role { 9485 9486 ## Given a group or db name with optional role information, return both 9487 ## Also returns optional list of other items, e.g. ABC:target:pri=2 9488 ## Arguments: one 9489 ## 1. Group or database name: 'foo' or 'foo:master' 9490 ## Returns: name, role name, and hashref of 'extra' info 9491 9492 my $name = shift or die; 9493 9494 ## Role always defaults to 'target' 9495 my $role = 'target'; 9496 9497 ## Check for a role attached to the group name 9498 if ($name =~ s/:([^:]+)//) { 9499 $role = lc $1; 9500 } 9501 9502 ## Look for any additional items 9503 my %extra; 9504 while ($name =~ s/:([^:]+)//) { 9505 my $extra = $1; 9506 if ($extra !~ /(\w+)=([\w\d]+)/) { 9507 die qq{Invalid value "$extra"\n}; 9508 } 9509 my ($lname,$val) = ($1,$2); 9510 if ($lname =~ /make?delta/i) { 9511 $extra{'makedelta'} = make_boolean($val); 9512 } 9513 elsif ($lname =~ /pri/i) { 9514 $extra{'priority'} = $val; 9515 } 9516 else { 9517 die qq{Unknown value "$lname": must be priority or makedelta\n}; 9518 } 9519 } 9520 9521 ## Valid group name? 9522 if ($name !~ /^[\w\d]+$/) { 9523 die "Invalid name: $name\n"; 9524 } 9525 9526 ## Valid role name? 9527 if ($role !~ /^(?:master|target|t|slave|rep|replica|source|s|fullcopy)$/) { 9528 die "Invalid database role: $role\n"; 9529 } 9530 9531 ## Standardize the names 9532 $role = 'source' if $role =~ /^(?:master|s)$/; 9533 $role = 'target' if $role =~ /^(?:slave|rep|replica|tar|t)$/; 9534 9535 return $name, $role, \%extra; 9536 9537} ## end of extract_name_and_role 9538 9539 9540sub load_bucardo_info { 9541 9542 ## Load of all information from the database into global hashes 9543 ## Arguments: one 9544 ## 1. Boolean: if true, force run even if we've run once already 9545 ## Returns: undef 9546 9547 my $force = shift || 0; 9548 9549 return if exists $global{db} and ! $force; 9550 9551 ## Grab all database information 9552 $SQL = 'SELECT *, EXTRACT(epoch FROM cdate) AS epoch FROM bucardo.db'; 9553 $sth = $dbh->prepare($SQL); 9554 $sth->execute(); 9555 my $db = $sth->fetchall_hashref('name'); 9556 9557 ## Grab all database information 9558 $SQL = 'SELECT * FROM bucardo.dbgroup'; 9559 $sth = $dbh->prepare($SQL); 9560 $sth->execute(); 9561 my $dbgroup = $sth->fetchall_hashref('name'); 9562 9563 ## Map databases to their groups 9564 $SQL = 'SELECT * FROM bucardo.dbmap'; 9565 $sth = $dbh->prepare($SQL); 9566 $sth->execute(); 9567 for my $row (@{$sth->fetchall_arrayref({})}) { 9568 $db->{$row->{db}}{group}{$row->{dbgroup}} = $row; 9569 9570 ## Tally up the roles each database fills 9571 $db->{$row->{db}}{roles}{$row->{role}}++; 9572 9573 ## Mark if this db is ever used as a source, for help in adding table 9574 $db->{$row->{db}}{issource}++ if $row->{role} eq 'source'; 9575 9576 $dbgroup->{$row->{dbgroup}}{db}{$row->{db}} = $row; 9577 } 9578 9579 ## Grab all goat information 9580 $SQL = 'SELECT * FROM bucardo.goat'; 9581 $sth = $dbh->prepare($SQL); 9582 $sth->execute(); 9583 9584 my $goat; 9585 $goat->{by_id} = $sth->fetchall_hashref('id'); 9586 $goat->{by_table} = {}; 9587 9588 for my $key (%{$goat->{by_id}}) { 9589 next if $key !~ /^\d/; 9590 my $tname = $goat->{by_id}{$key}{tablename}; 9591 my $name = "$goat->{by_id}{$key}{schemaname}.$tname"; 9592 my $dbname = $goat->{by_id}{$key}{db}; 9593 9594 ## Index by database, so different databases containing matching object 9595 ## names can be handled 9596 $goat->{by_db}{$dbname}{$name} = $goat->{by_id}{$key}; 9597 9598 ## Index by full object name 9599 if (! exists $goat->{by_fullname}{$name}) { 9600 $goat->{by_fullname}{$name} = [ $goat->{by_id}{$key} ]; 9601 } 9602 else { 9603 push @{$goat->{by_fullname}{$name}}, $goat->{by_id}{$key}; 9604 } 9605 9606 ## Also want a table-only version: 9607 $goat->{by_table}{$tname} = [] unless exists $goat->{by_table}{$tname}; 9608 push @{$goat->{by_table}{$tname}} => $goat->{by_id}{$key}; 9609 } 9610 9611 ## Grab all herd information 9612 $SQL = 'SELECT * FROM bucardo.herd'; 9613 $sth = $dbh->prepare($SQL); 9614 $sth->execute(); 9615 my $herd = $sth->fetchall_hashref('name'); 9616 9617 ## Grab all herdmap information, stick into previous hashes 9618 $SQL = 'SELECT * FROM bucardo.herdmap ORDER BY priority DESC, goat ASC'; 9619 $sth = $dbh->prepare($SQL); 9620 $sth->execute(); 9621 for my $row (@{$sth->fetchall_arrayref({})}) { 9622 my ($g,$h,$p) = @$row{qw/goat herd priority/}; 9623 $goat->{by_id}{$g}{herd}{$h} = $p; 9624 $herd->{$h}{goat}{"$goat->{by_id}{$g}{schemaname}.$goat->{by_id}{$g}{tablename}"} = { 9625 id => $g, 9626 priority => $p, 9627 reltype => $goat->{by_id}{$g}{reltype}, 9628 schema => $goat->{by_id}{$g}{schemaname}, 9629 table => $goat->{by_id}{$g}{tablename}, 9630 }; 9631 my ($s,$t) = @{$goat->{by_id}{$g}}{qw/schemaname tablename/}; 9632 $herd->{$h}{hasgoat}{$s}{$t} = $p; 9633 ## Assign each herd to a datbase via its included goats 9634 $herd->{$h}{db} = $goat->{by_id}{$g}{db}; 9635 } 9636 9637 ## Grab all sync information 9638 $SQL = 'SELECT * FROM bucardo.sync'; 9639 $sth = $dbh->prepare($SQL); 9640 $sth->execute(); 9641 my $sync; 9642 for my $row (@{$sth->fetchall_arrayref({})}) { 9643 my ($name,$p,$sherd,$dbs) = @$row{qw/name priority herd dbs/}; 9644 $sync->{$name} = $row; 9645 ## Add in herd information 9646 $sync->{$name}{herd} = $herd->{$sherd}; 9647 ## Add this sync back to the herd 9648 $herd->{$sherd}{sync}{$name}++; 9649 ## Grab the databases used by this sync 9650 $sync->{$name}{dblist} = $dbgroup->{$dbs}{db}; 9651 ## Map each database back to this sync, along with its type (source/target) 9652 for my $dbname (keys %{ $sync->{$name}{dblist} }) { 9653 $db->{$dbname}{sync}{$name} = $sync->{$name}{dblist}{$dbname}; 9654 } 9655 ## Note which syncs are used by each goat 9656 for my $row2 (sort keys %{$row->{herd}{goat}}) { 9657 $goat->{by_id}{$row2}{sync}{$name} = 1; 9658 } 9659 } 9660 9661 ## Grab all customcode information 9662 $SQL = 'SELECT * FROM bucardo.customcode'; 9663 $sth = $dbh->prepare($SQL); 9664 $sth->execute(); 9665 my $cc = $sth->fetchall_hashref('name'); 9666 $SQL = 'SELECT * FROM bucardo.customcode_map'; 9667 $sth = $dbh->prepare($SQL); 9668 $sth->execute(); 9669 my %codename; 9670 for my $row (values %$cc) { 9671 $codename{$row->{id}} = $row->{name}; 9672 } 9673 for my $row (@{$sth->fetchall_arrayref({})}) { 9674 my $codename = $codename{$row->{code}}; 9675 push @{$cc->{$codename}{map}} => $row; 9676 } 9677 9678 ## Grab all customname information 9679 $SQL = q{SELECT c.id, c.goat, c.newname, 9680COALESCE(c.sync, '') AS sync, 9681COALESCE(c.db, '') AS db, 9682g.schemaname || '.' || g.tablename AS tname 9683FROM bucardo.customname c 9684JOIN goat g ON (g.id = c.goat) 9685}; 9686 $sth = $dbh->prepare($SQL); 9687 $sth->execute(); 9688 $CUSTOMNAME = {}; 9689 for my $row (@{ $sth->fetchall_arrayref({}) }) { 9690 ## We store three versions 9691 9692 ## Look things up by the internal customname id: used for 'delete customname' 9693 ## Only one entry per id 9694 $CUSTOMNAME->{id}{$row->{id}} = $row; 9695 9696 ## Look things up by the goat id: used to check for existing entries 9697 ## Can have multiple entries per goat 9698 $CUSTOMNAME->{goat}{$row->{goat}}{$row->{db}}{$row->{sync}} = $row; 9699 9700 ## A simple list of all rows: used for 'list customnames' 9701 push @{ $CUSTOMNAME->{list} } => $row; 9702 } 9703 9704 ## Grab all customcols information 9705 $SQL = q{SELECT c.id, c.goat, c.clause, 9706COALESCE(c.sync, '') AS sync, 9707COALESCE(c.db, '') AS db, 9708g.schemaname || '.' || g.tablename AS tname 9709FROM bucardo.customcols c 9710JOIN goat g ON (g.id = c.goat) 9711}; 9712 $sth = $dbh->prepare($SQL); 9713 $sth->execute(); 9714 $CUSTOMCOLS = {}; 9715 for my $row (@{ $sth->fetchall_arrayref({}) }) { 9716 ## We store three versions: one for quick per-goat lookup, 9717 ## one by the assigned id, and one just a big list 9718 push @{ $CUSTOMCOLS->{goat}{$row->{goat}}{$row->{clause}} } => $row; 9719 $CUSTOMCOLS->{id}{$row->{id}} = $row; 9720 push @{ $CUSTOMCOLS->{list} } => $row; 9721 } 9722 9723 $global{cc} = $CUSTOMCODE = $cc; 9724 $global{dbgroup} = $DBGROUP = $dbgroup; 9725 $global{db} = $DB = $db; 9726 $global{goat} = $GOAT = $goat; 9727 $global{herd} = $HERD = $RELGROUP = $herd; 9728 $global{sync} = $SYNC = $sync; 9729 9730 ## Separate goat into tables and sequences 9731 for my $id (keys %{$GOAT->{by_id}}) { 9732 ## Ids only please 9733 next if $id !~ /^\d+$/; 9734 my $type = $GOAT->{by_id}{$id}{reltype}; 9735 if ($type eq 'table') { 9736 $TABLE->{$id} = $GOAT->{by_id}{$id}; 9737 } 9738 elsif ($type eq 'sequence') { 9739 $SEQUENCE->{$id} = $GOAT->{by_id}{$id}; 9740 } 9741 else { 9742 die "Unknown relation type $type!"; 9743 } 9744 } 9745 9746 ## Grab all clone information 9747 $SQL = qq{SELECT *, 9748 TO_CHAR(started,'$DATEFORMAT') AS pstarted, 9749 TO_CHAR(ended,'$DATEFORMAT') AS pended 9750 FROM bucardo.clone}; 9751 $sth = $dbh->prepare($SQL); 9752 $sth->execute(); 9753 $CLONE = {}; 9754 for my $row (@{ $sth->fetchall_arrayref({}) }) { 9755 $CLONE->{$row->{id}} = $row; 9756 } 9757 9758 return; 9759 9760} ## end of load_bucardo_info 9761 9762 9763sub transform_name { 9764 9765 ## Change a given word to a more standard form 9766 ## Generally used for database column names, which follow some simple rules 9767 ## Arguments: one 9768 ## 1. Name to transform 9769 ## Returns: transformed name 9770 9771 my $name = shift; 9772 9773 ## Complain right away if these are not standard characters 9774 if ($name !~ /^[\w ]+$/) { 9775 die "Invalid name: $name\n"; 9776 } 9777 9778 ## Change to lowercase 9779 $name = lc $name; 9780 9781 ## Change dashes and spaces to underscores 9782 $name =~ s{[- ]}{_}go; 9783 9784 ## Compress all underscores 9785 $name =~ s{__+}{_}go; 9786 9787 ## Fix common spelling errors 9788 $name =~ s{perpare}{prepare}go; 9789 9790 ## Look up standard abbreviations 9791 if (exists $alias{$name}) { 9792 $name = $alias{$name}; 9793 } 9794 9795 return $name; 9796 9797} ## end of transform_name 9798 9799 9800sub transform_value { 9801 9802 ## Change a value to a more standard form 9803 ## Used for database column SET actions 9804 ## Arguments: one 9805 ## 1. Value 9806 ## Returns: transformed value 9807 9808 my $value = shift; 9809 9810 ## Remove all whitespace on borders 9811 $value =~ s/^\s*(\S+)\s*$/$1/; 9812 9813 ## Change booleans to 0/1 9814 $value =~ s/^(?:t|true)$/1/io; 9815 $value =~ s/^(?:f|false)$/0/io; 9816 9817 return $value; 9818 9819} ## end of transform_value 9820 9821 9822sub make_boolean { 9823 9824 ## Transform some string into a strict boolean value 9825 ## Arguments: one 9826 ## 1. String to be analyzed 9827 ## Returns: the string literals 'true' or 'false' (unquoted) 9828 9829 my $value = shift; 9830 9831 $value = lc $value; 9832 9833 return 'true' if $value =~ /^(?:t|true|1|yes)$/o; 9834 9835 return 'false' if $value =~ /^f|false|0|no$/o; 9836 9837 die "Invalid value: must be 'true' of 'false'\n"; 9838 9839} ## end of make_boolean 9840 9841 9842sub standardize_rdbms_name { 9843 9844 ## Make the database types standard: account for misspellings, case, etc. 9845 ## Arguments: one 9846 ## 1. Name of a database type 9847 ## Returns: modified name 9848 9849 my $name = shift; 9850 9851 $name =~ s/postgres.*/postgres/io; 9852 $name =~ s/pg.*/postgres/io; 9853 $name =~ s/driz?zle.*/drizzle/io; 9854 $name =~ s/firebird/firebird/io; 9855 $name =~ s/mongo.*/mongo/io; 9856 $name =~ s/mysql.*/mysql/io; 9857 $name =~ s/maria.*/mariadb/io; 9858 $name =~ s/oracle.*/oracle/io; 9859 $name =~ s/redis.*/redis/io; 9860 $name =~ s/sqll?ite.*/sqlite/io; 9861 9862 return $name; 9863 9864} ## end of standardize_rdbms_name 9865 9866 9867sub find_best_db_for_searching { 9868 9869 ## Returns the db from $DB most likely to contain tables to add 9870 ## Basically, we use source ones first, then the date added 9871 ## Arguments: none 9872 ## Returns: database name or undef if no databases defined yet 9873 9874 for my $db ( 9875 map { $_->[0] } 9876 sort { 9877 ## Source databases are always first 9878 $a->[1] <=> $b->[1] 9879 ## First created are first 9880 or $a->[2] <=> $b->[2] 9881 ## All else fails, sort by name 9882 or $a->[0] cmp $b->[0] } 9883 map { [ 9884 $_, 9885 exists $DB->{$_}{issource} ? 0 : 1, 9886 $DB->{$_}{epoch}, 9887 lc $_, 9888 ] 9889 } 9890 keys %{ $DB } ) { 9891 return $db; 9892 } 9893 9894 ## Probably an error, but let the caller handle it: 9895 9896 return undef; 9897 9898} ## end of find_best_db_for_searching 9899 9900 9901## 9902## Subs to perform common SQL actions 9903## 9904 9905sub confirm_commit { 9906 9907 ## Perform a database commit unless the user does not want it 9908 ## Arguments: none 9909 ## Returns: true for commit, false for rollback 9910 9911 ## The dryrun option overrides everything else: we never commit 9912 if ($bcargs->{dryrun}) { 9913 $VERBOSE and print "In dryrun mode, so not going to commit database changes\n"; 9914 return 0; 9915 } 9916 9917 if ($bcargs->{confirm}) { 9918 print 'Commit the changes? Y/N '; 9919 if (<STDIN> !~ /Y/i) { 9920 $dbh->rollback(); 9921 print "Changes have been rolled back\n"; 9922 return 0; 9923 } 9924 else { 9925 $dbh->commit(); 9926 print "Changes have been committed\n"; 9927 } 9928 } 9929 else { 9930 $dbh->commit(); 9931 } 9932 9933 return 1; 9934 9935} ## end of confirm_commit 9936 9937 9938sub add_db_to_group { 9939 9940 ## Add a database to a group 9941 ## Will create the group as needed 9942 ## Does not commit 9943 ## Arguments: two 9944 ## 1. Database name 9945 ## 2. Group name (may have :role specifier) 9946 ## Returns: group name and role name 9947 9948 my ($db,$fullgroup) = @_; 9949 9950 ## Figure out the role. Defaults to target 9951 my ($group,$role) = extract_name_and_role($fullgroup); 9952 9953 if (! exists $DBGROUP->{$group}) { 9954 ## Extra argument prevents load_bucardo_info from being called by the sub 9955 create_dbgroup($group, 1); 9956 } 9957 9958 $SQL = 'INSERT INTO bucardo.dbmap(db,dbgroup,role) VALUES (?,?,?)'; 9959 $sth = $dbh->prepare($SQL); 9960 eval { 9961 $sth->execute($db,$group,$role); 9962 }; 9963 if ($@) { 9964 my $message = qq{Cannot add database "$db" to dbgroup "$group"}; 9965 if ($@ =~ /"dbmap_unique"/) { 9966 die qq{$message: already part of the group\n}; 9967 } 9968 die qq{$message: $@\n}; 9969 } 9970 9971 ## Reload our hashes 9972 load_bucardo_info(1); 9973 9974 return $group, $role; 9975 9976} ## end of add_db_to_group 9977 9978 9979sub remove_db_from_group { 9980 9981 ## Removes a database from a group: deletes from bucardo.dbmap 9982 ## Does not commit 9983 ## Arguments: two 9984 ## 1. Database name 9985 ## 2. Group name 9986 ## 3. Boolean: if true, prevents the reload 9987 ## Returns: undef 9988 9989 my ($db,$group,$noreload) = @_; 9990 9991 $SQL = 'DELETE FROM bucardo.dbmap WHERE db=? AND dbgroup=?'; 9992 $sth = $dbh->prepare_cached($SQL); 9993 $sth->execute($db, $group); 9994 9995 ## Reload our hashes 9996 $noreload or load_bucardo_info(1); 9997 9998 return; 9999 10000} ## end of remove_db_from_group 10001 10002 10003sub change_db_role { 10004 10005 ## Changes the role of a database: updates bucardo.dbmap 10006 ## Does not commit 10007 ## Arguments: four 10008 ## 1. New role 10009 ## 2. Name of the dbgroup 10010 ## 3. Name of the database 10011 ## 4. Boolean: if true, prevents the reload 10012 ## Returns: undef 10013 10014 my ($role,$group,$db,$noreload) = @_; 10015 10016 $SQL = 'UPDATE bucardo.dbmap SET role=? WHERE dbgroup=? AND db=?'; 10017 $sth = $dbh->prepare_cached($SQL); 10018 $sth->execute($role,$group,$db); 10019 10020 ## Reload our hashes 10021 $noreload or load_bucardo_info(1); 10022 10023 return; 10024 10025} ## end of change_db_role 10026 10027 10028sub update_dbmap { 10029 10030 ## Update the values in the bucardo.dbmap table 10031 ## Arguments: three 10032 ## 1. Name of the database 10033 ## 2. Name of the dbgroup 10034 ## 3. Hashref of things to change 10035 ## Returns: undef 10036 10037 my ($db,$group,$changes) = @_; 10038 10039 ## This should not need quoting as they are all [\w\d] 10040 my $list = join ',' => map { "$_=$changes->{$_}" } sort keys %$changes; 10041 10042 $SQL = "UPDATE bucardo.dbmap SET $list WHERE db=? AND dbgroup=?"; 10043 $sth = $dbh->prepare($SQL); 10044 $sth->execute($db, $group); 10045 10046 return; 10047 10048} ## end of update_dbmap 10049 10050 10051sub create_herd { 10052 10053 ## Creates a new entry in the bucardo.herd table 10054 ## Caller should have already checked for existence 10055 ## Does not commit 10056 ## Arguments: two 10057 ## 1. Name of the new herd 10058 ## 2. Boolean: if true, prevents the reload 10059 ## Returns: name of the herd just created 10060 10061 my ($name,$noreload) = @_; 10062 10063 $SQL = 'INSERT INTO bucardo.herd(name) VALUES (?)'; 10064 $sth = $dbh->prepare($SQL); 10065 eval { 10066 $sth->execute($name); 10067 }; 10068 if ($@) { 10069 print qq{Failed to create relgroup "$name"\n$@\n}; 10070 exit 1; 10071 } 10072 10073 ## Reload our hashes 10074 $noreload or load_bucardo_info(1); 10075 10076 return $name; 10077 10078} ## end of create_herd 10079 10080 10081__END__ 10082 10083=head1 NAME 10084 10085bucardo - utility script for controlling the Bucardo program 10086 10087=head1 VERSION 10088 10089This document describes version 5.6.0 of bucardo 10090 10091=head1 USAGE 10092 10093 bucardo [<options>] <command> [<action>] [<command-options>] [<command-params>] 10094 10095=head1 DESCRIPTION 10096 10097The bucardo script is the main interaction to a running Bucardo instance. It 10098can be used to start and stop Bucardo, add new items, kick syncs, and even 10099install and upgrade Bucardo itself. For more complete documentation, please 10100view L<the wiki|https://bucardo.org/>. 10101 10102=head1 COMMANDS 10103 10104Run C<< bucardo help <command> >> for additional details 10105 10106=over 10107 10108=item C<install> 10109 10110Installs the Bucardo configuration database. 10111 10112=item C<upgrade> 10113 10114Upgrades the Bucardo configuration database to the latest schema. 10115 10116=item C<< start [<start options>] [<reason>] >> 10117 10118Starts Bucardo. 10119 10120=item C<< stop [<reason>] >> 10121 10122Stops Bucardo. 10123 10124=item C<< restart [<start options>] [<reason>] >> 10125 10126Stops and starts Bucardo. 10127 10128=item C<< list <type> [<regex>] >> 10129 10130Lists objects managed by Bucardo. 10131 10132=item C<< add <type> <name> <parameters> >> 10133 10134Adds a new object. 10135 10136=item C<< update <type> <name> <parameters> >> 10137 10138Updates an object. 10139 10140=item C<< remove <type> <name> [<name>...] >> 10141 10142Removes one or more objects. 10143 10144=item C<< kick <syncname> [<sync options>] [<syncname>...] [<timeout>] >> 10145 10146Kicks off one or more syncs. 10147 10148=item C<reload config> 10149 10150Sends a message to all CTL and KID processes asking them to reload the Bucardo 10151configuration. 10152 10153=item C<reopen> 10154 10155Sends a message to all Bucardo processes asking them to reopen any log files 10156they may have open. Call this after you have rotated the log file(s). 10157 10158=item C<< show all|<setting> [<setting>...] >> 10159 10160Shows the current Bucardo settings. 10161 10162=item C<<set <setting=value> [<setting=value>...] >> 10163 10164Sets one or more configuration setting.. 10165 10166=item C<< ping [<timeout>] >> 10167 10168Sends a ping notice to the MCP process to see if it will respond. 10169 10170=item C<< status [<status options>] <syncname> [<syncname>...] >> 10171 10172Shows the brief status of syncs in a tabular format. 10173 10174=item C<< activate <syncname> [<syncname>...] [<timeout>] >> 10175 10176Activates one or more named syncs. 10177 10178=item C<< deactivate <syncname> [<syncname>...] [<timeout>] >> 10179 10180Deactivates one or more named syncs. 10181 10182=item C<< message '<body>' >> 10183 10184Sends a message to the running Bucardo logs. 10185 10186=item C<< reload [<syncname> [<syncname>...]] >> 10187 10188Sends a message to one or more sync processes, instructing them to reload. 10189 10190=item C<< inspect <type> <name> [<name>...] >> 10191 10192Inspects one or more objects of a particular type. 10193 10194=item C<< validate all|<syncname> [<syncname>...] >> 10195 10196Validates one or more syncs. 10197 10198=item C<< purge all|<table> [<table>...] >> 10199 10200Purges the delta and track tables for one or more tables, for one or more 10201databases. 10202 10203=item C<< delta [<database(s)>] >> 10204 10205Show the delta counts for each source target. 10206 10207=item C<< help [<command> [<action>]] >> 10208 10209Shows help. 10210 10211=back 10212 10213=head1 OPTIONS 10214 10215 -d --db-name NAME Database name. 10216 -U --db-user USER Database user name. 10217 -P --db-pass PASS Database password. 10218 -h --db-host HOST Database server host name. 10219 -p --db-port PORT Database server port number. 10220 --bucardorc FILE Use specified .bucardorc file. 10221 --no-bucardorc Do not use .bucardorc file. 10222 --quiet Incremental quiet. 10223 --verbose Incremental verbose mode. 10224 -? --help Output basic help and exit. 10225 --version Print the version number and exit. 10226 --dryrun Do not perform any actual actions. 10227 --confirm Require direct confirmation before changes. 10228 10229=head1 COMMAND DETAILS 10230 10231Most of the commands take parameters. These may be passed after the command 10232name and, where appropriate, an object name. Parameters take the form of 10233key/value pairs separated by an equal sign (C<=>). For example: 10234 10235 bucardo add db sea_widgets dbname=widgets host=db.example.com 10236 10237Here C<dbname> and <host> are parameters. 10238 10239Many of the commands also use command-line options, which are specified in the 10240normal way. For example, the C<bucardo add db> command could also be written 10241as: 10242 10243 bucardo add db sea_widgets --dbname widgets --dbhost db.example.com 10244 10245However, parameters and options are not directly interchangeable in all cases. 10246See the documentation for individual commands for their supported options. 10247 10248=head2 install 10249 10250 bucardo install 10251 10252Installs the Bucardo schema from the file F<bucardo.schema> into an existing Postgres cluster. 10253The user "bucardo" and database "bucardo" will be created first as needed. This is an 10254interactive installer, but you can supply the following values from the command line: 10255 10256=over 10257 10258=item C<--dbuser> 10259 10260defaults to postgres 10261 10262=item C<--dbname> 10263 10264defaults to postgres 10265 10266=item C<--dbport> 10267 10268defaults to 5432 10269 10270=item C<--pid-dir> 10271 10272defaults to /var/run/bucardo/ 10273 10274=back 10275 10276=head2 upgrade 10277 10278 bucardo upgrade 10279 10280Upgrades an existing Bucardo installation to the current version of the bucardo database 10281script. Requires that bucardo and the F<bucardo.schema> file be the same version. All 10282changes should be backwards compatible, but you may need to re-validate existing scripts 10283to make sure changes get propagated to all databases. 10284 10285=head2 start 10286 10287 bucardo start "Reason" 10288 10289Starts Bucardo. Fails if the MCP process is running (determined if its PID file is present). 10290Otherwise, starts cleanly by first issuing the equivalent of a stop to ask any existing Bucardo 10291processes to exit, and then starting a new Bucardo MCP process. A short reason and name should 10292be provided - these are written to the C<reason_file> file (F<./bucardo.restart.reason.txt> by 10293default) and sent in the email sent when Bucardo has been started up. It is also appended to 10294the reason log, which has the same name as the the C<reason_file> but ends in F<.log>. 10295 10296The options for the C<start> command are: 10297 10298=over 10299 10300=item C<--sendmail> 10301 10302Tells Bucardo whether or not to send mail on interesting events: startup, 10303shutdown, and errors. Default is on. 10304 10305=item C<--extra-name string> 10306 10307A short string that will be appended to the version string as output by the 10308Bucardo process names. Mostly useful for debugging. 10309 10310=item C<--log-destination destination> 10311 10312Determines the destination for logging output. The supported values are: 10313 10314=over 10315 10316=item C<stderr> 10317 10318=item C<stdout> 10319 10320=item C<syslog> 10321 10322=item C<none> 10323 10324=item A file system directory. 10325 10326=back 10327 10328May be specified more than once, which is useful for, e.g., logging both to a 10329directory and to syslog. If C<--log-destination> is not specified at all, the 10330default is to log to files in F</var/log/bucardo>. 10331 10332=item C<--log-separate> 10333 10334Forces creation of separate log files for each Bucardo process of the form 10335"log.bucardo.X.Y", where X is the type of process (MCP, CTL, or KID), and Y is 10336the process ID. 10337 10338=item C<--log-extension string> 10339 10340Appends the given string to the end of the default log file name, 10341F<log.bucardo>. A dot is added before the name as well, so a log extension of 10342"rootdb" would produce a log file named F<log.bucardo.rootdb>. 10343 10344=item C<--log-clean> 10345 10346Forces removal of all old log files before running. 10347 10348=item C<--debug> 10349 10350=item C<--no-debug> 10351 10352Enable or disable debugging output. Disabled by default. 10353 10354=item C<--exit-on-nosync> 10355 10356=item C<--no-exit-on-nosync> 10357 10358On startup, if Bucardo finds no active syncs, it normally will continue to 10359run, requiring a restart once syncs are added. This is useful for startup 10360scripts and whatnot. 10361 10362If, however, you want it to exit when there are no active syncs, pass the 10363C<--exit-on-nosync> option. You can also be explicit that it should I<not> 10364exit when there are no syncs by passing C<--no-exit-on-nosync>. This is the 10365default value. 10366 10367=back 10368 10369=head2 stop 10370 10371 bucardo stop "Reason" 10372 10373Forces Bucardo to quit by creating a stop file which all MCP, CTL, and KID processes should 10374detect and cause them to exit. Note that active syncs will not exit right away, as they 10375will not look for the stop file until they have finished their current run. Typically, 10376you should scan the list of processes after running this program to make sure that all Bucardo 10377processes have stopped. One should also provide a reason for issuing the stop - usually 10378this is a short explanation and your name. This is written to the C<reason_file> file 10379(F<./bucardo.restart.reason.txt> by default) and is also used by Bucardo when it exits and 10380sends out mail about its death. It is also appended to the reason log, which has the same name 10381as the the C<reason_file> but ends in F<.log>. 10382 10383=head2 restart 10384 10385 bucardo restart "Reason" 10386 10387Stops bucardo, waits for the stop to complete, and then starts it again. 10388Supports the same options as <C<start>/start>. Useful for start scripts. For 10389getting just CTL and KID processes to recognize newly added, updated, or 10390removed objects, use the C<reload> command, instead. 10391 10392=head2 list 10393 10394 bucardo list <type> <regex> 10395 10396Lists summary information about Bucardo objects. The supported types are: 10397 10398=over 10399 10400=item * C<database> 10401 10402=item * C<dbgroup> 10403 10404=item * C<relgroup> 10405 10406=item * C<sync> 10407 10408=item * C<table> 10409 10410=item * C<sequence> 10411 10412=item * C<customcode> 10413 10414=item * C<customname> 10415 10416=item * C<customcols> 10417 10418=item * C<all> 10419 10420=back 10421 10422The C<all> option will list information about all object types. 10423 10424The optional C<regex> option can be used to filter the list to only those 10425matching a regular expression. 10426 10427=head2 add 10428 10429 bucardo add <type> <name> <parameters> 10430 10431Adds a new object to Bucardo. The C<type> specifies the type of object to add, 10432while the C<name> should be the name of the object. The supported types 10433include: 10434 10435=over 10436 10437=item C<db> 10438 10439=item C<dbgroup> 10440 10441=item C<table> 10442 10443=item C<sequence> 10444 10445=item C<all tables> 10446 10447=item C<all sequences> 10448 10449=item C<relgroup> 10450 10451=item C<sync> 10452 10453=item C<customname> 10454 10455=item C<customcols> 10456 10457=back 10458 10459=head3 add db 10460 10461 bucardo add db <name> dbname=actual_name port=xxx host=xxx user=xxx 10462 10463Adds one or more new databases. The C<name> is the name by which the database will be 10464known to Bucardo, and must be unique. This may vary from the actual database 10465name, as multiple hosts might have databases with the same name. Multiple databases 10466can be added by separating the names with commas. Options that differ between the 10467databases should be separated by a matching commas. Example: 10468 10469 bucardo add db alpha,beta dbname=sales host=aa,bb user=bucardo 10470 10471This command will attempt an immediate test connection to the added database(s). 10472The supported named parameters are: 10473 10474=over 10475 10476=item C<dbname> 10477 10478The actual name of the database. Required unless using a service file or setting it via dbdsn. 10479 10480=item C<type> 10481 10482The type of the database. Defaults to C<postgres>. Currently supported values are: 10483 10484=over 10485 10486=item * C<postgres> 10487 10488=item * C<drizzle> 10489 10490=item * C<mongo> 10491 10492=item * C<mysql> 10493 10494=item * C<maria> 10495 10496=item * C<oracle> 10497 10498=item * C<redis> 10499 10500=item * C<sqlite> 10501 10502=back 10503 10504=item C<dbdsn> 10505 10506A direct DSN to connect to a database. Will override all other connection options if set. 10507 10508=item C<user> 10509 10510The username Bucardo should use when connecting to this database. 10511 10512=item C<pass> 10513 10514The password Bucardo should use when connecting to this database. It is recommended 10515that you use a .pgpass file rather than entering the password here. 10516 10517=item C<host> 10518 10519The host Bucardo should use when connecting to this database. Defaults to the value of the C<$PGHOSTADDR> 10520or C<$PGHOST> environment variables, if present. 10521 10522=item C<port> 10523 10524The port Bucardo should use when connecting to this database. Defaults to the value of the C<$PGPORT> 10525environment variable, if present. 10526 10527=item C<conn> 10528 10529Additional connection parameters, e.g. C<sslmode=require>. 10530 10531=item C<service> 10532 10533The service name Bucardo should use when connecting to this database. 10534 10535=item C<status> 10536 10537Initial status of this database. Defaults to "active" but can be set to "inactive". 10538 10539=item C<dbgroup> 10540 10541Name of the database group this database should belong to. 10542 10543=item C<addalltables> 10544 10545Automatically add all tables from this database. 10546 10547=item C<addallsequences> 10548 10549Automatically add all sequences from this database. 10550 10551=item C<server_side_prepares> 10552 10553=item C<ssp> 10554 10555Set to 1 or 0 to enable or disable server-side prepares. Defaults to 1. 10556 10557=item C<makedelta> 10558 10559Set to 1 or 0 to enable or disable makedelta. Defaults to 0. 10560 10561=back 10562 10563Additional parameters: 10564 10565=over 10566 10567=item C<--force> 10568 10569Forces the database to be added without running a connection test. 10570 10571=back 10572 10573B<Note:> As a convenience, if the C<dbuser> value is its default value, 10574"bucardo", in the event that Bucardo cannot connect to the database, it will 10575try connecting as "postgres" and create a superuser named "bucardo". This is 10576to make things easier for folks getting started with Bucardo, but will not 10577work if it cannot connect as "postgres", or if it the connection failed due to 10578an authentication failure. 10579 10580=head3 add dbgroup 10581 10582 bucardo add dbgroup name db1:source db2:source db3:target ... 10583 10584Adds one or more databases to the named dbgroup. If the dbgroup 10585doesn't exist, it will be created. The database parameters should specify 10586their roles, either "source" or "target". 10587 10588=head3 add table 10589 10590 bucardo add table [schema].table db=actual_db_name 10591 10592Adds a table object. The table information will be read from the specified 10593database. Supported parameters: 10594 10595=over 10596 10597=item C<db> 10598 10599The name of the database from which to read the table information. Should be a 10600name known to Bucardo, thanks to a previous call to C<add database>. Required. 10601 10602=item C<autokick> 10603 10604Boolean indicating whether or not the table should automatically send kick 10605messages when it's modified. Overrides the C<autokick> parameter of any syncs 10606of which the table is a part. 10607 10608=item C<rebuild_index> 10609 10610Boolean indicating whether or not to rebuild indexes after every sync. Off by 10611default. Optional. 10612 10613=item C<analyze_after_copy> 10614 10615Boolean indicating whether or not to analyze the table after every sync. Off 10616by default. Optional. 10617 10618=item C<vacuum_after_copy> 10619 10620Boolean indicating whether or not to vacuum the table after every sync. Off by 10621default. Optional. 10622 10623=item C<relgroup> 10624 10625Adds the table to the named relgroup. If the relgroup does not 10626exist, it will be created. Optional. 10627 10628=item C<makedelta> 10629 10630Turns makedelta magic on or off. Value is a list of databases which need makedelta 10631for this table. Value can also be "on" to enable makedelta for all databases. 10632Defaults to "off". 10633 10634=item C<strict_checking> 10635 10636Boolean indicating whether or not to be strict when comparing the table 10637between syncs. If the columns have different names or data types, the 10638validation will fail. But perhaps the columns are allowed to have different 10639names or data types. If so, disable C<strict_checking> and column differences will 10640result in warnings rather than failing the validation. Defaults to true. 10641 10642=back 10643 10644=head3 add sequence 10645 10646 bucardo add sequence [schema].sequence relgroup=xxx 10647 10648=over 10649 10650=item C<db> 10651 10652The name of the database from which to read the sequence information. Should 10653be a name known to Bucardo, thanks to a previous call to C<add database>. 10654Required. 10655 10656=item C<relgroup> 10657 10658Adds the sequence to the named relgroup. If the relgroup does not 10659exist, it will be created. Optional. 10660 10661=back 10662 10663=head3 add all tables 10664 10665 bucardo add all tables [relgroup=xxx] [pkonly] 10666 10667Adds all the tables in all known databases or in a specified database. 10668Excludes tables in the C<pg_catalog>, C<information_schema>, and C<bucardo> 10669schemas. (Yes, this means that you cannot replicate the Bucardo configuration 10670database using Bucardo. Sorry about that.) Supported options and parameters: 10671 10672=over 10673 10674=item C<db> 10675 10676=item C<--db> 10677 10678Name of the database from which to find all the tables to add. If not 10679provided, tables will be added from all known databases. 10680 10681=item C<schema> 10682 10683=item C<--schema> 10684 10685=item C<-n> 10686 10687Limit to the tables in the specified comma-delimited list of schemas. The 10688options may be specified more than once. 10689 10690=item C<exclude-schema> 10691 10692=item C<--exclude-schema> 10693 10694=item C<-N> 10695 10696Exclude tables in the specified comma-delimited list of schemas. The options 10697may be specified more than once. 10698 10699=item C<table> 10700 10701=item C<--table> 10702 10703=item C<-t> 10704 10705Limit to the specified tables. The options may be specified more than once. 10706 10707=item C<exclude-table> 10708 10709=item C<--exclude-table> 10710 10711=item C<-T> 10712 10713Exclude the specified tables. The options may be specified more than once. 10714 10715=item C<relgroup> 10716 10717=item C<--relgroup> 10718 10719Name of the relgroup to which to add new tables. 10720 10721=item C<pkonly> 10722 10723Exclude tables without primary keys. 10724 10725=back 10726 10727=head3 add all sequences 10728 10729 bucardo add all sequences relgroup=xxx 10730 10731Adds all the sequences in all known databases or in a specified database. 10732Excludes sequences in the C<pg_catalog>, C<information_schema>, and C<bucardo> 10733schemas. (Yes, this means that you cannot replicate the Bucardo configuration 10734database using Bucardo. Sorry about that.) Supported options and parameters: 10735 10736=over 10737 10738=item C<db> 10739 10740=item C<--db> 10741 10742Name of the database from which to find all the sequences to add. If not 10743provided, sequences will be added from all known databases. 10744 10745=item C<schema> 10746 10747=item C<--schema> 10748 10749=item C<-n> 10750 10751Limit to the sequences in the specified comma-delimited list of schemas. The 10752options may be specified more than once. 10753 10754=item C<exclude-schema> 10755 10756=item C<--exclude-schema> 10757 10758=item C<-N> 10759 10760Exclude sequences in the specified comma-delimited list of schemas. The 10761options may be specified more than once. 10762 10763=item C<relgroup> 10764 10765=item C<--relgroup> 10766 10767Name of the relgroup to which to add new tables or sequences. 10768 10769=back 10770 10771=head3 add relgroup 10772 10773 bucardo add relgroup name 10774 bucardo add relgroup name table, sequence, ... 10775 10776Adds a relgroup. After the name, pass in an optional list of tables 10777and/or sequences and they will be added to the group. 10778 10779=head3 add sync 10780 10781 bucardo add sync name relgroup=xxx dbs=xxx 10782 10783Adds a sync, which is a named replication event containing information about 10784what to replicate from where to where. The supported parameters are: 10785 10786=over 10787 10788=item C<dbs> 10789 10790The name of a dbgroup or comma-delimited list of databases. All of the 10791specified databases will be synchronized. Required. 10792 10793=item C<dbgroup> 10794 10795The name of a dbgroup. All of the databases within this group will be 10796part of the sync. If the dbgroup does not exists and a separate list 10797of databases is given, the group will be created and populated. 10798 10799=item C<relgroup> 10800 10801The name of a relgroup to synchronize. All of the tables and/or 10802sequences in the relgroup will be synchronized. Required unless C<tables> is 10803specified. 10804 10805=item C<tables> 10806 10807List of tables to add to the sync. This implicitly creates a relgroup 10808with the same name as the sync. Required unless C<relgroup> is specified. 10809 10810=item C<status> 10811 10812Indicates whether or not the sync is active. Must be either "active" or 10813"inactive". Defaults to "active". 10814 10815=item C<rebuild_index> 10816 10817Boolean indicating whether or not to rebuild indexes after every sync. 10818Defaults to off. 10819 10820=item C<lifetime> 10821 10822Number of seconds a KID can live before being reaped. No limit by default. 10823 10824=item C<maxkicks> 10825 10826Number of times a KID may be kicked before being reaped. No limit by default. 10827 10828=item C<conflict_strategy> 10829 10830The conflict resolution strategy to use in the sync. Supported values: 10831 10832=over 10833 10834=item C<bucardo_source> 10835 10836The rows on the "source" database always "win". In other words, in a conflict, 10837Bucardo copies rows from source to target. 10838 10839=item C<bucardo_target> 10840 10841The rows on the "target" database always win. 10842 10843=item C<bucardo_skip> 10844 10845Any conflicting rows are simply not replicated. Not recommended for most 10846cases. 10847 10848=item C<bucardo_random> 10849 10850Each database has an equal chance of winning each time. This is the default. 10851 10852=item C<bucardo_latest> 10853 10854The row that was most recently changed wins. 10855 10856=item C<bucardo_abort> 10857 10858The sync is aborted on a conflict. 10859 10860=back 10861 10862=item C<onetimecopy> 10863 10864Determines whether or not a sync should switch to a full copy mode for a 10865single run. Supported values are: 10866 10867=over 10868 10869=item 0: off 10870 10871=item 1: always full copy 10872 10873=item 2: only copy tables that are empty on the target 10874 10875=back 10876 10877=item C<stayalive> 10878 10879Boolean indicating whether or not the sync processes (CTL) should be 10880persistent. Defaults to false. 10881 10882=item C<kidsalive> 10883 10884Boolean indicating whether or not the sync child processes (KID) should be 10885persistent. Defaults to false. 10886 10887=item C<autokick> 10888 10889Boolean indicating whether or not tables in the sync should automatically send 10890kick messages when they're modified. May be overridden by the C<autokick> 10891parameter of individual tables. 10892 10893=item C<checktime> 10894 10895An interval specifying the maximum time a sync should go before being 10896kicked. Useful for busy systems where you don't want the overhead of notify 10897triggers. 10898 10899=item C<priority> 10900 10901An integer indicating the priority of the sync. Lower numbers are higher 10902priority. Currently used only for display purposes. 10903 10904=item C<analyze_after_copy> 10905 10906Boolean indicating whether or not to analyze tables after every sync. Off by 10907default. Optional. 10908 10909=item C<overdue> 10910 10911An interval specifying the amount of time after which the sync has not run 10912that it should be considered overdue. C<check_bucardo_sync> issues a warning 10913when a sync has not been run in this amount of time. 10914 10915=item C<expired> 10916 10917An interval specifying the amount of time after which the sync has not run 10918that it should be considered expired. C<check_bucardo_sync> issues a critical 10919message when a sync has not been run in this amount of time. 10920 10921=item C<track_rates> 10922 10923Boolean indicating whether or not to track synchronization rates. 10924 10925=item C<rebuild_index> 10926 10927Boolean indicating whether or not to rebuild indexes after every sync. Off by 10928default. Optional. 10929 10930=item C<strict_checking> 10931 10932Boolean indicating whether or not to be strict when comparing tables in the 10933sync. If the columns have different names or data types, the validation will 10934fail. But perhaps the columns are allowed to have different names or data 10935types. If so, disable C<strict_checking> and column differences will result in 10936warnings rather than failing the validation. Defaults to true. 10937 10938=back 10939 10940=head3 add customname 10941 10942 bucardo add customname oldname newname [db=name] [sync=name] 10943 10944Creates a new Bucardo custom name mapping. This allows the tables involved in 10945replication to have different names on different databases. The C<oldname> 10946must contain the schema as well as the table name (if the source database 10947supports schemas). The optional parameters limit it to one or more databases, 10948and/or to one or more syncs. Supported parameters: 10949 10950=over 10951 10952=item C<sync> 10953 10954A sync to which to add the customname. May be specified multiple times. 10955 10956=item C<database> 10957 10958=item C<db> 10959 10960A database for which to add the customname. May be specified multiple times. 10961 10962=back 10963 10964=head3 add customcols 10965 10966 bucardo add customcols tablename select_clause [sync=x db=x] 10967 10968Specify the list of columns to select from when syncing. Rather than the 10969default C<SELECT *> behavior, you can specify any columns you want, including 10970the use of function call return values and things not in the source column 10971list. The optional parameters limit it to one or more databases, and/or to one 10972or more syncs. Some examples: 10973 10974 bucardo add customcols public.foobar "select a, b, c" 10975 bucardo add customcols public.foobar "select a, upper(b) AS b, c" db=foo 10976 bucardo add customcols public.foobar "select a, b, c" db=foo sync=abc 10977 10978Supported parameters: 10979 10980=over 10981 10982=item C<sync> 10983 10984A sync to which to add the customcols. May be specified multiple times. 10985 10986=item C<database> 10987 10988=item C<db> 10989 10990A database for which to add the customcols. May be specified multiple times. 10991 10992=back 10993 10994=head3 add customcode 10995 10996 bucardo add customcode <name> <whenrun=value> <src_code=filename> [optional information] 10997 10998Adds a customcode, which is a Perl subroutine that can be run at certain 10999points in the sync process. It might handle exceptions, handle conflicts, or 11000just run at certain times with no expectation of functionality (e.g., before 11001Bucardo drops triggers). Metadata about that point will be passed to the 11002subroutine as a hash reference. 11003 11004Supported parameters: 11005 11006=over 11007 11008=item C<name> 11009 11010The name of the custom code object. 11011 11012=item C<about> 11013 11014A short description of the custom code. 11015 11016=item C<whenrun> 11017 11018=item C<when_run> 11019 11020A string indicating when the custom code should be run. Supported values 11021include: 11022 11023=over 11024 11025=item C<before_txn> 11026 11027=item C<before_check_rows> 11028 11029=item C<before_trigger_drop> 11030 11031=item C<after_trigger_drop> 11032 11033=item C<after_table_sync> 11034 11035=item C<exception> 11036 11037=item C<conflict> 11038 11039=item C<before_trigger_enable> 11040 11041=item C<after_trigger_enable> 11042 11043=item C<after_txn> 11044 11045=item C<before_sync> 11046 11047=item C<after_sync> 11048 11049=back 11050 11051=item C<getdbh> 11052 11053Boolean indicating whether or not Perl L<DBI> database handles should be 11054provided to the custom code subroutine. If true, database handles will be 11055provided under the C<dbh> key of the hash reference passed to the subroutine. 11056The value under this key will be a hash reference mapping database names to 11057their respective handles. 11058 11059=item C<sync> 11060 11061Name of the sync with which to associate the custom code. Cannot be used in 11062combination with C<relation>. 11063 11064=item C<relation> 11065 11066Name of the table or sequence with which to associate the custom code. Cannot 11067be used in combination with C<sync>. 11068 11069=item C<status> 11070 11071The current status of this customcode. Anything other than "active" means the 11072code is not run. 11073 11074=item C<priority> 11075 11076Number indicating the priority in which order to execute custom codes. Lower numbers 11077are higher priority. Useful for subroutines that set C<lastcode> in order to 11078cancel the execution of subsequent custom codes for the same C<when_run>. 11079 11080=item C<src_code> 11081 11082File from which to read the custom code Perl source. 11083 11084=back 11085 11086The body of the Perl subroutine should be implemented in the C<src_code> file, 11087and not inside a C<sub> declaration. When called, it will be passed a single 11088hash reference with the following keys: 11089 11090=over 11091 11092=item C<syncname> 11093 11094The name of the currently-executing sync. 11095 11096=item C<version> 11097 11098The version of Bucardo executing the sync. 11099 11100=item C<sourcename> 11101 11102The name of the source database. 11103 11104=item C<targetname> 11105 11106The name of the target database. 11107 11108=item C<sendmail> 11109 11110A code reference that can be used to send email messages. 11111 11112=item C<sourcedbh> 11113 11114A L<DBI> database handle to the sync source database. Provided only to custom 11115code executed by the controller. 11116 11117=item C<rellist> 11118 11119An array reference of hash references, each representing a relation in the 11120sync. Provided only to custom code executed by the controller. The keys in 11121the hash are the same as the parameters supported by L</add table> and 11122L</add sequence>, as appropriate. 11123 11124=item C<schemaname> 11125 11126The schema for the table that triggered the exception. Provided only to 11127"exception" custom codes. 11128 11129=item C<tablename> 11130 11131The name of the table that triggered the exception. Provided only to 11132"exception" custom codes. 11133 11134=item C<error_string> 11135 11136The string containing the actual error message. Provided only to "exception" 11137custom codes. 11138 11139=item C<deltabin> 11140 11141A hash reference with the name of each source database as a key and a list of 11142all primary keys joined together with "\0". Provided only to "exception" 11143custom codes. 11144 11145=item C<attempts> 11146 11147The number of times the sync has been attempted. Provided only to "exception" 11148custom codes. 11149 11150=item C<conflicts> 11151 11152A hash reference of conflicting rows. The keys are the primary key values, and 11153the values are hash references with the names of the databases containing the 11154conflicting rows and true values. Provided only to "conflict" custom codes. 11155 11156=back 11157 11158The custom code subroutine may set any of these keys in the hash reference to 11159change the behavior of the sync: 11160 11161=over 11162 11163=item C<message> 11164 11165Message to send to the logs. 11166 11167=item C<warning> 11168 11169A warning to emit after the subroutine has returned. 11170 11171=item C<error> 11172 11173An error to be thrown after the subroutine has returned. 11174 11175=item C<nextcode> 11176 11177Set to send execution to the next custom code of the same type. Mainly useful 11178to exception custom codes, and supported only by custom codes executed by the 11179controller. 11180 11181=item C<lastcode> 11182 11183Set to true to have any subsequent custom codes of the same type to be 11184skipped. 11185 11186=item C<endsync> 11187 11188Cancels the sync altogether. 11189 11190=back 11191 11192An example: 11193 11194 use strict; 11195 use warnings; 11196 use Data::Dumper; 11197 11198 my $info = shift; 11199 11200 # Let's open a file. 11201 my $file = '/tmp/bucardo_dump.txt'; 11202 open my $fh, '>:encoding(UTF-8)', $file or do { 11203 $info->{warning} = "Cannot open $file: $!\n"; 11204 return; 11205 }; 11206 11207 # Inspect $info for fun. 11208 print $fh Dumper $info; 11209 close $fh or $info->{warning} = "Error closing $file: $!\n"; 11210 11211 # Log a message and return. 11212 $info->{message} = 'IN UR DATABASEZ NORMALIZIN UR RELAYSHUNS'; 11213 return; 11214 11215=head2 update 11216 11217 bucardo update <type> <name> <parameters> 11218 11219Updates a Bucardo object. The C<type> specifies the type of object to update, 11220while the C<name> should be the name of the object. The supported parameters 11221for each type are the same as those for L</add>. The supported types are: 11222 11223=over 11224 11225=item C<customcode> 11226 11227=item C<db> 11228 11229=item C<sync> 11230 11231=item C<table> 11232 11233=item C<sequence> 11234 11235=back 11236 11237=head3 update customcode 11238 11239 bucardo update customcode <name> setting=value 11240 11241Updates an existing customcode. Items that can be changed are: 11242 11243=over 11244 11245=item C<about> 11246 11247A short description of the custom code. 11248 11249=item C<getdbh> 11250 11251Boolean indicating whether or not Perl L<DBI> database handles should be 11252provided to the custom code subroutine. If true, database handles will be 11253provided under the C<dbh> key of the hash reference passed to the subroutine. 11254The value under this key will be a hash reference mapping database names to 11255their respective handles. 11256 11257=item C<name> 11258 11259The name of the custom code object. 11260 11261=item C<priority> 11262 11263Number indicating the priority in which order to execute custom codes. Lower numbers 11264are higher priority. Useful for subroutines that set C<lastcode> in order to 11265cancel the execution of subsequent custom codes for the same C<when_run>. 11266 11267=item C<src_code> 11268 11269File from which to read the custom code Perl source. 11270 11271=item C<status> 11272 11273The current status of this customcode. Anything other than "active" means the 11274code is not run. 11275 11276=item C<whenrun> 11277 11278A string indicating when the custom code should be run. Supported values include: 11279 11280=over 11281 11282=item C<before_txn> 11283 11284=item C<before_check_rows> 11285 11286=item C<before_trigger_drop> 11287 11288=item C<after_trigger_drop> 11289 11290=item C<after_table_sync> 11291 11292=item C<exception> 11293 11294=item C<conflict> 11295 11296=item C<before_trigger_enable> 11297 11298=item C<after_trigger_enable> 11299 11300=item C<after_txn> 11301 11302=item C<before_sync> 11303 11304=item C<after_sync> 11305 11306=back 11307 11308=back 11309 11310=head3 update db 11311 11312 bucardo udpate db <name> port=xxx host=xxx user=xxx pass=xxx 11313 11314Updates a database. The C<name> is the name by which the database is known to 11315Bucardo. This may vary from the actual database name, as multiple hosts might 11316have databases with the same name. 11317 11318The supported named parameters are: 11319 11320=over 11321 11322=item C<dbname> 11323 11324=item C<db> 11325 11326The actual name of the database. 11327 11328=item C<type> 11329 11330=item C<dbtype> 11331 11332The type of the database. Currently supported values are: 11333 11334=over 11335 11336=item * C<postgres> 11337 11338=item * C<drizzle> 11339 11340=item * C<mongo> 11341 11342=item * C<mysql> 11343 11344=item * C<maria> 11345 11346=item * C<oracle> 11347 11348=item * C<redis> 11349 11350=item * C<sqlite> 11351 11352=back 11353 11354=item C<username> 11355 11356=item C<dbuser> 11357 11358=item C<dbdsn> 11359 11360A direct DSN to connect to a database. Will override all other connection options if set. 11361 11362=item C<user> 11363 11364The username Bucardo should use to connect to the database. 11365 11366=item C<password> 11367 11368=item C<dbpass> 11369 11370=item C<pass> 11371 11372The password Bucardo should use when connecting to the database. 11373 11374=item C<dbhost> 11375 11376=item C<pghost> 11377 11378=item C<host> 11379 11380The host name to which to connect. 11381 11382=item C<dbport> 11383 11384=item C<pgport> 11385 11386=item C<port> 11387 11388The port to which to connect. 11389 11390=item C<dbconn> 11391 11392=item C<pgconn> 11393 11394=item C<conn> 11395 11396Additional connection parameters, e.g., C<sslmode=require>. Optional. 11397 11398=item C<status> 11399 11400Status of the database in Bucardo. Must be either "active" or "inactive". 11401 11402=item C<dbgroup> 11403 11404=item C<server_side_prepares> 11405 11406=item C<ssp> 11407 11408Enable or disable server-side prepares. Pass 1 to enable them or 0 to disable 11409them. 11410 11411=item C<makedelta> 11412 11413Enable or disable makedelta for this database. 11414 11415=item C<dbservice> 11416 11417=item C<service> 11418 11419The service name to use for a Postgres database. 11420 11421=item C<dbgroup> 11422 11423A comma-separated list of dbgroups to which to add the database. The 11424database will be removed from any other dbgroups of which it was previously a 11425member. 11426 11427=back 11428 11429=head3 update sync 11430 11431 bucardo update sync syncname relgroup=xxx dbs=xxx 11432 11433Updates a sync, which is a named replication event containing information about 11434what to replicate from where to where. The supported parameters are: 11435 11436=over 11437 11438=item C<name> 11439 11440The name of the sync. Required. 11441 11442=item C<dbs> 11443 11444The name of a dbgroup or comma-delimited list of databases. 11445 11446=item C<relgroup> 11447 11448The name of a relgroup to synchronize. 11449 11450=item C<status> 11451 11452Indicates whether or not the sync is active. Must be either "active" or 11453"inactive". Note that this will not change the current run status of the sync, 11454just mark whether it should be active or inactive on the next reload. Use the 11455C<activate sync> and <deactivate sync> commands to actually activate or 11456deactivate a sync. 11457 11458=item C<rebuild_index> 11459 11460Boolean indicating whether or not to rebuild indexes after every sync. 11461 11462=item C<lifetime> 11463 11464Number of seconds a KID can live before being reaped. 11465 11466=item C<maxkicks> 11467 11468Number of times a KID may be kicked before being reaped. 11469 11470=item C<isolation_level> 11471 11472The transaction isolation level this sync should use. 11473Only choices are "serializable" and "repeatable read" 11474 11475=item C<conflict_strategy> 11476 11477The conflict resolution strategy to use in the sync. Supported values: 11478 11479=over 11480 11481=item C<bucardo_source> 11482 11483The rows on the "source" database always "win". In other words, in a conflict, 11484Bucardo copies rows from source to target. 11485 11486=item C<bucardo_target> 11487 11488The rows on the "target" database always win. 11489 11490=item C<bucardo_latest> 11491 11492The row that was most recently changed wins. 11493 11494=item C<bucardo_abort> 11495 11496The sync is aborted on a conflict. 11497 11498=back 11499 11500=item C<onetimecopy> 11501 11502Determines whether or not a sync should switch to a full copy mode for a 11503single run. Supported values are: 11504 11505=over 11506 11507=item 0: off 11508 11509=item 1: always full copy 11510 11511=item 2: only copy tables that are empty on the target 11512 11513=back 11514 11515=item C<stayalive> 11516 11517Boolean indicating whether or not the sync processes (CTL) should be 11518persistent. 11519 11520=item C<kidsalive> 11521 11522Boolean indicating whether or not the sync child processes (KID) should be 11523persistent. 11524 11525=item C<autokick> 11526 11527Boolean indicating whether or not tables in the sync should automatically send 11528kick messages when they're modified. May be overridden by the C<autokick> 11529parameter of individual tables. 11530 11531=item C<checktime> 11532 11533An interval specifying the maximum time a sync should go before being 11534kicked. Useful for busy systems where you don't want the overhead of notify 11535triggers. 11536 11537=item C<priority> 11538 11539An integer indicating the priority of the sync. Lower numbers are higher 11540priority. Currently used only for display purposes. 11541 11542=item C<analyze_after_copy> 11543 11544Boolean indicating whether or not to analyze tables after every sync. Off by 11545default. 11546 11547=item C<overdue> 11548 11549An interval specifying the amount of time after which the sync has not run 11550that it should be considered overdue. C<check_bucardo_sync> issues a warning 11551when a sync has not been run in this amount of time. 11552 11553=item C<expired> 11554 11555An interval specifying the amount of time after which the sync has not run 11556that it should be considered expired. C<check_bucardo_sync> issues a critical 11557message when a sync has not been run in this amount of time. 11558 11559=item C<track_rates> 11560 11561Boolean indicating whether or not to track synchronization rates. 11562 11563=item C<rebuild_index> 11564 11565Boolean indicating whether or not to rebuild indexes after every sync. 11566 11567=item C<strict_checking> 11568 11569Boolean indicating whether or not to be strict when comparing tables in the 11570sync. If the columns have different names or data types, the validation will 11571fail. But perhaps the columns are allowed to have different names or data 11572types. If so, disable C<strict_checking> and column differences will result in 11573warnings rather than failing the validation. Defaults to true. 11574 11575=back 11576 11577=head3 update table 11578 11579 bucardo update table [schema].table db=actual_db_name 11580 11581Updates a table object. The table information will be read from the specified 11582database. Supported parameters: 11583 11584=over 11585 11586=item C<db> 11587 11588The name of the database from which to read the table information. Should be a 11589name known to Bucardo. 11590 11591=item C<schemaname> 11592 11593The name of the schema in which the table is found. 11594 11595=item C<tablename> 11596 11597The actual name of the table. 11598 11599=item C<autokick> 11600 11601Boolean indicating whether or not the table should automatically send kick 11602messages when it's modified. Overrides the C<autokick> parameter of any syncs 11603of which the table is a part. 11604 11605=item C<rebuild_index> 11606 11607Boolean indicating whether or not to rebuild indexes after every sync. 11608 11609=item C<analyze_after_copy> 11610 11611Boolean indicating whether or not to analyze the table after every sync. 11612 11613=item C<vacuum_after_copy> 11614 11615Boolean indicating whether or not to vacuum the table after every sync. 11616 11617=item C<relgroup> 11618 11619Adds the table to the named relgroup. May be specified more than once. 11620The table will be removed from any other relgroups. 11621 11622=item C<makedelta> 11623 11624Specifies which databases need makedelta enabled for this table. 11625 11626=item C<strict_checking> 11627 11628Boolean indicating whether or not to be strict when comparing the table 11629between syncs. If the columns have different names or data types, the 11630validation will fail. But perhaps the columns are allowed to have different 11631names or data types. If so, disable C<strict_checking> and column differences will 11632result in warnings rather than failing the validation. Defaults to true. 11633 11634=back 11635 11636=head3 update sequence 11637 11638 bucardo update sequence [schema].sequence relgroup=xxx 11639 11640=over 11641 11642=item C<db> 11643 11644The name of the database where the sequence lives. 11645 11646=item C<schemaname> 11647 11648The name of the schema in which the sequence is found. 11649 11650=item C<relgroup> 11651 11652Adds the sequence to the named relgroup. May be speci<fied more than 11653once. The sequence will be removed from any other relgroups. 11654 11655=back 11656 11657=head2 remove 11658 11659 bucardo remove <item_type> <item_name> 11660 11661Removes one or more objects from Bucardo. Valid item types are; 11662 11663=over 11664 11665=item * C<db> or C<database> 11666 11667Use the C<--force> option to clear out related tables and groups instead of 11668erroring out. 11669 11670=item * C<dbgroup> 11671 11672=item * C<relgroup> 11673 11674=item * C<sync> 11675 11676=item * C<table> 11677 11678=item * C<sequence> 11679 11680=item * C<customcols> 11681 11682=item * C<customname> 11683 11684=item * C<customcode> 11685 11686=back 11687 11688=head2 kick 11689 11690 bucardo kick <syncname(s)> [timeout] 11691 11692Tells one or more named syncs to fire as soon as possible. Note that this simply sends a request that 11693the sync fire: it may not start right away if the same sync is already running, or if the source or 11694target database has exceeded the number of allowed Bucardo connections. If the final argument is a 11695number, it is treated as a timeout. If this number is zero, the bucardo command will not return 11696until the sync has finished. For any other number, the sync will wait at most that number of seconds. 11697If any sync has not finished before the timeout, an exit value of 1 will be returned. Errors will 11698cause exit values of 2 or 3. In all other cases, an exit value of 0 will be returned. 11699 11700If a timeout is given, the total completion time in seconds is also displayed. If the sync is going to 11701multiple targets, the time that each target takes from the start of the kick is also shown as each 11702target finishes. Options: 11703 11704=over 11705 11706=item C<--retry> 11707 11708The number of times to retry a sync if it fails. Defaults to 0. 11709 11710=item C<--retry-sleep> 11711 11712How long to sleep, in seconds, between each retry attempt. 11713 11714=item C<--notimer> 11715 11716By default, kicks with a timeout argument give a running real-time summary of 11717time elapsed by using the backspace character. This may not be wanted if 11718running a kick, for example, via a cronjob, so turning --notimer on will 11719simply print the entire message without backspaces. 11720 11721=back 11722 11723=head2 pause 11724 11725 bucardo pause <syncname(s)> 11726 bucardo pause all 11727 bucardo resume <syncname(s)> 11728 bucardo resume all 11729 11730Tells one or more named syncs to temporarily pause, or to resume from a previous pause. This 11731only applies to active syncs and only takes effect if Bucardo is currently running. The 11732keyword 'all' can be used as well to pause or resume all known active syncs. 11733 11734=head2 reload config 11735 11736 bucardo reload config 11737 bucardo reload config 30 11738 11739Sends a message to all CTL and KID processes asking them to reload the Bucardo 11740configuration. This configuration is a series of key/value pairs that 11741configure Bucardo's behavior, and not any of the objects managed by the 11742C<add>, C<remove>, or C<update> commands. 11743 11744By default, Bucardo will send the message and then exit. Pass an optional 11745number and Bucardo will instead wait up to that length of time for all child 11746processes to report completion. 11747 11748=head2 set 11749 11750 bucardo set setting1=value [setting2=value] 11751 11752Sets one or more configuration setting table. Setting names are 11753case-insensitive. The available settings are: 11754 11755=begin comment 11756 11757How to generate this list: 11758 11759 psql -U bucardo -d bucardo -AXtc "SELECT regexp_replace(format( 11760 E'=item C<%s>\n\n%s. Default: %s.\n', 11761 name, about, CASE WHEN setting = '' THEN 'None' ELSE 'C<' || setting || '>' END 11762 ), '([.?])[.]', E'\\\\1') FROM bucardo_config ORDER BY name;" 11763 11764=end comment 11765 11766=over 11767 11768=item C<autosync_ddl> 11769 11770Which DDL changing conditions do we try to remedy automatically? Default: C<newcol>. 11771 11772=item C<bucardo_version> 11773 11774Current version of Bucardo. Default: C<5.6.0>. 11775 11776=item C<bucardo_vac> 11777 11778Do we want the automatic VAC daemon to run? Default: C<1>. 11779 11780=item C<bucardo_initial_version> 11781 11782Bucardo version this schema was created with. Default: C<5.6.0>. 11783 11784=item C<ctl_checkonkids_time> 11785 11786How often does the controller check on the kids health? Default: C<10>. 11787 11788=item C<ctl_createkid_time> 11789 11790How long do we sleep to allow kids-on-demand to get on their feet? Default: C<0.5>. 11791 11792=item C<ctl_sleep> 11793 11794How long does the controller loop sleep? Default: C<0.2>. 11795 11796=item C<default_conflict_strategy> 11797 11798Default conflict strategy for all syncs. Default: C<bucardo_latest>. 11799 11800=item C<default_email_from> 11801 11802Who the alert emails are sent as. Default: C<nobody@example.com>. 11803 11804=item C<default_email_host> 11805 11806Which host to send email through. Default: C<localhost>. 11807 11808=item C<default_email_to> 11809 11810Who to send alert emails to. Default: C<nobody@example.com>. 11811 11812=item C<email_debug_file> 11813 11814File to save a copy of all outgoing emails to. Default: None. 11815 11816=item C<endsync_sleep> 11817 11818How long do we sleep when custom code requests an endsync? Default: C<1.0>. 11819 11820=item C<flatfile_dir> 11821 11822Directory to store the flatfile output inside of. Default: C<.>. 11823 11824=item C<host_safety_check> 11825 11826Regex to make sure we don't accidentally run where we should not. Default: None. 11827 11828=item C<isolation_level> 11829 11830The transaction isolation level all sync should use. Defaults to 'serializable'. 11831The only other valid option is 'repeatable read' 11832 11833=item C<kid_deadlock_sleep> 11834 11835How long to sleep in seconds if we hit a deadlock error. Default: C<0.5>. 11836Set to -1 to prevent the kid from retrying. 11837 11838=item C<kid_nodeltarows_sleep> 11839 11840How long do kids sleep if no delta rows are found? Default: C<0.5>. 11841 11842=item C<kid_pingtime> 11843 11844How often do we ping check the KID? Default: C<60>. 11845 11846=item C<kid_restart_sleep> 11847 11848How long to sleep in seconds when restarting a kid? Default: C<1>. 11849 11850=item C<kid_serial_sleep> 11851 11852How long to sleep in seconds if we hit a serialization error. Default: C<0.5>. 11853Set to -1 to prevent the kid from retrying. 11854 11855=item C<kid_sleep> 11856 11857How long does a kid loop sleep? Default: C<0.5>. 11858 11859=item C<log_conflict_file> 11860 11861Name of the conflict detail log file. Default: C<bucardo_conflict.log>. 11862 11863=item C<log_level> 11864 11865How verbose to make the logging. Higher is more verbose. Default: C<normal>. 11866 11867=item C<log_microsecond> 11868 11869Show microsecond output in the timestamps? Default: C<0>. 11870 11871=item C<log_showlevel> 11872 11873Show log level in the log output? Default: C<0>. 11874 11875=item C<log_showline> 11876 11877Show line number in the log output? Default: C<0>. 11878 11879=item C<log_showpid> 11880 11881Show PID in the log output? Default: C<1>. 11882 11883=item C<log_showtime> 11884 11885Show timestamp in the log output? 0=off 1=seconds since epoch 2=scalar gmtime 3=scalar localtime. Default: C<3>. 11886 11887=item C<log_timer_format> 11888 11889The C<strftime> format to use to format the log timestamp when C<log_showtime> is set to 2 or 3. 11890Defaults to simply the scalar output of the time. 11891 11892=item C<mcp_dbproblem_sleep> 11893 11894How many seconds to sleep before trying to respawn. Default: C<15>. 11895 11896=item C<mcp_loop_sleep> 11897 11898How long does the main MCP daemon sleep between loops? Default: C<0.2>. 11899 11900=item C<mcp_pingtime> 11901 11902How often do we ping check the MCP? Default: C<60>. 11903 11904=item C<mcp_vactime> 11905 11906How often in seconds do we check that a VAC is still running? Default: C<60>. 11907 11908=item C<piddir> 11909 11910Directory holding Bucardo PID files. Default: C</var/run/bucardo>. 11911 11912=item C<reason_file> 11913 11914File to hold reasons for stopping and starting. Default: C<bucardo.restart.reason.txt>. 11915 11916=item C<reload_config_timeout> 11917 11918Number of seconds the C<reload_config> command should wait for the reload to complete. 11919Default: C<30>. 11920 11921=item C<semaphore_table> 11922 11923Table to let apps know a sync is ongoing. Default: C<bucardo_status>. 11924 11925=item C<statement_chunk_size> 11926 11927How many primary keys to shove into a single statement. Default: C<10000>. 11928 11929=item C<stats_script_url> 11930 11931Location of the stats script. Default: C<http://www.bucardo.org/>. 11932 11933=item C<stopfile> 11934 11935Name of the semaphore file used to stop Bucardo processes. Default: C<fullstopbucardo>. 11936 11937=item C<syslog_facility> 11938 11939Which syslog facility level to use. Default: C<log_local1>. 11940 11941=item C<tcp_keepalives_count> 11942 11943How many probes to send. 0 indicates sticking with system defaults. Default: C<0>. 11944 11945=item C<tcp_keepalives_idle> 11946 11947How long to wait between each keepalive probe. Default: C<0>. 11948 11949=item C<tcp_keepalives_interval> 11950 11951How long to wait for a response to a keepalive probe. Default: C<0>. 11952 11953=item C<vac_run> 11954 11955How often does the VAC process run? Default: C<30>. 11956 11957=item C<vac_sleep> 11958 11959How long does VAC process sleep between runs? Default: C<120>. 11960 11961=item C<warning_file> 11962 11963File containing all log lines starting with "Warning". Default: C<bucardo.warning.log>. 11964 11965=back 11966 11967=head2 show 11968 11969 bucardo show all|changed|<setting> [<setting>...] 11970 11971Shows the current Bucardo settings. Use the keyword "all" to see all the 11972settings, "changed" to see settings different than the installed defaults, 11973or specify one or more search terms. See L</set> for complete details on the 11974configuration settings. 11975 11976=head2 config 11977 11978 bucardo config show all|<setting> [<setting>...] 11979 bucardo config set <setting=value> [<setting=value>...] 11980 11981Deprecated interface for showing and setting configuration settings. Use the 11982L</show> and L</set> commands, instead. 11983 11984=head2 ping 11985 11986 bucardo ping 11987 bucardo ping 60 11988 bucardo ping 0 11989 11990Sends a ping notice to the MCP process to see if it will respond. By default, it will wait 15 seconds. A 11991numeric argument will change this timeout. Using a 0 as the timeout indicates waiting forever. If a response 11992was returned, the program will exit with a value of 0. If it times out, the value will be 1. 11993Returns a Nagios like message starting with "OK" or "CRITICAL" for success or failure. 11994 11995=head2 status 11996 11997 bucardo status [syncname(s)] [--sort=#] [--show-days] [--compress] 11998 11999Shows the brief status of all known syncs in a tabular format. If given one or more sync names, 12000shows detailed information for each one. To see detailed information for all syncs, simply 12001use "status all" 12002 12003When showing brief information, the columns are: 12004 12005=over 12006 12007=item 1. B<Name> 12008 12009The name of the sync 12010 12011=item 2. B<State> 12012 12013The state of the sync. Can be 'Good', 'Bad', 'Empty', 'No records found', 12014'Unknown', or the run state for a currently-running sync. 12015 12016=item 3. B<Last good> 12017 12018When the sync last successfully ran. 12019 12020=item 4. B<Time> 12021 12022How long it has been since the last sync success 12023 12024=item 5. B<Last I/U> 12025 12026The number of insert and deletes performed by the last successful sync. May also show 12027the number of rows truncated (T) or conflicted (C), if applicable. 12028 12029=item 6. B<Last bad> 12030 12031When the sync last failed. 12032 12033=item 7. B<Time> 12034 12035How long it has been since the last sync failure 12036 12037=back 12038 12039The options for C<status> are: 12040 12041=over 12042 12043=item C<--show-days> 12044 12045Specifies whether or not do list the time interval with days, or simply show 12046the hours. For example, "3d 12h 6m 3s" vs. "48h 6m 3s" 12047 12048=item C<--compress> 12049 12050Specifies whether or not to compress the time interval by removing spaces. 12051Mostly used to limit the width of the 'status' display. 12052 12053=item C<--sort=#> 12054 12055Requests sorting of the 'status' output by one of the nine columns. Use a 12056negative number to reverse the sort order. 12057 12058=back 12059 12060=head2 activate 12061 12062 bucardo activate syncname [syncname2 syncname3 ...] [timeout] 12063 12064Activates one or more named syncs. If given a timeout argument, it will wait until it has received 12065confirmation from Bucardo that each sync has been successfully activated. 12066 12067=head2 deactivate 12068 12069 bucardo deactivate syncname [syncname2 syncname3 ...] [timeout] 12070 12071Deactivates one or more named syncs. If given a timeout argument, it will wait until it has received 12072confirmation from Bucardo that the sync has been successfully deactivated. 12073 12074=head2 message 12075 12076 bucardo message 'I WAS HERE' 12077 12078Sends a message to the running Bucardo logs. This message will appear prefixed with "MESSAGE: ". If 12079Bucardo is not running, the message will go to the logs the next time Bucardo runs and someone 12080adds another message. 12081 12082=head2 reload 12083 12084 bucardo reload [syncname2 syncname3 ...] 12085 12086Sends a message to one or more sync processes, instructing them to reload. 12087Waits for each to reload before going on to the next. Reloading consists of 12088deactivating a sync, reloading its information from the database, and 12089activating it again. 12090 12091=head2 inspect 12092 12093 bucardo inspect <type> <name> [<name2>...] 12094 12095Inspects one or more objects of a particular type. The results are sent to 12096C<STDOUT>. The supported types include: 12097 12098=over 12099 12100=item C<table> 12101 12102=item C<sync> 12103 12104=item C<relgroup> 12105 12106=back 12107 12108=head2 validate 12109 12110 bucardo validate all|<sync> [<sync>...] 12111 12112Validates one or more syncs. Use the keyword "all" to validate all syncs, or 12113specify one or more syncs to validate. 12114 12115Note that this command executes a subset of all the validation done when a 12116sync is started or activated. 12117 12118=head2 purge 12119 12120 bucardo purge all|<table> [<table>...] 12121 12122Purges the delta and track tables for one or more tables, for one or more 12123databases. Use the keyword "all" to validate all tables, or specify one or 12124more tables to validate. 12125 12126=head2 delta 12127 12128 bucardo delta [total] [<database>...] 12129 12130Show the current delta count for each source target. Provide a list of databases 12131to limit it to just the given ones. Wildcards are allowed. Use the special name 12132"totals" to show only the grand total. 12133 12134=head2 help 12135 12136 bucardo help 12137 bucardo help <command> 12138 bucardo help <command> <action> 12139 12140Get help. General help can be returned, as well as help for a single command 12141or a command and its action. Some examples: 12142 12143 bucard help list 12144 bucard help add table 12145 12146=head1 OPTIONS DETAILS 12147 12148It is usually easier to set most of these options at the top of the script, or make an alias for them, 12149as they will not change very often if at all. 12150 12151=over 12152 12153=item C<-d> 12154 12155=item C<--db-name> 12156 12157 bucardo --db-name widgets 12158 bucardo -d bricolage 12159 12160Name of the Bucardo database to which to connect. 12161 12162=item C<-U> 12163 12164=item C<--db-user> 12165 12166 bucardo --db-user postgres 12167 bucardo -U Mom 12168 12169User name to use when connecting to the Bucardo database. 12170 12171=item C<-P> 12172 12173=item C<--db-pass> 12174 12175 bucardo --db-pass s3cr1t 12176 bucardo -P lolz 12177 12178Password to use when connecting to the Bucardo database. 12179 12180=item C<-h> 12181 12182=item C<--db-host> 12183 12184 bucardo --db-host db.example.com 12185 bucardo -h db2.example.net 12186 12187Host name to use when connecting to the Bucardo database. 12188 12189=item C<-p> 12190 12191=item C<--db-port> 12192 12193 bucardo --db-port 7654 12194 12195Port number to connect to when connecting to the Bucardo database. 12196 12197=item C<--bucardorc> 12198 12199 bucardo --bucardorc myrcfile 12200 12201Use the specified file for configuration instead of the default 12202F<./.bucardorc>. 12203 12204=item C<--no-bucardorc> 12205 12206Do not use the F<./.bucardorc> configuration file. 12207 12208=item C<--verbose> 12209 12210Makes bucardo run verbosely. Default is off. 12211 12212=item C<--quiet> 12213 12214Tells bucardo to be as quiet as possible. Default is off. 12215 12216=item C<--help> 12217 12218Shows a brief summary of usage for bucardo. 12219 12220=back 12221 12222=head1 FILES 12223 12224In addition to command-line configurations, you can put any options inside of a file. The file F<.bucardorc> in 12225the current directory will be used if found. If not found, then the file F<~/.bucardorc> will be used. Finally, 12226the file /etc/bucardorc will be used if available. The format of the file is option = value, one per line. Any 12227line starting with a '#' will be skipped. Any values loaded from a bucardorc file will be overwritten by 12228command-line options. All bucardorc files can be ignored by supplying a C<--no-bucardorc> argument. A specific 12229file can be forced with the C<--bucardorc=file> option; if this option is set, bucardo will refuse to run 12230unless that file can be read. 12231 12232=head1 ENVIRONMENT VARIABLES 12233 12234The bucardo script uses I<$ENV{HOME}> to look for a F<.bucardorc> file. 12235 12236=head1 BUGS 12237 12238Bug reports and feature requests are always welcome, please visit 12239L<bucardo.org|https://bucardo.org>, file L<GitHub 12240Issues|http://github.com/bucardo/bucardo/issues>, or post to our 12241L<email list|https://bucardo.org/mailman/listinfo/bucardo-general>. 12242 12243=head1 SEE ALSO 12244 12245Bucardo 12246 12247=head1 COPYRIGHT 12248 12249Copyright 2006-2020 Greg Sabino Mullane <greg@turnstep.com> 12250 12251This program is free to use, subject to the limitations in the LICENSE file. 12252 12253=cut 12254