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