1#!perl 2# -*-mode:cperl; indent-tabs-mode: nil; cperl-indent-level: 4-*- 3 4## The main Bucardo program 5## 6## This script should only be called via the 'bucardo' program 7## 8## Copyright 2006-2020 Greg Sabino Mullane <greg@turnstep.com> 9## 10## Please visit https://bucardo.org for more information 11 12package Bucardo; 13use 5.008003; 14use strict; 15use warnings; 16use utf8; 17use open qw( :std :utf8 ); 18 19our $VERSION = '5.6.0'; 20 21use DBI 1.51; ## How Perl talks to databases 22use DBD::Pg 2.0 qw( :async ); ## How Perl talks to Postgres databases 23use DBIx::Safe '1.2.4'; ## Filter out what DB calls customcode may use 24 25use sigtrap qw( die normal-signals ); ## Call die() on HUP, INT, PIPE, or TERM 26use Config qw( %Config ); ## Used to map signal names 27use File::Spec qw( ); ## For portable file operations 28use Data::Dumper qw( Dumper ); ## Used to dump information in email alerts 29use POSIX qw( strftime strtod ); ## For grabbing the local timezone, and forcing to NV 30use Sys::Hostname qw( hostname ); ## Used for host safety check, and debugging/mail sending 31use IO::Handle qw( autoflush ); ## Used to prevent stdout/stderr buffering 32use Sys::Syslog qw( openlog syslog ); ## In case we are logging via syslog() 33use Net::SMTP qw( ); ## Used to send out email alerts 34use List::Util qw( first ); ## Better than grep 35use MIME::Base64 qw( encode_base64 36 decode_base64 ); ## For making text versions of bytea primary keys 37 38use Time::HiRes qw( sleep gettimeofday 39 tv_interval ); ## For better resolution than the built-in sleep 40 ## and for timing of events 41 42## Formatting of Data::Dumper() calls: 43$Data::Dumper::Varname = 'BUCARDO'; 44$Data::Dumper::Indent = 1; 45 46## Common variables we don't want to declare over and over: 47use vars qw(%SQL $sth %sth $count $info); 48 49## Logging verbosity control 50## See also the 'log_level_number' inside the config hash 51use constant { 52 LOG_WARN => 0, ## Always shown 53 LOG_TERSE => 1, ## Bare minimum 54 LOG_NORMAL => 2, ## Normal messages 55 LOG_VERBOSE => 3, ## Many more details 56 LOG_DEBUG => 4, ## Firehose: rarely needed 57 LOG_DEBUG2 => 5, ## Painful level of detail 58}; 59 60## Map system signal numbers to standard names 61## This allows us to say kill $signumber{HUP} => $pid 62my $i = 0; 63my %signumber; 64for (split(' ', $Config{sig_name})) { 65 $signumber{$_} = $i++; 66} 67 68## Prevent buffering of output: 69*STDOUT->autoflush(1); 70*STDERR->autoflush(1); 71 72## Configuration of DBIx::Safe 73## Specify exactly what database handles are allowed to do within custom code 74## Here, 'strict' means 'inside the main transaction that Bucardo uses to make changes' 75my $strict_allow = 'SELECT INSERT UPDATE DELETE quote quote_identifier'; 76my $nostrict_allow = "$strict_allow COMMIT ROLLBACK NOTIFY SET pg_savepoint pg_release pg_rollback_to"; 77 78my %dbix = ( 79 source => { 80 strict => { 81 allow_command => $strict_allow, 82 allow_attribute => '', 83 allow_regex => '', ## Must be qr{} if not empty 84 deny_regex => '', 85 }, 86 notstrict => { 87 allow_command => $nostrict_allow, 88 allow_attribute => 'RaiseError PrintError', 89 allow_regex => [qr{CREATE TEMP TABLE},qr{CREATE(?: UNIQUE)? INDEX}], 90 deny_regex => '', 91 }, 92 }, 93 target => { 94 strict => { 95 allow_command => $strict_allow, 96 allow_attribute => '', 97 allow_regex => '', ## Must be qr{} if not empty 98 deny_regex => '', 99 }, 100 notstrict => { 101 allow_command => $nostrict_allow, 102 allow_attribute => 'RaiseError PrintError', 103 allow_regex => [qr{CREATE TEMP TABLE}], 104 deny_regex => '', 105 }, 106 } 107); 108 109## Grab our full and shortened host name: 110## Used for the host_safety_check as well as for emails 111my $hostname = hostname; 112my $shorthost = $hostname; 113$shorthost =~ s/^(.+?)\..*/$1/; 114 115## Items pulled from bucardo_config and shared everywhere: 116our %config; 117our %config_about; 118 119## Set a default in case we call glog before we load the configs: 120$config{log_level_number} = LOG_NORMAL; 121 122## Sequence columns we care about and how to change them via ALTER: 123my @sequence_columns = ( 124 ['last_value' => ''], 125 ['start_value' => 'START WITH'], 126 ['increment_by' => 'INCREMENT BY'], 127 ['max_value' => 'MAXVALUE'], 128 ['min_value' => 'MINVALUE'], 129 ['is_cycled' => 'BOOL CYCLE'], 130 ['is_called' => ''], 131); 132 133my $sequence_columns = join ',' => map { $_->[0] } @sequence_columns; 134 135## Default statement chunk size in case config does not have it 136my $default_statement_chunk_size = 10_000; 137 138## Output messages per language 139our %msg = ( 140'en' => { 141 'time-day' => q{day}, 142 'time-days' => q{days}, 143 'time-hour' => q{hour}, 144 'time-hours' => q{hours}, 145 'time-minute' => q{minute}, 146 'time-minutes' => q{minutes}, 147 'time-month' => q{month}, 148 'time-months' => q{months}, 149 'time-second' => q{second}, 150 'time-seconds' => q{seconds}, 151 'time-week' => q{week}, 152 'time-weeks' => q{weeks}, 153 'time-year' => q{year}, 154 'time-years' => q{years}, 155}, 156'fr' => { 157 'time-day' => q{jour}, 158 'time-days' => q{jours}, 159 'time-hour' => q{heure}, 160 'time-hours' => q{heures}, 161 'time-minute' => q{minute}, 162 'time-minutes' => q{minutes}, 163 'time-month' => q{mois}, 164 'time-months' => q{mois}, 165 'time-second' => q{seconde}, 166 'time-seconds' => q{secondes}, 167 'time-week' => q{semaine}, 168 'time-weeks' => q{semaines}, 169 'time-year' => q{année}, 170 'time-years' => q{années}, 171}, 172'de' => { 173 'time-day' => q{Tag}, 174 'time-days' => q{Tag}, 175 'time-hour' => q{Stunde}, 176 'time-hours' => q{Stunden}, 177 'time-minute' => q{Minute}, 178 'time-minutes' => q{Minuten}, 179 'time-month' => q{Monat}, 180 'time-months' => q{Monate}, 181 'time-second' => q{Sekunde}, 182 'time-seconds' => q{Sekunden}, 183 'time-week' => q{Woche}, 184 'time-weeks' => q{Woche}, 185 'time-year' => q{Jahr}, 186 'time-years' => q{Jahr}, 187}, 188'es' => { 189 'time-day' => q{día}, 190 'time-days' => q{días}, 191 'time-hour' => q{hora}, 192 'time-hours' => q{horas}, 193 'time-minute' => q{minuto}, 194 'time-minutes' => q{minutos}, 195 'time-month' => q{mes}, 196 'time-months' => q{meses}, 197 'time-second' => q{segundo}, 198 'time-seconds' => q{segundos}, 199 'time-week' => q{semana}, 200 'time-weeks' => q{semanas}, 201 'time-year' => q{año}, 202 'time-years' => q{años}, 203}, 204); 205## use critic 206 207## Figure out which language to use for output 208our $lang = $ENV{LC_ALL} || $ENV{LC_MESSAGES} || $ENV{LANG} || 'en'; 209$lang = substr($lang,0,2); 210 211 212## 213## Everything else is subroutines 214## 215 216sub new { 217 218 ## Create a new Bucardo object and return it 219 ## Takes a hashref of options as the only argument 220 221 my $class = shift; 222 my $params = shift || {}; 223 224 ## The hash for this object, with default values: 225 my $self = { 226 created => scalar localtime, 227 mcppid => $$, 228 verbose => 1, 229 quickstart => 0, 230 logdest => ['.'], 231 warning_file => '', 232 logseparate => 0, 233 logextension => '', 234 logclean => 0, 235 dryrun => 0, 236 sendmail => 1, 237 extraname => '', 238 logprefix => 'BC!', 239 version => $VERSION, 240 listening => {}, 241 pidmap => {}, 242 exit_on_nosync => 0, 243 sqlprefix => "/* Bucardo $VERSION */", 244 }; 245 246 ## Add any passed-in parameters to our hash: 247 for (keys %$params) { 248 $self->{$_} = $params->{$_}; 249 } 250 251 ## Transform our hash into a genuine 'Bucardo' object: 252 bless $self, $class; 253 254 ## Remove any previous log files if requested 255 if ($self->{logclean} && (my @dirs = grep { 256 $_ !~ /^(?:std(?:out|err)|none|syslog)/ 257 } @{ $self->{logdest} }) ) { 258 ## If the dir does not exists, silently proceed 259 for my $dir (@dirs) { 260 opendir my $dh, $dir or next; 261 ## We look for any files that start with 'log.bucardo' plus another dot 262 for my $file (grep { /^log\.bucardo\./ } readdir $dh) { 263 my $fullfile = File::Spec->catfile( $dir => $file ); 264 unlink $fullfile or warn qq{Could not remove "$fullfile": $!\n}; 265 } 266 closedir $dh or warn qq{Could not closedir "$dir": $!\n}; 267 } 268 } 269 270 ## Zombie stopper 271 $SIG{CHLD} = 'IGNORE'; 272 273 ## Basically, dryrun does a rollback instead of a commit at the final sync step 274 ## This is not 100% safe, if (for example) you have custom code that reaches 275 ## outside the database to do things. 276 if (exists $ENV{BUCARDO_DRYRUN}) { 277 $self->{dryrun} = 1; 278 } 279 if ($self->{dryrun}) { 280 $self->glog(q{** DRYRUN - Syncs will not be committed! **}, LOG_WARN); 281 } 282 283 ## This gets appended to the process description ($0) 284 if ($self->{extraname}) { 285 $self->{extraname} = " ($self->{extraname})"; 286 } 287 288 ## Connect to the main Bucardo database 289 $self->{masterdbh} = $self->connect_database(); 290 291 ## Load in the configuration information 292 $self->reload_config_database(); 293 294 ## Figure out if we are writing emails to a file 295 $self->{sendmail_file} = $ENV{BUCARDO_EMAIL_DEBUG_FILE} || $config{email_debug_file} || ''; 296 297 ## Where to store our PID: 298 $self->{pid_file} = File::Spec->catfile( $config{piddir} => 'bucardo.mcp.pid' ); 299 300 ## The file to ask all processes to stop: 301 $self->{stop_file} = File::Spec->catfile( $config{piddir} => $config{stopfile} ); 302 303 ## Send all log lines starting with "Warning" to a separate file 304 $self->{warning_file} ||= $config{warning_file}; 305 306 ## Make sure we are running where we are supposed to be 307 ## This prevents items in bucardo.db that reference production 308 ## systems from getting run on QA! 309 ## ...or at least makes sure people have to work a lot harder 310 ## to shoot themselves in the foot. 311 if (length $config{host_safety_check}) { 312 my $safe = $config{host_safety_check}; 313 my $osafe = $safe; 314 my $ok = 0; 315 ## Regular expression 316 if ($safe =~ s/^~//) { 317 $ok = 1 if $hostname =~ qr{$safe}; 318 } 319 ## Set of choices 320 elsif ($safe =~ s/^=//) { 321 for my $string (split /,/ => $safe) { 322 if ($hostname eq $string) { 323 $ok=1; 324 last; 325 } 326 } 327 } 328 ## Simple string 329 elsif ($safe eq $hostname) { 330 $ok = 1; 331 } 332 333 if (! $ok) { 334 warn qq{Cannot start: configured to only run on "$osafe". This is "$hostname"\n}; 335 warn qq{ This is usually done to prevent a configured Bucardo from running\n}; 336 warn qq{ on the wrong host. Please verify the 'db' settings by doing:\n}; 337 warn qq{bucardo list dbs\n}; 338 warn qq{ Once you are sure the bucardo.db table has the correct values,\n}; 339 warn qq{ you can adjust the 'host_safety_check' value\n}; 340 exit 2; 341 } 342 } 343 344 return $self; 345 346} ## end of new 347 348 349sub start_mcp { 350 351 ## Start the Bucardo daemon. Called by bucardo after setsid() 352 ## Arguments: one 353 ## 1. Arrayref of command-line options. 354 ## Returns: never (exit 0 or exit 1) 355 356 my ($self, $opts) = @_; 357 358 ## Store the original invocation string, then modify it 359 my $old0 = $0; 360 ## May not work on all platforms, of course, but we're gonna try 361 $0 = "Bucardo Master Control Program v$VERSION.$self->{extraname}"; 362 363 ## Prefix all lines in the log file with this TLA (until overriden by a forked child) 364 $self->{logprefix} = 'MCP'; 365 366 ## If the standard pid file [from new()] already exists, cowardly refuse to run 367 if (-e $self->{pid_file}) { 368 ## Grab the PID from the file if we can for better output 369 my $extra = ''; 370 371 ## Failing to open is not fatal here, just means no PID shown 372 my $oldpid; 373 if (open my $fh, '<', $self->{pid_file}) { 374 if (<$fh> =~ /(\d+)/) { 375 $oldpid = $1; 376 $extra = " (PID=$oldpid)"; 377 } 378 close $fh or warn qq{Could not close "$self->{pid_file}": $!\n}; 379 } 380 381 ## Output to the logfile, to STDERR, then exit 382 if ($oldpid != $$) { 383 my $msg = qq{File "$self->{pid_file}" already exists$extra: cannot run until it is removed}; 384 $self->glog($msg, LOG_WARN); 385 warn $msg; 386 387 exit 1; 388 } 389 } 390 391 ## We also refuse to run if the global stop file exists 392 if (-e $self->{stop_file}) { 393 my $msg = qq{Cannot run while this file exists: "$self->{stop_file}"}; 394 $self->glog($msg, LOG_WARN); 395 warn $msg; 396 397 ## Failure to open this file is not fatal 398 if (open my $fh, '<', $self->{stop_file}) { 399 ## Read in up to 10 lines from the stopfile and output them 400 while (<$fh>) { 401 $msg = "Line $.: $_"; 402 $self->glog($msg, LOG_WARN); 403 warn $msg; 404 last if $. > 10; 405 } 406 close $fh or warn qq{Could not close "$self->{stop_file}": $!\n}; 407 } 408 409 exit 1; 410 } 411 412 ## We are clear to start. Output a quick hello and version to the logfile 413 $self->glog("Starting Bucardo version $VERSION", LOG_WARN); 414 $self->glog("Log level: $config{log_level}", LOG_WARN); 415 416 ## Close unused file handles. 417 unless (grep { $_ eq 'stderr' } @{ $self->{logdest} }) { 418 close STDERR or warn "Could not close STDERR\n"; 419 } 420 unless (grep { $_ eq 'stdout' } @{ $self->{logdest} }) { 421 close STDOUT or warn "Could not close STDOUT\n"; 422 } 423 424 ## Create a new (but very temporary) PID file 425 ## We will overwrite later with a new PID once we do the initial fork 426 $self->create_mcp_pid_file($old0); 427 428 ## Send an email message with details about this invocation 429 if ($self->{sendmail} or $self->{sendmail_file}) { 430 ## Create a pretty Dumped version of the current $self object, with the password elided 431 432 ## Squirrel away the old password 433 my $oldpass = $self->{dbpass}; 434 ## Set to something else 435 $self->{dbpass} = '<not shown>'; 436 ## Dump the entire object with Data::Dumper (with custom config variables) 437 my $dump = Dumper $self; 438 ## Put the password back in place 439 $self->{dbpass} = $oldpass; 440 441 ## Prepare to send an email letting people know we have started up 442 my $body = qq{ 443 Master Control Program $$ was started on $hostname 444 Args: $old0 445 Version: $VERSION 446 }; 447 my $subject = qq{Bucardo $VERSION started on $shorthost}; 448 449 ## If someone left a message in the reason file, append it, then delete the file 450 my $reason = get_reason('delete'); 451 if ($reason) { 452 $body .= "Reason: $reason\n"; 453 $subject .= " ($reason)"; 454 } 455 ## Strip leading whitespace from the body (from the qq{} above) 456 $body =~ s/^\s+//gsm; 457 458 ## Send out the email (if sendmail or sendmail_file is enabled) 459 $self->send_mail({ body => "$body\n\n$dump", subject => $subject }); 460 } 461 462 ## Drop the existing database connection, fork, and get a new one 463 ## This self-fork helps ensure our survival 464 my $disconnect_ok = 0; 465 eval { 466 ## This connection was set in new() 467 $self->{masterdbh}->disconnect(); 468 $disconnect_ok = 1; 469 }; 470 $disconnect_ok or $self->glog("Warning! Disconnect failed $@", LOG_WARN); 471 472 my $seeya = fork; 473 if (! defined $seeya) { 474 die q{Could not fork mcp!}; 475 } 476 ## Immediately close the child process (one side of the fork) 477 if ($seeya) { 478 exit 0; 479 } 480 481 ## Now that we've forked, overwrite the PID file with our new value 482 $self->create_mcp_pid_file($old0); 483 484 ## Reconnect to the master database 485 ($self->{mcp_backend}, $self->{masterdbh}) = $self->connect_database(); 486 my $masterdbh = $self->{masterdbh}; 487 488 ## Let any listeners know we have gotten this far 489 ## (We do this nice and early for impatient watchdog programs) 490 $self->db_notify($masterdbh, 'boot', 1); 491 492 ## Store the function to use to generate clock timestamps 493 ## We greatly prefer clock_timestamp, 494 ## but fallback to timeofday() for 8.1 and older 495 $self->{mcp_clock_timestamp} = 496 $masterdbh->{pg_server_version} >= 80200 497 ? 'clock_timestamp()' 498 : 'timeofday()::timestamptz'; 499 500 ## Start outputting some interesting things to the log 501 $self->show_db_version_and_time($masterdbh, $self->{mcp_backend}, 'Master DB '); 502 $self->glog("PID: $$", LOG_WARN); 503 $self->glog('Postgres library version: ' . $masterdbh->{pg_lib_version}, LOG_WARN); 504 $self->glog("bucardo: $old0", LOG_WARN); 505 $self->glog('Bucardo.pm: ' . $INC{'Bucardo.pm'}, LOG_WARN); 506 $self->glog((sprintf 'OS: %s Perl: %s %vd', $^O, $^X, $^V), LOG_WARN); 507 508 ## Get an integer version of the DBD::Pg version, for later comparisons 509 if ($DBD::Pg::VERSION !~ /(\d+)\.(\d+)\.(\d+)/) { 510 die "Could not parse the DBD::Pg version: was $DBD::Pg::VERSION\n"; 511 } 512 $self->{dbdpgversion} = int (sprintf '%02d%02d%02d', $1,$2,$3); 513 $self->glog((sprintf 'DBI version: %s DBD::Pg version: %s (%d) DBIx::Safe version: %s', 514 $DBI::VERSION, 515 $DBD::Pg::VERSION, 516 $self->{dbdpgversion}, 517 $DBIx::Safe::VERSION), 518 LOG_WARN); 519 520 ## Attempt to print the git hash to help with debugging if running a dev version 521 if (-d '.git') { 522 my $COM = 'git log -1'; 523 my $log = ''; 524 eval { $log = qx{$COM}; }; 525 if ($log =~ /^commit ([a-f0-9]{40}).+Date:\s+(.+?)$/ms) { 526 $self->glog("Last git commit sha and date: $1 $2", LOG_NORMAL); 527 } 528 } 529 530 ## Store some PIDs for later debugging use 531 $self->{pidmap}{$$} = 'MCP'; 532 $self->{pidmap}{$self->{mcp_backend}} = 'Bucardo DB'; 533 534 ## Get the maximum key length of the "self" hash for pretty formatting 535 my $maxlen = 5; 536 for (keys %$self) { 537 $maxlen = length($_) if length($_) > $maxlen; 538 } 539 540 ## Print each object, aligned, and show 'undef' for undefined values 541 ## Yes, this prints things like HASH(0x8fbfc84), but we're okay with that 542 $Data::Dumper::Indent = 0; 543 $Data::Dumper::Terse = 1; 544 my $objdump = "Bucardo object:\n"; 545 for my $key (sort keys %$self) { 546 my $value = $key eq 'dbpass' ? '<not shown>' : $self->{$key}; 547 $objdump .= sprintf " %-*s => %s\n", $maxlen, $key, 548 (defined $value) ? 549 (ref $value eq 'ARRAY') ? Dumper($value) 550 : qq{'$value'} : 'undef'; 551 } 552 $Data::Dumper::Indent = 1; 553 $Data::Dumper::Terse = 0; 554 $self->glog($objdump, LOG_TERSE); 555 556 ## Dump all configuration variables to the log 557 $self->log_config(); 558 559 ## Any other files we find in the piddir directory should be considered old 560 ## Thus, we can remove them 561 my $piddir = $config{piddir}; 562 opendir my $dh, $piddir or die qq{Could not opendir "$piddir": $!\n}; 563 564 ## Nothing else should really be in here, but we will limit with a regex anyway 565 my @pidfiles = grep { /^bucardo.*\.pid$/ } readdir $dh; 566 closedir $dh or warn qq{Could not closedir "$piddir" $!\n}; 567 568 ## Loop through and remove each file found, making a note in the log 569 for my $pidfile (sort @pidfiles) { 570 my $fullfile = File::Spec->catfile( $piddir => $pidfile ); 571 ## Do not erase our own file 572 next if $fullfile eq $self->{pid_file}; 573 ## Everything else can get removed 574 if (-e $fullfile) { 575 if (unlink $fullfile) { 576 $self->glog("Warning: removed old pid file $fullfile", LOG_VERBOSE); 577 } 578 else { 579 ## This will cause problems, but we will drive on 580 $self->glog("Warning: failed to remove pid file $fullfile", LOG_TERSE); 581 } 582 } 583 } 584 585 ## We use a USR2 signal to indicate that the logs should be reopened 586 local $SIG{USR2} = sub { 587 588 $self->glog("Received USR2 from pid $$, who is a $self->{logprefix}", LOG_DEBUG); 589 590 ## Go through and reopen anything that needs reopening 591 ## For now, that is only plain text files 592 for my $logdest (sort keys %{$self->{logcodes}}) { 593 my $loginfo = $self->{logcodes}{$logdest}; 594 595 next if $loginfo->{type} ne 'textfile'; 596 597 my $filename = $loginfo->{filename}; 598 599 ## Reopen the same (named) file with a new filehandle 600 my $newfh; 601 if (! open $newfh, '>>', $filename) { 602 $self->glog("Warning! Unable to open new filehandle for $filename", LOG_WARN); 603 next; 604 } 605 606 ## Turn off buffering on this handle 607 $newfh->autoflush(1); 608 609 ## Overwrite the old sub and point to the new filehandle 610 my $oldfh = $loginfo->{filehandle}; 611 612 $self->glog("Switching to new filehandle for log file $filename", LOG_NORMAL); 613 $loginfo->{code} = sub { print {$newfh} @_, $/ }; 614 $self->glog("Completed reopen of file $filename", LOG_NORMAL); 615 616 ## Close the old filehandle, then remove it from our records 617 close $oldfh or warn "Could not close old filehandle for $filename: $!\n"; 618 $loginfo->{filehandle} = $newfh; 619 620 } 621 622 }; ## end of handling USR2 signals 623 624 ## From this point forward, we want to die gracefully 625 ## We setup our own subroutine to catch any die signals 626 local $SIG{__DIE__} = sub { 627 628 ## Arguments: one 629 ## 1. The error message 630 ## Returns: never (exit 1 or exec new process) 631 632 my $msg = shift; 633 my $line = (caller)[2]; 634 $self->glog("Warning: Killed (line $line): $msg", LOG_WARN); 635 636 ## Was this a database problem? 637 ## We can carefully handle certain classes of errors 638 if ($msg =~ /DBI|DBD/) { 639 640 ## How many bad databases we found 641 my $bad = 0; 642 for my $db (sort keys %{ $self->{sdb} }) { ## need a better name! 643 if (! exists $self->{sdb}{$db}{dbh} ) { 644 $self->glog("Database $db has no database handle", LOG_NORMAL); 645 $bad++; 646 } 647 elsif (! $self->{sdb}{$db}{dbh}->ping()) { 648 $self->glog("Database $db failed ping check", LOG_NORMAL); 649 $msg = 'Ping failed'; 650 $bad++; 651 } 652 } 653 654 if ($bad) { 655 my $changes = $self->check_sync_health(); 656 if ($changes) { 657 ## If we already made a MCP label, go there 658 ## Else fallthrough and assume our bucardo.sync changes stick! 659 if ($self->{mcp_loop_started}) { 660 $self->glog('Going to restart the MCP loop, as syncs have changed', LOG_VERBOSE); 661 die 'We are going to redo the MCP loop'; ## goes to end of mcp main eval 662 } 663 } 664 } 665 } 666 667 ## The error message determines if we try to resurrect ourselves or not 668 my $respawn = ( 669 $msg =~ /DBI connect/ ## From DBI 670 or $msg =~ /Ping failed/ ## Set below 671 ) ? 1 : 0; 672 673 ## Sometimes we don't want to respawn at all (e.g. during some tests) 674 if (! $config{mcp_dbproblem_sleep}) { 675 $self->glog('Database problem, but will not attempt a respawn due to mcp_dbproblem_sleep=0', LOG_TERSE); 676 $respawn = 0; 677 } 678 679 ## Create some output for the mail message 680 my $diesubject = "Bucardo MCP $$ was killed"; 681 my $diebody = "MCP $$ was killed: $msg"; 682 683 ## Most times we *do* want to respawn 684 if ($respawn) { 685 $self->glog("Database problem, will respawn after a short sleep: $config{mcp_dbproblem_sleep}", LOG_TERSE); 686 $diebody .= " (will attempt respawn in $config{mcp_dbproblem_sleep} seconds)"; 687 $diesubject .= ' (respawning)'; 688 } 689 690 ## Callers can prevent an email being sent by setting this before they die 691 if (! $self->{clean_exit}) { 692 $self->send_mail({ body => $diebody, subject => $diesubject }); 693 } 694 695 ## Kill kids, remove pidfile, update tables, etc. 696 $self->cleanup_mcp("Killed: $msg"); 697 698 ## If we are not respawning, simply exit right now 699 exit 1 if ! $respawn; 700 701 ## We will attempt a restart, but sleep a while first to avoid constant restarts 702 $self->glog("Sleep time: $config{mcp_dbproblem_sleep}", LOG_TERSE); 703 sleep($config{mcp_dbproblem_sleep}); 704 705 ## Do a quick check for a stopfile 706 ## Bail if the stopfile exists 707 if (-e $self->{stop_file}) { 708 $self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_WARN); 709 my $message = 'Found stopfile'; 710 711 ## Grab the reason, if it exists, so we can propagate it onward 712 my $mcpreason = get_reason(0); 713 if ($mcpreason) { 714 $message .= ": $mcpreason"; 715 } 716 717 ## Stop controllers, disconnect, remove PID file, etc. 718 $self->cleanup_mcp("$message\n"); 719 720 $self->glog('Exiting', LOG_WARN); 721 exit 0; 722 } 723 724 ## We assume this is bucardo, and that we are in same directory as when called 725 my $RUNME = $old0; 726 ## Check to see if $RUNME is executable as is, before we assume we're in the same directory 727 if (! -x $RUNME) { 728 $RUNME = "./$RUNME" if index ($RUNME,'.') != 0; 729 } 730 731 my $mcpreason = 'Attempting automatic respawn after MCP death'; 732 $self->glog("Respawn attempt: $RUNME @{ $opts } start '$mcpreason'", LOG_TERSE); 733 734 ## Replace ourselves with a new process running this command 735 { exec $RUNME, @{ $opts }, 'start', $mcpreason }; 736 $self->glog("Could not exec $RUNME: $!", LOG_WARN); 737 738 }; ## end SIG{__DIE__} handler sub 739 740 ## This resets listeners, kills kids, and loads/activates syncs 741 my $active_syncs = $self->reload_mcp(); 742 743 if (!$active_syncs && $self->{exit_on_nosync}) { 744 ## No syncs means no reason for us to hang around, so we exit 745 $self->glog('No active syncs were found, so we are exiting', LOG_WARN); 746 $self->db_notify($masterdbh, 'nosyncs', 1); 747 $self->cleanup_mcp('No active syncs'); 748 exit 1; 749 } 750 751 ## Report which syncs are active 752 $self->glog("Active syncs: $active_syncs", LOG_TERSE); 753 754 ## We want to reload everything if someone HUPs us 755 local $SIG{HUP} = sub { 756 $self->reload_mcp(); 757 }; 758 759 ## We need KIDs to tell us their PID so we can deregister them 760 $self->{kidpidlist} = {}; 761 762 ## Let any listeners know we have gotten this far 763 $self->db_notify($masterdbh, 'started', 1); 764 765 ## For optimization later on, we need to know which syncs are 'fullcopy' 766 for my $syncname (keys %{ $self->{sync} }) { 767 768 my $s = $self->{sync}{$syncname}; 769 770 ## Skip inactive or paused syncs 771 next if !$s->{mcp_active} or $s->{paused}; 772 773 ## Walk through each database and check the roles, discarding inactive dbs 774 my %rolecount; 775 for my $db (values %{ $s->{db} }) { 776 next if $db->{status} ne 'active'; 777 $rolecount{$db->{role}}++; 778 } 779 780 ## Default to being fullcopy 781 $s->{fullcopy} = 1; 782 783 ## We cannot be a fullcopy sync if: 784 if ($rolecount{'target'} ## there are any target dbs 785 or $rolecount{'source'} > 1 ## there is more than one source db 786 or ! $rolecount{'fullcopy'}) { ## there are no fullcopy dbs 787 $s->{fullcopy} = 0; 788 } 789 } 790 791 792 ## Because a sync may have gotten a notice while we were down, 793 ## we auto-kick all eligible syncs 794 ## We also need to see if we can prevent the VAC daemon from running, 795 ## if there are no databases with bucardo schemas 796 $self->{needsvac} = 0; 797 for my $syncname (keys %{ $self->{sync} }) { 798 799 my $s = $self->{sync}{$syncname}; 800 801 ## Default to starting in a non-kicked mode 802 $s->{kick_on_startup} = 0; 803 804 ## Skip inactive or paused syncs 805 next if !$s->{mcp_active} or $s->{paused}; 806 807 ## Skip fullcopy syncs 808 next if $s->{fullcopy}; 809 810 ## Right now, the vac daemon is only useful for source Postgres databases 811 ## Of course, it is not needed for fullcopy syncs 812 for my $db (values %{ $s->{db} }) { 813 if ($db->{status} eq 'active' 814 and $db->{dbtype} eq 'postgres' 815 and $db->{role} eq 'source') { 816 ## We need to increment it for any matches in sdb, regardless of which sync initially set it! 817 $self->{sdb}{ $db->{name} }{needsvac} = 2; 818 $self->{needsvac} = 1; 819 } 820 } 821 822 ## Skip if autokick is false 823 next if ! $s->{autokick}; 824 825 ## Kick it! 826 $s->{kick_on_startup} = 1; 827 } 828 829 ## Start the main loop 830 { 831 my $value = $self->mcp_main(); 832 redo if $value; 833 } 834 835 return; ## no critic 836 837} ## end of start_mcp 838 839 840sub create_mcp_pid_file { 841 842 ## Create a file containing the PID of the current MCP, 843 ## plus a few other details 844 ## Arguments: one 845 ## 1. Message (usually just the original invocation line) 846 ## Returns: undef 847 848 my $self = shift; 849 my $message = shift || ''; 850 851 open my $pidfh, '>', $self->{pid_file} 852 or die qq{Cannot write to $self->{pid_file}: $!\n}; 853 854 ## Inside our newly created PID file, print out PID on the first line 855 ## - print how the script was originally invoked on the second line (old $0), 856 ## - print the current time on the third line 857 my $now = scalar localtime; 858 print {$pidfh} "$$\n$message\n$now\n"; 859 close $pidfh or warn qq{Could not close "$self->{pid_file}": $!\n}; 860 861 return; 862 863} ## end of create_mcp_pid_file 864 865 866sub mcp_main { 867 868 ## The main MCP process 869 ## Arguments: none 870 ## Returns: undef (but almost always just exits with 0 or 1) 871 872 my $self = shift; 873 874 my $maindbh = $self->{masterdbh}; 875 my $sync = $self->{sync}; 876 877 my $SQL; 878 879 ## Used to gather up and handle any notices received via the listen/notify system 880 my $notice; 881 882 ## Used to keep track of the last time we pinged the databases 883 my $lastpingcheck = 0; 884 885 ## Keep track of how long since we checked on the VAC daemon 886 my $lastvaccheck = 0; 887 888 $self->glog('Entering main loop', LOG_TERSE); 889 890 $self->{mcp_loop_started} = 1; 891 892 MCP: { 893 894 ## We eval the whole loop so we can cleanly redo it if needed 895 my $mcp_loop_finished = 0; 896 eval { 897 898 ## Bail if the stopfile exists 899 if (-e $self->{stop_file}) { 900 $self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_WARN); 901 my $msg = 'Found stopfile'; 902 903 ## Grab the reason, if it exists, so we can propagate it onward 904 my $mcpreason = get_reason(0); 905 if ($mcpreason) { 906 $msg .= ": $mcpreason"; 907 } 908 909 ## Stop controllers, disconnect, remove PID file, etc. 910 $self->cleanup_mcp("$msg\n"); 911 912 $self->glog('Exiting', LOG_WARN); 913 exit 0; 914 } 915 916 ## Startup the VAC daemon as needed 917 ## May be off via user configuration, or because of no valid databases 918 if ($config{bucardo_vac} and $self->{needsvac}) { 919 920 ## Check on it occasionally (different than the running time) 921 if (time() - $lastvaccheck >= $config{mcp_vactime}) { 922 923 ## Is it alive? If not, spawn 924 my $pidfile = "$config{piddir}/bucardo.vac.pid"; 925 if (! -e $pidfile) { 926 $self->fork_vac(); 927 } 928 929 $lastvaccheck = time(); 930 931 } ## end of time to check vac 932 933 } ## end if bucardo_vac 934 935 ## Every once in a while, make sure our database connections are still there 936 if (time() - $lastpingcheck >= $config{mcp_pingtime}) { 937 938 ## This message must have "Ping failed" to match the $respawn above 939 $maindbh->ping or die qq{Ping failed for main database!\n}; 940 941 ## Check each (pingable) remote database in undefined order 942 for my $dbname (keys %{ $self->{sdb} }) { 943 944 my $d = $self->{sdb}{$dbname}; 945 946 next if $d->{dbtype} =~ /flat|mongo|redis/o; 947 948 my $try_reconnect = 0; 949 if ($d->{status} eq 'stalled') { 950 $self->glog("Trying to connect to stalled database $dbname", LOG_VERBOSE); 951 $try_reconnect = 1; 952 } 953 elsif (! $d->{dbh}->ping) { 954 $self->glog("Ping failed for database $dbname, trying to reconnect", LOG_NORMAL); 955 } 956 957 if ($try_reconnect) { 958 959 ## Sleep a hair so we don't reloop constantly 960 sleep 0.5; 961 undef $d->{backend}; 962 { 963 local $SIG{__DIE__} = 'IGNORE'; 964 eval { 965 ($d->{backend}, $d->{dbh}) = $self->connect_database($dbname); 966 }; 967 } 968 if (defined $d->{backend}) { 969 $self->show_db_version_and_time($d->{dbh}, $d->{backend}, qq{Database "$dbname" }); 970 $d->{status} = 'active'; ## In case it was stalled 971 } 972 else { 973 $self->glog("Unable to reconnect to database $dbname!", LOG_WARN); 974 ## We may want to throw an exception if this keeps happening 975 ## We may also want to adjust lastpingcheck so we check more often 976 } 977 } 978 } 979 980 ## Reset our internal counter to 'now' 981 $lastpingcheck = time(); 982 983 } ## end of checking database connections 984 985 ## Add in any messages from the main database and reset the notice hash 986 ## Ignore things we may have sent ourselves 987 $notice = $self->db_get_notices($maindbh, $self->{mcp_backend}); 988 989 ## Add in any messages from each remote database 990 for my $dbname (keys %{ $self->{sdb} }) { 991 992 my $d = $self->{sdb}{$dbname}; 993 994 next if $d->{dbtype} ne 'postgres'; 995 996 next if $d->{status} eq 'stalled'; 997 998 my $nlist = $self->db_get_notices($d->{dbh}); 999 $d->{dbh}->rollback(); 1000 for my $name (keys %{ $nlist } ) { 1001 if (! exists $notice->{$name}) { 1002 $notice->{$name} = $nlist->{$name}; 1003 } 1004 else { 1005 for my $pid (keys %{ $nlist->{$name}{pid} }) { 1006 $notice->{$name}{pid}{$pid}++; 1007 } 1008 } 1009 } 1010 } 1011 1012 ## Handle each notice one by one 1013 for my $name (sort keys %{ $notice }) { 1014 1015 my $npid = $notice->{$name}{firstpid}; 1016 1017 ## Request to stop everything 1018 if ('mcp_fullstop' eq $name) { 1019 $self->glog("Received full stop notice from PID $npid, leaving", LOG_TERSE); 1020 $self->cleanup_mcp("Received stop NOTICE from PID $npid"); 1021 exit 0; 1022 } 1023 1024 ## Request that a named sync get kicked 1025 elsif ($name =~ /^kick_sync_(.+)/o) { 1026 my $syncname = $1; 1027 1028 ## Prepare to send some sort of log message 1029 my $msg = ''; 1030 1031 ## We will not kick if this sync does not exist or it is inactive 1032 if (! exists $self->{sync}{$syncname}) { 1033 $msg = qq{Warning: Unknown sync to be kicked: "$syncname"\n}; 1034 } 1035 elsif (! $self->{sync}{$syncname}{mcp_active}) { 1036 $msg = qq{Cannot kick inactive sync "$syncname"}; 1037 } 1038 elsif ($self->{sync}{$syncname}{paused}) { 1039 $msg = qq{Cannot kick paused sync "$syncname"}; 1040 } 1041 ## We also won't kick if this was created by a kid 1042 ## This can happen as our triggerkicks may be set to 'always' 1043 elsif (exists $self->{kidpidlist}{$npid}) { 1044 $self->glog(qq{Not kicking sync "$syncname" as it came from KID $npid}, LOG_DEBUG); 1045 } 1046 else { 1047 ## Kick it! 1048 $sync->{$syncname}{kick_on_startup} = 1; 1049 } 1050 1051 if ($msg) { 1052 $self->glog($msg, $msg =~ /Unknown/ ? LOG_TERSE : LOG_VERBOSE); 1053 ## As we don't want people to wait around for a syncdone... 1054 $self->db_notify($maindbh, "syncerror_$syncname", 1); 1055 } 1056 } 1057 1058 ## A sync has finished 1059 elsif ($name =~ /^syncdone_(.+)/o) { 1060 my $syncdone = $1; 1061 $self->glog("Sync $syncdone has finished", LOG_DEBUG); 1062 1063 ## Echo out to anyone listening 1064 $self->db_notify($maindbh, $name, 1); 1065 1066 ## If this was a onetimecopy sync, flip it off 1067 $sync->{$syncdone}{onetimecopy} = 0; 1068 } 1069 ## A sync has been killed 1070 elsif ($name =~ /^synckill_(.+)/o) { 1071 my $syncdone = $1; 1072 $self->glog("Sync $syncdone has been killed", LOG_DEBUG); 1073 ## Echo out to anyone listening 1074 $self->db_notify($maindbh, $name, 1); 1075 ## Check on the health of our databases, in case that was the reason the sync was killed 1076 $self->check_sync_health(); 1077 } 1078 ## Request to pause a sync 1079 elsif ($name =~ /^pause_sync_(.+)/o) { 1080 my $syncname = $1; 1081 my $msg; 1082 1083 ## We will not pause if this sync does not exist or it is inactive 1084 if (! exists $self->{sync}{$syncname}) { 1085 $msg = qq{Warning: Unknown sync to be paused: "$syncname"\n}; 1086 } 1087 elsif (! $self->{sync}{$syncname}{mcp_active}) { 1088 $msg = qq{Cannot pause inactive sync "$syncname"}; 1089 } 1090 else { 1091 ## Mark it as paused, stop the kids and controller 1092 $sync->{$syncname}{paused} = 1; 1093 my $stopsync = "stopsync_$syncname"; 1094 $self->db_notify($maindbh, "kid_$stopsync"); 1095 $self->db_notify($maindbh, "ctl_$stopsync"); 1096 $maindbh->commit(); 1097 $self->glog(qq{Set sync "$syncname" as paused}, LOG_VERBOSE); 1098 } 1099 if (defined $msg) { 1100 $self->glog($msg, LOG_TERSE); 1101 } 1102 } 1103 ## Request to resume a sync 1104 elsif ($name =~ /^resume_sync_(.+)/o) { 1105 my $syncname = $1; 1106 my $msg; 1107 1108 ## We will not resume if this sync does not exist or it is inactive 1109 if (! exists $self->{sync}{$syncname}) { 1110 $msg = qq{Warning: Unknown sync to be resumed: "$syncname"\n}; 1111 } 1112 elsif (! $self->{sync}{$syncname}{mcp_active}) { 1113 $msg = qq{Cannot resume inactive sync "$syncname"}; 1114 } 1115 else { 1116 ## Mark it as resumed 1117 my $s = $sync->{$syncname}; 1118 $s->{paused} = 0; 1119 ## Since we may have accumulated deltas while pasued, set to autokick if needed 1120 if (!$s->{fullcopy} and $s->{autokick}) { 1121 $s->{kick_on_startup} = 1; 1122 } 1123 $self->glog(qq{Set sync "$syncname" as resumed}, LOG_VERBOSE); 1124 ## MCP will restart the CTL on next loop around 1125 } 1126 if (defined $msg) { 1127 $self->glog($msg, LOG_TERSE); 1128 } 1129 } 1130 ## Request to reload the configuration file 1131 elsif ('reload_config' eq $name) { 1132 $self->glog('Reloading configuration table', LOG_TERSE); 1133 $self->reload_config_database(); 1134 1135 ## Output all values to the log file again 1136 $self->log_config(); 1137 1138 ## We need to reload ourself as well 1139 ## XXX Not needed for some items! e.g. mcp_pingtime 1140 $self->reload_mcp(); 1141 1142 ## Let anyone listening know we are done 1143 $self->db_notify($maindbh, 'reload_config_finished', 1); 1144 } 1145 1146 ## Request to reload the MCP 1147 elsif ('mcp_reload' eq $name) { 1148 $self->glog('Reloading MCP', LOG_TERSE); 1149 $self->reload_mcp(); 1150 1151 ## Let anyone listening know we are done 1152 $self->db_notify($maindbh, 'reloaded_mcp', 1); 1153 } 1154 1155 ## Request for a ping via listen/notify 1156 elsif ('mcp_ping' eq $name) { 1157 $self->glog("Got a ping from PID $npid, issuing pong", LOG_DEBUG); 1158 $self->db_notify($maindbh, 'mcp_pong', 1); 1159 } 1160 1161 ## Request that we parse and empty the log message table 1162 elsif ('log_message' eq $name) { 1163 $self->glog('Checking for log messages', LOG_DEBUG); 1164 $SQL = 'SELECT msg,cdate FROM bucardo_log_message ORDER BY cdate'; 1165 my $sth = $maindbh->prepare_cached($SQL); 1166 $count = $sth->execute(); 1167 if ($count ne '0E0') { 1168 for my $row (@{$sth->fetchall_arrayref()}) { 1169 $self->glog("MESSAGE ($row->[1]): $row->[0]", LOG_TERSE); 1170 } 1171 $maindbh->do('DELETE FROM bucardo_log_message'); 1172 $maindbh->commit(); 1173 } 1174 else { 1175 $sth->finish(); 1176 } 1177 } 1178 1179 ## Request that a named sync get reloaded 1180 elsif ($name =~ /^reload_sync_(.+)/o) { 1181 my $syncname = $1; 1182 my $succeeded = 0; 1183 1184 ## Skip if the sync does not exist or is inactive 1185 if (! exists $sync->{$syncname}) { 1186 $self->glog(qq{Invalid sync reload: "$syncname"}, LOG_TERSE); 1187 } 1188 elsif (!$sync->{$syncname}{mcp_active}) { 1189 $self->glog(qq{Cannot reload: sync "$syncname" is not active}, LOG_TERSE); 1190 } 1191 else { 1192 1193 ## reload overrides a pause 1194 if ($sync->{$syncname}{paused}) { 1195 $self->glog(qq{Resuming paused sync "$syncname"}, LOG_TERSE); 1196 $sync->{$syncname}{paused} = 0; 1197 } 1198 1199 $self->glog(qq{Deactivating sync "$syncname"}, LOG_TERSE); 1200 $self->deactivate_sync($sync->{$syncname}); 1201 1202 ## Reread from the database 1203 $SQL = q{SELECT *, } 1204 . q{COALESCE(EXTRACT(epoch FROM checktime),0) AS checksecs, } 1205 . q{COALESCE(EXTRACT(epoch FROM lifetime),0) AS lifetimesecs } 1206 . q{FROM bucardo.sync WHERE name = ?}; 1207 my $sth = $maindbh->prepare($SQL); 1208 $count = $sth->execute($syncname); 1209 if ($count eq '0E0') { 1210 $sth->finish(); 1211 $self->glog(qq{Warning! Cannot reload sync "$syncname": no longer in the database!}, LOG_WARN); 1212 $maindbh->commit(); 1213 next; ## Handle the next notice 1214 } 1215 1216 ## XXX: Actually do a full disconnect and redo all the items in here 1217 1218 my $info = $sth->fetchall_arrayref({})->[0]; 1219 $maindbh->commit(); 1220 1221 ## Only certain things can be changed "on the fly" 1222 for my $val (qw/checksecs stayalive deletemethod status autokick 1223 analyze_after_copy vacuum_after_copy targetgroup targetdb 1224 onetimecopy lifetimesecs maxkicks rebuild_index 1225 conflict_strategy/) { 1226 $sync->{$syncname}{$val} = $self->{sync}{$syncname}{$val} = $info->{$val}; 1227 } 1228 1229 ## XXX: Todo: Fix those double assignments 1230 1231 ## Empty all of our custom code arrays 1232 for my $key (grep { /^code_/ } sort keys %{ $self->{sync}{$syncname} }) { 1233 $sync->{$syncname}{$key} = $self->{sync}{$syncname}{$key} = []; 1234 } 1235 1236 sleep 2; ## XXX TODO: Actually wait somehow, perhaps fork 1237 1238 $self->glog("Reactivating sync $syncname", LOG_TERSE); 1239 $sync->{$syncname}{mcp_active} = 0; 1240 if (! $self->activate_sync($sync->{$syncname})) { 1241 $self->glog(qq{Warning! Reactivation of sync "$syncname" failed}, LOG_WARN); 1242 } 1243 else { 1244 ## Let anyone listening know the sync is now ready 1245 $self->db_notify($maindbh, "reloaded_sync_$syncname", 1); 1246 $succeeded = 1; 1247 } 1248 $maindbh->commit(); 1249 1250 $self->glog("Succeeded: $succeeded", LOG_WARN); 1251 } 1252 $self->db_notify($maindbh, "reload_error_sync_$syncname", 1) 1253 if ($succeeded != 1); 1254 } 1255 1256 ## Request that a named sync get activated 1257 elsif ($name =~ /^activate_sync_(.+)/o) { 1258 my $syncname = $1; 1259 if (! exists $sync->{$syncname}) { 1260 $self->glog(qq{Invalid sync activation: "$syncname"}, LOG_TERSE); 1261 } 1262 elsif ($sync->{$syncname}{mcp_active}) { 1263 $self->glog(qq{Sync "$syncname" is already activated}, LOG_TERSE); 1264 $self->db_notify($maindbh, "activated_sync_$syncname", 1); 1265 } 1266 elsif ($self->activate_sync($sync->{$syncname})) { 1267 $sync->{$syncname}{mcp_active} = 1; 1268 ## Just in case: 1269 $sync->{$syncname}{paused} = 0; 1270 $maindbh->do( 1271 'UPDATE sync SET status = ? WHERE name = ?', 1272 undef, 'active', $syncname 1273 ); 1274 } 1275 } 1276 ## Request that a named sync get deactivated 1277 elsif ($name =~ /^deactivate_sync_(.+)/o) { 1278 my $syncname = $1; 1279 if (! exists $sync->{$syncname}) { 1280 $self->glog(qq{Invalid sync "$syncname"}, LOG_TERSE); 1281 } 1282 elsif (! $sync->{$syncname}{mcp_active}) { 1283 $self->glog(qq{Sync "$syncname" is already deactivated}, LOG_TERSE); 1284 $self->db_notify($maindbh, "deactivated_sync_$syncname", 1); 1285 } 1286 elsif ($self->deactivate_sync($sync->{$syncname})) { 1287 $sync->{$syncname}{mcp_active} = 0; 1288 $maindbh->do( 1289 'UPDATE sync SET status = ? WHERE name = ?', 1290 undef, 'inactive', $syncname 1291 ); 1292 } 1293 } 1294 1295 # Serialization/deadlock problems; now the child is gonna sleep. 1296 elsif ($name =~ /^syncsleep_(.+)/o) { 1297 my $syncname = $1; 1298 $self->glog("Sync $syncname could not serialize, will sleep", LOG_DEBUG); 1299 1300 ## Echo out to anyone listening 1301 $self->db_notify($maindbh, $name, 1); 1302 } 1303 1304 ## A kid reporting in. We just store the PID 1305 elsif ('kid_pid_start') { 1306 for my $lpid (keys %{ $notice->{$name}{pid} }) { 1307 $self->{kidpidlist}{$lpid} = 1; 1308 } 1309 } 1310 1311 ## A kid leaving. We remove the stored PID. 1312 elsif ('kid_pid_stop') { 1313 for my $lpid (keys %{ $notice->{$name}{pid} }) { 1314 delete $self->{kidpidlist}{$lpid}; 1315 } 1316 } 1317 1318 ## Someone giving us a hint that a database may be down 1319 elsif ($name =~ /dead_db_(.+)/) { 1320 my $dbname = $1; 1321 $self->glog(qq{Got a hint that database "$dbname" may be down. Let's check it out!}, LOG_NORMAL); 1322 my $changes = $self->check_sync_health($dbname); 1323 } 1324 1325 ## Should not happen, but let's at least log it 1326 else { 1327 $self->glog("Warning: received unknown message $name from $npid!", LOG_TERSE); 1328 } 1329 1330 } ## end each notice 1331 1332 $maindbh->commit(); 1333 1334 ## Just in case this changed behind our back: 1335 $sync = $self->{sync}; 1336 1337 ## Startup controllers for all eligible syncs 1338 SYNC: for my $syncname (keys %$sync) { 1339 1340 my $s = $sync->{$syncname}; 1341 1342 ## Skip if this sync has not been activated 1343 next if ! $s->{mcp_active}; 1344 1345 ## Skip if this one is paused 1346 next if $s->{paused}; 1347 1348 ## Skip is this one is stalled 1349 next if $s->{status} eq 'stalled'; 1350 1351 ## If this is not a stayalive, AND is not being kicked, skip it 1352 next if ! $s->{stayalive} and ! $s->{kick_on_startup}; 1353 1354 ## If this is a fullcopy sync, skip unless it is being kicked 1355 next if $s->{fullcopy} and ! $s->{kick_on_startup}; 1356 1357 ## If this is a previous stayalive, see if it is active, kick if needed 1358 if ($s->{stayalive} and $s->{controller}) { 1359 $count = kill 0 => $s->{controller}; 1360 ## If kill 0 returns nothing, the controller is gone, so create a new one 1361 if (! $count) { 1362 $self->glog("Could not find controller $s->{controller}, will create a new one. Kicked is $s->{kick_on_startup}", LOG_TERSE); 1363 $s->{controller} = 0; 1364 } 1365 else { ## Presume it is alive and listening to us, restart and kick as needed 1366 if ($s->{kick_on_startup}) { 1367 ## See if controller needs to be killed, because of time limit or job count limit 1368 my $restart_reason = ''; 1369 1370 ## We can kill and restart a controller after a certain number of kicks 1371 if ($s->{maxkicks} > 0 and $s->{ctl_kick_counts} >= $s->{maxkicks}) { 1372 $restart_reason = "Total kicks ($s->{ctl_kick_counts}) >= limit ($s->{maxkicks})"; 1373 } 1374 1375 ## We can kill and restart a controller after a certain amount of time 1376 elsif ($s->{lifetimesecs} > 0) { 1377 my $thistime = time(); 1378 my $timediff = $thistime - $s->{start_time}; 1379 if ($thistime - $s->{start_time} > $s->{lifetimesecs}) { 1380 $restart_reason = "Time is $timediff, limit is $s->{lifetimesecs} ($s->{lifetime})"; 1381 } 1382 } 1383 1384 if ($restart_reason) { 1385 ## Kill and restart controller 1386 $self->glog("Restarting controller for sync $syncname. $restart_reason", LOG_TERSE); 1387 kill $signumber{USR1} => $s->{controller}; 1388 1389 ## Create a new controller 1390 $self->fork_controller($s, $syncname); 1391 } 1392 else { 1393 ## Perform the kick 1394 my $notify = "ctl_kick_$syncname"; 1395 $self->db_notify($maindbh, $notify); 1396 $self->glog(qq{Sent a kick to controller $s->{controller} for sync "$syncname"}, LOG_DEBUG); 1397 } 1398 1399 ## Reset so we don't kick the next round 1400 $s->{kick_on_startup} = 0; 1401 1402 ## Track how many times we've kicked 1403 $s->{ctl_kick_counts}++; 1404 } 1405 next SYNC; 1406 } 1407 } 1408 1409 ## At this point, we are either: 1410 ## 1. Not a stayalive 1411 ## 2. A stayalive that has not been run yet 1412 ## 3. A stayalive that has been run but is not responding 1413 1414 ## Make sure there is nothing out there already running 1415 my $syncname = $s->{name}; 1416 my $pidfile = "$config{piddir}/bucardo.ctl.sync.$syncname.pid"; 1417 if ($s->{mcp_changed}) { 1418 $self->glog(qq{Checking for existing controllers for sync "$syncname"}, LOG_VERBOSE); 1419 } 1420 1421 if (-e $pidfile and ! $s->{mcp_problemchild}) { 1422 $self->glog("File exists staylive=$s->{stayalive} controller=$s->{controller}", LOG_TERSE); 1423 my $pid; 1424 if (!open $pid, '<', $pidfile) { 1425 $self->glog(qq{Warning: Could not open file "$pidfile": $!}, LOG_WARN); 1426 $s->{mcp_problemchild} = 1; 1427 next SYNC; 1428 } 1429 my $oldpid = <$pid>; 1430 chomp $oldpid; 1431 close $pid or warn qq{Could not close "$pidfile": $!\n}; 1432 ## We don't need to know about this every time 1433 if ($s->{mcp_changed}) { 1434 $self->glog(qq{Found previous controller $oldpid from "$pidfile"}, LOG_TERSE); 1435 } 1436 if ($oldpid !~ /^\d+$/) { 1437 $self->glog(qq{Warning: Invalid pid found inside of file "$pidfile" ($oldpid)}, LOG_WARN); 1438 $s->{mcp_changed} = 0; 1439 $s->{mcp_problemchild} = 2; 1440 next SYNC; 1441 } 1442 ## Is it still alive? 1443 $count = kill 0 => $oldpid; 1444 if ($count==1) { 1445 if ($s->{mcp_changed}) { 1446 $self->glog(qq{Skipping sync "$syncname", seems to be already handled by $oldpid}, LOG_VERBOSE); 1447 ## Make sure this kid is still running 1448 $count = kill 0 => $oldpid; 1449 if (!$count) { 1450 $self->glog(qq{Warning! PID $oldpid was not found. Removing PID file}, LOG_WARN); 1451 unlink $pidfile or $self->glog("Warning! Failed to unlink $pidfile", LOG_WARN); 1452 $s->{mcp_problemchild} = 3; 1453 next SYNC; 1454 } 1455 $s->{mcp_changed} = 0; 1456 } 1457 if (! $s->{stayalive}) { 1458 $self->glog(qq{Non stayalive sync "$syncname" still active - sending it a notify}, LOG_NORMAL); 1459 } 1460 my $notify = "ctl_kick_$syncname"; 1461 $self->db_notify($maindbh, $notify); 1462 $s->{kick_on_startup} = 0; 1463 next SYNC; 1464 } 1465 $self->glog("No active pid $oldpid found. Killing just in case, and removing file", LOG_TERSE); 1466 $self->kill_bucardo_pid($oldpid => 'normal'); 1467 unlink $pidfile or $self->glog("Warning! Failed to unlink $pidfile", LOG_WARN); 1468 $s->{mcp_changed} = 1; 1469 } ## end if pidfile found for this sync 1470 1471 ## We may have found an error in the pid file detection the first time through 1472 $s->{mcp_problemchild} = 0; 1473 1474 ## Fork off the controller, then clean up the $s hash 1475 $self->{masterdbh}->commit(); 1476 $self->fork_controller($s, $syncname); 1477 $s->{kick_on_startup} = 0; 1478 $s->{mcp_changed} = 1; 1479 1480 } ## end each sync 1481 1482 sleep $config{mcp_loop_sleep}; 1483 1484 $mcp_loop_finished = 1; 1485 1486 }; # end of eval 1487 1488 redo MCP if $mcp_loop_finished; 1489 1490 ## We may want to redo if the error was not *that* fatal 1491 if ($@ =~ /redo/) { 1492 $self->glog('Going to restart the main MCP loop', LOG_VERBOSE); 1493 redo MCP; 1494 } 1495 1496 } ## end of MCP loop 1497 1498 return; 1499 1500} ## end of mcp_main 1501 1502 1503sub check_sync_health { 1504 1505 ## Check every database used by a sync 1506 ## Typically called on demand when we know something is wrong 1507 ## Marks any unreachable databases, and their syncs, as stalled 1508 ## Arguments: zero or one 1509 ## 1. Optional name of database to hone in on 1510 ## Returns: number of bad databases detected 1511 1512 my $self = shift; 1513 my $dbnamematch = shift || ''; 1514 1515 my $SQL; 1516 1517 $self->glog('Starting check_sync_health', LOG_NORMAL); 1518 1519 ## How many bad databases did we find? 1520 my $bad_dbs = 0; 1521 1522 ## No need to check databases more than once, as they can span across syncs 1523 my $db_checked = {}; 1524 1525 ## Do this at the sync level, rather than 'sdb', as we don't 1526 ## want to check non-active syncs at all 1527 SYNC: for my $syncname (sort keys %{ $self->{sync} }) { 1528 1529 my $sync = $self->{sync}{$syncname}; 1530 1531 if ($sync->{status} ne 'active') { 1532 $self->glog("Skipping $sync->{status} sync $syncname", LOG_NORMAL); 1533 next SYNC; 1534 } 1535 1536 ## Walk through each database used by this sync 1537 DB: for my $dbname (sort keys %{ $sync->{db} }) { 1538 1539 ## Only check each database (by name) once 1540 next if $db_checked->{$dbname}++; 1541 1542 ## If limiting to a single database, only check that one 1543 next if $dbnamematch and $dbnamematch ne $dbname; 1544 1545 $self->glog("Checking database $dbname for sync $syncname", LOG_DEBUG); 1546 1547 my $dbinfo = $sync->{db}{$dbname}; 1548 1549 ## We only bother checking ones that are currently active 1550 if ($dbinfo->{status} ne 'active') { 1551 $self->glog("Skipping $dbinfo->{status} database $dbname for sync $syncname", LOG_NORMAL); 1552 next DB; 1553 } 1554 1555 ## Is this database valid or not? 1556 my $isbad = 0; 1557 1558 my $dbh = $dbinfo->{dbh}; 1559 1560 if (! ref $dbh) { 1561 $self->glog("Database handle for database $dbname does not look valid", LOG_NORMAL); 1562 if ($dbinfo->{dbtype} eq 'postgres') { 1563 $isbad = 1; 1564 } 1565 else { 1566 ## TODO: Account for other non dbh types 1567 next DB; 1568 } 1569 } 1570 elsif (ref $dbh =~ /DBI/ and ! $dbh->ping() ) { 1571 $isbad = 1; 1572 $self->glog("Database $dbname failed ping", LOG_NORMAL); 1573 } 1574 1575 ## If not marked as bad, assume good and move on 1576 next DB unless $isbad; 1577 1578 ## Retry connection afresh: wrap in eval as one of these is likely to fail! 1579 undef $dbinfo->{dbh}; 1580 1581 eval { 1582 ($dbinfo->{backend}, $dbinfo->{dbh}) = $self->connect_database($dbname); 1583 $self->show_db_version_and_time($dbinfo->{dbh}, $dbinfo->{backend}, qq{Database "$dbname" }); 1584 }; 1585 1586 ## If we cannot connect, mark the db (and the sync) as stalled 1587 if (! defined $dbinfo->{dbh}) { 1588 $self->glog("Database $dbname is unreachable, marking as stalled", LOG_NORMAL); 1589 $dbinfo->{status} = 'stalled'; 1590 $bad_dbs++; 1591 if ($sync->{status} ne 'stalled') { 1592 $self->glog("Marked sync $syncname as stalled", LOG_NORMAL); 1593 $sync->{status} = 'stalled'; 1594 $SQL = 'UPDATE bucardo.sync SET status = ? WHERE name = ?'; 1595 eval { 1596 my $sth = $self->{masterdbh}->prepare($SQL); 1597 $sth->execute('stalled',$syncname); 1598 }; 1599 if ($@) { 1600 $self->glog("Failed to set sync $syncname as stalled: $@", LOG_WARN); 1601 $self->{masterdbh}->rollback(); 1602 } 1603 } 1604 $SQL = 'UPDATE bucardo.db SET status = ? WHERE name = ?'; 1605 my $sth = $self->{masterdbh}->prepare($SQL); 1606 eval { 1607 $sth->execute('stalled',$dbname); 1608 $self->{masterdbh}->commit(); 1609 }; 1610 if ($@) { 1611 $self->glog("Failed to set db $dbname as stalled: $@", LOG_WARN); 1612 $self->{masterdbh}->rollback(); 1613 } 1614 1615 } 1616 1617 } ## end each database in this sync 1618 1619 } ## end each sync 1620 1621 ## If any databases were marked as bad, go ahead and stall other syncs that are using them 1622 ## (todo) 1623 1624 return $bad_dbs; 1625 1626} ## end of check_sync_health 1627 1628 1629sub restore_syncs { 1630 1631 ## Try to restore stalled syncs by checking its stalled databases 1632 ## Arguments: none 1633 ## Returns: number of syncs restored 1634 1635 my $self = shift; 1636 1637 my $SQL; 1638 1639 $self->glog('Starting restore_syncs', LOG_DEBUG); 1640 1641 ## How many syncs did we restore? 1642 my $restored_syncs = 0; 1643 1644 ## No need to check databases more than once, as they can span across syncs 1645 my $db_checked = {}; 1646 1647 ## If a sync is stalled, check its databases 1648 SYNC: for my $syncname (sort keys %{ $self->{sync} }) { 1649 1650 my $sync = $self->{sync}{$syncname}; 1651 1652 next SYNC if $sync->{status} ne 'stalled'; 1653 1654 $self->glog("Checking stalled sync $syncname", LOG_DEBUG); 1655 1656 ## Number of databases restored for this sync only 1657 my $restored_dbs = 0; 1658 1659 ## Walk through each database used by this sync 1660 DB: for my $dbname (sort keys %{ $sync->{db} }) { 1661 1662 ## Only check each database (by name) once 1663 next if $db_checked->{$dbname}++; 1664 1665 $self->glog("Checking database $dbname for sync $syncname", LOG_DEBUG); 1666 1667 my $dbinfo = $sync->{db}{$dbname}; 1668 1669 ## All we need to worry about are stalled ones 1670 next DB if $dbinfo->{status} ne 'stalled'; 1671 1672 ## Just in case, remove the database handle 1673 undef $dbinfo->{dbh}; 1674 eval { 1675 ($dbinfo->{backend}, $dbinfo->{dbh}) = $self->connect_database($dbname); 1676 $self->show_db_version_and_time($dbinfo->{dbh}, $dbinfo->{backend}, qq{Database "$dbname" }); 1677 }; 1678 1679 if (defined $dbinfo->{dbh}) { 1680 $dbinfo->{status} = 'active'; 1681 $SQL = 'UPDATE bucardo.db SET status = ? WHERE name = ?'; 1682 my $sth = $self->{masterdbh}->prepare($SQL); 1683 $sth->execute('active',$dbname); 1684 $self->{masterdbh}->commit(); 1685 $restored_dbs++; 1686 $self->glog("Sucessfully restored database $dbname: no longer stalled", LOG_NORMAL); 1687 } 1688 1689 } ## end each database 1690 1691 ## If any databases were restored, restore the sync too 1692 if ($restored_dbs) { 1693 $sync->{status} = 'stalled'; 1694 $SQL = 'UPDATE bucardo.sync SET status = ? WHERE name = ?'; 1695 my $sth = $self->{masterdbh}->prepare($SQL); 1696 $sth->execute('active',$syncname); 1697 $self->{masterdbh}->commit(); 1698 $restored_syncs++; 1699 $self->glog("Sucessfully restored sync $syncname: no longer stalled", LOG_NORMAL); 1700 } 1701 1702 } ## end each sync 1703 1704 return $restored_syncs; 1705 1706} ## end of restore_syncs 1707 1708 1709sub start_controller { 1710 1711 ## For a particular sync, does all the listening and creation of KIDs 1712 ## aka the CTL process 1713 ## Why not just spawn KIDs? Someday the CTL may have multiple kids again... 1714 ## Arguments: one 1715 ## 1. Hashref of sync information 1716 ## Returns: never 1717 1718 our ($self,$sync) = @_; 1719 1720 my $SQL; 1721 1722 $self->{ctlpid} = $$; 1723 $self->{syncname} = $sync->{name}; 1724 1725 ## Prefix all log lines with this TLA (was MCP) 1726 $self->{logprefix} = 'CTL'; 1727 1728 ## Extract some of the more common items into local vars 1729 my ($syncname,$kidsalive,$dbinfo, $kicked,) = @$sync{qw( 1730 name kidsalive dbs kick_on_startup)}; 1731 1732 ## Set our process name 1733 $0 = qq{Bucardo Controller.$self->{extraname} Sync "$syncname" for relgroup "$sync->{herd}" to dbs "$sync->{dbs}"}; 1734 1735 ## Upgrade any specific sync configs to global configs 1736 if (exists $config{sync}{$syncname}) { 1737 while (my ($setting, $value) = each %{$config{sync}{$syncname}}) { 1738 $config{$setting} = $value; 1739 $self->glog("Set sync-level config setting $setting: $value", LOG_TERSE); 1740 } 1741 } 1742 1743 ## Store our PID into a file 1744 ## Save the complete returned name for later cleanup 1745 $self->{ctlpidfile} = $self->store_pid( "bucardo.ctl.sync.$syncname.pid" ); 1746 1747 ## Start normal log output for this controller: basic facts 1748 my $msg = qq{New controller for sync "$syncname". Relgroup is "$sync->{herd}", dbs is "$sync->{dbs}". PID=$$}; 1749 $self->glog($msg, LOG_TERSE); 1750 1751 ## Log some startup information, and squirrel some away for later emailing 1752 my $mailmsg = "$msg\n"; 1753 $msg = qq{ stayalive: $sync->{stayalive} checksecs: $sync->{checksecs} kicked: $kicked}; 1754 $self->glog($msg, LOG_NORMAL); 1755 $mailmsg .= "$msg\n"; 1756 1757 $msg = sprintf q{ kidsalive: %s onetimecopy: %s lifetimesecs: %s (%s) maxkicks: %s}, 1758 $kidsalive, 1759 $sync->{onetimecopy}, 1760 $sync->{lifetimesecs}, 1761 $sync->{lifetime} || 'NULL', 1762 $sync->{maxkicks}; 1763 $self->glog($msg, LOG_NORMAL); 1764 $mailmsg .= "$msg\n"; 1765 1766 ## Allow the MCP to signal us (request to exit) 1767 local $SIG{USR1} = sub { 1768 ## Do not change this message: looked for in the controller DIE sub 1769 die "MCP request\n"; 1770 }; 1771 1772 ## From this point forward, we want to die gracefully 1773 local $SIG{__DIE__} = sub { 1774 1775 ## Arguments: one 1776 ## 1. Error message 1777 ## Returns: never (exit 0) 1778 1779 my ($diemsg) = @_; 1780 1781 ## Store the line that did the actual exception 1782 my $line = (caller)[2]; 1783 1784 ## Don't issue a warning if this was simply a MCP request 1785 my $warn = $diemsg =~ /MCP request/ ? '' : 'Warning! '; 1786 $self->glog(qq{${warn}Controller for "$syncname" was killed at line $line: $diemsg}, LOG_WARN); 1787 1788 ## We send an email if it's enabled 1789 if ($self->{sendmail} or $self->{sendmail_file}) { 1790 1791 ## Never email passwords 1792 my $oldpass = $self->{dbpass}; 1793 $self->{dbpass} = '???'; 1794 1795 ## Create a text version of our $self to email out 1796 my $dump = Dumper $self; 1797 1798 my $body = qq{ 1799 Controller $$ has been killed at line $line 1800 Host: $hostname 1801 Sync name: $syncname 1802 Relgroup: $sync->{herd} 1803 Databases: $sync->{dbs} 1804 Error: $diemsg 1805 Parent process: $self->{mcppid} 1806 Stats page: $config{stats_script_url}?sync=$syncname 1807 Version: $VERSION 1808 }; 1809 1810 ## Whitespace cleanup 1811 $body =~ s/^\s+//gsm; 1812 1813 ## Give some hints in the subject lines for known types of errors 1814 my $moresub = ''; 1815 if ($diemsg =~ /Found stopfile/) { 1816 $moresub = ' (stopfile)'; 1817 } 1818 elsif ($diemsg =~ /could not serialize access/) { 1819 $moresub = ' (serialization)'; 1820 } 1821 elsif ($diemsg =~ /deadlock/) { 1822 $moresub = ' (deadlock)'; 1823 } 1824 elsif ($diemsg =~ /could not connect/) { 1825 $moresub = ' (no connection)'; 1826 } 1827 1828 ## Send the mail, but not for a normal shutdown 1829 if ($moresub !~ /stopfile/) { 1830 my $subject = qq{Bucardo "$syncname" controller killed on $shorthost$moresub}; 1831 $self->send_mail({ body => "$body\n", subject => $subject }); 1832 } 1833 1834 ## Restore the password for the final cleanup connection 1835 $self->{dbpass} = $oldpass; 1836 1837 } ## end sending email 1838 1839 ## Cleanup the controller by killing kids, cleaning database tables and removing the PID file. 1840 $self->cleanup_controller(0, $diemsg); 1841 1842 exit 0; 1843 1844 }; ## end SIG{__DIE__} handler sub 1845 1846 ## Connect to the master database 1847 ($self->{master_backend}, $self->{masterdbh}) = $self->connect_database(); 1848 my $maindbh = $self->{masterdbh}; 1849 $self->glog("Bucardo database backend PID: $self->{master_backend}", LOG_VERBOSE); 1850 1851 ## Map the PIDs to common names for better log output 1852 $self->{pidmap}{$$} = 'CTL'; 1853 $self->{pidmap}{$self->{master_backend}} = 'Bucardo DB'; 1854 1855 ## Listen for kick requests from the MCP for this sync 1856 my $kicklisten = "kick_$syncname"; 1857 $self->db_listen($maindbh, "ctl_$kicklisten"); 1858 1859 ## Listen for a controller ping request 1860 my $pinglisten = "${$}_ping"; 1861 $self->db_listen($maindbh, "ctl_$pinglisten"); 1862 1863 ## Commit so we start listening right away 1864 $maindbh->commit(); 1865 1866 ## SQL to update the syncrun table's status only 1867 ## This is currently unused, but no harm in leaving it in place. 1868 ## It would be nice to syncrun the before_sync and after_sync 1869 ## custom codes. If we reintroduce the multi-kid 'gang' concept, 1870 ## that changes things radically as well. 1871 $SQL = q{ 1872 UPDATE bucardo.syncrun 1873 SET status=? 1874 WHERE sync=? 1875 AND ended IS NULL 1876 }; 1877 $sth{ctl_syncrun_update_status} = $maindbh->prepare($SQL); 1878 1879 ## SQL to update the syncrun table on startup 1880 ## Returns the insert (start) time 1881 $SQL = q{ 1882 UPDATE bucardo.syncrun 1883 SET ended=now(), status=? 1884 WHERE sync=? 1885 AND ended IS NULL 1886 RETURNING started 1887 }; 1888 $sth{ctl_syncrun_end_now} = $maindbh->prepare($SQL); 1889 1890 ## At this point, this controller must be authoritative for its sync 1891 ## Thus, we want to stop/kill any other CTL or KID processes that exist for this sync 1892 ## The first step is to send a friendly notice asking them to leave gracefully 1893 1894 my $stopsync = "stopsync_$syncname"; 1895 ## This will commit after the notify: 1896 $self->db_notify($maindbh, "kid_$stopsync"); 1897 ## We also want to force other controllers of this sync to leave 1898 $self->db_notify($maindbh, "ctl_$stopsync"); 1899 1900 ## Now we can listen for it ourselves in case the MCP requests it 1901 $self->db_listen($maindbh, "ctl_$stopsync"); 1902 1903 ## Now we look for any PID files for this sync and send them a HUP 1904 $count = $self->send_signal_to_PID( {sync => $syncname} ); 1905 1906 ## Next, we want to interrupt any long-running queries a kid may be in the middle of 1907 ## If they are, they will not receive the message above until done, but we can't wait 1908 ## If we stopped anyone, sleep a bit to allow them to exit and remove their PID files 1909 $self->terminate_old_goats($syncname) and sleep 1; 1910 1911 ## Clear out any old entries in the syncrun table 1912 $sth = $sth{ctl_syncrun_end_now}; 1913 $count = $sth->execute("Old entry ended (CTL $$)", $syncname); 1914 if (1 == $count) { 1915 $info = $sth->fetchall_arrayref()->[0][0]; 1916 $self->glog("Ended old syncrun entry, start time was $info", LOG_NORMAL); 1917 } 1918 else { 1919 $sth->finish(); 1920 } 1921 1922 ## Listen for a kid letting us know the sync has finished 1923 my $syncdone = "syncdone_$syncname"; 1924 $self->db_listen($maindbh, "ctl_$syncdone"); 1925 1926 ## Determine the last time this sync fired, if we are using "checksecs" 1927 if ($sync->{checksecs}) { 1928 1929 ## The handy syncrun table tells us the time of the last good run 1930 $SQL = q{ 1931 SELECT CEIL(EXTRACT(epoch FROM ended)) 1932 FROM bucardo.syncrun 1933 WHERE sync=? 1934 AND lastgood IS TRUE 1935 OR lastempty IS TRUE 1936 }; 1937 $sth = $maindbh->prepare($SQL); 1938 $count = $sth->execute($syncname); 1939 1940 ## Got a match? Use that 1941 if (1 == $count) { 1942 $sync->{lastheardfrom} = $sth->fetchall_arrayref()->[0][0]; 1943 } 1944 else { 1945 ## We default to "now" if we cannot find an earlier time 1946 $sth->finish(); 1947 $sync->{lastheardfrom} = time(); 1948 } 1949 $maindbh->commit(); 1950 } 1951 1952 ## If running an after_sync customcode, we need a timestamp 1953 if (exists $sync->{code_after_sync}) { 1954 $SQL = 'SELECT now()'; 1955 $sync->{starttime} = $maindbh->selectall_arrayref($SQL)->[0][0]; 1956 ## Rolling back as all we did was the SELECT 1957 $maindbh->rollback(); 1958 } 1959 1960 ## Reconnect to all databases we care about: overwrites existing dbhs 1961 for my $dbname (sort keys %{ $sync->{db} }) { 1962 1963 my $d = $sync->{db}{$dbname}; 1964 1965 if ($d->{dbtype} =~ /flat/o) { 1966 $self->glog(qq{Not connecting to flatfile database "$dbname"}, LOG_NORMAL); 1967 next; 1968 } 1969 1970 ## Do not need non-Postgres handles for the controller 1971 next if $d->{dbtype} ne 'postgres'; 1972 1973 ## Establish a new database handle 1974 ($d->{backend}, $d->{dbh}) = $self->connect_database($dbname); 1975 $self->glog(qq{Database "$dbname" backend PID: $d->{backend}}, LOG_NORMAL); 1976 $self->{pidmap}{$d->{backend}} = "DB $dbname"; 1977 } 1978 1979 ## Adjust the target table names as needed and store in the goat hash 1980 1981 ## New table name regardless of syncs or databases 1982 $SQL = 'SELECT newname FROM bucardo.customname WHERE goat=? AND db IS NULL and sync IS NULL'; 1983 my $sth_custom1 = $maindbh->prepare($SQL); 1984 ## New table name for this sync only 1985 $SQL = 'SELECT newname FROM bucardo.customname WHERE goat=? AND sync=? AND db IS NULL'; 1986 my $sth_custom2 = $maindbh->prepare($SQL); 1987 ## New table name for a specific database only 1988 $SQL = 'SELECT newname FROM bucardo.customname WHERE goat=? AND db=? AND sync IS NULL'; 1989 my $sth_custom3 = $maindbh->prepare($SQL); 1990 ## New table name for this sync and a specific database 1991 $SQL = 'SELECT newname FROM bucardo.customname WHERE goat=? AND sync=? AND db=?'; 1992 my $sth_custom4 = $maindbh->prepare($SQL); 1993 1994 ## Adjust the target table columns as needed and store in the goat hash 1995 1996 ## New table cols regardless of syncs or databases 1997 $SQL = 'SELECT clause FROM bucardo.customcols WHERE goat=? AND db IS NULL and sync IS NULL'; 1998 my $sth_customc1 = $maindbh->prepare($SQL); 1999 ## New table cols for this sync only 2000 $SQL = 'SELECT clause FROM bucardo.customcols WHERE goat=? AND sync=? AND db IS NULL'; 2001 my $sth_customc2 = $maindbh->prepare($SQL); 2002 ## New table cols for a specific database only 2003 $SQL = 'SELECT clause FROM bucardo.customcols WHERE goat=? AND db=? AND sync IS NULL'; 2004 my $sth_customc3 = $maindbh->prepare($SQL); 2005 ## New table cols for this sync and a specific database 2006 $SQL = 'SELECT clause FROM bucardo.customcols WHERE goat=? AND sync=? AND db=?'; 2007 my $sth_customc4 = $maindbh->prepare($SQL); 2008 2009 for my $g (@{ $sync->{goatlist} }) { 2010 2011 ## We only transform tables for now 2012 next if $g->{reltype} ne 'table'; 2013 2014 my ($S,$T) = ($g->{safeschema},$g->{safetable}); 2015 2016 ## See if we have any custom names or columns. Each level overrides the last 2017 my $customname = ''; 2018 my $customcols = ''; 2019 2020 ## Just this goat 2021 $count = $sth_custom1->execute($g->{id}); 2022 if ($count < 1) { 2023 $sth_custom1->finish(); 2024 } 2025 else { 2026 $customname = $sth_custom1->fetchall_arrayref()->[0][0]; 2027 } 2028 $count = $sth_customc1->execute($g->{id}); 2029 if ($count < 1) { 2030 $sth_customc1->finish(); 2031 } 2032 else { 2033 $customcols = $sth_customc1->fetchall_arrayref()->[0][0]; 2034 } 2035 2036 ## Just this goat and this sync 2037 $count = $sth_custom2->execute($g->{id}, $syncname); 2038 if ($count < 1) { 2039 $sth_custom2->finish(); 2040 } 2041 else { 2042 $customname = $sth_custom2->fetchall_arrayref()->[0][0]; 2043 } 2044 $count = $sth_customc2->execute($g->{id}, $syncname); 2045 if ($count < 1) { 2046 $sth_customc2->finish(); 2047 } 2048 else { 2049 $customcols = $sth_customc2->fetchall_arrayref()->[0][0]; 2050 } 2051 2052 ## Need to pick one source at random to extract the list of columns from 2053 my $saved_sourcedbh = ''; 2054 2055 ## Set for each target db 2056 $g->{newname}{$syncname} = {}; 2057 $g->{newcols}{$syncname} = {}; 2058 for my $dbname (sort keys %{ $sync->{db} }) { 2059 2060 my $d = $sync->{db}{$dbname}; 2061 2062 my $type= $d->{dbtype}; 2063 2064 my $cname; 2065 my $ccols = ''; 2066 2067 ## We only ever change table names (or cols) for true targets 2068 if ($d->{role} ne 'source') { 2069 2070 ## Save local copies for this database only 2071 $cname = $customname; 2072 $ccols = $customcols; 2073 2074 ## Anything for this goat and this database? 2075 $count = $sth_custom3->execute($g->{id}, $dbname); 2076 if ($count < 1) { 2077 $sth_custom3->finish(); 2078 } 2079 else { 2080 $cname = $sth_custom3->fetchall_arrayref()->[0][0]; 2081 } 2082 $count = $sth_customc3->execute($g->{id}, $dbname); 2083 if ($count < 1) { 2084 $sth_customc3->finish(); 2085 } 2086 else { 2087 $ccols = $sth_customc3->fetchall_arrayref()->[0][0]; 2088 } 2089 2090 ## Anything for this goat, this sync, and this database? 2091 $count = $sth_custom4->execute($g->{id}, $syncname, $dbname); 2092 if ($count < 1) { 2093 $sth_custom4->finish(); 2094 } 2095 else { 2096 $cname = $sth_custom4->fetchall_arrayref()->[0][0]; 2097 } 2098 $count = $sth_customc4->execute($g->{id}, $syncname, $dbname); 2099 if ($count < 1) { 2100 $sth_customc4->finish(); 2101 } 2102 else { 2103 $ccols = $sth_customc4->fetchall_arrayref()->[0][0]; 2104 } 2105 } 2106 2107 ## Got a new name match? Just use that for everything 2108 if (defined $cname and $cname) { 2109 $g->{newname}{$syncname}{$dbname} = $cname; 2110 } 2111 ## Only a few use schemas: 2112 elsif ($d->{dbtype} eq 'postgres' 2113 or $d->{dbtype} eq 'flatpg') { 2114 $g->{newname}{$syncname}{$dbname} = "$S.$T"; 2115 } 2116 ## Some always get the raw table name 2117 elsif ($d->{dbtype} eq 'redis' or $d->{dbtype} eq 'mongo') { 2118 $g->{newname}{$syncname}{$dbname} = $g->{tablename}; 2119 } 2120 else { 2121 $g->{newname}{$syncname}{$dbname} = $T; 2122 } 2123 2124 ## Set the columns for this combo: empty for no change 2125 $g->{newcols}{$syncname}{$dbname} = $ccols; 2126 2127 ## If we do not have a source database handle yet, grab one 2128 if (! $saved_sourcedbh) { 2129 for my $dbname (sort keys %{ $sync->{db} }) { 2130 2131 next if $sync->{db}{$dbname}{role} ne 'source'; 2132 2133 ## All we need is the handle, nothing more 2134 $saved_sourcedbh = $sync->{db}{$dbname}{dbh}; 2135 2136 ## Leave this loop, we got what we came for 2137 last; 2138 } 2139 } 2140 2141 ## We either get the specific columns, or use a '*' if no customcols 2142 my $SELECT = $ccols || 'SELECT *'; 2143 2144 ## Run a dummy query against the source to pull back the column names 2145 ## This is particularly important for customcols of course! 2146 $sth = $saved_sourcedbh->prepare("SELECT * FROM ($SELECT FROM $S.$T LIMIT 0) AS foo LIMIT 0"); 2147 $sth->execute(); 2148 2149 ## Store the arrayref of column names for this goat and this select clause 2150 $g->{tcolumns}{$SELECT} = $sth->{NAME}; 2151 $sth->finish(); 2152 $saved_sourcedbh->rollback(); 2153 2154 ## Make sure none of them are un-named, which Postgres outputs as ?column? 2155 if (grep { /^\?.+\?$/ } @{ $g->{tcolumns}{$SELECT} }) { 2156 die "Invalid customcols given: must give an alias to all columns! ($g->{tcolumns}{$SELECT}) for $SELECT\n"; 2157 } 2158 2159 } 2160 } 2161 2162 ## Set to true if we determine the kid(s) should make a run 2163 ## Can be set by: 2164 ## kick notice from the MCP for this sync 2165 ## 'checksecs' timeout 2166 ## if we are just starting up (now) 2167 my $kick_request = 1; 2168 2169 ## How long it has been since we checked on our kids 2170 my $kidchecktime = 0; 2171 2172 ## For custom code: 2173 our $input = {}; ## XXX still needed? 2174 2175 ## We are finally ready to enter the main loop 2176 2177 CONTROLLER: { 2178 2179 ## Bail if the stopfile exists 2180 if (-e $self->{stop_file}) { 2181 $self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_TERSE); 2182 ## Do not change this message: looked for in the controller DIE sub 2183 my $stopmsg = 'Found stopfile'; 2184 2185 ## Grab the reason, if it exists, so we can propagate it onward 2186 my $ctlreason = get_reason(0); 2187 if ($ctlreason) { 2188 $stopmsg .= ": $ctlreason"; 2189 } 2190 2191 ## This exception is caught by the controller's __DIE__ sub above 2192 die "$stopmsg\n"; 2193 } 2194 2195 ## Process any notifications from the main database 2196 ## Ignore things we may have sent ourselves 2197 my $nlist = $self->db_get_notices($maindbh, $self->{master_backend}); 2198 2199 NOTICE: for my $name (sort keys %{ $nlist }) { 2200 2201 my $npid = $nlist->{$name}{firstpid}; 2202 2203 ## Strip prefix so we can easily use both pre and post 9.0 versions 2204 $name =~ s/^ctl_//o; 2205 2206 ## Kick request from the MCP? 2207 if ($name eq $kicklisten) { 2208 $kick_request = 1; 2209 next NOTICE; 2210 } 2211 2212 ## Request for a ping via listen/notify 2213 if ($name eq $pinglisten) { 2214 2215 $self->glog('Got a ping, issuing pong', LOG_DEBUG); 2216 $self->db_notify($maindbh, "ctl_${$}_pong"); 2217 2218 next NOTICE; 2219 } 2220 2221 ## Another controller has asked us to leave as we are no longer The Man 2222 if ($name eq $stopsync) { 2223 $self->glog('Got a stop sync request, so exiting', LOG_TERSE); 2224 die 'Stop sync request'; 2225 } 2226 2227 ## A kid has just finished syncing 2228 if ($name eq $syncdone) { 2229 $self->{syncdone} = time; 2230 $self->glog("Kid $npid has reported that sync $syncname is done", LOG_DEBUG); 2231 ## If this was a onetimecopy sync, flip the bit (which should be done in the db already) 2232 if ($sync->{onetimecopy}) { 2233 $sync->{onetimecopy} = 0; 2234 } 2235 next NOTICE; 2236 } 2237 2238 ## Someone else's sync is getting kicked, finishing up, or stopping 2239 next NOTICE if 2240 (index($name, 'kick_') == 0) 2241 or 2242 (index($name, 'syncdone_') == 0) 2243 or 2244 (index($name, 'stopsync_') == 0); 2245 2246 2247 ## Ignore any messages sent to a kid 2248 next NOTICE if 0 == index($name, 'kid_'); 2249 2250 ## Should not happen, but let's at least log it 2251 $self->glog("Warning: received unknown message $name from $npid!", LOG_TERSE); 2252 2253 } ## end of each notification 2254 2255 ## To ensure we can receive new notifications next time: 2256 $maindbh->commit(); 2257 2258 if ($self->{syncdone}) { 2259 2260 ## Reset the notice 2261 $self->{syncdone} = 0; 2262 2263 ## Run all after_sync custom codes 2264 if (exists $sync->{code_after_sync}) { 2265 for my $code (@{$sync->{code_after_sync}}) { 2266 #$sth{ctl_syncrun_update_status}->execute("Code after_sync (CTL $$)", $syncname); 2267 $maindbh->commit(); 2268 my $result = $self->run_ctl_custom_code($sync,$input,$code, 'nostrict'); 2269 $self->glog("End of after_sync $code->{id}", LOG_VERBOSE); 2270 } ## end each custom code 2271 } 2272 2273 ## Let anyone listening know that this sync is complete. Global message 2274 my $notifymsg = "syncdone_$syncname"; 2275 $self->db_notify($maindbh, $notifymsg); 2276 2277 ## If we are not a stayalive, this is a good time to leave 2278 if (! $sync->{stayalive} and ! $kidsalive) { 2279 $self->cleanup_controller(1, 'Kids are done'); 2280 exit 0; 2281 } 2282 2283 ## XXX: re-examine 2284 # If we ran an after_sync and grabbed rows, reset the time 2285 # if (exists $rows_for_custom_code->{source}) { 2286 # $SQL = "SELECT $self->{mcp_clock_timestamp}"; 2287 # $sync->{starttime} = $maindbh->selectall_arrayref($SQL)->[0][0]; 2288 # } 2289 2290 } ## end if sync done 2291 2292 ## If we are using checksecs, possibly force a kick 2293 if ($sync->{checksecs}) { 2294 2295 ## Already being kicked? Reset the clock 2296 if ($kick_request) { 2297 $sync->{lastheardfrom} = time(); 2298 } 2299 elsif (time() - $sync->{lastheardfrom} >= $sync->{checksecs}) { 2300 if ($sync->{onetimecopy}) { 2301 $self->glog(qq{Timed out, but in onetimecopy mode, so not kicking, for "$syncname"}, LOG_DEBUG); 2302 } 2303 else { 2304 $self->glog(qq{Timed out - force a sync for "$syncname"}, LOG_VERBOSE); 2305 $kick_request = 1; 2306 } 2307 2308 ## Reset the clock 2309 $sync->{lastheardfrom} = time(); 2310 } 2311 } 2312 2313 ## XXX What about non stayalive kids? 2314 ## XXX This is called too soon - recently created kids are not there yet! 2315 2316 ## Check that our kids are alive and healthy 2317 ## XXX Skip if we know the kids are busy? (cannot ping/pong!) 2318 ## XXX Maybe skip this entirely and just check on a kick? 2319 if ($sync->{stayalive} ## CTL must be persistent 2320 and $kidsalive ## KID must be persistent 2321 and $self->{kidpid} ## KID must have been created at least once 2322 and time() - $kidchecktime >= $config{ctl_checkonkids_time}) { 2323 2324 my $pidfile = "$config{piddir}/bucardo.kid.sync.$syncname.pid"; 2325 2326 ## If we find a problem, set this to true 2327 my $resurrect = 0; 2328 ## Make sure the PID file exists 2329 if (! -e $pidfile) { 2330 $self->glog("PID file missing: $pidfile", LOG_DEBUG); 2331 $resurrect = 1; 2332 } 2333 else { 2334 ## Make sure that a kill 0 sees it 2335 ## XXX Use ping/pong? 2336 my $pid = $self->{kidpid}; 2337 $count = kill 0 => $pid; 2338 if ($count != 1) { 2339 $self->glog("Warning: Kid $pid is not responding, will respawn", LOG_TERSE); 2340 $resurrect = 2; 2341 } 2342 } 2343 2344 ## At this point, the PID file does not exist or the kid is not responding 2345 if ($resurrect) { 2346 ## XXX Try harder to kill it? 2347 ## First clear out any old entries in the syncrun table 2348 $sth = $sth{ctl_syncrun_end_now}; 2349 $count = $sth->execute("Old entry died (CTL $$)", $syncname); 2350 if (1 == $count) { 2351 $info = $sth->fetchall_arrayref()->[0][0]; 2352 $self->glog("Old syncrun entry removed during resurrection, start time was $info", LOG_NORMAL); 2353 } 2354 else { 2355 $sth->finish(); 2356 } 2357 $self->glog("Resurrecting kid $syncname, resurrect was $resurrect", LOG_DEBUG); 2358 $self->{kidpid} = $self->create_newkid($sync); 2359 2360 ## Sleep a little here to prevent runaway kid creation 2361 sleep $config{kid_restart_sleep}; 2362 } 2363 2364 ## Reset the time 2365 $kidchecktime = time(); 2366 2367 } ## end of time to check on our kid's health 2368 2369 ## Redo if we are not kicking but are stayalive and the queue is clear 2370 if (! $kick_request and $sync->{stayalive}) { 2371 sleep $config{ctl_sleep}; 2372 redo CONTROLLER; 2373 } 2374 2375 ## Reset the kick_request for the next run 2376 $kick_request = 0; 2377 2378 ## At this point, we know we are about to run a sync 2379 ## We will either create the kid(s), or signal the existing one(s) 2380 2381 ## XXX If a custom code handler needs a database handle, create one 2382 our ($cc_sourcedbh,$safe_sourcedbh); 2383 2384 ## Run all before_sync code 2385 ## XXX Move to kid? Do not want to run over and over if something is queued 2386 if (exists $sync->{code_before_sync}) { 2387 #$sth{ctl_syncrun_update_status}->execute("Code before_sync (CTL $$)", $syncname); 2388 $maindbh->commit(); 2389 for my $code (@{$sync->{code_before_sync}}) { 2390 my $result = $self->run_ctl_custom_code($sync,$input,$code, 'nostrict'); 2391 if ($result eq 'redo') { 2392 redo CONTROLLER; 2393 } 2394 } 2395 } 2396 2397 $maindbh->commit(); 2398 2399 if ($self->{kidpid}) { 2400 ## Tell any listening kids to go ahead and start 2401 $self->db_notify($maindbh, "kid_run_$syncname"); 2402 } 2403 else { 2404 ## Create any kids that do not exist yet (or have been killed, as detected above) 2405 $self->glog("Creating a new kid for sync $syncname", LOG_VERBOSE); 2406 $self->{kidpid} = $self->create_newkid($sync); 2407 } 2408 2409 sleep $config{ctl_sleep}; 2410 redo CONTROLLER; 2411 2412 } ## end CONTROLLER 2413 2414 die 'How did we reach outside of the main controller loop?'; 2415 2416} ## end of start_controller 2417 2418 2419sub start_kid { 2420 2421 ## A single kid, in charge of doing a sync between two or more databases 2422 ## aka the KID process 2423 ## Arguments: one 2424 ## 1. Hashref of sync information 2425 ## Returns: never (exits) 2426 2427 my ($self,$sync) = @_; 2428 2429 my $SQL; 2430 2431 ## Prefix all log lines with this TLA 2432 $self->{logprefix} = 'KID'; 2433 2434 ## Extract some of the more common items into local vars 2435 my ($syncname, $goatlist, $kidsalive, $dbs, $kicked) = @$sync{qw( 2436 name goatlist kidsalive dbs kick_on_startup)}; 2437 2438 ## Adjust the process name, start logging 2439 $0 = qq{Bucardo Kid.$self->{extraname} Sync "$syncname"}; 2440 my $extra = $sync->{onetimecopy} ? "OTC: $sync->{onetimecopy}" : ''; 2441 if ($config{log_showsyncname}) { 2442 $self->{logprefix} .= " ($syncname)"; 2443 } 2444 2445 $self->glog(qq{New kid, sync "$syncname" alive=$kidsalive Parent=$self->{ctlpid} PID=$$ kicked=$kicked $extra}, LOG_TERSE); 2446 2447 ## Store our PID into a file 2448 ## Save the complete returned name for later cleanup 2449 $self->{kidpidfile} = $self->store_pid( "bucardo.kid.sync.$syncname.pid" ); 2450 2451 ## Establish these early so the DIE block can use them 2452 my ($S,$T,$pkval) = ('?','?','?'); 2453 2454 ## Keep track of how many times this kid has done work 2455 my $kidloop = 0; 2456 2457 ## Catch USR1 errors as a signal from the parent CTL process to exit right away 2458 local $SIG{USR1} = sub { 2459 ## Mostly so we do not send an email: 2460 $self->{clean_exit} = 1; 2461 die "CTL request\n"; 2462 }; 2463 2464 ## Set up some common groupings of the databases inside sync->{db} 2465 ## Also setup common attributes 2466 my (@dbs, @dbs_source, @dbs_target, @dbs_delta, @dbs_fullcopy, 2467 @dbs_connectable, @dbs_dbi, @dbs_write, @dbs_non_fullcopy, 2468 @dbs_postgres, @dbs_drizzle, @dbs_firebird, @dbs_mongo, @dbs_mysql, @dbs_oracle, 2469 @dbs_redis, @dbs_sqlite); 2470 2471 ## Used to weed out all but one source if in onetimecopy mode 2472 my $found_first_source = 0; 2473 2474 for my $dbname (sort keys %{ $sync->{db} }) { 2475 2476 my $d = $sync->{db}{$dbname}; 2477 2478 ## All databases start with triggers enabled 2479 $d->{triggers_enabled} = 1; 2480 2481 ## First, do some exclusions 2482 2483 ## If this is a onetimecopy sync, the fullcopy targets are dead to us 2484 next if $sync->{onetimecopy} and $d->{role} eq 'fullcopy'; 2485 2486 ## If this is a onetimecopy sync, we only need to connect to a single source 2487 if ($sync->{onetimecopy} and $d->{role} eq 'source') { 2488 next if $found_first_source; 2489 $found_first_source = 1; 2490 } 2491 2492 ## If this is inactive, we've already checked that if it is a source in validate_sync 2493 ## Thus, if we made it this far, it is a target and should be skipped 2494 if ($d->{status} eq 'inactive') { 2495 $self->glog(qq{Skipping inactive database "$dbname" entirely}, LOG_NORMAL); 2496 ## Don't just skip it: nuke it from orbit! It's the only way to be sure. 2497 delete $sync->{db}{$dbname}; 2498 next; 2499 } 2500 2501 ## Now set the default attributes 2502 2503 ## Is this a SQL database? 2504 $d->{does_sql} = 0; 2505 2506 ## Do we have a DBI-based driver? 2507 $d->{does_dbi} = 0; 2508 2509 ## Can it do truncate? 2510 $d->{does_truncate} = 0; 2511 2512 ## Does it support asynchronous queries well? 2513 $d->{does_async} = 0; 2514 2515 ## Does it have good support for ANY()? 2516 $d->{does_ANY_clause} = 0; 2517 2518 ## Can it do savepoints (and roll them back)? 2519 $d->{does_savepoints} = 0; 2520 2521 ## Does it support truncate cascade? 2522 $d->{does_cascade} = 0; 2523 2524 ## Does it support a LIMIT clause? 2525 $d->{does_limit} = 0; 2526 2527 ## Can it be queried? 2528 $d->{does_append_only} = 0; 2529 2530 ## List of tables in this database that need makedelta inserts 2531 $d->{does_makedelta} = {}; 2532 2533 ## Does it have that annoying timestamp +dd bug? 2534 $d->{has_mysql_timestamp_issue} = 0; 2535 2536 ## Start clumping into groups and adjust the attributes 2537 2538 ## Postgres 2539 if ('postgres' eq $d->{dbtype}) { 2540 push @dbs_postgres => $dbname; 2541 $d->{does_sql} = 1; 2542 $d->{does_truncate} = 1; 2543 $d->{does_savepoints} = 1; 2544 $d->{does_cascade} = 1; 2545 $d->{does_limit} = 1; 2546 $d->{does_async} = 1; 2547 $d->{does_ANY_clause} = 1; 2548 } 2549 2550 ## Drizzle 2551 if ('drizzle' eq $d->{dbtype}) { 2552 push @dbs_drizzle => $dbname; 2553 $d->{does_sql} = 1; 2554 $d->{does_truncate} = 1; 2555 $d->{does_savepoints} = 1; 2556 $d->{does_limit} = 1; 2557 $d->{has_mysql_timestamp_issue} = 1; 2558 } 2559 2560 ## MongoDB 2561 if ('mongo' eq $d->{dbtype}) { 2562 push @dbs_mongo => $dbname; 2563 } 2564 2565 ## MySQL (and MariaDB) 2566 if ('mysql' eq $d->{dbtype} or 'mariadb' eq $d->{dbtype}) { 2567 push @dbs_mysql => $dbname; 2568 $d->{does_sql} = 1; 2569 $d->{does_truncate} = 1; 2570 $d->{does_savepoints} = 1; 2571 $d->{does_limit} = 1; 2572 $d->{has_mysql_timestamp_issue} = 1; 2573 } 2574 2575 ## Firebird 2576 if ('firebird' eq $d->{dbtype}) { 2577 push @dbs_firebird => $dbname; 2578 $d->{does_sql} = 1; 2579 $d->{does_truncate} = 1; 2580 $d->{does_savepoints} = 1; 2581 $d->{does_limit} = 1; 2582 $d->{has_mysql_timestamp_issue} = 1; 2583 } 2584 2585 ## Oracle 2586 if ('oracle' eq $d->{dbtype}) { 2587 push @dbs_oracle => $dbname; 2588 $d->{does_sql} = 1; 2589 $d->{does_truncate} = 1; 2590 $d->{does_savepoints} = 1; 2591 } 2592 2593 ## Redis 2594 if ('redis' eq $d->{dbtype}) { 2595 push @dbs_redis => $dbname; 2596 } 2597 2598 ## SQLite 2599 if ('sqlite' eq $d->{dbtype}) { 2600 push @dbs_sqlite => $dbname; 2601 $d->{does_sql} = 1; 2602 $d->{does_truncate} = 1; 2603 $d->{does_savepoints} = 1; 2604 $d->{does_limit} = 1; 2605 } 2606 2607 ## Flat files 2608 if ($d->{dbtype} =~ /flat/) { 2609 $d->{does_append_only} = 1; 2610 } 2611 2612 ## Everyone goes into this bucket 2613 push @dbs => $dbname; 2614 2615 ## Databases we read data from 2616 push @dbs_source => $dbname 2617 if $d->{role} eq 'source'; 2618 2619 ## Target databases 2620 push @dbs_target => $dbname 2621 if $d->{role} ne 'source'; 2622 2623 ## Databases that (potentially) get written to 2624 ## This is all of them, unless we are a source 2625 ## and a fullcopy sync or in onetimecopy mode 2626 push @dbs_write => $dbname 2627 if (!$sync->{fullcopy} and !$sync->{onetimecopy}) 2628 or $d->{role} ne 'source'; 2629 2630 ## Databases that get deltas 2631 ## If in onetimecopy mode, this is always forced to be empty 2632 ## Likewise, no point in populating if this is a fullcopy sync 2633 push @dbs_delta => $dbname 2634 if $d->{role} eq 'source' 2635 and ! $sync->{onetimecopy} 2636 and ! $sync->{fullcopy}; 2637 2638 ## Databases that get the full monty 2639 ## In normal mode, this means a role of 'fullcopy' 2640 ## In onetimecopy mode, this means a role of 'target' 2641 push @dbs_fullcopy => $dbname 2642 if ($sync->{onetimecopy} and $d->{role} eq 'target') 2643 or ($sync->{fullcopy} and $d->{role} eq 'fullcopy'); 2644 2645 ## Non-fullcopy databases. Basically dbs_source + dbs_target 2646 push @dbs_non_fullcopy => $dbname 2647 if $d->{role} ne 'fullcopy'; 2648 2649 ## Databases with Perl DBI support 2650 if ($d->{dbtype} eq 'postgres' 2651 or $d->{dbtype} eq 'drizzle' 2652 or $d->{dbtype} eq 'firebird' 2653 or $d->{dbtype} eq 'mariadb' 2654 or $d->{dbtype} eq 'mysql' 2655 or $d->{dbtype} eq 'oracle' 2656 or $d->{dbtype} eq 'sqlite') { 2657 push @dbs_dbi => $dbname; 2658 $d->{does_dbi} = 1; 2659 } 2660 2661 ## Things we can connect to. Almost everything 2662 push @dbs_connectable => $dbname 2663 if $d->{dbtype} !~ /flat/; 2664 } 2665 2666 ## Connect to the main database 2667 ($self->{master_backend}, $self->{masterdbh}) = $self->connect_database(); 2668 2669 ## Set a shortcut for this handle, and log the details 2670 my $maindbh = $self->{masterdbh}; 2671 $self->glog("Bucardo database backend PID: $self->{master_backend}", LOG_VERBOSE); 2672 2673 ## Setup mapping so we can report in the log which things came from this backend 2674 $self->{pidmap}{$self->{master_backend}} = 'Bucardo DB'; 2675 2676 ## SQL to enter a new database in the dbrun table 2677 $SQL = q{ 2678 INSERT INTO bucardo.dbrun(sync,dbname,pgpid) 2679 VALUES (?,?,?) 2680 }; 2681 $sth{dbrun_insert} = $maindbh->prepare($SQL); 2682 2683 ## SQL to remove a database from the dbrun table 2684 $SQL{dbrun_delete} = q{ 2685 DELETE FROM bucardo.dbrun 2686 WHERE sync = ? AND dbname = ? 2687 }; 2688 $sth{dbrun_delete} = $maindbh->prepare($SQL{dbrun_delete}); 2689 2690 ## Disable the CTL exception handler. 2691 2692 2693 ## Fancy exception handler to clean things up before leaving. 2694 my $err_handler = sub { 2695 2696 ## Arguments: one 2697 ## 1. Error message 2698 ## Returns: never (exit 1) 2699 2700 ## Trim whitespace from our message 2701 my ($msg) = @_; 2702 $msg =~ s/\s+$//g; 2703 2704 ## Where did we die? 2705 my $line = (caller)[2]; 2706 $msg .= "\nLine: $line"; 2707 2708 ## Subject line tweaking later on 2709 my $moresub = ''; 2710 2711 ## Find any error messages/states for all databases 2712 if ($msg =~ /DBD::Pg/) { 2713 $msg .= "\nMain DB state: " . ($maindbh->state || '?'); 2714 $msg .= ' Error: ' . ($maindbh->err || 'none'); 2715 for my $dbname (@dbs_dbi) { 2716 2717 my $d = $sync->{db}{$dbname}; 2718 2719 my $dbh = $d->{dbh}; 2720 my $state = $dbh->state || '?'; 2721 $msg .= "\nDB $dbname state: $state"; 2722 $msg .= ' Error: ' . ($dbh->err || 'none'); 2723 ## If this was a deadlock problem, try and gather more information 2724 if ($state eq '40P01' and $d->{dbtype} eq 'postgres') { 2725 $msg .= $self->get_deadlock_details($dbh, $msg); 2726 $moresub = ' (deadlock)'; 2727 last; 2728 } 2729 } 2730 } 2731 $msg .= "\n"; 2732 2733 (my $flatmsg = $msg) =~ s/\n/ /g; 2734 $self->glog("Kid has died, error is: $flatmsg", LOG_TERSE); 2735 2736 ## Drop connection to the main database, then reconnect 2737 if (defined $maindbh and $maindbh) { 2738 $maindbh->rollback; 2739 $_->finish for values %{ $maindbh->{CachedKids} }; 2740 $maindbh->disconnect; 2741 } 2742 my ($finalbackend, $finaldbh) = $self->connect_database(); 2743 $self->glog("Final database backend PID: $finalbackend", LOG_VERBOSE); 2744 $sth{dbrun_delete} = $finaldbh->prepare($SQL{dbrun_delete}); 2745 2746 $self->db_notify($finaldbh, 'kid_pid_stop', 1); 2747 2748 ## Drop all open database connections, clear out the dbrun table 2749 for my $dbname (@dbs_dbi) { 2750 2751 my $d = $sync->{db}{$dbname}; 2752 2753 my $dbh = $d->{dbh} or do { 2754 $self->glog("Missing $dbname database handle", LOG_WARN); 2755 next; 2756 }; 2757 2758 ## Is this still around? 2759 if (!$dbh->ping) { 2760 $self->glog("Ping failed for database $dbname", LOG_TERSE); 2761 ## We want to give the MCP a hint that something is wrong 2762 $self->db_notify($finaldbh, "dead_db_$dbname", 1); 2763 ## We'll assume no disconnect is necessary - but we'll undef it below just in case 2764 } 2765 else { 2766 ## Rollback, finish all statement handles, and disconnect 2767 $dbh->rollback(); 2768 $self->glog("Disconnecting from database $dbname", LOG_DEBUG); 2769 $_->finish for values %{ $dbh->{CachedKids} }; 2770 $dbh->disconnect(); 2771 } 2772 2773 ## Make sure we don't think we are still in the middle of an async query 2774 $d->{async_active} = 0; 2775 2776 ## Make sure we never access this connection again 2777 undef $dbh; 2778 2779 ## Clear out the entry from the dbrun table 2780 $sth = $sth{dbrun_delete}; 2781 $sth->execute($syncname, $dbname); 2782 $finaldbh->commit(); 2783 } 2784 2785 ## If using semaphore tables, mark the status as 'failed' 2786 ## At least in the Mongo case, it's pretty safe to do this, 2787 ## as it is unlikely the error came from Mongo Land 2788 if ($config{semaphore_table}) { 2789 my $tname = $config{semaphore_table}; 2790 for my $dbname (@dbs_connectable) { 2791 2792 my $d = $sync->{db}{$dbname}; 2793 2794 if ($d->{dbtype} eq 'mongo') { 2795 $self->update_mongo_status( $d, $syncname, $tname, 'failed' ); 2796 } 2797 } 2798 } 2799 2800 ## Mark this syncrun as aborted if needed, replace the 'lastbad' 2801 my $status = "Failed : $flatmsg (KID $$)"; 2802 $self->end_syncrun($finaldbh, 'bad', $syncname, $status); 2803 $finaldbh->commit(); 2804 2805 ## Update the dbrun table as needed 2806 $SQL = q{DELETE FROM bucardo.dbrun WHERE sync = ?}; 2807 $sth = $finaldbh->prepare($SQL); 2808 $sth->execute($syncname); 2809 2810 ## Let anyone listening know that this target sync aborted. Global message. 2811 $self->db_notify($finaldbh, "synckill_${syncname}"); 2812 2813 ## Done with database cleanups, so disconnect 2814 $finaldbh->disconnect(); 2815 2816 ## Send an email as needed (never for clean exit) 2817 if (! $self->{clean_exit} and $self->{sendmail} or $self->{sendmail_file}) { 2818 my $warn = $msg =~ /CTL.+request/ ? '' : 'Warning! '; 2819 $self->glog(qq{${warn}Child for sync "$syncname" was killed at line $line: $msg}, LOG_WARN); 2820 2821 ## Never display the database passwords 2822 for (values %{$self->{dbs}}) { 2823 $_->{dbpass} = '???'; 2824 } 2825 $self->{dbpass} = '???'; 2826 2827 ## Create the body of the message to be mailed 2828 my $dump = Dumper $self; 2829 2830 my $body = qq{ 2831 Kid $$ has been killed at line $line 2832 Error: $msg 2833 Possible suspects: $S.$T: $pkval 2834 Host: $hostname 2835 Sync name: $syncname 2836 Stats page: $config{stats_script_url}?sync=$syncname 2837 Parent process: $self->{mcppid} -> $self->{ctlpid} 2838 Rows set to aborted: $count 2839 Version: $VERSION 2840 Loops: $kidloop 2841 }; 2842 2843 $body =~ s/^\s+//gsm; 2844 if ($msg =~ /Found stopfile/) { 2845 $moresub = ' (stopfile)'; 2846 } 2847 elsif ($msg =~ /could not connect/) { 2848 $moresub = ' (no connection)'; 2849 } 2850 my $subject = qq{Bucardo kid for "$syncname" killed on $shorthost$moresub}; 2851 $self->send_mail({ body => "$body\n", subject => $subject }); 2852 2853 } ## end sending email 2854 2855 my $extrainfo = sprintf '%s%s%s', 2856 qq{Sync "$syncname"}, 2857 $S eq '?' ? '' : " $S.$T", 2858 $pkval eq '?' ? '' : " pk: $pkval"; 2859 2860 $self->cleanup_kid($flatmsg, $extrainfo); 2861 2862 exit 1; 2863 2864 }; ## end $err_handler 2865 2866 my $stop_sync_request = "stopsync_$syncname"; 2867 ## Tracks how long it has been since we last ran a ping against our databases 2868 my $lastpingcheck = 0; 2869 2870 ## Row counts from the delta tables: 2871 my %deltacount; 2872 2873 ## Count of changes made (inserts,deletes,truncates,conflicts handled): 2874 my %dmlcount; 2875 2876 my $did_setup = 0; 2877 local $@; 2878 eval { 2879 ## Listen for the controller asking us to go again if persistent 2880 if ($kidsalive) { 2881 $self->db_listen( $maindbh, "kid_run_$syncname" ); 2882 } 2883 2884 ## Listen for a kid ping, even if not persistent 2885 my $kidping = "${$}_ping"; 2886 $self->db_listen( $maindbh, "kid_$kidping" ); 2887 2888 ## Listen for a sync-wide exit signal 2889 $self->db_listen( $maindbh, "kid_$stop_sync_request" ); 2890 2891 ## Prepare all of our SQL 2892 ## Note that none of this is actually 'prepared' until the first execute 2893 2894 ## SQL to add a new row to the syncrun table 2895 $SQL = 'INSERT INTO bucardo.syncrun(sync,status) VALUES (?,?)'; 2896 $sth{kid_syncrun_insert} = $maindbh->prepare($SQL); 2897 2898 ## SQL to update the syncrun table's status only 2899 $SQL = q{ 2900 UPDATE bucardo.syncrun 2901 SET status=? 2902 WHERE sync=? 2903 AND ended IS NULL 2904 }; 2905 $sth{kid_syncrun_update_status} = $maindbh->prepare($SQL); 2906 2907 ## SQL to set the syncrun table as ended once complete 2908 $SQL = q{ 2909 UPDATE bucardo.syncrun 2910 SET deletes=deletes+?, inserts=inserts+?, truncates=truncates+?, 2911 conflicts=?, details=?, status=? 2912 WHERE sync=? 2913 AND ended IS NULL 2914 }; 2915 $sth{kid_syncrun_end} = $maindbh->prepare($SQL); 2916 2917 ## Connect to all (connectable) databases we are responsible for 2918 ## This main list has already been pruned by the controller as needed 2919 for my $dbname (@dbs_connectable) { 2920 2921 my $d = $sync->{db}{$dbname}; 2922 2923 ($d->{backend}, $d->{dbh}) = $self->connect_database($dbname); 2924 $self->glog(qq{Database "$dbname" backend PID: $d->{backend}}, LOG_VERBOSE); 2925 2926 ## Register ourself with the MCP (if we are Postgres) 2927 if ($d->{dbtype} eq 'postgres') { 2928 $self->db_notify($maindbh, 'kid_pid_start', 1, $dbname); 2929 } 2930 } 2931 2932 ## Set the maximum length of the $dbname.$S.$T string. 2933 ## Used for logging output 2934 $self->{maxdbname} = 1; 2935 for my $dbname (keys %{ $sync->{db} }) { 2936 $self->{maxdbname} = length $dbname if length $dbname > $self->{maxdbname}; 2937 } 2938 my $maxst = 3; 2939 for my $g (@$goatlist) { 2940 next if $g->{reltype} ne 'table'; 2941 ($S,$T) = ($g->{safeschema},$g->{safetable}); 2942 $maxst = length "$S.$T" if length ("$S.$T") > $maxst; 2943 } 2944 $self->{maxdbstname} = $self->{maxdbname} + 1 + $maxst; 2945 2946 ## If we are using delta tables, prepare all relevant SQL 2947 if (@dbs_delta) { 2948 2949 ## Prepare the SQL specific to each table 2950 for my $g (@$goatlist) { 2951 2952 ## Only tables get all this fuss: sequences are easy 2953 next if $g->{reltype} ne 'table'; 2954 2955 ## This is the main query: grab all unique changed primary keys since the last sync 2956 $SQL{delta}{$g} = qq{ 2957 SELECT DISTINCT $g->{pklist} 2958 FROM bucardo.$g->{deltatable} d 2959 WHERE NOT EXISTS ( 2960 SELECT 1 2961 FROM bucardo.$g->{tracktable} t 2962 WHERE d.txntime = t.txntime 2963 AND (t.target = DBGROUP::text) 2964 ) 2965 }; 2966 2967 ## We also need secondary queries to catch the case of partial replications 2968 ## This is a per-target check 2969 $SQL{deltatarget}{$g} = qq{ 2970 SELECT DISTINCT $g->{pklist} 2971 FROM bucardo.$g->{deltatable} d 2972 WHERE NOT EXISTS ( 2973 SELECT 1 2974 FROM bucardo.$g->{tracktable} t 2975 WHERE d.txntime = t.txntime 2976 AND (t.target = TARGETNAME::text) 2977 ) 2978 }; 2979 2980 ## Mark all unclaimed visible delta rows as done in the track table 2981 $SQL{track}{$g} = qq{ 2982 INSERT INTO bucardo.$g->{tracktable} (txntime,target) 2983 SELECT DISTINCT txntime, DBGROUP::text 2984 FROM bucardo.$g->{deltatable} d 2985 WHERE NOT EXISTS ( 2986 SELECT 1 2987 FROM bucardo.$g->{tracktable} t 2988 WHERE d.txntime = t.txntime 2989 AND (t.target = DBGROUP::text) 2990 ); 2991 }; 2992 2993 ## The same thing, but to the staging table instead, as we have to 2994 ## wait for all targets to succesfully commit in multi-source situations 2995 ($SQL{stage}{$g} = $SQL{track}{$g}) =~ s/$g->{tracktable}/$g->{stagetable}/; 2996 2997 2998 } ## end each table 2999 3000 ## For each source database, prepare the queries above 3001 for my $dbname (@dbs_source) { 3002 3003 my $d = $sync->{db}{$dbname}; 3004 3005 ## Set the DBGROUP for each database: the bucardo.track_* target entry 3006 $d->{DBGROUPNAME} = "dbgroup $dbs"; 3007 3008 for my $g (@$goatlist) { 3009 3010 next if $g->{reltype} ne 'table'; 3011 3012 ($S,$T) = ($g->{safeschema},$g->{safetable}); 3013 3014 ## Replace with the target name for source delta querying 3015 ($SQL = $SQL{delta}{$g}) =~ s/DBGROUP/'$d->{DBGROUPNAME}'/o; 3016 3017 ## As these can be expensive, make them asynchronous 3018 $sth{getdelta}{$dbname}{$g} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC}); 3019 3020 ## We need to update either the track table or the stage table 3021 ## There is no way to know beforehand which we will need, so we prepare both 3022 3023 ## Replace with the target name for source track updating 3024 ($SQL = $SQL{track}{$g}) =~ s/DBGROUP/'$d->{DBGROUPNAME}'/go; 3025 ## Again, async as they may be slow 3026 $sth{track}{$dbname}{$g} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC}); 3027 3028 ## Same thing for stage 3029 ($SQL = $SQL{stage}{$g}) =~ s/DBGROUP/'$d->{DBGROUPNAME}'/go; 3030 $sth{stage}{$dbname}{$g} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC}); 3031 3032 } ## end each table 3033 3034 } ## end each source database 3035 3036 3037 ## Set all makedelta tables (target databases can have them too, as another sync may have them as a source) 3038 for my $dbname (@dbs) { 3039 3040 my $d = $sync->{db}{$dbname}; 3041 3042 for my $g (@$goatlist) { 3043 3044 next if $g->{reltype} ne 'table'; 3045 ($S,$T) = ($g->{safeschema},$g->{safetable}); 3046 ## Set the per database/per table makedelta setting now 3047 if (1 == $d->{makedelta} or $g->{makedelta} eq 'on' or $g->{makedelta} =~ /\b$dbname\b/) { 3048 $d->{does_makedelta}{"$S.$T"} = 1; 3049 $self->glog("Set table $dbname.$S.$T to makedelta", LOG_NORMAL); 3050 } 3051 3052 } ## end each table 3053 3054 } ## end all databases 3055 3056 } ## end if delta databases 3057 3058 ## Create safe versions of the database handles if we are going to need them 3059 if ($sync->{need_safe_dbh_strict} or $sync->{need_safe_dbh}) { 3060 3061 for my $dbname (@dbs_postgres) { 3062 3063 my $d = $sync->{db}{$dbname}; 3064 3065 my $darg; 3066 if ($sync->{need_safe_dbh_strict}) { 3067 for my $arg (sort keys %{ $dbix{ $d->{role} }{strict} }) { 3068 next if ! length $dbix{ $d->{role} }{strict}{$arg}; 3069 $darg->{$arg} = $dbix{ $d->{role} }{strict}{$arg}; 3070 } 3071 $darg->{dbh} = $d->{dbh}; 3072 $self->{safe_dbh_strict}{$dbname} = DBIx::Safe->new($darg); 3073 } 3074 3075 if ($sync->{need_safe_dbh}) { 3076 undef $darg; 3077 for my $arg (sort keys %{ $dbix{ $d->{role} }{notstrict} }) { 3078 next if ! length $dbix{ $d->{role} }{notstrict}{$arg}; 3079 $darg->{$arg} = $dbix{ $d->{role} }{notstrict}{$arg}; 3080 } 3081 $darg->{dbh} = $d->{dbh}; 3082 $self->{safe_dbh}{$dbname} = DBIx::Safe->new($darg); 3083 } 3084 } 3085 3086 } ## end DBIX::Safe creations 3087 $did_setup = 1; 3088 }; 3089 $err_handler->($@) if !$did_setup; 3090 3091 ## Begin the main KID loop 3092 my $didrun = 0; 3093 my $runkid = sub { 3094 KID: { 3095 ## Leave right away if we find a stopfile 3096 if (-e $self->{stop_file}) { 3097 $self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_WARN); 3098 last KID; 3099 } 3100 3101 ## Should we actually do something this round? 3102 my $dorun = 0; 3103 3104 ## If we were just created or kicked, go ahead and start a run. 3105 if ($kicked) { 3106 $dorun = 1; 3107 $kicked = 0; 3108 } 3109 3110 ## If persistent, listen for messages and do an occasional ping of all databases 3111 if ($kidsalive) { 3112 3113 my $nlist = $self->db_get_notices($maindbh); 3114 3115 for my $name (sort keys %{ $nlist }) { 3116 3117 my $npid = $nlist->{$name}{firstpid}; 3118 3119 ## Strip the prefix 3120 $name =~ s/^kid_//o; 3121 3122 ## The controller wants us to exit 3123 if ( $name eq $stop_sync_request ) { 3124 $self->glog('Got a stop sync request, so exiting', LOG_TERSE); 3125 die 'Stop sync request'; 3126 } 3127 3128 ## The controller has told us we are clear to go 3129 elsif ($name eq "run_$syncname") { 3130 $dorun = 1; 3131 } 3132 3133 ## Got a ping? Respond with a pong. 3134 elsif ($name eq "${$}_ping") { 3135 $self->glog('Got a ping, issuing pong', LOG_DEBUG); 3136 $self->db_notify($maindbh, "kid_${$}_pong"); 3137 } 3138 3139 ## Someone else's sync is running 3140 elsif (index($name, 'run_') == 0) { 3141 } 3142 ## Someone else's sync is stopping 3143 elsif (index($name, 'stopsync_') == 0) { 3144 } 3145 ## Someone else's kid is getting pinged 3146 elsif (index($name, '_ping') > 0) { 3147 } 3148 3149 ## Should not happen, but let's at least log it 3150 else { 3151 $self->glog("Warning: received unknown message $name from $npid!", LOG_TERSE); 3152 } 3153 3154 } ## end each notice 3155 3156 ## Now that we've read in any notices, simply rollback 3157 $maindbh->rollback(); 3158 3159 ## Periodically verify connections to all databases 3160 if (time() - $lastpingcheck >= $config{kid_pingtime}) { 3161 ## If this fails, simply have the CTL restart it 3162 ## Other things match on the exception wording below, so change carefully 3163 $maindbh->ping or die qq{Ping failed for main database\n}; 3164 for my $dbname (@dbs_dbi) { 3165 3166 my $d = $sync->{db}{$dbname}; 3167 3168 $d->{dbh}->ping or die qq{Ping failed for database "$dbname"\n}; 3169 $d->{dbh}->rollback(); 3170 } 3171 $lastpingcheck = time(); 3172 } 3173 3174 } ## end if kidsalive 3175 3176 ## If we are not doing anything this round, sleep and start over 3177 ## We will only ever hit this on the second go around, as kids 3178 ## start as autokicked 3179 if (! $dorun) { 3180 sleep $config{kid_sleep}; 3181 redo KID; 3182 } 3183 3184 ## From this point on, we are a live kid that is expected to run the sync 3185 3186 ## Used to report on total times for the long-running parts, e.g. COPY 3187 my $kid_start_time = [gettimeofday]; 3188 3189 ## Create an entry in the syncrun table to let people know we've started 3190 $self->glog('Adding entry to syncrun table', LOG_DEBUG); 3191 $sth{kid_syncrun_insert}->execute($syncname, "Started (KID $$)"); 3192 3193 ## Increment our count of how many times we have been here before 3194 $kidloop++; 3195 3196 ## Reset the numbers to track total bucardo_delta matches 3197 undef %deltacount; 3198 $deltacount{all} = 0; 3199 $deltacount{alltables} = 0; 3200 $deltacount{table} = {}; 3201 3202 ## Reset our counts of total inserts, deletes, truncates, and conflicts 3203 undef %dmlcount; 3204 $dmlcount{deletes} = 0; 3205 $dmlcount{inserts} = 0; 3206 $dmlcount{truncates} = 0; 3207 $dmlcount{conflicts} = 0; 3208 3209 ## Reset all of our truncate stuff 3210 $self->{has_truncation} = 0; 3211 delete $self->{truncateinfo}; 3212 3213 ## Reset some things at the per-database level 3214 for my $dbname (keys %{ $sync->{db} }) { 3215 3216 my $d = $sync->{db}{$dbname}; 3217 3218 ## This must be set, as it is used by the conflict_strategy below 3219 $deltacount{$dbname} = 0; 3220 $dmlcount{allinserts}{$dbname} = 0; 3221 $dmlcount{alldeletes}{$dbname} = 0; 3222 3223 delete $d->{truncatewinner}; 3224 3225 } 3226 3227 ## Reset things at the goat level 3228 for my $g (@$goatlist) { 3229 delete $g->{truncatewinner}; 3230 } 3231 3232 ## Run all 'before_txn' code 3233 if (exists $sync->{code_before_txn}) { 3234 ## Let external people know where we are 3235 $sth{kid_syncrun_update_status}->execute("Code before_txn (KID $$)", $syncname); 3236 $maindbh->commit(); 3237 for my $code (@{$sync->{code_before_txn}}) { 3238 ## Check if the code has asked us to skip other before_txn codes 3239 last if 'last' eq $self->run_kid_custom_code($sync, $code); 3240 } 3241 } 3242 3243 ## Populate the dbrun table so others know we are using these databases 3244 $self->glog('Populating the dbrun table', LOG_DEBUG); 3245 for my $dbname (@dbs_connectable) { 3246 3247 my $d = $sync->{db}{$dbname}; 3248 3249 $sth{dbrun_insert}->execute($syncname, $dbname, $d->{backend}); 3250 } 3251 3252 ## Add a note to the syncrun table 3253 $self->glog('Adding note to the syncrun table', LOG_DEBUG); 3254 $sth{kid_syncrun_update_status}->execute("Begin txn (KID $$)", $syncname); 3255 3256 ## Figure out our isolation level. Only used for Postgres 3257 ## All others are hard-coded as 'serializable' 3258 $self->{pg_isolation_level} = defined $sync->{isolation_level} ? $sync->{isolation_level} : 3259 $config{isolation_level} || 'serializable'; 3260 3261 ## Commit so our dbrun and syncrun stuff is visible to others 3262 ## This should be done just before we start transactions on all dbs 3263 $self->glog('Doing final maindbh commit', LOG_DEBUG); 3264 $maindbh->commit(); 3265 3266 ## Start the main transaction and do things such as setting isolation levels 3267 $self->start_main_transaction({ sync => $sync, databases => \@dbs_connectable}); 3268 3269 ## We may have a request to lock all the tables 3270 $self->lock_all_tables({ sync => $sync, databases => \@dbs_write, tables => $goatlist}); 3271 3272 ## Do all the delta (non-fullcopy) targets 3273 if (@dbs_delta) { 3274 3275 ## We will never reach this while in onetimecopy mode as @dbs_delta is emptied 3276 3277 ## Run all 'before_check_rows' code 3278 if (exists $sync->{code_before_check_rows}) { 3279 $sth{kid_syncrun_update_status}->execute("Code before_check_rows (KID $$)", $syncname); 3280 $maindbh->commit(); 3281 for my $code (@{$sync->{code_before_check_rows}}) { 3282 ## Check if the code has asked us to skip other before_check_rows codes 3283 last if 'last' eq $self->run_kid_custom_code($sync, $code); 3284 } 3285 } 3286 3287 ## Check if any tables were truncated on all source databases 3288 ## If so, set $self->{has_truncation}; store results in $self->{truncateinfo} 3289 ## First level keys are schema then table name 3290 ## Third level is maxtime and maxdb, showing the "winner" for each table 3291 3292 $SQL = 'SELECT quote_ident(sname), quote_ident(tname), MAX(EXTRACT(epoch FROM cdate))' 3293 . ' FROM bucardo.bucardo_truncate_trigger ' 3294 . ' WHERE sync = ? AND replicated IS NULL GROUP BY 1,2'; 3295 3296 for my $dbname (@dbs_source) { 3297 3298 my $d = $sync->{db}{$dbname}; 3299 3300 ## Grab the latest truncation time for each table, for this source database 3301 $self->glog(qq{Checking truncate_trigger table on database "$dbname"}, LOG_VERBOSE); 3302 $sth = $d->{dbh}->prepare($SQL); 3303 $self->{has_truncation} += $sth->execute($syncname); 3304 for my $row (@{ $sth->fetchall_arrayref() }) { 3305 my ($s,$t,$time) = @{ $row }; 3306 ## Store if this is the new winner 3307 if (! exists $self->{truncateinfo}{$s}{$t}{maxtime} 3308 or $time > $self->{truncateinfo}{$s}{$t}{maxtime}) { 3309 $self->{truncateinfo}{$s}{$t}{maxtime} = $time; 3310 $self->{truncateinfo}{$s}{$t}{maxdb} = $dbname; 3311 } 3312 } 3313 3314 } ## end each source database, checking for truncations 3315 3316 ## Now go through and mark the winner within the "x" hash, for easy skipping later on 3317 if ($self->{has_truncation}) { 3318 for my $s (keys %{ $self->{truncateinfo} }) { 3319 for my $t (keys %{ $self->{truncateinfo}{$s} }) { 3320 my $dbname = $self->{truncateinfo}{$s}{$t}{maxdb}; 3321 my $d = $sync->{db}{$dbname}; 3322 $d->{truncatewinner}{$s}{$t} = 1; 3323 $self->glog("Truncate winner for $s.$t is database $dbname", LOG_DEBUG); 3324 } 3325 } 3326 ## Set the truncate count 3327 my $number = @dbs_non_fullcopy; ## not the best estimate: corner cases 3328 $dmlcount{truncate} = $number - 1; 3329 3330 ## Now map this back to our goatlist 3331 for my $g (@$goatlist) { 3332 next if $g->{reltype} ne 'table'; 3333 ($S,$T) = ($g->{safeschema},$g->{safetable}); 3334 if (exists $self->{truncateinfo}{$S}{$T}) { 3335 $g->{truncatewinner} = $self->{truncateinfo}{$S}{$T}{maxdb}; 3336 } 3337 } 3338 } 3339 3340 ## Next, handle all the sequences 3341 for my $g (@$goatlist) { 3342 3343 next if $g->{reltype} ne 'sequence'; 3344 3345 ($S,$T) = ($g->{safeschema},$g->{safetable}); 3346 3347 ## Grab the sequence information from each database 3348 ## Figure out which source one is the highest 3349 ## Right now, this is the only sane option. 3350 ## In the future, we might consider coupling tables and sequences and 3351 ## then copying sequences based on the 'winning' underlying table 3352 $SQL = "SELECT * FROM $S.$T"; 3353 my $maxvalue = -1; 3354 for my $dbname (@dbs_non_fullcopy) { 3355 3356 my $d = $sync->{db}{$dbname}; 3357 3358 next if $d->{dbtype} ne 'postgres'; 3359 3360 $sth = $d->{dbh}->prepare($SQL); 3361 $sth->execute(); 3362 my $info = $sth->fetchall_arrayref({})->[0]; 3363 $g->{sequenceinfo}{$dbname} = $info; 3364 3365 ## Only the source databases matter for the max value comparison 3366 next if $d->{role} ne 'source'; 3367 3368 if ($info->{last_value} > $maxvalue) { 3369 $maxvalue = $info->{last_value}; 3370 $g->{winning_db} = $dbname; 3371 } 3372 } 3373 3374 $self->glog("Sequence $S.$T from db $g->{winning_db} is the highest", LOG_DEBUG); 3375 3376 ## Now that we have a winner, apply the changes to every other (non-fullcopy) PG database 3377 for my $dbname (@dbs_non_fullcopy) { 3378 3379 my $d = $sync->{db}{$dbname}; 3380 3381 next if $d->{dbtype} ne 'postgres'; 3382 3383 $d->{adjustsequence} = 1; 3384 } 3385 3386 $deltacount{sequences} += $self->adjust_sequence($g, $sync, $S, $T, $syncname); 3387 3388 } ## end of handling sequences 3389 3390 ## We want to line up all the delta count numbers in the logs, 3391 ## so this tracks the largest number returned 3392 my $maxcount = 0; 3393 3394 ## Use the bucardo_delta_check function on each database, which gives us 3395 ## a quick summary of whether each table has any active delta rows 3396 ## This is a big win on slow networks! 3397 if ($config{quick_delta_check}) { 3398 for my $dbname (@dbs_source) { 3399 3400 my $d = $sync->{db}{$dbname}; 3401 3402 $sth{kid_syncrun_update_status}->execute("delta_check on db $dbname",$syncname); 3403 $maindbh->commit(); 3404 3405 $SQL = 'SELECT * FROM bucardo.bucardo_delta_check(?,?)'; 3406 $sth = $d->{dbh}->prepare($SQL); 3407 $sth->execute($syncname, $d->{DBGROUPNAME}); 3408 $d->{deltazero} = $d->{deltatotal} = 0; 3409 for my $row (@{$sth->fetchall_arrayref()}) { 3410 my ($number,$tablename) = split /,/ => $row->[0], 2; 3411 $d->{deltaquick}{$tablename} = $number; 3412 if ($number) { 3413 $d->{deltatotal}++; 3414 $deltacount{table}{$tablename}++; 3415 } 3416 else { 3417 $d->{deltazero}++; 3418 } 3419 } 3420 $self->glog("Tables with deltas on $dbname: $d->{deltatotal} Without: $d->{deltazero}", LOG_VERBOSE); 3421 3422 } ## end quick delta check for each database 3423 3424 } ## end quick delta check 3425 3426 ## Grab the delta information for each table from each source database 3427 ## While we could do this as per-db/per-goat instead of per-goat/per-db, 3428 ## we want to take advantage of the async requests as much as possible, 3429 ## and we'll get the best benefit by hitting each db in turn 3430 3431 for my $g (@$goatlist) { 3432 3433 ## Again, this is only for tables 3434 next if $g->{reltype} ne 'table'; 3435 3436 ## Populate the global vars 3437 ($S,$T) = ($g->{safeschema},$g->{safetable}); 3438 3439 ## This is the meat of Bucardo: 3440 for my $dbname (@dbs_source) { 3441 3442 ## If we had a truncation, we only get deltas from the "winning" source 3443 ## We still need these, as we want to respect changes made after the truncation! 3444 next if exists $g->{truncatewinner} and $g->{truncatewinner} ne $dbname; 3445 3446 my $d = $sync->{db}{$dbname}; 3447 3448 ## No need to grab information if we know there are no deltas for this table 3449 if ($config{quick_delta_check}) { 3450 next if ! $d->{deltaquick}{"$S.$T"}; 3451 } 3452 3453 $sth{kid_syncrun_update_status}->execute("Counting all deltas on db $dbname",$syncname); 3454 $maindbh->commit(); 3455 3456 ## Gets all relevant rows from bucardo_deltas: runs asynchronously 3457 $d->{async_active} = time; 3458 $sth{getdelta}{$dbname}{$g}->execute(); 3459 } 3460 3461 ## Grab all results as they finish. 3462 ## Order does not really matter here, except for consistency in the logs 3463 for my $dbname (@dbs_source) { 3464 3465 ## Skip if truncating and this one is not the winner 3466 next if exists $g->{truncatewinner} and $g->{truncatewinner} ne $dbname; 3467 3468 my $d = $sync->{db}{$dbname}; 3469 3470 ## If we skipped this, set the deltacount to zero and move on 3471 if ($config{quick_delta_check}) { 3472 if (! $d->{deltaquick}{"$S.$T"}) { 3473 $deltacount{dbtable}{$dbname}{$S}{$T} = 0; 3474 next; 3475 } 3476 } 3477 3478 ## pg_result tells us to wait for the query to finish 3479 $count = $d->{dbh}->pg_result(); 3480 $d->{async_active} = 0; 3481 3482 ## Call finish() and change the ugly 0E0 to a true zero 3483 $sth{getdelta}{$dbname}{$g}->finish() if $count =~ s/0E0/0/o; 3484 3485 ## Store counts globally (per sync), per DB, per table, and per table/DB 3486 $deltacount{all} += $count; 3487 $deltacount{db}{$dbname} += $count; 3488 $deltacount{table}{$S}{$T} += $count; 3489 $deltacount{dbtable}{$dbname}{$S}{$T} = $count; ## NOT a += 3490 3491 ## Special versions for FK checks below 3492 if ($count) { 3493 $deltacount{tableoid}{$g->{oid}}{$dbname} = $count; 3494 } 3495 3496 ## For our pretty output below 3497 $maxcount = $count if $count > $maxcount; 3498 3499 } ## end each database 3500 3501 } ## end each table (deltacount) 3502 3503 ## Output the counts, now that we know the widths 3504 for my $g (@$goatlist) { 3505 3506 ## Only for tables 3507 next if $g->{reltype} ne 'table'; 3508 3509 ## Populate the global vars 3510 ($S,$T) = ($g->{safeschema},$g->{safetable}); 3511 3512 for my $dbname (@dbs_source) { 3513 3514 ## Skip if truncating and this one is not the winner 3515 next if exists $g->{truncatewinner} and $g->{truncatewinner} ne $dbname; 3516 3517 $self->glog((sprintf q{Delta count for %-*s : %*d}, 3518 $self->{maxdbstname}, 3519 "$dbname.$S.$T", 3520 length $maxcount, 3521 $deltacount{dbtable}{$dbname}{$S}{$T}), LOG_VERBOSE); 3522 } ## end each db 3523 3524 } ## end each table 3525 3526 ## Report on the total number of deltas found 3527 $self->glog("Total delta count: $deltacount{all}", LOG_VERBOSE); 3528 3529 ## Reset our list of possible FK issues 3530 $sync->{fkcheck} = {}; 3531 3532 ## If more than one total source db, break it down at that level 3533 ## We also check for foreign key dependencies here 3534 if (keys %{ $deltacount{db} } > 1) { 3535 3536 ## Figure out the width for the per-db breakdown below 3537 my $maxdbcount = 0; 3538 for my $dbname (sort keys %{ $sync->{db} }) { 3539 $maxdbcount = $deltacount{db}{$dbname} 3540 if exists $deltacount{db}{$dbname} 3541 and $deltacount{db}{$dbname} > $maxdbcount; 3542 } 3543 3544 for my $dbname (@dbs_source) { 3545 3546 ## Skip if truncating and deltacount is thus not set 3547 next if ! exists $deltacount{db}{$dbname}; 3548 3549 $self->glog((sprintf q{Delta count for %-*s: %*d}, 3550 $self->{maxdbname} + 2, 3551 qq{"$dbname"}, 3552 length $maxdbcount, 3553 $deltacount{db}{$dbname}), LOG_VERBOSE); 3554 } 3555 3556 ## Since we have changes appearing on more than one database, 3557 ## we need to see if any of the database-spanning tables involved 3558 ## are linked via foreign keys. If they are, we may have to 3559 ## change our replication strategy so that the foreign keys are 3560 ## still intact at the end of our operation. 3561 ## If we find tables that need to be checked, we add them to $self->{fkcheck} 3562 3563 ## Walk through each table with changes 3564 for my $toid (sort keys %{ $deltacount{tableoid} }) { 3565 3566 my $t1 = $deltacount{tableoid}{$toid}; 3567 my $tname1 = $sync->{tableoid}{$toid}{name}; 3568 3569 ## Find all tables that this table references 3570 my $info = $sync->{tableoid}{$toid}; 3571 ## Note that we really only need to check one of references or referencedby 3572 REFFER: for my $reftable (sort keys %{ $info->{references} } ) { 3573 3574 ## Skip if it has no changes 3575 next if ! exists $deltacount{tableoid}{$reftable}; 3576 3577 ## At this point, we know that both linked tables have at 3578 ## least one source change. We also know that at least two 3579 ## source databases are involved in this sync. 3580 3581 my $t2 = $deltacount{tableoid}{$reftable}; 3582 my $tname2 = $sync->{tableoid}{$reftable}{name}; 3583 3584 ## The danger is if the changes come from different databases 3585 ## If this happens, the foreign key relationship may be violated 3586 ## when we push the changes both ways. 3587 3588 ## Check if any of the dbs are mismatched. If so, instant FK marking 3589 for my $db1 (sort keys %$t1) { 3590 if (! exists $t2->{$db1}) { 3591 $self->glog("Table $tname1 and $tname2 may have FK issues", LOG_DEBUG); 3592 $sync->{fkcheck}{$tname1}{$tname2} = 1; 3593 next REFFER; 3594 } 3595 } 3596 3597 ## So both tables have changes on the same source databases. 3598 ## Now the only danger is if either has more than one source 3599 if (keys %$t1 > 1 or keys %$t2 > 1) { 3600 $self->glog("Table $tname1 and $tname2 may have FK issues", LOG_DEBUG); 3601 $sync->{fkcheck}{$tname1}{$tname2} = 1; 3602 $sync->{fkcheck}{$tname2}{$tname1} = 2; 3603 } 3604 3605 } ## end each reffed table 3606 3607 } ## end each changed table 3608 3609 } ## end if more than one source database has changes 3610 3611 ## If there were no changes on any sources, rollback all databases, 3612 ## update the syncrun and dbrun tables, notify listeners, 3613 ## then either re-loop or leave 3614 3615 if (! $deltacount{all} and ! $self->{has_truncation}) { 3616 3617 ## If we modified the bucardo_sequences table, save the change 3618 if ($deltacount{sequences}) { 3619 #die "fixme"; 3620 #$sourcedbh->commit(); 3621 } 3622 3623 ## Just to be safe, rollback everything 3624 for my $dbname (@dbs_dbi) { 3625 3626 my $d = $sync->{db}{$dbname}; 3627 3628 $d->{dbh}->rollback(); 3629 } 3630 3631 ## Clear out the entries from the dbrun table 3632 for my $dbname (@dbs_connectable) { 3633 3634 my $d = $sync->{db}{$dbname}; 3635 3636 ## We never do native fullcopy targets here 3637 next if $d->{role} eq 'fullcopy'; 3638 3639 $sth = $sth{dbrun_delete}; 3640 $sth->execute($syncname, $dbname); 3641 $maindbh->commit(); 3642 } 3643 3644 ## Clear the syncrun table 3645 my $msg = "No delta rows found (KID $$)"; 3646 $self->end_syncrun($maindbh, 'empty', $syncname, $msg); 3647 3648 $maindbh->commit(); 3649 3650 ## Let the CTL know we are done 3651 $self->db_notify($maindbh, "ctl_syncdone_${syncname}"); 3652 $maindbh->commit(); 3653 3654 ## Even with no changes, we like to know how long this took 3655 my $synctime = sprintf '%.2f', tv_interval($kid_start_time); 3656 $self->glog((sprintf 'Total time for sync "%s" (no rows): %s%s', 3657 $syncname, 3658 pretty_time($synctime), 3659 $synctime < 120 ? '' : " ($synctime seconds)",), 3660 LOG_DEBUG); 3661 3662 ## Sleep a hair 3663 sleep $config{kid_nodeltarows_sleep}; 3664 3665 redo KID if $kidsalive; 3666 last KID; 3667 3668 } ## end no deltas 3669 3670 ## Only need to turn off triggers and rules once via pg_class 3671 my $disabled_via_pg_class = 0; 3672 3673 ## Reset all of our non-persistent conflict information 3674 $self->{conflictinfo} = {}; 3675 3676 ## Custom conflict handler may have told us to always use the same winner 3677 if (exists $self->{conflictinfo}{winneralways}) { 3678 $self->{conflictinfo}{winners} = $self->{conflictinfo}{winneralways}; 3679 } 3680 3681 ## Do each goat in turn 3682 3683 PUSHDELTA_GOAT: for my $g (@$goatlist) { 3684 3685 ## No need to proceed unless we're a table 3686 next if $g->{reltype} ne 'table'; 3687 3688 ## Skip if we've already handled this via fullcopy 3689 next if $g->{source}{needstruncation}; 3690 3691 ($S,$T) = ($g->{safeschema},$g->{safetable}); 3692 3693 ## Skip this table if no source rows have changed 3694 ## However, we still need to go on in the case of a truncation 3695 next if ! $deltacount{table}{$S}{$T} and ! exists $g->{truncatewinner}; 3696 3697 ## How many times this goat has handled an exception? 3698 $g->{exceptions} ||= 0; 3699 3700 ## The list of primary key columns 3701 if (! $g->{pkeycols}) { ## only do this once 3702 $g->{pkeycols} = ''; 3703 $i=0; 3704 for my $qpk (@{$g->{qpkey}}) { 3705 $g->{pkeycols} .= sprintf '%s,', $g->{binarypkey}{$i} ? qq{ENCODE($qpk,'base64')} : $qpk; 3706 $i++; 3707 } 3708 chop $g->{pkeycols}; 3709 $g->{numpkcols} > 1 and $g->{pkeycols} = "($g->{pkeycols})"; 3710 ## Example: id 3711 ## Example MCPK: (id,"space bar",cdate) 3712 3713 ## Store a raw version for some non-Postgres targets 3714 $g->{pkeycolsraw} = join ',' => @{ $g->{pkey} }; 3715 3716 } 3717 3718 ## How many times have we done the loop below? 3719 my $delta_attempts = 0; 3720 3721 ## For each source database, grab all distinct pks for this table 3722 ## from bucardo_delta (that have not already been pushed to the targetname) 3723 ## We've already executed and got a count from these queries: 3724 ## it's now time to gather the actual data 3725 my %deltabin; 3726 3727 ## Customcode may need to know which rows we have changed: reset it here 3728 $sync->{deltarows} = {}; 3729 3730 for my $dbname (@dbs_source) { 3731 3732 ## Skip if we are truncating and this is not the winner 3733 next if exists $g->{truncatewinner} and $g->{truncatewinner} ne $dbname; 3734 3735 ## If this is a truncation, we always want the deltabin to exist, even if empty! 3736 if (exists $g->{truncatewinner}) { 3737 $deltabin{$dbname} = {}; 3738 } 3739 3740 ## Skip if we know we have no rows - and thus have issued a finish() 3741 next if ! $deltacount{dbtable}{$dbname}{$S}{$T}; 3742 3743 ## Create an empty hash to hold the primary key information 3744 $deltabin{$dbname} = {}; 3745 3746 $sth{kid_syncrun_update_status}->execute("Get deltas from db $dbname",$syncname); 3747 $maindbh->commit(); 3748 3749 while (my $y = $sth{getdelta}{$dbname}{$g}->fetchrow_arrayref()) { 3750 ## Join all primary keys together with \0, put into hash as key 3751 ## XXX: Using \0 is not unique for binaries 3752 if (!$g->{hasbinarypk}) { 3753 $deltabin{$dbname}{join "\0" => @$y} = 1; 3754 } 3755 else { 3756 my $decodename = ''; 3757 3758 my @pk; 3759 for my $row (@$y) { 3760 push @pk => $row; 3761 } 3762 $deltabin{$dbname}{join "\0" => @pk} = 1; 3763 } 3764 } 3765 3766 } ## end getting pks from each db for this table 3767 3768 ## Walk through and make sure we have only one source for each primary key 3769 3770 ## Simple map of what we've already compared: 3771 my %seenpair; 3772 3773 ## Hash indicating which databases have conflicts: 3774 $self->{db_hasconflict} = {}; 3775 3776 ## Hash of all conflicts for this goat 3777 ## Key is the primary key value 3778 ## Value is a list of all databases containing this value 3779 my %conflict; 3780 3781 for my $dbname1 (sort keys %deltabin) { 3782 3783 for my $dbname2 (sort keys %deltabin) { 3784 3785 ## Don't compare with ourselves 3786 next if $dbname1 eq $dbname2; 3787 3788 ## Skip if we've already handled this pair the reverse way 3789 next if exists $seenpair{$dbname2}{$dbname1}; 3790 $seenpair{$dbname1}{$dbname2} = 1; 3791 3792 ## Loop through all rows from database 1 and see if they exist on 2 3793 ## If they do, it's a conflict, and one of them must win 3794 ## Store in the conflict hash for processing below 3795 for my $key (keys %{ $deltabin{$dbname1} }) { 3796 next if ! exists $deltabin{$dbname2}{$key}; 3797 3798 ## Got a conflict! Same pkey updated on both sides 3799 $conflict{$key}{$dbname1} = 1; 3800 $conflict{$key}{$dbname2} = 1; 3801 3802 ## Build a list of which databases have conflicts 3803 $self->{db_hasconflict}{$dbname1} = 1; 3804 $self->{db_hasconflict}{$dbname2} = 1; 3805 } 3806 } 3807 } 3808 3809 ## If we had any conflicts, handle them now 3810 $count = keys %conflict; 3811 if ($count) { 3812 3813 ## Increment count across all tables 3814 $dmlcount{conflicts} += $count; 3815 3816 $self->glog("Conflicts for $S.$T: $count", LOG_NORMAL); 3817 3818 ## If we have a custom conflict handler for this goat, invoke it 3819 if ($g->{code_conflict}) { 3820 3821 ## We can safely skip this if we already have the winners list in some format 3822 if (exists $self->{conflictinfo}{tablewinner_always}{$g}) { 3823 $self->glog('Using previous tablewinner_always winner', LOG_DEBUG); 3824 } 3825 elsif (exists $self->{conflictinfo}{syncwinner}) { 3826 $self->glog('Using previous syncwinner winner', LOG_DEBUG); 3827 } 3828 elsif (exists $self->{conflictinfo}{syncwinner_always}) { 3829 $self->glog('Using previous syncwinner_always winner', LOG_DEBUG); 3830 } 3831 else { 3832 $self->glog('Starting code_conflict', LOG_VERBOSE); 3833 3834 ## Give each piece of code a chance to resolve the conflict 3835 for my $code (@{ $g->{code_conflict} }) { 3836 3837 ## The all important conflict hash, which the caller may change 3838 $code->{info}{conflicts} = \%conflict; 3839 3840 ## Provide the current schema and table name 3841 $code->{info}{schemaname} = $S; 3842 $code->{info}{tablename} = $T; 3843 3844 ## Provide detailed information on all databases, but elide the dbh 3845 for my $dbname (@dbs_connectable) { 3846 3847 my $d = $sync->{db}{$dbname}; 3848 3849 ## Make a shallow copy, excluding the actual dbh handle 3850 for my $name (keys %$d) { 3851 3852 ## We provide DBIx::Safe versions elsewhere 3853 next if $name eq 'dbh'; 3854 3855 $code->{info}{dbinfo}{$dbname}{$name} = $d->{$name}; 3856 } 3857 } 3858 3859 my $cname = $code->{name}; 3860 3861 ## Run the conflict handler customcode, get the result 3862 my $result = $self->run_kid_custom_code($sync, $code); 3863 $self->glog("Result of custom code $cname is $result", LOG_DEBUG); 3864 3865 ## Code has asked us to do nothing 3866 next if 'skip' eq $result; 3867 3868 ## How to handle conflicts for this table right now only: 3869 if ($result =~ /tablewinner: (.+)/o) { 3870 my $winlist = $1; 3871 $self->glog("Custom code $cname says table winners should be: $winlist", LOG_VERBOSE); 3872 $self->{conflictinfo}{tablewinner}{$g} = $winlist; 3873 last; 3874 } 3875 3876 ## How to handle conflicts for this table until the sync restarts: 3877 if ($result =~ /tablewinner_always: (.+)/o) { 3878 my $winlist = $1; 3879 $self->glog("Custom code $cname says table winners should always be: $winlist", LOG_VERBOSE); 3880 $self->{conflictinfo}{tablewinner_always}{$g} = $winlist; 3881 last; 3882 } 3883 3884 ## How to handle conflicts for all tables in this sync: 3885 if ($result =~ /syncwinner: (.+)/o) { 3886 my $winlist = $1; 3887 $self->glog("Custom code $cname says all table winners should be: $winlist", LOG_VERBOSE); 3888 $self->{conflictinfo}{syncwinner} = $winlist; 3889 last; 3890 } 3891 3892 ## How to handle conflicts for all tables in this sync, until the sync restarts: 3893 if ($result =~ /syncwinner_always: (.+)/o) { 3894 my $winlist = $1; 3895 $self->glog("Custom code $cname says all table winners should always be: $winlist", LOG_VERBOSE); 3896 $self->{conflictinfo}{syncwinner_always} = $winlist; 3897 last; 3898 } 3899 3900 ## We assume that some or all keys in %conflict have been changed, 3901 ## from a hashref to a scalar. 3902 ## We don't do checks here, as it will get caught down below. 3903 3904 ## If info->{lastcode} has been set, we don't call any other codes 3905 last if $result eq 'last'; 3906 3907 } ## end each code_conflict 3908 } 3909 } 3910 ## If conflict_strategy is abort, simply die right away 3911 elsif ('bucardo_abort' eq $g->{conflict_strategy}) { 3912 $self->pause_and_exit(qq{Aborting sync due to conflict of $S.$T}); 3913 } 3914 ## If we require a custom code, also die 3915 elsif ('bucardo_custom' eq $g->{conflict_strategy}) { 3916 $self->pause_and_exit(qq{Aborting sync due to lack of custom conflict handler for $S.$T}); 3917 } 3918 elsif ($g->{conflict_strategy} =~ /^bucardo_latest/o) { 3919 3920 ## For bucardo_latest*, we want to check the transaction times across 3921 ## all databases in this sync that may conflict - in other words, 3922 ## source databases that have deltas. We then sort that list and set it 3923 ## as the list of preferred databases 3924 ## There are two variants: 3925 ## bucardo_latest: check this table only 3926 ## bucardo_latest_all_tables: check all tables in the sync 3927 ## These get internally mapped to tablewinner and syncwinner respectively 3928 3929 $self->glog(qq{Starting conflict strategy $g->{conflict_strategy}}, LOG_VERBOSE); 3930 3931 ## If we are doing all tables, we only run it once, then save the information 3932 if (exists $self->{conflictinfo}{syncwinner}) { 3933 $self->glog("Using previous conflict winner $self->{conflictinfo}{syncwinner}", LOG_DEBUG); 3934 } 3935 else { 3936 my $maxsql = 'SELECT COALESCE(extract(epoch FROM MAX(txntime)),0) FROM'; 3937 3938 ## Find the maximum txntime across all databases for this table 3939 if ($g->{conflict_strategy} eq 'bucardo_latest') { 3940 $SQL = "$maxsql bucardo.$g->{deltatable}"; 3941 } 3942 ## Same, but also across all tables in the sync 3943 elsif ($g->{conflict_strategy} eq 'bucardo_latest_all_tables') { 3944 $SQL = join " UNION\n" => 3945 map { "$maxsql bucardo.$_->{deltatable}" } 3946 grep { $_->{reltype} eq 'table'} 3947 @$goatlist; 3948 } 3949 else { 3950 ## Sanity check in case something got misspelled 3951 $self->pause_and_exit(qq{Unknown conflict_strategy $g->{conflict_strategy}!}); 3952 } 3953 3954 $SQL .= ' ORDER BY 1 DESC LIMIT 1'; 3955 3956 ## Check every database that generates deltas 3957 for my $dbname (@dbs_delta) { 3958 3959 my $d = $sync->{db}{$dbname}; 3960 3961 $d->{sth} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC}); 3962 $d->{async_active} = time; 3963 $d->{sth}->execute(); 3964 } 3965 for my $dbname (@dbs_delta) { 3966 3967 my $d = $sync->{db}{$dbname}; 3968 3969 $d->{dbh}->pg_result(); 3970 $d->{async_active} = 0; 3971 $d->{lastmod} = $d->{sth}->fetchall_arrayref()->[0][0] || 0; 3972 } 3973 3974 ## Now we can put them in rank order 3975 ## The last modification time is the main key 3976 ## In the unlikely chance of a tie, we go by alphabetical database name 3977 my $winner = 3978 join ' ' => 3979 map { $_->[0] } 3980 sort { $b->[1] <=> $a->[1] or $a->[0] cmp $b->[0] } 3981 map { [$_, $sync->{db}{$_}{lastmod} ] } 3982 @dbs_delta; 3983 3984 $self->glog("Set conflict winners to: $winner", LOG_VERBOSE); 3985 3986 ## Store it away 3987 $self->{conflictinfo}{tablewinner}{$g} = $winner; 3988 if ($g->{conflict_strategy} eq 'bucardo_latest_all_tables') { 3989 $self->{conflictinfo}{syncwinner} = $winner; 3990 } 3991 } 3992 3993 } ## end of bucardo_latest* 3994 else { 3995 ## Not a built-in, so assume a list of databases: 3996 $self->{conflictinfo}{winners} = $g->{conflict_strategy}; 3997 } 3998 3999 ## At this point, we should have enough information to solve the conflict 4000 ## Either conflictinfo{winners} will have a list of databases, 4001 ## or we will have a per-table or per-sync list 4002 if (! exists $self->{conflictinfo}{winners}) { 4003 if (exists $self->{conflictinfo}{tablewinner}{$g}) { 4004 $self->{conflictinfo}{winners} = $self->{conflictinfo}{tablewinner}{$g}; 4005 } 4006 if (exists $self->{conflictinfo}{tablewinner_always}{$g}) { 4007 $self->{conflictinfo}{winners} = $self->{conflictinfo}{tablewinner_always}{$g}; 4008 } 4009 if (exists $self->{conflictinfo}{syncwinner}) { 4010 $self->{conflictinfo}{winners} = $self->{conflictinfo}{syncwinner}; 4011 } 4012 if (exists $self->{conflictinfo}{syncwinner_alwyas}) { 4013 $self->{conflictinfo}{winners} = $self->{conflictinfo}{syncwinner_always}; 4014 } 4015 } 4016 4017 if (exists $self->{conflictinfo}{winners}) { 4018 ## We walk through all of the conflicting rows, and set the winner as the 4019 ## database highest in the supplied list 4020 my $sc = $self->{conflictinfo}{winners} 4021 or $self->pause_and_exit(q{Invalid conflict winners list given}); 4022 if (index($sc, ' ') < 1) { 4023 ## Sanity check 4024 if (! exists $deltacount{$sc}) { 4025 $self->pause_and_exit(qq{Invalid conflict strategy '$sc' used for $S.$T: no such database}); 4026 } 4027 for my $pkval (keys %conflict) { 4028 ## May have already been set by customcode, so only change if a ref 4029 $conflict{$pkval} = $sc if ref $conflict{$pkval}; 4030 } 4031 } 4032 else { 4033 ## Have more than one, so figure out the best one to use 4034 my @mdbs = split / +/ => $sc; 4035 ## Make sure they all exist 4036 for my $dbname (@mdbs) { 4037 if (! exists $deltacount{$dbname}) { 4038 $self->pause_and_exit(qq{Invalid conflict strategy '$sc' used for $S.$T: no such database '$dbname'});; 4039 } 4040 } 4041 4042 ## Fill in each conflict with first found database 4043 for my $pkval (keys %conflict) { 4044 ## As above, we only change if currently a ref 4045 next if ! ref $conflict{$pkval}; 4046 $conflict{$pkval} = first { exists $conflict{$pkval}{$_} } split ' ' => $sc; 4047 } 4048 } 4049 } 4050 4051 ## Delete our old conflict resolution information so we don't use it again 4052 delete $self->{conflictinfo}{winners}; 4053 4054 ## At this point, the conflict hash should consist of keys with 4055 ## the winning database as the value 4056 ## Walk through and apply to the %deltabin hash 4057 4058 for my $pkey (keys %conflict) { 4059 4060 ## Delete everyone for this primary key 4061 for my $dbname (keys %deltabin) { 4062 delete $deltabin{$dbname}{$pkey}; 4063 } 4064 4065 ## Add (or re-add) the winning one 4066 ## We do it this way as we cannot be sure that the combo existed. 4067 ## It could be the case that the winning database made 4068 ## no changes to this table! 4069 $deltabin{ $conflict{$pkey} }{$pkey} = 1; 4070 } 4071 4072 $self->glog('Conflicts have been resolved', LOG_NORMAL); 4073 4074 } ## end if have conflicts 4075 4076 ## Create filehandles for any flatfile databases 4077 for my $dbname (keys %{ $sync->{db} }) { 4078 4079 my $d = $sync->{db}{$dbname}; 4080 4081 next if $d->{dbtype} !~ /flat/o; 4082 4083 ## Figure out and set the filename 4084 my $date = strftime('%Y%m%d_%H%M%S', localtime()); 4085 $d->{filename} = "$config{flatfile_dir}/bucardo.flatfile.$self->{syncname}.$date.sql"; 4086 4087 ## Does this already exist? It's possible we got so quick the old one exists 4088 ## Since we want the names to be unique, come up with a new name 4089 if (-e $d->{filename}) { 4090 my $tmpfile; 4091 my $extension = 1; 4092 { 4093 $tmpfile = "$d->{filename}.$extension"; 4094 last if -e $tmpfile; 4095 $extension++; 4096 redo; 4097 } 4098 $d->{filename} = $tmpfile; 4099 } 4100 $d->{filename} .= '.tmp'; 4101 4102 open $d->{filehandle}, '>>', $d->{filename} 4103 or die qq{Could not open flatfile "$d->{filename}": $!\n}; 4104 } 4105 4106 ## Populate the semaphore table if the setting is non-empty 4107 if ($config{semaphore_table}) { 4108 my $tname = $config{semaphore_table}; 4109 for my $dbname (@dbs_connectable) { 4110 4111 my $d = $sync->{db}{$dbname}; 4112 4113 if ($d->{dbtype} eq 'mongo') { 4114 $self->update_mongo_status( $d, $syncname, $tname, 'started' ); 4115 } 4116 } 4117 } 4118 4119 ## At this point, %deltabin should contain a single copy of each primary key 4120 ## It may even be empty if we are truncating 4121 4122 ## We need to figure out how many sources we have for some later optimizations 4123 my $numsources = keys %deltabin; 4124 4125 ## Figure out which databases are getting written to 4126 ## If there is only one source, then it will *not* get written to 4127 ## If there is more than one source, then everyone gets written to! 4128 for my $dbname (keys %{ $sync->{db} }) { 4129 4130 my $d = $sync->{db}{$dbname}; 4131 4132 ## Again: everyone is written to unless there is a single source 4133 ## A truncation source may have an empty deltabin, but it will exist 4134 $d->{writtento} = (1==$numsources and exists $deltabin{$dbname}) ? 0 : 1; 4135 next if ! $d->{writtento}; 4136 4137 ## Should we use the stage table for this database? 4138 $d->{trackstage} = ($numsources > 1 and exists $deltabin{$dbname}) ? 1 : 0; 4139 4140 ## Disable triggers as needed 4141 $self->disable_triggers($sync, $d); 4142 4143 ## Disable indexes as needed (will be rebuilt after data is copied) 4144 $self->disable_indexes($sync, $d, $g); 4145 4146 } ## end setting up each database 4147 4148 4149 ## This is where we want to 'rewind' to on a handled exception 4150 PUSH_SAVEPOINT: { 4151 4152 $delta_attempts++; 4153 4154 ## From here on out, we're making changes that may trigger an exception 4155 ## Thus, if we have exception handling code, we create savepoints to rollback to 4156 if ($g->{has_exception_code}) { 4157 for my $dbname (keys %{ $sync->{db} }) { 4158 4159 my $d = $sync->{db}{$dbname}; 4160 4161 ## No need to rollback if we didn't make any changes 4162 next if ! $d->{writtento}; 4163 4164 $self->glog(qq{Creating savepoint on database "$dbname" for exception handler(s)}, LOG_DEBUG); 4165 $d->{dbh}->do("SAVEPOINT bucardo_$$") 4166 or die qq{Savepoint creation failed for bucardo_$$}; 4167 } 4168 } 4169 4170 ## This var gets set to true at the end of the eval 4171 ## Safety check as $@ alone is not enough 4172 my $evaldone = 0; 4173 4174 ## This label is solely to localize the DIE signal handler 4175 LOCALDIE: { 4176 4177 $sth{kid_syncrun_update_status}->execute("Sync $S.$T (KID $$)", $syncname); 4178 $maindbh->commit(); 4179 4180 ## Everything before this point should work, so we delay the eval until right before 4181 ## our first actual data change on a target 4182 4183 eval { 4184 4185 ## Walk through each database in %deltabin, and push its contents 4186 ## to all other databases for this sync 4187 for my $dbname1 (sort keys %deltabin) { 4188 4189 ## If we are doing a truncate, delete everything from all other dbs! 4190 if (exists $g->{truncatewinner}) { 4191 4192 for my $dbnamet (@dbs) { 4193 4194 ## Exclude ourselves, which should be the only thing in deltabin! 4195 next if $dbname1 eq $dbnamet; 4196 4197 ## Set the real target name 4198 $g->{tablename} = $g->{newname}{$syncname}{$dbnamet}; 4199 4200 my $d = $sync->{db}{$dbnamet}; 4201 4202 my $do_cascade = 0; 4203 $self->truncate_table($d, $g, $do_cascade); 4204 4205 ## Do not keep this around, as it is sync and db specific! 4206 delete $g->{tablename}; 4207 4208 } 4209 ## We keep going, in case the source has post-truncation items 4210 } 4211 4212 ## How many rows are we pushing around? If none, we done! 4213 my $rows = keys %{ $deltabin{$dbname1} }; 4214 $self->glog("Rows to push from $dbname1.$S.$T: $rows", LOG_VERBOSE); 4215 ## This also exits us if we are a truncate with no source rows 4216 next if ! $rows; 4217 $deltacount{alltables}++; 4218 4219 ## Build the list of target databases we are pushing to 4220 my @pushdbs; 4221 for my $dbname2 (@dbs_non_fullcopy) { 4222 4223 ## Don't push to ourselves! 4224 next if $dbname1 eq $dbname2; 4225 4226 ## No %seenpair is needed: this time we *do* go both ways (A->B, then B->A) 4227 4228 push @pushdbs => $sync->{db}{$dbname2}; 4229 } 4230 4231 my $sourcedb = $sync->{db}{$dbname1}; 4232 4233 ## Here's the real action: delete/truncate from target, then copy from source to target 4234 4235 ## For this table, delete all rows that may exist on the target(s) 4236 $sth{kid_syncrun_update_status}->execute("Deleting based on $dbname1.$S.$T",$syncname); 4237 $maindbh->commit(); 4238 $dmlcount{deletes} += $self->delete_rows( 4239 $deltabin{$dbname1}, $g, $sync, \@pushdbs); 4240 4241 ## For this table, copy all rows from source to target(s) 4242 $sth{kid_syncrun_update_status}->execute("Copying from $dbname1.$S.$T",$syncname); 4243 $maindbh->commit(); 4244 $dmlcount{inserts} += $self->push_rows( 4245 $deltabin{$dbname1}, $g, $sync, $sourcedb, \@pushdbs, 'copy'); 4246 4247 ## Store references to the list of changes in case custom code needs them 4248 $sync->{deltarows}{$S}{$T} = $deltabin{$dbname1}; 4249 4250 } ## end copying data from each source database 4251 4252 ## Enable indexes and run REINDEX as needed 4253 $self->enable_indexes($sync, $g); 4254 4255 ## We set this as we cannot rely on $@ alone 4256 $evaldone = 1; 4257 4258 }; ## end of eval 4259 4260 } ## end of LOCALDIE 4261 4262 ## Got exception handlers, but no exceptions, so reset the count: 4263 if ($evaldone) { 4264 $g->{exceptions} = 0; 4265 } 4266 ## Did we fail the eval? 4267 else { 4268 4269 chomp $@; 4270 (my $err = $@) =~ s/\n/\\n/g; 4271 4272 ## If we have no exception code, we simply die to pass control to $err_handler. 4273 ## XXX If no handler, we want to rewind and try again ourselves 4274 ## XXX But this time, we want to enter a more aggressive conflict resolution mode 4275 ## XXX Specifically, we need to ensure that a single database "wins" and that 4276 ## XXX all table changes therein come from that database. 4277 ## XXX No need if we only have a single table, of course, or if there were 4278 ## XXX no possible conflicting changes. 4279 ## XXX Finally, we skip if the first run already had a canonical winner 4280 if (!$g->{has_exception_code}) { 4281 $self->glog("Warning! Aborting due to exception for $S.$T:$pkval Error was $err", 4282 $err =~ /serialize|deadlock/ ? LOG_VERBOSE : LOG_WARN); 4283 ## If this was a serialization error, we will not need to use pg_cancel 4284 if ($err =~ /serialize/) { 4285 $g->{async_active} = 0; 4286 } 4287 die "$err\n"; 4288 } 4289 4290 ## We have an exception handler 4291 $self->glog("Exception caught: $err", LOG_WARN); 4292 4293 ## Bail if we've already tried to handle this goat via an exception 4294 if ($g->{exceptions}++ > 1) { 4295 ## XXX Does this get properly reset on a redo? 4296 $self->glog("Warning! Exception custom code did not work for $S.$T:$pkval", LOG_WARN); 4297 die qq{Error: too many exceptions to handle for $S.$T:$pkval}; 4298 } 4299 4300 ## Time to let the exception handling custom code do its work 4301 ## First, we rollback to our savepoint on all databases that are using them 4302 for my $dbname (keys %{ $sync->{db} }) { 4303 4304 my $d = $sync->{db}{$dbname}; 4305 4306 next if ! $d->{writtento}; 4307 4308 ## Just in case, clear out any existing async queries 4309 if ($d->{async_active}) { 4310 $d->{dbh}->pg_cancel(); 4311 $d->{async_active} = 0; 4312 } 4313 4314 $self->glog("Rolling back to savepoint on database $dbname", LOG_DEBUG); 4315 $d->{dbh}->do("ROLLBACK TO SAVEPOINT bucardo_$$"); 4316 } 4317 4318 ## Prepare information to pass to the handler about this run 4319 my $codeinfo = { 4320 version => $VERSION, 4321 schemaname => $S, 4322 tablename => $T, 4323 error_string => $err, 4324 deltabin => \%deltabin, 4325 attempts => $delta_attempts, 4326 }; 4327 4328 ## Set if any handlers think we should try again 4329 my $runagain = 0; 4330 4331 for my $code (@{$g->{code_exception}}) { 4332 4333 $self->glog("Trying exception code $code->{id}: $code->{name}", LOG_TERSE); 4334 4335 ## Pass in the information above about the current state 4336 $code->{info} = $codeinfo; 4337 4338 my $result = $self->run_kid_custom_code($sync, $code); 4339 4340 ## A request to run the same goat again. 4341 if ('retry' eq $result) { 4342 $self->glog('Exception handler thinks we can try again', LOG_NORMAL); 4343 $runagain = 1; 4344 last; 4345 } 4346 4347 ## Request to skip any other codes 4348 last if $result eq 'last'; 4349 4350 $self->glog('Going to next available exception code', LOG_VERBOSE); 4351 next; 4352 } 4353 4354 ## If not running again, we simply give up and throw an exception to the kid 4355 if (!$runagain) { 4356 $self->glog('No exception handlers were able to help, so we are bailing out', LOG_WARN); 4357 die qq{No exception handlers were able to help, so we are bailing out\n}; 4358 } 4359 4360 ## The custom code wants to try again 4361 ## XXX Should probably reset session_replication_role 4362 4363 ## Make sure the Postgres database connections are still clean 4364 for my $dbname (@dbs_postgres) { 4365 4366 my $ping = $sync->{db}{$dbname}{dbh}->ping(); 4367 if ($ping !~ /^[123]$/o) { 4368 $self->glog("Warning! Ping on database $dbname after exception handler was $ping", LOG_WARN); 4369 } 4370 } 4371 4372 ## Now jump back and try this goat again! 4373 redo PUSH_SAVEPOINT; 4374 4375 } ## end of handled exception 4376 4377 } ## end of PUSH_SAVEPOINT 4378 4379 } ## end each goat 4380 4381 $self->glog("Totals: deletes=$dmlcount{deletes} inserts=$dmlcount{inserts} conflicts=$dmlcount{conflicts}", 4382 LOG_VERBOSE); 4383 4384 ## Update bucardo_track table so that the bucardo_delta rows we just processed 4385 ## are marked as "done" and ignored by subsequent runs 4386 4387 ## Reset our pretty-printer count 4388 $maxcount = 0; 4389 4390 for my $g (@$goatlist) { 4391 4392 next if $g->{reltype} ne 'table'; 4393 4394 ($S,$T) = ($g->{safeschema},$g->{safetable}); 4395 delete $g->{rateinfo}; 4396 4397 ## Gather up our rate information - just store for now, we can write it after the commits 4398 ## XX Redo with sourcename etc. 4399 ## Skip as {deltarate} is not even defined! 4400 if (0) { 4401 if ($deltacount{source}{$S}{$T} and $sync->{track_rates}) { 4402 $self->glog('Gathering source rate information', LOG_VERBOSE); 4403 my $sth = $sth{source}{$g}{deltarate}; 4404 $count = $sth->execute(); 4405 $g->{rateinfo}{source} = $sth->fetchall_arrayref(); 4406 } 4407 4408 for my $dbname (@dbs_source) { 4409 4410 if ($deltacount{dbtable}{$dbname}{$S}{$T} and $sync->{track_rates}) { 4411 $self->glog('Gathering target rate information', LOG_VERBOSE); 4412 my $sth = $sth{target}{$g}{deltarate}; 4413 $count = $sth->execute(); 4414 $g->{rateinfo}{target} = $sth->fetchall_arrayref(); 4415 } 4416 4417 } 4418 } 4419 ## For each database that had delta changes, insert rows to bucardo_track 4420 for my $dbname (@dbs_source) { 4421 4422 my $d = $sync->{db}{$dbname}; 4423 4424 $d->{needs_track} = 0; 4425 4426 if ($deltacount{dbtable}{$dbname}{$S}{$T}) { 4427 $d->{needs_track} = 1; 4428 ## Kick off the track or stage update asynchronously 4429 if ($d->{trackstage}) { 4430 ## The stage table can only have rows if a previous version failed 4431 ## This can happen if this kid committed, but another failed 4432 ## Thus, we always want to make sure the stage table is empty: 4433 $SQL = "DELETE FROM bucardo.$g->{stagetable}"; 4434 $d->{dbh}->do($SQL); 4435 $sth{stage}{$dbname}{$g}->execute(); 4436 } 4437 else { 4438 $sth{track}{$dbname}{$g}->execute(); 4439 } 4440 $d->{async_active} = time; 4441 } 4442 } 4443 4444 ## Loop through again and let everyone finish 4445 for my $dbname (@dbs_source) { 4446 4447 my $d = $sync->{db}{$dbname}; 4448 4449 if ($d->{needs_track}) { 4450 ($count = $d->{dbh}->pg_result()) =~ s/0E0/0/o; 4451 $d->{async_active} = 0; 4452 $self->{insertcount}{dbname}{$S}{$T} = $count; 4453 $maxcount = $count if $count > $maxcount; 4454 } 4455 } 4456 4457 } ## end each goat 4458 4459 ## Get sizing for the next printout 4460 my $maxsize = 10; 4461 my $maxcount2 = 1; 4462 4463 for my $g (@$goatlist) { 4464 next if $g->{reltype} ne 'table'; 4465 ($S,$T) = ($g->{safeschema},$g->{safetable}); 4466 for my $dbname (keys %{ $sync->{db} }) { 4467 next if ! $deltacount{dbtable}{$dbname}{$S}{$T}; 4468 $maxsize = length " $dbname.$S.$T" if length " $dbname.$S.$T" > $maxsize; 4469 $maxcount2 = length $count if length $count > $maxcount2; 4470 } 4471 } 4472 4473 ## Pretty print the number of rows per db/table 4474 for my $g (@$goatlist) { 4475 next if $g->{reltype} ne 'table'; 4476 ($S,$T) = ($g->{safeschema},$g->{safetable}); 4477 4478 for my $dbname (keys %{ $sync->{db} }) { 4479 4480 my $d = $sync->{db}{$dbname}; 4481 4482 if ($deltacount{dbtable}{$dbname}{$S}{$T}) { 4483 $count = $self->{insertcount}{dbname}{$S}{$T}; 4484 $self->glog((sprintf 'Rows inserted to bucardo_%s for %-*s: %*d', 4485 $d->{trackstage} ? 'stage' : 'track', 4486 $maxsize, 4487 "$dbname.$S.$T", 4488 length $maxcount2, 4489 $count), 4490 LOG_DEBUG); 4491 } 4492 } ## end each db 4493 } ## end each table 4494 4495 } ## end if dbs_delta 4496 4497 ## Handle all the fullcopy targets 4498 if (@dbs_fullcopy) { 4499 4500 ## We only need one of the sources, so pull out the first one 4501 ## (dbs_source should only have a single entry anyway) 4502 my ($sourcename, $sourcedbh, $sourcex); 4503 for my $dbname (@dbs_source) { 4504 4505 my $d = $sync->{db}{$dbname}; 4506 4507 $sourcename = $dbname; 4508 $sourcedbh = $d->{dbh}; 4509 $sourcex = $d; 4510 $self->glog(qq{For fullcopy, we are using source database "$sourcename"}, LOG_VERBOSE); 4511 last; 4512 4513 } 4514 4515 ## Temporary hash to store onetimecopy information 4516 $sync->{otc} = {}; 4517 4518 ## Walk through and handle each goat 4519 GOAT: for my $g (@$goatlist) { 4520 4521 ($S,$T) = ($g->{safeschema},$g->{safetable}); 4522 4523 ## Handle sequences first 4524 ## We always do these, regardless of onetimecopy 4525 if ($g->{reltype} eq 'sequence') { 4526 $SQL = "SELECT * FROM $S.$T"; 4527 $sth = $sourcedbh->prepare($SQL); 4528 $sth->execute(); 4529 $g->{sequenceinfo}{$sourcename} = $sth->fetchall_arrayref({})->[0]; 4530 $g->{winning_db} = $sourcename; 4531 4532 ## We want to modify all fullcopy targets only 4533 for my $dbname (@dbs_fullcopy) { 4534 $sync->{db}{$dbname}{adjustsequence} = 1; 4535 } 4536 $self->adjust_sequence($g, $sync, $S, $T, $syncname); 4537 4538 next; 4539 } 4540 4541 ## Some tables exists just to be examined but not pushed to 4542 if ($g->{ghost}) { 4543 $self->glog("Skipping ghost table $S.$T", LOG_VERBOSE); 4544 next; 4545 } 4546 4547 ## If doing a one-time-copy and using empty mode, skip this table if it has rows 4548 ## This is done on a per table / per target basis 4549 if (2 == $sync->{onetimecopy}) { 4550 4551 ## Also make sure we have at least one row on the source 4552 my $tname = $g->{newname}{$syncname}{$sourcename}; 4553 if (! $self->table_has_rows($sourcex, $tname)) { 4554 $self->glog(qq{Source table "$sourcename.$S.$T" has no rows and we are in onetimecopy if empty mode, so we will not COPY}, LOG_NORMAL); 4555 ## No sense in going any further 4556 next GOAT; 4557 } 4558 4559 ## Check each fullcopy target to see if it is empty and thus ready to COPY 4560 my $have_targets = 0; 4561 for my $dbname (@dbs_fullcopy) { 4562 4563 ## Reset this in case a previous loop changed it 4564 $sync->{otc}{skip}{$dbname} = 0; 4565 4566 my $d = $sync->{db}{$dbname}; 4567 4568 my $targetname = $g->{newname}{$syncname}{$dbname}; 4569 4570 ## If this target table has rows, skip it 4571 if ($self->table_has_rows($d, $targetname)) { 4572 $sync->{otc}{skip}{$dbname} = 1; 4573 $self->glog(qq{Target table "$dbname.$targetname" has rows and we are in onetimecopy if empty mode, so we will not COPY}, LOG_NORMAL); 4574 } 4575 else { 4576 $have_targets = 1; 4577 } 4578 } 4579 4580 ## If we have no valid targets at all, skip this goat 4581 next GOAT if ! $have_targets; 4582 4583 } ## end onetimecopy of 2 4584 4585 ## The list of targets we will be fullcopying to 4586 ## This is a subset of dbs_fullcopy, and may be less due 4587 ## to the target having rows and onetimecopy being set 4588 my @dbs_copytarget; 4589 4590 for my $dbname (@dbs_fullcopy) { 4591 4592 ## Skip if onetimecopy was two and this target had rows 4593 next if 2 == $sync->{onetimecopy} and $sync->{otc}{skip}{$dbname}; 4594 4595 push @dbs_copytarget => $dbname; 4596 4597 } 4598 4599 ## Truncate the table on all target databases, and fallback to delete if that fails 4600 for my $dbname (@dbs_copytarget) { 4601 4602 my $d = $sync->{db}{$dbname}; 4603 4604 ## Nothing to do here for flatfiles 4605 next if $d->{dbtype} =~ /flat/; 4606 4607 ## Disable triggers as needed 4608 $self->disable_triggers($sync, $d); 4609 4610 ## Disable indexes as needed 4611 $self->disable_indexes($sync, $d, $g); 4612 4613 $self->glog(qq{Emptying out $dbname.$S.$T using $sync->{deletemethod}}, LOG_VERBOSE); 4614 my $use_delete = 1; 4615 4616 ## By hook or by crook, empty this table 4617 4618 my $tname = $g->{tablename} = $g->{newname}{$syncname}{$dbname}; 4619 4620 if ($sync->{deletemethod} =~ /truncate/io) { 4621 my $do_cascade = $sync->{deletemethod} =~ /cascade/io ? 1 : 0; 4622 if ($self->truncate_table($d, $g, $do_cascade)) { 4623 $self->glog("Truncated table $tname", LOG_VERBOSE); 4624 $use_delete = 0; 4625 } 4626 else { 4627 $self->glog("Truncation of table $tname failed, so we will try a delete", LOG_VERBOSE); 4628 } 4629 } 4630 4631 if ($use_delete) { 4632 4633 ## This may take a while, so we update syncrun 4634 $sth{kid_syncrun_update_status}->execute("DELETE $tname (KID $$)", $syncname); 4635 $maindbh->commit(); 4636 4637 ## Note: even though $tname is the actual name, we still track stats with $S.$T 4638 $dmlcount{D}{target}{$S}{$T} = $self->delete_table($d, $g); 4639 $dmlcount{alldeletes}{target} += $dmlcount{D}{target}{$S}{$T}; 4640 $self->glog("Rows deleted from $tname: $dmlcount{D}{target}{$S}{$T}", LOG_VERBOSE); 4641 } 4642 4643 ## This needs to not stick around 4644 delete $g->{tablename}; 4645 4646 } ## end each database to be truncated/deleted 4647 4648 4649 ## For this table, copy all rows from source to target(s) 4650 $dmlcount{inserts} += $dmlcount{I}{target}{$S}{$T} = $self->push_rows( 4651 {}, $g, $sync, $sourcex, 4652 ## We need an array of database objects here: 4653 [ map { $sync->{db}{$_} } @dbs_copytarget ], 'fullcopy'); 4654 4655 ## Add to our cross-table tally 4656 $dmlcount{allinserts}{target} += $dmlcount{I}{target}{$S}{$T}; 4657 4658 ## Restore the indexes and run REINDEX where needed 4659 $self->enable_indexes($sync, $g); 4660 4661 ## TODO: logic to clean out delta rows is this was a onetimecopy 4662 4663 } ## end each goat 4664 4665 if ($sync->{deletemethod} ne 'truncate') { 4666 $self->glog("Total target rows deleted: $dmlcount{alldeletes}{target}", LOG_NORMAL); 4667 } 4668 $self->glog("Total target rows copied: $dmlcount{allinserts}{target}", LOG_NORMAL); 4669 4670 } ## end have some fullcopy targets 4671 4672 ## Close filehandles for any flatfile databases 4673 for my $dbname (keys %{ $sync->{db} }) { 4674 4675 my $d = $sync->{db}{$dbname}; 4676 4677 next if $d->{dbtype} !~ /flat/o; 4678 4679 close $d->{filehandle} 4680 or warn qq{Could not close flatfile "$d->{filename}": $!\n}; 4681 ## Atomically rename it so other processes can pick it up 4682 (my $newname = $d->{filename}) =~ s/\.tmp$//; 4683 rename $d->{filename}, $newname; 4684 4685 ## Remove the old ones, just in case 4686 delete $d->{filename}; 4687 delete $d->{filehandle}; 4688 } 4689 4690 ## If using semaphore tables, mark the status as 'complete' 4691 if ($config{semaphore_table}) { 4692 4693 my $tname = $config{semaphore_table}; 4694 4695 for my $dbname (@dbs_connectable) { 4696 4697 my $d = $sync->{db}{$dbname}; 4698 4699 if ($d->{dbtype} eq 'mongo') { 4700 $self->update_mongo_status( $d, $syncname, $tname, 'complete' ); 4701 } 4702 } 4703 } 4704 4705 ## If doing truncate, do some cleanup 4706 if (exists $self->{truncateinfo}) { 4707 ## For each source database that had a truncate entry, mark them all as done 4708 $SQL = 'UPDATE bucardo.bucardo_truncate_trigger SET replicated = now() WHERE sync = ? AND replicated IS NULL'; 4709 for my $dbname (@dbs_source) { 4710 4711 my $d = $sync->{db}{$dbname}; 4712 4713 $d->{sth} = $d->{dbh}->prepare($SQL, {pg_async => PG_ASYNC}); 4714 $d->{sth}->execute($syncname); 4715 $d->{async_active} = time; 4716 4717 } 4718 for my $dbname (@dbs_source) { 4719 4720 my $d = $sync->{db}{$dbname}; 4721 4722 $d->{dbh}->pg_result(); 4723 $d->{async_active} = 0; 4724 4725 } 4726 } 4727 4728 ## Run all 'before_trigger_enable' code 4729 if (exists $sync->{code_before_trigger_enable}) { 4730 $sth{kid_syncrun_update_status}->execute("Code before_trigger_enable (KID $$)", $syncname); 4731 $maindbh->commit(); 4732 for my $code (@{$sync->{code_before_trigger_enable}}) { 4733 last if 'last' eq $self->run_kid_custom_code($sync, $code); 4734 } 4735 } 4736 4737 ## Turn triggers and rules back on as needed 4738 $self->enable_triggers($sync); 4739 4740 ## Bring the db back to normal 4741 for my $dbname (@dbs_write) { 4742 4743 my $d = $sync->{db}{$dbname}; 4744 4745 next if ! $d->{writtento}; 4746 4747 if ($d->{dbtype} eq 'mysql' or $d->{dbtype} eq 'mariadb') { 4748 4749 $self->glog(qq{Turning foreign key checks back on for $dbname}, LOG_VERBOSE); 4750 $d->{dbh}->do('SET foreign_key_checks = 1'); 4751 } 4752 } 4753 4754 if ($self->{dryrun}) { 4755 $self->glog('Dryrun, rolling back...', LOG_TERSE); 4756 for my $dbname (@dbs_dbi) { 4757 $sync->{db}{$dbname}{dbh}->rollback(); 4758 } 4759 for my $dbname (@dbs_redis) { 4760 ## Implement DISCARD when the client supports it 4761 ##$sync->{db}{$dbname}{dbh}->discard(); 4762 } 4763 $maindbh->rollback(); 4764 } 4765 else { 4766 $self->glog(q{Issuing final commit for all databases}, LOG_VERBOSE); 4767 ## This is a tricky bit: all writeable databases *must* go first 4768 ## If we only have a single source, this ensures we don't mark rows as done 4769 ## in the track tables before everyone has reported back 4770 for my $dbname (@dbs_dbi) { 4771 4772 my $d = $sync->{db}{$dbname}; 4773 4774 next if ! $d->{writtento}; 4775 4776 $d->{dbh}->commit(); 4777 } 4778 ## Now we can commit anyone else 4779 for my $dbname (@dbs_dbi) { 4780 4781 my $d = $sync->{db}{$dbname}; 4782 4783 next if $d->{writtento}; 4784 4785 $d->{dbh}->commit(); 4786 } 4787 for my $dbname (@dbs_redis) { 4788 ## Implement EXEC when the client supports it 4789 ## $sync->{db}{$dbname}{dbh}->exec(); 4790 } 4791 $self->glog(q{All databases committed}, LOG_VERBOSE); 4792 } 4793 4794 ## If we used a staging table for the tracking info, do the final inserts now 4795 ## This is the safest way to ensure we never miss any changes 4796 for my $dbname (@dbs_dbi) { 4797 4798 my $d = $sync->{db}{$dbname}; 4799 4800 next if ! $d->{trackstage}; 4801 4802 my $dbh = $d->{dbh}; 4803 4804 for my $g (@$goatlist) { 4805 4806 next if $g->{reltype} ne 'table'; 4807 4808 next if ! $deltacount{dbtable}{$dbname}{$g->{safeschema}}{$g->{safetable}}; 4809 4810 $SQL = "INSERT INTO bucardo.$g->{tracktable} SELECT * FROM bucardo.$g->{stagetable}"; 4811 $dbh->do($SQL); 4812 $SQL = "DELETE FROM bucardo.$g->{stagetable}"; 4813 $dbh->do($SQL); 4814 $self->glog("Populated $dbname.$g->{tracktable}", LOG_DEBUG); 4815 } 4816 $dbh->commit(); 4817 } 4818 4819 ## Capture the current time. now() is good enough as we just committed or rolled back 4820 ## XXX used for track below 4821 #my $source_commit_time = $sourcedbh->selectall_arrayref('SELECT now()')->[0][0]; 4822 #my $target_commit_time = $targetdbh->selectall_arrayref('SELECT now()')->[0][0]; 4823 #$sourcedbh->commit(); 4824 #$targetdbh->commit(); 4825 #my ($source_commit_time, $target_commit_time); 4826 4827 ## Update the syncrun table, including the delete and insert counts 4828 my $reason = "Finished (KID $$)"; 4829 my $details = ''; 4830 $count = $sth{kid_syncrun_end}->execute( 4831 $dmlcount{deletes}, $dmlcount{inserts}, $dmlcount{truncates}, $dmlcount{conflicts}, 4832 $details, $reason, $syncname); 4833 4834 ## Change this row to the latest good or empty 4835 my $action = ($dmlcount{deletes} or $dmlcount{inserts} or $dmlcount{truncates}) 4836 ? 'good' : 'empty'; 4837 $self->end_syncrun($maindbh, $action, $syncname, "Complete (KID $$)"); 4838 $maindbh->commit(); 4839 4840 ## Just in case, report on failure to update 4841 if ($count != 1) { 4842 $self->glog("Unable to correctly update syncrun table! (count was $count)", LOG_TERSE); 4843 } 4844 4845 ## Put a note in the logs for how long this took 4846 my $synctime = sprintf '%.2f', tv_interval($kid_start_time); 4847 $self->glog((sprintf 'Total time for sync "%s" (%s %s, %s %s): %s%s', 4848 $syncname, 4849 $dmlcount{inserts}, 4850 (1==$dmlcount{inserts} ? 'row' : 'rows'), 4851 $deltacount{alltables}, 4852 (1== $deltacount{alltables} ? 'table' : 'tables'), 4853 pretty_time($synctime), 4854 $synctime < 120 ? '' : " ($synctime seconds)",), LOG_VERBOSE); 4855 4856 ## Update our rate information as needed 4857 if (0 and $sync->{track_rates}) { 4858 $SQL = 'INSERT INTO bucardo_rate(sync,goat,target,mastercommit,slavecommit,total) VALUES (?,?,?,?,?,?)'; 4859 $sth = $maindbh->prepare($SQL); 4860 for my $g (@$goatlist) { 4861 next if ! exists $g->{rateinfo} or $g->{reltype} ne 'table'; 4862 ($S,$T) = ($g->{safeschema},$g->{safetable}); 4863 if ($deltacount{source}{$S}{$T}) { 4864 for my $time (@{$g->{rateinfo}{source}}) { 4865 #$sth->execute($syncname,$g->{id},$targetname,$time,$source_commit_time,$deltacount{source}{$S}{$T}); 4866 } 4867 } 4868 if ($deltacount{target}{$S}{$T}) { 4869 for my $time (@{$g->{rateinfo}{target}}) { 4870 # fixme 4871 #$sth->execute($syncname,$g->{id},$sourcename,$time,$source_commit_time,$deltacount{target}{$S}{$T}); 4872 } 4873 } 4874 } 4875 $maindbh->commit(); 4876 4877 } ## end of track_rates 4878 4879 if (@dbs_fullcopy and !$self->{dryrun}) { 4880 if ($sync->{vacuum_after_copy}) { 4881 ## May want to break this output down by table 4882 $sth{kid_syncrun_update_status}->execute("VACUUM (KID $$)", $syncname); 4883 $maindbh->commit(); 4884 for my $dbname (@dbs_fullcopy) { 4885 4886 my $d = $sync->{db}{$dbname}; 4887 4888 for my $g (@$goatlist) { 4889 next if ! $g->{vacuum_after_copy} or $g->{reltype} ne 'table'; 4890 my $tablename = $g->{newname}{$syncname}{$dbname}; 4891 $self->vacuum_table($kid_start_time, $d->{dbtype}, $d->{dbh}, $d->{name}, $tablename); 4892 } 4893 } 4894 } 4895 if ($sync->{analyze_after_copy}) { 4896 $sth{kid_syncrun_update_status}->execute("ANALYZE (KID $$)", $syncname); 4897 $maindbh->commit(); 4898 for my $dbname (@dbs_fullcopy) { 4899 4900 my $d = $sync->{db}{$dbname}; 4901 4902 for my $g (@$goatlist) { 4903 next if ! $g->{analyze_after_copy} or $g->{reltype} ne 'table'; 4904 if ($g->{onetimecopy_ifempty}) { 4905 $g->{onetimecopy_ifempty} = 0; 4906 next; 4907 } 4908 my $tablename = $g->{newname}{$syncname}{$dbname}; 4909 $self->analyze_table($kid_start_time, $d->{dbtype}, $d->{dbh}, $d->{name}, $tablename); 4910 } 4911 } 4912 } 4913 } 4914 4915 my $total_time = sprintf '%.2f', tv_interval($kid_start_time); 4916 4917 ## Remove lock file if we used it 4918 $self->remove_lock_file(); 4919 4920 ## Run all 'after_txn' code 4921 if (exists $sync->{code_after_txn}) { 4922 $sth{kid_syncrun_update_status}->execute("Code after_txn (KID $$)", $syncname); 4923 $maindbh->commit(); 4924 for my $code (@{$sync->{code_after_txn}}) { 4925 last if 'last' eq $self->run_kid_custom_code($sync, $code); 4926 } 4927 } 4928 4929 ## Clear out the entries from the dbrun table 4930 for my $dbname (@dbs_connectable) { 4931 $sth = $sth{dbrun_delete}; 4932 $sth->execute($syncname, $dbname); 4933 $maindbh->commit(); 4934 } 4935 4936 ## Notify the parent that we are done 4937 $self->db_notify($maindbh, "ctl_syncdone_${syncname}"); 4938 $maindbh->commit(); 4939 4940 ## If this was a onetimecopy, leave so we don't have to rebuild dbs_fullcopy etc. 4941 if ($sync->{onetimecopy}) { 4942 $self->glog('Turning onetimecopy back to 0', LOG_VERBOSE); 4943 $SQL = 'UPDATE sync SET onetimecopy=0 WHERE name = ?'; 4944 $sth = $maindbh->prepare($SQL); 4945 $sth->execute($syncname); 4946 $maindbh->commit(); 4947 ## This gets anything loaded from scratch from this point 4948 ## The CTL knows to switch onetimecopy off because it gets a syncdone signal 4949 last KID; 4950 } 4951 4952 if (! $kidsalive) { 4953 $self->glog('Kid is not kidsalive, so exiting', LOG_DEBUG); 4954 last KID; 4955 } 4956 4957 redo KID; 4958 4959 } ## end KID 4960 4961 ## Disconnect from all the databases used in this sync 4962 for my $dbname (@dbs_dbi) { 4963 my $dbh = $sync->{db}{$dbname}{dbh}; 4964 $dbh->rollback(); 4965 $_->finish for values %{ $dbh->{CachedKids} }; 4966 $dbh->disconnect(); 4967 } 4968 4969 if ($sync->{onetimecopy}) { 4970 ## XXX 4971 ## We need the MCP and CTL to pick up the new setting. This is the 4972 ## easiest way: First we sleep a second, to make sure the CTL has 4973 ## picked up the syncdone signal. It may resurrect a kid, but it 4974 ## will at least have the correct onetimecopy 4975 #sleep 1; 4976 #$maindbh->do("NOTIFY reload_sync_$syncname"); 4977 #$maindbh->commit(); 4978 } 4979 4980 ## Disconnect from the main database 4981 $maindbh->disconnect(); 4982 4983 $self->cleanup_kid('Normal exit', ''); 4984 4985 $didrun = 1; 4986 }; ## end $runkid 4987 4988 ## Do the actual work. 4989 RUNKID: { 4990 $didrun = 0; 4991 eval { $runkid->() }; 4992 exit 0 if $didrun; 4993 4994 my $err = $@; 4995 4996 ## Bail out unless this error came from DBD::Pg 4997 $err_handler->($err) if $err !~ /DBD::Pg/; 4998 4999 eval { 5000 ## We only do special things for certain errors, so check for those. 5001 my ($sleeptime, $fail_msg) = (0,''); 5002 my @states = map { $sync->{db}{$_}{dbh}->state } @dbs_dbi; 5003 if (first { $_ eq '40001' } @states) { 5004 $sleeptime = $config{kid_serial_sleep}; 5005 ## If set to -1, this means we never try again 5006 if ($sleeptime < 0) { 5007 $self->glog('Could not serialize, will not retry', LOG_VERBOSE); 5008 $err_handler->($err); 5009 } 5010 elsif ($sleeptime) { 5011 $self->glog((sprintf 'Could not serialize, will sleep for %s %s', 5012 $sleeptime, 1==$sleeptime ? 'second' : 'seconds'), LOG_NORMAL); 5013 } 5014 else { 5015 $self->glog('Could not serialize, will try again', LOG_NORMAL); 5016 } 5017 $fail_msg = 'Serialization failure'; 5018 } 5019 elsif (first { $_ eq '40P01' } @states) { 5020 $sleeptime = $config{kid_deadlock_sleep}; 5021 ## If set to -1, this means we never try again 5022 if ($sleeptime < 0) { 5023 $self->glog('Encountered a deadlock, will not retry', LOG_VERBOSE); 5024 $err_handler->($err); 5025 } 5026 elsif ($sleeptime) { 5027 $self->glog((sprintf 'Encountered a deadlock, will sleep for %s %s', 5028 $sleeptime, 1==$sleeptime ? 'second' : 'seconds'), LOG_NORMAL); 5029 } 5030 else { 5031 $self->glog('Encountered a deadlock, will try again', LOG_NORMAL); 5032 } 5033 $fail_msg = 'Deadlock detected'; 5034 ## TODO: Get more information via get_deadlock_details() 5035 } 5036 else { 5037 $err_handler->($err); 5038 } 5039 5040 if ($config{log_level_number} >= LOG_VERBOSE) { 5041 ## Show complete error information in debug mode. 5042 for my $dbh (map { $sync->{db}{$_}{dbh} } @dbs_dbi) { 5043 $self->glog( 5044 sprintf('* %s: %s - %s', $dbh->{Name}, $dbh->state, $dbh->errstr), 5045 LOG_VERBOSE 5046 ) if $dbh->err; 5047 } 5048 } 5049 5050 ## Roll everyone back 5051 for my $dbname (@dbs_dbi) { 5052 5053 my $d = $sync->{db}{$dbname}; 5054 5055 my $dbh = $d->{dbh}; 5056 5057 ## If we are async, clear it out - if the connection is still valid! 5058 if ($d->{async_active}) { 5059 my $state = $dbh->state; 5060 if ($state eq '' or $state eq '25P01') { 5061 $dbh->pg_cancel(); 5062 } 5063 $d->{async_active} = 0; 5064 } 5065 5066 ## Mark triggers as enabled, since we are also rolling back our trigger disabling magic 5067 $d->{triggers_enabled} = 1; 5068 5069 ## Seperate eval{} for the rollback as we are probably still connected to the transaction. 5070 eval { $dbh->rollback; }; 5071 if ($@) { 5072 $self->glog("Result of eval for rollback: $@", LOG_DEBUG); 5073 die $@; 5074 } 5075 } 5076 5077 # End the syncrun. 5078 $self->end_syncrun($maindbh, 'bad', $syncname, "Failed : $fail_msg (KID $$)" ); 5079 $maindbh->commit; 5080 5081 ## Tell listeners we are about to sleep 5082 ## TODO: Add some sweet payload information: sleep time, which dbs/tables failed, etc. 5083 $self->db_notify($maindbh, "syncsleep_${syncname}", 0, "$fail_msg. Sleep=$sleeptime"); 5084 5085 ## Sleep and try again. 5086 sleep $sleeptime if $sleeptime; 5087 $kicked = 1; 5088 }; 5089 if ($@) { 5090 # Our recovery failed. :-( 5091 $err_handler->($@); 5092 } 5093 else { 5094 redo RUNKID; 5095 } 5096 5097 } 5098 5099} ## end of start_kid 5100 5101 5102sub start_main_transaction { 5103 5104 ## Prepare each database for the final work of copying data 5105 ## This is the time when we do things such as set the isolation level 5106 ## From this point on, we are in the "main" transaction and speed is important 5107 ## Arguments: one hashref 5108 ## sync: the sync object 5109 ## databases: arrayref of all databases that have been connected to 5110 ## Returns: undef 5111 5112 my ($self, $info) = @_; 5113 5114 my $sync = $info->{sync} or die qq{Required arg 'sync' missing\n}; 5115 my $databases = $info->{databases} or die qq{Required arg 'databases' missing\n}; 5116 5117 for my $dbname (@$databases) { 5118 5119 my $d = $sync->{db}{$dbname}; 5120 my $dbh = exists $d->{dbh} ? $d->{dbh} : ''; 5121 5122 if ($d->{does_dbi}) { 5123 ## Just in case: 5124 $dbh->rollback(); 5125 } 5126 5127 if ('postgres' eq $d->{dbtype}) { 5128 ## We never want to timeout! 5129 $dbh->do('SET statement_timeout = 0'); 5130 ## Using the same time zone everywhere keeps us sane 5131 $dbh->do(q{SET TIME ZONE 'GMT'}); 5132 ## Rare, but allow for tcp fiddling 5133 for my $var (qw/ idle interval count /) { 5134 my $name = "tcp_keepalives_$var"; 5135 5136 ## Should always exist, but: 5137 next if ! exists $config{$name}; 5138 5139 ## Quick sanity checks: 5140 next if ! defined $config{$name} or $config{$name} !~ /^\d+$/; 5141 5142 ## A setting of zero means leave it alone 5143 next if ! $config{$name}; 5144 5145 $dbh->do("SET $name = $config{$name}"); 5146 5147 $self->glog("Set $name to $config{$name} for database $dbname", LOG_DEBUG); 5148 } 5149 5150 $dbh->do(qq{SET TRANSACTION ISOLATION LEVEL $self->{pg_isolation_level} READ WRITE}); 5151 $self->glog(qq{Set database "$dbname" to $self->{pg_isolation_level} read write}, LOG_DEBUG); 5152 } 5153 5154 if ('mysql' eq $d->{dbtype} or 'mariadb' eq $d->{dbtype}) { 5155 5156 ## ANSI mode: mostly because we want ANSI_QUOTES 5157 $dbh->do(q{SET sql_mode = 'ANSI'}); 5158 ## Use the same time zone everywhere 5159 $dbh->do(q{SET time_zone = '+0:00'}); 5160 5161 $dbh->do('SET TRANSACTION ISOLATION LEVEL SERIALIZABLE'); ## READ WRITE appears in MySQL 5.6.5 5162 $self->glog(qq{Set database "$dbname" to serializable}, LOG_DEBUG); 5163 } 5164 5165 if ('drizzle' eq $d->{dbtype}) { 5166 ## Drizzle does not appear to have anything to control this yet 5167 } 5168 5169 if ('oracle' eq $d->{dbtype}) { 5170 $dbh->do('SET TRANSACTION READ WRITE'); 5171 $dbh->do(q{SET TRANSACTION ISOLATION LEVEL SERIALIZABLE NAME 'bucardo'}); 5172 $self->glog(qq{Set database "$dbname" to serializable and read write}, LOG_DEBUG); 5173 } 5174 5175 if ('sqlite' eq $d->{dbtype}) { 5176 ## Defer all foreign key checking until the very end 5177 $dbh->do('PRAGMA defer_foreign_keys = 1'); 5178 } 5179 5180 if ('redis' eq $d->{dbtype}) { 5181 ## Implement MULTI, when the driver supports it 5182 ##$dbh->multi(); 5183 } 5184 5185 } 5186 5187 return undef; 5188 5189} ## end of start_main_transaction 5190 5191 5192sub lock_all_tables { 5193 5194 ## If requested, lock all the tables used in the sync 5195 ## Arguments: one hashref 5196 ## sync: sync object 5197 ## tables: arrayref of table objects 5198 ## databases: arrayref of database names 5199 ## Returns: undef 5200 5201 my ($self, $info) = @_; 5202 5203 my $sync = $info->{sync} or die qq{Required arg 'sync' missing\n}; 5204 my $tables = $info->{tables} or die qq{Required arg 'tables' missing\n}; 5205 my $databases = $info->{databases} or die qq{Required arg 'databases' missing\n}; 5206 5207 ## The final mode we choose 5208 my $lock_table_mode = ''; 5209 5210 my $syncname = $sync->{name}; 5211 5212 ## Check if the filesystem has a lock file request 5213 my $force_lock_file = File::Spec->catfile( $config{piddir} => "bucardo-force-lock-$syncname" ); 5214 ## Cache that 5215 5216 ## Currently, a file is the only way to trigger this rather severe action 5217 return undef if ! -e $force_lock_file; 5218 5219 $self->{force_lock_file} = $force_lock_file; 5220 5221 ## If the file exists, pull the mode from inside it. Default to EXCLUSIVE mode 5222 $lock_table_mode = 'EXCLUSIVE'; 5223 if (-s _ and (open my $fh, '<', "$force_lock_file")) { 5224 my $newmode = <$fh>; 5225 close $fh or warn qq{Could not close "$force_lock_file": $!\n}; 5226 if (defined $newmode) { 5227 chomp $newmode; 5228 ## Quick sanity check: only set if looks like normal words 5229 $lock_table_mode = $newmode if $newmode =~ /^\s*\w[ \w]+\s*$/o; 5230 } 5231 } 5232 $self->glog(qq{Found lock control file "$force_lock_file". Mode: $lock_table_mode}, LOG_TERSE); 5233 5234 $self->glog("Locking all writeable tables in $lock_table_mode MODE", LOG_TERSE); 5235 for my $dbname (@$databases) { 5236 5237 my $d = $sync->{db}{$dbname}; 5238 5239 for my $g (@$tables) { 5240 5241 next if $g->{reltype} ne 'table'; 5242 5243 ## Figure out which table name to use 5244 my $tname = $g->{newname}{$syncname}{$dbname}; 5245 5246 if ('postgres' eq $d->{dbtype}) { 5247 my $com = "$tname IN $lock_table_mode MODE"; 5248 $self->glog("Database $dbname: Locking table $com", LOG_TERSE); 5249 $d->{dbh}->do("LOCK TABLE $com"); 5250 } 5251 elsif ('mysql' eq $d->{dbtype } or 'drizzle' eq $d->{dbtype} or 'mariadb' eq $d->{dbtype}) { 5252 my $com = "$tname WRITE"; 5253 $self->glog("Database $dbname: Locking table $com", LOG_TERSE); 5254 $d->{dbh}->do("LOCK TABLE $com"); 5255 } 5256 elsif ('oracle' eq $d->{dbtype}) { 5257 my $com = "$tname IN EXCLUSIVE MODE"; 5258 $self->glog("Database $dbname: Locking table $com", LOG_TERSE); 5259 $d->{dbh}->do("LOCK TABLE $com"); 5260 } 5261 elsif ('sqlite' eq $d->{dbtype}) { 5262 $d->{dbh}->do('BEGIN EXCLUSIVE TRANSACTION'); 5263 } 5264 } 5265 } 5266 5267 return undef; 5268 5269} ## end of lock_all_tables 5270 5271 5272sub remove_lock_file { 5273 5274 ## Remove a lock file that was used above in the remove_lock_file sub 5275 ## Arguments: none 5276 ## Returns: undef 5277 5278 my $self = shift; 5279 5280 if (exists $self->{force_lock_file} and -e $self->{force_lock_file}) { 5281 $self->glog("Removing lock control file $self->{force_lock_file}", LOG_VERBOSE); 5282 unlink $self->{force_lock_file} 5283 or $self->glog("Warning! Failed to unlink $self->{force_lock_file}", LOG_WARN); 5284 } 5285 5286 return undef; 5287 5288} ## end of remove_lock_file 5289 5290 5291sub update_mongo_status { 5292 5293 ## Update the Mongo semaphore table 5294 ## Arguments: four 5295 ## 1. Database object 5296 ## 2. Name of the sync 5297 ## 3. Name of the table 5298 ## 3. New status 5299 5300 my ($self, $d, $syncname, $tablename, $status) = @_; 5301 5302 my $collection = $d->{dbh}->get_collection($tablename); 5303 5304 my @args = ( 5305 { sync => $syncname }, 5306 { '$set' => { 5307 sync => $syncname, 5308 status => $status, 5309 endtime => scalar gmtime, 5310 } 5311 }, 5312 { upsert => 1, safe => 1 } 5313 ); 5314 5315 $self->{oldmongo} ? $collection->update(@args) : $collection->update_one(@args); 5316 5317 return; 5318 5319 5320} ## end of update_mongo_status 5321 5322 5323 5324sub disable_triggers { 5325 5326 ## Disable triggers and rules for all tables in a sync, for the given database. 5327 ## This gets all tables at once, so it only needs to be called once for each database. 5328 ## Arguments: two 5329 ## 1. Sync object 5330 ## 2. Database object 5331 ## Returns: undef 5332 5333 my ($self, $sync, $db) = @_; 5334 5335 my $SQL; 5336 5337 ## Are triggers already disabled for this database? Return and do nothing 5338 return undef if ! $db->{triggers_enabled}; 5339 5340 my $dbh = $db->{dbh}; 5341 5342 if ('mysql' eq $db->{dbtype} or 'mariadb' eq $db->{dbtype}) { 5343 ## Do not worry about checking foreign keys 5344 $dbh->do('SET foreign_key_checks = 0'); 5345 ## Do not worry about uniqueness of unique indexes 5346 $dbh->do('SET unique_checks = 0'); 5347 5348 $db->{triggers_enabled} = 0; 5349 return undef; 5350 } 5351 5352 ## From this point on we are doing Postgres 5353 return undef if $db->{dbtype} ne 'postgres'; 5354 5355 ## Can we do this the easy way? Thanks to Jan for srr! 5356 my $dbname = $db->{name}; 5357 if ($dbh->{pg_server_version} >= 80300) { 5358 $self->glog("Setting session_replication_role to replica for database $dbname", LOG_VERBOSE); 5359 $dbh->do(q{SET session_replication_role = 'replica'}); 5360 5361 $db->{triggers_enabled} = 0; 5362 return undef; 5363 } 5364 5365 ## Okay, the old and ugly way: pg_class table manipulation 5366 ## First, create the SQL as needed 5367 if (! $sync->{SQL_disable_trigrules}) { 5368 5369 ## The SQL to disable all triggers and rules for the tables in this sync 5370 $SQL = q{ 5371 UPDATE pg_class 5372 SET reltriggers = 0, relhasrules = false 5373 WHERE ( 5374 }; 5375 $SQL .= join "OR\n" 5376 => map { "(oid = '$_->{safeschema}.$_->{safetable}'::regclass)" } 5377 grep { $_->{reltype} eq 'table' } 5378 @{ $sync->{goatlist} }; 5379 $SQL .= ')'; 5380 5381 $sync->{SQL_disable_trigrules} = $SQL; 5382 } 5383 5384 ## Now run the SQL and mark that we have been here 5385 $self->glog(qq{Disabling triggers and rules on database "$dbname" via pg_class}, LOG_VERBOSE); 5386 $dbh->do($sync->{SQL_disable_trigrules}); 5387 5388 $db->{triggers_enabled} = 0; 5389 5390 return undef; 5391 5392} ## end of disable_triggers 5393 5394 5395sub enable_triggers { 5396 5397 ## Restore any previously disabled triggers and rules for all databases 5398 ## Arguments: one 5399 ## 1. Sync object 5400 ## Returns: undef 5401 5402 my ($self, $sync) = @_; 5403 5404 my $SQL; 5405 5406 ## Walk through each database in this sync and enable triggers as needed 5407 for my $dbname (sort keys %{ $sync->{db} }) { 5408 5409 my $db = $sync->{db}{$dbname}; 5410 5411 ## Do nothing unless triggers are disabled 5412 next if $db->{triggers_enabled}; 5413 5414 my $dbh = $db->{dbh}; 5415 5416 if ('mysql' eq $db->{dbtype} or 'mariadb' eq $db->{dbtype}) { 5417 $dbh->do('SET foreign_key_checks = 1'); 5418 $dbh->do('SET unique_checks = 1'); 5419 $db->{triggers_enabled} = time; 5420 next; 5421 } 5422 5423 ## Past here is Postgres 5424 5425 ## If we are using srr, just flip it back to the default 5426 if ($db->{dbh}{pg_server_version} >= 80300) { 5427 $self->glog("Setting session_replication_role to default for database $dbname", LOG_VERBOSE); 5428 $dbh->do(q{SET session_replication_role = default}); ## Assumes a sane default! 5429 $dbh->commit(); 5430 $db->{triggers_enabled} = time; 5431 next; 5432 } 5433 5434 ## Okay, the old and ugly way: pg_class table manipulation 5435 ## First, create the SQL as needed 5436 if (! $sync->{SQL_enable_trigrules}) { 5437 5438 my $setclause = 5439 ## no critic (RequireInterpolationOfMetachars) 5440 q{reltriggers = } 5441 . q{(SELECT count(*) FROM pg_catalog.pg_trigger WHERE tgrelid = pg_catalog.pg_class.oid),} 5442 . q{relhasrules = } 5443 . q{CASE WHEN (SELECT COUNT(*) FROM pg_catalog.pg_rules WHERE schemaname=SNAME AND tablename=TNAME) > 0 } 5444 . q{THEN true ELSE false END}; 5445 ## use critic 5446 5447 my $tempsql = qq{ 5448 UPDATE pg_class 5449 SET $setclause 5450 WHERE oid = 'SCHEMANAME.TABLENAME'::regclass 5451 }; 5452 $SQL = join ";\n" 5453 => map { 5454 my $sql = $tempsql; 5455 $sql =~ s/SNAME/$_->{safeschemaliteral}/g; 5456 $sql =~ s/TNAME/$_->{safetableliteral}/g; 5457 $sql =~ s/SCHEMANAME/$_->{safeschema}/g; 5458 $sql =~ s/TABLENAME/$_->{safetable}/g; 5459 $sql; 5460 } 5461 grep { $_->{reltype} eq 'table' } 5462 @{ $sync->{goatlist} }; 5463 5464 $sync->{SQL_enable_trigrules} = $SQL; 5465 } 5466 5467 ## Now run the SQL and mark that we have been here 5468 $self->glog(qq{Enabling triggers and rules on database "$dbname" via pg_class}, LOG_VERBOSE); 5469 $db->{dbh}->do($sync->{SQL_enable_trigrules}); 5470 5471 $db->{triggers_enabled} = time; 5472 5473 } 5474 5475 return undef; 5476 5477} ## end of enable_triggers 5478 5479 5480sub disable_indexes { 5481 5482 ## Disable indexes on a specific table in a specific database for faster copying 5483 ## Obviously, the index will get enabled and rebuilt later on 5484 ## If you want finer tuning, such as only disabling the same table for some databases, 5485 ## then it is up to the caller to tweak {rebuild_index} before calling. 5486 ## Arguments: three 5487 ## 1. Sync object 5488 ## 2. Database object 5489 ## 3. Table object 5490 ## Returns: undef 5491 5492 my ($self, $sync, $db, $table) = @_; 5493 5494 my $SQL; 5495 5496 ## Do nothing unless rebuild_index has been set for this table 5497 return undef if ! $table->{rebuild_index}; 5498 5499 ## The only system we do this with is Postgres 5500 return undef if $db->{dbtype} ne 'postgres'; 5501 5502 ## Grab the actual target table name 5503 my $tablename = $table->{newname}{$sync->{name}}{$db->{name}}; 5504 5505 ## Have we already disabled triggers on this table? Return but make a note 5506 my $dbname = $db->{name}; 5507 if ($table->{"db:$dbname"}{indexes_disabled}) { 5508 $self->glog("Warning: tried to disable indexes twice for $db->{name}.$tablename", LOG_WARN); 5509 return undef; 5510 } 5511 5512 ## We need to know if this table has indexes or not 5513 if (! exists $table->{"db:$dbname"}{has_indexes}) { 5514 $SQL = qq{SELECT relhasindex FROM pg_class WHERE oid = '$tablename'::regclass}; 5515 ## relhasindex is a boolean 't' or 'f', but DBD::Pg will return it as 1 or 0 5516 $table->{"db:$dbname"}{has_indexes} = $db->{dbh}->selectall_arrayref($SQL)->[0][0]; 5517 } 5518 5519 ## If the table has no indexes, then we don't need to worry about disabling them 5520 return undef if ! $table->{"db:$dbname"}{has_indexes}; 5521 5522 ## Now we can proceed with the disabling, by monkeying with the system catalog 5523 $self->glog("Disabling indexes for $dbname.$tablename", LOG_NORMAL); 5524 $SQL = qq{UPDATE pg_class SET relhasindex = 'f' WHERE oid = '$tablename'::regclass}; 5525 $count = $db->{dbh}->do($SQL); 5526 ## Safety check: 5527 if ($count < 1) { 5528 $self->glog("Warning: disable index failed for $dbname.$tablename", LOG_WARN); 5529 } 5530 5531 ## This is mostly here to tell enable_indexes to proceed 5532 $table->{"db:$dbname"}{indexes_disabled} = 1; 5533 5534 return undef; 5535 5536} ## end of disable_indexes 5537 5538 5539sub enable_indexes { 5540 5541 ## Make indexes live again, and rebuild if needed 5542 ## Walks through all the databases itself 5543 ## Arguments: two 5544 ## 1. Sync object 5545 ## 2. Table object 5546 ## Returns: undef 5547 5548 my ($self, $sync, $table) = @_; 5549 5550 my $SQL; 5551 5552 ## Walk through each database in this sync and reapply indexes as needed 5553 for my $dbname (sort keys %{ $sync->{db} }) { 5554 5555 my $db = $sync->{db}{$dbname}; 5556 5557 ## Do nothing unless we are sure indexes have been disabled 5558 next if ! $table->{"db:$dbname"}{indexes_disabled}; 5559 5560 ## This all assumes the database is Postgres 5561 5562 ## Grab the actual target table name 5563 my $tablename = $table->{newname}{$sync->{name}}{$db->{name}}; 5564 5565 ## Turn the indexes back on 5566 $self->glog("Enabling indexes for $dbname.$tablename", LOG_NORMAL); 5567 ## We set this to 'f' earlier, so flip it back now 5568 $SQL = qq{UPDATE pg_class SET relhasindex = 't' WHERE oid = '$tablename'::regclass}; 5569 $count = $db->{dbh}->do($SQL); 5570 ## Safety check: 5571 if ($count < 1) { 5572 $self->glog("Warning: enable index failed for $dbname.$tablename", LOG_WARN); 5573 } 5574 $table->{"db:$dbname"}{indexes_disabled} = 0; 5575 5576 ## Rebuild all the indexes on this table 5577 $self->glog("Reindexing table $dbname.$tablename", LOG_NORMAL); 5578 ## We do this asynchronously so we don't wait on each db 5579 $db->{async_active} = time; 5580 $db->{dbh}->do( "REINDEX TABLE $tablename", {pg_async => PG_ASYNC} ); 5581 5582 ## Very short-lived variable to help the loop below 5583 $db->{rebuild_index_active} = 1; 5584 } 5585 5586 ## Now walk through and let each one finish 5587 for my $dbname (sort keys %{ $sync->{db} }) { 5588 5589 my $db = $sync->{db}{$dbname}; 5590 5591 if ($db->{rebuild_index_active}) { 5592 ## Waits for the REINDEX to finish: 5593 $db->{dbh}->pg_result(); 5594 $db->{async_active} = 0; 5595 } 5596 delete $db->{rebuild_index_active}; 5597 5598 } 5599 5600 return undef; 5601 5602} ## end of enable_indexes 5603 5604 5605sub pause_and_exit { 5606 5607 ## Usually called by a kid, dies and pauses the sync before it leaves 5608 ## This prevents infinite loops because something went wrong with the kid 5609 ## Arguments: one 5610 ## 1. Message to give (LOG_WARN) 5611 ## Returns: never, dies. 5612 5613 my ($self, $message) = @_; 5614 5615 $self->glog($message, LOG_WARN); 5616 5617 my $syncname = $self->{sync}{name}; 5618 $self->glog("Pausing sync $syncname", LOG_TERSE); 5619 5620 $self->db_notify($self->{masterdbh}, "pause_sync_$syncname", 1); 5621 5622 die $message; 5623 5624} ## end of pause_and_exit 5625 5626 5627sub connect_database { 5628 5629 ## Connect to the given database 5630 ## Arguments: one 5631 ## 1. The id of the database 5632 ## If the database id is blank or zero, we return the main database 5633 ## Returns: 5634 ## - the database handle and the backend PID 5635 ## OR 5636 ## - the string 'inactive' if set as such in the db table 5637 ## OR 5638 ## - the string 'flat' if this is a flatfile 'database' 5639 5640 my $self = shift; 5641 5642 my $id = shift || 0; 5643 5644 my ($dsn,$dbh,$user,$pass,$ssp,$dbname,$SQL); 5645 5646 my $dbtype = 'postgres'; 5647 5648 ## If id is 0, connect to the main database 5649 if (!$id) { 5650 $dsn = "dbi:Pg:dbname=$self->{dbname}"; 5651 defined $self->{dbport} and length $self->{dbport} and $dsn .= ";port=$self->{dbport}"; 5652 defined $self->{dbhost} and length $self->{dbhost} and $dsn .= ";host=$self->{dbhost}"; 5653 defined $self->{dbconn} and length $self->{dbconn} and $dsn .= ";$self->{dbconn}"; 5654 $user = $self->{dbuser}; 5655 $pass = $self->{dbpass}; 5656 $ssp = 1; 5657 } 5658 else { 5659 5660 my $db = $self->get_dbs; 5661 exists $db->{$id} or die qq{Invalid database id!: $id\n}; 5662 5663 my $d = $db->{$id}; 5664 $dbtype = $d->{dbtype}; 5665 $dbname = $d->{dbname}; 5666 if ($d->{status} eq 'inactive') { 5667 return 0, 'inactive'; 5668 } 5669 5670 ## Flat files do not actually get connected to, of course 5671 if ($dbtype =~ /flat/o) { 5672 return 0, 'flat'; 5673 } 5674 5675 if ('postgres' eq $dbtype) { 5676 $dsn = 'dbi:Pg:'; 5677 $dsn .= join ';', map { 5678 ($_ eq 'dbservice' ? 'service' : $_ ) . "=$d->{$_}"; 5679 } grep { defined $d->{$_} and length $d->{$_} } qw/dbname dbservice/; 5680 } 5681 elsif ('drizzle' eq $dbtype) { 5682 $dsn = "dbi:drizzle:database=$dbname"; 5683 } 5684 elsif ('mongo' eq $dbtype) { 5685 5686 ## For now, we simply require it 5687 require MongoDB; 5688 5689 ## We also need some specific Perl modules we do not want all of Bucardo to require 5690 ## In this case, we want to generate our own error message: 5691 my $module_loaded_ok = 0; 5692 eval { require boolean; $module_loaded_ok = 1; }; 5693 $module_loaded_ok or die qq{Unable to load the Perl 'boolean' module: needed for MongoDB support\n}; 5694 5695 $module_loaded_ok = 0; 5696 eval { require Date::Parse; $module_loaded_ok = 1; }; 5697 $module_loaded_ok or die qq{Unable to load the Perl 'Date::Parse' module: needed for MongoDB support\n}; 5698 5699 $module_loaded_ok = 0; 5700 eval { require DateTime; $module_loaded_ok = 1; }; 5701 $module_loaded_ok or die qq{Unable to load the Perl 'DateTime' module: needed for MongoDB support\n}; 5702 5703 ## Are we using the old "point-zero" version? 5704 my $mongoversion = $MongoDB::VERSION; 5705 $self->{oldmongo} = $mongoversion =~ /^0\./ ? 1 : 0; 5706 5707 my $mongoURI = 'mongodb://'; 5708 my $dbdsn = $d->{dbdsn} || ''; 5709 5710 if (length $dbdsn) { 5711 $dbdsn =~ s/^DSN://; 5712 if ($dbdsn !~ /^mongodb:/) { 5713 $mongoURI .= $dbdsn; 5714 } 5715 else { 5716 $mongoURI = $dbdsn; 5717 } 5718 } 5719 else { 5720 my $mongodsn = {}; 5721 for my $name (qw/ dbhost dbport dbuser dbpass /) { 5722 defined $d->{$name} and length $d->{$name} and $mongodsn->{$name} = $d->{$name}; 5723 } 5724 if (exists $mongodsn->{dbuser}) { 5725 my $pass = $mongodsn->{dbpass} || ''; 5726 $mongoURI .= "$mongodsn->{dbuser}:$pass\@"; 5727 } 5728 $mongoURI .= $mongodsn->{dbhost} || 'localhost'; 5729 $mongoURI .= ":$mongodsn->{dbport}" if exists $mongodsn->{dbport}; 5730 } 5731 5732 $self->glog("MongoDB connection URI to database $dbname: $mongoURI", LOG_DEBUG); 5733 my $conn = $self->{oldmongo} ? MongoDB::MongoClient->new(host => $mongoURI) 5734 : MongoDB->connect($mongoURI); ## no critic 5735 5736 $dbh = $conn->get_database($dbname); 5737 my $backend = 0; 5738 if (! $self->{show_mongodb_version}++) { 5739 $self->glog("Perl module MongoDB loaded. Version $MongoDB::VERSION", LOG_NORMAL); 5740 } 5741 5742 return $backend, $dbh; 5743 } 5744 elsif ('firebird' eq $dbtype) { 5745 $dsn = "dbi:Firebird:db=$dbname"; 5746 } 5747 elsif ('mysql' eq $dbtype or 'mariadb' eq $dbtype) { 5748 $dsn = "dbi:mysql:database=$dbname"; 5749 } 5750 elsif ('oracle' eq $dbtype) { 5751 $dsn = "dbi:Oracle:dbname=$dbname"; 5752 } 5753 elsif ('redis' eq $dbtype) { 5754 my @dsn; 5755 my $server = ''; 5756 if (defined $d->{dbhost} and length $d->{dbhost}) { 5757 $server = $d->{dbhost}; 5758 } 5759 if (defined $d->{dbport} and length $d->{dbport}) { 5760 $server = ":$d->{dbport}"; 5761 } 5762 if ($server) { 5763 push @dsn => 'server', $server; 5764 } 5765 5766 my ($pass, $index); 5767 if (defined $d->{dbpass} and length $d->{dbpass}) { 5768 $pass = $d->{dbpass}; 5769 } 5770 if (defined $d->{dbname} and length $d->{dbname} and $d->{dbname} !~ /\D/) { 5771 $index = $d->{dbname}; 5772 } 5773 5774 push @dsn => 'on_connect', sub { 5775 $_[0]->client_setname('bucardo'); 5776 $_[0]->auth($pass) if $pass; 5777 $_[0]->select($index) if $index; 5778 }; 5779 5780 ## For now, we simply require it 5781 require Redis; 5782 $dbh = Redis->new(@dsn); 5783 if (! $self->{show_redis_version}++) { 5784 $self->glog("Perl module Redis loaded. Version $Redis::VERSION", LOG_NORMAL); 5785 } 5786 5787 return 0, $dbh; 5788 } 5789 elsif ('sqlite' eq $dbtype) { 5790 $dsn = "dbi:SQLite:dbname=$dbname"; 5791 } 5792 else { 5793 die qq{Cannot handle databases of type "$dbtype"\n}; 5794 } 5795 5796 if (defined $d->{dbdsn} and length $d->{dbdsn}) { 5797 $dsn = "TEST$d->{dbdsn}"; 5798 } 5799 else { 5800 defined $d->{dbport} and length $d->{dbport} and $dsn .= ";port=$d->{dbport}"; 5801 defined $d->{dbhost} and length $d->{dbhost} and $dsn .= ";host=$d->{dbhost}"; 5802 length $d->{dbconn} and $dsn .= ";$d->{dbconn}"; 5803 } 5804 $user = $d->{dbuser}; 5805 $pass = $d->{dbpass} || ''; 5806 $ssp = $d->{server_side_prepares}; 5807 } 5808 5809 $self->glog("DSN: $dsn", LOG_VERBOSE) if exists $config{log_level}; 5810 5811 $dbh = DBI->connect 5812 ( 5813 $dsn, 5814 $user, 5815 $pass, 5816 {AutoCommit=>0, RaiseError=>1, PrintError=>0} 5817 ); 5818 5819 ## Register this database in our global list 5820 ## Note that we only worry about DBI-backed databases here, 5821 ## as there is no particular cleanup needed (e.g. InactiveDestroy) 5822 ## for other types. 5823 $self->{dbhlist}{$dbh} = $dbh; 5824 5825 ## From here on out we are setting Postgres-specific items, so everyone else is done 5826 if ($dbtype ne 'postgres') { 5827 my $modname = "DBD::" . $dbh->{Driver}->{Name}; 5828 if (! $self->{"show_${modname}_version"}++) { 5829 my $modver = $modname->VERSION; 5830 $self->glog("Perl module $modname loaded. Version $modver", LOG_NORMAL); 5831 } 5832 return 0, $dbh; 5833 } 5834 5835 ## Set the application name if we can 5836 if ($dbh->{pg_server_version} >= 90000) { 5837 my $role = $self->{logprefix} || '???'; 5838 $dbh->do("SET application_name='bucardo $role (PID $$)'"); 5839 $dbh->commit(); 5840 } 5841 5842 ## If we are using something like pgbouncer, we need to tell Bucardo not to 5843 ## use server-side prepared statements, as they will not span commits/rollbacks. 5844 if (! $ssp) { 5845 $self->glog('Turning off server-side prepares for this database connection', LOG_TERSE); 5846 $dbh->{pg_server_prepare} = 0; 5847 } 5848 5849 ## Grab the backend PID for this Postgres process 5850 ## Also a nice check that everything is working properly 5851 $SQL = 'SELECT pg_backend_pid()'; 5852 5853 my $backend = $dbh->selectall_arrayref($SQL)->[0][0]; 5854 $dbh->rollback(); 5855 5856 ## If the main database, prepend 'bucardo' to the search path 5857 if (!$id) { 5858 $dbh->do(q{SELECT pg_catalog.set_config('search_path', 'bucardo,' || current_setting('search_path'), false)}); 5859 $dbh->commit(); 5860 } 5861 5862 ## If this is not the main database, listen for a dead db hint 5863 if ($id and $self->{logprefix} eq 'MCP') { 5864 $self->db_listen($self->{masterdbh}, "dead_db_$id"); 5865 $self->glog("Listening for dead_db_$id", LOG_DEBUG); 5866 $dbh->commit(); 5867 } 5868 5869 ## If this is a vacuum process, make sure it can write to the database! 5870 if ('VAC' eq $self->{logprefix}) { 5871 $dbh->do(qq{SET default_transaction_read_only = off}); 5872 $dbh->commit(); 5873 } 5874 5875 return $backend, $dbh; 5876 5877} ## end of connect_database 5878 5879 5880sub reload_config_database { 5881 5882 ## Reload the %config and %config_about hashes from the bucardo_config table 5883 ## Calls commit on the masterdbh 5884 ## Arguments: none 5885 ## Returns: undef 5886 5887 my $self = shift; 5888 5889 my $SQL; 5890 5891 undef %config; 5892 undef %config_about; 5893 5894 my %log_level_number = ( 5895 WARN => 1, ## Yes, this is correct. Should not be able to set lower than 1 5896 TERSE => 1, 5897 NORMAL => 2, 5898 VERBOSE => 3, 5899 DEBUG => 4, 5900 ); 5901 5902 $SQL = 'SELECT name,setting,about,type,name FROM bucardo_config'; 5903 $sth = $self->{masterdbh}->prepare($SQL); 5904 $sth->execute(); 5905 for my $row (@{$sth->fetchall_arrayref({})}) { 5906 ## Things from an rc file can override the value in the db 5907 my $setting = exists $self->{$row->{name}} ? $self->{$row->{name}} : $row->{setting}; 5908 if ($row->{name} eq 'log_level') { 5909 my $newvalue = $log_level_number{uc $setting}; 5910 if (! defined $newvalue) { 5911 die "Invalid log_level! ($setting)\n"; 5912 } 5913 $config{log_level_number} = $newvalue; 5914 } 5915 if (defined $row->{type}) { 5916 $config{$row->{type}}{$row->{name}}{$row->{setting}} = $setting; 5917 $config_about{$row->{type}}{$row->{name}}{$row->{setting}} = $row->{about}; 5918 } 5919 else { 5920 $config{$row->{name}} = $setting; 5921 $config_about{$row->{name}} = $row->{about}; 5922 } 5923 } 5924 $self->{masterdbh}->commit(); 5925 5926 ## Allow certain command-line overrides 5927 my $loglevel = delete $self->{loglevel} || ''; 5928 if (length $loglevel) { 5929 $config{log_level} = $loglevel; 5930 $config{log_level_number} = $log_level_number{uc $loglevel}; 5931 } 5932 my $logshowline = delete $self->{logshowline} || ''; 5933 if (length $logshowline) { 5934 $config{log_showline} = 1; 5935 } 5936 5937 return; 5938 5939} ## end of reload_config_database 5940 5941 5942sub log_config { 5943 5944 ## Write the current contents of the config hash to the log 5945 ## Arguments: none 5946 ## Returns: undef 5947 5948 my $self = shift; 5949 5950 my $msg = "Bucardo config:\n"; 5951 5952 ## Figure out the longest key name for pretty formatting 5953 my $maxlen = 5; 5954 for (keys %config) { 5955 $maxlen = length($_) if length($_) > $maxlen; 5956 } 5957 5958 ## Print each config name and setting in alphabetic order 5959 for (sort keys %config) { 5960 $msg .= sprintf " %-*s => %s\n", $maxlen, $_, (defined $config{$_}) ? qq{'$config{$_}'} : 'undef'; 5961 } 5962 $self->glog($msg, LOG_WARN); 5963 5964 return; 5965 5966} ## end of log_config 5967 5968 5969sub _logto { 5970 5971 my $self = shift; 5972 5973 if ($self->{logpid} && $self->{logpid} != $$) { 5974 # We've forked! Get rid of any existing handles. 5975 delete $self->{logcodes}; 5976 } 5977 5978 return $self->{logcodes} if $self->{logcodes}; 5979 5980 # Do no logging if any destination is "none". 5981 if (grep { $_ eq 'none' } @{ $self->{logdest} }) { 5982 $self->{logcodes} = {}; 5983 return $self->{logcodes}; 5984 } 5985 5986 $self->{logpid} = $$; 5987 my %logger; 5988 for my $dest (@{ $self->{logdest}} ) { 5989 5990 next if exists $logger{$dest}; 5991 5992 if ($dest eq 'syslog') { 5993 ## Use Sys::Syslog to open a new syslog connection 5994 openlog 'Bucardo', 'pid nowait', $config{syslog_facility}; 5995 ## Ignore the header argument for syslog output. 5996 $logger{syslog} = { type => 'syslog', code => sub { shift; syslog 'info', @_ } }; 5997 } 5998 elsif ($dest eq 'stderr') { 5999 $logger{stderr} = { type => 'stderr', code => sub { print STDERR @_, $/ } }; 6000 } 6001 elsif ($dest eq 'stdout') { 6002 $logger{stdout} = { type => 'stdout', code => sub { print STDOUT @_, $/ } }; 6003 } 6004 else { 6005 ## Just a plain text file 6006 my $fn = File::Spec->catfile($dest, 'log.bucardo'); 6007 $fn .= ".$self->{logextension}" if length $self->{logextension}; 6008 6009 ## If we are writing each process to a separate file, 6010 ## append the prefix (first three letters) and the PID to the file name 6011 my $tla = substr($self->{logprefix},0,3); 6012 $fn .= "$tla.$$" if $self->{logseparate}; 6013 6014 open my $fh, '>>', $fn or die qq{Could not append to "$fn": $!\n}; 6015 ## Turn off buffering on this handle 6016 $fh->autoflush(1); 6017 6018 $logger{$dest} = { 6019 type => 'textfile', 6020 code => sub { print {$fh} @_, $/ }, 6021 filename => $fn, 6022 filehandle => $fh, 6023 }; 6024 6025 } 6026 } 6027 6028 ## Store this away so the reopening via USR2 works 6029 $self->{logcodes} = \%logger; 6030 6031 return \%logger; 6032} 6033 6034sub glog { ## no critic (RequireArgUnpacking) 6035 6036 ## Reformat and log internal messages to the correct place 6037 ## Arguments: two 6038 ## 1. the log message 6039 ## 2. the log level (defaults to 0) 6040 ## Returns: undef 6041 6042 ## Quick shortcut if verbose is 'off' (which is not recommended!) 6043 return if ! $_[0]->{verbose}; 6044 6045 my $self = shift; 6046 my $msg = shift; 6047 6048 ## Grab the log level: defaults to 0 (LOG_WARN) 6049 my $loglevel = shift || 0; 6050 6051 ## Return and do nothing, if we have not met the minimum log level 6052 return if $loglevel > $config{log_level_number}; 6053 6054 ## Just return if there is no place to log to. 6055 my $logs = $self->_logto; 6056 return unless keys %$logs || ($loglevel == LOG_WARN && $self->{warning_file}); 6057 6058 ## Remove newline from the end of the message, in case it has one 6059 chomp $msg; 6060 6061 ## We should always have a prefix, either BC!, MCP, CTL, KID, or VAC 6062 ## Prepend it to our message 6063 my $prefix = $self->{logprefix} || '???'; 6064 $msg = "$prefix $msg"; 6065 6066 ## We may also show other optional things: log level, PID, timestamp, line we came from 6067 6068 ## Optionally show the current time in some form 6069 my $showtime = ''; 6070 if ($config{log_showtime}) { 6071 my ($sec,$msec) = gettimeofday; 6072 $showtime = 6073 1 == $config{log_showtime} ? $sec 6074 : 2 == $config{log_showtime} ? ($config{log_timer_format} ? 6075 strftime($config{log_timer_format}, gmtime($sec)) 6076 : scalar gmtime($sec)) 6077 : 3 == $config{log_showtime} ? ($config{log_timer_format} ? 6078 strftime($config{log_timer_format}, localtime($sec)) 6079 : scalar localtime($sec)) 6080 : ''; 6081 if ($config{log_microsecond}) { 6082 $showtime =~ s/(:\d\d) /"$1." . substr($msec,0,3) . ' '/oe; 6083 $showtime =~ s/(:\d\d\.\d\d) /${1}0 /; 6084 } 6085 } 6086 6087 ## Optionally show the PID (and set the time from above) 6088 ## Show which line we came from as well 6089 my $header = sprintf '%s%s%s', 6090 ($config{log_showpid} ? "($$) " : ''), 6091 ($showtime ? "[$showtime] " : ''), 6092 $config{log_showline} ? (sprintf '#%04d ', (caller)[2]) : ''; 6093 6094 ## Prepend the loglevel to the message 6095 if ($config{log_showlevel}) { 6096 $header = sprintf "%s $header", qw(WARN TERSE NORMAL VERBOSE DEBUG)[$loglevel]; 6097 } 6098 6099 ## Warning messages may also get written to a separate file 6100 ## Note that a 'warning message' is simply anything starting with "Warning" 6101 if ($self->{warning_file} and $loglevel == LOG_WARN) { 6102 my $file = $self->{warning_file}; 6103 open my $fh, , '>>', $file or die qq{Could not append to "$file": $!\n}; 6104 print {$fh} "$header$msg\n"; 6105 close $fh or warn qq{Could not close "$file": $!\n}; 6106 } 6107 6108 # Send it to all logs. 6109 for my $log (sort keys %$logs) { 6110 next if ! exists $logs->{$log}{code}; 6111 $logs->{$log}{code}->($header, $msg); 6112 } 6113 return; 6114 6115} ## end of glog 6116 6117 6118sub conflict_log { 6119 6120 ## Log a message to the conflict log file at config{log_conflict_file} 6121 ## Arguments: one 6122 ## 1. the log message 6123 ## Returns: undef 6124 6125 my $self = shift; 6126 my $msg = shift; 6127 chomp $msg; 6128 6129 my $cfile = $config{log_conflict_file}; 6130 my $clog; 6131 if (! open $clog, '>>', $cfile) { 6132 warn qq{Could not append to file "$cfile": $!}; 6133 return; 6134 } 6135 6136 print {$clog} "$msg\n"; 6137 close $clog or warn qq{Could not close "$cfile": $!\n}; 6138 6139 return; 6140 6141} ## end of conflict_log 6142 6143 6144sub show_db_version_and_time { 6145 6146 ## Output the time, timezone, and version information to the log 6147 ## Arguments: three 6148 ## 1. Database handle 6149 ## 2. Backend PID 6150 ## 3. A string indicating which database this is 6151 ## Returns: undef 6152 6153 my ($self,$ldbh,$backend,$prefix) = @_; 6154 6155 my $SQL; 6156 6157 return if ! defined $ldbh; 6158 6159 return if ref $ldbh ne 'DBI::db'; 6160 6161 return if $ldbh->{Driver}{Name} ne 'Pg'; 6162 6163 $self->glog(qq{${prefix}backend PID: $backend}, LOG_VERBOSE); 6164 6165 ## Get the databases epoch, timestamp, and timezone 6166 $SQL = q{SELECT extract(epoch FROM now()), now(), current_setting('timezone')}; 6167 my $sth = $ldbh->prepare($SQL); 6168 6169 ## Get the system's time 6170 my $systemtime = Time::HiRes::time(); 6171 6172 ## Do the actual database call as close as possible to the system one 6173 $sth->execute(); 6174 my $dbtime = $sth->fetchall_arrayref()->[0]; 6175 6176 $self->glog("${prefix}Local epoch: $systemtime DB epoch: $dbtime->[0]", LOG_WARN); 6177 $systemtime = scalar localtime ($systemtime); 6178 $self->glog("${prefix}Local time: $systemtime DB time: $dbtime->[1]", LOG_WARN); 6179 $systemtime = strftime('%Z (%z)', localtime()); 6180 $self->glog("${prefix}Local timezone: $systemtime DB timezone: $dbtime->[2]", LOG_WARN); 6181 $self->glog("${prefix}Postgres version: " . $ldbh->{pg_server_version}, LOG_WARN); 6182 $self->glog("${prefix}Database port: " . $ldbh->{pg_port}, LOG_WARN); 6183 $ldbh->{pg_host} and $self->glog("${prefix}Database host: " . $ldbh->{pg_host}, LOG_WARN); 6184 6185 return; 6186 6187} ## end of show_db_version_and_time 6188 6189sub get_dbs { 6190 6191 ## Fetch a hashref of everything in the db table 6192 ## Used by connect_database() 6193 ## Calls commit on the masterdbh 6194 ## Arguments: none 6195 ## Returns: hashref 6196 6197 my $self = shift; 6198 6199 my $SQL = 'SELECT * FROM bucardo.db'; 6200 $sth = $self->{masterdbh}->prepare($SQL); 6201 $sth->execute(); 6202 my $info = $sth->fetchall_hashref('name'); 6203 $self->{masterdbh}->commit(); 6204 6205 return $info; 6206 6207} ## end of get_dbs 6208 6209 6210sub get_goats { 6211 6212 ## Fetch a hashref of everything in the goat table 6213 ## Used by find_goats() 6214 ## Calls commit on the masterdbh 6215 ## Arguments: none 6216 ## Returns: hashref 6217 6218 my $self = shift; 6219 6220 my $SQL = 'SELECT * FROM bucardo.goat'; 6221 $sth = $self->{masterdbh}->prepare($SQL); 6222 $sth->execute(); 6223 my $info = $sth->fetchall_hashref('id'); 6224 $self->{masterdbh}->commit(); 6225 6226 return $info; 6227 6228} ## end of get_goats 6229 6230 6231sub find_goats { 6232 6233 ## Given a herd, return an arrayref of goats 6234 ## Used by validate_sync() 6235 ## Calls commit on the masterdbh 6236 ## Arguments: none 6237 ## Returns: hashref 6238 6239 my ($self,$herd) = @_; 6240 6241 my $goats = $self->get_goats(); 6242 my $SQL = q{ 6243 SELECT goat 6244 FROM bucardo.herdmap 6245 WHERE herd = ? 6246 ORDER BY priority DESC, goat ASC 6247 }; 6248 $sth = $self->{masterdbh}->prepare($SQL); 6249 $sth->execute($herd); 6250 my $newgoats = []; 6251 for (@{$sth->fetchall_arrayref()}) { 6252 push @$newgoats, $goats->{$_->[0]}; 6253 } 6254 $self->{masterdbh}->commit(); 6255 6256 return $newgoats; 6257 6258} ## end of find_goats 6259 6260 6261sub get_syncs { 6262 6263 ## Fetch a hashref of everything in the sync table 6264 ## Used by reload_mcp() 6265 ## Calls commit on the masterdbh 6266 ## Arguments: none 6267 ## Returns: hashref 6268 6269 my $self = shift; 6270 6271 ## Grab all fields plus some computed ones from the sync table 6272 my $SQL = q{ 6273 SELECT *, 6274 COALESCE(EXTRACT(epoch FROM checktime),0) AS checksecs, 6275 COALESCE(EXTRACT(epoch FROM lifetime),0) AS lifetimesecs 6276 FROM bucardo.sync 6277 }; 6278 $sth = $self->{masterdbh}->prepare($SQL); 6279 $sth->execute(); 6280 6281 ## Turn it into a hash based on the sync name, then return the ref 6282 my $info = $sth->fetchall_hashref('name'); 6283 $self->{masterdbh}->commit(); 6284 6285 return $info; 6286 6287} ## end of get_syncs 6288 6289 6290sub get_reason { 6291 6292 ## Returns the current string (if any) in the reason file 6293 ## Arguments: one 6294 ## 1. Optional boolean: if true, the reason file is removed 6295 ## Returns: string 6296 6297 my $delete = shift || 0; 6298 6299 ## String to return 6300 my $reason = ''; 6301 6302 ## If we can't open the file, we simply return an empty string 6303 if (open my $fh, '<', $config{reason_file}) { 6304 ## Everything after the pipe is the reason. If no match, return empty string 6305 if (<$fh> =~ /\|\s*(.+)/o) { 6306 $reason = $1; 6307 } 6308 close $fh or warn qq{Could not close "$config{reason_file}": $!\n}; 6309 6310 ## Optionally delete the file after we've opened and closed it 6311 $delete and unlink $config{reason_file}; 6312 } 6313 6314 return $reason; 6315 6316} ## end of get_reason 6317 6318 6319sub db_listen { 6320 6321 ## Listen for specific messages. Does not commit. 6322 ## Arguments: two, three, or four 6323 ## 1. Database handle 6324 ## 2. String to listen for 6325 ## 3. Short name of the database (optional, for debug output, default to 'bucardo') 6326 ## 4. Whether to skip payloads. Optional boolean, defaults to false 6327 6328 ## Returns: undef 6329 6330 my $self = shift; 6331 my $ldbh = shift; 6332 my $string = shift; 6333 my $name = shift || 'bucardo'; 6334 my $skip_payload = shift || 0; 6335 6336 if (! ref $ldbh) { 6337 my $line = (caller)[2]; 6338 $self->glog("Call to db_listen from an invalid database handle for $name, line $line", LOG_WARN); 6339 return; 6340 } 6341 6342 ## If using payloads, we only need to listen for one thing 6343 if ($ldbh->{pg_server_version} >= 90000 and ! $skip_payload) { 6344 6345 ## Do nothing if we are already listening 6346 return if $self->{listen_payload}{$ldbh}; 6347 6348 ## Mark this process as listening to this database. 6349 ## Get implicitly reset post-fork as new database handles are created 6350 $self->{listen_payload}{$ldbh} = 1; 6351 6352 ## We use 'bucardo', 'bucardo_ctl', or 'bucardo_kid' 6353 my $suffix = $self->{logprefix} =~ /(KID|CTL)/ ? ('_' . lc $1) : ''; 6354 $string = "bucardo$suffix"; 6355 } 6356 elsif (exists $self->{listening}{$ldbh}{$string}) { 6357 ## Using old-style direct names and already listening? Just return 6358 return; 6359 } 6360 else { 6361 ## Mark it as already done 6362 $self->{listening}{$ldbh}{$string} = 1; 6363 } 6364 6365 $string = "bucardo_$string" if index($string, 'bucardo'); 6366 6367 ## If log level low enough, show which line this call came from 6368 if ($config{log_level_number} <= LOG_DEBUG) { 6369 my $line = (caller)[2]; 6370 $self->glog(qq{LISTEN for "$string" on "$name" (line $line)}, LOG_DEBUG); 6371 } 6372 6373 $ldbh->do(qq{LISTEN "$string"}) 6374 or die qq{LISTEN "$string" failed!\n}; 6375 6376 return; 6377 6378} ## end of db_listen 6379 6380 6381sub db_unlisten { 6382 6383 ## Stop listening for specific messages 6384 ## Arguments: four 6385 ## 1. Database handle 6386 ## 2. String to stop listening to 6387 ## 3. Short name of the database (for debug output) 6388 ## 4. Whether to skip payloads. Optional boolean, defaults to false 6389 ## Returns: undef 6390 6391 my $self = shift; 6392 my $ldbh = shift; 6393 my $string = shift; 6394 my $name = shift || 'bucardo'; 6395 my $skip_payload = shift || 0; 6396 6397 ## If we are 9.0 or greater, we never stop listening 6398 if ($ldbh->{pg_server_version} >= 90000 and ! $skip_payload) { 6399 return; 6400 } 6401 6402 my $original_string = $string; 6403 6404 $string = "bucardo_$string"; 6405 6406 ## If log level low enough, show which line this call came from 6407 if ($config{log_level_number} <= LOG_DEBUG) { 6408 my $line = (caller)[2]; 6409 $self->glog(qq{UNLISTEN for "$string" on "$name" (line $line)}, LOG_DEBUG); 6410 } 6411 6412 ## We'll unlisten even if the hash indicates we are not 6413 $ldbh->do(qq{UNLISTEN "$string"}); 6414 6415 delete $self->{listening}{$ldbh}{$original_string}; 6416 6417 return; 6418 6419} ## end of db_unlisten 6420 6421 6422sub db_unlisten_all { 6423 6424 ## Stop listening to everything important 6425 ## Arguments: one 6426 ## 1. Database handle 6427 ## Returns: undef 6428 6429 my $self = shift; 6430 my $ldbh = shift; 6431 6432 ## If the log level is low enough, show the line that called this 6433 if ($config{log_level_number} <= LOG_DEBUG) { 6434 my $line = (caller)[2]; 6435 $self->glog(qq{UNLISTEN * (line $line)}, LOG_DEBUG); 6436 } 6437 6438 ## Do the deed 6439 $ldbh->do('UNLISTEN *'); 6440 6441 delete $self->{listening}{$ldbh}; 6442 delete $self->{listen_payload}{$ldbh}; 6443 6444 return; 6445 6446} ## end of db_unlisten_all 6447 6448 6449sub db_notify { 6450 6451 ## Send an asynchronous notification into the DB aether, then commit 6452 ## Arguments: five 6453 ## 1. Database handle 6454 ## 2. The string to send 6455 ## 3. Whether to skip payloads. Optional boolean, defaults to false 6456 ## 4. Name of the database (as defined in bucardo.db). Optional 6457 ## 5. Whether we should skip the final commit or not. Defaults to false. Optional. 6458 ## Returns: undef 6459 6460 my ($self, $ldbh, $string, $skip_payload, $dbname, $skip_commit) = @_; 6461 6462 ## We make some exceptions to the payload system, mostly for early MCP notices 6463 ## This is because we don't want to complicate external clients with payload decisions 6464 $skip_payload = 0 if ! defined $skip_payload; 6465 6466 $skip_commit = 0 if ! defined $skip_commit; 6467 6468 if ($config{log_level_number} <= LOG_DEBUG) { 6469 my $line = (caller)[2]; 6470 my $showdb = (defined $dbname and length $dbname) ? " to db $dbname" : ''; 6471 $self->glog(qq{Sending NOTIFY "$string"$showdb (line $line) skip_commit=$skip_commit}, LOG_DEBUG); 6472 } 6473 6474 if ($ldbh->{pg_server_version} < 90000 or $skip_payload) { 6475 ## Old-school notification system. Simply send the given string 6476 ## ...but prepend a 'bucardo_' to it first 6477 $string = "bucardo_$string"; 6478 $ldbh->do(qq{NOTIFY "$string"}) 6479 or $self->glog(qq{Warning: NOTIFY failed for "$string"}, LOG_DEBUG); 6480 } 6481 else { 6482 ## New-style notification system. The string becomes the payload 6483 6484 ## The channel is always 'bucardo' based. 6485 my $channel = 'bucardo'; 6486 ## Going to ctl? 6487 $channel = 'bucardo_ctl' if $string =~ s/^ctl_//o; 6488 ## Going to kid 6489 $channel = 'bucardo_kid' if $string =~ s/^kid_//o; 6490 6491 $ldbh->do(qq{NOTIFY $channel, '$string'}) 6492 or $self->glog(qq{Warning: NOTIFY failed for bucardo, '$string'}, LOG_DEBUG); 6493 } 6494 6495 $ldbh->commit() if ! $skip_commit; 6496 6497 return; 6498 6499} ## end of db_notify 6500 6501 6502sub db_get_notices { 6503 6504 ## Gather up and return a list of asynchronous notices received since the last check 6505 ## Arguments: one or two 6506 ## 1. Database handle 6507 ## 2. PID that can be ignored (optional) 6508 ## Returns: hash of notices, with the key as the name and then another hash with: 6509 ## count: total number received 6510 ## firstpid: the first PID for this notice 6511 ## pids: hashref of all pids 6512 ## If using 9.0 or greater, the payload becomes the name 6513 6514 my ($self, $ldbh, $selfpid) = @_; 6515 6516 my ($n, %notice); 6517 6518 while ($n = $ldbh->func('pg_notifies')) { 6519 6520 my ($name, $pid, $payload) = @$n; 6521 6522 ## Ignore certain PIDs (e.g. from ourselves!) 6523 next if defined $selfpid and $pid == $selfpid; 6524 6525 if ($ldbh->{pg_server_version} >= 90000 and $payload) { 6526 $name = $payload; ## presto! 6527 } 6528 else { 6529 $name =~ s/^bucardo_//o; 6530 } 6531 6532 if (exists $notice{$name}) { 6533 $notice{$name}{count}++; 6534 $notice{$name}{pid}{$pid}++; 6535 } 6536 else { 6537 $notice{$name}{count} = 1; 6538 $notice{$name}{pid}{$pid} = 1; 6539 $notice{$name}{firstpid} = $pid; 6540 } 6541 } 6542 6543 ## Return right now if we had no notices, 6544 ## or if don't need lots of logging detail 6545 if (! keys %notice or $config{log_level_number} > LOG_DEBUG) { 6546 return \%notice; 6547 } 6548 6549 ## TODO: Return if this was sent from us (usually PID+1) 6550 6551 ## Always want to write the actual line these came from 6552 my $line = (caller)[2]; 6553 6554 ## Walk the list and show each unique message received 6555 for my $name (sort keys %notice) { 6556 my $pid = $notice{$name}{firstpid}; 6557 my $prettypid = (exists $self->{pidmap}{$pid} ? "$pid ($self->{pidmap}{$pid})" : $pid); 6558 6559 my $extra = ''; 6560 my $pcount = keys %{ $notice{$name}{pid} }; 6561 $pcount--; ## Not the firstpid please 6562 if ($pcount > 1) { 6563 $extra = sprintf ' (and %d other %s)', 6564 $pcount, 1 == $pcount ? 'PID' : 'PIDs'; 6565 } 6566 6567 my $times = ''; 6568 $count = $notice{$name}{count}; 6569 if ($count > 1) { 6570 $times = " $count times"; 6571 } 6572 6573 my $msg = sprintf 'Got NOTICE %s%s from %s%s (line %d)', 6574 $name, $times, $prettypid, $extra, $line; 6575 $self->glog($msg, LOG_DEBUG); 6576 } 6577 6578 return \%notice; 6579 6580} ## end of db_get_notices 6581 6582 6583sub send_signal_to_PID { 6584 6585 ## Send a USR1 to one or more PIDs 6586 ## Arguments: one 6587 ## 1. Hashref of info, including: 6588 ## sync => name of a sync to filter PID files with 6589 ## Returns: number of signals sucessfully sent 6590 6591 my ($self, $arg) = @_; 6592 6593 my $total = 0; 6594 6595 ## Slurp in all the files from the PID directory 6596 my $piddir = $config{piddir}; 6597 opendir my $dh, $piddir or die qq{Could not opendir "$piddir" $!\n}; 6598 my @pidfiles = grep { /^bucardo.*\.pid$/ } readdir $dh; 6599 closedir $dh or warn qq{Could not closedir "$piddir": $!\n}; 6600 6601 ## Send a signal to the ones we care about 6602 for my $pidfile (sort @pidfiles) { 6603 6604 next if $arg->{sync} and $pidfile !~ /\bsync\.$arg->{sync}\b/; 6605 6606 my $pfile = File::Spec->catfile( $piddir => $pidfile ); 6607 if (open my $fh, '<', $pfile) { 6608 my $pid = <$fh>; 6609 close $fh or warn qq{Could not close "$pfile": $!\n}; 6610 if (! defined $pid or $pid !~ /^\d+$/) { 6611 $self->glog("Warning: No PID found in file, so removing $pfile", LOG_TERSE); 6612 unlink $pfile; 6613 } 6614 elsif ($pid == $$) { 6615 } 6616 else { 6617 $total += kill $signumber{'USR1'} => $pid; 6618 $self->glog("Sent USR1 signal to process $pid", LOG_VERBOSE); 6619 } 6620 } 6621 else { 6622 $self->glog("Warning: Could not open file, so removing $pfile", LOG_TERSE); 6623 unlink $pfile; 6624 } 6625 } 6626 6627 return $total; 6628 6629} ## end of send_signal_to_PID 6630 6631 6632sub validate_sync { 6633 6634 ## Check each database a sync needs to use, and validate all tables and columns 6635 ## This also populates the all important $self->{sdb} hash 6636 ## We use sdb to prevent later accidental mixing with $sync->{db} 6637 ## Arguments: one 6638 ## 1. Hashref of sync information 6639 ## Returns: boolean success/failure 6640 6641 my ($self,$s) = @_; 6642 6643 my $syncname = $s->{name}; 6644 my $SQL; 6645 6646 $self->glog(qq{Running validate_sync on "$s->{name}"}, LOG_NORMAL); 6647 6648 ## Populate $s->{db} with all databases in this sync 6649 $SQL = 'SELECT db.*, m.role, m.priority FROM dbmap m JOIN db ON (db.name = m.db) WHERE m.dbgroup = ?'; 6650 $sth = $self->{masterdbh}->prepare($SQL); 6651 $count = $sth->execute($s->{dbs}); 6652 $s->{db} = $sth->fetchall_hashref('name'); 6653 6654 ## Figure out what role each database will play in this sync 6655 my %role = ( source => 0, target => 0, fullcopy => 0); 6656 6657 ## Establish a connection to each database used 6658 ## We also populate the "source" database as the first source we come across 6659 my ($sourcename,$srcdbh); 6660 6661 ## How many database were restored from a stalled state 6662 my $restored_dbs = 0; 6663 6664 for my $dbname (sort keys %{ $s->{db} }) { 6665 6666 ## Helper var so we don't have to type this out all the time 6667 my $d = $s->{db}{$dbname}; 6668 6669 ## Check for inactive databases 6670 if ($d->{status} eq 'inactive') { 6671 ## Source databases are never allowed to be inactive 6672 if ($d->{role} eq 'source') { 6673 $self->glog("Source database $dbname is not active, cannot run this sync", LOG_WARN); 6674 ## Normally, we won't get here as the sync should not be active 6675 ## Mark the syncs as stalled and move on 6676 $s->{status} = 'stalled'; 6677 $SQL = 'UPDATE bucardo.sync SET status = ? WHERE name = ?'; 6678 eval { 6679 my $sth = $self->{masterdbh}->prepare($SQL); 6680 $sth->execute('stalled',$syncname); 6681 $self->{masterdbh}->commit(); 6682 }; 6683 if ($@) { 6684 $self->glog("Failed to set sync $syncname as stalled: $@", LOG_WARN); 6685 $self->{masterdbh}->rollback(); 6686 } 6687 return 0; 6688 } 6689 ## Warn about non-source ones, but allow the sync to proceed 6690 $self->glog("Database $dbname is not active, so it will not be used", LOG_WARN); 6691 6692 ## No sense in connecting to it 6693 next; 6694 } 6695 6696 ## If we've not already populated sdb, do so now 6697 if (! exists $self->{sdb}{$dbname}) { 6698 6699 $self->{sdb}{$dbname} = $d; 6700 6701 my $role = $d->{role}; 6702 if ($d->{dbtype} =~ /flat/o) { 6703 $self->glog(qq{Skipping flatfile database "$dbname"}, LOG_NORMAL); 6704 next; 6705 } 6706 $self->glog(qq{Connecting to database "$dbname" ($role)}, LOG_TERSE); 6707 eval { 6708 ## We do not want the CTL handler here 6709 local $SIG{__DIE__} = undef; 6710 ($d->{backend}, $d->{dbh}) = $self->connect_database($dbname); 6711 }; 6712 if (!defined $d->{backend}) { 6713 $self->glog("Connection failed: $@", LOG_TERSE); 6714 ## If this was already stalled, we can simply reject the validation 6715 if ($d->{status} eq 'stalled') { 6716 $self->glog("Stalled db $dbname failed again: $@", LOG_VERBOSE); 6717 return 0; 6718 } 6719 ## Wasn't stalled before, but is now! 6720 ## This is a temporary setting: we don't modify masterdbh 6721 $d->{status} = 'stalled'; 6722 return 0; 6723 } 6724 6725 $self->show_db_version_and_time($d->{dbh}, $d->{backend}, qq{Database "$dbname" }); 6726 6727 ## If this db was previously stalled, restore it 6728 if ($d->{status} eq 'stalled') { 6729 $self->glog("Restoring stalled db $dbname", LOG_NORMAL); 6730 $SQL = 'UPDATE bucardo.db SET status = ? WHERE name = ?'; 6731 my $sth = $self->{masterdbh}->prepare($SQL); 6732 eval { 6733 $sth->execute('active',$dbname); 6734 $self->{masterdbh}->commit(); 6735 $restored_dbs++; 6736 $d->{status} = 'active'; 6737 }; 6738 if ($@) { 6739 $self->glog("Failed to set db $dbname as active: $@", LOG_WARN); 6740 $self->{masterdbh}->rollback(); 6741 ## If this fails, we don't want the sync restored 6742 $restored_dbs = 0; 6743 } 6744 } 6745 6746 } 6747 6748 ## If the whole sync was stalled but we retored its dbs above, 6749 ## restore the sync as well 6750 if ($restored_dbs) { 6751 $self->glog("Restoring stalled sync $syncname", LOG_NORMAL); 6752 $SQL = 'UPDATE bucardo.sync SET status = ? WHERE name = ?'; 6753 eval { 6754 my $sth = $self->{masterdbh}->prepare($SQL); 6755 $sth->execute('active',$syncname); 6756 $s->{status} = 'active'; 6757 }; 6758 if ($@) { 6759 $self->glog("Failed to set sync $syncname as active: $@", LOG_WARN); 6760 $self->{masterdbh}->rollback(); 6761 } 6762 } 6763 6764 ## Help figure out source vs target later on 6765 $role{$d->{role}}++; 6766 6767 ## We want to grab the first source we find and populate $sourcename and $srcdbh 6768 if (! defined $sourcename and $s->{db}{$dbname}{role} eq 'source') { 6769 $sourcename = $dbname; 6770 $srcdbh = $self->{sdb}{$dbname}{dbh}; 6771 } 6772 6773 } ## end each database 6774 6775 ## If we have more than one source, then everyone is a target 6776 ## Otherwise, only non-source databases are 6777 for my $dbname (keys %{ $s->{db} }) { 6778 6779 my $d = $s->{db}{$dbname}; 6780 6781 $d->{istarget} = ($d->{role} ne 'source' or $role{source} > 1) ? 1 : 0; 6782 $d->{issource} = $d->{role} eq 'source' ? 1 : 0; 6783 } 6784 6785 ## Grab the authoritative list of goats in this herd 6786 $s->{goatlist} = $self->find_goats($s->{herd}); 6787 6788 ## Call validate_sync: checks tables, columns, sets up supporting 6789 ## schemas, tables, functions, and indexes as needed 6790 6791 eval { 6792 local $SIG{__DIE__} = undef; 6793 $self->glog(qq{Calling validate_sync on sync "$syncname"}, LOG_VERBOSE); 6794 $self->{masterdbh}->do("SELECT validate_sync('$syncname')"); 6795 }; 6796 if ($@) { 6797 $self->glog("Error from validate_sync: $@", LOG_NORMAL); 6798 $self->{masterdbh}->rollback; 6799 return 0; 6800 } 6801 6802 ## Prepare some SQL statements for immediate and future use 6803 my %SQL; 6804 6805 ## Given a schema and table name, return safely quoted names 6806 $SQL{checktable} = q{ 6807 SELECT c.oid, quote_ident(n.nspname), quote_ident(c.relname), quote_literal(n.nspname), quote_literal(c.relname) 6808 FROM pg_class c, pg_namespace n 6809 WHERE c.relnamespace = n.oid 6810 AND c.oid = ?::regclass 6811 }; 6812 $sth{checktable} = $srcdbh->prepare($SQL{checktable}); 6813 6814 ## Given a table, return detailed column information 6815 $SQL{checkcols} = q{ 6816 SELECT attname, quote_ident(attname) AS qattname, atttypid, format_type(atttypid, atttypmod) AS ftype, 6817 attnotnull, atthasdef, attnum, 6818 (SELECT pg_get_expr(adbin, adrelid) FROM pg_attrdef WHERE adrelid=attrelid 6819 AND adnum=attnum AND atthasdef) AS def 6820 FROM pg_attribute 6821 WHERE attrelid = ?::regclass AND attnum > 0 AND NOT attisdropped 6822 ORDER BY attnum 6823 }; 6824 $sth{checkcols} = $srcdbh->prepare($SQL{checkcols}); 6825 6826 ## Reset custom code related counters for this sync 6827 $s->{need_rows} = $s->{need_safe_dbh} = $s->{need_safe_dbh_strict} = 0; 6828 6829 ## Empty out any existing lists of code types 6830 for my $key (grep { /^code_/ } sort keys %$s) { 6831 $s->{$key} = []; 6832 } 6833 6834 ## Validate all (active) custom codes for this sync 6835 my $goatlistcodes = join ',' => map { $_->{id} } @{$s->{goatlist}}; 6836 my $goatclause = length $goatlistcodes ? "OR m.goat IN ($goatlistcodes)" : ''; 6837 6838 $SQL = qq{ 6839 SELECT c.src_code, c.id, c.whenrun, c.getdbh, c.name, COALESCE(c.about,'?') AS about, 6840 c.status, m.active, m.priority, COALESCE(m.goat,0) AS goat 6841 FROM customcode c, customcode_map m 6842 WHERE c.id=m.code AND m.active IS TRUE 6843 AND (m.sync = ? $goatclause) 6844 ORDER BY m.priority ASC, m.goat IS NULL, c.name ASC 6845 }; 6846 $sth = $self->{masterdbh}->prepare($SQL); 6847 $sth->execute($syncname); 6848 6849 ## Loop through all customcodes for this sync 6850 for my $c (@{$sth->fetchall_arrayref({})}) { 6851 if ($c->{status} ne 'active') { 6852 $self->glog(qq{ Skipping custom code $c->{id} ($c->{name}): not active }. LOG_NORMAL); 6853 next; 6854 } 6855 $self->glog(qq{ Validating custom code $c->{id} ($c->{whenrun}) (goat=$c->{goat}): $c->{name}}, LOG_WARN); 6856 6857 ## Carefully compile the code and catch complications 6858 TRY: { 6859 local $@; 6860 local $_; 6861 $c->{coderef} = eval qq{ 6862 package Bucardo::CustomCode; 6863 sub { $c->{src_code} } 6864 }; ## no critic (ProhibitStringyEval) 6865 if ($@) { 6866 $self->glog(qq{Warning! Custom code $c->{id} ($c->{name}) for sync "$syncname" did not compile: $@}, LOG_WARN); 6867 return 0; 6868 }; 6869 } 6870 6871 ## If this code is run at the goat level, push it to each goat's list of code 6872 if ($c->{goat}) { 6873 my ($goat) = grep { $_->{id}==$c->{goat} } @{$s->{goatlist}}; 6874 push @{$goat->{"code_$c->{whenrun}"}}, $c; 6875 if ($c->{whenrun} eq 'exception') { 6876 $goat->{has_exception_code}++; 6877 } 6878 } 6879 else { 6880 push @{$s->{"code_$c->{whenrun}"}}, $c; 6881 ## Every goat gets this code 6882 for my $g ( @{$s->{goatlist}} ) { 6883 push @{$g->{"code_$c->{whenrun}"}}, $c; 6884 $g->{has_exception_code}++ if $c->{whenrun} eq 'exception'; 6885 } 6886 } 6887 6888 ## Some custom code needs database handles - if so, gets one of two types 6889 if ($c->{getdbh}) { 6890 if ($c->{whenrun} eq 'before_txn' 6891 or $c->{whenrun} eq 'after_txn' 6892 or $c->{whenrun} eq 'before_sync' 6893 or $c->{whenrun} eq 'after_sync') { 6894 $s->{need_safe_dbh} = 1; 6895 } 6896 else { 6897 $s->{need_safe_dbh_strict} = 1; 6898 } 6899 } 6900 6901 } ## end checking each custom code 6902 6903 ## Go through each goat in this sync, adjusting items and possibly bubbling up info to sync 6904 for my $g (@{$s->{goatlist}}) { 6905 ## None of this applies to non-tables 6906 next if $g->{reltype} ne 'table'; 6907 6908 ## If we didn't find exception custom code above, set it to 0 for this goat 6909 $g->{has_exception_code} ||= 0; 6910 6911 if (!defined $g->{rebuild_index}) { 6912 $g->{rebuild_index} = $s->{rebuild_index}; 6913 } 6914 6915 } ## end each goat 6916 6917 ## There are things that a fullcopy sync does not do 6918 if ($s->{fullcopy}) { 6919 $s->{track_rates} = 0; 6920 } 6921 6922 ## Build our customname hash for use below when checking remote database tables 6923 my %customname; 6924 $SQL = q{SELECT goat,newname,db,COALESCE(db,'') AS db, COALESCE(sync,'') AS sync FROM bucardo.customname}; 6925 my $maindbh = $self->{masterdbh}; 6926 $sth = $maindbh->prepare($SQL); 6927 $sth->execute(); 6928 for my $row (@{$sth->fetchall_arrayref({})}) { 6929 ## Ignore if this is for some other sync 6930 next if length $row->{sync} and $row->{sync} ne $syncname; 6931 6932 $customname{$row->{goat}}{$row->{db}} = $row->{newname}; 6933 } 6934 6935 # Table cache 6936 $SQL{checktableonce} = q{ 6937 SELECT n.nspname, c.relname, c.oid, quote_ident(n.nspname) as safeschema, quote_ident(c.relname) as safetable, quote_literal(n.nspname) as safeschemaliteral, quote_literal(c.relname) as safetableliteral 6938 FROM pg_class c, pg_namespace n 6939 WHERE c.relnamespace = n.oid 6940 }; 6941 $sth = $srcdbh->prepare($SQL{checktableonce}); 6942 $sth->execute(); 6943 my %tablescache; 6944 for my $row (@{$sth->fetchall_arrayref({})}) { 6945 $tablescache{"$row->{nspname}.$row->{relname}"} = { 6946 map { $_ => $row->{$_} } qw(oid safeschema safetable safeschemaliteral safetableliteral) 6947 }; 6948 } 6949 $sth->finish(); 6950 6951 GOAT: for my $g (@{$s->{goatlist}}) { 6952 6953 ## TODO: refactor with work in validate_sync() 6954 6955 my $t = "$g->{schemaname}.$g->{tablename}"; 6956 $self->glog(qq{ Inspecting source $g->{reltype} "$t" on database "$sourcename"}, LOG_NORMAL); 6957 ## Check the source table, save escaped versions of the names 6958 6959 if (!exists ($tablescache{$t})) { 6960 my $msg = qq{Could not find $g->{reltype} "$t"\n}; 6961 $self->glog($msg, LOG_WARN); 6962 warn $msg; 6963 return 0; 6964 } 6965 6966 for my $key (keys %{ $tablescache{ $t } }) { 6967 $g->{$key} = $tablescache{$t}{$key}; 6968 } 6969 6970 my ($S,$T) = ($g->{safeschema},$g->{safetable}); 6971 6972 ## Plunk the oid into a hash for easy lookup below when saving FK information 6973 $s->{tableoid}{$g->{oid}}{name} = "$S.$T"; 6974 6975 ## Makedelta for this table starts empty 6976 $g->{makedelta} ||= ''; 6977 6978 ## Determine the conflict method for each goat 6979 ## Use the syncs if it has one, otherwise the default 6980 $g->{conflict_strategy} = $s->{conflict_strategy} || $config{default_conflict_strategy}; 6981 $self->glog(qq{ Set conflict strategy for $S.$T to "$g->{conflict_strategy}"}, LOG_DEBUG); 6982 ## We do this even if g->{code_conflict} exists so it can fall through 6983 6984 my $colinfo; 6985 if ($g->{reltype} eq 'table') { 6986 6987 ## Save information about each column in the primary key 6988 if (!defined $g->{pkey} or !defined $g->{qpkey}) { 6989 die "Table $g->{safetable} has no pkey or qpkey - do you need to run validate_goat() on it?\n"; 6990 } 6991 6992 ## Much of this is used later on, for speed of performing the sync 6993 $g->{pkey} = [split /\|/o => $g->{pkey}]; 6994 $g->{qpkey} = [split /\|/o => $g->{qpkey}]; 6995 $g->{pkeytype} = [split /\|/o => $g->{pkeytype}]; 6996 $g->{numpkcols} = @{$g->{pkey}}; 6997 $g->{hasbinarypk} = 0; ## Not used anywhere? 6998 $i = 0; 6999 for (@{$g->{pkey}}) { 7000 $g->{binarypkey}{$i++} = 0; 7001 } 7002 7003 ## All pks together for the main delta query 7004 ## We change bytea to base64 so we don't have to declare binary args anywhere 7005 $g->{pklist} = ''; 7006 for ($i = 0; defined $g->{pkey}[$i]; $i++) { 7007 $g->{pklist} .= sprintf '%s,', 7008 $g->{pkeytype}[$i] eq 'bytea' 7009 ? qq{ENCODE("$g->{pkey}[$i]", 'base64')} 7010 : qq{"$g->{pkey}[$i]"}; 7011 } 7012 ## Remove the final comma: 7013 chop $g->{pklist}; 7014 7015 ## The name of the delta and track tables for this table 7016 $SQL = 'SELECT bucardo.bucardo_tablename_maker(?)'; 7017 $sth = $self->{masterdbh}->prepare($SQL); 7018 $sth->execute($S.'_'.$T); 7019 $g->{makername} = $sth->fetchall_arrayref()->[0][0]; 7020 if ($g->{makername} =~ s/"//g) { 7021 $g->{deltatable} = qq{"delta_$g->{makername}"}; 7022 $g->{tracktable} = qq{"track_$g->{makername}"}; 7023 $g->{stagetable} = qq{"stage_$g->{makername}"}; 7024 } 7025 else { 7026 $g->{deltatable} = "delta_$g->{makername}"; 7027 $g->{tracktable} = "track_$g->{makername}"; 7028 $g->{stagetable} = "stage_$g->{makername}"; 7029 } 7030 7031 ## Turn off the search path, to help the checks below match up 7032 $srcdbh->do('SET LOCAL search_path = pg_catalog'); 7033 7034 ## Check the source columns, and save them 7035 $sth = $sth{checkcols}; 7036 $sth->execute(qq{"$g->{schemaname}"."$g->{tablename}"}); 7037 $colinfo = $sth->fetchall_hashref('attname'); 7038 ## Allow for 'dead' columns in the attnum ordering 7039 $i = 1; 7040 for (sort { $colinfo->{$a}{attnum} <=> $colinfo->{$b}{attnum} } keys %$colinfo) { 7041 $colinfo->{$_}{realattnum} = $i++; 7042 } 7043 $g->{columnhash} = $colinfo; 7044 7045 ## Build lists of columns 7046 $i = 1; 7047 $g->{cols} = []; 7048 $g->{safecols} = []; 7049 COL: for my $colname (sort { $colinfo->{$a}{attnum} <=> $colinfo->{$b}{attnum} } keys %$colinfo) { 7050 ## Skip if this column is part of the primary key 7051 for my $pk (@{$g->{pkey}}) { 7052 next COL if $pk eq $colname; 7053 } 7054 push @{$g->{cols}}, $colname; 7055 push @{$g->{safecols}}, $colinfo->{$colname}{qattname}; 7056 $colinfo->{$colname}{order} = $i++; 7057 } 7058 7059 ## Stringified versions of the above lists, for ease later on 7060 $g->{columnlist} = join ',' => @{$g->{cols}}; 7061 $g->{safecolumnlist} = join ',' => @{$g->{safecols}}; 7062 7063 ## Note which columns are bytea 7064 BCOL: for my $colname (keys %$colinfo) { 7065 my $c = $colinfo->{$colname}; 7066 next if $c->{atttypid} != 17; ## Yes, it's hardcoded, no sweat 7067 $i = 0; 7068 for my $pk (@{$g->{pkey}}) { 7069 if ($colname eq $pk) { 7070 $g->{binarypkey}{$i} = 1; 7071 $g->{hasbinarypk} = 1; 7072 next BCOL; 7073 } 7074 $i++; 7075 } 7076 ## This is used to bind_param these as binary during inserts and updates 7077 push @{$g->{binarycols}}, $colinfo->{$colname}{order}; 7078 } 7079 7080 $srcdbh->do('RESET search_path'); 7081 7082 } ## end if reltype is table 7083 7084 my $sourceseq = 1; 7085 #$g->{reltype} eq 'sequence' 7086 # ? $self->get_sequence_info($srcdbh, $S, $T) 7087 # : {}; 7088 7089 next if $g->{reltype} ne 'table'; 7090 7091 ## Verify sequences or tables+columns on remote databases 7092 for my $dbname (sort keys %{ $self->{sdb} }) { 7093 7094 ## Only ones for this sync, please 7095 next if ! exists $s->{db}{$dbname}; 7096 7097 my $d = $self->{sdb}{$dbname}; 7098 7099 next if $d->{role} eq 'source'; 7100 7101 ## Flat files are obviously skipped as we create them de novo 7102 next if $d->{dbtype} =~ /flat/o; 7103 7104 ## Mongo is skipped because it can create schemas on the fly 7105 next if $d->{dbtype} =~ /mongo/o; 7106 7107 ## Redis is skipped because we can create keys on the fly 7108 next if $d->{dbtype} =~ /redis/o; 7109 7110 ## MySQL/MariaDB/Drizzle/Oracle/SQLite is skipped for now, but should be added later 7111 next if $d->{dbtype} =~ /mysql|mariadb|drizzle|oracle|sqlite/o; 7112 7113 if ($self->{quickstart}) { 7114 $self->glog(" quickstart: Skipping table check for $dbname.$S.$T", LOG_VERBOSE); 7115 next; 7116 } 7117 7118 ## Respond to ping here and now for very impatient watchdog programs 7119 $maindbh->commit(); 7120 7121 my $nlist = $self->db_get_notices($maindbh); 7122 for my $name (keys %{ $nlist }) { 7123 my $npid = $nlist->{$name}{firstpid}; 7124 if ($name eq 'mcp_fullstop') { 7125 $self->glog("Received full stop notice from PID $npid, leaving", LOG_WARN); 7126 $self->cleanup_mcp("Received stop NOTICE from PID $npid"); 7127 exit 0; 7128 } 7129 if ($name eq 'mcp_ping') { 7130 $self->glog("Got a ping from PID $npid, issuing pong", LOG_DEBUG); 7131 $self->db_notify($maindbh, 'mcp_pong'); 7132 } 7133 } 7134 7135 ## Get a handle for the remote database 7136 my $dbh = $d->{dbh}; 7137 7138 ## If a sequence, verify the information and move on 7139 if ($g->{reltype} eq 'sequenceSKIP') { 7140 my $targetseq = $self->get_sequence_info($dbh, $S, $T); 7141 for my $key (sort keys %$targetseq) { 7142 if (! exists $sourceseq->{$key}) { 7143 $self->glog(qq{Warning! Sequence on target has item $key, but source does not!}, LOG_WARN); 7144 next; 7145 } 7146 if ($targetseq->{$key} ne $sourceseq->{$key}) { 7147 $self->glog("Warning! Sequence mismatch. Source $key=$sourceseq->{$key}, target is $targetseq->{$key}", LOG_WARN); 7148 next; 7149 } 7150 } 7151 7152 next; 7153 7154 } ## end if sequence 7155 7156 ## Turn off the search path, to help the checks below match up 7157 $dbh->do('SET LOCAL search_path = pg_catalog'); 7158 7159 ## Grab column information about this table 7160 $sth = $dbh->prepare($SQL{checkcols}); 7161 7162 ## Change to the customname if needed 7163 my ($RS,$RT) = ($S,$T); 7164 7165 ## We don't need to check if this is a source: this is already targets only 7166 my $using_customname = 0; 7167 if (exists $customname{$g->{id}}) { 7168 ## If there is an entry for this particular database, use that 7169 ## Otherwise, use the default one 7170 if (exists $customname{$g->{id}}{$dbname} or exists $customname{$g->{id}}{''}) { 7171 $RT = $customname{$g->{id}}{$dbname} || $customname{$g->{id}}{''}; 7172 $using_customname = 1; 7173 7174 ## If this has a dot, change the schema as well 7175 ## Otherwise, we simply use the existing schema 7176 if ($RT =~ s/(.+)\.//) { 7177 $RS = $1; 7178 } 7179 } 7180 } 7181 7182 $self->glog(qq{ Inspecting target $g->{reltype} "$RS.$RT" on database "$dbname"}, LOG_NORMAL); 7183 7184 $sth->execute("$RS.$RT"); 7185 my $targetcolinfo = $sth->fetchall_hashref('attname'); 7186 ## Allow for 'dead' columns in the attnum ordering 7187 $i = 1; 7188 for (sort { $targetcolinfo->{$a}{attnum} <=> $targetcolinfo->{$b}{attnum} } keys %$targetcolinfo) { 7189 $targetcolinfo->{$_}{realattnum} = $i++; 7190 } 7191 7192 $dbh->do('RESET search_path'); 7193 $dbh->rollback(); 7194 7195 ## We'll state no problems until we are proved wrong 7196 my $column_problems = 0; 7197 7198 ## Check each column in alphabetic order 7199 for my $colname (sort keys %$colinfo) { 7200 7201 ## Simple var mapping to make the following code sane 7202 my $fcol = $targetcolinfo->{$colname}; 7203 my $scol = $colinfo->{$colname}; 7204 7205 $self->glog(qq{ Column on target database "$dbname": "$colname" ($scol->{ftype})}, LOG_DEBUG); 7206 ## Always fatal: column on source but not target 7207 if (! exists $targetcolinfo->{$colname}) { 7208 $column_problems = 2; 7209 my $msg = qq{Source database for sync "$syncname" has column "$colname" of table "$t", but target database "$dbname" does not}; 7210 $self->glog("Warning: $msg", LOG_WARN); 7211 warn $msg; 7212 next; 7213 } 7214 7215 ## Almost always fatal: types do not match up 7216 if ($scol->{ftype} ne $fcol->{ftype}) { 7217 ## Carve out some known exceptions (but still warn about them) 7218 ## Allowed: varchar == text 7219 ## Allowed: timestamp* == timestamp* 7220 ## Allowed: int == bigint 7221 if ( 7222 ($scol->{ftype} eq 'character varying' and $fcol->{ftype} eq 'text') 7223 or 7224 ($scol->{ftype} eq 'text' and $fcol->{ftype} eq 'character varying') 7225 or 7226 ($scol->{ftype} eq 'integer' and $fcol->{ftype} eq 'bigint') 7227 or 7228 ($scol->{ftype} =~ /^timestamp/ and $fcol->{ftype} =~ /^timestamp/) 7229 ) { 7230 my $msg = qq{Source database for sync "$syncname" has column "$colname" of table "$t" as type "$scol->{ftype}", but target database "$dbname" has a type of "$fcol->{ftype}". You should really fix that.}; 7231 $self->glog("Warning: $msg", LOG_WARN); 7232 } 7233 else { 7234 $column_problems = 2; 7235 my $msg = qq{Source database for sync "$syncname" has column "$colname" of table "$t" as type "$scol->{ftype}", but target database "$dbname" has a type of "$fcol->{ftype}"}; 7236 $self->glog("Warning: $msg", LOG_WARN); 7237 next; 7238 } 7239 } 7240 7241 ## Fatal in strict mode: NOT NULL mismatch 7242 if ($scol->{attnotnull} != $fcol->{attnotnull}) { 7243 $column_problems ||= 1; ## Don't want to override a setting of "2" 7244 my $msg = sprintf q{Source database for sync "%s" has column "%s" of table "%s" set as %s, but target database "%s" has column set as %s}, 7245 $syncname, 7246 $colname, 7247 $t, 7248 $scol->{attnotnull} ? 'NOT NULL' : 'NULL', 7249 $dbname, 7250 $scol->{attnotnull} ? 'NULL' : 'NOT NULL'; 7251 $self->glog("Warning: $msg", LOG_WARN); 7252 warn $msg; 7253 } 7254 7255 ## Fatal in strict mode: DEFAULT existence mismatch 7256 if ($scol->{atthasdef} != $fcol->{atthasdef}) { 7257 $column_problems ||= 1; ## Don't want to override a setting of "2" 7258 my $msg = sprintf q{Source database for sync "%s" has column "%s" of table "%s" %s, but target database "%s" %s}, 7259 $syncname, 7260 $colname, 7261 $t, 7262 $scol->{atthasdef} ? 'with a DEFAULT value' : 'has no DEFAULT value', 7263 $dbname, 7264 $scol->{atthasdef} ? 'has none' : 'does'; 7265 $self->glog("Warning: $msg", LOG_WARN); 7266 warn $msg; 7267 } 7268 7269 ## Fatal in strict mode: DEFAULT exists but does not match 7270 if ($scol->{atthasdef} and $fcol->{atthasdef} and $scol->{def} ne $fcol->{def}) { 7271 ## Make an exception for Postgres versions returning DEFAULT parenthesized or not 7272 ## e.g. as "-5" in 8.2 or as "(-5)" in 8.3 7273 my $scol_def = $scol->{def}; 7274 my $fcol_def = $fcol->{def}; 7275 for ($scol_def, $fcol_def) { 7276 s/\A\(//; 7277 s/\)\z//; 7278 s/\)::/::/; 7279 7280 ## Also make exceptions for DEFAULT casting text to integers/numerics 7281 s/^'(-?\d+(?:\.\d+)?)'\s*::\s*(?:integer|numeric).*$/\$1/i; 7282 } 7283 my $msg; 7284 if ($scol_def eq $fcol_def) { 7285 $msg = q{Postgres version mismatch leads to this difference, which is being tolerated: }; 7286 } 7287 else { 7288 $column_problems ||= 1; ## Don't want to override a setting of "2" 7289 $msg = ''; 7290 } 7291 $msg .= qq{Source database for sync "$syncname" has column "$colname" of table "$t" with a DEFAULT of "$scol->{def}", but target database "$dbname" has a DEFAULT of "$fcol->{def}"}; 7292 $self->glog("Warning: $msg", LOG_WARN); 7293 warn $msg; 7294 } 7295 7296 ## Fatal in strict mode: order of columns does not match up 7297 if ($scol->{realattnum} != $fcol->{realattnum}) { 7298 $column_problems ||= 1; ## Don't want to override a setting of "2" 7299 my $msg = qq{Source database for sync "$syncname" has column "$colname" of table "$t" at position $scol->{realattnum} ($scol->{attnum}), but target database "$dbname" has it in position $fcol->{realattnum} ($fcol->{attnum})}; 7300 $self->glog("Warning: $msg", LOG_WARN); 7301 warn $msg; 7302 } 7303 7304 } ## end each column to be checked 7305 7306 ## Fatal in strict mode: extra columns on the target side 7307 for my $colname (sort keys %$targetcolinfo) { 7308 next if exists $colinfo->{$colname}; 7309 $column_problems ||= 1; ## Don't want to override a setting of "2" 7310 my $msg = qq{Target database has column "$colname" on table "$t", but source database does not}; 7311 $self->glog("Warning: $msg", LOG_WARN); 7312 warn $msg; 7313 } 7314 7315 ## Real serious problems always bail out 7316 return 0 if $column_problems >= 2; 7317 7318 ## If this is a minor problem, and we are using a customname, 7319 ## allow it to pass 7320 $column_problems = 0 if $using_customname; 7321 7322 ## If other problems, only bail if strict checking is on both sync and goat 7323 ## This allows us to make a sync strict, but carve out exceptions for goats 7324 return 0 if $column_problems and $s->{strict_checking} and $g->{strict_checking}; 7325 7326 } ## end each target database 7327 7328 } ## end each goat 7329 7330 ## Generate mapping of foreign keys 7331 ## This helps us with conflict resolution later on 7332 my $oidlist = join ',' => map { $_->{oid} } @{ $s->{goatlist} }; 7333 if ($oidlist) { 7334 7335 ## Postgres added the array_agg function in 8.4, so if this is older than that, 7336 ## we add our own copy 7337 my $arrayagg = 'array_agg'; 7338 if ($srcdbh->{pg_server_version} < 80400) { 7339 7340 ## We reset the search_path below, so we need to force the query below to use the public namespace 7341 $arrayagg = 'public.array_agg'; 7342 7343 ## Searching for the proname rather than the aggregate should be good enough 7344 $SQL = 'SELECT proname FROM pg_proc WHERE proname ~ ?'; 7345 $sth = $srcdbh->prepare($SQL); 7346 $count = $sth->execute('array_agg'); 7347 $sth->finish(); 7348 if ($count < 1) { 7349 $SQL = q{CREATE AGGREGATE array_agg(anyelement) ( SFUNC=array_append, STYPE=anyarray, INITCOND='{}')}; 7350 $srcdbh->do($SQL); 7351 } 7352 } 7353 7354 $SQL = qq{SELECT conname, 7355 conrelid, conrelid::regclass, 7356 confrelid, confrelid::regclass, 7357 $arrayagg(a.attname), $arrayagg(z.attname) 7358 FROM pg_constraint c 7359 JOIN pg_attribute a ON (a.attrelid = conrelid AND a.attnum = ANY(conkey)) 7360 JOIN pg_attribute z ON (z.attrelid = confrelid AND z.attnum = ANY (confkey)) 7361 WHERE contype = 'f' 7362 AND (conrelid IN ($oidlist) OR confrelid IN ($oidlist)) 7363 GROUP BY 1,2,3,4,5 7364 }; 7365 7366 ## We turn off search_path to get fully-qualified relation names 7367 $srcdbh->do('SET LOCAL search_path = pg_catalog'); 7368 7369 for my $row (@{ $srcdbh->selectall_arrayref($SQL) }) { 7370 7371 my ($conname, $oid1,$t1, $oid2,$t2, $c1,$c2) = @$row; 7372 7373 ## The referenced table is not being tracked in this sync 7374 if (! exists $s->{tableoid}{$oid2}) { 7375 ## Nothing to do except report this problem and move on 7376 $self->glog("Table $t1 references $t2($conname), which is not part of this sync!", LOG_NORMAL); 7377 next; 7378 } 7379 7380 ## A table referencing us is not being tracked in this sync 7381 if (! exists $s->{tableoid}{$oid1}) { 7382 ## Nothing to do except report this problem and move on 7383 $self->glog("Table $t2 is referenced by $t1($conname), which is not part of this sync!", LOG_NORMAL); 7384 next; 7385 } 7386 7387 ## Both exist, so tie them together 7388 $s->{tableoid}{$oid1}{references}{$oid2} = [$conname,$c1,$c2]; 7389 $s->{tableoid}{$oid2}{referencedby}{$oid1} = [$conname,$c1,$c2]; 7390 7391 } 7392 7393 $srcdbh->do('RESET search_path'); 7394 $srcdbh->commit(); 7395 7396 } 7397 7398 ## If autokick, listen for a triggerkick on all source databases 7399 if ($s->{autokick}) { 7400 my $l = "kick_sync_$syncname"; 7401 for my $dbname (sort keys %{ $s->{db} }) { 7402 7403 my $d = $s->{db}{$dbname}; 7404 7405 next if $d->{status} ne 'active'; 7406 $self->glog("Listen for $l on $dbname ($d->{role})", LOG_DEBUG); 7407 next if $d->{role} ne 'source'; 7408 my $dbh = $self->{sdb}{$dbname}{dbh}; 7409 $self->db_listen($dbh, $l, $dbname, 0); 7410 $dbh->commit; 7411 } 7412 } 7413 7414 ## Success! 7415 return 1; 7416 7417} ## end of validate_sync 7418 7419 7420sub activate_sync { 7421 7422 ## We've got a new sync to be activated (but not started) 7423 ## Arguments: one 7424 ## 1. Hashref of sync information 7425 ## Returns: boolean success/failure 7426 7427 my ($self,$s) = @_; 7428 7429 my $maindbh = $self->{masterdbh}; 7430 my $syncname = $s->{name}; 7431 7432 ## Connect to each database used by this sync and validate tables 7433 if (! $self->validate_sync($s)) { 7434 $self->glog("Validation of sync $s->{name} FAILED", LOG_WARN); 7435 $s->{mcp_active} = 0; 7436 return 0; 7437 } 7438 7439 ## If the kids stay alive, the controller must too 7440 if ($s->{kidsalive} and !$s->{stayalive}) { 7441 $s->{stayalive} = 1; 7442 $self->glog('Warning! Setting stayalive to true because kidsalive is true', LOG_WARN); 7443 } 7444 7445 ## Mark this sync as active: used in sync kicks/reloads later on 7446 $self->{sync}{$syncname}{mcp_active} = 1; 7447 7448 ## Let any listeners know we are done 7449 $self->db_notify($maindbh, "activated_sync_$syncname", 1); 7450 ## We don't need to listen for activation requests anymore 7451 $self->db_unlisten($maindbh, "activate_sync_$syncname", '', 1); 7452 ## But we do need to listen for deactivate and kick requests 7453 $self->db_listen($maindbh, "deactivate_sync_$syncname", '', 1); 7454 $self->db_listen($maindbh, "kick_sync_$syncname", '', 1); 7455 $self->db_listen($maindbh, "pause_sync_$syncname", '', 1); 7456 $self->db_listen($maindbh, "resume_sync_$syncname", '', 1); 7457 $maindbh->commit(); 7458 7459 ## Redo our process name to include an updated list of active syncs 7460 my @activesyncs; 7461 for my $syncname (sort keys %{ $self->{sync} }) { 7462 next if ! $self->{sync}{$syncname}{mcp_active}; 7463 push @activesyncs, $syncname; 7464 } 7465 7466 ## Change our process name to show all active syncs 7467 $0 = "Bucardo Master Control Program v$VERSION.$self->{extraname} Active syncs: "; 7468 $0 .= join ',' => @activesyncs; 7469 7470 return 1; 7471 7472} ## end of activate_sync 7473 7474 7475sub deactivate_sync { 7476 7477 ## We need to turn off a running sync 7478 ## Arguments: one 7479 ## 1. Hashref of sync information 7480 ## Returns: boolean success/failure 7481 7482 my ($self,$s) = @_; 7483 7484 my $maindbh = $self->{masterdbh}; 7485 my $syncname = $s->{name}; 7486 7487 ## Kill the controller 7488 my $ctl = $s->{controller}; 7489 if (!$ctl) { 7490 $self->glog('Warning! Controller not found', LOG_WARN); 7491 } 7492 else { 7493 $count = kill $signumber{USR1} => $ctl; 7494 $self->glog("Sent kill USR1 to CTL process $ctl. Result: $count", LOG_NORMAL); 7495 } 7496 $s->{controller} = 0; 7497 7498 $self->{sync}{$syncname}{mcp_active} = 0; 7499 7500 ## Let any listeners know we are done 7501 $self->db_notify($maindbh, "deactivated_sync_$syncname"); 7502 ## We don't need to listen for deactivation or kick/pause/resume requests 7503 $self->db_unlisten($maindbh, "deactivate_sync_$syncname", '', 1); 7504 $self->db_unlisten($maindbh, "kick_sync_$syncname", '', 1); 7505 $self->db_unlisten($maindbh, "pause_sync_$syncname", '', 1); 7506 $self->db_unlisten($maindbh, "resume_sync_$syncname", '', 1); 7507 ## But we do need to listen for an activation request 7508 $self->db_listen($maindbh, "activate_sync_$syncname", '', 1); 7509 $maindbh->commit(); 7510 7511 ## If we are listening for kicks on the source, stop doing so 7512 for my $dbname (sort keys %{ $self->{sdb} }) { 7513 7514 my $d = $self->{sdb}{$dbname}; 7515 7516 next if $d->{dbtype} ne 'postgres'; 7517 7518 next if $d->{role} ne 'source'; 7519 7520 $d->{dbh} ||= $self->connect_database($dbname); 7521 $d->{dbh}->commit(); 7522 if ($s->{autokick}) { 7523 my $l = "kick_sync_$syncname"; 7524 $self->db_unlisten($d->{dbh}, $l, $dbname, 0); 7525 $d->{dbh}->commit(); 7526 } 7527 } 7528 7529 ## Redo our process name to include an updated list of active syncs 7530 my @activesyncs; 7531 for my $syncname (keys %{ $self->{sync} }) { 7532 push @activesyncs, $syncname; 7533 } 7534 7535 $0 = "Bucardo Master Control Program v$VERSION.$self->{extraname} Active syncs: "; 7536 $0 .= join ',' => @activesyncs; 7537 7538 return 1; 7539 7540} ## end of deactivate_sync 7541 7542 7543sub fork_controller { 7544 7545 ## Fork off a controller process 7546 ## Arguments: two 7547 ## 1. Hashref of sync information 7548 ## 2. The name of the sync 7549 ## Returns: undef 7550 7551 my ($self, $s, $syncname) = @_; 7552 7553 my $newpid = $self->fork_and_inactivate('CTL'); 7554 7555 if ($newpid) { ## We are the parent 7556 $self->glog(qq{Created controller $newpid for sync "$syncname". Kick is $s->{kick_on_startup}}, LOG_NORMAL); 7557 $s->{controller} = $newpid; 7558 $self->{pidmap}{$newpid} = 'CTL'; 7559 7560 ## Reset counters for ctl restart via maxkicks and lifetime settings 7561 $s->{ctl_kick_counts} = 0; 7562 $s->{start_time} = time(); 7563 7564 return; 7565 } 7566 7567 ## We are the kid, aka the new CTL process 7568 7569 ## Sleep a hair so the MCP can finish the items above first 7570 sleep 0.05; 7571 7572 ## No need to keep information about other syncs around 7573 $self->{sync} = $s; 7574 7575 $self->start_controller($s); 7576 7577 exit 0; 7578 7579} ## end of fork_controller 7580 7581 7582sub fork_and_inactivate { 7583 7584 ## Call fork, and immediately inactivate open database handles 7585 ## Arguments: one 7586 ## 1. Type of thing we are forking (VAC, CTL, KID) 7587 ## Returns: nothing 7588 7589 my $self = shift; 7590 my $type = shift || '???'; 7591 7592 my $newpid = fork; 7593 if (!defined $newpid) { 7594 die qq{Warning: Fork for $type failed!\n}; 7595 } 7596 7597 if ($newpid) { ## Parent 7598 ## Very slight sleep to increase the chance of something happening to the kid 7599 ## before InactiveDestroy is set 7600 sleep 0.1; 7601 } 7602 else { ## Kid 7603 ## Walk through the list of all known DBI databases 7604 ## Inactivate each one, then undef it 7605 7606 ## Change to a better prefix, so 'MCP' does not appear in the logs 7607 $self->{logprefix} = $type; 7608 7609 ## It is probably still referenced elsewhere, so handle that - how? 7610 for my $iname (keys %{ $self->{dbhlist} }) { 7611 my $ldbh = $self->{dbhlist}{$iname}; 7612 $self->glog("Inactivating dbh $iname post-fork", LOG_DEBUG2); 7613 $ldbh->{InactiveDestroy} = 1; 7614 delete $self->{dbhlist}{$iname}; 7615 } 7616 ## Now go through common shared database handle locations, and delete them 7617 $self->{masterdbh}->{InactiveDestroy} = 1 7618 if $self->{masterdbh}; 7619 delete $self->{masterdbh}; 7620 7621 ## Clear the 'sdb' structure of any existing database handles 7622 if (exists $self->{sdb}) { 7623 for my $dbname (keys %{ $self->{sdb} }) { 7624 if (exists $self->{sdb}{$dbname}{dbh}) { 7625 if (ref $self->{sdb}{$dbname}{dbh}) { 7626 $self->glog("Removing sdb reference to database $dbname", LOG_DEBUG); 7627 $self->{sdb}{$dbname}{dbh}->{InactiveDestroy} = 1; 7628 } 7629 delete $self->{sdb}{$dbname}{dbh}; 7630 } 7631 } 7632 } 7633 7634 ## Clear any sync-specific database handles 7635 if (exists $self->{sync}) { 7636 if (exists $self->{sync}{name}) { ## This is a controller/kid with a single sync 7637 for my $dbname (sort keys %{ $self->{sync}{db} }) { 7638 if (exists $self->{sync}{db}{$dbname}{dbh}) { 7639 if (ref $self->{sync}{db}{$dbname}{dbh}) { 7640 $self->glog("Removing reference to database $dbname", LOG_DEBUG2); 7641 $self->{sync}{db}{$dbname}{dbh}->{InactiveDestroy} = 1; 7642 } 7643 delete $self->{sync}{db}{$dbname}{dbh}; 7644 } 7645 } 7646 } 7647 else { 7648 for my $syncname (keys %{ $self->{sync} }) { 7649 for my $dbname (sort keys %{ $self->{sync}{$syncname}{db} }) { 7650 if (exists $self->{sync}{$syncname}{db}{$dbname}{dbh}) { 7651 if (ref $self->{sync}{$syncname}{db}{$dbname}{dbh}) { 7652 $self->glog("Removing reference to database $dbname in sync $syncname", LOG_DEBUG2); 7653 $self->{sync}{$syncname}{db}{$dbname}{dbh}->{InactiveDestroy} = 1; 7654 } 7655 delete $self->{sync}{$syncname}{db}{$dbname}{dbh}; 7656 } 7657 } 7658 } 7659 } 7660 } 7661 } 7662 7663 return $newpid; 7664 7665} ## end of fork_and_inactivate 7666 7667 7668sub fork_vac { 7669 7670 ## Fork off a VAC process 7671 ## Arguments: none 7672 ## Returns: undef 7673 7674 my $self = shift; 7675 my $SQL; 7676 7677 ## Fork it off 7678 my $newpid = $self->fork_and_inactivate('VAC'); 7679 7680 ## Parent MCP just makes a note in the logs and returns 7681 if ($newpid) { ## We are the parent 7682 $self->glog(qq{Created VAC $newpid}, LOG_NORMAL); 7683 $self->{vacpid} = $newpid; 7684 return; 7685 } 7686 7687 ## Prefix all log lines with this TLA (was MCP) 7688 $self->{logprefix} = 'VAC'; 7689 7690 ## Set our process name 7691 $0 = qq{Bucardo VAC.$self->{extraname}}; 7692 7693 ## Store our PID into a file 7694 ## Save the complete returned name for later cleanup 7695 $self->{vacpidfile} = $self->store_pid( 'bucardo.vac.pid' ); 7696 7697 ## Start normal log output for this controller: basic facts 7698 my $msg = qq{New VAC daemon. PID=$$}; 7699 $self->glog($msg, LOG_NORMAL); 7700 7701 ## Allow the MCP to signal us (request to exit) 7702 local $SIG{USR1} = sub { 7703 ## Do not change this message: looked for in the controller DIE sub 7704 die "MCP request\n"; 7705 }; 7706 7707 ## From this point forward, we want to die gracefully 7708 local $SIG{__DIE__} = sub { 7709 7710 ## Arguments: one 7711 ## 1. Error message 7712 ## Returns: never (exit 0) 7713 7714 my ($diemsg) = @_; 7715 7716 ## Store the line that did the actual exception 7717 my $line = (caller)[2]; 7718 7719 ## Don't issue a warning if this was simply a MCP request 7720 my $warn = ($diemsg =~ /MCP request|Not needed/ ? '' : 'Warning! '); 7721 $self->glog(qq{${warn}VAC was killed at line $line: $diemsg}, $warn ? LOG_WARN :LOG_VERBOSE); 7722 7723 ## Not a whole lot of cleanup to do on this one: just shut database connections and leave 7724 $self->{masterdbh}->disconnect() if exists $self->{masterdbhvac}; 7725 7726 for my $dbname (keys %{ $self->{sdb} }) { 7727 my $d = $self->{sdb}{$dbname}; 7728 if (defined $d->{dbh} and $d->{dbh}) { 7729 $d->{dbh}->disconnect(); 7730 } 7731 } 7732 7733 7734 ## Remove our pid file 7735 unlink $self->{vacpidfile} or $self->glog("Warning! Failed to unlink $self->{vacpidfile}", LOG_WARN); 7736 7737 exit 0; 7738 7739 }; ## end SIG{__DIE__} handler sub 7740 7741 ## Connect to the master database 7742 ($self->{master_backend}, $self->{masterdbh}) = $self->connect_database(); 7743 $self->{masterdbhvac} = 1; 7744 my $maindbh = $self->{masterdbh}; 7745 $self->glog("Bucardo database backend PID: $self->{master_backend}", LOG_VERBOSE); 7746 7747 ## Map the PIDs to common names for better log output 7748 $self->{pidmap}{$$} = 'VAC'; 7749 $self->{pidmap}{$self->{master_backend}} = 'Bucardo DB'; 7750 7751 ## Listen for an exit request from the MCP 7752 my $exitrequest = 'stop_vac'; 7753 $self->db_listen($maindbh, $exitrequest, '', 1); ## No payloads please 7754 7755 ## Commit so we start listening right away 7756 $maindbh->commit(); 7757 7758 ## Reconnect to all databases we care about 7759 for my $dbname (keys %{ $self->{sdb} }) { 7760 7761 my $d = $self->{sdb}{$dbname}; 7762 7763 ## We looped through all the syncs earlier to determine which databases 7764 ## really need to be vacuumed. The criteria: 7765 ## not a fullcopy sync, dbtype is postgres, role is source 7766 next if ! $d->{needsvac}; 7767 7768 ## Establish a new database handle 7769 ($d->{backend}, $d->{dbh}) = $self->connect_database($dbname); 7770 $self->glog(qq{Connected to database "$dbname" with backend PID of $d->{backend}}, LOG_NORMAL); 7771 $self->{pidmap}{$d->{backend}} = "DB $dbname"; 7772 ## We don't want details about the purging 7773 $d->{dbh}->do(q{SET client_min_messages = 'warning'}); 7774 } 7775 7776 ## Track how long since we last came to life for vacuuming 7777 my $lastvacrun = 0; 7778 7779 ## The main loop 7780 VAC: { 7781 7782 ## Bail if the stopfile exists 7783 if (-e $self->{stop_file}) { 7784 $self->glog(qq{Found stopfile "$self->{stop_file}": exiting}, LOG_TERSE); 7785 ## Do not change this message: looked for in the controller DIE sub 7786 my $stopmsg = 'Found stopfile'; 7787 7788 ## Grab the reason, if it exists, so we can propagate it onward 7789 my $vacreason = get_reason(0); 7790 if ($vacreason) { 7791 $stopmsg .= ": $vacreason"; 7792 } 7793 7794 ## This exception is caught by the controller's __DIE__ sub above 7795 die "$stopmsg\n"; 7796 } 7797 7798 ## Process any notifications from the main database 7799 ## Ignore things we may have sent ourselves 7800 my $nlist = $self->db_get_notices($maindbh, $self->{master_backend}); 7801 7802 NOTICE: for my $name (sort keys %{ $nlist }) { 7803 7804 my $npid = $nlist->{$name}{firstpid}; 7805 7806 ## Strip prefix so we can easily use both pre and post 9.0 versions 7807 $name =~ s/^vac_//o; 7808 7809 ## Exit request from the MCP? 7810 if ($name eq $exitrequest) { 7811 die "Process $npid requested we exit\n"; 7812 } 7813 7814 ## Just ignore everything else 7815 7816 } ## end of each notification 7817 7818 ## To ensure we can receive new notifications next time: 7819 $maindbh->commit(); 7820 7821 ## Should we attempt a vacuum? 7822 if (time() - $lastvacrun >= $config{vac_run}) { 7823 7824 $lastvacrun = time(); 7825 7826 ## If there are no valid backends, we want to stop running entirely 7827 my $valid_backends = 0; 7828 7829 ## Kick each one off async 7830 for my $dbname (sort keys %{ $self->{sdb}} ) { 7831 7832 my $d = $self->{sdb}{$dbname}; 7833 7834 next if ! $d->{needsvac}; 7835 7836 my $dbh = $d->{dbh}; 7837 7838 ## Safety check: if the bucardo schema is not there, we don't want to vacuum 7839 if (! exists $d->{hasschema}) { 7840 $SQL = q{SELECT count(*) FROM pg_namespace WHERE nspname = 'bucardo'}; 7841 $d->{hasschema} = $dbh->selectall_arrayref($SQL)->[0][0]; 7842 if (! $d->{hasschema} ) { 7843 $self->glog("Warning! Cannot vacuum db $dbname unless we have a bucardo schema", LOG_WARN); 7844 } 7845 } 7846 7847 ## No schema? We've already complained, so skip it silently 7848 next if ! $d->{hasschema}; 7849 7850 $valid_backends++; 7851 7852 ## Async please 7853 $self->glog(qq{Running bucardo_purge_delta on database "$dbname"}, LOG_VERBOSE); 7854 $SQL = q{SELECT bucardo.bucardo_purge_delta('45 seconds')}; 7855 $sth{"vac_$dbname"} = $dbh->prepare($SQL, { pg_async => PG_ASYNC } ); 7856 $sth{"vac_$dbname"}->execute(); 7857 $d->{async_active} = time; 7858 7859 } ## end each source database 7860 7861 ## If we found no backends, we can leave right away, and not run again 7862 if (! $valid_backends) { 7863 7864 $self->glog('No valid backends, so disabling the VAC daemon', LOG_VERBOSE); 7865 7866 $config{bucardo_vac} = 0; 7867 7868 ## Caught by handler above 7869 die 'Not needed'; 7870 7871 } 7872 7873 ## Finish each one up 7874 for my $dbname (sort keys %{ $self->{sdb}} ) { 7875 7876 my $d = $self->{sdb}{$dbname}; 7877 7878 ## As above, skip if not a source or no schema available 7879 next if ! $d->{needsvac}; 7880 7881 next if ! $d->{hasschema}; 7882 7883 my $dbh = $d->{dbh}; 7884 7885 $self->glog(qq{Finish and fetch bucardo_purge_delta on database "$dbname"}, LOG_DEBUG); 7886 $count = $sth{"vac_$dbname"}->pg_result(); 7887 $d->{async_active} = 0; 7888 7889 my $info = $sth{"vac_$dbname"}->fetchall_arrayref()->[0][0]; 7890 $dbh->commit(); 7891 7892 $self->glog(qq{Purge on db "$dbname" gave: $info}, LOG_VERBOSE); 7893 7894 } ## end each source database 7895 7896 } ## end of attempting to vacuum 7897 7898 sleep $config{vac_sleep}; 7899 7900 redo VAC; 7901 7902 } ## end of main VAC loop 7903 7904 exit 0; 7905 7906} ## end of fork_vac 7907 7908 7909sub reset_mcp_listeners { 7910 7911 ## Unlisten everything, the relisten to specific entries 7912 ## Used by reload_mcp() 7913 ## Arguments: none 7914 ## Returns: undef 7915 7916 my $self = shift; 7917 7918 my $maindbh = $self->{masterdbh}; 7919 7920 ## Unlisten everything 7921 $self->db_unlisten_all($maindbh); 7922 ## Need to commit here to work around Postgres bug! 7923 $maindbh->commit(); 7924 7925 ## Listen for MCP specific items 7926 for my $l 7927 ( 7928 'mcp_fullstop', 7929 'mcp_reload', 7930 'reload_config', 7931 'log_message', 7932 'mcp_ping', 7933 'kid_pid_start', 7934 'kid_pid_stop', 7935 ) { 7936 $self->db_listen($maindbh, $l, '', 1); 7937 } 7938 7939 ## Listen for sync specific items 7940 for my $syncname (keys %{ $self->{sync} }) { 7941 for my $l 7942 ( 7943 'activate_sync', 7944 'deactivate_sync', 7945 'reload_sync', 7946 'kick_sync', 7947 ) { 7948 7949 ## If the sync is inactive, no sense in listening for anything but activate/reload requests 7950 if ($self->{sync}{$syncname}{status} ne 'active') { 7951 next if $l eq 'deactivate_sync' or $l eq 'kick_sync'; 7952 } 7953 else { 7954 ## If sync is active, no need to listen for an activate request 7955 next if $l eq 'activate_sync'; 7956 } 7957 7958 my $listen = "${l}_$syncname"; 7959 $self->db_listen($maindbh, $listen, '', 1); 7960 } 7961 7962 ## Listen for controller telling us the sync is done 7963 $self->db_listen($maindbh, "syncdone_$syncname"); 7964 7965 } 7966 7967 $maindbh->commit(); 7968 7969 return; 7970 7971} ## end of reset_mcp_listeners 7972 7973 7974sub reload_mcp { 7975 7976 ## Reset listeners, kill kids, load and activate syncs 7977 ## Arguments: none 7978 ## Returns: number of syncs we activated 7979 7980 my $self = shift; 7981 7982 my $SQL; 7983 7984 ## Grab a list of all the current syncs from the database and store as objects 7985 $self->{sync} = $self->get_syncs(); 7986 7987 ## Try and restore any stalled syncs 7988 $self->restore_syncs(); 7989 7990 ## This unlistens any old syncs 7991 $self->reset_mcp_listeners(); 7992 7993 ## Stop any kids that currently exist 7994 7995 ## First, we loop through the PID directory and signal all CTL processes 7996 ## These should in turn remove their kids 7997 $self->signal_pid_files('ctl'); 7998 7999 ## Next, we signal any KID processes that are still around 8000 $self->signal_pid_files('kid'); 8001 8002 ## Next we use dbrun to see if any database connections are still active 8003 ## First, a brief sleep to allow things to catch up 8004 sleep 0.5; 8005 8006 $self->terminate_old_goats(); 8007 8008 my $maindbh = $self->{masterdbh}; 8009 8010 ## At this point, we are authoritative, so we can safely clean out the syncrun table 8011 $SQL = q{ 8012 UPDATE bucardo.syncrun 8013 SET status=?, ended=now() 8014 WHERE ended IS NULL 8015 }; 8016 $sth = $maindbh->prepare($SQL); 8017 my $cleanmsg = "Old entry ended (MCP $$)"; 8018 $count = $sth->execute($cleanmsg); 8019 $maindbh->commit(); 8020 if ($count >= 1) { 8021 $self->glog("Entries cleaned from the syncrun table: $count", LOG_NORMAL); 8022 } 8023 8024 $SQL = q{DELETE FROM bucardo.dbrun}; 8025 $maindbh->do($SQL); 8026 8027 $self->glog(('Loading sync table. Rows=' . (scalar (keys %{ $self->{sync} }))), LOG_VERBOSE); 8028 8029 ## Load each sync in alphabetical order 8030 my @activesyncs; 8031 for (sort keys %{ $self->{sync} }) { 8032 my $s = $self->{sync}{$_}; 8033 my $syncname = $s->{name}; 8034 8035 ## Note that the mcp has changed this sync 8036 $s->{mcp_changed} = 1; 8037 8038 ## Reset some boolean flags for this sync 8039 $s->{mcp_active} = $s->{kick_on_startup} = $s->{controller} = 0; 8040 8041 ## If this sync is not active or stalled, don't bother going any further 8042 if ($s->{status} ne 'active' and $s->{status} ne 'stalled') { 8043 $self->glog(qq{Skipping sync "$syncname": status is "$s->{status}"}, LOG_TERSE); 8044 next; 8045 } 8046 8047 ## If we are doing specific syncs, check the name 8048 if (exists $self->{dosyncs}) { 8049 if (! exists $self->{dosyncs}{$syncname}) { 8050 $self->glog(qq{Skipping sync "$syncname": not explicitly named}, LOG_VERBOSE); 8051 next; 8052 } 8053 $self->glog(qq{Activating sync "$syncname": explicitly named}, LOG_VERBOSE); 8054 } 8055 else { 8056 $self->glog(qq{Activating sync "$syncname"}, LOG_NORMAL); 8057 } 8058 8059 ## Activate this sync! 8060 $s->{mcp_active} = 1; 8061 if (! $self->activate_sync($s)) { 8062 $s->{mcp_active} = 0; 8063 } 8064 8065 # If it was successfully activated, push it on the queue 8066 push @activesyncs, $syncname if $s->{mcp_active}; 8067 8068 } ## end each sync 8069 8070 ## Change our process name, and list all active syncs 8071 $0 = "Bucardo Master Control Program v$VERSION.$self->{extraname} Active syncs: "; 8072 $0 .= join ',' => @activesyncs; 8073 8074 my $count = @activesyncs; 8075 8076 return $count; 8077 8078} ## end of reload_mcp 8079 8080 8081sub cleanup_mcp { 8082 8083 ## MCP is shutting down, so we: 8084 ## - disconnect from the database 8085 ## - attempt to kill any controller kids 8086 ## - send a final NOTIFY 8087 ## - remove our own PID file 8088 ## Arguments: one 8089 ## 1. String with a reason for exiting 8090 ## Returns: undef 8091 8092 my ($self,$exitreason) = @_; 8093 8094 ## Rollback and disconnect from the master database if needed 8095 if ($self->{masterdbh}) { 8096 $self->{masterdbh}->rollback(); 8097 $self->{masterdbh}->disconnect(); 8098 } 8099 8100 ## Reconnect to the master database for some final cleanups 8101 my ($finalbackend,$finaldbh) = $self->connect_database(); 8102 $self->glog("Final database backend PID: $finalbackend", LOG_VERBOSE); 8103 8104 ## Sleep a bit to let the processes clean up their own pid files 8105 sleep 1.5; 8106 8107 ## We know we are authoritative for all pid files in the piddir 8108 ## Use those to kill any open processes that we think are still bucardo related 8109 my $piddir = $config{piddir}; 8110 opendir my $dh, $piddir or die qq{Could not opendir "$piddir" $!\n}; 8111 8112 ## As before, we only worry about certain files, 8113 ## even though nothing else should be in there 8114 my @pidfiles2 = grep { /^bucardo.*\.pid$/ } readdir $dh; 8115 closedir $dh or warn qq{Could not closedir "$piddir": $!\n}; 8116 8117 ## For each file, attempt to kill the process it refers to 8118 for my $pidfile (sort @pidfiles2) { 8119 next if $pidfile eq 'bucardo.mcp.pid'; ## That's us! 8120 my $pfile = File::Spec->catfile( $piddir => $pidfile ); 8121 if (-e $pfile) { 8122 $self->glog("Trying to kill stale PID file $pidfile", LOG_DEBUG); 8123 my $result = $self->kill_bucardo_pidfile($pfile); 8124 if ($result == -4) { ## kill 0 indicates that PID is no more 8125 $self->glog("PID from $pidfile is gone, removing file", LOG_NORMAL); 8126 unlink $pfile; 8127 } 8128 } 8129 } 8130 8131 ## Gather system and database timestamps, output them to the logs 8132 my $end_systemtime = scalar localtime; 8133 my $end_dbtime = eval { $finaldbh->selectcol_arrayref('SELECT now()')->[0] } || 'unknown'; 8134 $self->glog(qq{End of cleanup_mcp. Sys time: $end_systemtime. Database time: $end_dbtime}, LOG_TERSE); 8135 8136 ## Let anyone listening know we have stopped 8137 $self->db_notify($finaldbh, 'stopped', 1) if $end_dbtime ne 'unknown'; 8138 $finaldbh->disconnect(); 8139 8140 ## For the very last thing, remove our own PID file 8141 if (unlink $self->{pid_file}) { 8142 $self->glog(qq{Removed pid file "$self->{pid_file}"}, LOG_DEBUG); 8143 } 8144 else { 8145 $self->glog("Warning! Failed to remove pid file $self->{pid_file}", LOG_WARN); 8146 } 8147 8148 return; 8149 8150} ## end of cleanup_mcp 8151 8152 8153 8154sub terminate_old_goats { 8155 8156 ## Uses the dbrun table to see if any existing connections are still active 8157 ## This can happen if a KID is killed but a large COPY is still going on 8158 ## Arguments: one 8159 ## 1. Optional sync name to limit the reaping to 8160 ## Returns: number of backends successfully terminated 8161 8162 my $self = shift; 8163 my $sync = shift || ''; 8164 8165 my $maindbh = $self->{masterdbh}; 8166 8167 my $SQL; 8168 8169 ## Grab all backends in the table 8170 $SQL = 'SELECT * FROM bucardo.dbrun WHERE pgpid IS NOT NULL'; 8171 8172 ## Just for one sync if that was passed in 8173 if ($sync) { 8174 $SQL .= ' AND sync = ' . $maindbh->quote($sync); 8175 } 8176 8177 $sth = $maindbh->prepare($SQL); 8178 $sth->execute(); 8179 8180 ## Create a hash with the names of the databases as the first-level keys, 8181 ## and the process ids as the second-level keys. 8182 my %dbpid; 8183 for my $row (@{ $sth->fetchall_arrayref({}) }) { 8184 $dbpid{$row->{dbname}}{$row->{pgpid}} = $row->{started}; 8185 } 8186 8187 ## Use pg_stat_activity to find a match, then terminate it 8188 my $pidcol = $maindbh->{pg_server_version} >= 90200 ? 'pid' : 'procpid'; 8189 $SQL = "SELECT 1 FROM pg_stat_activity WHERE $pidcol = ? AND query_start = ?"; 8190 my $SQLC = 'SELECT pg_cancel_backend(?)'; 8191 my $total = 0; 8192 for my $dbname (sort keys %{ $self->{sdb} }) { 8193 8194 my $d = $self->{sdb}{$dbname}; 8195 8196 ## All of this is very Postgres specific 8197 next if $d->{dbtype} ne 'postgres'; 8198 8199 ## Loop through each backend PID found for this database 8200 EPID: for my $pid (sort keys %{ $dbpid{$dbname} }) { 8201 my $time = $dbpid{$dbname}{$pid}; 8202 8203 if (! defined $d->{dbh}) { 8204 $self->glog("Existing database connection gone: reconnecting to $dbname", LOG_VERBOSE); 8205 eval { 8206 ($d->{backend}, $d->{dbh}) = $self->connect_database($dbname); 8207 }; 8208 if (! defined $d->{dbh}) { 8209 $self->glog("Database $dbname unreachable, skipping cleanup of pid $pid", LOG_NORMAL); 8210 next EPID; 8211 } 8212 } 8213 8214 $sth = $d->{dbh}->prepare($SQL); 8215 8216 ## See if the process is still around by matching PID and query_start time 8217 $count = $sth->execute($pid, $time); 8218 $sth->finish(); 8219 8220 ## If no match, silently move on 8221 next if $count < 1; 8222 8223 ## If we got a match, try and kill it 8224 $sth = $d->{dbh}->prepare($SQLC); 8225 $count = $sth->execute($pid); 8226 my $res = $count < 1 ? 'failed' : 'ok'; 8227 $self->glog("Attempted to kill backend $pid on db $dbname, started $time. Result: $res", LOG_NORMAL); 8228 8229 ## We are going to count both failed and ok as the same for the return number 8230 $total += $count; 8231 } 8232 } 8233 8234 return $total; 8235 8236} ## end of terminate_old_goats 8237 8238 8239sub kill_bucardo_pidfile { 8240 8241 ## Given a file, extract the PID and kill it 8242 ## Arguments: 2 8243 ## 1. File to be checked 8244 ## 2. String either 'strict' or not. Strict does TERM and KILL in addition to USR1 8245 ## Returns: same as kill_bucardo_pid, plus: 8246 ## -100: File not found 8247 ## -101: Could not open the file 8248 ## -102: No PID found in the file 8249 8250 my ($self,$file,$strength) = @_; 8251 8252 ## Make sure the file supplied exists! 8253 if (! -e $file) { 8254 $self->glog(qq{Failed to find PID file "$file"}, LOG_VERBOSE); 8255 return -100; 8256 } 8257 8258 ## Try and open the supplied file 8259 my $fh; 8260 if (! open $fh, '<', $file) { 8261 $self->glog(qq{Failed to open PID file "$file": $!}, LOG_VERBOSE); 8262 return -101; 8263 } 8264 8265 ## Try and extract the numeric PID from inside of it 8266 ## Should be the only thing on the first line 8267 if (<$fh> !~ /(\d+)/) { 8268 $self->glog(qq{Failed to find a PID in the file PID "$file"}, LOG_TERSE); 8269 close $fh or warn qq{Could not close "$file": $!}; 8270 return -102; 8271 } 8272 8273 ## Close the file and call another method to do the dirty work 8274 8275 close $fh or warn qq{Could not close "$file": $!}; 8276 8277 return $self->kill_bucardo_pid($1 => $strength); 8278 8279} ## end of kill_bucardo_pidfile 8280 8281 8282sub kill_bucardo_pid { 8283 8284 ## Send a kill signal to a specific process 8285 ## Arguments: two 8286 ## 1. PID to be killed 8287 ## 2. String either 'strict' or not. Strict does KILL and TERM in addition to USR1 8288 ## Returns: 1 on successful kill, < 0 otherwise 8289 ## 0: no such PID or not a 'bucardo' PID 8290 ## +1 : successful TERM 8291 ## -1: Failed to signal with USR1 8292 ## +2: Successful KILL 8293 ## -2: Failed to signal with TERM and KILL 8294 ## -3: Invalid PID (non-numeric) 8295 ## -4: PID does not exist 8296 8297 my ($self,$pid,$nice) = @_; 8298 8299 $self->glog("Attempting to kill PID $pid", LOG_VERBOSE); 8300 8301 ## We want to confirm this is still a Bucardo process 8302 ## The most portable way at the moment is a plain ps -p 8303 ## Windows users are on their own 8304 8305 ## If the PID is not numeric, throw a warning and return 8306 if ($pid !~ /^\d+$/o) { 8307 $self->glog("Warning: invalid PID supplied to kill_bucardo_pid: $pid", LOG_WARN); 8308 return -3; 8309 } 8310 8311 ## Make sure the process is still around 8312 ## If not, log it and return 8313 if (! kill(0 => $pid) ) { 8314 $self->glog("Process $pid did not respond to a kill 0", LOG_NORMAL); 8315 return -4; 8316 } 8317 8318 ## It's nice to do some basic checks when possible that these are Bucardo processes 8319 ## For non Win32 boxes, we can try a basic ps 8320 ## If no header line, drive on 8321 ## If command is not perl, skip it! 8322 ## If args is not perl or bucardo, skip it 8323 if ($^O !~ /Win/) { 8324 my $COM = "ps -p $pid -o comm,args"; 8325 my $info = qx{$COM}; 8326 if ($info !~ /^COMMAND/) { 8327 $self->glog(qq{Could not determine ps information for pid $pid}, LOG_VERBOSE); 8328 } 8329 elsif ($info !~ /\bbucardo\s+/oi) { 8330 $self->glog(qq{Will not kill process $pid: ps args is not 'Bucardo', got: $info}, LOG_TERSE); 8331 return 0; 8332 } 8333 } ## end of trying ps because not Windows 8334 8335 ## At this point, we've done due diligence and can start killing this pid 8336 ## Start with a USR1 signal 8337 $self->glog("Sending signal $signumber{USR1} to pid $pid", LOG_DEBUG); 8338 $count = kill $signumber{USR1} => $pid; 8339 8340 if ($count >= 1) { 8341 $self->glog("Successfully signalled pid $pid with kill USR1", LOG_DEBUG); 8342 return 1; 8343 } 8344 8345 ## If we are not strict, we are done 8346 if ($nice ne 'strict') { 8347 $self->glog("Failed to USR1 signal pid $pid", LOG_TERSE); 8348 return -1; 8349 } 8350 8351 $self->glog("Sending signal $signumber{TERM} to pid $pid", LOG_DEBUG); 8352 $count = kill $signumber{TERM} => $pid; 8353 8354 if ($count >= 1) { 8355 $self->glog("Successfully signalled pid $pid with kill TERM", LOG_DEBUG); 8356 return 1; 8357 } 8358 8359 $self->glog("Failed to TERM signal pid $pid", LOG_TERSE); 8360 8361 ## Raise the stakes and issue a KILL signal 8362 $self->glog("Sending signal $signumber{KILL} to pid $pid", LOG_DEBUG); 8363 $count = kill $signumber{KILL} => $pid; 8364 8365 if ($count >= 1) { 8366 $self->glog("Successfully signalled pid $pid with kill KILL", LOG_DEBUG); 8367 return 2; 8368 } 8369 8370 $self->glog("Failed to KILL signal pid $pid", LOG_TERSE); 8371 return -2; 8372 8373} ## end of kill_bucardo_pid 8374 8375 8376sub signal_pid_files { 8377 8378 ## Finds the pid in all matching pid files, and signals with USR1 8379 ## Arguments: 1 8380 ## 1. String to match the file inside the PID directory with 8381 ## Returns: number successfully signalled 8382 8383 my ($self,$string) = @_; 8384 8385 my $signalled = 0; 8386 8387 ## Open the directory that contains our PID files 8388 my $piddir = $config{piddir}; 8389 opendir my $dh, $piddir or die qq{Could not opendir "$piddir": $!\n}; 8390 my ($name, $fh); 8391 while (defined ($name = readdir($dh))) { 8392 8393 ## Skip unless it's a matched file 8394 next if index($name, $string) < 0; 8395 8396 $self->glog(qq{Attempting to signal PID from file "$name"}, LOG_TERSE); 8397 8398 ## File must be readable 8399 my $cfile = File::Spec->catfile( $piddir => $name ); 8400 if (! open $fh, '<', $cfile) { 8401 $self->glog(qq{Could not open $cfile: $!}, LOG_WARN); 8402 next; 8403 } 8404 8405 ## File must contain a number (the PID) 8406 if (<$fh> !~ /(\d+)/) { 8407 $self->glog(qq{Warning! File "$cfile" did not contain a PID!}, LOG_WARN); 8408 next; 8409 } 8410 8411 my $pid = $1; ## no critic (ProhibitCaptureWithoutTest) 8412 close $fh or warn qq{Could not close "$cfile": $!\n}; 8413 8414 ## No sense in doing deeper checks that this is still a Bucardo process, 8415 ## as a USR1 should be a pretty harmless signal 8416 $count = kill $signumber{USR1} => $pid; 8417 if ($count != 1) { 8418 $self->glog(qq{Failed to signal $pid with USR1}, LOG_WARN); 8419 } 8420 else { 8421 $signalled++; 8422 } 8423 8424 } ## end each file in the pid directory 8425 8426 closedir $dh or warn qq{Warning! Could not closedir "$piddir": $!\n}; 8427 8428 return $signalled; 8429 8430} ## end of signal_pid_files 8431 8432 8433 8434 8435 8436 8437sub cleanup_controller { 8438 8439 ## Controller is shutting down 8440 ## Disconnect from the database 8441 ## Attempt to kill any kids 8442 ## Remove our PID file 8443 ## Arguments: two 8444 ## 1. Exited normally? (0 or 1) 8445 ## 2. Reason for leaving 8446 ## Return: undef 8447 8448 my ($self,$normalexit,$reason) = @_; 8449 8450 if (exists $self->{cleanexit}) { 8451 $reason = 'Normal exit'; 8452 } 8453 8454 ## Disconnect from the master database 8455 if ($self->{masterdbh}) { 8456 ## Ask all kids to exit as well 8457 my $exitname = "kid_stopsync_$self->{syncname}"; 8458 $self->{masterdbh}->rollback(); 8459 $self->db_notify($self->{masterdbh}, $exitname); 8460 8461 # Quick debug to find active statement handles 8462 # for my $s (@{$self->{masterdbh}{ChildHandles}}) { 8463 # next if ! ref $s or ! $s->{Active}; 8464 # $self->glog(Dumper $s->{Statement}, LOG_NORMAL); 8465 #} 8466 $self->{masterdbh}->rollback(); 8467 $self->{masterdbh}->disconnect(); 8468 } 8469 8470 ## Sleep a bit to let the processes clean up their own pid files 8471 sleep 0.5; 8472 8473 ## Kill any kids who have a pid file for this sync 8474 ## By kill, we mean "send a friendly USR1 signal" 8475 8476 my $piddir = $config{piddir}; 8477 opendir my $dh, $piddir or die qq{Could not opendir "$piddir" $!\n}; 8478 my @pidfiles = readdir $dh; 8479 closedir $dh or warn qq{Could not closedir "$piddir": $!\n}; 8480 8481 for my $pidfile (sort @pidfiles) { 8482 my $sname = $self->{syncname}; 8483 next unless $pidfile =~ /^bucardo\.kid\.sync\.$sname\.?.*\.pid$/; 8484 my $pfile = File::Spec->catfile( $piddir => $pidfile ); 8485 if (open my $fh, '<', $pfile) { 8486 my $pid = <$fh>; 8487 close $fh or warn qq{Could not close "$pfile": $!\n}; 8488 if (! defined $pid or $pid !~ /^\d+$/) { 8489 $self->glog("Warning: no PID found in file, so removing $pfile", LOG_TERSE); 8490 unlink $pfile; 8491 } 8492 else { 8493 kill $signumber{USR1} => $pid; 8494 $self->glog("Sent USR1 signal to kid process $pid", LOG_VERBOSE); 8495 } 8496 } 8497 else { 8498 $self->glog("Warning: could not open file, so removing $pfile", LOG_TERSE); 8499 unlink $pfile; 8500 } 8501 } 8502 8503 $self->glog("Controller $$ exiting at cleanup_controller. Reason: $reason", LOG_TERSE); 8504 8505 ## Remove the pid file 8506 if (unlink $self->{ctlpidfile}) { 8507 $self->glog(qq{Removed pid file "$self->{ctlpidfile}"}, LOG_DEBUG); 8508 } 8509 else { 8510 $self->glog("Warning! Failed to remove pid file $self->{ctlpidfile}", LOG_WARN); 8511 } 8512 8513 ## Reconnect and clean up the syncrun table 8514 my ($finalbackend, $finaldbh) = $self->connect_database(); 8515 $self->glog("Final database backend PID: $finalbackend", LOG_VERBOSE); 8516 8517 ## Need to make this one either lastgood or lastbad 8518 ## In theory, this will never set lastgood 8519 $self->end_syncrun($finaldbh, $normalexit ? 'good' : 'bad', 8520 $self->{syncname}, "Ended (CTL $$)"); 8521 $finaldbh->commit(); 8522 $finaldbh->disconnect(); 8523 $self->glog('Made final adjustment to the syncrun table', LOG_DEBUG); 8524 8525 return; 8526 8527} ## end of cleanup_controller 8528 8529 8530sub end_syncrun { 8531 8532 ## End the current syncrun entry, and adjust lastgood/lastbad/lastempty as needed 8533 ## If there is no null ended for this sync, does nothing 8534 ## Does NOT commit 8535 ## Arguments: four 8536 ## 1. The database handle to use 8537 ## 2. How did we exit ('good', 'bad', or 'empty') 8538 ## 3. The name of the sync 8539 ## 4. The new status to put 8540 ## Returns: undef 8541 8542 my ($self, $ldbh, $exitmode, $syncname, $status) = @_; 8543 8544 my $SQL; 8545 8546 ## Which column are we changing? 8547 my $lastcol = 8548 $exitmode eq 'good' ? 'lastgood' : 8549 $exitmode eq 'bad' ? 'lastbad' : 8550 $exitmode eq 'empty' ? 'lastempty' : 8551 die qq{Invalid exitmode "$exitmode"}; 8552 8553 ## Make sure we have something to update 8554 $SQL = q{ 8555 SELECT ctid 8556 FROM bucardo.syncrun 8557 WHERE sync = ? 8558 AND ended IS NULL}; 8559 $sth = $ldbh->prepare($SQL); 8560 $count = $sth->execute($syncname); 8561 if ($count < 1) { 8562 $sth->finish(); 8563 return; 8564 } 8565 if ($count > 1) { 8566 $self->glog("Expected one row from end_syncrun, but got $count", LOG_NORMAL); 8567 } 8568 my $ctid = $sth->fetchall_arrayref()->[0][0]; 8569 8570 ## Remove the previous 'last' entry, if any 8571 $SQL = qq{ 8572 UPDATE bucardo.syncrun 8573 SET $lastcol = 'false' 8574 WHERE $lastcol IS TRUE 8575 AND sync = ? 8576 }; 8577 $sth = $ldbh->prepare($SQL); 8578 $sth->execute($syncname); 8579 8580 ## End the current row, and elevate it to a 'last' position 8581 $SQL = qq{ 8582 UPDATE bucardo.syncrun 8583 SET $lastcol = 'true', ended=now(), status=? 8584 WHERE ctid = ? 8585 }; 8586 $sth = $ldbh->prepare($SQL); 8587 $sth->execute($status, $ctid); 8588 8589 return; 8590 8591} ## end of end_syncrun 8592 8593 8594sub run_ctl_custom_code { 8595 8596 ## Arguments: four 8597 ## 1. Sync object 8598 ## 2. Input object 8599 ## 2. Hashref of customcode information 8600 ## 3. Strictness boolean, defaults to false 8601 ## 4. Number of attempts, defaults to 0 8602 ## Returns: string indicating what to do, one of: 8603 ## 'next' 8604 ## 'redo' 8605 ## 'normal' 8606 8607 my $self = shift; 8608 my $sync = shift; 8609 my $input = shift; 8610 my $c = shift; 8611 my $strictness = shift || ''; 8612 my $attempts = shift || 0; 8613 8614 $self->glog("Running $c->{whenrun} controller custom code $c->{id}: $c->{name}", LOG_NORMAL); 8615 8616 my $cc_sourcedbh; 8617 if (!defined $sync->{safe_sourcedbh}) { 8618 $cc_sourcedbh = $self->connect_database($sync->{sourcedb}); 8619 my $darg; 8620 for my $arg (sort keys %{ $dbix{source}{notstrict} }) { 8621 next if ! length $dbix{source}{notstrict}{$arg}; 8622 $darg->{$arg} = $dbix{source}{notstrict}{$arg}; 8623 } 8624 $darg->{dbh} = $cc_sourcedbh; 8625 $sync->{safe_sourcedbh} = DBIx::Safe->new($darg); 8626 } 8627 8628 $input = { 8629 sourcedbh => $sync->{safe_sourcedbh}, 8630 syncname => $sync->{name}, 8631 goatlist => $sync->{goatlist}, 8632 rellist => $sync->{goatlist}, 8633 sourcename => $sync->{sourcedb}, 8634 targetname => '', 8635 message => '', 8636 warning => '', 8637 error => '', 8638 nextcode => '', 8639 endsync => '', 8640 }; 8641 8642 $self->{masterdbh}->{InactiveDestroy} = 1; 8643 $cc_sourcedbh->{InactiveDestroy} = 1; 8644 local $_ = $input; 8645 $c->{coderef}->($input); 8646 $self->{masterdbh}->{InactiveDestroy} = 0; 8647 $cc_sourcedbh->{InactiveDestroy} = 0; 8648 $self->glog("Finished custom code $c->{name}", LOG_VERBOSE); 8649 if (length $input->{message}) { 8650 $self->glog("Message from $c->{whenrun} code $c->{name}: $input->{message}", LOG_TERSE); 8651 } 8652 if (length $input->{warning}) { 8653 $self->glog("Warning! Code $c->{whenrun} $c->{name}: $input->{warning}", LOG_WARN); 8654 } 8655 if (length $input->{error}) { 8656 $self->glog("Warning! Code $c->{whenrun} $c->{name}: $input->{error}", LOG_WARN); 8657 die "Code $c->{whenrun} $c->{name} error: $input->{error}"; 8658 } 8659 if (length $input->{nextcode}) { ## Mostly for conflict handlers 8660 return 'next'; 8661 } 8662 if (length $input->{endsync}) { 8663 $self->glog("Code $c->{whenrun} requests a cancellation of the rest of the sync", LOG_TERSE); 8664 ## before_txn and after_txn only should commit themselves 8665 $cc_sourcedbh->rollback(); 8666 $self->{masterdbh}->commit(); 8667 sleep $config{endsync_sleep}; 8668 return 'redo'; 8669 } 8670 8671 return 'normal'; 8672 8673} ## end of run_ctl_custom_code 8674 8675 8676sub create_newkid { 8677 8678 ## Fork and create a KID process 8679 ## Arguments: one 8680 ## 1. Hashref of sync information ($self->{sync}{$syncname}) 8681 ## Returns: PID of new process 8682 8683 my ($self, $kidsync) = @_; 8684 8685 ## Just in case, ask any existing kid processes to exit 8686 $self->db_notify($self->{masterdbh}, "kid_stopsync_$self->{syncname}"); 8687 8688 ## Sleep a hair so we don't have the newly created kid get the message above 8689# sleep 1; 8690 8691 ## Fork off a new process which will become the KID 8692 my $newkid = $self->fork_and_inactivate('KID'); 8693 8694 if ($newkid) { ## We are the parent 8695 my $msg = sprintf q{Created new kid %s for sync "%s"}, 8696 $newkid, $self->{syncname}; 8697 $self->glog($msg, LOG_VERBOSE); 8698 8699 ## Map this PID to a name for CTL use elsewhere 8700 $self->{pidmap}{$newkid} = 'KID'; 8701 8702 sleep $config{ctl_createkid_time}; 8703 8704 return $newkid; 8705 } 8706 8707 ## At this point, this is the kid. Make sure we do not inherit the CTL error handler: 8708 $SIG{__DIE__} = undef; 8709 8710 ## Create the kid process 8711 $self->start_kid($kidsync); 8712 8713 exit 0; 8714 8715} ## end of create_newkid 8716 8717 8718sub get_deadlock_details { 8719 8720 ## Given a database handle, extract deadlock details from it 8721 ## Arguments: two 8722 ## 1. Database handle 8723 ## 2. Database error string 8724 ## Returns: detailed string, or an empty one 8725 8726 my ($self, $dldbh, $dlerr) = @_; 8727 return '' unless $dlerr =~ /Process \d+ waits for /; 8728 return '' unless defined $dldbh and $dldbh; 8729 8730 $dldbh->rollback(); 8731 my $pid = $dldbh->{pg_pid}; 8732 while ($dlerr =~ /Process (\d+) waits for (.+) on relation (\d+) of database (\d+); blocked by process (\d+)/g) { 8733 next if $1 == $pid; 8734 my ($process,$locktype,$relation) = ($1,$2,$3); 8735 ## Fetch the relation name 8736 my $getname = $dldbh->prepare(q{SELECT nspname||'.'||relname FROM pg_class c, pg_namespace n ON (n.oid=c.relnamespace) WHERE c.oid = ?}); 8737 $getname->execute($relation); 8738 my $relname = $getname->fetchall_arrayref()->[0][0]; 8739 8740 my $clock_timestamp = $dldbh->{pg_server_version} >= 80200 8741 ? 'clock_timestamp()' : 'timeofday()::timestamptz'; 8742 8743 ## Fetch information about the conflicting process 8744 my $pidcol = $dldbh->{pg_server_version} >= 90200 ? 'pid' : 'procpid'; 8745 my $queryinfo =$dldbh->prepare(qq{ 8746SELECT 8747 current_query AS query, 8748 datname AS database, 8749 TO_CHAR($clock_timestamp, 'HH24:MI:SS (YYYY-MM-DD)') AS current_time, 8750 TO_CHAR(backend_start, 'HH24:MI:SS (YYYY-MM-DD)') AS backend_started, 8751 TO_CHAR($clock_timestamp - backend_start, 'HH24:MI:SS') AS backend_age, 8752 CASE WHEN query_start IS NULL THEN '?' ELSE 8753 TO_CHAR(query_start, 'HH24:MI:SS (YYYY-MM-DD)') END AS query_started, 8754 CASE WHEN query_start IS NULL THEN '?' ELSE 8755 TO_CHAR($clock_timestamp - query_start, 'HH24:MI:SS') END AS query_age, 8756 COALESCE(host(client_addr)::text,''::text) AS ip, 8757 CASE WHEN client_port <= 0 THEN 0 ELSE client_port END AS port, 8758 usename AS user 8759FROM pg_stat_activity 8760WHERE $pidcol = ? 8761}); 8762 $queryinfo->execute($process); 8763 my $q = $queryinfo->fetchall_arrayref({})->[0]; 8764 my $ret = qq{Deadlock on "$relname"\nLocktype: $locktype\n}; 8765 if (defined $q) { 8766 $ret .= qq{Blocker PID: $process $q->{ip} Database: $q->{database} User: $q->{user}\n}. 8767 qq{Query: $q->{query}\nQuery started: $q->{query_started} Total time: $q->{query_age}\n}. 8768 qq{Backend started: $q->{backend_started} Total time: $q->{backend_age}\n}; 8769 } 8770 return $ret; 8771 } 8772 8773 return; 8774 8775} ## end of get_deadlock_details 8776 8777 8778sub cleanup_kid { 8779 8780 ## Kid is shutting down 8781 ## Remove our PID file 8782 ## Arguments: two 8783 ## 1. Reason for leaving 8784 ## 2. Extra information 8785 ## Returns: undef 8786 8787 my ($self,$reason,$extrainfo) = @_; 8788 8789 $self->glog("Kid $$ exiting at cleanup_kid. $extrainfo Reason: $reason", LOG_TERSE); 8790 8791 ## Remove the pid file, but only if it has our PID in it! 8792 my $file = $self->{kidpidfile}; 8793 my $fh; 8794 if (! open my $fh, '<', $file) { 8795 $self->glog("Warning! Could not find pid file $file", LOG_WARN); 8796 } 8797 elsif (<$fh> !~ /(\d+)/) { 8798 $self->glog("Warning! File $file did not contain a PID", LOG_WARN); 8799 } 8800 else { 8801 my $oldpid = $1; 8802 if ($$ !~ $oldpid) { 8803 $self->glog("File $file contained foreign PID $oldpid, so will not remove", LOG_WARN); 8804 } 8805 elsif (unlink $file) { 8806 $self->glog(qq{Removed pid file $file}, LOG_DEBUG); 8807 } 8808 else { 8809 $self->glog("Warning! Failed to remove pid file $file", LOG_WARN); 8810 } 8811 } 8812 return; 8813 8814} ## end of cleanup_kid 8815 8816 8817sub store_pid { 8818 8819 ## Store the PID of the current process somewhere (e.g. local disk) 8820 ## Arguments: one 8821 ## 1. Name of the file 8822 ## Returns: complete name of the file, with directory 8823 8824 my $self = shift; 8825 my $file = shift or die; 8826 8827 ## Put this file into our pid directory 8828 my $pidfile = File::Spec->catfile( $config{piddir} => $file ); 8829 8830 ## Check for and remove old processes 8831 my $oldpid = '?'; 8832 if (-e $pidfile) { 8833 ## Send the PID in the file a USR1. If we did so, sleep a little bit 8834 ## to allow that process to clean itself up 8835 $self->signal_pid_files($pidfile) and sleep 1; 8836 if (-e $pidfile) { 8837 $self->glog("Overwriting $pidfile: old process was $oldpid", LOG_NORMAL); 8838 } 8839 } 8840 8841 ## Overwrite anything that is already there 8842 open my $pidfh, '>', $pidfile or die qq{Cannot write to $pidfile: $!\n}; 8843 print {$pidfh} "$$\n"; 8844 close $pidfh or warn qq{Could not close "$pidfile": $!\n}; 8845 $self->glog("Created $pidfile", LOG_DEBUG); 8846 8847 return $pidfile; 8848 8849} ## end of store_pid 8850 8851 8852sub table_has_rows { 8853 8854 ## See if the given table has any rows or not 8855 ## Arguments: two 8856 ## 1. Target database object (contains dbtype and possibly dbh) 8857 ## 2. Name of the table 8858 ## Returns: true or false 8859 8860 my ($self,$d,$tname) = @_; 8861 8862 my $SQL; 8863 8864 ## Some types do not have a count 8865 return 0 if $d->{does_append_only}; 8866 8867 if ($d->{does_limit}) { 8868 $SQL = "SELECT 1 FROM $tname LIMIT 1"; 8869 $sth = $d->{dbh}->prepare($SQL); 8870 $sth->execute(); 8871 $count = $sth->rows(); 8872 $sth->finish(); 8873 return $count >= 1 ? 1 : 0; 8874 } 8875 elsif ('mongo' eq $d->{dbtype}) { 8876 my $collection = $d->{dbh}->get_collection($tname); 8877 $count = $collection->count({}); 8878 return $count >= 1 ? 1 : 0; 8879 } 8880 elsif ('oracle' eq $d->{dbtype}) { 8881 $SQL = "SELECT 1 FROM $tname WHERE rownum > 1"; 8882 $sth = $d->{dbh}->prepare($SQL); 8883 $sth->execute(); 8884 $count = $sth->rows(); 8885 $sth->finish(); 8886 return $count >= 1 ? 1 : 0; 8887 } 8888 elsif ('redis' eq $d->{dbtype}) { 8889 ## No sense in returning anything here 8890 return 0; 8891 } 8892 else { 8893 die "Cannot handle database type $d->{dbtype} yet!"; 8894 } 8895 8896 return 0; 8897 8898} ## end of table_has_rows 8899 8900 8901sub get_sequence_info { 8902 8903 ## Get sequence information 8904 ## Not technically MVCC but good enough for our purposes 8905 ## Arguments: five 8906 ## 1. Database handle 8907 ## 2. Schema name 8908 ## 3. Sequence name 8909 ## 4. (optional) Name of the sync 8910 ## 5. (optional) Target database name 8911 ## Returns: hashref of information 8912 8913 ## If five arguments are given, look up the "old" information in bucardo_sequences 8914 ## With only three arguments, pull directly from the sequence 8915 8916 return; ## XXX sequence work 8917 8918 my ($self,$ldbh,$schemaname,$seqname,$syncname,$targetname) = @_; 8919 8920 my $SQL; 8921 8922 if (defined $syncname) { 8923 ## Pull "old" sequence information. May be empty. 8924 $SQL = "SELECT $sequence_columns FROM bucardo.bucardo_sequences " 8925 . ' WHERE schemaname=? AND seqname = ? AND syncname=? AND targetname=?'; 8926 $sth = $ldbh->prepare($SQL); 8927 $sth->execute($schemaname,$seqname, $syncname, $targetname); 8928 } 8929 else { 8930 ## Pull directly from a named sequence 8931 $SQL = "SELECT $sequence_columns FROM $schemaname.$seqname"; 8932 $sth = $ldbh->prepare($SQL); 8933 $sth->execute(); 8934 } 8935 8936 return $sth->fetchall_arrayref({})->[0]; 8937 8938} ## end of get_sequence_info 8939 8940 8941sub adjust_sequence { 8942 8943 ## Adjusts all sequences as needed using a "winning" source database sequence 8944 ## If changed, update the bucardo_sequences table 8945 ## Arguments: four 8946 ## 1. goat object (which contains 'winning_db' and 'sequenceinfo') 8947 ## 2. sync object 8948 ## 2. Schema name 8949 ## 3. Sequence name 8950 ## 4. Name of the current sync 8951 ## Returns: number of changes made for this sequence 8952 8953 my ($self,$g,$sync,$S,$T,$syncname) = @_; 8954 8955 my $SQL; 8956 8957 ## Total changes made across all databases 8958 my $changes = 0; 8959 8960 my $winner = $g->{winning_db}; 8961 8962 my $sourceinfo = $g->{sequenceinfo}{$winner}; 8963 8964 ## Walk through all Postgres databases and set the sequence 8965 for my $dbname (sort keys %{ $sync->{db} }) { 8966 8967 next if $dbname eq $winner; ## Natch 8968 8969 my $d = $sync->{db}{$dbname}; 8970 8971 next if $d->{dbtype} ne 'postgres'; 8972 8973 next if ! $d->{adjustsequence}; 8974 8975 ## Reset the flag in case this sub is called more than once 8976 $d->{adjustsequence} = 0; 8977 8978 my $targetinfo = $g->{sequenceinfo}{$dbname} || {}; 8979 8980 ## First, change things up via SETVAL if needed 8981 if (! exists $targetinfo->{last_value} 8982 or 8983 $sourceinfo->{last_value} != $targetinfo->{last_value} 8984 or 8985 $sourceinfo->{is_called} != $targetinfo->{is_called}) { 8986 $self->glog("Set sequence $dbname.$S.$T to $sourceinfo->{last_value} (is_called to $sourceinfo->{is_called})", 8987 LOG_DEBUG); 8988 $SQL = qq{SELECT setval('$S.$T', $sourceinfo->{last_value}, '$sourceinfo->{is_called}')}; 8989 $d->{dbh}->do($SQL); 8990 $changes++; 8991 } 8992 8993 ## Then, change things up via ALTER SEQUENCE if needed 8994 my @alter; 8995 for my $col (@sequence_columns) { 8996 my ($name,$syntax) = @$col; 8997 8998 ## Skip things not set by ALTER SEQUENCE 8999 next if ! $syntax; 9000 9001 ## Older versions may not have all the fields! 9002 next if ! exists $sourceinfo->{$name} or ! exists $targetinfo->{$name}; 9003 9004 ## Skip if these items are the exact same 9005 next if $sourceinfo->{$name} eq $targetinfo->{$name}; 9006 9007 ## Fullcopy will not have this, and we won't report it 9008 if (exists $targetinfo->{$name}) { 9009 $self->glog("Sequence $S.$T has a different $name value: was $targetinfo->{$name}, now $sourceinfo->{$name}", LOG_VERBOSE); 9010 } 9011 9012 ## If this is a boolean setting, we want to simply prepend a 'NO' for false 9013 if ($syntax =~ s/BOOL //) { 9014 push @alter => sprintf '%s%s', 9015 $sourceinfo->{$name} ? '' : 'NO ', 9016 $syntax; 9017 } 9018 else { 9019 push @alter => "$syntax $sourceinfo->{$name}"; 9020 } 9021 $changes++; 9022 9023 } ## end each sequence column 9024 9025 if (@alter) { 9026 $SQL = "ALTER SEQUENCE $S.$T "; 9027 $SQL .= join ' ' => @alter; 9028 $self->glog("Running on target $dbname: $SQL", LOG_DEBUG); 9029 $d->{dbh}->do($SQL); 9030 } 9031 9032 } ## end each database 9033 9034 return $changes; 9035 9036} ## end of adjust_sequence 9037 9038 9039sub run_kid_custom_code { 9040 9041 ## Prepare and then run the custom code subroutine 9042 ## Arguments: two 9043 ## 1. Sync information 9044 ## 2. This code information 9045 ## Returns: status code, one of 'redo', 'last', 'retry', or 'normal' 9046 ## May also throw an exception if the calling code requests it 9047 9048 my $self = shift; 9049 my $sync = shift; 9050 my $c = shift; 9051 9052 $self->glog("Running $c->{whenrun} custom code $c->{id}: $c->{name}", LOG_NORMAL); 9053 9054 ## Allow the caller to maintain some state by providing a hash 9055 if (! exists $self->{kid_customcode_shared}) { 9056 $self->{kid_customcode_shared} = {}; 9057 } 9058 9059 ## Create a hash of information common to all customcodes 9060 my $info = { 9061 rows => $sync->{deltarows}, 9062 syncname => $sync->{name}, 9063 version => $self->{version}, ## Version of Bucardo 9064 9065 message => '', ## Allows the code to send a message to the logs 9066 warning => '', ## Allows a warning to be thrown by the code 9067 error => '', ## Allows an exception to be thrown by the code 9068 skip => '', ## Tells the caller to skip this code 9069 lastcode => '', ## Tells the caller to skip any other codes of this type 9070 endsync => '', ## Tells the caller to cancel the whole sync 9071 sendmail => sub { $self->send_mail(@_) }, 9072 shared => $self->{kid_customcode_shared}, 9073 }; 9074 9075 ## Add in any items custom to this code 9076 if (exists $c->{info}) { 9077 for my $key (keys %{ $c->{info} }) { 9078 $info->{$key} = $c->{info}{$key}; 9079 } 9080 delete $c->{info}; 9081 } 9082 9083 ## Make a copy of what we send them, so we can safely pull back info later 9084 my $infocopy = {}; 9085 for (keys %$info) { 9086 $infocopy->{$_} = $info->{$_}; 9087 } 9088 9089 ## If they need database handles, provide them 9090 if ($c->{getdbh}) { 9091 my $strict = ($c->{whenrun} eq 'before_txn' or $c->{whenrun} eq 'after_txn') ? 1 : 0; 9092 for my $dbname (keys %{ $sync->{db} }) { 9093 $info->{dbh}{$dbname} = $strict ? $self->{safe_dbh}{$dbname} 9094 : $self->{safe_dbh_strict}{$dbname}; 9095 } 9096 } 9097 9098 ## Set all databases' InactiveDestroy to on, so the customcode doesn't mess things up 9099 for my $dbname (keys %{ $sync->{db} }) { 9100 $sync->{db}{$dbname}{dbh}->{InactiveDestroy} = 1; 9101 } 9102 9103 ## Run the actual code! 9104 local $_ = $info; 9105 $c->{coderef}->($info); 9106 9107 $self->glog("Finished custom code $c->{name}", LOG_VERBOSE); 9108 9109 for my $dbname (keys %{ $sync->{db} }) { 9110 $sync->{db}{$dbname}{dbh}->{InactiveDestroy} = 0; 9111 } 9112 9113 ## Check for any messages set by the custom code 9114 if (length $info->{message}) { 9115 $self->glog("Message from $c->{whenrun} code $c->{name}: $info->{message}", LOG_TERSE); 9116 } 9117 9118 ## Check for any warnings set by the custom code 9119 if (length $info->{warning}) { 9120 $self->glog("Warning! Code $c->{whenrun} $c->{name}: $info->{warning}", LOG_WARN); 9121 } 9122 9123 ## Check for any errors set by the custom code. Throw an exception if found. 9124 if (length $info->{error}) { 9125 $self->glog("Warning! Code $c->{whenrun} $c->{name}: $info->{error}", LOG_WARN); 9126 die "Code $c->{whenrun} $c->{name} error: $info->{error}"; 9127 } 9128 9129 ## Check for a request to end the sync. 9130 ## If found, rollback, adjust the Q, and redo the kid 9131 if (length $info->{endsync}) { 9132 $self->glog("Code $c->{whenrun} requests a cancellation of the rest of the sync", LOG_TERSE); 9133 ## before_txn and after_txn should commit themselves 9134 for my $dbname (keys %{ $sync->{db} }) { 9135 $sync->{db}{$dbname}{dbh}->rollback(); 9136 } 9137 my $syncname = $infocopy->{syncname}; 9138 my $targetname = $infocopy->{targetname}; 9139 $sth{qend}->execute(0,0,0,$syncname,$targetname,$$); 9140 my $notify = "bucardo_syncdone_${syncname}_$targetname"; 9141 my $maindbh = $self->{masterdbh}; 9142 $self->db_notify($maindbh, $notify); 9143 sleep $config{endsync_sleep}; 9144 return 'redo'; 9145 } 9146 9147 ## The custom code has requested we retry this sync (exception code only) 9148 if (exists $info->{retry} and $info->{retry}) { 9149 return 'retry'; 9150 } 9151 9152 ## The custom code has requested we don't call any other codes of the same type 9153 if (length $info->{lastcode}) { 9154 return 'last'; 9155 } 9156 9157 ## The custom code has requested we skip this code (and let any others try) 9158 if (length $info->{skip}) { 9159 return 'skip'; 9160 } 9161 9162 ## Four cases for handling conflicts: 9163 ## The customcode has told us how to handle this table 9164 ## The customcode has told us how to handle this table until a sync restart 9165 ## The customcode has told us how to handle all tables in the sync 9166 ## The customcode has told us how to handle all tables in the sync until a sync restart 9167 for my $case (qw/ tablewinner tablewinner_always syncwinner syncwinner_always /) { 9168 if (exists $info->{$case}) { 9169 return "$case: $info->{$case}"; 9170 } 9171 } 9172 9173 ## Default action, which usually means the next code in the list, if any 9174 return 'normal'; 9175 9176} ## end of run_kid_custom_code 9177 9178 9179sub truncate_table { 9180 9181 ## Given a table, attempt to truncate it 9182 ## Arguments: three 9183 ## 1. Database object 9184 ## 2. Table object 9185 ## 3. Boolean if we should CASCADE the truncate or not 9186 ## Returns: true if the truncate succeeded without error, false otherwise 9187 9188 my ($self, $Database, $Table, $does_cascade) = @_; 9189 9190 my $SQL; 9191 9192 ## Override any existing handlers so we can cleanly catch the eval 9193 local $SIG{__DIE__} = sub {}; 9194 9195 my $tablename = exists $Table->{tablename} ? $Table->{tablename} : "$Table->{safeschema}.$Table->{safetable}"; 9196 9197 if ($Database->{does_sql}) { 9198 if ($Database->{does_savepoints}) { 9199 $Database->{dbh}->do('SAVEPOINT truncate_attempt'); 9200 } 9201 $SQL = sprintf 'TRUNCATE TABLE %s%s', 9202 $tablename, 9203 ($does_cascade and $Database->{does_cascade}) ? ' CASCADE' : ''; 9204 my $truncate_ok = 0; 9205 9206 eval { 9207 $Database->{dbh}->do($SQL); 9208 $truncate_ok = 1; 9209 }; 9210 if (! $truncate_ok) { 9211 $Database->{does_savepoints} and $Database->{dbh}->do('ROLLBACK TO truncate_attempt'); 9212 $self->glog("Truncate error for db $Database->{name}.$Database->{dbname}.$tablename: $@", LOG_NORMAL); 9213 return 0; 9214 } 9215 else { 9216 $Database->{does_savepoints} and $Database->{dbh}->do('RELEASE truncate_attempt'); 9217 return 1; 9218 } 9219 } 9220 9221 if ('mongo' eq $Database->{dbtype}) { 9222 my $collection = $Database->{dbh}->get_collection($tablename); 9223 $self->{oldmongo} ? $collection->remove({}, { safe => 1} ): $collection->delete_many({}, { safe => 1} ); 9224 return 1; 9225 } 9226 9227 elsif ('redis' eq $Database->{dbtype}) { 9228 ## No real equivalent here, as we do not map tables 1:1 to redis keys 9229 ## In theory, we could walk through all keys and delete ones that match the table 9230 ## We will hold off until someone actually needs that, however :) 9231 return 1; 9232 } 9233 9234 return undef; 9235 9236} ## end of truncate_table 9237 9238 9239sub delete_table { 9240 9241 ## Given a table, attempt to unconditionally delete rows from it 9242 ## Arguments: two 9243 ## 1. Database object 9244 ## 2. Table object 9245 ## Returns: number of rows deleted 9246 9247 my ($self, $d, $Table) = @_; 9248 9249 my $tablename = exists $Table->{tablename} ? $Table->{tablename} : "$Table->{safeschema}.$Table->{safetable}"; 9250 9251 my $count = 0; 9252 9253 if ($d->{does_sql}) { 9254 ($count = $d->{dbh}->do("DELETE FROM $tablename")) =~ s/0E0/0/o; 9255 } 9256 elsif ('mongo' eq $d->{dbtype}) { 9257 ## Same as truncate, really, except we return the number of rows 9258 my $collection = $d->{dbh}->get_collection($tablename); 9259 if ($self->{oldmongo}) { 9260 my $res = $collection->remove({}, { safe => 1} ); 9261 $count = $res->{n}; 9262 } 9263 else { 9264 my $res = $collection->delete_many({}, { safe => 1} ); 9265 $count = $res->{deleted_count}; 9266 } 9267 } 9268 elsif ('redis' eq $d->{dbtype}) { 9269 ## Nothing relevant here, as the table is only part of the key name 9270 } 9271 else { 9272 die "Do not know how to delete a dbtype of $d->{dbtype}"; 9273 } 9274 9275 return $count; 9276 9277} ## end of delete_table 9278 9279 9280sub delete_rows { 9281 9282 ## Given a list of rows, delete them from a table in one or more databases 9283 ## Arguments: four 9284 ## 1. Hashref of rows to delete, where the keys are the primary keys (\0 joined if multi). 9285 ## 2. Table object 9286 ## 3. Sync object 9287 ## 4. Target database object (or an arrayref of the same) 9288 ## Returns: number of rows deleted 9289 9290 my ($self,$rows,$Table,$Sync,$TargetDB) = @_; 9291 9292 ## Have we already truncated this table? If yes, skip and reset the flag 9293 if (exists $Table->{truncatewinner}) { 9294 return 0; 9295 } 9296 9297 my ($S,$T) = ($Table->{safeschema},$Table->{safetable}); 9298 9299 my $syncname = $Sync->{name}; 9300 my $pkcols = $Table->{pkeycols}; 9301 my $pkcolsraw = $Table->{pkeycolsraw}; 9302 9303 ## Ensure the target database argument is always an array 9304 if (ref $TargetDB ne 'ARRAY') { 9305 $TargetDB = [$TargetDB]; 9306 } 9307 9308 ## We may be going from one table to another - this is the mapping hash 9309 my $customname = $Table->{newname}{$syncname} || {}; 9310 9311 ## Are we truncating? 9312 if (exists $self->{truncateinfo} and exists $self->{truncateinfo}{$S}{$T}) { 9313 9314 ## Try and truncate each target 9315 for my $Target (@$TargetDB) { 9316 9317 my $target_tablename = $customname->{$Target->{name}}; 9318 9319 my $type = $Target->{dbtype}; 9320 9321 ## Postgres is a plain and simple TRUNCATE, with an async flag 9322 ## TRUNCATE CASCADE is not needed as everything should be in one 9323 ## sync (herd), and we have turned all FKs off 9324 if ('postgres' eq $type) { 9325 $Target->{dbh}->do("$self->{sqlprefix}TRUNCATE table $target_tablename", { pg_async => PG_ASYNC }); 9326 $Target->{async_active} = time; 9327 } 9328 ## For all other SQL databases, we simply truncate 9329 elsif ($Target->{does_sql}) { 9330 $Target->{dbh}->do("$self->{sqlprefix}TRUNCATE TABLE $target_tablename"); 9331 } 9332 ## For MongoDB, we simply remove everything from the collection 9333 ## This keeps the indexes around (which is why we don't "drop") 9334 elsif ('mongo' eq $type) { 9335 my $collection = $Target->{dbh}->get_collection($target_tablename); 9336 $collection->remove({}, { safe => 1 } ); 9337 } 9338 ## For flatfiles, write out a basic truncate statement 9339 elsif ($type =~ /flat/o) { 9340 printf {$Target->{filehandle}} qq{TRUNCATE TABLE $target_tablename;\n\n}; 9341 $self->glog(qq{Appended truncate command to flatfile "$Target->{filename}"}, LOG_VERBOSE); 9342 } 9343 elsif ('redis' eq $type) { 9344 ## For Redis, do nothing 9345 } 9346 ## Safety valve: 9347 else { 9348 die qq{Do not know how to do truncate for type $type!\n}; 9349 } 9350 9351 } ## end each target to be truncated 9352 9353 ## Final cleanup for each target 9354 for my $Target (@$TargetDB) { 9355 if ('postgres' eq $Target->{dbtype}) { 9356 ## Wait for the async truncate call to finish 9357 $Target->{dbh}->pg_result(); 9358 $Target->{async_active} = 0; 9359 } 9360 } 9361 9362 ## We do not know how many rows were actually truncated 9363 return 0; 9364 9365 } ## end truncation 9366 9367 ## We may want to break the SQL into separate statements if there are lots of keys 9368 my $chunksize = $config{statement_chunk_size} || $default_statement_chunk_size; 9369 9370 ## The number of primary keys this table has affects our SQL 9371 my $numpks = $Table->{numpkcols}; 9372 9373 ## Setup our deletion SQL as needed 9374 my %SQL; 9375 for my $Target (@$TargetDB) { 9376 9377 my $type = $Target->{dbtype}; 9378 9379 ## Track the number of rows actually deleted from this target 9380 $Target->{deleted_rows} = 0; 9381 9382 ## Set to true when all rounds completed 9383 $Target->{delete_complete} = 0; 9384 9385 ## No special preparation for mongo or redis 9386 next if $type =~ /mongo|redis/; 9387 9388 ## The actual target table name: may differ from the source! 9389 my $target_tablename = $customname->{$Target->{name}}; 9390 9391 if ('firebird' eq $type) { 9392 $Table->{pklist} =~ s/\"//g; ## not ideal: fix someday 9393 $Table->{pklist} = uc $Table->{pklist}; 9394 $target_tablename = qq{"$target_tablename"} if $target_tablename !~ /"/; 9395 } 9396 9397 ## Set the type of SQL we are using: IN vs ANY. Default is IN 9398 ## Use of ANY is greatly preferred, but can only use if the 9399 ## underlying database supports it, and if we have a single column pk 9400 my $sqltype = ($Target->{does_ANY_clause} and 1==$numpks) ? 'ANY' : 'IN'; 9401 9402 ## Internal counters to help us break queries into chunks if needed 9403 my ($round, $roundtotal) = (0,0); 9404 9405 ## Array to store each chunk of SQL 9406 my @chunk; 9407 ## Optimization for a single primary key using ANY(?) 9408 if ('ANY' eq $sqltype and ! exists $SQL{ANY}{$target_tablename}) { 9409 $SQL{ANY}{$target_tablename} = "$self->{sqlprefix}DELETE FROM $target_tablename WHERE $pkcols = ANY(?)"; 9410 for my $key (keys %$rows) { 9411 push @{$chunk[$round]} => length $key ? ([split '\0', $key, -1]) : ['']; 9412 if (++$roundtotal >= $chunksize) { 9413 $roundtotal = 0; 9414 $round++; 9415 } 9416 } 9417 $SQL{ANYargs} = \@chunk; 9418 } 9419 ## Normal DELETE call with IN() clause 9420 elsif ('IN' eq $sqltype and ! exists $SQL{IN}{$target_tablename}) { 9421 $SQL{IN}{$target_tablename} = sprintf '%sDELETE FROM %s WHERE (%s) IN (', 9422 $self->{sqlprefix}, 9423 $target_tablename, 9424 $Table->{pklist}; 9425 my $inner; 9426 if ($Target->{has_mysql_timestamp_issue}) { 9427 for my $key (keys %$rows) { 9428 $inner = length $key 9429 ? (join ',' => map { s/\'/''/go; s{\\}{\\\\}; s/\+\d\d$//; qq{'$_'}; } split '\0', $key, -1) 9430 : q{''}; 9431 $chunk[$round] .= "($inner),"; 9432 if (++$roundtotal >= $chunksize) { 9433 $roundtotal = 0; 9434 $round++; 9435 } 9436 } 9437 } 9438 else { 9439 for my $key (keys %$rows) { 9440 $inner = length $key 9441 ? (join ',' => map { s/\'/''/go; s{\\}{\\\\}; qq{'$_'}; } split '\0', $key, -1) 9442 : q{''}; 9443 $chunk[$round] .= "($inner),"; 9444 if (++$roundtotal >= $chunksize) { 9445 $roundtotal = 0; 9446 $round++; 9447 } 9448 } 9449 } 9450 ## Cleanup 9451 for (@chunk) { 9452 chop; 9453 $_ = "$SQL{IN}{$target_tablename} $_)"; 9454 } 9455 $SQL{IN}{$target_tablename} = \@chunk; 9456 } 9457 9458 $Target->{delete_rounds} = @chunk; 9459 9460 ## If we bypassed because of a cached version, use the cached delete_rounds too 9461 if ('ANY' eq $sqltype) { 9462 if (exists $SQL{ANYrounds}{$target_tablename}) { 9463 $Target->{delete_rounds} = $SQL{ANYrounds}{$target_tablename}; 9464 } 9465 else { 9466 $SQL{ANYrounds}{$target_tablename} = $Target->{delete_rounds}; 9467 } 9468 } 9469 elsif ('IN' eq $sqltype) { 9470 if (exists $SQL{INrounds}{$target_tablename}) { 9471 $Target->{delete_rounds} = $SQL{INrounds}{$target_tablename}; 9472 } 9473 else { 9474 $SQL{INrounds}{$target_tablename} = $Target->{delete_rounds}; 9475 } 9476 } 9477 9478 ## Empty our internal tracking items that may have been set previously 9479 $Target->{delete_round} = 0; 9480 delete $Target->{delete_sth}; 9481 9482 } ## end each Target 9483 9484 ## Start the main deletion loop 9485 ## The idea is to be efficient as possible by always having as many 9486 ## async targets running as possible. We run one non-async at a time 9487 ## before heading back to check on the asyncs. 9488 9489 my $done = 0; 9490 my $did_something; 9491 while (!$done) { 9492 9493 $did_something = 0; 9494 9495 ## Wrap up any async targets that have finished 9496 for my $Target (@$TargetDB) { 9497 next if ! $Target->{async_active} or $Target->{delete_complete}; 9498 if ('postgres' eq $Target->{dbtype}) { 9499 if ($Target->{dbh}->pg_ready) { 9500 ## If this was a do(), we already have the number of rows 9501 if (1 == $numpks) { 9502 $Target->{deleted_rows} += $Target->{dbh}->pg_result(); 9503 } 9504 else { 9505 $Target->{dbh}->pg_result(); 9506 } 9507 $Target->{async_active} = 0; 9508 } 9509 } 9510 ## Don't need to check for invalid types: happens on the kick off below 9511 } 9512 9513 ## Kick off all dormant async targets 9514 for my $Target (@$TargetDB) { 9515 9516 ## Skip if this target does not support async, or is in the middle of a query 9517 next if ! $Target->{does_async} or $Target->{async_active} or $Target->{delete_complete}; 9518 9519 ## The actual target name 9520 my $target_tablename = $customname->{$Target->{name}}; 9521 9522 if ('postgres' eq $Target->{dbtype}) { 9523 9524 ## Which chunk we are processing. 9525 $Target->{delete_round}++; 9526 if ($Target->{delete_round} > $Target->{delete_rounds}) { 9527 $Target->{delete_complete} = 1; 9528 next; 9529 } 9530 my $dbname = $Target->{name}; 9531 $self->glog("Deleting from target $dbname.$target_tablename (round $Target->{delete_round} of $Target->{delete_rounds})", LOG_DEBUG); 9532 9533 $did_something++; 9534 9535 ## Single primary key, so delete using the ANY(?) format 9536 if (1 == $numpks) { 9537 ## Use the or-equal so we only prepare this once 9538 $Target->{delete_sth} ||= $Target->{dbh}->prepare("$SQL{ANY}{$target_tablename}", { pg_async => PG_ASYNC }); 9539 $Target->{delete_sth}->execute($SQL{ANYargs}->[$Target->{delete_round}-1]); 9540 } 9541 ## Multiple primary keys, so delete old school via IN ((x,y),(a,b)) 9542 else { 9543 my $pre = $Target->{delete_rounds} > 1 ? "/* $Target->{delete_round} of $Target->{delete_rounds} */ " : ''; 9544 ## The pg_direct tells DBD::Pg there are no placeholders, and to use PQexec directly 9545 $Target->{deleted_rows} += $Target->{dbh}-> 9546 do($pre.$SQL{IN}{$target_tablename}->[$Target->{delete_round}-1], { pg_async => PG_ASYNC, pg_direct => 1 }); 9547 } 9548 9549 $Target->{async_active} = time; 9550 } ## end postgres 9551 else { 9552 die qq{Do not know how to do async for type $Target->{dbtype}!\n}; 9553 } 9554 9555 } ## end all async targets 9556 9557 ## Kick off a single non-async target 9558 for my $Target (@$TargetDB) { 9559 9560 ## Skip if this target is async, or has no more rounds 9561 next if $Target->{does_async} or $Target->{delete_complete}; 9562 9563 $did_something++; 9564 9565 my $type = $Target->{dbtype}; 9566 9567 ## The actual target name 9568 my $target_tablename = $customname->{$Target->{name}}; 9569 9570 $self->glog("Deleting from target $target_tablename (type=$type)", LOG_DEBUG); 9571 9572 if ('firebird' eq $type) { 9573 $target_tablename = qq{"$target_tablename"} if $target_tablename !~ /"/; 9574 } 9575 9576 if ('mongo' eq $type) { 9577 9578 ## Set the collection 9579 $Target->{collection} = $Target->{dbh}->get_collection($target_tablename); 9580 9581 ## Because we may have multi-column primary keys, and each key may need modifying, 9582 ## we have to put everything into an array of arrays. 9583 ## The first level is the primary key number, the next is the actual values 9584 my @delkeys = []; 9585 9586 ## The pkcolsraw variable is a simple comma-separated list of PK column names 9587 ## The rows variable is a hash with the PK values as keys (the values can be ignored) 9588 9589 ## Binary PKs are easy: all we have to do is decode 9590 ## We can assume that binary PK means not a multi-column PK 9591 if ($Table->{hasbinarypkey}) { 9592 @{ $delkeys[0] } = map { decode_base64($_) } keys %$rows; 9593 } 9594 else { 9595 9596 ## Break apart the primary keys into an array of arrays 9597 my @fullrow = map { length($_) ? [split '\0', $_, -1] : [''] } keys %$rows; 9598 9599 ## Which primary key column we are currently using 9600 my $pknum = 0; 9601 9602 ## Walk through each column making up the primary key 9603 for my $realpkname (split /,/, $pkcolsraw, -1) { 9604 9605 ## Grab what type this column is 9606 ## We need to map non-strings to correct types as best we can 9607 my $ctype = $Table->{columnhash}{$realpkname}{ftype}; 9608 9609 ## For integers, we simply force to a Perlish int 9610 if ($ctype =~ /smallint|integer|bigint/o) { 9611 @{ $delkeys[$pknum] } = map { int $_->[$pknum] } @fullrow; 9612 } 9613 ## Non-integer numbers get set via the strtod command from the 'POSIX' module 9614 elsif ($ctype =~ /real|double|numeric/o) { 9615 @{ $delkeys[$pknum] } = map { strtod $_->[$pknum] } @fullrow; 9616 } 9617 ## Boolean becomes true Perlish booleans via the 'boolean' module 9618 elsif ($ctype eq 'boolean') { 9619 @{ $delkeys[$pknum] } = map { $_->[$pknum] eq 't' ? boolean->true : boolean->false } @fullrow; 9620 } 9621 ## Everything else gets a direct mapping 9622 else { 9623 @{ $delkeys[$pknum] } = map { $_->[$pknum] } @fullrow; 9624 } 9625 $pknum++; 9626 } 9627 } ## end of multi-column PKs 9628 9629 ## We may need to batch these to keep the total message size reasonable 9630 my $max = keys %$rows; 9631 $max--; 9632 9633 ## The bottom of our current array slice 9634 my $bottom = 0; 9635 9636 ## This loop limits the size of our delete requests to mongodb 9637 MONGODEL: { 9638 ## Calculate the current top of the array slice 9639 my $top = $bottom + $chunksize; 9640 9641 ## Stop at the total number of rows 9642 $top = $max if $top > $max; 9643 9644 ## If we have a single key, we can use the '$in' syntax 9645 if ($numpks <= 1) { 9646 my @newarray = @{ $delkeys[0] }[$bottom..$top]; 9647 if ($self->{oldmongo}) { 9648 my $res = $Target->{collection}->remove( {$pkcolsraw => { '$in' => \@newarray }}, { safe => 1 }); 9649 $Target->{deleted_rows} += $res->{n}; 9650 } 9651 else { 9652 my $res = $Target->{collection}->delete_many( {$pkcolsraw => { '$in' => \@newarray }}, { safe => 1 }); 9653 $Target->{deleted_rows} += $res->{deleted_count}; 9654 } 9655 } 9656 else { 9657 ## For multi-column primary keys, we cannot use '$in', sadly. 9658 ## Thus, we will just call delete once per row 9659 9660 ## Put the names into an easy to access array 9661 my @realpknames = split /,/, $pkcolsraw, -1; 9662 9663 my @find; 9664 9665 ## Which row we are currently processing 9666 my $numrows = scalar keys %$rows; 9667 for my $rownumber (0..$numrows-1) { 9668 for my $pknum (0..$numpks-1) { 9669 push @find => $realpknames[$pknum], $delkeys[$pknum][$rownumber]; 9670 } 9671 } 9672 9673 if ($self->{oldmongo}) { 9674 my $res = $Target->{collection}->remove( { '$and' => \@find }, { safe => 1 }); 9675 $Target->{deleted_rows} += $res->{n}; 9676 } 9677 else { 9678 my $res = $Target->{collection}->delete_many( { '$and' => \@find }, { safe => 1 }); 9679 $Target->{deleted_rows} += $res->{deleted_count}; 9680 } 9681 9682 ## We do not need to loop, as we just went 1 by 1 through the whole list 9683 last MONGODEL; 9684 9685 } 9686 9687 ## Bail out of the loop if we've hit the max 9688 last MONGODEL if $top >= $max; 9689 9690 ## Assign the bottom of our array slice to be above the current top 9691 $bottom = $top + 1; 9692 9693 redo MONGODEL; 9694 } 9695 9696 $self->glog("Mongo objects removed from $target_tablename: $Target->{deleted_rows}", LOG_VERBOSE); 9697 } 9698 elsif ('mysql' eq $type or 'drizzle' eq $type or 'mariadb' eq $type 9699 or 'oracle' eq $type or 'sqlite' eq $type or 'firebird' eq $type) { 9700 my $tdbh = $Target->{dbh}; 9701 for (@{ $SQL{IN}{$target_tablename} }) { 9702 $Target->{deleted_rows} += $tdbh->do($_); 9703 } 9704 } 9705 elsif ('redis' eq $type) { 9706 ## We need to remove the entire tablename:pkey:column for each column we know about 9707 my $cols = $Table->{cols}; 9708 for my $pk (keys %$rows) { 9709 ## If this is a multi-column primary key, change our null delimiter to a colon 9710 if ($Table->{numpkcols} > 1) { 9711 $pk =~ s{\0}{:}go; 9712 } 9713 $Target->{deleted_rows} += $Target->{dbh}->del("$target_tablename:$pk"); 9714 } 9715 } 9716 elsif ($type =~ /flat/o) { ## same as flatpg for now 9717 for (@{ $SQL{IN}{$target_tablename} }) { 9718 print {$Target->{filehandle}} qq{$_;\n\n}; 9719 } 9720 $self->glog(qq{Appended to flatfile "$Target->{filename}"}, LOG_VERBOSE); 9721 } 9722 else { 9723 die qq{No support for database type "$type" yet!}; 9724 } 9725 9726 $Target->{delete_complete} = 1; 9727 9728 ## Only one target at a time, please: we need to check on the asyncs 9729 last; 9730 9731 } ## end async target 9732 9733 ## If we did nothing this round, and there are no asyncs running, we are done. 9734 ## Otherwise, we will wait for the oldest async to finish 9735 if (!$did_something) { 9736 if (! grep { $_->{async_active} } @$TargetDB) { 9737 $done = 1; 9738 } 9739 else { 9740 ## Since nothing else is going on, let's wait for the oldest async to finish 9741 my $Target = ( sort { $a->{async_active} > $b->{async_active} } grep { $_->{async_active} } @$TargetDB)[0]; 9742 if (1 == $numpks) { 9743 $Target->{deleted_rows} += $Target->{dbh}->pg_result(); 9744 } 9745 else { 9746 $Target->{dbh}->pg_result(); 9747 } 9748 $Target->{async_active} = 0; 9749 } 9750 } 9751 9752 } ## end of main deletion loop 9753 9754 ## Generate our final deletion counts 9755 my $rows_deleted = 0; 9756 9757 for my $Target (@$TargetDB) { 9758 9759 ## We do not delete from certain types of targets 9760 next if $Target->{dbtype} =~ /mongo|flat|redis/o; 9761 9762 my $target_tablename = $customname->{$Target->{name}}; 9763 9764 $rows_deleted += $Target->{deleted_rows}; 9765 $self->glog(qq{Rows deleted from $Target->{name}.$target_tablename: $Target->{deleted_rows}}, LOG_VERBOSE); 9766 } 9767 9768 return $rows_deleted; 9769 9770} ## end of delete_rows 9771 9772 9773sub push_rows { 9774 9775 ## Copy rows from one table to others 9776 ## Typically called after delete_rows() 9777 ## Arguments: six 9778 ## 1. Hashref of rows to copy, where the keys are the primary keys (\0 joined if multi). Can be empty. 9779 ## 2. Table object 9780 ## 3. Sync object (may be empty if we are not associated with a sync) 9781 ## 4. Source database object 9782 ## 5. Target database object (or an arrayref of the same) 9783 ## 6. Action mode - currently only 'copy' and 'fullcopy' 9784 ## Returns: number of rows copied (to each target, not the total) 9785 9786 my ($self,$rows,$Table,$Sync,$SourceDB,$TargetDB,$mode) = @_; 9787 9788 my $SQL; 9789 9790 ## This will be zero for fullcopy of course 9791 my $total_rows = keys %$rows; 9792 9793 if (!$total_rows and $mode ne 'fullcopy') { 9794 return 0; ## Can happen on a truncation 9795 } 9796 9797 my $numpks = $Table->{numpkcols}; 9798 9799 ## If there are a large number of rows (and we are not using ANY) break the statement up 9800 my $chunksize = $config{statement_chunk_size} || $default_statement_chunk_size; 9801 9802 ## Build a list of all PK values to feed to IN clauses 9803 ## This is an array in case we go over $chunksize 9804 my @pkvals = []; 9805 9806 ## If there is only one primary key, and a sane number of rows, we can use '= ANY(?)' 9807 if ($mode ne 'fullcopy') { 9808 if ($numpks == 1 and $total_rows <= $chunksize) { 9809 $mode = 'anyclause'; 9810 } 9811 ## Otherwise, we split up the primary key values into bins 9812 else { 9813 my $pk_array_number = 0; 9814 my $current_row = 1; 9815 9816 ## Loop through each row and create the needed SQL fragment 9817 for my $key (keys %$rows) { 9818 9819 push @{ $pkvals[$pk_array_number] ||= [] } => split '\0', $key, -1; 9820 9821 ## Make sure our SQL statement doesn't grow too large 9822 if (++$current_row > $chunksize) { 9823 $current_row = 1; 9824 $pk_array_number++; 9825 } 9826 } 9827 } 9828 } 9829 9830 my $syncname = $Sync->{name} || ''; 9831 9832 ## Make sure TargetDB is an arrayref (may come as a single TargetDB object) 9833 if (ref $TargetDB ne 'ARRAY') { 9834 $TargetDB = [$TargetDB]; 9835 } 9836 9837 ## Figure out the different SELECT clauses, and assign targets to them 9838 my %srccmd; 9839 for my $Target (@$TargetDB ) { 9840 9841 ## The SELECT clause we use (usually an empty string unless customcols is being used) 9842 my $select_clause = $Table->{newcols}{$syncname}{$Target->{name}} || ''; 9843 9844 ## Associate this target with this clause 9845 push @{$srccmd{$select_clause}} => $Target; 9846 } 9847 9848 ## We may want to change the target table based on the customname table 9849 ## It is up to the caller to populate these, even if the syncname is '' 9850 my $customname = $Table->{newname}{$syncname} || {}; 9851 9852 ## Name of the table to copy. Only Postgres can be used as a source 9853 my $source_tablename = "$Table->{safeschema}.$Table->{safetable}"; 9854 my $sourcedbh = $SourceDB->{dbh}; 9855 9856 ## Actual number of source rows read and copied. May be less than $total_rows 9857 my $source_rows_read = 0; 9858 9859 ## Loop through each select command and push it out to all targets that are associated with it 9860 for my $select_clause (sort keys %srccmd) { 9861 9862 ## Build the clause (cache) and kick it off 9863 my $SELECT = $select_clause || 'SELECT *'; 9864 9865 ## Prepare each target that is using this select clause 9866 for my $Target (@{ $srccmd{$select_clause} }) { 9867 9868 ## Internal name of this target 9869 my $targetname = $Target->{name}; 9870 9871 ## The actual target table name. Depends on dbtype and customname table entries 9872 my $target_tablename = $customname->{$targetname}; 9873 9874 ## The columns we are pushing to, both as an arrayref and a CSV: 9875 my $cols = $Table->{tcolumns}{$SELECT}; 9876 my $columnlist = $Target->{does_sql} ? 9877 ('(' . (join ',', map { $Target->{dbh}->quote_identifier($_) } @$cols) . ')') 9878 : ('(' . (join ',', map { $_ } @$cols) . ')'); 9879 9880 my $type = $Target->{dbtype}; 9881 9882 ## Using columnlist avoids worrying about the order of columns 9883 9884 if ('postgres' eq $type) { 9885 my $tgtcmd = "$self->{sqlprefix}COPY $target_tablename$columnlist FROM STDIN"; 9886 $Target->{dbh}->do($tgtcmd); 9887 } 9888 elsif ('firebird' eq $type) { 9889 $columnlist =~ s/\"//g; 9890 $target_tablename = qq{"$target_tablename"} if $target_tablename !~ /"/; 9891 my $tgtcmd = "INSERT INTO $target_tablename$columnlist VALUES ("; 9892 $tgtcmd .= '?,' x @$cols; 9893 $tgtcmd =~ s/,$/)/o; 9894 $Target->{sth} = $Target->{dbh}->prepare($tgtcmd); 9895 } 9896 elsif ('flatpg' eq $type) { 9897 print {$Target->{filehandle}} "COPY $target_tablename$columnlist FROM STDIN;\n"; 9898 } 9899 elsif ('flatsql' eq $type) { 9900 print {$Target->{filehandle}} "INSERT INTO $target_tablename$columnlist VALUES\n"; 9901 } 9902 elsif ('mongo' eq $type) { 9903 } 9904 elsif ('redis' eq $type) { 9905 ## No setup needed 9906 } 9907 elsif ('sqlite' eq $type or 'oracle' eq $type or 9908 'mysql' eq $type or 'mariadb' eq $type or 'drizzle' eq $type) { 9909 my $tgtcmd = "INSERT INTO $target_tablename$columnlist VALUES ("; 9910 $tgtcmd .= '?,' x @$cols; 9911 $tgtcmd =~ s/,$/)/o; 9912 $Target->{sth} = $Target->{dbh}->prepare($tgtcmd); 9913 } 9914 else { 9915 die qq{No support for database type "$type" yet!}; 9916 } 9917 9918 if ($type =~ /flat/) { 9919 $self->glog(qq{Appended to flatfile "$Target->{filename}"}, LOG_VERBOSE); 9920 } 9921 9922 } ## end preparing each target for this select clause 9923 9924 my $loop = 1; 9925 my $number_chunks = @pkvals; 9926 9927 ## Loop through each chunk of primary keys to copy over 9928 for my $pk_values (@pkvals) { 9929 9930 ## Start streaming rows from the source 9931 my $pre = $number_chunks > 1 ? "/* $loop of $number_chunks */ " : ''; 9932 $self->glog(qq{${pre}Copying from $SourceDB->{name}.$source_tablename}, LOG_VERBOSE); 9933 9934 ## If we are doing a small batch of single primary keys, use ANY 9935 ## For a fullcopy mode, leave the WHERE clause out completely 9936 if ($mode eq 'fullcopy' or $mode eq 'anyclause') { 9937 my $srccmd = sprintf '%sCOPY (%s FROM ONLY %s %s) TO STDOUT%s', 9938 $self->{sqlprefix}, 9939 $SELECT, 9940 $source_tablename, 9941 $mode eq 'fullcopy' ? '' : " WHERE $Table->{pklist} = ANY(?)", 9942 $Sync->{copyextra} ? " $Sync->{copyextra}" : ''; 9943 9944 my $srcsth = $sourcedbh->prepare($srccmd); 9945 $mode eq 'fullcopy' ? $srcsth->execute() : $srcsth->execute( [ keys %$rows ]); 9946 } 9947 else { 9948 ## Create the proper number of placeholders 9949 my $baseq = '?'; 9950 if ($numpks > 1) { 9951 $baseq = '?,' x $numpks; 9952 $baseq =~ s/(.+?).$/\($1\)/; 9953 } 9954 my $number_values = @$pk_values; 9955 my $placeholders = "$baseq," x ($number_values / $numpks); 9956 chop $placeholders; 9957 9958 my $srccmd = sprintf '%s%sCOPY (%s FROM ONLY %s WHERE %s IN (%s)) TO STDOUT%s', 9959 $pre, 9960 $self->{sqlprefix}, 9961 $SELECT, 9962 $source_tablename, 9963 $Table->{pkeycols}, 9964 $placeholders, 9965 $Sync->{copyextra} ? " $Sync->{copyextra}" : ''; 9966 9967 my $srcsth = $sourcedbh->prepare($srccmd); 9968 $srcsth->execute( @$pk_values ); 9969 } 9970 9971 ## Loop through each row output from the source, storing it in $buffer 9972 ## Future optimization: slurp in X rows at a time, then process them 9973 my $buffer = ''; 9974 while ($sourcedbh->pg_getcopydata($buffer) >= 0) { 9975 9976 $source_rows_read++; 9977 9978 ## For each target using this particular SELECT clause 9979 for my $Target (@{ $srccmd{$select_clause} }) { 9980 9981 my $type = $Target->{dbtype}; 9982 9983 ## For Postgres, we simply do COPY to COPY 9984 if ('postgres' eq $type) { 9985 $Target->{dbh}->pg_putcopydata($buffer); 9986 } 9987 ## For flat files destined for Postgres, just do a tab-delimited dump 9988 elsif ('flatpg' eq $type) { 9989 print {$Target->{filehandle}} $buffer; 9990 } 9991 ## For other flat files, make a standard VALUES list 9992 elsif ('flatsql' eq $type) { 9993 chomp $buffer; 9994 if ($source_rows_read > 1) { 9995 print {$Target->{filehandle}} ",\n"; 9996 } 9997 print {$Target->{filehandle}} '(' . 9998 (join ',' => map { $self->{masterdbh}->quote($_) } split /\t/, $buffer, -1) . ')'; 9999 } 10000 ## For Mongo, do some mongomagic 10001 elsif ('mongo' eq $type) { 10002 10003 ## The actual target name 10004 my $target_tablename = $customname->{$Target->{name}}; 10005 $Target->{collection} = $Target->{dbh}->get_collection($target_tablename); 10006 10007 ## Have to map these values back to their names 10008 chomp $buffer; 10009 my @cols = map { $_ = undef if $_ eq '\\N'; $_; } split /\t/, $buffer, -1; 10010 10011 my $targetcols = $Table->{tcolumns}{$SELECT}; 10012 10013 ## Our object consists of the primary keys, plus all other fields 10014 my $object = {}; 10015 for my $cname (@{ $targetcols }) { 10016 $object->{$cname} = shift @cols; 10017 } 10018 ## Coerce non-strings into different objects 10019 for my $key (keys %$object) { 10020 ## Since mongo is schemaless, don't set null columns in the mongo doc 10021 if (!defined($object->{$key})) { 10022 delete $object->{$key}; 10023 } 10024 elsif ($Table->{columnhash}{$key}{ftype} =~ /smallint|integer|bigint/o) { 10025 $object->{$key} = int $object->{$key}; 10026 } 10027 elsif ($Table->{columnhash}{$key}{ftype} eq 'boolean') { 10028 if (defined $object->{$key}) { 10029 $object->{$key} = $object->{$key} eq 't' ? boolean->true : boolean->false; 10030 } 10031 } 10032 elsif ($Table->{columnhash}{$key}{ftype} =~ /real|double|numeric/o) { 10033 $object->{$key} = strtod($object->{$key}); 10034 } 10035 elsif ($Table->{columnhash}{$key}{ftype} =~ /timestamp with time zone|date|abstime/o) { 10036 $object->{$key} = DateTime->from_epoch(epoch => str2time($object->{$key})); 10037 } 10038 } 10039 $self->{oldmongo} ? 10040 $Target->{collection}->insert($object, { safe => 1 }) : 10041 $Target->{collection}->insert_one($object, { safe => 1 }); 10042 } 10043 elsif ('redis' eq $type) { 10044 10045 ## We are going to set a Redis hash, in which the key is "tablename:pkeyvalue" 10046 chomp $buffer; 10047 my @colvals = map { $_ = undef if $_ eq '\\N'; $_; } split /\t/, $buffer, -1; 10048 my @pkey; 10049 for (1 .. $Table->{numpkcols}) { 10050 push @pkey => shift @colvals; 10051 } 10052 my $pkeyval = join ':' => @pkey; 10053 ## Build a list of non-null key/value pairs to set in the hash 10054 my @add; 10055 $i = $Table->{numpkcols} - 1; 10056 my $targetcols = $Table->{tcolumns}{$SELECT}; 10057 for my $val (@colvals) { 10058 $i++; 10059 next if ! defined $val; 10060 push @add, $targetcols->[$i], $val; 10061 } 10062 10063 my $target_tablename = $customname->{$Target->{name}}; 10064 $Target->{dbh}->hmset("$target_tablename:$pkeyval", @add); 10065 } 10066 ## For SQLite, MySQL, MariaDB, Firebird, Drizzle, and Oracle, do some basic INSERTs 10067 elsif ('sqlite' eq $type 10068 or 'oracle' eq $type 10069 or 'mysql' eq $type 10070 or 'mariadb' eq $type 10071 or 'drizzle' eq $type 10072 or 'firebird' eq $type) { 10073 10074 chomp $buffer; 10075 my @cols = map { $_ = undef if $_ eq '\\N'; $_; } split /\t/, $buffer, -1; 10076 my $targetcols = $Table->{tcolumns}{$SELECT}; 10077 for my $cindex (0..@cols) { 10078 next unless defined $cols[$cindex]; 10079 if ($Table->{columnhash}{$targetcols->[$cindex]}{ftype} eq 'boolean') { 10080 # BOOLEAN support is inconsistent, but almost everyone will coerce 1/0 to TRUE/FALSE 10081 $cols[$cindex] = ( $cols[$cindex] =~ /^[1ty]/i )? 1 : 0; 10082 } 10083 } 10084 $Target->{sth}->execute(@cols); 10085 } 10086 ## Safety valve: 10087 else { 10088 die qq{No support for database type "$type" yet!}; 10089 } 10090 10091 } ## end each target 10092 10093 } ## end each row pulled from the source 10094 10095 $loop++; 10096 10097 } ## end each chunk of primary keys 10098 10099 ## Workaround for DBD::Pg bug 10100 ## Once we require a minimum version of 2.18.1 or better, we can remove this! 10101 if ($SourceDB->{dbtype} eq 'postgres' and $self->{dbdpgversion} < 21801) { 10102 $sourcedbh->do('SELECT 1'); 10103 } 10104 10105 ## Perform final cleanups for each target 10106 for my $Target (@{ $srccmd{$select_clause} }) { 10107 10108 my $target_tablename = $customname->{$Target->{name}}; 10109 10110 my $type = $Target->{dbtype}; 10111 10112 my $tname = $Target->{name}; 10113 10114 $self->glog(qq{Rows copied to ($type) $tname.$target_tablename: $source_rows_read}, LOG_VERBOSE); 10115 10116 if ('postgres' eq $type) { 10117 my $dbh = $Target->{dbh}; 10118 $dbh->pg_putcopyend(); 10119 ## Same bug as above 10120 if ($self->{dbdpgversion} < 21801) { 10121 $dbh->do('SELECT 1'); 10122 } 10123 ## If this table is set to makedelta, add rows to bucardo.delta to simulate the 10124 ## normal action of a trigger and add a row to bucardo.track to indicate that 10125 ## it has already been replicated here. 10126 my $d = $Sync->{db}{$tname}; 10127 if ($mode ne 'fullcopy' and $d->{does_makedelta}{$source_tablename} ) { 10128 10129 $self->glog("Using makedelta to populate delta and track tables for $tname.$target_tablename", LOG_VERBOSE); 10130 10131 my $cols = join ',' => @{ $Table->{qpkey} }; 10132 10133 ## We use the original list, not what may have actually got copied! 10134 for my $pk_values (@pkvals) { 10135 10136 ## Generate the correct number of placeholders 10137 my $baseq = '?'; 10138 if ($numpks > 1) { 10139 $baseq = '?,' x $numpks; 10140 chop $baseq; 10141 } 10142 my $number_values = $mode eq 'copy' ? @$pk_values : keys %$rows; 10143 my $placeholders = "($baseq)," x ($number_values / $numpks); 10144 chop $placeholders; 10145 10146 my $SQL = sprintf 'INSERT INTO bucardo.%s (%s) VALUES %s', 10147 $Table->{deltatable}, 10148 $cols, 10149 $placeholders; 10150 10151 my $sth = $dbh->prepare($SQL); 10152 $sth->execute($mode eq 'copy' ? @$pk_values : (keys %$rows)); 10153 } 10154 10155 # Make sure we track it - but only if this sync already acts as a source! 10156 if ($Target->{role} eq 'source') { 10157 $dbh->do(qq{ 10158 INSERT INTO bucardo.$Table->{tracktable} 10159 VALUES (NOW(), ?) 10160 }, undef, $d->{DBGROUPNAME}); 10161 } 10162 10163 ## We want to send a kick signal to other syncs that are using this table 10164 ## However, we do not want to kick unless they are set to autokick and active 10165 ## This works even if we do not have a real syncs, as $syncname will be '' 10166 $self->glog('Signalling other syncs that this table has changed', LOG_DEBUG); 10167 if (! exists $self->{kick_othersyncs}{$syncname}{$tname}{$target_tablename}) { 10168 $SQL = 'SELECT name FROM sync WHERE herd IN (SELECT herd FROM herdmap WHERE goat IN (SELECT id FROM goat WHERE schemaname=? AND tablename = ?)) AND name <> ? AND autokick AND status = ?'; 10169 $sth = $self->{masterdbh}->prepare($SQL); 10170 $sth->execute($Table->{schemaname}, $Table->{tablename}, $syncname, 'active'); 10171 $self->{kick_othersyncs}{$syncname}{$tname}{$target_tablename} = $sth->fetchall_arrayref(); 10172 } 10173 ## For each sync returned from the query above, send a kick request 10174 for my $row (@{ $self->{kick_othersyncs}{$syncname}{$tname}{$target_tablename} }) { 10175 my $othersync = $row->[0]; 10176 $self->db_notify($dbh, "kick_sync_$othersync", 0, '', 1); 10177 } 10178 } 10179 } 10180 elsif ('flatpg' eq $type) { 10181 print {$Target->{filehandle}} "\\\.\n\n"; 10182 } 10183 elsif ('flatsql' eq $type) { 10184 print {$Target->{filehandle}} ";\n\n"; 10185 } 10186 else { 10187 ## Nothing to be done for mongo, mysql, mariadb, sqlite, oracle, firebird, redis 10188 } 10189 10190 } ## end each Target 10191 10192 } ## end of each clause in the source command list 10193 10194 return $source_rows_read; 10195 10196} ## end of push_rows 10197 10198 10199sub vacuum_table { 10200 10201 ## Compact and/or optimize the table in the target database 10202 ## Argument: five 10203 ## 1. Starting time for the kid, so we can output cumulative times 10204 ## 2. Database type 10205 ## 3. Database handle 10206 ## 4. Database name 10207 ## 5. Table name (may be in schema.table format) 10208 ## Returns: undef 10209 10210 my ($self, $start_time, $dbtype, $ldbh, $dbname, $tablename) = @_; 10211 10212 ## XXX Return output from vacuum/optimize as a LOG_VERBOSE or LOG_DEBUG? 10213 10214 if ('postgres' eq $dbtype) { 10215 ## Do a normal vacuum of the table 10216 $ldbh->commit(); 10217 $ldbh->{AutoCommit} = 1; 10218 $self->glog("Vacuuming $dbname.$tablename", LOG_VERBOSE); 10219 $ldbh->do("VACUUM $tablename"); 10220 $ldbh->{AutoCommit} = 0; 10221 10222 my $total_time = sprintf '%.2f', tv_interval($start_time); 10223 $self->glog("Vacuum complete. Time: $total_time", LOG_VERBOSE); 10224 } 10225 elsif ('mysql' eq $dbtype or 'drizzle' eq $dbtype or 'mariadb' eq $dbtype) { 10226 ## Optimize the table 10227 $self->glog("Optimizing $tablename", LOG_VERBOSE); 10228 10229 $ldbh->do("OPTIMIZE TABLE $tablename"); 10230 $ldbh->commit(); 10231 10232 my $total_time = sprintf '%.2f', tv_interval($start_time); 10233 $self->glog("Optimization complete. Time: $total_time", LOG_VERBOSE); 10234 } 10235 elsif ('sqlite' eq $dbtype) { 10236 # Note the SQLite command vacuums the entire database. 10237 # Should probably avoid multi-vacuuming if several tables have changed. 10238 $self->glog('Vacuuming the database', LOG_VERBOSE); 10239 $ldbh->do('VACUUM'); 10240 10241 my $total_time = sprintf '%.2f', tv_interval($start_time); 10242 $self->glog("Vacuum complete. Time: $total_time", LOG_VERBOSE); 10243 } 10244 elsif ('redis' eq $dbtype) { 10245 # Nothing to do, really 10246 } 10247 elsif ('mongodb' eq $dbtype) { 10248 # Use db.repairDatabase() ? 10249 } 10250 else { 10251 ## Do nothing! 10252 } 10253 10254 return; 10255 10256} ## end of vacuum_table 10257 10258 10259sub analyze_table { 10260 10261 ## Update table statistics in the target database 10262 ## Argument: five 10263 ## 1. Starting time for the kid, so we can output cumulative times 10264 ## 2. Database type 10265 ## 3. Database handle 10266 ## 4. Database name 10267 ## 5. Table name (may be in schema.table format) 10268 ## Returns: undef 10269 10270 my ($self, $start_time, $dbtype, $ldbh, $dbname, $tablename) = @_; 10271 10272 ## XXX Return output from analyze as a LOG_VERBOSE or LOG_DEBUG? 10273 10274 if ('postgres' eq $dbtype) { 10275 $ldbh->do("ANALYZE $tablename"); 10276 my $total_time = sprintf '%.2f', tv_interval($start_time); 10277 $self->glog("Analyze complete for $dbname.$tablename. Time: $total_time", LOG_VERBOSE); 10278 $ldbh->commit(); 10279 } 10280 elsif ('sqlite' eq $dbtype) { 10281 $ldbh->do("ANALYZE $tablename"); 10282 my $total_time = sprintf '%.2f', tv_interval($start_time); 10283 $self->glog("Analyze complete for $dbname.$tablename. Time: $total_time", LOG_VERBOSE); 10284 $ldbh->commit(); 10285 } 10286 elsif ('mysql' eq $dbtype or 'drizzle' eq $dbtype or 'mariadb' eq $dbtype) { 10287 $ldbh->do("ANALYZE TABLE $tablename"); 10288 my $total_time = sprintf '%.2f', tv_interval($start_time); 10289 $self->glog("Analyze complete for $tablename. Time: $total_time", LOG_VERBOSE); 10290 $ldbh->commit(); 10291 } 10292 else { 10293 ## Nothing to do here 10294 } 10295 10296 return undef; 10297 10298} ## end of analyze_table 10299 10300 10301sub msg { ## no critic 10302 10303 my $name = shift || '?'; 10304 10305 my $msg = ''; 10306 10307 if (exists $msg{$lang}{$name}) { 10308 $msg = $msg{$lang}{$name}; 10309 } 10310 elsif (exists $msg{'en'}{$name}) { 10311 $msg = $msg{'en'}{$name}; 10312 } 10313 else { 10314 my $line = (caller)[2]; 10315 die qq{Invalid message "$name" from line $line\n}; 10316 } 10317 10318 $i = 1; 10319 { 10320 my $val = $_[$i-1]; 10321 $val = '?' if ! defined $val; 10322 last unless $msg =~ s/\$$i/$val/g; 10323 $i++; 10324 redo; 10325 } 10326 return $msg; 10327 10328} ## end of msg 10329 10330 10331sub pretty_time { 10332 10333 ## Transform number of seconds to a more human-readable format 10334 ## First argument is number of seconds 10335 ## Second optional arg is highest transform: s,m,h,d,w 10336 ## If uppercase, it indicates to "round that one out" 10337 10338 my $sec = shift; 10339 my $tweak = shift || ''; 10340 10341 ## Round to two decimal places, then trim the rest 10342 $sec = sprintf '%.2f', $sec; 10343 $sec =~ s/0+$//o; 10344 $sec =~ s/\.$//o; 10345 10346 ## Just seconds (< 2:00) 10347 if ($sec < 120 or $tweak =~ /s/) { 10348 return sprintf "$sec %s", $sec==1 ? msg('time-second') : msg('time-seconds'); 10349 } 10350 10351 ## Minutes and seconds (< 60:00) 10352 if ($sec < 60*60 or $tweak =~ /m/) { 10353 my $min = int $sec / 60; 10354 $sec %= 60; 10355 $sec = int $sec; 10356 my $ret = sprintf "$min %s", $min==1 ? msg('time-minute') : msg('time-minutes'); 10357 $sec and $tweak !~ /S/ and $ret .= sprintf " $sec %s", $sec==1 ? msg('time-second') : msg('time-seconds'); 10358 return $ret; 10359 } 10360 10361 ## Hours, minutes, and seconds (< 48:00:00) 10362 if ($sec < 60*60*24*2 or $tweak =~ /h/) { 10363 my $hour = int $sec / (60*60); 10364 $sec -= ($hour*60*60); 10365 my $min = int $sec / 60; 10366 $sec -= ($min*60); 10367 $sec = int $sec; 10368 my $ret = sprintf "$hour %s", $hour==1 ? msg('time-hour') : msg('time-hours'); 10369 $min and $tweak !~ /M/ and $ret .= sprintf " $min %s", $min==1 ? msg('time-minute') : msg('time-minutes'); 10370 $sec and $tweak !~ /[SM]/ and $ret .= sprintf " $sec %s", $sec==1 ? msg('time-second') : msg('time-seconds'); 10371 return $ret; 10372 } 10373 10374 ## Days, hours, minutes, and seconds (< 28 days) 10375 if ($sec < 60*60*24*28 or $tweak =~ /d/) { 10376 my $day = int $sec / (60*60*24); 10377 $sec -= ($day*60*60*24); 10378 my $our = int $sec / (60*60); 10379 $sec -= ($our*60*60); 10380 my $min = int $sec / 60; 10381 $sec -= ($min*60); 10382 $sec = int $sec; 10383 my $ret = sprintf "$day %s", $day==1 ? msg('time-day') : msg('time-days'); 10384 $our and $tweak !~ /H/ and $ret .= sprintf " $our %s", $our==1 ? msg('time-hour') : msg('time-hours'); 10385 $min and $tweak !~ /[HM]/ and $ret .= sprintf " $min %s", $min==1 ? msg('time-minute') : msg('time-minutes'); 10386 $sec and $tweak !~ /[HMS]/ and $ret .= sprintf " $sec %s", $sec==1 ? msg('time-second') : msg('time-seconds'); 10387 return $ret; 10388 } 10389 10390 ## Weeks, days, hours, minutes, and seconds (< 28 days) 10391 my $week = int $sec / (60*60*24*7); 10392 $sec -= ($week*60*60*24*7); 10393 my $day = int $sec / (60*60*24); 10394 $sec -= ($day*60*60*24); 10395 my $our = int $sec / (60*60); 10396 $sec -= ($our*60*60); 10397 my $min = int $sec / 60; 10398 $sec -= ($min*60); 10399 $sec = int $sec; 10400 my $ret = sprintf "$week %s", $week==1 ? msg('time-week') : msg('time-weeks'); 10401 $day and $tweak !~ /D/ and $ret .= sprintf " $day %s", $day==1 ? msg('time-day') : msg('time-days'); 10402 $our and $tweak !~ /[DH]/ and $ret .= sprintf " $our %s", $our==1 ? msg('time-hour') : msg('time-hours'); 10403 $min and $tweak !~ /[DHM]/ and $ret .= sprintf " $min %s", $min==1 ? msg('time-minute') : msg('time-minutes'); 10404 $sec and $tweak !~ /[DHMS]/ and $ret .= sprintf " $sec %s", $sec==1 ? msg('time-second') : msg('time-seconds'); 10405 10406 return $ret; 10407 10408} ## end of pretty_time 10409 10410 10411sub send_mail { 10412 10413 ## Send out an email message 10414 ## Arguments: one 10415 ## 1. Hashref with mandatory args 'body' and 'subject'. Optional 'to' 10416 ## Returns: undef 10417 10418 my $self = shift; 10419 10420 ## Return right away if sendmail and sendmail_file are false 10421 return if ! $self->{sendmail} and ! $self->{sendmail_file}; 10422 10423 ## Hashref of args 10424 my $arg = shift; 10425 10426 ## If 'default_email_from' is not set, we default to currentuser@currenthost 10427 my $from = $config{default_email_from} || (getpwuid($>) . '@' . $hostname); 10428 10429 ## Who is the email going to? We usually use the default. 10430 $arg->{to} ||= $config{default_email_to}; 10431 10432 ## We should always pass in a subject, but just in case: 10433 $arg->{subject} ||= 'Bucardo Mail!'; 10434 10435 ## Like any good murder mystery, a body is mandatory 10436 if (! $arg->{body}) { 10437 $self->glog('Warning: Cannot send mail, no body message', LOG_WARN); 10438 return; 10439 } 10440 10441 ## Where do we connect to? 10442 my $smtphost = $config{default_email_host} || 'localhost'; 10443 my $smtpport = $config{default_email_port} || 25; 10444 10445 ## Send normal email 10446 ## Do not send it if the 'example.com' default value is still in place 10447 if ($self->{sendmail} and $arg->{to} ne 'nobody@example.com') { 10448 ## Wrap the whole call in an eval so we can report errors 10449 my $evalworked = 0; 10450 eval { 10451 my $smtp = Net::SMTP->new( 10452 Host => $smtphost, 10453 Port => $smtpport, 10454 Hello => $hostname, 10455 Timeout => 15 10456 ); 10457 10458 if ($config{email_auth_user} and $config{email_auth_pass}) { 10459 ## Requires Authen::SASL 10460 my ($auser,$apass) = ($config{email_auth_user}, $config{email_auth_pass}); 10461 $self->glog("Attempting Net::SMTP::auth with user $auser", LOG_DEBUG); 10462 $smtp->auth($auser, $apass); 10463 } 10464 10465 $smtp->mail($from); 10466 $smtp->to($arg->{to}); 10467 $smtp->data(); 10468 $smtp->datasend("From: $from\n"); 10469 $smtp->datasend("To: $arg->{to}\n"); 10470 $smtp->datasend("Subject: $arg->{subject}\n"); 10471 $smtp->datasend("\n"); 10472 $smtp->datasend($arg->{body}); 10473 $smtp->dataend; 10474 $smtp->quit; 10475 $evalworked = 1; 10476 }; 10477 if (! $evalworked) { 10478 my $error = $@ || '???'; 10479 $self->glog("Warning: Error sending email to $arg->{to}: $error", LOG_WARN); 10480 } 10481 else { 10482 $self->glog("Sent an email to $arg->{to} from $from: $arg->{subject}", LOG_NORMAL); 10483 } 10484 } 10485 10486 ## Write the mail to a file 10487 if ($self->{sendmail_file}) { 10488 my $fh; 10489 ## This happens rare enough to not worry about caching the file handle 10490 if (! open $fh, '>>', $self->{sendmail_file}) { 10491 $self->glog(qq{Warning: Could not open sendmail file "$self->{sendmail_file}": $!}, LOG_WARN); 10492 return; 10493 } 10494 my $now = scalar localtime; 10495 print {$fh} qq{ 10496========================================== 10497To: $arg->{to} 10498From: $from 10499Subject: $arg->{subject} 10500Date: $now 10501$arg->{body} 10502 10503}; 10504 close $fh or warn qq{Could not close "$self->{sendmail_file}": $!\n}; 10505 } 10506 10507 return; 10508 10509} ## end of send_mail 10510 105111; 10512 10513 10514__END__ 10515 10516=pod 10517 10518=head1 NAME 10519 10520Bucardo - Postgres multi-master replication system 10521 10522=head1 VERSION 10523 10524This document describes version 5.6.0 of Bucardo 10525 10526=head1 WEBSITE 10527 10528The latest news and documentation can always be found at: 10529 10530https://bucardo.org/ 10531 10532=head1 DESCRIPTION 10533 10534Bucardo is a Perl module that replicates Postgres databases using a combination 10535of Perl, a custom database schema, Pl/Perlu, and Pl/Pgsql. 10536 10537Bucardo is unapologetically extremely verbose in its logging. 10538 10539Full documentation can be found on the website, or in the files that came with 10540this distribution. See also the documentation for the bucardo program. 10541 10542=head1 DEPENDENCIES 10543 10544=over 10545 10546=item * DBI (1.51 or better) 10547 10548=item * DBD::Pg (2.0.0 or better) 10549 10550=item * Sys::Hostname 10551 10552=item * Sys::Syslog 10553 10554=item * DBIx::Safe ## Try 'yum install perl-DBIx-Safe' or visit bucardo.org 10555 10556=item * boolean (only if using MongoDB) 10557 10558=back 10559 10560=head1 BUGS 10561 10562Bugs should be reported to bucardo-general@bucardo.org. A list of bugs can be found at 10563https://bucardo.org/bugs.html 10564 10565=head1 CREDITS 10566 10567Bucardo was originally developed and funded by Backcountry.com, who have been using versions 10568of it in production since 2002. Jon Jensen <jon@endpoint.com> wrote the original version. 10569 10570=head1 AUTHOR 10571 10572Greg Sabino Mullane <greg@turnstep.com> 10573 10574=head1 LICENSE AND COPYRIGHT 10575 10576Copyright (c) 2005-2020 Greg Sabino Mullane <greg@turnstep.com>. 10577 10578This software is free to use: see the LICENSE file for details. 10579 10580=cut 10581