Skip to content

Commit d56cb42

Browse files
peterepetere
committed
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.) Reviewed-by: Daniel Gustafsson <daniel@yesql.se> Discussion: https://www.postgresql.org/message-id/flat/88b7d4f2-46d9-4cc7-b1f7-613c90f9a76a%40eisentraut.org
1 parent bb5604b commit d56cb42

File tree

15 files changed

+52
-43
lines changed

15 files changed

+52
-43
lines changed

‎src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ sub create_files
3636
{
3737
foreach my $fn (map { $_->{name} } @_)
3838
{
39-
open my $file, '>', "$tempdir/$fn";
39+
open my $file, '>', "$tempdir/$fn" or die $!;
4040

4141
print $file 'CONTENT';
4242
close $file;

‎src/bin/pg_basebackup/t/010_pg_basebackup.pl

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,7 @@
7777
ok(-d "$tempdir/backup", 'backup directory was created and left behind');
7878
rmtree("$tempdir/backup");
7979

80-
open my $conf, '>>', "$pgdata/postgresql.conf";
80+
open my $conf, '>>', "$pgdata/postgresql.conf" or die $!;
8181
print $conf "max_replication_slots = 10\n";
8282
print $conf "max_wal_senders = 10\n";
8383
print $conf "wal_level = replica\n";
@@ -175,7 +175,7 @@
175175
qw(backup_label tablespace_map postgresql.auto.conf.tmp
176176
current_logfiles.tmp global/pg_internal.init.123))
177177
{
178-
open my $file, '>>', "$pgdata/$filename";
178+
open my $file, '>>', "$pgdata/$filename" or die $!;
179179
print $file "DONOTCOPY";
180180
close $file;
181181
}
@@ -185,7 +185,7 @@
185185
# unintended side effects.
186186
if ($Config{osname} ne 'darwin')
187187
{
188-
open my $file, '>>', "$pgdata/.DS_Store";
188+
open my $file, '>>', "$pgdata/.DS_Store" or die $!;
189189
print $file "DONOTCOPY";
190190
close $file;
191191
}
@@ -423,7 +423,7 @@
423423
my $tblspcoid = $1;
424424
my $escapedRepTsDir = $realRepTsDir;
425425
$escapedRepTsDir =~ s/\\/\\\\/g;
426-
open my $mapfile, '>', $node2->data_dir . '/tablespace_map';
426+
open my $mapfile, '>', $node2->data_dir . '/tablespace_map' or die $!;
427427
print $mapfile "$tblspcoid $escapedRepTsDir\n";
428428
close $mapfile;
429429

‎src/bin/pg_ctl/t/001_start_stop.pl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@
2323
command_ok([ $ENV{PG_REGRESS}, '--config-auth', "$tempdir/data" ],
2424
'configure authentication');
2525
my $node_port = PostgreSQL::Test::Cluster::get_free_port();
26-
open my $conf, '>>', "$tempdir/data/postgresql.conf";
26+
open my $conf, '>>', "$tempdir/data/postgresql.conf" or die $!;
2727
print $conf "fsync = off\n";
2828
print $conf "port = $node_port\n";
2929
print $conf PostgreSQL::Test::Utils::slurp_file($ENV{TEMP_CONFIG})

‎src/bin/pg_resetwal/t/002_corrupted.pl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@
2121
my $data;
2222
open my $fh, '<', $pg_control or BAIL_OUT($!);
2323
binmode $fh;
24-
read $fh, $data, 16;
24+
read $fh, $data, 16 or die $!;
2525
close $fh;
2626

2727
# Fill pg_control with zeros

‎src/bin/pg_rewind/t/009_growing_files.pl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@
6969
# Extract the last line from the verbose output as that should have the error
7070
# message for the unexpected file size
7171
my $last;
72-
open my $f, '<', "$standby_pgdata/tst_both_dir/file1";
72+
open my $f, '<', "$standby_pgdata/tst_both_dir/file1" or die $!;
7373
$last = $_ while (<$f>);
7474
close $f;
7575
like($last, qr/error: size of source file/, "Check error message");

‎src/bin/pg_rewind/t/RewindTest.pm

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -311,8 +311,8 @@ sub run_pg_rewind
311311
# Make sure that directories have the right umask as this is
312312
# required by a follow-up check on permissions, and better
313313
# safe than sorry.
314-
chmod(0700, $node_primary->archive_dir);
315-
chmod(0700, $node_primary->data_dir . "/pg_wal");
314+
chmod(0700, $node_primary->archive_dir) or die $!;
315+
chmod(0700, $node_primary->data_dir . "/pg_wal") or die $!;
316316

317317
# Add appropriate restore_command to the target cluster
318318
$node_primary->enable_restoring($node_primary, 0);

‎src/pl/plperl/text2macro.pl

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -88,11 +88,11 @@ sub selftest
8888
close $fh;
8989

9090
system("perl $0 --name=X $tmp.pl > $tmp.c") == 0 or die;
91-
open $fh, '>>', "$tmp.c";
91+
open $fh, '>>', "$tmp.c" or die;
9292
print $fh "#include <stdio.h>\n";
9393
print $fh "int main() { puts(X); return 0; }\n";
9494
close $fh;
95-
system("cat -n $tmp.c");
95+
system("cat -n $tmp.c") == 0 or die;
9696

9797
system("make $tmp") == 0 or die;
9898
open $fh, '<', "./$tmp |" or die;

‎src/test/kerberos/t/001_auth.pl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -111,7 +111,7 @@
111111
# Construct a pgpass file to make sure we don't use it
112112
append_to_file($pgpass, '*:*:*:*:abc123');
113113

114-
chmod 0600, $pgpass;
114+
chmod 0600, $pgpass or die $!;
115115

116116
# Build the krb5.conf to use.
117117
#

‎src/test/modules/ssl_passphrase_callback/t/001_testfunc.pl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
# install certificate and protected key
3434
copy("server.crt", $ddir);
3535
copy("server.key", $ddir);
36-
chmod 0600, "$ddir/server.key";
36+
chmod 0600, "$ddir/server.key" or die $!;
3737

3838
$node->start;
3939

‎src/test/perl/PostgreSQL/Test/Cluster.pm

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -467,7 +467,7 @@ sub set_replication_conf
467467
$self->host eq $test_pghost
468468
or croak "set_replication_conf only works with the default host";
469469

470-
open my $hba, '>>', "$pgdata/pg_hba.conf";
470+
open my $hba, '>>', "$pgdata/pg_hba.conf" or die $!;
471471
print $hba
472472
"\n# Allow replication (set up by PostgreSQL::Test::Cluster.pm)\n";
473473
if ($PostgreSQL::Test::Utils::windows_os
@@ -580,7 +580,7 @@ sub init
580580
PostgreSQL::Test::Utils::system_or_bail($ENV{PG_REGRESS},
581581
'--config-auth', $pgdata, @{ $params{auth_extra} });
582582

583-
open my $conf, '>>', "$pgdata/postgresql.conf";
583+
open my $conf, '>>', "$pgdata/postgresql.conf" or die $!;
584584
print $conf "\n# Added by PostgreSQL::Test::Cluster.pm\n";
585585
print $conf "fsync = off\n";
586586
print $conf "restart_after_crash = off\n";
@@ -862,7 +862,7 @@ sub init_from_backup
862862
rmdir($data_path);
863863
PostgreSQL::Test::RecursiveCopy::copypath($backup_path, $data_path);
864864
}
865-
chmod(0700, $data_path);
865+
chmod(0700, $data_path) or die $!;
866866

867867
# Base configuration for this node
868868
$self->append_conf(
@@ -1688,16 +1688,16 @@ sub _reserve_port
16881688
if (kill 0, $pid)
16891689
{
16901690
# process exists and is owned by us, so we can't reserve this port
1691-
flock($portfile, LOCK_UN);
1691+
flock($portfile, LOCK_UN) || die $!;
16921692
close($portfile);
16931693
return 0;
16941694
}
16951695
}
16961696
# All good, go ahead and reserve the port
1697-
seek($portfile, 0, SEEK_SET);
1697+
seek($portfile, 0, SEEK_SET) || die $!;
16981698
# print the pid with a fixed width so we don't leave any trailing junk
16991699
print $portfile sprintf("%10d\n", $$);
1700-
flock($portfile, LOCK_UN);
1700+
flock($portfile, LOCK_UN) || die $!;
17011701
close($portfile);
17021702
push(@port_reservation_files, $filename);
17031703
return 1;

‎src/test/perl/PostgreSQL/Test/Utils.pm

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -211,10 +211,10 @@ INIT
211211
or die "could not open STDOUT to logfile \"$test_logfile\": $!";
212212

213213
# Hijack STDOUT and STDERR to the log file
214-
open(my $orig_stdout, '>&', \*STDOUT);
215-
open(my $orig_stderr, '>&', \*STDERR);
216-
open(STDOUT, '>&', $testlog);
217-
open(STDERR, '>&', $testlog);
214+
open(my $orig_stdout, '>&', \*STDOUT) or die $!;
215+
open(my $orig_stderr, '>&', \*STDERR) or die $!;
216+
open(STDOUT, '>&', $testlog) or die $!;
217+
open(STDERR, '>&', $testlog) or die $!;
218218

219219
# The test output (ok ...) needs to be printed to the original STDOUT so
220220
# that the 'prove' program can parse it, and display it to the user in
@@ -564,15 +564,15 @@ Find and replace string of a given file.
564564
sub string_replace_file
565565
{
566566
my ($filename, $find, $replace) = @_;
567-
open(my $in, '<', $filename);
567+
open(my $in, '<', $filename) or croak $!;
568568
my $content = '';
569569
while (<$in>)
570570
{
571571
$_ =~ s/$find/$replace/;
572572
$content = $content . $_;
573573
}
574574
close $in;
575-
open(my $out, '>', $filename);
575+
open(my $out, '>', $filename) or croak $!;
576576
print $out $content;
577577
close($out);
578578

@@ -789,11 +789,11 @@ sub dir_symlink
789789
# need some indirection on msys
790790
$cmd = qq{echo '$cmd' | \$COMSPEC /Q};
791791
}
792-
system($cmd);
792+
system($cmd) == 0 or die;
793793
}
794794
else
795795
{
796-
symlink $oldname, $newname;
796+
symlink $oldname, $newname or die $!;
797797
}
798798
die "No $newname" unless -e $newname;
799799
}

