# 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;