Server IP : 85.214.239.14 / Your IP : 18.117.231.160 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/postgresql-common/t/ |
Upload File : |
# Common functionality for postgresql-common self tests # # (C) 2005-2009 Martin Pitt <mpitt@debian.org> # (C) 2013-2022 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 next_free_port/; 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 { my $dir = $_[0]; opendir D, $dir or return ["opendir $dir: $!"]; 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"; # prefer ss over netstat (until all debian/tests/control files in postgresql-* have been updated) unless (-x '/bin/netstat' and not -x '/bin/ss') { is `ss --no-header -tlp 'sport >= 5432 and sport <= 5439'`, '', 'PostgreSQL TCP ports are closed'; } else { is `netstat -avptn 2>/dev/null | grep ":543[2-9]\\b.*LISTEN"`, '', 'PostgreSQL TCP ports are closed'; } is next_free_port(), 5432, "Next free port is 5432"; } 1;