From c32941ce95281ab21691c4181962d20a820b1f20 Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <peter@eisentraut.org>
Date: Tue, 20 Feb 2024 10:12:12 +0100
Subject: [PATCH v1 1/2] perlcritic InputOutput::RequireCheckedSyscalls

---
 .../t/010_pg_archivecleanup.pl                  |  2 +-
 src/bin/pg_basebackup/t/010_pg_basebackup.pl    |  8 ++++----
 src/bin/pg_ctl/t/001_start_stop.pl              |  2 +-
 src/bin/pg_resetwal/t/002_corrupted.pl          |  2 +-
 src/bin/pg_rewind/t/009_growing_files.pl        |  2 +-
 src/bin/pg_rewind/t/RewindTest.pm               |  4 ++--
 src/pl/plperl/text2macro.pl                     |  4 ++--
 src/test/kerberos/t/001_auth.pl                 |  2 +-
 .../ssl_passphrase_callback/t/001_testfunc.pl   |  2 +-
 src/test/perl/PostgreSQL/Test/Cluster.pm        | 12 ++++++------
 src/test/perl/PostgreSQL/Test/Utils.pm          | 16 ++++++++--------
 src/test/ssl/t/SSL/Server.pm                    | 10 +++++-----
 src/tools/msvc_gendef.pl                        |  4 ++--
 src/tools/perlcheck/perlcriticrc                |  4 ++++
 src/tools/pgindent/pgindent                     | 17 +++++++++--------
 15 files changed, 48 insertions(+), 43 deletions(-)