‎src/test/ssl/t/SSL/Server.pm

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -191,7 +191,7 @@ sub configure_test_server_for_ssl
191191
}
192192

193193
# enable logging etc.
194-
open my $conf, '>>', "$pgdata/postgresql.conf";
194+
open my $conf, '>>', "$pgdata/postgresql.conf" or die $!;
195195
print $conf "fsync=off\n";
196196
print $conf "log_connections=on\n";
197197
print $conf "log_hostname=on\n";
@@ -204,7 +204,7 @@ sub configure_test_server_for_ssl
204204
close $conf;
205205

206206
# SSL configuration will be placed here
207-
open my $sslconf, '>', "$pgdata/sslconfig.conf";
207+
open my $sslconf, '>', "$pgdata/sslconfig.conf" or die $!;
208208
close $sslconf;
209209

210210
# Perform backend specific configuration
@@ -290,7 +290,7 @@ sub switch_server_cert
290290
my %params = @_;
291291
my $pgdata = $node->data_dir;
292292

293-
open my $sslconf, '>', "$pgdata/sslconfig.conf";
293+
open my $sslconf, '>', "$pgdata/sslconfig.conf" or die $!;
294294
print $sslconf "ssl=on\n";
295295
print $sslconf $backend->set_server_cert(\%params);
296296
print $sslconf "ssl_passphrase_command='"
@@ -315,7 +315,7 @@ sub _configure_hba_for_ssl
315315
# but seems best to keep it as narrow as possible for security reasons.
316316
#
317317
# When connecting to certdb, also check the client certificate.
318-
open my $hba, '>', "$pgdata/pg_hba.conf";
318+
open my $hba, '>', "$pgdata/pg_hba.conf" or die $!;
319319
print $hba
320320
"# TYPE DATABASE USER ADDRESS METHOD OPTIONS\n";
321321
print $hba
@@ -337,7 +337,7 @@ sub _configure_hba_for_ssl
337337
close $hba;
338338

