aboutsummaryrefslogtreecommitdiff
path: root/src/test
diff options
context:
space:
mode:
authorAlvaro Herrera <alvherre@alvh.no-ip.org>2015-12-02 18:46:16 -0300
committerAlvaro Herrera <alvherre@alvh.no-ip.org>2015-12-02 18:46:16 -0300
commit1caef31d9e550408d0cbc5788a422dcb69736df5 (patch)
tree451c4745e315c8dba59415a83eb2c4963fded212 /src/test
parentc7485a82c3e29103757db75bb9ff8dac597387dc (diff)
downloadpostgresql-1caef31d9e550408d0cbc5788a422dcb69736df5.tar.gz
postgresql-1caef31d9e550408d0cbc5788a422dcb69736df5.zip
Refactor Perl test code
The original code was a bit clunky; make it more amenable for further reuse by creating a new Perl package PostgresNode, which is an object-oriented representation of a single server, with some support routines such as init, start, stop, psql. This serves as a better basis on which to build further test code, and enables writing tests that use more than one server without too much complication. This commit modifies a lot of the existing test files, mostly to remove explicit calls to system commands (pg_ctl) replacing them with method calls of a PostgresNode object. The result is quite a bit more straightforward. Also move some initialization code to BEGIN and INIT blocks instead of having it straight in as top-level code. This commit also introduces package RecursiveCopy so that we can copy whole directories without having to depend on packages that may not be present on vanilla Perl 5.8 installations. I also ran perltidy on the modified files, which changes some code sites that are not otherwise touched by this patch. I tried to avoid this, but it ended up being more trouble than it's worth. Authors: Michael Paquier, Álvaro Herrera Review: Noah Misch
Diffstat (limited to 'src/test')
-rw-r--r--src/test/perl/PostgresNode.pm470
-rw-r--r--src/test/perl/RecursiveCopy.pm42
-rw-r--r--src/test/perl/TestLib.pm319
-rw-r--r--src/test/ssl/ServerSetup.pm34
-rw-r--r--src/test/ssl/t/001_ssltests.pl33
5 files changed, 657 insertions, 241 deletions
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
new file mode 100644
index 00000000000..aa7a00c9fa4
--- /dev/null
+++ b/src/test/perl/PostgresNode.pm
@@ -0,0 +1,470 @@
+# PostgresNode, class representing a data directory and postmaster.
+#
+# This contains a basic set of routines able to work on a PostgreSQL node,
+# allowing to start, stop, backup and initialize it with various options.
+# The set of nodes managed by a given test is also managed by this module.
+
+package PostgresNode;
+
+use strict;
+use warnings;
+
+use Config;
+use Cwd;
+use Exporter 'import';
+use File::Basename;
+use File::Spec;
+use File::Temp ();
+use IPC::Run;
+use PostgresNode;
+use RecursiveCopy;
+use Test::More;
+use TestLib ();
+
+our @EXPORT = qw(
+ get_new_node
+);
+
+our ($test_pghost, $last_port_assigned, @all_nodes);
+
+BEGIN
+{
+
+ # PGHOST is set once and for all through a single series of tests when
+ # this module is loaded.
+ $test_pghost =
+ $TestLib::windows_os ? "127.0.0.1" : TestLib::tempdir_short;
+ $ENV{PGHOST} = $test_pghost;
+ $ENV{PGDATABASE} = 'postgres';
+
+ # Tracking of last port value assigned to accelerate free port lookup.
+ # XXX: Should this use PG_VERSION_NUM?
+ $last_port_assigned = 90600 % 16384 + 49152;
+
+ # Node tracking
+ @all_nodes = ();
+}
+
+sub new
+{
+ my $class = shift;
+ my $pghost = shift;
+ my $pgport = shift;
+ my $self = {
+ _port => $pgport,
+ _host => $pghost,
+ _basedir => TestLib::tempdir,
+ _applname => "node_$pgport",
+ _logfile => "$TestLib::log_path/node_$pgport.log" };
+
+ bless $self, $class;
+ $self->dump_info;
+
+ return $self;
+}
+
+sub port
+{
+ my ($self) = @_;
+ return $self->{_port};
+}
+
+sub host
+{
+ my ($self) = @_;
+ return $self->{_host};
+}
+
+sub basedir
+{
+ my ($self) = @_;
+ return $self->{_basedir};
+}
+
+sub applname
+{
+ my ($self) = @_;
+ return $self->{_applname};
+}
+
+sub logfile
+{
+ my ($self) = @_;
+ return $self->{_logfile};
+}
+
+sub connstr
+{
+ my ($self, $dbname) = @_;
+ my $pgport = $self->port;
+ my $pghost = $self->host;
+ if (!defined($dbname))
+ {
+ return "port=$pgport host=$pghost";
+ }
+ return "port=$pgport host=$pghost dbname=$dbname";
+}
+
+sub data_dir
+{
+ my ($self) = @_;
+ my $res = $self->basedir;
+ return "$res/pgdata";
+}
+
+sub archive_dir
+{
+ my ($self) = @_;
+ my $basedir = $self->basedir;
+ return "$basedir/archives";
+}
+
+sub backup_dir
+{
+ my ($self) = @_;
+ my $basedir = $self->basedir;
+ return "$basedir/backup";
+}
+
+# Dump node information
+sub dump_info
+{
+ my ($self) = @_;
+ print "Data directory: " . $self->data_dir . "\n";
+ print "Backup directory: " . $self->backup_dir . "\n";
+ print "Archive directory: " . $self->archive_dir . "\n";
+ print "Connection string: " . $self->connstr . "\n";
+ print "Application name: " . $self->applname . "\n";
+ print "Log file: " . $self->logfile . "\n";
+}
+
+sub set_replication_conf
+{
+ my ($self) = @_;
+ my $pgdata = $self->data_dir;
+
+ open my $hba, ">>$pgdata/pg_hba.conf";
+ print $hba "\n# Allow replication (set up by PostgresNode.pm)\n";
+ if (!$TestLib::windows_os)
+ {
+ print $hba "local replication all trust\n";
+ }
+ else
+ {
+ print $hba
+"host replication all 127.0.0.1/32 sspi include_realm=1 map=regress\n";
+ }
+ close $hba;
+}
+
+# Initialize a new cluster for testing.
+#
+# Authentication is set up so that only the current OS user can access the
+# cluster. On Unix, we use Unix domain socket connections, with the socket in
+# a directory that's only accessible to the current user to ensure that.
+# On Windows, we use SSPI authentication to ensure the same (by pg_regress
+# --config-auth).
+sub init
+{
+ my ($self, %params) = @_;
+ my $port = $self->port;
+ my $pgdata = $self->data_dir;
+ my $host = $self->host;
+
+ $params{hba_permit_replication} = 1
+ if (!defined($params{hba_permit_replication}));
+
+ mkdir $self->backup_dir;
+ mkdir $self->archive_dir;
+
+ TestLib::system_or_bail('initdb', '-D', $pgdata, '-A', 'trust', '-N');
+ TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata);
+
+ open my $conf, ">>$pgdata/postgresql.conf";
+ print $conf "\n# Added by PostgresNode.pm)\n";
+ print $conf "fsync = off\n";
+ print $conf "log_statement = all\n";
+ print $conf "port = $port\n";
+ if ($TestLib::windows_os)
+ {
+ print $conf "listen_addresses = '$host'\n";
+ }
+ else
+ {
+ print $conf "unix_socket_directories = '$host'\n";
+ print $conf "listen_addresses = ''\n";
+ }
+ close $conf;
+
+ $self->set_replication_conf if ($params{hba_permit_replication});
+}
+
+sub append_conf
+{
+ my ($self, $filename, $str) = @_;
+
+ my $conffile = $self->data_dir . '/' . $filename;
+
+ TestLib::append_to_file($conffile, $str);
+}
+
+sub backup
+{
+ my ($self, $backup_name) = @_;
+ my $backup_path = $self->backup_dir . '/' . $backup_name;
+ my $port = $self->port;
+
+ print "# Taking backup $backup_name from node with port $port\n";
+ TestLib::system_or_bail("pg_basebackup -D $backup_path -p $port -x");
+ print "# Backup finished\n";
+}
+
+sub init_from_backup
+{
+ my ($self, $root_node, $backup_name) = @_;
+ my $backup_path = $root_node->backup_dir . '/' . $backup_name;
+ my $port = $self->port;
+ my $root_port = $root_node->port;
+
+ print
+"Initializing node $port from backup \"$backup_name\" of node $root_port\n";
+ die "Backup $backup_path does not exist" unless -d $backup_path;
+
+ mkdir $self->backup_dir;
+ mkdir $self->archive_dir;
+
+ my $data_path = $self->data_dir;
+ rmdir($data_path);
+ RecursiveCopy::copypath($backup_path, $data_path);
+ chmod(0700, $data_path);
+
+ # Base configuration for this node
+ $self->append_conf(
+ 'postgresql.conf',
+ qq(
+port = $port
+));
+ $self->set_replication_conf;
+}
+
+sub start
+{
+ my ($self) = @_;
+ my $port = $self->port;
+ my $pgdata = $self->data_dir;
+ print("### Starting test server in $pgdata\n");
+ my $ret = TestLib::system_log('pg_ctl', '-w', '-D', $self->data_dir, '-l',
+ $self->logfile, 'start');
+
+ if ($ret != 0)
+ {
+ print "# pg_ctl failed; logfile:\n";
+ print TestLib::slurp_file($self->logfile);
+ BAIL_OUT("pg_ctl failed");
+ }
+
+ $self->_update_pid;
+
+}
+
+sub stop
+{
+ my ($self, $mode) = @_;
+ my $port = $self->port;
+ my $pgdata = $self->data_dir;
+ $mode = 'fast' if (!defined($mode));
+ print "### Stopping node in $pgdata with port $port using mode $mode\n";
+ TestLib::system_log('pg_ctl', '-D', $pgdata, '-m', $mode, 'stop');
+ $self->{_pid} = undef;
+ $self->_update_pid;
+}
+
+sub restart
+{
+ my ($self) = @_;
+ my $port = $self->port;
+ my $pgdata = $self->data_dir;
+ my $logfile = $self->logfile;
+ TestLib::system_log('pg_ctl', '-D', $pgdata, '-w', '-l', $logfile,
+ 'restart');
+ $self->_update_pid;
+}
+
+sub _update_pid
+{
+ my $self = shift;
+
+ # If we can open the PID file, read its first line and that's the PID we
+ # want. If the file cannot be opened, presumably the server is not
+ # running; don't be noisy in that case.
+ open my $pidfile, $self->data_dir . "/postmaster.pid";
+ if (not defined $pidfile)
+ {
+ $self->{_pid} = undef;
+ print "# No postmaster PID\n";
+ return;
+ }
+
+ $self->{_pid} = <$pidfile>;
+ print "# Postmaster PID is $self->{_pid}\n";
+ close $pidfile;
+}
+
+#
+# Cluster management functions
+#
+
+# Build a new PostgresNode object, assigning a free port number.
+#
+# We also register the node, to avoid the port number from being reused
+# for another node even when this one is not active.
+sub get_new_node
+{
+ my $found = 0;
+ my $port = $last_port_assigned;
+
+ while ($found == 0)
+ {
+ $port++;
+ print "# Checking for port $port\n";
+ my $devnull = $TestLib::windows_os ? "nul" : "/dev/null";
+ if (!TestLib::run_log([ 'pg_isready', '-p', $port ]))
+ {
+ $found = 1;
+
+ # Found a potential candidate port number. Check first that it is
+ # not included in the list of registered nodes.
+ foreach my $node (@all_nodes)
+ {
+ $found = 0 if ($node->port == $port);
+ }
+ }
+ }
+
+ print "# Found free port $port\n";
+
+ # Lock port number found by creating a new node
+ my $node = new PostgresNode($test_pghost, $port);
+
+ # Add node to list of nodes
+ push(@all_nodes, $node);
+
+ # And update port for next time
+ $last_port_assigned = $port;
+
+ return $node;
+}
+
+sub DESTROY
+{
+ my $self = shift;
+ return if not defined $self->{_pid};
+ print "# signalling QUIT to $self->{_pid}\n";
+ kill 'QUIT', $self->{_pid};
+}
+
+sub teardown_node
+{
+ my $self = shift;
+
+ $self->stop('immediate');
+}
+
+sub psql
+{
+ my ($self, $dbname, $sql) = @_;
+
+ my ($stdout, $stderr);
+ print("# Running SQL command: $sql\n");
+
+ IPC::Run::run [ 'psql', '-XAtq', '-d', $self->connstr($dbname), '-f',
+ '-' ], '<', \$sql, '>', \$stdout, '2>', \$stderr
+ or die;
+
+ if ($stderr ne "")
+ {
+ print "#### Begin standard error\n";
+ print $stderr;
+ print "#### End standard error\n";
+ }
+ chomp $stdout;
+ $stdout =~ s/\r//g if $Config{osname} eq 'msys';
+ return $stdout;
+}
+
+# Run a query once a second, until it returns 't' (i.e. SQL boolean true).
+sub poll_query_until
+{
+ my ($self, $dbname, $query) = @_;
+
+ my $max_attempts = 30;
+ my $attempts = 0;
+ my ($stdout, $stderr);
+
+ while ($attempts < $max_attempts)
+ {
+ my $cmd =
+ [ 'psql', '-At', '-c', $query, '-d', $self->connstr($dbname) ];
+ my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
+
+ chomp($stdout);
+ $stdout =~ s/\r//g if $Config{osname} eq 'msys';
+ if ($stdout eq "t")
+ {
+ return 1;
+ }
+
+ # Wait a second before retrying.
+ sleep 1;
+ $attempts++;
+ }
+
+ # The query result didn't change in 30 seconds. Give up. Print the stderr
+ # from the last attempt, hopefully that's useful for debugging.
+ diag $stderr;
+ return 0;
+}
+
+sub command_ok
+{
+ my $self = shift;
+
+ local $ENV{PGPORT} = $self->port;
+
+ TestLib::command_ok(@_);
+}
+
+sub command_fails
+{
+ my $self = shift;
+
+ local $ENV{PGPORT} = $self->port;
+
+ TestLib::command_fails(@_);
+}
+
+sub command_like
+{
+ my $self = shift;
+
+ local $ENV{PGPORT} = $self->port;
+
+ TestLib::command_like(@_);
+}
+
+# Run a command on the node, then verify that $expected_sql appears in the
+# server log file.
+sub issues_sql_like
+{
+ my ($self, $cmd, $expected_sql, $test_name) = @_;
+
+ local $ENV{PGPORT} = $self->port;
+
+ truncate $self->logfile, 0;
+ my $result = TestLib::run_log($cmd);
+ ok($result, "@$cmd exit code 0");
+ my $log = TestLib::slurp_file($self->logfile);
+ like($log, $expected_sql, "$test_name: SQL found in server log");
+}
+
+1;
diff --git a/src/test/perl/RecursiveCopy.pm b/src/test/perl/RecursiveCopy.pm
new file mode 100644
index 00000000000..9362aa89590
--- /dev/null
+++ b/src/test/perl/RecursiveCopy.pm
@@ -0,0 +1,42 @@
+# RecursiveCopy, a simple recursive copy implementation
+package RecursiveCopy;
+
+use strict;
+use warnings;
+
+use File::Basename;
+use File::Copy;
+
+sub copypath
+{
+ my $srcpath = shift;
+ my $destpath = shift;
+
+ die "Cannot operate on symlinks" if -l $srcpath or -l $destpath;
+
+ # This source path is a file, simply copy it to destination with the
+ # same name.
+ die "Destination path $destpath exists as file" if -f $destpath;
+ if (-f $srcpath)
+ {
+ copy($srcpath, $destpath)
+ or die "copy $srcpath -> $destpath failed: $!";
+ return 1;
+ }
+
+ die "Destination needs to be a directory" unless -d $srcpath;
+ mkdir($destpath) or die "mkdir($destpath) failed: $!";
+
+ # Scan existing source directory and recursively copy everything.
+ opendir(my $directory, $srcpath) or die "could not opendir($srcpath): $!";
+ while (my $entry = readdir($directory))
+ {
+ next if ($entry eq '.' || $entry eq '..');
+ RecursiveCopy::copypath("$srcpath/$entry", "$destpath/$entry")
+ or die "copypath $srcpath/$entry -> $destpath/$entry failed";
+ }
+ closedir($directory);
+ return 1;
+}
+
+1;
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index 02533ebde53..af46dc8c7a2 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -1,3 +1,10 @@
+# TestLib, low-level routines and actions regression tests.
+#
+# This module contains a set of routines dedicated to environment setup for
+# a PostgreSQL regression test tun, and includes some low-level routines
+# aimed at controlling command execution, logging and test functions. This
+# module should never depend on any other PostgreSQL regression test modules.
+
package TestLib;
use strict;
@@ -5,16 +12,17 @@ use warnings;
use Config;
use Exporter 'import';
+use File::Basename;
+use File::Spec;
+use File::Temp ();
+use IPC::Run;
+use SimpleTee;
+use Test::More;
+
our @EXPORT = qw(
- tempdir
- tempdir_short
- standard_initdb
- configure_hba_for_replication
- start_test_server
- restart_test_server
- psql
slurp_dir
slurp_file
+ append_to_file
system_or_bail
system_log
run_log
@@ -26,88 +34,82 @@ our @EXPORT = qw(
program_version_ok
program_options_handling_ok
command_like
- issues_sql_like
- $tmp_check
- $log_path
$windows_os
);
-use Cwd;
-use File::Basename;
-use File::Spec;
-use File::Temp ();
-use IPC::Run qw(run start);
+our ($windows_os, $tmp_check, $log_path, $test_logfile);
-use SimpleTee;
-
-use Test::More;
-
-our $windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys';
-
-# Open log file. For each test, the log file name uses the name of the
-# file launching this module, without the .pl suffix.
-our ($tmp_check, $log_path);
-$tmp_check = $ENV{TESTDIR} ? "$ENV{TESTDIR}/tmp_check" : "tmp_check";
-$log_path = "$tmp_check/log";
-mkdir $tmp_check;
-mkdir $log_path;
-my $test_logfile = basename($0);
-$test_logfile =~ s/\.[^.]+$//;
-$test_logfile = "$log_path/regress_log_$test_logfile";
-open TESTLOG, '>', $test_logfile or die "Cannot open STDOUT to logfile: $!";
-
-# Hijack STDOUT and STDERR to the log file
-open(ORIG_STDOUT, ">&STDOUT");
-open(ORIG_STDERR, ">&STDERR");
-open(STDOUT, ">&TESTLOG");
-open(STDERR, ">&TESTLOG");
-
-# The test output (ok ...) needs to be printed to the original STDOUT so
-# that the 'prove' program can parse it, and display it to the user in
-# real time. But also copy it to the log file, to provide more context
-# in the log.
-my $builder = Test::More->builder;
-my $fh = $builder->output;
-tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG;
-$fh = $builder->failure_output;
-tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG;
-
-# Enable auto-flushing for all the file handles. Stderr and stdout are
-# redirected to the same file, and buffering causes the lines to appear
-# in the log in confusing order.
-autoflush STDOUT 1;
-autoflush STDERR 1;
-autoflush TESTLOG 1;
-
-# Set to untranslated messages, to be able to compare program output
-# with expected strings.
-delete $ENV{LANGUAGE};
-delete $ENV{LC_ALL};
-$ENV{LC_MESSAGES} = 'C';
-
-delete $ENV{PGCONNECT_TIMEOUT};
-delete $ENV{PGDATA};
-delete $ENV{PGDATABASE};
-delete $ENV{PGHOSTADDR};
-delete $ENV{PGREQUIRESSL};
-delete $ENV{PGSERVICE};
-delete $ENV{PGSSLMODE};
-delete $ENV{PGUSER};
-
-if (!$ENV{PGPORT})
+BEGIN
{
- $ENV{PGPORT} = 65432;
+
+ # Set to untranslated messages, to be able to compare program output
+ # with expected strings.
+ delete $ENV{LANGUAGE};
+ delete $ENV{LC_ALL};
+ $ENV{LC_MESSAGES} = 'C';
+
+ delete $ENV{PGCONNECT_TIMEOUT};
+ delete $ENV{PGDATA};
+ delete $ENV{PGDATABASE};
+ delete $ENV{PGHOSTADDR};
+ delete $ENV{PGREQUIRESSL};
+ delete $ENV{PGSERVICE};
+ delete $ENV{PGSSLMODE};
+ delete $ENV{PGUSER};
+ delete $ENV{PGPORT};
+ delete $ENV{PGHOST};
+
+ # Must be set early
+ $windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys';
}
-$ENV{PGPORT} = int($ENV{PGPORT}) % 65536;
+INIT
+{
+ # Determine output directories, and create them. The base path is the
+ # TESTDIR environment variable, which is normally set by the invoking
+ # Makefile.
+ $tmp_check = $ENV{TESTDIR} ? "$ENV{TESTDIR}/tmp_check" : "tmp_check";
+ $log_path = "$tmp_check/log";
+
+ mkdir $tmp_check;
+ mkdir $log_path;
+
+ # Open the test log file, whose name depends on the test name.
+ $test_logfile = basename($0);
+ $test_logfile =~ s/\.[^.]+$//;
+ $test_logfile = "$log_path/regress_log_$test_logfile";
+ open TESTLOG, '>', $test_logfile
+ or die "could not open STDOUT to logfile \"$test_logfile\": $!";
+
+ # Hijack STDOUT and STDERR to the log file
+ open(ORIG_STDOUT, ">&STDOUT");
+ open(ORIG_STDERR, ">&STDERR");
+ open(STDOUT, ">&TESTLOG");
+ open(STDERR, ">&TESTLOG");
+
+ # The test output (ok ...) needs to be printed to the original STDOUT so
+ # that the 'prove' program can parse it, and display it to the user in
+ # real time. But also copy it to the log file, to provide more context
+ # in the log.
+ my $builder = Test::More->builder;
+ my $fh = $builder->output;
+ tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG;
+ $fh = $builder->failure_output;
+ tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG;
+
+ # Enable auto-flushing for all the file handles. Stderr and stdout are
+ # redirected to the same file, and buffering causes the lines to appear
+ # in the log in confusing order.
+ autoflush STDOUT 1;
+ autoflush STDERR 1;
+ autoflush TESTLOG 1;
+}
#
# Helper functions
#
-
-
sub tempdir
{
return File::Temp::tempdir(
@@ -124,117 +126,31 @@ sub tempdir_short
return File::Temp::tempdir(CLEANUP => 1);
}
-# Initialize a new cluster for testing.
-#
-# The PGHOST environment variable is set to connect to the new cluster.
-#
-# Authentication is set up so that only the current OS user can access the
-# cluster. On Unix, we use Unix domain socket connections, with the socket in
-# a directory that's only accessible to the current user to ensure that.
-# On Windows, we use SSPI authentication to ensure the same (by pg_regress
-# --config-auth).
-sub standard_initdb
-{
- my $pgdata = shift;
- system_or_bail('initdb', '-D', "$pgdata", '-A' , 'trust', '-N');
- system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata);
-
- my $tempdir_short = tempdir_short;
-
- open CONF, ">>$pgdata/postgresql.conf";
- print CONF "\n# Added by TestLib.pm)\n";
- print CONF "fsync = off\n";
- if ($windows_os)
- {
- print CONF "listen_addresses = '127.0.0.1'\n";
- }
- else
- {
- print CONF "unix_socket_directories = '$tempdir_short'\n";
- print CONF "listen_addresses = ''\n";
- }
- close CONF;
-
- $ENV{PGHOST} = $windows_os ? "127.0.0.1" : $tempdir_short;
-}
-
-# Set up the cluster to allow replication connections, in the same way that
-# standard_initdb does for normal connections.
-sub configure_hba_for_replication
-{
- my $pgdata = shift;
-
- open HBA, ">>$pgdata/pg_hba.conf";
- print HBA "\n# Allow replication (set up by TestLib.pm)\n";
- if (! $windows_os)
- {
- print HBA "local replication all trust\n";
- }
- else
- {
- print HBA "host replication all 127.0.0.1/32 sspi include_realm=1 map=regress\n";
- }
- close HBA;
-}
-
-my ($test_server_datadir, $test_server_logfile);
-
-
-# Initialize a new cluster for testing in given directory, and start it.
-sub start_test_server
-{
- my ($tempdir) = @_;
- my $ret;
-
- print("### Starting test server in $tempdir\n");
- standard_initdb "$tempdir/pgdata";
-
- $ret = system_log('pg_ctl', '-D', "$tempdir/pgdata", '-w', '-l',
- "$log_path/postmaster.log", '-o', "--log-statement=all",
- 'start');
-
- if ($ret != 0)
- {
- print "# pg_ctl failed; logfile:\n";
- system('cat', "$log_path/postmaster.log");
- BAIL_OUT("pg_ctl failed");
- }
-
- $test_server_datadir = "$tempdir/pgdata";
- $test_server_logfile = "$log_path/postmaster.log";
-}
-
-sub restart_test_server
+sub system_log
{
- print("### Restarting test server\n");
- system_log('pg_ctl', '-D', $test_server_datadir, '-w', '-l',
- $test_server_logfile, 'restart');
+ print("# Running: " . join(" ", @_) . "\n");
+ return system(@_);
}
-END
+sub system_or_bail
{
- if ($test_server_datadir)
+ if (system_log(@_) != 0)
{
- system_log('pg_ctl', '-D', $test_server_datadir, '-m',
- 'immediate', 'stop');
+ BAIL_OUT("system $_[0] failed");
}
}
-sub psql
+sub run_log
{
- my ($dbname, $sql) = @_;
- my ($stdout, $stderr);
- print("# Running SQL command: $sql\n");
- run [ 'psql', '-X', '-A', '-t', '-q', '-d', $dbname, '-f', '-' ], '<', \$sql, '>', \$stdout, '2>', \$stderr or die;
- chomp $stdout;
- $stdout =~ s/\r//g if $Config{osname} eq 'msys';
- return $stdout;
+ print("# Running: " . join(" ", @{ $_[0] }) . "\n");
+ return run(@_);
}
sub slurp_dir
{
my ($dir) = @_;
- opendir(my $dh, $dir) or die;
+ opendir(my $dh, $dir)
+ or die "could not opendir \"$dir\": $!";
my @direntries = readdir $dh;
closedir $dh;
return @direntries;
@@ -249,32 +165,18 @@ sub slurp_file
return $contents;
}
-sub system_or_bail
-{
- if (system_log(@_) != 0)
- {
- BAIL_OUT("system $_[0] failed: $?");
- }
-}
-
-sub system_log
+sub append_to_file
{
- print("# Running: " . join(" ", @_) ."\n");
- return system(@_);
-}
+ my ($filename, $str) = @_;
-sub run_log
-{
- print("# Running: " . join(" ", @{$_[0]}) ."\n");
- return run (@_);
+ open my $fh, ">>", $filename or die "could not open \"$filename\": $!";
+ print $fh $str;
+ close $fh;
}
-
#
# Test functions
#
-
-
sub command_ok
{
my ($cmd, $test_name) = @_;
@@ -292,8 +194,8 @@ sub command_fails
sub command_exit_is
{
my ($cmd, $expected, $test_name) = @_;
- print("# Running: " . join(" ", @{$cmd}) ."\n");
- my $h = start $cmd;
+ print("# Running: " . join(" ", @{$cmd}) . "\n");
+ my $h = IPC::Run::start $cmd;
$h->finish();
# On Windows, the exit status of the process is returned directly as the
@@ -303,8 +205,10 @@ sub command_exit_is
# assuming the Unix convention, which will always return 0 on Windows as
# long as the process was not terminated by an exception. To work around
# that, use $h->full_result on Windows instead.
- my $result = ($Config{osname} eq "MSWin32") ?
- ($h->full_results)[0] : $h->result(0);
+ my $result =
+ ($Config{osname} eq "MSWin32")
+ ? ($h->full_results)[0]
+ : $h->result(0);
is($result, $expected, $test_name);
}
@@ -313,7 +217,8 @@ sub program_help_ok
my ($cmd) = @_;
my ($stdout, $stderr);
print("# Running: $cmd --help\n");
- my $result = run [ $cmd, '--help' ], '>', \$stdout, '2>', \$stderr;
+ my $result = IPC::Run::run [ $cmd, '--help' ], '>', \$stdout, '2>',
+ \$stderr;
ok($result, "$cmd --help exit code 0");
isnt($stdout, '', "$cmd --help goes to stdout");
is($stderr, '', "$cmd --help nothing to stderr");
@@ -324,7 +229,8 @@ sub program_version_ok
my ($cmd) = @_;
my ($stdout, $stderr);
print("# Running: $cmd --version\n");
- my $result = run [ $cmd, '--version' ], '>', \$stdout, '2>', \$stderr;
+ my $result = IPC::Run::run [ $cmd, '--version' ], '>', \$stdout, '2>',
+ \$stderr;
ok($result, "$cmd --version exit code 0");
isnt($stdout, '', "$cmd --version goes to stdout");
is($stderr, '', "$cmd --version nothing to stderr");
@@ -335,8 +241,9 @@ sub program_options_handling_ok
my ($cmd) = @_;
my ($stdout, $stderr);
print("# Running: $cmd --not-a-valid-option\n");
- my $result = run [ $cmd, '--not-a-valid-option' ], '>', \$stdout, '2>',
- \$stderr;
+ my $result = IPC::Run::run [ $cmd, '--not-a-valid-option' ], '>',
+ \$stdout,
+ '2>', \$stderr;
ok(!$result, "$cmd with invalid option nonzero exit code");
isnt($stderr, '', "$cmd with invalid option prints error message");
}
@@ -346,20 +253,10 @@ sub command_like
my ($cmd, $expected_stdout, $test_name) = @_;
my ($stdout, $stderr);
print("# Running: " . join(" ", @{$cmd}) . "\n");
- my $result = run $cmd, '>', \$stdout, '2>', \$stderr;
+ my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
ok($result, "@$cmd exit code 0");
is($stderr, '', "@$cmd no stderr");
like($stdout, $expected_stdout, "$test_name: matches");
}
-sub issues_sql_like
-{
- my ($cmd, $expected_sql, $test_name) = @_;
- truncate $test_server_logfile, 0;
- my $result = run_log($cmd);
- ok($result, "@$cmd exit code 0");
- my $log = slurp_file($test_server_logfile);
- like($log, $expected_sql, "$test_name: SQL found in server log");
-}
-
1;
diff --git a/src/test/ssl/ServerSetup.pm b/src/test/ssl/ServerSetup.pm
index a6c77b5c80a..4e93184eb03 100644
--- a/src/test/ssl/ServerSetup.pm
+++ b/src/test/ssl/ServerSetup.pm
@@ -18,6 +18,7 @@ package ServerSetup;
use strict;
use warnings;
+use PostgresNode;
use TestLib;
use File::Basename;
use File::Copy;
@@ -45,17 +46,19 @@ sub copy_files
sub configure_test_server_for_ssl
{
- my $tempdir = $_[0];
+ my $node = $_[0];
my $serverhost = $_[1];
+ my $pgdata = $node->data_dir;
+
# Create test users and databases
- psql 'postgres', "CREATE USER ssltestuser";
- psql 'postgres', "CREATE USER anotheruser";
- psql 'postgres', "CREATE DATABASE trustdb";
- psql 'postgres', "CREATE DATABASE certdb";
+ $node->psql('postgres', "CREATE USER ssltestuser");
+ $node->psql('postgres', "CREATE USER anotheruser");
+ $node->psql('postgres', "CREATE DATABASE trustdb");
+ $node->psql('postgres', "CREATE DATABASE certdb");
# enable logging etc.
- open CONF, ">>$tempdir/pgdata/postgresql.conf";
+ open CONF, ">>$pgdata/postgresql.conf";
print CONF "fsync=off\n";
print CONF "log_connections=on\n";
print CONF "log_hostname=on\n";
@@ -68,17 +71,17 @@ sub configure_test_server_for_ssl
close CONF;
# Copy all server certificates and keys, and client root cert, to the data dir
- copy_files("ssl/server-*.crt", "$tempdir/pgdata");
- copy_files("ssl/server-*.key", "$tempdir/pgdata");
- chmod(0600, glob "$tempdir/pgdata/server-*.key") or die $!;
- copy_files("ssl/root+client_ca.crt", "$tempdir/pgdata");
- copy_files("ssl/root+client.crl", "$tempdir/pgdata");
+ copy_files("ssl/server-*.crt", $pgdata);
+ copy_files("ssl/server-*.key", $pgdata);
+ chmod(0600, glob "$pgdata/server-*.key") or die $!;
+ copy_files("ssl/root+client_ca.crt", $pgdata);
+ copy_files("ssl/root+client.crl", $pgdata);
# Only accept SSL connections from localhost. Our tests don't depend on this
# but seems best to keep it as narrow as possible for security reasons.
#
# When connecting to certdb, also check the client certificate.
- open HBA, ">$tempdir/pgdata/pg_hba.conf";
+ open HBA, ">$pgdata/pg_hba.conf";
print HBA
"# TYPE DATABASE USER ADDRESS METHOD\n";
print HBA
@@ -96,12 +99,13 @@ sub configure_test_server_for_ssl
# the server so that the configuration takes effect.
sub switch_server_cert
{
- my $tempdir = $_[0];
+ my $node = $_[0];
my $certfile = $_[1];
+ my $pgdata = $node->data_dir;
diag "Restarting server with certfile \"$certfile\"...";
- open SSLCONF, ">$tempdir/pgdata/sslconfig.conf";
+ open SSLCONF, ">$pgdata/sslconfig.conf";
print SSLCONF "ssl=on\n";
print SSLCONF "ssl_ca_file='root+client_ca.crt'\n";
print SSLCONF "ssl_cert_file='$certfile.crt'\n";
@@ -110,5 +114,5 @@ sub switch_server_cert
close SSLCONF;
# Stop and restart server to reload the new config.
- restart_test_server();
+ $node->restart;
}
diff --git a/src/test/ssl/t/001_ssltests.pl b/src/test/ssl/t/001_ssltests.pl
index 0d6f339335d..92f16e4a11d 100644
--- a/src/test/ssl/t/001_ssltests.pl
+++ b/src/test/ssl/t/001_ssltests.pl
@@ -1,5 +1,7 @@
use strict;
use warnings;
+use PostgresNode;
+use TestLib;
use TestLib;
use Test::More tests => 38;
use ServerSetup;
@@ -25,8 +27,6 @@ BEGIN
# postgresql-ssl-regression.test.
my $SERVERHOSTADDR = '127.0.0.1';
-my $tempdir = TestLib::tempdir;
-
# Define a couple of helper functions to test connecting to the server.
my $common_connstr;
@@ -74,10 +74,17 @@ chmod 0600, "ssl/client.key";
#### Part 0. Set up the server.
-diag "setting up data directory in \"$tempdir\"...";
-start_test_server($tempdir);
-configure_test_server_for_ssl($tempdir, $SERVERHOSTADDR);
-switch_server_cert($tempdir, 'server-cn-only');
+diag "setting up data directory...";
+my $node = get_new_node();
+$node->init;
+
+# PGHOST is enforced here to set up the node, subsequent connections
+# will use a dedicated connection string.
+$ENV{PGHOST} = $node->host;
+$ENV{PGPORT} = $node->port;
+$node->start;
+configure_test_server_for_ssl($node, $SERVERHOSTADDR);
+switch_server_cert($node, 'server-cn-only');
### Part 1. Run client-side tests.
###
@@ -150,7 +157,7 @@ test_connect_ok("sslmode=verify-ca host=wronghost.test");
test_connect_fails("sslmode=verify-full host=wronghost.test");
# Test Subject Alternative Names.
-switch_server_cert($tempdir, 'server-multiple-alt-names');
+switch_server_cert($node, 'server-multiple-alt-names');
diag "test hostname matching with X509 Subject Alternative Names";
$common_connstr =
@@ -165,7 +172,7 @@ test_connect_fails("host=deep.subdomain.wildcard.pg-ssltest.test");
# Test certificate with a single Subject Alternative Name. (this gives a
# slightly different error message, that's all)
-switch_server_cert($tempdir, 'server-single-alt-name');
+switch_server_cert($node, 'server-single-alt-name');
diag "test hostname matching with a single X509 Subject Alternative Name";
$common_connstr =
@@ -178,7 +185,7 @@ test_connect_fails("host=deep.subdomain.wildcard.pg-ssltest.test");
# Test server certificate with a CN and SANs. Per RFCs 2818 and 6125, the CN
# should be ignored when the certificate has both.
-switch_server_cert($tempdir, 'server-cn-and-alt-names');
+switch_server_cert($node, 'server-cn-and-alt-names');
diag "test certificate with both a CN and SANs";
$common_connstr =
@@ -190,7 +197,7 @@ test_connect_fails("host=common-name.pg-ssltest.test");
# Finally, test a server certificate that has no CN or SANs. Of course, that's
# not a very sensible certificate, but libpq should handle it gracefully.
-switch_server_cert($tempdir, 'server-no-names');
+switch_server_cert($node, 'server-no-names');
$common_connstr =
"user=ssltestuser dbname=trustdb sslcert=invalid sslrootcert=ssl/root+server_ca.crt hostaddr=$SERVERHOSTADDR";
@@ -199,7 +206,7 @@ test_connect_fails("sslmode=verify-full host=common-name.pg-ssltest.test");
# Test that the CRL works
diag "Testing client-side CRL";
-switch_server_cert($tempdir, 'server-revoked');
+switch_server_cert($node, 'server-revoked');
$common_connstr =
"user=ssltestuser dbname=trustdb sslcert=invalid hostaddr=$SERVERHOSTADDR host=common-name.pg-ssltest.test";
@@ -233,7 +240,3 @@ test_connect_fails(
test_connect_fails(
"user=ssltestuser sslcert=ssl/client-revoked.crt sslkey=ssl/client-revoked.key"
);
-
-
-# All done! Save the log, before the temporary installation is deleted
-copy("$tempdir/client-log", "./client-log");