diff --git a/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl b/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl
index 792f5677c87..91a98c71e99 100644
--- a/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl
+++ b/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl
@@ -36,7 +36,7 @@ sub create_files
 {
 	foreach my $fn (map { $_->{name} } @_)
 	{
-		open my $file, '>', "$tempdir/$fn";
+		open my $file, '>', "$tempdir/$fn" or die $!;
 
 		print $file 'CONTENT';
 		close $file;
diff --git a/src/bin/pg_basebackup/t/010_pg_basebackup.pl b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
index 86cc01a640b..159da3029af 100644
--- a/src/bin/pg_basebackup/t/010_pg_basebackup.pl
+++ b/src/bin/pg_basebackup/t/010_pg_basebackup.pl
@@ -77,7 +77,7 @@
 ok(-d "$tempdir/backup", 'backup directory was created and left behind');
 rmtree("$tempdir/backup");
 
-open my $conf, '>>', "$pgdata/postgresql.conf";
+open my $conf, '>>', "$pgdata/postgresql.conf" or die $!;
 print $conf "max_replication_slots = 10\n";
 print $conf "max_wal_senders = 10\n";
 print $conf "wal_level = replica\n";
@@ -175,7 +175,7 @@
 	qw(backup_label tablespace_map postgresql.auto.conf.tmp
 	current_logfiles.tmp global/pg_internal.init.123))
 {
-	open my $file, '>>', "$pgdata/$filename";
+	open my $file, '>>', "$pgdata/$filename" or die $!;
 	print $file "DONOTCOPY";
 	close $file;
 }
@@ -185,7 +185,7 @@
 # unintended side effects.
 if ($Config{osname} ne 'darwin')
 {
-	open my $file, '>>', "$pgdata/.DS_Store";
+	open my $file, '>>', "$pgdata/.DS_Store" or die $!;
 	print $file "DONOTCOPY";
 	close $file;
 }
@@ -424,7 +424,7 @@
 	my $tblspcoid = $1;
 	my $escapedRepTsDir = $realRepTsDir;
 	$escapedRepTsDir =~ s/\\/\\\\/g;
-	open my $mapfile, '>', $node2->data_dir . '/tablespace_map';
+	open my $mapfile, '>', $node2->data_dir . '/tablespace_map' or die $!;
 	print $mapfile "$tblspcoid $escapedRepTsDir\n";
 	close $mapfile;
 
diff --git a/src/bin/pg_ctl/t/001_start_stop.pl b/src/bin/pg_ctl/t/001_start_stop.pl
index fd56bf7706a..cbdaee57fb1 100644
--- a/src/bin/pg_ctl/t/001_start_stop.pl
+++ b/src/bin/pg_ctl/t/001_start_stop.pl
@@ -23,7 +23,7 @@
 command_ok([ $ENV{PG_REGRESS}, '--config-auth', "$tempdir/data" ],
 	'configure authentication');
 my $node_port = PostgreSQL::Test::Cluster::get_free_port();
-open my $conf, '>>', "$tempdir/data/postgresql.conf";
+open my $conf, '>>', "$tempdir/data/postgresql.conf" or die $!;
 print $conf "fsync = off\n";
 print $conf "port = $node_port\n";
 print $conf PostgreSQL::Test::Utils::slurp_file($ENV{TEMP_CONFIG})
diff --git a/src/bin/pg_resetwal/t/002_corrupted.pl b/src/bin/pg_resetwal/t/002_corrupted.pl
index 897b03162e0..c5e09bbb688 100644
--- a/src/bin/pg_resetwal/t/002_corrupted.pl
+++ b/src/bin/pg_resetwal/t/002_corrupted.pl
@@ -21,7 +21,7 @@
 my $data;
 open my $fh, '<', $pg_control or BAIL_OUT($!);
 binmode $fh;
-read $fh, $data, 16;
+read $fh, $data, 16 or die $!;
 close $fh;
 
 # Fill pg_control with zeros
diff --git a/src/bin/pg_rewind/t/009_growing_files.pl b/src/bin/pg_rewind/t/009_growing_files.pl
index 3541d735685..8e59ad69961 100644
--- a/src/bin/pg_rewind/t/009_growing_files.pl
+++ b/src/bin/pg_rewind/t/009_growing_files.pl
@@ -69,7 +69,7 @@
 # Extract the last line from the verbose output as that should have the error
 # message for the unexpected file size
 my $last;
-open my $f, '<', "$standby_pgdata/tst_both_dir/file1";
+open my $f, '<', "$standby_pgdata/tst_both_dir/file1" or die $!;
 $last = $_ while (<$f>);
 close $f;
 like($last, qr/error: size of source file/, "Check error message");
diff --git a/src/bin/pg_rewind/t/RewindTest.pm b/src/bin/pg_rewind/t/RewindTest.pm
index 72deab8e886..0bf59db9973 100644
--- a/src/bin/pg_rewind/t/RewindTest.pm
+++ b/src/bin/pg_rewind/t/RewindTest.pm
@@ -311,8 +311,8 @@ sub run_pg_rewind
 		# Make sure that directories have the right umask as this is
 		# required by a follow-up check on permissions, and better
 		# safe than sorry.
-		chmod(0700, $node_primary->archive_dir);
-		chmod(0700, $node_primary->data_dir . "/pg_wal");
+		chmod(0700, $node_primary->archive_dir) or die $!;
+		chmod(0700, $node_primary->data_dir . "/pg_wal") or die $!;
 
 		# Add appropriate restore_command to the target cluster
 		$node_primary->enable_restoring($node_primary, 0);
diff --git a/src/pl/plperl/text2macro.pl b/src/pl/plperl/text2macro.pl
index 577417ac7ac..c6240af69c7 100644
--- a/src/pl/plperl/text2macro.pl
+++ b/src/pl/plperl/text2macro.pl
@@ -88,11 +88,11 @@ sub selftest
 	close $fh;
 
 	system("perl $0 --name=X $tmp.pl > $tmp.c") == 0 or die;
-	open $fh, '>>', "$tmp.c";
+	open $fh, '>>', "$tmp.c" or die;
 	print $fh "#include <stdio.h>\n";
 	print $fh "int main() { puts(X); return 0; }\n";
 	close $fh;
-	system("cat -n $tmp.c");
+	system("cat -n $tmp.c") == 0 or die;
 
 	system("make $tmp") == 0 or die;
 	open $fh, '<', "./$tmp |" or die;
diff --git a/src/test/kerberos/t/001_auth.pl b/src/test/kerberos/t/001_auth.pl
index 2a81ce8834b..e51e87d0a2e 100644
--- a/src/test/kerberos/t/001_auth.pl
+++ b/src/test/kerberos/t/001_auth.pl
@@ -111,7 +111,7 @@
 # Construct a pgpass file to make sure we don't use it
 append_to_file($pgpass, '*:*:*:*:abc123');
 
-chmod 0600, $pgpass;
+chmod 0600, $pgpass or die $!;
 
 # Build the krb5.conf to use.
 #
diff --git a/src/test/modules/ssl_passphrase_callback/t/001_testfunc.pl b/src/test/modules/ssl_passphrase_callback/t/001_testfunc.pl
index 9aa4bdc3704..a2bfb645760 100644
--- a/src/test/modules/ssl_passphrase_callback/t/001_testfunc.pl
+++ b/src/test/modules/ssl_passphrase_callback/t/001_testfunc.pl
@@ -33,7 +33,7 @@
 # install certificate and protected key
 copy("server.crt", $ddir);
 copy("server.key", $ddir);
-chmod 0600, "$ddir/server.key";
+chmod 0600, "$ddir/server.key" or die $!;
 
 $node->start;
 
diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index 44c1bb5afd0..73f46c846d2 100644
--- a/src/test/perl/PostgreSQL/Test/Cluster.pm
+++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
@@ -470,7 +470,7 @@ sub set_replication_conf
 	$self->host eq $test_pghost
 	  or croak "set_replication_conf only works with the default host";
 
-	open my $hba, '>>', "$pgdata/pg_hba.conf";
+	open my $hba, '>>', "$pgdata/pg_hba.conf" or die $!;
 	print $hba
 	  "\n# Allow replication (set up by PostgreSQL::Test::Cluster.pm)\n";
 	if ($PostgreSQL::Test::Utils::windows_os
@@ -583,7 +583,7 @@ sub init
 	PostgreSQL::Test::Utils::system_or_bail($ENV{PG_REGRESS},
 		'--config-auth', $pgdata, @{ $params{auth_extra} });
 
-	open my $conf, '>>', "$pgdata/postgresql.conf";
+	open my $conf, '>>', "$pgdata/postgresql.conf" or die $!;
 	print $conf "\n# Added by PostgreSQL::Test::Cluster.pm\n";
 	print $conf "fsync = off\n";
 	print $conf "restart_after_crash = off\n";
@@ -865,7 +865,7 @@ sub init_from_backup
 		rmdir($data_path);
 		PostgreSQL::Test::RecursiveCopy::copypath($backup_path, $data_path);
 	}
-	chmod(0700, $data_path);
+	chmod(0700, $data_path) or die $!;
 
 	# Base configuration for this node
 	$self->append_conf(
@@ -1691,16 +1691,16 @@ sub _reserve_port
 		if (kill 0, $pid)
 		{
 			# process exists and is owned by us, so we can't reserve this port
-			flock($portfile, LOCK_UN);
+			flock($portfile, LOCK_UN) || die $!;
 			close($portfile);
 			return 0;
 		}
 	}
 	# All good, go ahead and reserve the port
-	seek($portfile, 0, SEEK_SET);
+	seek($portfile, 0, SEEK_SET) || die $!;
 	# print the pid with a fixed width so we don't leave any trailing junk
 	print $portfile sprintf("%10d\n", $$);
-	flock($portfile, LOCK_UN);
+	flock($portfile, LOCK_UN) || die $!;
 	close($portfile);
 	push(@port_reservation_files, $filename);
 	return 1;
diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index 2185a079def..42d5a50dc88 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -211,10 +211,10 @@ INIT
 	  or die "could not open STDOUT to logfile \"$test_logfile\": $!";
 
 	# Hijack STDOUT and STDERR to the log file
-	open(my $orig_stdout, '>&', \*STDOUT);
-	open(my $orig_stderr, '>&', \*STDERR);
-	open(STDOUT, '>&', $testlog);
-	open(STDERR, '>&', $testlog);
+	open(my $orig_stdout, '>&', \*STDOUT) or die $!;
+	open(my $orig_stderr, '>&', \*STDERR) or die $!;
+	open(STDOUT, '>&', $testlog) or die $!;
+	open(STDERR, '>&', $testlog) or die $!;
 
 	# 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
@@ -564,7 +564,7 @@ Find and replace string of a given file.
 sub string_replace_file
 {
 	my ($filename, $find, $replace) = @_;
-	open(my $in, '<', $filename);
+	open(my $in, '<', $filename) or croak $!;
 	my $content = '';
 	while (<$in>)
 	{
@@ -572,7 +572,7 @@ sub string_replace_file
 		$content = $content . $_;
 	}
 	close $in;
-	open(my $out, '>', $filename);
+	open(my $out, '>', $filename) or croak $!;
 	print $out $content;
 	close($out);
 
@@ -789,11 +789,11 @@ sub dir_symlink
 			# need some indirection on msys
 			$cmd = qq{echo '$cmd' | \$COMSPEC /Q};
 		}
-		system($cmd);
+		system($cmd) == 0 or die;
 	}
 	else
 	{
-		symlink $oldname, $newname;
+		symlink $oldname, $newname or die $!;
 	}
 	die "No $newname" unless -e $newname;
 }
