What about Perl autodie?

Started by Peter Eisentrautalmost 2 years ago22 messages
#1Peter Eisentraut
peter@eisentraut.org
1 attachment(s)

I came across the Perl autodie pragma
(https://perldoc.perl.org/autodie). This seems pretty useful; is this
something we can use? Any drawbacks? Any minimum Perl version?

Attached is a sample patch of the kind of thing I'd be interested in.
The existing error handling of file operations in Perl is pretty
cumbersome, and this would simplify that.

Btw., here is a sample error message from autodie:

Can't open '../src/include/mb/pg_wchar.h' for reading: 'No such file or
directory' at ../src/include/catalog/../../backend/catalog/genbki.pl
line 391

which seems as good or better than the stuff we produce manually.

Attachments:

0001-WIP-Make-some-use-of-Perl-autodie-pragma.patchtext/plain; charset=UTF-8; name=0001-WIP-Make-some-use-of-Perl-autodie-pragma.patchDownload
From 4ada07b13ecde8b3c0d120583202a38de062239f Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <peter@eisentraut.org>
Date: Wed, 7 Feb 2024 14:59:36 +0100
Subject: [PATCH] WIP: Make some use of Perl autodie pragma

---
 src/backend/catalog/Catalog.pm | 11 ++++++-----
 src/backend/catalog/genbki.pl  | 24 +++++++++---------------
 2 files changed, 15 insertions(+), 20 deletions(-)

diff --git a/src/backend/catalog/Catalog.pm b/src/backend/catalog/Catalog.pm
index 55a8877aede..fa42d472df1 100644
--- a/src/backend/catalog/Catalog.pm
+++ b/src/backend/catalog/Catalog.pm
@@ -15,6 +15,7 @@ package Catalog;
 
 use strict;
 use warnings FATAL => 'all';
+use autodie;
 
 use File::Compare;
 
@@ -48,7 +49,7 @@ sub ParseHeader
 	$catalog{foreign_keys} = [];
 	$catalog{client_code} = [];
 
-	open(my $ifh, '<', $input_file) || die "$input_file: $!";
+	open(my $ifh, '<', $input_file);
 
 	# Scan the input file.
 	while (<$ifh>)
@@ -307,7 +308,7 @@ sub ParseData
 {
 	my ($input_file, $schema, $preserve_formatting) = @_;
 
-	open(my $ifd, '<', $input_file) || die "$input_file: $!";
+	open(my $ifd, '<', $input_file);
 	$input_file =~ /(\w+)\.dat$/
 	  or die "Input file $input_file needs to be a .dat file.\n";
 	my $catname = $1;
@@ -531,11 +532,11 @@ sub RenameTempFile
 	if (-f $final_name
 		&& compare($temp_name, $final_name) == 0)
 	{
-		unlink($temp_name) || die "unlink: $temp_name: $!";
+		unlink($temp_name);
 	}
 	else
 	{
-		rename($temp_name, $final_name) || die "rename: $temp_name: $!";
+		rename($temp_name, $final_name);
 	}
 	return;
 }
@@ -553,7 +554,7 @@ sub FindDefinedSymbol
 		$include_path .= '/';
 	}
 	my $file = $include_path . $catalog_header;