339339
# Also set the ident maps. Note: fields with commas must be quoted
340-
open my $map, ">", "$pgdata/pg_ident.conf";
340+
open my $map, ">", "$pgdata/pg_ident.conf" or die $!;
341341
print $map
342342
"# MAPNAME SYSTEM-USERNAME PG-USERNAME\n",
343343
"dn \"CN=ssltestuser-dn,OU=Testing,OU=Engineering,O=PGDG\" ssltestuser\n",

‎src/tools/msvc_gendef.pl

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -195,8 +195,8 @@ sub usage
195195

196196
my $cmd = "dumpbin /nologo /symbols /out:$tmpfile " . join(' ', @files);
197197

198-
system($cmd) && die "Could not call dumpbin";
199-
rename($tmpfile, $symfile);
198+
system($cmd) == 0 or die "Could not call dumpbin";
199+
rename($tmpfile, $symfile) or die $!;
200200
extract_syms($symfile, \%def);
201201
print "\n";
202202

‎src/tools/perlcheck/perlcriticrc

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,3 +29,11 @@ severity = 5
2929

3030
[BuiltinFunctions::ProhibitVoidMap]
3131
severity = 5
32+
33+
# Require checking return value of system calls. The excluded ones
34+
# are currently consistently checked, but more checking could be
35+
# added.
36+
[InputOutput::RequireCheckedSyscalls]
37+
severity = 5
38+
functions = :builtins
39+
exclude_functions = binmode chdir close closedir kill mkdir print rmdir setsockopt sleep truncate umask unlink waitpid