diff --git a/src/test/ssl/t/SSL/Server.pm b/src/test/ssl/t/SSL/Server.pm
index 149a9385119..ca4c7b567b3 100644
--- a/src/test/ssl/t/SSL/Server.pm
+++ b/src/test/ssl/t/SSL/Server.pm
@@ -191,7 +191,7 @@ sub configure_test_server_for_ssl
 	}
 
 	# enable logging etc.
-	open my $conf, '>>', "$pgdata/postgresql.conf";
+	open my $conf, '>>', "$pgdata/postgresql.conf" or die $!;
 	print $conf "fsync=off\n";
 	print $conf "log_connections=on\n";
 	print $conf "log_hostname=on\n";
@@ -204,7 +204,7 @@ sub configure_test_server_for_ssl
 	close $conf;
 
 	# SSL configuration will be placed here
-	open my $sslconf, '>', "$pgdata/sslconfig.conf";
+	open my $sslconf, '>', "$pgdata/sslconfig.conf" or die $!;
 	close $sslconf;
 
 	# Perform backend specific configuration
@@ -290,7 +290,7 @@ sub switch_server_cert
 	my %params = @_;
 	my $pgdata = $node->data_dir;
 
-	open my $sslconf, '>', "$pgdata/sslconfig.conf";
+	open my $sslconf, '>', "$pgdata/sslconfig.conf" or die $!;
 	print $sslconf "ssl=on\n";
 	print $sslconf $backend->set_server_cert(\%params);
 	print $sslconf "ssl_passphrase_command='"
