1 2=pod 3 4=head1 NAME 5 6PostgresNode - class representing PostgreSQL server instance 7 8=head1 SYNOPSIS 9 10 use PostgresNode; 11 12 my $node = PostgresNode->get_new_node('mynode'); 13 14 # Create a data directory with initdb 15 $node->init(); 16 17 # Start the PostgreSQL server 18 $node->start(); 19 20 # Change a setting and restart 21 $node->append_conf('postgresql.conf', 'hot_standby = on'); 22 $node->restart(); 23 24 # run a query with psql, like: 25 # echo 'SELECT 1' | psql -qAXt postgres -v ON_ERROR_STOP=1 26 $psql_stdout = $node->safe_psql('postgres', 'SELECT 1'); 27 28 # Run psql with a timeout, capturing stdout and stderr 29 # as well as the psql exit code. Pass some extra psql 30 # options. If there's an error from psql raise an exception. 31 my ($stdout, $stderr, $timed_out); 32 my $cmdret = $node->psql('postgres', 'SELECT pg_sleep(600)', 33 stdout => \$stdout, stderr => \$stderr, 34 timeout => 180, timed_out => \$timed_out, 35 extra_params => ['--single-transaction'], 36 on_error_die => 1) 37 print "Sleep timed out" if $timed_out; 38 39 # Similar thing, more convenient in common cases 40 my ($cmdret, $stdout, $stderr) = 41 $node->psql('postgres', 'SELECT 1'); 42 43 # run query every second until it returns 't' 44 # or times out 45 $node->poll_query_until('postgres', q|SELECT random() < 0.1;|') 46 or die "timed out"; 47 48 # Do an online pg_basebackup 49 my $ret = $node->backup('testbackup1'); 50 51 # Take a backup of a running server 52 my $ret = $node->backup_fs_hot('testbackup2'); 53 54 # Take a backup of a stopped server 55 $node->stop; 56 my $ret = $node->backup_fs_cold('testbackup3') 57 58 # Restore it to create a new independent node (not a replica) 59 my $replica = get_new_node('replica'); 60 $replica->init_from_backup($node, 'testbackup'); 61 $replica->start; 62 63 # Stop the server 64 $node->stop('fast'); 65 66=head1 DESCRIPTION 67 68PostgresNode contains a set of routines able to work on a PostgreSQL node, 69allowing to start, stop, backup and initialize it with various options. 70The set of nodes managed by a given test is also managed by this module. 71 72In addition to node management, PostgresNode instances have some wrappers 73around Test::More functions to run commands with an environment set up to 74point to the instance. 75 76The IPC::Run module is required. 77 78=cut 79 80package PostgresNode; 81 82use strict; 83use warnings; 84 85use Config; 86use Cwd; 87use Exporter 'import'; 88use File::Basename; 89use File::Spec; 90use File::Temp (); 91use IPC::Run; 92use RecursiveCopy; 93use Socket; 94use Test::More; 95use TestLib (); 96use Time::HiRes qw(usleep); 97use Scalar::Util qw(blessed); 98 99our @EXPORT = qw( 100 get_new_node 101); 102 103our ($use_tcp, $test_localhost, $test_pghost, $last_host_assigned, 104 $last_port_assigned, @all_nodes); 105 106# For backward compatibility only. 107our $vfs_path = ''; 108if ($Config{osname} eq 'msys') 109{ 110 $vfs_path = `cd / && pwd -W`; 111 chomp $vfs_path; 112} 113 114INIT 115{ 116 117 # Set PGHOST for backward compatibility. This doesn't work for own_host 118 # nodes, so prefer to not rely on this when writing new tests. 119 $use_tcp = $TestLib::windows_os; 120 $test_localhost = "127.0.0.1"; 121 $last_host_assigned = 1; 122 $test_pghost = $use_tcp ? $test_localhost : TestLib::tempdir_short; 123 $ENV{PGHOST} = $test_pghost; 124 $ENV{PGDATABASE} = 'postgres'; 125 126 # Tracking of last port value assigned to accelerate free port lookup. 127 $last_port_assigned = int(rand() * 16384) + 49152; 128} 129 130=pod 131 132=head1 METHODS 133 134=over 135 136=item PostgresNode::new($class, $name, $pghost, $pgport) 137 138Create a new PostgresNode instance. Does not initdb or start it. 139 140You should generally prefer to use get_new_node() instead since it takes care 141of finding port numbers, registering instances for cleanup, etc. 142 143=cut 144 145sub new 146{ 147 my ($class, $name, $pghost, $pgport) = @_; 148 my $testname = basename($0); 149 $testname =~ s/\.[^.]+$//; 150 my $self = { 151 _port => $pgport, 152 _host => $pghost, 153 _basedir => TestLib::tempdir("data_" . $name), 154 _name => $name, 155 _logfile_generation => 0, 156 _logfile_base => "$TestLib::log_path/${testname}_${name}", 157 _logfile => "$TestLib::log_path/${testname}_${name}.log" 158 }; 159 160 bless $self, $class; 161 $self->dump_info; 162 163 return $self; 164} 165 166=pod 167 168=item $node->port() 169 170Get the port number assigned to the host. This won't necessarily be a TCP port 171open on the local host since we prefer to use unix sockets if possible. 172 173Use $node->connstr() if you want a connection string. 174 175=cut 176 177sub port 178{ 179 my ($self) = @_; 180 return $self->{_port}; 181} 182 183=pod 184 185=item $node->host() 186 187Return the host (like PGHOST) for this instance. May be a UNIX socket path. 188 189Use $node->connstr() if you want a connection string. 190 191=cut 192 193sub host 194{ 195 my ($self) = @_; 196 return $self->{_host}; 197} 198 199=pod 200 201=item $node->basedir() 202 203The directory all the node's files will be within - datadir, archive directory, 204backups, etc. 205 206=cut 207 208sub basedir 209{ 210 my ($self) = @_; 211 return $self->{_basedir}; 212} 213 214=pod 215 216=item $node->name() 217 218The name assigned to the node at creation time. 219 220=cut 221 222sub name 223{ 224 my ($self) = @_; 225 return $self->{_name}; 226} 227 228=pod 229 230=item $node->logfile() 231 232Path to the PostgreSQL log file for this instance. 233 234=cut 235 236sub logfile 237{ 238 my ($self) = @_; 239 return $self->{_logfile}; 240} 241 242=pod 243 244=item $node->connstr() 245 246Get a libpq connection string that will establish a connection to 247this node. Suitable for passing to psql, DBD::Pg, etc. 248 249=cut 250 251sub connstr 252{ 253 my ($self, $dbname) = @_; 254 my $pgport = $self->port; 255 my $pghost = $self->host; 256 if (!defined($dbname)) 257 { 258 return "port=$pgport host=$pghost"; 259 } 260 261 # Escape properly the database string before using it, only 262 # single quotes and backslashes need to be treated this way. 263 $dbname =~ s#\\#\\\\#g; 264 $dbname =~ s#\'#\\\'#g; 265 266 return "port=$pgport host=$pghost dbname='$dbname'"; 267} 268 269=pod 270 271=item $node->data_dir() 272 273Returns the path to the data directory. postgresql.conf and pg_hba.conf are 274always here. 275 276=cut 277 278sub data_dir 279{ 280 my ($self) = @_; 281 my $res = $self->basedir; 282 return "$res/pgdata"; 283} 284 285=pod 286 287=item $node->archive_dir() 288 289If archiving is enabled, WAL files go here. 290 291=cut 292 293sub archive_dir 294{ 295 my ($self) = @_; 296 my $basedir = $self->basedir; 297 return "$basedir/archives"; 298} 299 300=pod 301 302=item $node->backup_dir() 303 304The output path for backups taken with $node->backup() 305 306=cut 307 308sub backup_dir 309{ 310 my ($self) = @_; 311 my $basedir = $self->basedir; 312 return "$basedir/backup"; 313} 314 315=pod 316 317=item $node->info() 318 319Return a string containing human-readable diagnostic information (paths, etc) 320about this node. 321 322=cut 323 324sub info 325{ 326 my ($self) = @_; 327 my $_info = ''; 328 open my $fh, '>', \$_info or die; 329 print $fh "Name: " . $self->name . "\n"; 330 print $fh "Data directory: " . $self->data_dir . "\n"; 331 print $fh "Backup directory: " . $self->backup_dir . "\n"; 332 print $fh "Archive directory: " . $self->archive_dir . "\n"; 333 print $fh "Connection string: " . $self->connstr . "\n"; 334 print $fh "Log file: " . $self->logfile . "\n"; 335 close $fh or die; 336 return $_info; 337} 338 339=pod 340 341=item $node->dump_info() 342 343Print $node->info() 344 345=cut 346 347sub dump_info 348{ 349 my ($self) = @_; 350 print $self->info; 351} 352 353 354# Internal method to set up trusted pg_hba.conf for replication. Not 355# documented because you shouldn't use it, it's called automatically if needed. 356sub set_replication_conf 357{ 358 my ($self) = @_; 359 my $pgdata = $self->data_dir; 360 361 $self->host eq $test_pghost 362 or die "set_replication_conf only works with the default host"; 363 364 open my $hba, '>>', "$pgdata/pg_hba.conf"; 365 print $hba "\n# Allow replication (set up by PostgresNode.pm)\n"; 366 if ($TestLib::windows_os) 367 { 368 print $hba 369"host replication all $test_localhost/32 sspi include_realm=1 map=regress\n"; 370 } 371 close $hba; 372} 373 374=pod 375 376=item $node->init(...) 377 378Initialize a new cluster for testing. 379 380Authentication is set up so that only the current OS user can access the 381cluster. On Unix, we use Unix domain socket connections, with the socket in 382a directory that's only accessible to the current user to ensure that. 383On Windows, we use SSPI authentication to ensure the same (by pg_regress 384--config-auth). 385 386WAL archiving can be enabled on this node by passing the keyword parameter 387has_archiving => 1. This is disabled by default. 388 389postgresql.conf can be set up for replication by passing the keyword 390parameter allows_streaming => 'logical' or 'physical' (passing 1 will also 391suffice for physical replication) depending on type of replication that 392should be enabled. This is disabled by default. 393 394The new node is set up in a fast but unsafe configuration where fsync is 395disabled. 396 397=cut 398 399sub init 400{ 401 my ($self, %params) = @_; 402 my $port = $self->port; 403 my $pgdata = $self->data_dir; 404 my $host = $self->host; 405 406 $params{allows_streaming} = 0 unless defined $params{allows_streaming}; 407 $params{has_archiving} = 0 unless defined $params{has_archiving}; 408 409 mkdir $self->backup_dir; 410 mkdir $self->archive_dir; 411 412 TestLib::system_or_bail('initdb', '-D', $pgdata, '-A', 'trust', '-N', 413 @{ $params{extra} }); 414 TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata, 415 @{ $params{auth_extra} }); 416 417 open my $conf, '>>', "$pgdata/postgresql.conf"; 418 print $conf "\n# Added by PostgresNode.pm\n"; 419 print $conf "fsync = off\n"; 420 print $conf "restart_after_crash = off\n"; 421 print $conf "log_line_prefix = '%m [%p] %q%a '\n"; 422 print $conf "log_statement = all\n"; 423 print $conf "wal_retrieve_retry_interval = '500ms'\n"; 424 425 # If a setting tends to affect whether tests pass or fail, print it after 426 # TEMP_CONFIG. Otherwise, print it before TEMP_CONFIG, thereby permitting 427 # overrides. Settings that merely improve performance or ease debugging 428 # belong before TEMP_CONFIG. 429 print $conf TestLib::slurp_file($ENV{TEMP_CONFIG}) 430 if defined $ENV{TEMP_CONFIG}; 431 432 # XXX Neutralize any stats_temp_directory in TEMP_CONFIG. Nodes running 433 # concurrently must not share a stats_temp_directory. 434 print $conf "stats_temp_directory = 'pg_stat_tmp'\n"; 435 436 if ($params{allows_streaming}) 437 { 438 if ($params{allows_streaming} eq "logical") 439 { 440 print $conf "wal_level = logical\n"; 441 } 442 else 443 { 444 print $conf "wal_level = replica\n"; 445 } 446 print $conf "max_wal_senders = 10\n"; 447 print $conf "max_replication_slots = 10\n"; 448 print $conf "wal_keep_segments = 20\n"; 449 print $conf "wal_log_hints = on\n"; 450 print $conf "hot_standby = on\n"; 451 # conservative settings to ensure we can run multiple postmasters: 452 print $conf "shared_buffers = 1MB\n"; 453 print $conf "max_connections = 20\n"; 454 # limit disk space consumption, too: 455 print $conf "max_wal_size = 128MB\n"; 456 } 457 else 458 { 459 print $conf "wal_level = minimal\n"; 460 print $conf "max_wal_senders = 0\n"; 461 } 462 463 print $conf "port = $port\n"; 464 if ($use_tcp) 465 { 466 print $conf "unix_socket_directories = ''\n"; 467 print $conf "listen_addresses = '$host'\n"; 468 } 469 else 470 { 471 print $conf "unix_socket_directories = '$host'\n"; 472 print $conf "listen_addresses = ''\n"; 473 } 474 close $conf; 475 476 $self->set_replication_conf if $params{allows_streaming}; 477 $self->enable_archiving if $params{has_archiving}; 478} 479 480=pod 481 482=item $node->append_conf(filename, str) 483 484A shortcut method to append to files like pg_hba.conf and postgresql.conf. 485 486Does no validation or sanity checking. Does not reload the configuration 487after writing. 488 489A newline is automatically appended to the string. 490 491=cut 492 493sub append_conf 494{ 495 my ($self, $filename, $str) = @_; 496 497 my $conffile = $self->data_dir . '/' . $filename; 498 499 TestLib::append_to_file($conffile, $str . "\n"); 500} 501 502=pod 503 504=item $node->backup(backup_name) 505 506Create a hot backup with B<pg_basebackup> in subdirectory B<backup_name> of 507B<< $node->backup_dir >>, including the WAL. 508 509By default, WAL files are fetched at the end of the backup, not streamed. 510You can adjust that and other things by passing an array of additional 511B<pg_basebackup> command line options in the keyword parameter backup_options. 512 513You'll have to configure a suitable B<max_wal_senders> on the 514target server since it isn't done by default. 515 516=cut 517 518sub backup 519{ 520 my ($self, $backup_name, %params) = @_; 521 my $backup_path = $self->backup_dir . '/' . $backup_name; 522 my $name = $self->name; 523 524 print "# Taking pg_basebackup $backup_name from node \"$name\"\n"; 525 TestLib::system_or_bail( 526 'pg_basebackup', '-D', $backup_path, '-h', 527 $self->host, '-p', $self->port, '--checkpoint', 528 'fast', '--no-sync', 529 @{ $params{backup_options} }); 530 print "# Backup finished\n"; 531} 532 533=item $node->backup_fs_hot(backup_name) 534 535Create a backup with a filesystem level copy in subdirectory B<backup_name> of 536B<< $node->backup_dir >>, including WAL. 537 538Archiving must be enabled, as B<pg_start_backup()> and B<pg_stop_backup()> are 539used. This is not checked or enforced. 540 541The backup name is passed as the backup label to B<pg_start_backup()>. 542 543=cut 544 545sub backup_fs_hot 546{ 547 my ($self, $backup_name) = @_; 548 $self->_backup_fs($backup_name, 1); 549} 550 551=item $node->backup_fs_cold(backup_name) 552 553Create a backup with a filesystem level copy in subdirectory B<backup_name> of 554B<< $node->backup_dir >>, including WAL. The server must be 555stopped as no attempt to handle concurrent writes is made. 556 557Use B<backup> or B<backup_fs_hot> if you want to back up a running server. 558 559=cut 560 561sub backup_fs_cold 562{ 563 my ($self, $backup_name) = @_; 564 $self->_backup_fs($backup_name, 0); 565} 566 567 568# Common sub of backup_fs_hot and backup_fs_cold 569sub _backup_fs 570{ 571 my ($self, $backup_name, $hot) = @_; 572 my $backup_path = $self->backup_dir . '/' . $backup_name; 573 my $port = $self->port; 574 my $name = $self->name; 575 576 print "# Taking filesystem backup $backup_name from node \"$name\"\n"; 577 578 if ($hot) 579 { 580 my $stdout = $self->safe_psql('postgres', 581 "SELECT * FROM pg_start_backup('$backup_name');"); 582 print "# pg_start_backup: $stdout\n"; 583 } 584 585 RecursiveCopy::copypath( 586 $self->data_dir, 587 $backup_path, 588 filterfn => sub { 589 my $src = shift; 590 return ($src ne 'log' and $src ne 'postmaster.pid'); 591 }); 592 593 if ($hot) 594 { 595 596 # We ignore pg_stop_backup's return value. We also assume archiving 597 # is enabled; otherwise the caller will have to copy the remaining 598 # segments. 599 my $stdout = 600 $self->safe_psql('postgres', 'SELECT * FROM pg_stop_backup();'); 601 print "# pg_stop_backup: $stdout\n"; 602 } 603 604 print "# Backup finished\n"; 605} 606 607 608 609=pod 610 611=item $node->init_from_backup(root_node, backup_name) 612 613Initialize a node from a backup, which may come from this node or a different 614node. root_node must be a PostgresNode reference, backup_name the string name 615of a backup previously created on that node with $node->backup. 616 617Does not start the node after initializing it. 618 619A recovery.conf is not created. 620 621Streaming replication can be enabled on this node by passing the keyword 622parameter has_streaming => 1. This is disabled by default. 623 624Restoring WAL segments from archives using restore_command can be enabled 625by passing the keyword parameter has_restoring => 1. This is disabled by 626default. 627 628The backup is copied, leaving the original unmodified. pg_hba.conf is 629unconditionally set to enable replication connections. 630 631=cut 632 633sub init_from_backup 634{ 635 my ($self, $root_node, $backup_name, %params) = @_; 636 my $backup_path = $root_node->backup_dir . '/' . $backup_name; 637 my $host = $self->host; 638 my $port = $self->port; 639 my $node_name = $self->name; 640 my $root_name = $root_node->name; 641 642 $params{has_streaming} = 0 unless defined $params{has_streaming}; 643 $params{has_restoring} = 0 unless defined $params{has_restoring}; 644 645 print 646"# Initializing node \"$node_name\" from backup \"$backup_name\" of node \"$root_name\"\n"; 647 die "Backup \"$backup_name\" does not exist at $backup_path" 648 unless -d $backup_path; 649 650 mkdir $self->backup_dir; 651 mkdir $self->archive_dir; 652 653 my $data_path = $self->data_dir; 654 rmdir($data_path); 655 RecursiveCopy::copypath($backup_path, $data_path); 656 chmod(0700, $data_path); 657 658 # Base configuration for this node 659 $self->append_conf( 660 'postgresql.conf', 661 qq( 662port = $port 663)); 664 if ($use_tcp) 665 { 666 $self->append_conf('postgresql.conf', "listen_addresses = '$host'"); 667 } 668 else 669 { 670 $self->append_conf('postgresql.conf', 671 "unix_socket_directories = '$host'"); 672 } 673 $self->enable_streaming($root_node) if $params{has_streaming}; 674 $self->enable_restoring($root_node) if $params{has_restoring}; 675} 676 677=pod 678 679=item $node->rotate_logfile() 680 681Switch to a new PostgreSQL log file. This does not alter any running 682PostgreSQL process. Subsequent method calls, including pg_ctl invocations, 683will use the new name. Return the new name. 684 685=cut 686 687sub rotate_logfile 688{ 689 my ($self) = @_; 690 $self->{_logfile} = sprintf('%s_%d.log', 691 $self->{_logfile_base}, 692 ++$self->{_logfile_generation}); 693 return $self->{_logfile}; 694} 695 696=pod 697 698=item $node->start(%params) => success_or_failure 699 700Wrapper for pg_ctl start 701 702Start the node and wait until it is ready to accept connections. 703 704=over 705 706=item fail_ok => 1 707 708By default, failure terminates the entire F<prove> invocation. If given, 709instead return a true or false value to indicate success or failure. 710 711=back 712 713=cut 714 715sub start 716{ 717 my ($self, %params) = @_; 718 my $port = $self->port; 719 my $pgdata = $self->data_dir; 720 my $name = $self->name; 721 BAIL_OUT("node \"$name\" is already running") if defined $self->{_pid}; 722 print("### Starting node \"$name\"\n"); 723 my $ret = TestLib::system_log('pg_ctl', '-D', $self->data_dir, '-l', 724 $self->logfile, 'start'); 725 726 if ($ret != 0) 727 { 728 print "# pg_ctl start failed; logfile:\n"; 729 print TestLib::slurp_file($self->logfile); 730 BAIL_OUT("pg_ctl start failed") unless $params{fail_ok}; 731 return 0; 732 } 733 734 $self->_update_pid(1); 735 return 1; 736} 737 738=pod 739 740=item $node->kill9() 741 742Send SIGKILL (signal 9) to the postmaster. 743 744Note: if the node is already known stopped, this does nothing. 745However, if we think it's running and it's not, it's important for 746this to fail. Otherwise, tests might fail to detect server crashes. 747 748=cut 749 750sub kill9 751{ 752 my ($self) = @_; 753 my $name = $self->name; 754 return unless defined $self->{_pid}; 755 print "### Killing node \"$name\" using signal 9\n"; 756 kill(9, $self->{_pid}) or BAIL_OUT("kill(9, $self->{_pid}) failed"); 757 $self->{_pid} = undef; 758 return; 759} 760 761=pod 762 763=item $node->stop(mode) 764 765Stop the node using pg_ctl -m $mode and wait for it to stop. 766 767Note: if the node is already known stopped, this does nothing. 768However, if we think it's running and it's not, it's important for 769this to fail. Otherwise, tests might fail to detect server crashes. 770 771=cut 772 773sub stop 774{ 775 my ($self, $mode) = @_; 776 my $port = $self->port; 777 my $pgdata = $self->data_dir; 778 my $name = $self->name; 779 $mode = 'fast' unless defined $mode; 780 return unless defined $self->{_pid}; 781 print "### Stopping node \"$name\" using mode $mode\n"; 782 TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-m', $mode, 'stop'); 783 $self->_update_pid(0); 784} 785 786=pod 787 788=item $node->reload() 789 790Reload configuration parameters on the node. 791 792=cut 793 794sub reload 795{ 796 my ($self) = @_; 797 my $port = $self->port; 798 my $pgdata = $self->data_dir; 799 my $name = $self->name; 800 print "### Reloading node \"$name\"\n"; 801 TestLib::system_or_bail('pg_ctl', '-D', $pgdata, 'reload'); 802} 803 804=pod 805 806=item $node->restart() 807 808Wrapper for pg_ctl restart 809 810=cut 811 812sub restart 813{ 814 my ($self) = @_; 815 my $port = $self->port; 816 my $pgdata = $self->data_dir; 817 my $logfile = $self->logfile; 818 my $name = $self->name; 819 print "### Restarting node \"$name\"\n"; 820 TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile, 821 'restart'); 822 $self->_update_pid(1); 823} 824 825=pod 826 827=item $node->promote() 828 829Wrapper for pg_ctl promote 830 831=cut 832 833sub promote 834{ 835 my ($self) = @_; 836 my $port = $self->port; 837 my $pgdata = $self->data_dir; 838 my $logfile = $self->logfile; 839 my $name = $self->name; 840 print "### Promoting node \"$name\"\n"; 841 TestLib::system_or_bail('pg_ctl', '-D', $pgdata, '-l', $logfile, 842 'promote'); 843} 844 845# Internal routine to enable streaming replication on a standby node. 846sub enable_streaming 847{ 848 my ($self, $root_node) = @_; 849 my $root_connstr = $root_node->connstr; 850 my $name = $self->name; 851 852 print "### Enabling streaming replication for node \"$name\"\n"; 853 $self->append_conf( 854 'recovery.conf', qq( 855primary_conninfo='$root_connstr application_name=$name' 856standby_mode=on 857)); 858} 859 860# Internal routine to enable archive recovery command on a standby node 861sub enable_restoring 862{ 863 my ($self, $root_node) = @_; 864 my $path = TestLib::perl2host($root_node->archive_dir); 865 my $name = $self->name; 866 867 print "### Enabling WAL restore for node \"$name\"\n"; 868 869 # On Windows, the path specified in the restore command needs to use 870 # double back-slashes to work properly and to be able to detect properly 871 # the file targeted by the copy command, so the directory value used 872 # in this routine, using only one back-slash, need to be properly changed 873 # first. Paths also need to be double-quoted to prevent failures where 874 # the path contains spaces. 875 $path =~ s{\\}{\\\\}g if ($TestLib::windows_os); 876 my $copy_command = 877 $TestLib::windows_os 878 ? qq{copy "$path\\\\%f" "%p"} 879 : qq{cp "$path/%f" "%p"}; 880 881 $self->append_conf( 882 'recovery.conf', qq( 883restore_command = '$copy_command' 884standby_mode = on 885)); 886} 887 888# Internal routine to enable archiving 889sub enable_archiving 890{ 891 my ($self) = @_; 892 my $path = TestLib::perl2host($self->archive_dir); 893 my $name = $self->name; 894 895 print "### Enabling WAL archiving for node \"$name\"\n"; 896 897 # On Windows, the path specified in the restore command needs to use 898 # double back-slashes to work properly and to be able to detect properly 899 # the file targeted by the copy command, so the directory value used 900 # in this routine, using only one back-slash, need to be properly changed 901 # first. Paths also need to be double-quoted to prevent failures where 902 # the path contains spaces. 903 $path =~ s{\\}{\\\\}g if ($TestLib::windows_os); 904 my $copy_command = 905 $TestLib::windows_os 906 ? qq{copy "%p" "$path\\\\%f"} 907 : qq{cp "%p" "$path/%f"}; 908 909 # Enable archive_mode and archive_command on node 910 $self->append_conf( 911 'postgresql.conf', qq( 912archive_mode = on 913archive_command = '$copy_command' 914)); 915} 916 917# Internal method 918sub _update_pid 919{ 920 my ($self, $is_running) = @_; 921 my $name = $self->name; 922 923 # If we can open the PID file, read its first line and that's the PID we 924 # want. 925 if (open my $pidfile, '<', $self->data_dir . "/postmaster.pid") 926 { 927 chomp($self->{_pid} = <$pidfile>); 928 print "# Postmaster PID for node \"$name\" is $self->{_pid}\n"; 929 close $pidfile; 930 931 # If we found a pidfile when there shouldn't be one, complain. 932 BAIL_OUT("postmaster.pid unexpectedly present") unless $is_running; 933 return; 934 } 935 936 $self->{_pid} = undef; 937 print "# No postmaster PID for node \"$name\"\n"; 938 939 # Complain if we expected to find a pidfile. 940 BAIL_OUT("postmaster.pid unexpectedly not present") if $is_running; 941} 942 943=pod 944 945=item PostgresNode->get_new_node(node_name, %params) 946 947Build a new object of class C<PostgresNode> (or of a subclass, if you have 948one), assigning a free port number. Remembers the node, to prevent its port 949number from being reused for another node, and to ensure that it gets 950shut down when the test script exits. 951 952You should generally use this instead of C<PostgresNode::new(...)>. 953 954=over 955 956=item port => [1,65535] 957 958By default, this function assigns a port number to each node. Specify this to 959force a particular port number. The caller is responsible for evaluating 960potential conflicts and privilege requirements. 961 962=item own_host => 1 963 964By default, all nodes use the same PGHOST value. If specified, generate a 965PGHOST specific to this node. This allows multiple nodes to use the same 966port. 967 968=back 969 970For backwards compatibility, it is also exported as a standalone function, 971which can only create objects of class C<PostgresNode>. 972 973=cut 974 975sub get_new_node 976{ 977 my $class = 'PostgresNode'; 978 $class = shift if scalar(@_) % 2 != 1; 979 my ($name, %params) = @_; 980 my $port_is_forced = defined $params{port}; 981 my $found = $port_is_forced; 982 my $port = $port_is_forced ? $params{port} : $last_port_assigned; 983 984 while ($found == 0) 985 { 986 987 # advance $port, wrapping correctly around range end 988 $port = 49152 if ++$port >= 65536; 989 print "# Checking port $port\n"; 990 991 # Check first that candidate port number is not included in 992 # the list of already-registered nodes. 993 $found = 1; 994 foreach my $node (@all_nodes) 995 { 996 $found = 0 if ($node->port == $port); 997 } 998 999 # Check to see if anything else is listening on this TCP port. 1000 # Seek a port available for all possible listen_addresses values, 1001 # so callers can harness this port for the widest range of purposes. 1002 # The 0.0.0.0 test achieves that for MSYS, which automatically sets 1003 # SO_EXCLUSIVEADDRUSE. Testing 0.0.0.0 is insufficient for Windows 1004 # native Perl (https://stackoverflow.com/a/14388707), so we also 1005 # have to test individual addresses. Doing that for 127.0.0/24 1006 # addresses other than 127.0.0.1 might fail with EADDRNOTAVAIL on 1007 # non-Linux, non-Windows kernels. 1008 # 1009 # Thus, 0.0.0.0 and individual 127.0.0/24 addresses are tested 1010 # only on Windows and only when TCP usage is requested. 1011 if ($found == 1) 1012 { 1013 foreach my $addr (qw(127.0.0.1), 1014 ($use_tcp && $TestLib::windows_os) 1015 ? qw(127.0.0.2 127.0.0.3 0.0.0.0) 1016 : ()) 1017 { 1018 can_bind($addr, $port) or $found = 0; 1019 } 1020 } 1021 } 1022 1023 print "# Found port $port\n"; 1024 1025 # Select a host. 1026 my $host = $test_pghost; 1027 if ($params{own_host}) 1028 { 1029 if ($use_tcp) 1030 { 1031 $last_host_assigned++; 1032 $last_host_assigned > 254 and BAIL_OUT("too many own_host nodes"); 1033 $host = '127.0.0.' . $last_host_assigned; 1034 } 1035 else 1036 { 1037 $host = "$test_pghost/$name"; # Assume $name =~ /^[-_a-zA-Z0-9]+$/ 1038 mkdir $host; 1039 } 1040 } 1041 1042 # Lock port number found by creating a new node 1043 my $node = $class->new($name, $host, $port); 1044 1045 # Add node to list of nodes 1046 push(@all_nodes, $node); 1047 1048 # And update port for next time 1049 $port_is_forced or $last_port_assigned = $port; 1050 1051 return $node; 1052} 1053 1054# Internal routine to check whether a host:port is available to bind 1055sub can_bind 1056{ 1057 my ($host, $port) = @_; 1058 my $iaddr = inet_aton($host); 1059 my $paddr = sockaddr_in($port, $iaddr); 1060 my $proto = getprotobyname("tcp"); 1061 1062 socket(SOCK, PF_INET, SOCK_STREAM, $proto) 1063 or die "socket failed: $!"; 1064 1065 # As in postmaster, don't use SO_REUSEADDR on Windows 1066 setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) 1067 unless $TestLib::windows_os; 1068 my $ret = bind(SOCK, $paddr) && listen(SOCK, SOMAXCONN); 1069 close(SOCK); 1070 return $ret; 1071} 1072 1073# Automatically shut down any still-running nodes when the test script exits. 1074# Note that this just stops the postmasters (in the same order the nodes were 1075# created in). Temporary PGDATA directories are deleted, in an unspecified 1076# order, later when the File::Temp objects are destroyed. 1077END 1078{ 1079 1080 # take care not to change the script's exit value 1081 my $exit_code = $?; 1082 1083 foreach my $node (@all_nodes) 1084 { 1085 $node->teardown_node; 1086 } 1087 1088 $? = $exit_code; 1089} 1090 1091=pod 1092 1093=item $node->teardown_node() 1094 1095Do an immediate stop of the node 1096 1097=cut 1098 1099sub teardown_node 1100{ 1101 my $self = shift; 1102 1103 $self->stop('immediate'); 1104} 1105 1106=pod 1107 1108=item $node->safe_psql($dbname, $sql) => stdout 1109 1110Invoke B<psql> to run B<sql> on B<dbname> and return its stdout on success. 1111Die if the SQL produces an error. Runs with B<ON_ERROR_STOP> set. 1112 1113Takes optional extra params like timeout and timed_out parameters with the same 1114options as psql. 1115 1116=cut 1117 1118sub safe_psql 1119{ 1120 my ($self, $dbname, $sql, %params) = @_; 1121 1122 my ($stdout, $stderr); 1123 1124 my $ret = $self->psql( 1125 $dbname, $sql, 1126 %params, 1127 stdout => \$stdout, 1128 stderr => \$stderr, 1129 on_error_die => 1, 1130 on_error_stop => 1); 1131 1132 # psql can emit stderr from NOTICEs etc 1133 if ($stderr ne "") 1134 { 1135 print "#### Begin standard error\n"; 1136 print $stderr; 1137 print "\n#### End standard error\n"; 1138 } 1139 1140 return $stdout; 1141} 1142 1143=pod 1144 1145=item $node->psql($dbname, $sql, %params) => psql_retval 1146 1147Invoke B<psql> to execute B<$sql> on B<$dbname> and return the return value 1148from B<psql>, which is run with on_error_stop by default so that it will 1149stop running sql and return 3 if the passed SQL results in an error. 1150 1151As a convenience, if B<psql> is called in array context it returns an 1152array containing ($retval, $stdout, $stderr). 1153 1154psql is invoked in tuples-only unaligned mode with reading of B<.psqlrc> 1155disabled. That may be overridden by passing extra psql parameters. 1156 1157stdout and stderr are transformed to UNIX line endings if on Windows. Any 1158trailing newline is removed. 1159 1160Dies on failure to invoke psql but not if psql exits with a nonzero 1161return code (unless on_error_die specified). 1162 1163If psql exits because of a signal, an exception is raised. 1164 1165=over 1166 1167=item stdout => \$stdout 1168 1169B<stdout>, if given, must be a scalar reference to which standard output is 1170written. If not given, standard output is not redirected and will be printed 1171unless B<psql> is called in array context, in which case it's captured and 1172returned. 1173 1174=item stderr => \$stderr 1175 1176Same as B<stdout> but gets standard error. If the same scalar is passed for 1177both B<stdout> and B<stderr> the results may be interleaved unpredictably. 1178 1179=item on_error_stop => 1 1180 1181By default, the B<psql> method invokes the B<psql> program with ON_ERROR_STOP=1 1182set, so SQL execution is stopped at the first error and exit code 2 is 1183returned. Set B<on_error_stop> to 0 to ignore errors instead. 1184 1185=item on_error_die => 0 1186 1187By default, this method returns psql's result code. Pass on_error_die to 1188instead die with an informative message. 1189 1190=item timeout => 'interval' 1191 1192Set a timeout for the psql call as an interval accepted by B<IPC::Run::timer> 1193(integer seconds is fine). This method raises an exception on timeout, unless 1194the B<timed_out> parameter is also given. 1195 1196=item timed_out => \$timed_out 1197 1198If B<timeout> is set and this parameter is given, the scalar it references 1199is set to true if the psql call times out. 1200 1201=item extra_params => ['--single-transaction'] 1202 1203If given, it must be an array reference containing additional parameters to B<psql>. 1204 1205=back 1206 1207e.g. 1208 1209 my ($stdout, $stderr, $timed_out); 1210 my $cmdret = $node->psql('postgres', 'SELECT pg_sleep(600)', 1211 stdout => \$stdout, stderr => \$stderr, 1212 timeout => 180, timed_out => \$timed_out, 1213 extra_params => ['--single-transaction']) 1214 1215will set $cmdret to undef and $timed_out to a true value. 1216 1217 $node->psql('postgres', $sql, on_error_die => 1); 1218 1219dies with an informative message if $sql fails. 1220 1221=cut 1222 1223sub psql 1224{ 1225 my ($self, $dbname, $sql, %params) = @_; 1226 1227 my $stdout = $params{stdout}; 1228 my $stderr = $params{stderr}; 1229 my $timeout = undef; 1230 my $timeout_exception = 'psql timed out'; 1231 my @psql_params = 1232 ('psql', '-XAtq', '-d', $self->connstr($dbname), '-f', '-'); 1233 1234 # If the caller wants an array and hasn't passed stdout/stderr 1235 # references, allocate temporary ones to capture them so we 1236 # can return them. Otherwise we won't redirect them at all. 1237 if (wantarray) 1238 { 1239 if (!defined($stdout)) 1240 { 1241 my $temp_stdout = ""; 1242 $stdout = \$temp_stdout; 1243 } 1244 if (!defined($stderr)) 1245 { 1246 my $temp_stderr = ""; 1247 $stderr = \$temp_stderr; 1248 } 1249 } 1250 1251 $params{on_error_stop} = 1 unless defined $params{on_error_stop}; 1252 $params{on_error_die} = 0 unless defined $params{on_error_die}; 1253 1254 push @psql_params, '-v', 'ON_ERROR_STOP=1' if $params{on_error_stop}; 1255 push @psql_params, @{ $params{extra_params} } 1256 if defined $params{extra_params}; 1257 1258 $timeout = 1259 IPC::Run::timeout($params{timeout}, exception => $timeout_exception) 1260 if (defined($params{timeout})); 1261 1262 ${ $params{timed_out} } = 0 if defined $params{timed_out}; 1263 1264 # IPC::Run would otherwise append to existing contents: 1265 $$stdout = "" if ref($stdout); 1266 $$stderr = "" if ref($stderr); 1267 1268 my $ret; 1269 1270 # Run psql and capture any possible exceptions. If the exception is 1271 # because of a timeout and the caller requested to handle that, just return 1272 # and set the flag. Otherwise, and for any other exception, rethrow. 1273 # 1274 # For background, see 1275 # http://search.cpan.org/~ether/Try-Tiny-0.24/lib/Try/Tiny.pm 1276 do 1277 { 1278 local $@; 1279 eval { 1280 my @ipcrun_opts = (\@psql_params, '<', \$sql); 1281 push @ipcrun_opts, '>', $stdout if defined $stdout; 1282 push @ipcrun_opts, '2>', $stderr if defined $stderr; 1283 push @ipcrun_opts, $timeout if defined $timeout; 1284 1285 IPC::Run::run @ipcrun_opts; 1286 $ret = $?; 1287 }; 1288 my $exc_save = $@; 1289 if ($exc_save) 1290 { 1291 1292 # IPC::Run::run threw an exception. re-throw unless it's a 1293 # timeout, which we'll handle by testing is_expired 1294 die $exc_save 1295 if (blessed($exc_save) 1296 || $exc_save !~ /^\Q$timeout_exception\E/); 1297 1298 $ret = undef; 1299 1300 die "Got timeout exception '$exc_save' but timer not expired?!" 1301 unless $timeout->is_expired; 1302 1303 if (defined($params{timed_out})) 1304 { 1305 ${ $params{timed_out} } = 1; 1306 } 1307 else 1308 { 1309 die "psql timed out: stderr: '$$stderr'\n" 1310 . "while running '@psql_params'"; 1311 } 1312 } 1313 }; 1314 1315 # Note: on Windows, IPC::Run seems to convert \r\n to \n in program output 1316 # if we're using native Perl, but not if we're using MSys Perl. So do it 1317 # by hand in the latter case, here and elsewhere. 1318 1319 if (defined $$stdout) 1320 { 1321 $$stdout =~ s/\r\n/\n/g if $Config{osname} eq 'msys'; 1322 chomp $$stdout; 1323 } 1324 1325 if (defined $$stderr) 1326 { 1327 $$stderr =~ s/\r\n/\n/g if $Config{osname} eq 'msys'; 1328 chomp $$stderr; 1329 } 1330 1331 # See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR 1332 # We don't use IPC::Run::Simple to limit dependencies. 1333 # 1334 # We always die on signal. 1335 my $core = $ret & 128 ? " (core dumped)" : ""; 1336 die "psql exited with signal " 1337 . ($ret & 127) 1338 . "$core: '$$stderr' while running '@psql_params'" 1339 if $ret & 127; 1340 $ret = $ret >> 8; 1341 1342 if ($ret && $params{on_error_die}) 1343 { 1344 die "psql error: stderr: '$$stderr'\nwhile running '@psql_params'" 1345 if $ret == 1; 1346 die "connection error: '$$stderr'\nwhile running '@psql_params'" 1347 if $ret == 2; 1348 die 1349"error running SQL: '$$stderr'\nwhile running '@psql_params' with sql '$sql'" 1350 if $ret == 3; 1351 die "psql returns $ret: '$$stderr'\nwhile running '@psql_params'"; 1352 } 1353 1354 if (wantarray) 1355 { 1356 return ($ret, $$stdout, $$stderr); 1357 } 1358 else 1359 { 1360 return $ret; 1361 } 1362} 1363 1364=pod 1365 1366=item $node->background_psql($dbname, \$stdin, \$stdout, $timer, %params) => harness 1367 1368Invoke B<psql> on B<$dbname> and return an IPC::Run harness object, which the 1369caller may use to send input to B<psql>. The process's stdin is sourced from 1370the $stdin scalar reference, and its stdout and stderr go to the $stdout 1371scalar reference. This allows the caller to act on other parts of the system 1372while idling this backend. 1373 1374The specified timer object is attached to the harness, as well. It's caller's 1375responsibility to select the timeout length, and to restart the timer after 1376each command if the timeout is per-command. 1377 1378psql is invoked in tuples-only unaligned mode with reading of B<.psqlrc> 1379disabled. That may be overridden by passing extra psql parameters. 1380 1381Dies on failure to invoke psql, or if psql fails to connect. Errors occurring 1382later are the caller's problem. psql runs with on_error_stop by default so 1383that it will stop running sql and return 3 if passed SQL results in an error. 1384 1385Be sure to "finish" the harness when done with it. 1386 1387=over 1388 1389=item on_error_stop => 1 1390 1391By default, the B<psql> method invokes the B<psql> program with ON_ERROR_STOP=1 1392set, so SQL execution is stopped at the first error and exit code 3 is 1393returned. Set B<on_error_stop> to 0 to ignore errors instead. 1394 1395=item replication => B<value> 1396 1397If set, add B<replication=value> to the conninfo string. 1398Passing the literal value C<database> results in a logical replication 1399connection. 1400 1401=item extra_params => ['--single-transaction'] 1402 1403If given, it must be an array reference containing additional parameters to B<psql>. 1404 1405=back 1406 1407=cut 1408 1409sub background_psql 1410{ 1411 my ($self, $dbname, $stdin, $stdout, $timer, %params) = @_; 1412 1413 local $ENV{PGHOST} = $self->host; 1414 local $ENV{PGPORT} = $self->port; 1415 1416 my $replication = $params{replication}; 1417 1418 my @psql_params = ( 1419 'psql', 1420 '-XAtq', 1421 '-d', 1422 $self->connstr($dbname) 1423 . (defined $replication ? " replication=$replication" : ""), 1424 '-f', 1425 '-'); 1426 1427 $params{on_error_stop} = 1 unless defined $params{on_error_stop}; 1428 1429 push @psql_params, '-v', 'ON_ERROR_STOP=1' if $params{on_error_stop}; 1430 push @psql_params, @{ $params{extra_params} } 1431 if defined $params{extra_params}; 1432 1433 # Ensure there is no data waiting to be sent: 1434 $$stdin = "" if ref($stdin); 1435 # IPC::Run would otherwise append to existing contents: 1436 $$stdout = "" if ref($stdout); 1437 1438 my $harness = IPC::Run::start \@psql_params, 1439 '<', $stdin, '>', $stdout, $timer; 1440 1441 # Request some output, and pump until we see it. This means that psql 1442 # connection failures are caught here, relieving callers of the need to 1443 # handle those. (Right now, we have no particularly good handling for 1444 # errors anyway, but that might be added later.) 1445 my $banner = "background_psql: ready"; 1446 $$stdin = "\\echo $banner\n"; 1447 pump $harness until $$stdout =~ /$banner/ || $timer->is_expired; 1448 1449 die "psql startup timed out" if $timer->is_expired; 1450 1451 return $harness; 1452} 1453 1454# Common sub of pgbench-invoking interfaces. Makes any requested script files 1455# and returns pgbench command-line options causing use of those files. 1456sub _pgbench_make_files 1457{ 1458 my ($self, $files) = @_; 1459 my @file_opts; 1460 1461 if (defined $files) 1462 { 1463 1464 # note: files are ordered for determinism 1465 for my $fn (sort keys %$files) 1466 { 1467 my $filename = $self->basedir . '/' . $fn; 1468 push @file_opts, '-f', $filename; 1469 1470 # cleanup file weight 1471 $filename =~ s/\@\d+$//; 1472 1473 #push @filenames, $filename; 1474 # filenames are expected to be unique on a test 1475 if (-e $filename) 1476 { 1477 ok(0, "$filename must not already exist"); 1478 unlink $filename or die "cannot unlink $filename: $!"; 1479 } 1480 TestLib::append_to_file($filename, $$files{$fn}); 1481 } 1482 } 1483 1484 return @file_opts; 1485} 1486 1487=pod 1488 1489=item $node->pgbench($opts, $stat, $out, $err, $name, $files, @args) 1490 1491Invoke B<pgbench>, with parameters and files. 1492 1493=over 1494 1495=item $opts 1496 1497Options as a string to be split on spaces. 1498 1499=item $stat 1500 1501Expected exit status. 1502 1503=item $out 1504 1505Reference to a regexp list that must match stdout. 1506 1507=item $err 1508 1509Reference to a regexp list that must match stderr. 1510 1511=item $name 1512 1513Name of test for error messages. 1514 1515=item $files 1516 1517Reference to filename/contents dictionary. 1518 1519=item @args 1520 1521Further raw options or arguments. 1522 1523=back 1524 1525=cut 1526 1527sub pgbench 1528{ 1529 local $Test::Builder::Level = $Test::Builder::Level + 1; 1530 1531 my ($self, $opts, $stat, $out, $err, $name, $files, @args) = @_; 1532 my @cmd = ( 1533 'pgbench', 1534 split(/\s+/, $opts), 1535 $self->_pgbench_make_files($files), @args); 1536 1537 $self->command_checks_all(\@cmd, $stat, $out, $err, $name); 1538} 1539 1540=pod 1541 1542=item $node->background_pgbench($opts, $files, \$stdout, $timer) => harness 1543 1544Invoke B<pgbench> and return an IPC::Run harness object. The process's stdin 1545is empty, and its stdout and stderr go to the $stdout scalar reference. This 1546allows the caller to act on other parts of the system while B<pgbench> is 1547running. Errors from B<pgbench> are the caller's problem. 1548 1549The specified timer object is attached to the harness, as well. It's caller's 1550responsibility to select the timeout length, and to restart the timer after 1551each command if the timeout is per-command. 1552 1553Be sure to "finish" the harness when done with it. 1554 1555=over 1556 1557=item $opts 1558 1559Options as a string to be split on spaces. 1560 1561=item $files 1562 1563Reference to filename/contents dictionary. 1564 1565=back 1566 1567=cut 1568 1569sub background_pgbench 1570{ 1571 my ($self, $opts, $files, $stdout, $timer) = @_; 1572 1573 my @cmd = 1574 ('pgbench', split(/\s+/, $opts), $self->_pgbench_make_files($files)); 1575 1576 local $ENV{PGHOST} = $self->host; 1577 local $ENV{PGPORT} = $self->port; 1578 1579 my $stdin = ""; 1580 # IPC::Run would otherwise append to existing contents: 1581 $$stdout = "" if ref($stdout); 1582 1583 my $harness = IPC::Run::start \@cmd, '<', \$stdin, '>', $stdout, '2>&1', 1584 $timer; 1585 1586 return $harness; 1587} 1588 1589=pod 1590 1591=item $node->poll_query_until($dbname, $query [, $expected ]) 1592 1593Run B<$query> repeatedly, until it returns the B<$expected> result 1594('t', or SQL boolean true, by default). 1595Continues polling if B<psql> returns an error result. 1596Times out after 180 seconds. 1597Returns 1 if successful, 0 if timed out. 1598 1599=cut 1600 1601sub poll_query_until 1602{ 1603 my ($self, $dbname, $query, $expected) = @_; 1604 1605 $expected = 't' unless defined($expected); # default value 1606 1607 my $cmd = [ 'psql', '-XAt', '-d', $self->connstr($dbname) ]; 1608 my ($stdout, $stderr); 1609 my $max_attempts = 180 * 10; 1610 my $attempts = 0; 1611 1612 while ($attempts < $max_attempts) 1613 { 1614 my $result = IPC::Run::run $cmd, '<', \$query, 1615 '>', \$stdout, '2>', \$stderr; 1616 1617 $stdout =~ s/\r\n/\n/g if $Config{osname} eq 'msys'; 1618 chomp($stdout); 1619 $stderr =~ s/\r\n/\n/g if $Config{osname} eq 'msys'; 1620 chomp($stderr); 1621 1622 if ($stdout eq $expected && $stderr eq '') 1623 { 1624 return 1; 1625 } 1626 1627 # Wait 0.1 second before retrying. 1628 usleep(100_000); 1629 1630 $attempts++; 1631 } 1632 1633 # The query result didn't change in 180 seconds. Give up. Print the 1634 # output from the last attempt, hopefully that's useful for debugging. 1635 diag qq(poll_query_until timed out executing this query: 1636$query 1637expecting this output: 1638$expected 1639last actual query output: 1640$stdout 1641with stderr: 1642$stderr); 1643 return 0; 1644} 1645 1646=pod 1647 1648=item $node->command_ok(...) 1649 1650Runs a shell command like TestLib::command_ok, but with PGHOST and PGPORT set 1651so that the command will default to connecting to this PostgresNode. 1652 1653=cut 1654 1655sub command_ok 1656{ 1657 my $self = shift; 1658 1659 local $ENV{PGHOST} = $self->host; 1660 local $ENV{PGPORT} = $self->port; 1661 1662 TestLib::command_ok(@_); 1663} 1664 1665=pod 1666 1667=item $node->command_fails(...) - TestLib::command_fails with our PGPORT 1668 1669TestLib::command_fails with our connection parameters. See command_ok(...) 1670 1671=cut 1672 1673sub command_fails 1674{ 1675 my $self = shift; 1676 1677 local $ENV{PGHOST} = $self->host; 1678 local $ENV{PGPORT} = $self->port; 1679 1680 TestLib::command_fails(@_); 1681} 1682 1683=pod 1684 1685=item $node->command_like(...) 1686 1687TestLib::command_like with our connection parameters. See command_ok(...) 1688 1689=cut 1690 1691sub command_like 1692{ 1693 my $self = shift; 1694 1695 local $ENV{PGHOST} = $self->host; 1696 local $ENV{PGPORT} = $self->port; 1697 1698 TestLib::command_like(@_); 1699} 1700 1701=pod 1702 1703=item $node->command_checks_all(...) 1704 1705TestLib::command_checks_all with our connection parameters. See 1706command_ok(...) 1707 1708=cut 1709 1710sub command_checks_all 1711{ 1712 my $self = shift; 1713 1714 local $ENV{PGHOST} = $self->host; 1715 local $ENV{PGPORT} = $self->port; 1716 1717 TestLib::command_checks_all(@_); 1718 return; 1719} 1720 1721=pod 1722 1723=item $node->issues_sql_like(cmd, expected_sql, test_name) 1724 1725Run a command on the node, then verify that $expected_sql appears in the 1726server log file. 1727 1728=cut 1729 1730sub issues_sql_like 1731{ 1732 my ($self, $cmd, $expected_sql, $test_name) = @_; 1733 1734 local $ENV{PGHOST} = $self->host; 1735 local $ENV{PGPORT} = $self->port; 1736 1737 my $log_location = -s $self->logfile; 1738 1739 my $result = TestLib::run_log($cmd); 1740 ok($result, "@$cmd exit code 0"); 1741 my $log = TestLib::slurp_file($self->logfile, $log_location); 1742 like($log, $expected_sql, "$test_name: SQL found in server log"); 1743} 1744 1745=pod 1746 1747=item $node->run_log(...) 1748 1749Runs a shell command like TestLib::run_log, but with connection parameters set 1750so that the command will default to connecting to this PostgresNode. 1751 1752=cut 1753 1754sub run_log 1755{ 1756 my $self = shift; 1757 1758 local $ENV{PGHOST} = $self->host; 1759 local $ENV{PGPORT} = $self->port; 1760 1761 TestLib::run_log(@_); 1762} 1763 1764=pod 1765 1766=item $node->lsn(mode) 1767 1768Look up WAL locations on the server: 1769 1770 * insert location (master only, error on replica) 1771 * write location (master only, error on replica) 1772 * flush location (master only, error on replica) 1773 * receive location (always undef on master) 1774 * replay location (always undef on master) 1775 1776mode must be specified. 1777 1778=cut 1779 1780sub lsn 1781{ 1782 my ($self, $mode) = @_; 1783 my %modes = ( 1784 'insert' => 'pg_current_wal_insert_lsn()', 1785 'flush' => 'pg_current_wal_flush_lsn()', 1786 'write' => 'pg_current_wal_lsn()', 1787 'receive' => 'pg_last_wal_receive_lsn()', 1788 'replay' => 'pg_last_wal_replay_lsn()'); 1789 1790 $mode = '<undef>' if !defined($mode); 1791 die "unknown mode for 'lsn': '$mode', valid modes are " 1792 . join(', ', keys %modes) 1793 if !defined($modes{$mode}); 1794 1795 my $result = $self->safe_psql('postgres', "SELECT $modes{$mode}"); 1796 chomp($result); 1797 if ($result eq '') 1798 { 1799 return; 1800 } 1801 else 1802 { 1803 return $result; 1804 } 1805} 1806 1807=pod 1808 1809=item $node->wait_for_catchup(standby_name, mode, target_lsn) 1810 1811Wait for the node with application_name standby_name (usually from node->name) 1812until its replication location in pg_stat_replication equals or passes the 1813upstream's WAL insert point at the time this function is called. By default 1814the replay_lsn is waited for, but 'mode' may be specified to wait for any of 1815sent|write|flush|replay. 1816 1817If there is no active replication connection from this peer, waits until 1818poll_query_until timeout. 1819 1820Requires that the 'postgres' db exists and is accessible. 1821 1822target_lsn may be any arbitrary lsn, but is typically $master_node->lsn('insert'). 1823 1824This is not a test. It die()s on failure. 1825 1826=cut 1827 1828sub wait_for_catchup 1829{ 1830 my ($self, $standby_name, $mode, $target_lsn) = @_; 1831 $mode = defined($mode) ? $mode : 'replay'; 1832 my %valid_modes = 1833 ('sent' => 1, 'write' => 1, 'flush' => 1, 'replay' => 1); 1834 die "unknown mode $mode for 'wait_for_catchup', valid modes are " 1835 . join(', ', keys(%valid_modes)) 1836 unless exists($valid_modes{$mode}); 1837 1838 # Allow passing of a PostgresNode instance as shorthand 1839 if (blessed($standby_name) && $standby_name->isa("PostgresNode")) 1840 { 1841 $standby_name = $standby_name->name; 1842 } 1843 die 'target_lsn must be specified' unless defined($target_lsn); 1844 print "Waiting for replication conn " 1845 . $standby_name . "'s " 1846 . $mode 1847 . "_lsn to pass " 1848 . $target_lsn . " on " 1849 . $self->name . "\n"; 1850 my $query = 1851qq[SELECT '$target_lsn' <= ${mode}_lsn FROM pg_catalog.pg_stat_replication WHERE application_name = '$standby_name';]; 1852 $self->poll_query_until('postgres', $query) 1853 or die "timed out waiting for catchup, current location is " 1854 . ($self->safe_psql('postgres', $query) || '(unknown)'); 1855 print "done\n"; 1856} 1857 1858=pod 1859 1860=item $node->wait_for_slot_catchup(slot_name, mode, target_lsn) 1861 1862Wait for the named replication slot to equal or pass the supplied target_lsn. 1863The location used is the restart_lsn unless mode is given, in which case it may 1864be 'restart' or 'confirmed_flush'. 1865 1866Requires that the 'postgres' db exists and is accessible. 1867 1868This is not a test. It die()s on failure. 1869 1870If the slot is not active, will time out after poll_query_until's timeout. 1871 1872target_lsn may be any arbitrary lsn, but is typically $master_node->lsn('insert'). 1873 1874Note that for logical slots, restart_lsn is held down by the oldest in-progress tx. 1875 1876=cut 1877 1878sub wait_for_slot_catchup 1879{ 1880 my ($self, $slot_name, $mode, $target_lsn) = @_; 1881 $mode = defined($mode) ? $mode : 'restart'; 1882 if (!($mode eq 'restart' || $mode eq 'confirmed_flush')) 1883 { 1884 die "valid modes are restart, confirmed_flush"; 1885 } 1886 die 'target lsn must be specified' unless defined($target_lsn); 1887 print "Waiting for replication slot " 1888 . $slot_name . "'s " 1889 . $mode 1890 . "_lsn to pass " 1891 . $target_lsn . " on " 1892 . $self->name . "\n"; 1893 my $query = 1894qq[SELECT '$target_lsn' <= ${mode}_lsn FROM pg_catalog.pg_replication_slots WHERE slot_name = '$slot_name';]; 1895 $self->poll_query_until('postgres', $query) 1896 or die "timed out waiting for catchup, current location is " 1897 . ($self->safe_psql('postgres', $query) || '(unknown)'); 1898 print "done\n"; 1899} 1900 1901=pod 1902 1903=item $node->query_hash($dbname, $query, @columns) 1904 1905Execute $query on $dbname, replacing any appearance of the string __COLUMNS__ 1906within the query with a comma-separated list of @columns. 1907 1908If __COLUMNS__ does not appear in the query, its result columns must EXACTLY 1909match the order and number (but not necessarily alias) of supplied @columns. 1910 1911The query must return zero or one rows. 1912 1913Return a hash-ref representation of the results of the query, with any empty 1914or null results as defined keys with an empty-string value. There is no way 1915to differentiate between null and empty-string result fields. 1916 1917If the query returns zero rows, return a hash with all columns empty. There 1918is no way to differentiate between zero rows returned and a row with only 1919null columns. 1920 1921=cut 1922 1923sub query_hash 1924{ 1925 my ($self, $dbname, $query, @columns) = @_; 1926 die 'calls in array context for multi-row results not supported yet' 1927 if (wantarray); 1928 1929 # Replace __COLUMNS__ if found 1930 substr($query, index($query, '__COLUMNS__'), length('__COLUMNS__')) = 1931 join(', ', @columns) 1932 if index($query, '__COLUMNS__') >= 0; 1933 my $result = $self->safe_psql($dbname, $query); 1934 1935 # hash slice, see http://stackoverflow.com/a/16755894/398670 . 1936 # 1937 # Fills the hash with empty strings produced by x-operator element 1938 # duplication if result is an empty row 1939 # 1940 my %val; 1941 @val{@columns} = 1942 $result ne '' ? split(qr/\|/, $result, -1) : ('',) x scalar(@columns); 1943 return \%val; 1944} 1945 1946=pod 1947 1948=item $node->slot(slot_name) 1949 1950Return hash-ref of replication slot data for the named slot, or a hash-ref with 1951all values '' if not found. Does not differentiate between null and empty string 1952for fields, no field is ever undef. 1953 1954The restart_lsn and confirmed_flush_lsn fields are returned verbatim, and also 1955as a 2-list of [highword, lowword] integer. Since we rely on Perl 5.8.8 we can't 1956"use bigint", it's from 5.20, and we can't assume we have Math::Bigint from CPAN 1957either. 1958 1959=cut 1960 1961sub slot 1962{ 1963 my ($self, $slot_name) = @_; 1964 my @columns = ( 1965 'plugin', 'slot_type', 'datoid', 'database', 1966 'active', 'active_pid', 'xmin', 'catalog_xmin', 1967 'restart_lsn'); 1968 return $self->query_hash( 1969 'postgres', 1970"SELECT __COLUMNS__ FROM pg_catalog.pg_replication_slots WHERE slot_name = '$slot_name'", 1971 @columns); 1972} 1973 1974=pod 1975 1976=item $node->pg_recvlogical_upto(self, dbname, slot_name, endpos, timeout_secs, ...) 1977 1978Invoke pg_recvlogical to read from slot_name on dbname until LSN endpos, which 1979corresponds to pg_recvlogical --endpos. Gives up after timeout (if nonzero). 1980 1981Disallows pg_recvlogical from internally retrying on error by passing --no-loop. 1982 1983Plugin options are passed as additional keyword arguments. 1984 1985If called in scalar context, returns stdout, and die()s on timeout or nonzero return. 1986 1987If called in array context, returns a tuple of (retval, stdout, stderr, timeout). 1988timeout is the IPC::Run::Timeout object whose is_expired method can be tested 1989to check for timeout. retval is undef on timeout. 1990 1991=cut 1992 1993sub pg_recvlogical_upto 1994{ 1995 my ($self, $dbname, $slot_name, $endpos, $timeout_secs, %plugin_options) = 1996 @_; 1997 my ($stdout, $stderr); 1998 1999 my $timeout_exception = 'pg_recvlogical timed out'; 2000 2001 die 'slot name must be specified' unless defined($slot_name); 2002 die 'endpos must be specified' unless defined($endpos); 2003 2004 my @cmd = ( 2005 'pg_recvlogical', '-S', $slot_name, '--dbname', 2006 $self->connstr($dbname)); 2007 push @cmd, '--endpos', $endpos; 2008 push @cmd, '-f', '-', '--no-loop', '--start'; 2009 2010 while (my ($k, $v) = each %plugin_options) 2011 { 2012 die "= is not permitted to appear in replication option name" 2013 if ($k =~ qr/=/); 2014 push @cmd, "-o", "$k=$v"; 2015 } 2016 2017 my $timeout; 2018 $timeout = 2019 IPC::Run::timeout($timeout_secs, exception => $timeout_exception) 2020 if $timeout_secs; 2021 my $ret = 0; 2022 2023 do 2024 { 2025 local $@; 2026 eval { 2027 IPC::Run::run(\@cmd, ">", \$stdout, "2>", \$stderr, $timeout); 2028 $ret = $?; 2029 }; 2030 my $exc_save = $@; 2031 if ($exc_save) 2032 { 2033 2034 # IPC::Run::run threw an exception. re-throw unless it's a 2035 # timeout, which we'll handle by testing is_expired 2036 die $exc_save 2037 if (blessed($exc_save) || $exc_save !~ qr/$timeout_exception/); 2038 2039 $ret = undef; 2040 2041 die "Got timeout exception '$exc_save' but timer not expired?!" 2042 unless $timeout->is_expired; 2043 2044 die 2045"$exc_save waiting for endpos $endpos with stdout '$stdout', stderr '$stderr'" 2046 unless wantarray; 2047 } 2048 }; 2049 2050 $stdout =~ s/\r\n/\n/g if $Config{osname} eq 'msys'; 2051 $stderr =~ s/\r\n/\n/g if $Config{osname} eq 'msys'; 2052 2053 if (wantarray) 2054 { 2055 return ($ret, $stdout, $stderr, $timeout); 2056 } 2057 else 2058 { 2059 die 2060"pg_recvlogical exited with code '$ret', stdout '$stdout' and stderr '$stderr'" 2061 if $ret; 2062 return $stdout; 2063 } 2064} 2065 2066=pod 2067 2068=back 2069 2070=cut 2071 20721; 2073