-	open(my $find_defined_symbol, '<', $file) || die "$file: $!";
+	open(my $find_defined_symbol, '<', $file);
 	while (<$find_defined_symbol>)
 	{
 		if (/^#define\s+\Q$symbol\E\s+(\S+)/)
diff --git a/src/backend/catalog/genbki.pl b/src/backend/catalog/genbki.pl
index 94afdc5491d..dc8cba037fd 100644
--- a/src/backend/catalog/genbki.pl
+++ b/src/backend/catalog/genbki.pl
@@ -15,6 +15,7 @@
 
 use strict;
 use warnings FATAL => 'all';
+use autodie;
 use Getopt::Long;
 
 use FindBin;
@@ -386,7 +387,7 @@
 my %encids;
 
 my $encfile = $include_path . 'mb/pg_wchar.h';
-open(my $ef, '<', $encfile) || die "$encfile: $!";
+open(my $ef, '<', $encfile);
 
 # We're parsing an enum, so start with 0 and increment
 # every time we find an enum member.
@@ -435,23 +436,17 @@
 # Open temp files
 my $tmpext = ".tmp$$";
 my $bkifile = $output_path . 'postgres.bki';
-open my $bki, '>', $bkifile . $tmpext
-  or die "can't open $bkifile$tmpext: $!";
+open my $bki, '>', $bkifile . $tmpext;
 my $schemafile = $output_path . 'schemapg.h';
-open my $schemapg, '>', $schemafile . $tmpext
-  or die "can't open $schemafile$tmpext: $!";
+open my $schemapg, '>', $schemafile . $tmpext;
 my $fk_info_file = $output_path . 'system_fk_info.h';
-open my $fk_info, '>', $fk_info_file . $tmpext
-  or die "can't open $fk_info_file$tmpext: $!";
+open my $fk_info, '>', $fk_info_file . $tmpext;
 my $constraints_file = $output_path . 'system_constraints.sql';
-open my $constraints, '>', $constraints_file . $tmpext
-  or die "can't open $constraints_file$tmpext: $!";
+open my $constraints, '>', $constraints_file . $tmpext;
 my $syscache_ids_file = $output_path . 'syscache_ids.h';
-open my $syscache_ids_fh, '>', $syscache_ids_file . $tmpext
-  or die "can't open $syscache_ids_file$tmpext: $!";
+open my $syscache_ids_fh, '>', $syscache_ids_file . $tmpext;
 my $syscache_info_file = $output_path . 'syscache_info.h';
-open my $syscache_info_fh, '>', $syscache_info_file . $tmpext
-  or die "can't open $syscache_info_file$tmpext: $!";
+open my $syscache_info_fh, '>', $syscache_info_file . $tmpext;
 
 # Generate postgres.bki and pg_*_d.h headers.
 
@@ -469,8 +464,7 @@
 
 	# Create one definition header with macro definitions for each catalog.
 	my $def_file = $output_path . $catname . '_d.h';
-	open my $def, '>', $def_file . $tmpext
-	  or die "can't open $def_file$tmpext: $!";
+	open my $def, '>', $def_file . $tmpext;
 
 	print_boilerplate($def, "${catname}_d.h",
 		"Macro definitions for $catname");
-- 
2.43.0

#2Greg Sabino Mullane
htamfids@gmail.com
In reply to: Peter Eisentraut (#1)
Re: What about Perl autodie?

On Wed, Feb 7, 2024 at 9:05 AM Peter Eisentraut <peter@eisentraut.org>
wrote:

I came across the Perl autodie pragma
(https://perldoc.perl.org/autodie). This seems pretty useful; is this
something we can use? Any drawbacks? Any minimum Perl version?

Big +1

No drawbacks. I've been using it heavily for many, many years. Came out in
5.10.1,
which should be available everywhere at this point (2009 was the year of
release)

Cheers,
Greg

#3John Naylor
johncnaylorls@gmail.com
In reply to: Greg Sabino Mullane (#2)
Re: What about Perl autodie?

On Wed, Feb 7, 2024 at 11:52 PM Greg Sabino Mullane <htamfids@gmail.com> wrote:

No drawbacks. I've been using it heavily for many, many years. Came out in 5.10.1,
which should be available everywhere at this point (2009 was the year of release)

We moved our minimum to 5.14 fairly recently, so we're good on that point.

#4Tom Lane
tgl@sss.pgh.pa.us
In reply to: John Naylor (#3)
Re: What about Perl autodie?

John Naylor <johncnaylorls@gmail.com> writes:

On Wed, Feb 7, 2024 at 11:52 PM Greg Sabino Mullane <htamfids@gmail.com> wrote:

No drawbacks. I've been using it heavily for many, many years. Came out in 5.10.1,
which should be available everywhere at this point (2009 was the year of release)

We moved our minimum to 5.14 fairly recently, so we're good on that point.

Yeah, but only recently. I'm a little worried about the value of this
change relative to the amount of code churn involved, and more to the
point I worry about the risk of future back-patches injecting bad code
into back branches that don't use autodie.

(Back-patching the use of autodie doesn't seem feasible, since before
v16 we supported perl 5.8.something.)

regards, tom lane

#5Peter Eisentraut
peter@eisentraut.org
In reply to: Tom Lane (#4)
Re: What about Perl autodie?

On 08.02.24 07:03, Tom Lane wrote:

John Naylor <johncnaylorls@gmail.com> writes:

On Wed, Feb 7, 2024 at 11:52 PM Greg Sabino Mullane <htamfids@gmail.com> wrote:

No drawbacks. I've been using it heavily for many, many years. Came out in 5.10.1,
which should be available everywhere at this point (2009 was the year of release)

We moved our minimum to 5.14 fairly recently, so we're good on that point.

Yeah, but only recently. I'm a little worried about the value of this
change relative to the amount of code churn involved, and more to the
point I worry about the risk of future back-patches injecting bad code
into back branches that don't use autodie.

(Back-patching the use of autodie doesn't seem feasible, since before
v16 we supported perl 5.8.something.)

Yeah, good points. I suppose we could start using it for completely new
scripts.

#6Daniel Gustafsson
daniel@yesql.se
In reply to: Peter Eisentraut (#5)
Re: What about Perl autodie?

On 8 Feb 2024, at 08:01, Peter Eisentraut <peter@eisentraut.org> wrote:

I suppose we could start using it for completely new scripts.

+1, it would be nice to eventually be able to move to it everywhere so starting
now with new scripts may make the eventual transition smoother.

--
Daniel Gustafsson

#7Tom Lane
tgl@sss.pgh.pa.us
In reply to: Daniel Gustafsson (#6)
Re: What about Perl autodie?

Daniel Gustafsson <daniel@yesql.se> writes:

On 8 Feb 2024, at 08:01, Peter Eisentraut <peter@eisentraut.org> wrote:
I suppose we could start using it for completely new scripts.

+1, it would be nice to eventually be able to move to it everywhere so starting
now with new scripts may make the eventual transition smoother.

I'm still concerned about people carelessly using autodie-reliant
code in places where they shouldn't. I offer two safer ways
forward:

1. Wait till v16 is the oldest supported branch, and then migrate
both HEAD and back branches to using autodie.

2. Don't wait, migrate them all now. This would mean requiring
Perl 5.10.1 or later to run the TAP tests, even in back branches.

I think #2 might not be all that radical. We have nothing older
than 5.14.0 in the buildfarm, so we don't really have much grounds
for claiming that 5.8.3 will work today. And 5.10.1 came out in
2009, so how likely is it that anyone cares anymore?

regards, tom lane

#8Daniel Gustafsson
daniel@yesql.se
In reply to: Tom Lane (#7)
Re: What about Perl autodie?

On 8 Feb 2024, at 16:53, Tom Lane <tgl@sss.pgh.pa.us> wrote:

2. Don't wait, migrate them all now. This would mean requiring
Perl 5.10.1 or later to run the TAP tests, even in back branches.

I think #2 might not be all that radical. We have nothing older
than 5.14.0 in the buildfarm, so we don't really have much grounds
for claiming that 5.8.3 will work today. And 5.10.1 came out in
2009, so how likely is it that anyone cares anymore?

I would vote for this option, if we don't run the trailing edge anywhere where
breakage is visible to developers then it is like you say, far from guaranteed
to work.

--
Daniel Gustafsson

#9Greg Sabino Mullane
htamfids@gmail.com
In reply to: Tom Lane (#7)
Re: What about Perl autodie?

2. Don't wait, migrate them all now. This would mean requiring
Perl 5.10.1 or later to run the TAP tests, even in back branches.

#2 please. For context, meson did not even exist in 2009.

Cheers,
Greg

In reply to: Daniel Gustafsson (#8)
Re: What about Perl autodie?

Daniel Gustafsson <daniel@yesql.se> writes:

On 8 Feb 2024, at 16:53, Tom Lane <tgl@sss.pgh.pa.us> wrote:

2. Don't wait, migrate them all now. This would mean requiring
Perl 5.10.1 or later to run the TAP tests, even in back branches.

I think #2 might not be all that radical. We have nothing older
than 5.14.0 in the buildfarm, so we don't really have much grounds
for claiming that 5.8.3 will work today. And 5.10.1 came out in
2009, so how likely is it that anyone cares anymore?

I would vote for this option, if we don't run the trailing edge anywhere where
breakage is visible to developers then it is like you say, far from guaranteed
to work.

The oldest Perl I'm aware of on a still-supported (fsvo) OS is RHEL 6,
which shipped 5.10.1 and has Extended Life-cycle Support until
2024-06-30.

For comparison, last year the at the Perl Toolchain Summit in Lyon we
decided that toolchain modules (the modules needed to build, test and
install CPAN distributions) are only required support versions of Perl
up to 10 years old, i.e. currently 5.18 (but there's a one-time
excemption to keep it to 5.16 until RHEL 7 goes out of maintenance
support on 2024-06-30).

- ilmari

#11Andrew Dunstan
andrew@dunslane.net
In reply to: Daniel Gustafsson (#8)
Re: What about Perl autodie?

On 2024-02-08 Th 11:08, Daniel Gustafsson wrote:

On 8 Feb 2024, at 16:53, Tom Lane <tgl@sss.pgh.pa.us> wrote:
2. Don't wait, migrate them all now. This would mean requiring
Perl 5.10.1 or later to run the TAP tests, even in back branches.

I think #2 might not be all that radical. We have nothing older
than 5.14.0 in the buildfarm, so we don't really have much grounds
for claiming that 5.8.3 will work today. And 5.10.1 came out in
2009, so how likely is it that anyone cares anymore?

I would vote for this option, if we don't run the trailing edge anywhere where
breakage is visible to developers then it is like you say, far from guaranteed
to work.

+1 from me too. We kept 5.8 going for a while because it was what the
Msys (v1) DTK perl was, but that doesn't matter any more I think.

cheers

andrew

--
Andrew Dunstan
EDB: https://www.enterprisedb.com

#12Tom Lane
tgl@sss.pgh.pa.us
In reply to: Andrew Dunstan (#11)
Re: What about Perl autodie?

Andrew Dunstan <andrew@dunslane.net> writes:

On 2024-02-08 Th 11:08, Daniel Gustafsson wrote:

On 8 Feb 2024, at 16:53, Tom Lane <tgl@sss.pgh.pa.us> wrote:

2. Don't wait, migrate them all now. This would mean requiring
Perl 5.10.1 or later to run the TAP tests, even in back branches.
I think #2 might not be all that radical. We have nothing older
than 5.14.0 in the buildfarm, so we don't really have much grounds
for claiming that 5.8.3 will work today. And 5.10.1 came out in
2009, so how likely is it that anyone cares anymore?

I would vote for this option, if we don't run the trailing edge anywhere where
breakage is visible to developers then it is like you say, far from guaranteed
to work.

+1 from me too. We kept 5.8 going for a while because it was what the
Msys (v1) DTK perl was, but that doesn't matter any more I think.

I've reconfigured longfin, which was using perl 5.14.0 on all
branches, to use 5.10.1 on the pre-v16 branches (and it did pass).
This seems like a good change even if we don't pull the trigger on
the above proposal --- although if we don't, maybe I should see
if I can get 5.8.3 to build on that machine.

regards, tom lane

#13Peter Eisentraut
peter@eisentraut.org
In reply to: Tom Lane (#7)
Re: What about Perl autodie?

On 08.02.24 16:53, Tom Lane wrote:

Daniel Gustafsson <daniel@yesql.se> writes:

On 8 Feb 2024, at 08:01, Peter Eisentraut <peter@eisentraut.org> wrote:
I suppose we could start using it for completely new scripts.

+1, it would be nice to eventually be able to move to it everywhere so starting
now with new scripts may make the eventual transition smoother.

I'm still concerned about people carelessly using autodie-reliant
code in places where they shouldn't. I offer two safer ways
forward:

1. Wait till v16 is the oldest supported branch, and then migrate
both HEAD and back branches to using autodie.

2. Don't wait, migrate them all now. This would mean requiring
Perl 5.10.1 or later to run the TAP tests, even in back branches.

I think #2 might not be all that radical. We have nothing older
than 5.14.0 in the buildfarm, so we don't really have much grounds
for claiming that 5.8.3 will work today. And 5.10.1 came out in
2009, so how likely is it that anyone cares anymore?

A gentler way might be to start using some perlcritic policies like
InputOutput::RequireCheckedOpen or the more general
InputOutput::RequireCheckedSyscalls and add explicit error checking at
the sites it points out. And then if we start using autodie in the
future, any inappropriate backpatching of calls lacking error checks
would be caught.

#14Andrew Dunstan
andrew@dunslane.net
In reply to: Peter Eisentraut (#13)
Re: What about Perl autodie?

On 2024-02-14 We 11:52, Peter Eisentraut wrote:

On 08.02.24 16:53, Tom Lane wrote:

Daniel Gustafsson <daniel@yesql.se> writes:

On 8 Feb 2024, at 08:01, Peter Eisentraut <peter@eisentraut.org>
wrote:
I suppose we could start using it for completely new scripts.

+1, it would be nice to eventually be able to move to it everywhere
so starting
now with new scripts may make the eventual transition smoother.

I'm still concerned about people carelessly using autodie-reliant
code in places where they shouldn't.  I offer two safer ways
forward:

1. Wait till v16 is the oldest supported branch, and then migrate
both HEAD and back branches to using autodie.

2. Don't wait, migrate them all now.  This would mean requiring
Perl 5.10.1 or later to run the TAP tests, even in back branches.

I think #2 might not be all that radical.  We have nothing older
than 5.14.0 in the buildfarm, so we don't really have much grounds
for claiming that 5.8.3 will work today.  And 5.10.1 came out in
2009, so how likely is it that anyone cares anymore?

A gentler way might be to start using some perlcritic policies like
InputOutput::RequireCheckedOpen or the more general
InputOutput::RequireCheckedSyscalls and add explicit error checking at
the sites it points out.  And then if we start using autodie in the
future, any inappropriate backpatching of calls lacking error checks
would be caught.

Yeah, that should work.

cheers

andrew

--
Andrew Dunstan
EDB: https://www.enterprisedb.com

#15Daniel Gustafsson
daniel@yesql.se
In reply to: Andrew Dunstan (#14)
Re: What about Perl autodie?

On 19 Feb 2024, at 01:54, Andrew Dunstan <andrew@dunslane.net> wrote:
On 2024-02-14 We 11:52, Peter Eisentraut wrote:

A gentler way might be to start using some perlcritic policies like InputOutput::RequireCheckedOpen or the more general InputOutput::RequireCheckedSyscalls and add explicit error checking at the sites it points out. And then if we start using autodie in the future, any inappropriate backpatching of calls lacking error checks would be caught.

Yeah, that should work.

I didn't study the referenced rules but the concept seems sane, so definitely a
+1 on that.

--
Daniel Gustafsson

#16Peter Eisentraut
peter@eisentraut.org
In reply to: Peter Eisentraut (#13)
2 attachment(s)
Re: What about Perl autodie?

On 14.02.24 17:52, Peter Eisentraut wrote:

A gentler way might be to start using some perlcritic policies like
InputOutput::RequireCheckedOpen or the more general
InputOutput::RequireCheckedSyscalls and add explicit error checking at
the sites it points out.

Here is a start for that. I added the required stanza to perlcriticrc
and started with an explicit list of functions to check:

functions = chmod flock open read rename seek symlink system

and fixed all the issues it pointed out.

I picked those functions because most existing code already checked
those, so the omissions are probably unintended, or in some cases also
because I thought it would be important for test correctness (e.g., some
tests using chmod).

I didn't design any beautiful error messages, mostly just used "or die
$!", which mostly matches existing code, and also this is
developer-level code, so having the system error plus source code
reference should be ok.

In the second patch, I changed the perlcriticrc stanza to use an
exclusion list instead of an explicit inclusion list. That way, you can
see what we are currently *not* checking. I'm undecided which way
around is better, and exactly what functions we should be checking. (Of
course, in principle, all of them, but since this is test and build
support code, not production code, there are probably some reasonable
compromises to be made.)

Attachments:

v1-0001-perlcritic-InputOutput-RequireCheckedSyscalls.patchtext/plain; charset=UTF-8; name=v1-0001-perlcritic-InputOutput-RequireCheckedSyscalls.patchDownload
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

v1-0002-Write-perlcritic-InputOutput-RequireCheckedSyscal.patchtext/plain; charset=UTF-8; name=v1-0002-Write-perlcritic-InputOutput-RequireCheckedSyscal.patchDownload
From 9068eac31c9df75b1f5302debed1a44f8c4c6c1e Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <peter@eisentraut.org>
Date: Tue, 20 Feb 2024 10:18:19 +0100
Subject: [PATCH v1 2/2] Write perlcritic InputOutput::RequireCheckedSyscalls
 as an exclude list instead

---
 src/tools/perlcheck/perlcriticrc | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/tools/perlcheck/perlcriticrc b/src/tools/perlcheck/perlcriticrc
index 57c1fd45708..bcef884df37 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -32,4 +32,5 @@ severity = 5
 
 [InputOutput::RequireCheckedSyscalls]
 severity = 5
-functions = chmod flock open read rename seek symlink system
+functions = :builtins
+exclude_functions = binmode chdir close closedir kill mkdir print rmdir setsockopt sleep truncate umask unlink waitpid
-- 
2.43.2

#17Peter Eisentraut
peter@eisentraut.org
In reply to: Peter Eisentraut (#16)
1 attachment(s)
Re: What about Perl autodie?

On 21.02.24 08:26, Peter Eisentraut wrote:

On 14.02.24 17:52, Peter Eisentraut wrote:

A gentler way might be to start using some perlcritic policies like
InputOutput::RequireCheckedOpen or the more general
InputOutput::RequireCheckedSyscalls and add explicit error checking at
the sites it points out.

Here is a start for that.  I added the required stanza to perlcriticrc
and started with an explicit list of functions to check:

functions = chmod flock open read rename seek symlink system

and fixed all the issues it pointed out.

I picked those functions because most existing code already checked
those, so the omissions are probably unintended, or in some cases also
because I thought it would be important for test correctness (e.g., some
tests using chmod).

I didn't design any beautiful error messages, mostly just used "or die
$!", which mostly matches existing code, and also this is
developer-level code, so having the system error plus source code
reference should be ok.

In the second patch, I changed the perlcriticrc stanza to use an
exclusion list instead of an explicit inclusion list.  That way, you can
see what we are currently *not* checking.  I'm undecided which way
around is better, and exactly what functions we should be checking.  (Of
course, in principle, all of them, but since this is test and build
support code, not production code, there are probably some reasonable
compromises to be made.)

After some pondering, I figured the exclude list is better. So here is
a squashed patch, also with a complete commit message.

Btw., do we check perlcritic in an automated way, like on the buildfarm?

Attachments:

v2-0001-Activate-perlcritic-InputOutput-RequireCheckedSys.patchtext/plain; charset=UTF-8; name=v2-0001-Activate-perlcritic-InputOutput-RequireCheckedSys.patchDownload
From c70c6af0e369496bec04d20dbe42d09a233f046f Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <peter@eisentraut.org>
Date: Sun, 17 Mar 2024 16:10:50 +0100
Subject: [PATCH v2] Activate perlcritic InputOutput::RequireCheckedSyscalls
 and fix resulting warnings

This checks that certain I/O-related Perl functions properly check
their return value.  Some parts of the PostgreSQL code had been a bit
sloppy about that.  The new perlcritic warnings are fixed here.  I
didn't design any beautiful error messages, mostly just used "or die
$!", which mostly matches existing code, and also this is
developer-level code, so having the system error plus source code
reference should be ok.

Initially, we only activate this check for a subset of what the
perlcritic check would warn about.  The effective list is

    chmod flock open read rename seek symlink system

The initial set of functions is picked because most existing code
already checked the return value of those, so any omissions are
probably unintended, or because it seems important for test
correctness.

The actual perlcritic configuration is written as an exclude list.
That seems better so that we are clear on what we are currently not
checking.  Maybe future patches want to investigate checking some of
the other functions.  (In principle, we might eventually want to check
all of them, but since this is test and build support code, not
production code, there are probably some reasonable compromises to be
made.)

Discussion: https://www.postgresql.org/message-id/flat/88b7d4f2-46d9-4cc7-b1f7-613c90f9a76a%40eisentraut.org
---
 .../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                |  8 ++++++++
 src/tools/pgindent/pgindent                     | 17 +++++++++--------
 15 files changed, 52 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 d3c83f26e4b..490a9822f09 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;
 }
@@ -423,7 +423,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 4fec417f6fa..1b3cd128f81 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..4739e9f4f18 100644
--- a/src/tools/perlcheck/perlcriticrc
+++ b/src/tools/perlcheck/perlcriticrc
@@ -29,3 +29,11 @@ severity = 5
 
 [BuiltinFunctions::ProhibitVoidMap]
 severity = 5
+
+# Require checking return value of system calls.  The excluded ones
+# are currently consistently checked, but more checking could be
+# added.
+[InputOutput::RequireCheckedSyscalls]
+severity = 5
+functions = :builtins
+exclude_functions = binmode chdir close closedir kill mkdir print rmdir setsockopt sleep truncate umask unlink waitpid
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: 20e58105badff383bd43f0b97e532771768f94df
-- 
2.44.0

#18Andrew Dunstan
andrew@dunslane.net
In reply to: Peter Eisentraut (#17)
Re: What about Perl autodie?

On Mon, Mar 18, 2024 at 2:28 AM Peter Eisentraut <peter@eisentraut.org>
wrote:

On 21.02.24 08:26, Peter Eisentraut wrote:

On 14.02.24 17:52, Peter Eisentraut wrote:

A gentler way might be to start using some perlcritic policies like
InputOutput::RequireCheckedOpen or the more general
InputOutput::RequireCheckedSyscalls and add explicit error checking at
the sites it points out.

Here is a start for that. I added the required stanza to perlcriticrc
and started with an explicit list of functions to check:

functions = chmod flock open read rename seek symlink system

and fixed all the issues it pointed out.

I picked those functions because most existing code already checked
those, so the omissions are probably unintended, or in some cases also
because I thought it would be important for test correctness (e.g., some
tests using chmod).

I didn't design any beautiful error messages, mostly just used "or die
$!", which mostly matches existing code, and also this is
developer-level code, so having the system error plus source code
reference should be ok.

In the second patch, I changed the perlcriticrc stanza to use an
exclusion list instead of an explicit inclusion list. That way, you can
see what we are currently *not* checking. I'm undecided which way
around is better, and exactly what functions we should be checking. (Of
course, in principle, all of them, but since this is test and build
support code, not production code, there are probably some reasonable
compromises to be made.)

After some pondering, I figured the exclude list is better. So here is
a squashed patch, also with a complete commit message.

Btw., do we check perlcritic in an automated way, like on the buildfarm?

Yes. crake and koel do.

cheers

andrew

#19Daniel Gustafsson
daniel@yesql.se
In reply to: Peter Eisentraut (#17)
Re: What about Perl autodie?

On 18 Mar 2024, at 07:27, Peter Eisentraut <peter@eisentraut.org> wrote:

After some pondering, I figured the exclude list is better.

Agreed.

So here is a squashed patch, also with a complete commit message.

Looks good from a read-through. It would have been nice to standardize on
using one of "|| die" and "or die" consistently but that's clearly not for this
body of work.

--
Daniel Gustafsson

In reply to: Daniel Gustafsson (#19)
Re: What about Perl autodie?

Daniel Gustafsson <daniel@yesql.se> writes:

On 18 Mar 2024, at 07:27, Peter Eisentraut <peter@eisentraut.org> wrote:

After some pondering, I figured the exclude list is better.

Agreed.

So here is a squashed patch, also with a complete commit message.

Looks good from a read-through. It would have been nice to standardize on
using one of "|| die" and "or die" consistently but that's clearly not for this
body of work.

"or die" is generally the preferred form, since || has higher precedence
than comma, so it's easy to make mistakes if you don't parenthesise the
function args, like:

open my $fh, '>', $filname || die "can't open $filename: $!";

which will only fail if $filename is falsy (i.e. undef, "", or "0").

- ilmari

#21Daniel Gustafsson
daniel@yesql.se
In reply to: Dagfinn Ilmari Mannsåker (#20)
Re: What about Perl autodie?

On 18 Mar 2024, at 14:18, Dagfinn Ilmari Mannsåker <ilmari@ilmari.org> wrote:
Daniel Gustafsson <daniel@yesql.se> writes:

It would have been nice to standardize on
using one of "|| die" and "or die" consistently but that's clearly not for this
body of work.

"or die" is generally the preferred form, since || has higher precedence
than comma, so it's easy to make mistakes if you don't parenthesise the
function args, like:

open my $fh, '>', $filname || die "can't open $filename: $!";

which will only fail if $filename is falsy (i.e. undef, "", or "0").

Thanks for the clarification! Looking over the || die() codepaths we have, and
we'll add as part of this patchset, none are vulnerable to the above issue
AFAICT.

--
Daniel Gustafsson

#22Peter Eisentraut
peter@eisentraut.org
In reply to: Daniel Gustafsson (#19)
Re: What about Perl autodie?

On 18.03.24 09:17, Daniel Gustafsson wrote:

On 18 Mar 2024, at 07:27, Peter Eisentraut <peter@eisentraut.org> wrote:

After some pondering, I figured the exclude list is better.

Agreed.

So here is a squashed patch, also with a complete commit message.

Looks good from a read-through. It would have been nice to standardize on
using one of "|| die" and "or die" consistently but that's clearly not for this
body of work.

Committed.

I was aware of the semantic difference between "||" and "or", and I had
tried to keep it similar to surrounding code.