‎src/tools/pgindent/pgindent

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -80,12 +80,14 @@ my $filtered_typedefs_fh;
8080

8181
sub check_indent
8282
{
83-
system("$indent -? < $devnull > $devnull 2>&1");
84-
if ($? >> 8 != 1)
83+
if (system("$indent -? < $devnull > $devnull 2>&1") != 0)
8584
{
86-
print STDERR
87-
"You do not appear to have $indent installed on your system.\n";
88-
exit 1;
85+
if ($? >> 8 != 1)
86+
{
87+
print STDERR
88+
"You do not appear to have $indent installed on your system.\n";
89+
exit 1;
90+
}
8991
}
9092

9193
if (`$indent --version` !~ m/ $INDENT_VERSION /)
@@ -95,8 +97,7 @@ sub check_indent
9597
exit 1;
9698
}
9799

98-
system("$indent -gnu < $devnull > $devnull 2>&1");
99-
if ($? == 0)
100+
if (system("$indent -gnu < $devnull > $devnull 2>&1") == 0)
100101
{
101102
print STDERR
102103
"You appear to have GNU indent rather than BSD indent.\n";
@@ -283,7 +284,7 @@ sub run_indent
283284

284285
unlink "$filename.BAK";
285286

286-
open(my $src_out, '<', $filename);
287+
open(my $src_out, '<', $filename) || die $!;
287288
local ($/) = undef;
288289
$source = <$src_out>;
289290
close($src_out);

0 commit comments

Comments
 (0)