summaryrefslogtreecommitdiffstats
path: root/t/TestLib.pm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--t/TestLib.pm262
1 files changed, 262 insertions, 0 deletions
diff --git a/t/TestLib.pm b/t/TestLib.pm
new file mode 100644
index 0000000..6047cf9
--- /dev/null
+++ b/t/TestLib.pm
@@ -0,0 +1,262 @@
+# Common functionality for postgresql-common self tests
+#
+# (C) 2005-2009 Martin Pitt <mpitt@debian.org>
+# (C) 2013-2020 Christoph Berg <myon@debian.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+package TestLib;
+use strict;
+use Exporter;
+use Test::More;
+use PgCommon qw/get_versions change_ugid/;
+
+our $VERSION = 1.00;
+our @ISA = ('Exporter');
+our @EXPORT = qw/os_release ps ok_dir exec_as deb_installed rpm_installed package_version
+ version_ge program_ok is_program_out like_program_out unlike_program_out
+ pidof pid_env check_clean
+ @ALL_MAJORS @MAJORS $delay/;
+
+our @ALL_MAJORS = get_versions(); # not affected by PG_VERSIONS/-v
+our @MAJORS = $ENV{PG_VERSIONS} ? split (/\s+/, $ENV{PG_VERSIONS}) : @ALL_MAJORS;
+our $delay = 500_000; # 500ms
+
+# called if a test fails; spawn a shell if the environment variable
+# FAILURE=shell is set
+sub fail_debug {
+ if ($ENV{'FAILURE'} eq 'shell') {
+ if ((system 'bash') != 0) {
+ exit 1;
+ }
+ }
+}
+
+# parse /etc/os-release and return (os, version number)
+sub os_release {
+ open OS, "/etc/os-release" or return (undef, undef);
+ my ($os, $osversion);
+ while (<OS>) {
+ $os = $1 if /^ID=(.*)/;
+ $osversion = $1 if /^VERSION_ID="?([^"]*)/;
+ }
+ close OS;
+ $osversion = 'unstable' if ($os eq 'debian' and not defined $osversion);
+ return ($os, $osversion);
+}
+
+# Return whether a given deb is installed.
+# Arguments: <deb name>
+sub deb_installed {
+ open (DPKG, "dpkg -s $_[0] 2>/dev/null|") or die "call dpkg: $!";
+ my $result = 0;
+ while (<DPKG>) {
+ if (/^Status: install ok installed/) {
+ $result = 1;
+ last;
+ }
+ }
+ close DPKG;
+
+ return $result;
+}
+
+# Return whether a given rpm is installed.
+# Arguments: <rpm name>
+sub rpm_installed {
+ open (RPM, "rpm -qa $_[0] 2>/dev/null|") or die "call rpm: $!";
+ my $out = <RPM>; # returns void or the package name
+ close RPM;
+ return ($out =~ /./);
+}
+
+# Return a package version
+# Arguments: <package>
+sub package_version {
+ my $package = shift;
+ if ($PgCommon::rpm) {
+ return `rpm --queryformat '%{VERSION}' -q $package`;
+ } else {
+ my $version = `dpkg-query -f '\${Version}' --show $package`;
+ chomp $version;
+ return $version;
+ }
+}
+
+# Return whether a version is greater or equal to another one
+# Arguments: <ver1> <ver2>
+sub version_ge {
+ my ($v1, $v2) = @_;
+ use IPC::Open2;
+ open2(\*CHLD_OUT, \*CHLD_IN, 'sort', '-Vr');
+ print CHLD_IN "$v1\n";
+ print CHLD_IN "$v2\n";
+ close CHLD_IN;
+ my $v_ge = <CHLD_OUT>;
+ chomp $v_ge;
+ return $v_ge eq $v1;
+}
+
+# Return the user, group, and command line of running processes for the given
+# program.
+sub ps {
+ return `ps h -o user,group,args -C $_[0] | grep '$_[0]' | sort -u`;
+}
+
+# Return array of pids that match the given command name (we require a leading
+# slash so the postgres children are filtered out)
+sub pidof {
+ my $prg = shift;
+ open F, '-|', 'ps', 'h', '-C', $prg, '-o', 'pid,cmd' or die "open: $!";
+ my @pids;
+ while (<F>) {
+ if ((index $_, "/$prg") >= 0) {
+ push @pids, (split)[0];
+ }
+ }
+ close F;
+ return @pids;
+}
+
+# Return an reference to an array of all entries but . and .. of the given directory.
+sub dircontent {
+ opendir D, $_[0] or die "opendir: $!";
+ my @e = grep { $_ ne '.' && $_ ne '..' } readdir (D);
+ closedir D;
+ return \@e;
+}
+
+# Return environment of given PID
+sub pid_env {
+ my ($user, $pid) = @_;
+ my $path = "/proc/$pid/environ";
+ my @lines;
+ open E, "su -c 'cat $path' $user |" or warn "open $path: $!";
+ {
+ local $/;
+ @lines = split '\0', <E>;
+ }
+ close E;
+ my %env;
+ foreach (@lines) {
+ my ($k, $v) = (split '=');
+ $env{$k} = $v;
+ }
+ return %env;
+}
+
+# Check the contents of a directory.
+# Arguments: <directory name> <ref to expected dir content> <test description>
+sub ok_dir {
+ my $content = dircontent $_[0];
+ if (eq_set $content, $_[1]) {
+ pass $_[2];
+ } else {
+ diag "Expected directory contents: [@{$_[1]}], actual contents: [@$content]\n";
+ fail $_[2];
+ }
+}
+
+# Execute a command as a different user and return the output. Prints the
+# output of the command if exit code differs from expected one.
+# Arguments: <user> <system command> <ref to output> [<expected exit code>]
+# Returns: Program exit code
+sub exec_as {
+ my $uid;
+ if ($_[0] =~ /\d+/) {
+ $uid = int($_[0]);
+ } else {
+ $uid = getpwnam $_[0];
+ defined($uid) or die "TestLib::exec_as: target user '$_[0]' does not exist";
+ }
+ change_ugid ($uid, (getpwuid $uid)[3]);
+ die "changing euid: $!" if $> != $uid;
+ my $out = `$_[1] 2>&1`;
+ my $result = $? >> 8;
+ $< = $> = 0;
+ $( = $) = 0;
+ die "changing euid back to root: $!" if $> != 0;
+ $_[2] = \$out;
+
+ if (defined $_[3] && $_[3] != $result) {
+ print "command '$_[1]' did not exit with expected code $_[3] but with $result:\n";
+ print $out;
+ fail_debug;
+ }
+ return $result;
+}
+
+# Execute a command as a particular user, and check the exit code
+# Arguments: <user> <command> [<expected exit code>] [<description>]
+sub program_ok {
+ my ($user, $cmd, $exit, $description) = @_;
+ $exit ||= 0;
+ $description ||= $cmd;
+ my $outref;
+ ok ((exec_as $user, $cmd, \$outref, $exit) == $exit, $description);
+}
+
+# Execute a command as a particular user, and check the exit code and output
+# (merged stdout/stderr).
+# Arguments: <user> <command> <expected exit code> <expected output> [<description>]
+sub is_program_out {
+ my $outref;
+ my $result = exec_as $_[0], $_[1], $outref;
+ is $result, $_[2], $_[1] or fail_debug;
+ is ($$outref, $_[3], (defined $_[4] ? $_[4] : "correct output of $_[1]")) or fail_debug;
+}
+
+# Execute a command as a particular user, and check the exit code and output
+# against a regular expression (merged stdout/stderr).
+# Arguments: <user> <command> <expected exit code> <expected output re> [<description>]
+sub like_program_out {
+ my $outref;
+ my $result = exec_as $_[0], $_[1], $outref;
+ is $result, $_[2], $_[1] or fail_debug;
+ like ($$outref, $_[3], (defined $_[4] ? $_[4] : "correct output of $_[1]")) or fail_debug;
+}
+
+# Execute a command as a particular user, check the exit code, and check that
+# the output does not match a regular expression (merged stdout/stderr).
+# Arguments: <user> <command> <expected exit code> <expected output re> [<description>]
+sub unlike_program_out {
+ my $outref;
+ my $result = exec_as $_[0], $_[1], $outref;
+ is $result, $_[2], $_[1] or fail_debug;
+ unlike ($$outref, $_[3], (defined $_[4] ? $_[4] : "correct output of $_[1]")) or fail_debug;
+}
+
+# Check that all PostgreSQL related directories are empty and no
+# postgres processes are running. Should be called at the end
+# of all tests. Does 8 tests.
+sub check_clean {
+ note "Cleanup";
+ is (`pg_lsclusters -h`, '', 'Cleanup: No clusters left behind');
+ is ((ps 'postgres'), '', 'No postgres processes left behind');
+
+ my @check_dirs = ('/etc/postgresql', '/var/lib/postgresql',
+ '/var/run/postgresql');
+ foreach (@check_dirs) {
+ if (-d) {
+ ok_dir $_, [], "No files in $_ left behind";
+ } else {
+ pass "Directory $_ does not exist";
+ }
+ }
+ # we always want /var/log/postgresql/ to exist, so that logrotate does not
+ # complain about missing directories
+ ok_dir '/var/log/postgresql', [], "No files in /var/log/postgresql left behind";
+
+ is_program_out 0, 'netstat -avptn 2>/dev/null | grep ":543[2-9]\\b.*LISTEN"', 1, '',
+ 'PostgreSQL TCP ports are closed';
+}
+
+1;