@@ -315,7 +315,7 @@ sub _configure_hba_for_ssl
 	# but seems best to keep it as narrow as possible for security reasons.
 	#
 	# When connecting to certdb, also check the client certificate.
-	open my $hba, '>', "$pgdata/pg_hba.conf";
+	open my $hba, '>', "$pgdata/pg_hba.conf" or die $!;
 	print $hba
 	  "# TYPE  DATABASE        USER            ADDRESS                 METHOD             OPTIONS\n";
 	print $hba
@@ -337,7 +337,7 @@ sub _configure_hba_for_ssl
 	close $hba;
 
 	# Also set the ident maps. Note: fields with commas must be quoted
-	open my $map, ">", "$pgdata/pg_ident.conf";
+	open my $map, ">", "$pgdata/pg_ident.conf" or die $!;
 	print $map
 	  "# MAPNAME       SYSTEM-USERNAME                           PG-USERNAME\n",
 	  "dn             \"CN=ssltestuser-dn,OU=Testing,OU=Engineering,O=PGDG\"    ssltestuser\n",
diff --git a/src/tools/msvc_gendef.pl b/src/tools/msvc_gendef.pl
index 12c49ed2654..4ca08c1a475 100644
--- a/src/tools/msvc_gendef.pl
+++ b/src/tools/msvc_gendef.pl
@@ -195,8 +195,8 @@ sub usage
 
 my $cmd = "dumpbin /nologo /symbols /out:$tmpfile " . join(' ', @files);
 
-system($cmd) && die "Could not call dumpbin";
-rename($tmpfile, $symfile);
+system($cmd) == 0 || die "Could not call dumpbin";
+rename($tmpfile, $symfile) || die $!;
 extract_syms($symfile, \%def);
 print "\n";
 
diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 49ac9ee52b5..57c1fd45708 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -29,3 +29,7 @@ severity = 5
 
 [BuiltinFunctions::ProhibitVoidMap]
 severity = 5
+
+[InputOutput::RequireCheckedSyscalls]
+severity = 5
+functions = chmod flock open read rename seek symlink system
diff --git a/src/tools/pgindent/pgindent b/src/tools/pgindent/pgindent
index 9093d4ff739..48d83bc434f 100755
--- a/src/tools/pgindent/pgindent
+++ b/src/tools/pgindent/pgindent
@@ -80,12 +80,14 @@ my $filtered_typedefs_fh;
 
 sub check_indent
 {
-	system("$indent -? < $devnull > $devnull 2>&1");
-	if ($? >> 8 != 1)
+	if (system("$indent -? < $devnull > $devnull 2>&1") != 0)
 	{
-		print STDERR
-		  "You do not appear to have $indent installed on your system.\n";
-		exit 1;
+		if ($? >> 8 != 1)
+		{
+			print STDERR
+			  "You do not appear to have $indent installed on your system.\n";
+			exit 1;
+		}
 	}
 
 	if (`$indent --version` !~ m/ $INDENT_VERSION /)
@@ -95,8 +97,7 @@ sub check_indent
 		exit 1;
 	}
 
-	system("$indent -gnu < $devnull > $devnull 2>&1");
-	if ($? == 0)
+	if (system("$indent -gnu < $devnull > $devnull 2>&1") == 0)
 	{
 		print STDERR
 		  "You appear to have GNU indent rather than BSD indent.\n";
@@ -283,7 +284,7 @@ sub run_indent
 
 	unlink "$filename.BAK";
 
-	open(my $src_out, '<', $filename);
+	open(my $src_out, '<', $filename) || die $!;
 	local ($/) = undef;
 	$source = <$src_out>;
 	close($src_out);

base-commit: ff9e1e764fcce9a34467d614611a34d4d2a91b50
-- 
2.43.2