From: Jacob Bachmeyer Date: Fri, 7 Oct 2022 03:48:56 +0000 (-0500) Subject: Use Perl's "or" in conditionals used for control flow X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=ad600df970f6e632340103ba382b2061ef1258d0;p=gatekeeper.git Use Perl's "or" in conditionals used for control flow --- diff --git a/gatekeeper.pl b/gatekeeper.pl index 2937dda..2f5ac61 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -387,7 +387,7 @@ ftp_syslog('info', "($log_style) Beginning upload processing run."); # Use die instead of fatal - this error should "never" happen. for my $dir ($package_config_base, $incoming_dir, $incoming_tmp, $destfinal, $desttmp) { - -d $dir || ftp_die("FATAL: configuration problem, $dir is not a directory"); + -d $dir or ftp_die("FATAL: configuration problem, $dir is not a directory"); } @@ -428,7 +428,7 @@ sub email_addresses { my @ret; open (EMAIL_FILE, "<", "$package_config_base/$package_name/email") - || fatal("The directory line should start with the name of the package for which you are trying to upload a file, e.g. gcc, gawk, or gasm. We have no package named '$package_name'. If this is a new GNU package, please ensure that you have registered your GPG key for its uploads, per http://www.gnu.org/prep/maintain/html_node/Automated-Upload-Registration.html. The GPG key must be registered separately for each package, so this needs to be done even if you are already registered for uploading with another package.",1); + or fatal("The directory line should start with the name of the package for which you are trying to upload a file, e.g. gcc, gawk, or gasm. We have no package named '$package_name'. If this is a new GNU package, please ensure that you have registered your GPG key for its uploads, per http://www.gnu.org/prep/maintain/html_node/Automated-Upload-Registration.html. The GPG key must be registered separately for each package, so this needs to be done even if you are already registered for uploading with another package.",1); while () { chomp; @@ -437,7 +437,7 @@ sub email_addresses { push (@ret, $line) if $line =~ /^[[:graph:]]+@[[:graph:]]+$/; # simple sanity check } - close (EMAIL_FILE) || ftp_warn("close($package_config_base/$package_name/email) failed: $!"); + close (EMAIL_FILE) or ftp_warn("close($package_config_base/$package_name/email) failed: $!"); # Now also look for all maintainer addresses in the maintainers.bypkg file open (EMAIL_FILE, "<", "$maintainers_bypkg"); @@ -641,9 +641,9 @@ sub fatal { while () { chomp ($cwd = $_); } - close (PWD) || ftp_warn("pwd exited $?"); + close (PWD) or ftp_warn("pwd exited $?"); } else { # child - exec ("/bin/pwd") || ftp_die("can't exec pwd: $!"); + exec ("/bin/pwd") or ftp_die("can't exec pwd: $!"); } ftp_die("(in $cwd) $msg",$exit_code); } @@ -670,7 +670,7 @@ sub scan_incoming { # Get list of all possible files from incoming dir. # opendir (INCOMING, $incoming_dir) - || ftp_die("FATAL opendir($incoming_dir) failed: $!"); + or ftp_die("FATAL opendir($incoming_dir) failed: $!"); while (my $tainted_ent = readdir (INCOMING)) { # don't look at files with a leading dot or dash, but allow those chars # subsequently. Omit files containing any other weird characters. @@ -682,7 +682,7 @@ sub scan_incoming { ftp_syslog('debug', "($log_style) DEBUG: " . "uploaded file to check: $ent") if DEBUG; $possible{$ent} = 1; } - closedir (INCOMING) || ftp_die("FATAL: closedir($incoming_dir) failed: $!"); + closedir (INCOMING) or ftp_die("FATAL: closedir($incoming_dir) failed: $!"); # No possible files found, so return before we call lsof return @ret unless %possible; # Determine if any of those possible files are open. We find the @@ -717,11 +717,11 @@ sub scan_incoming { ftp_syslog('debug', "($log_style) DEBUG: " . "lsof output: $line") if DEBUG; next unless $line =~ /^n${incoming_dir}\/(.+)$/; # only look at the name lines. ftp_syslog('debug', "($log_style) DEBUG: " . "upload in progress for $1, ignoring during this run") if DEBUG; - delete ($possible{$1}) || ftp_warn("WARNING: lsof found unrequested but open $1?!"); + delete ($possible{$1}) or ftp_warn("WARNING: lsof found unrequested but open $1?!"); } close (LSOF); } else { # child - exec (@lsof_args) || ftp_die("FATAL: cannot exec lsof: $!"); + exec (@lsof_args) or ftp_die("FATAL: cannot exec lsof: $!"); } # Do not consider files that have been modified in the last 2 minutes @@ -762,7 +762,7 @@ sub scan_incoming { # for my $f (($directive, $sig, $base)) { rename ($f, "$incoming_tmp/$f") - || fatal("rename $incoming_dir/$f to $incoming_tmp/$f failed: $!",0); + or fatal("rename $incoming_dir/$f to $incoming_tmp/$f failed: $!",0); } # don't bother to try any part of this triple again. @@ -799,7 +799,7 @@ sub scan_incoming { # Do atomic rename to temp incoming directory before reading # anything, for safety. rename ($base, "$incoming_tmp/$base") - || fatal("rename $incoming_dir/$base to $incoming_tmp/$base failed: $!",0); + or fatal("rename $incoming_dir/$base to $incoming_tmp/$base failed: $!",0); } delete $possible{$base}; } elsif ((-f $directive) && ((-s $directive) >= 50*1024)) { @@ -834,7 +834,7 @@ sub parse_directory_line { # Can't let it start with - . / or contain strange characters. # This disallows .. as a file name component since no component # can start with a . at all. - $tainted_val =~ m,^(\w[-.\w]*(/\w[-.\w]*)*)$, || fatal("invalid directory $tainted_val\n$directive_file_contents",1,$directive_file_contents); + $tainted_val =~ m,^(\w[-.\w]*(/\w[-.\w]*)*)$, or fatal("invalid directory $tainted_val\n$directive_file_contents",1,$directive_file_contents); my $val = $1; # so far so good # A couple of subdir levels are ok, but don't allow hundreds. @@ -894,7 +894,7 @@ sub verify_keyring { while (defined (my $line = )) { $retval .= $line; } - close (GPGV) || ftp_warn("gpgv exited $?"); + close (GPGV) or ftp_warn("gpgv exited $?"); if (!defined($retval)) { # This is bad - we couldn't even execute the gpgv command properly @@ -940,14 +940,14 @@ sub read_directive_file { # Directory: dirname[/subdirname] # open (DIRECTIVE_FILE, "<", $directive_file) - || ftp_die("FATAL: open($directive_file) failed: $!"); + or ftp_die("FATAL: open($directive_file) failed: $!"); my $cnt = 0; # Keep track of the order of directives... while () { my $line = $_; $directive_file_contents .= $line; push(@lines,$line); } - close (DIRECTIVE_FILE) || ftp_warn("close($directive_file) failed: $!"); + close (DIRECTIVE_FILE) or ftp_warn("close($directive_file) failed: $!"); # If we don't know whose project this file belongs to, because the # 'directory:' line is messed up or not there, we'd still like to let the @@ -992,7 +992,7 @@ sub read_directive_file { parse_directory_line($tainted_val, $directive_file_contents,0); } elsif ($tainted_cmd =~ /^Filename:?$/i) { # case-insensitive, w or w/o the : # We use the same filename restrictions as scan_incoming - $tainted_val =~ /^([\w_+][-.\w_+~]*)$/ || fatal("invalid filename $tainted_val",1,$directive_file_contents); + $tainted_val =~ /^([\w_+][-.\w_+~]*)$/ or fatal("invalid filename $tainted_val",1,$directive_file_contents); my $val = $1; # so far so good # Only let them specify one filename directive. @@ -1001,7 +1001,7 @@ sub read_directive_file { $info{"filename"} = {"value" => $val, "order" => $cnt++}; # ok. } elsif ($tainted_cmd =~ /^Version:?$/i) { # case-insensitive, w or w/o the : - $tainted_val =~ /^(\d+\.\d+)$/ || fatal("invalid version $tainted_val",1,$directive_file_contents); + $tainted_val =~ /^(\d+\.\d+)$/ or fatal("invalid version $tainted_val",1,$directive_file_contents); my $val = $1; # so far so good # We only support version 1.1/1.2 right now! @@ -1012,24 +1012,24 @@ sub read_directive_file { $info{"version"} = $val; #ok. } elsif ($tainted_cmd =~ /^symlink:?$/i) { # case-insensitive, w or w/o the : - $tainted_val =~ /^([\w_+][-.\w_+\/]*)\s+([\w_+][-.\w_+\/]*)$/ || fatal("invalid parameters for symlink command: $tainted_val",1,$directive_file_contents); + $tainted_val =~ /^([\w_+][-.\w_+\/]*)\s+([\w_+][-.\w_+\/]*)$/ or fatal("invalid parameters for symlink command: $tainted_val",1,$directive_file_contents); my ($target,$link) = ($1,$2); # so far so good fatal("invalid parameters for symlink command(2): $tainted_val",1,$directive_file_contents) if ($target =~ /\.\./ || $link =~ /\.\./); $info{"symlink-$target"} = {"link" => $link, "order" => $cnt++}; #ok. } elsif ($tainted_cmd =~ /^rmsymlink:?$/i) { # case-insensitive, w or w/o the : - $tainted_val =~ /^([\w_+][-.\w_+\/]*)$/ || fatal("invalid parameters for rmsymlink command: $tainted_val",1,$directive_file_contents); + $tainted_val =~ /^([\w_+][-.\w_+\/]*)$/ or fatal("invalid parameters for rmsymlink command: $tainted_val",1,$directive_file_contents); my $val = $1; # so far so good fatal("invalid parameters for rmsymlink command(2): $tainted_val",1,$directive_file_contents) if ($val =~ /\.\./); $info{"rmsymlink-$1"} = {"order" => $cnt++}; #ok. } elsif ($tainted_cmd =~ /^archive:?$/i) { # case-insensitive, w or w/o the : - $tainted_val =~ /^([\w_+][-.\w_+\/]*)$/ || fatal("invalid parameters for archive command: $tainted_val",1,$directive_file_contents); + $tainted_val =~ /^([\w_+][-.\w_+\/]*)$/ or fatal("invalid parameters for archive command: $tainted_val",1,$directive_file_contents); my $val = $1; # so far so good fatal("invalid parameters for archive command(2): $tainted_val",1,$directive_file_contents) if ($val =~ /\.\./); $info{"archive-$1"} = {"order" => $cnt++}; #ok. } elsif ($tainted_cmd =~ /^replace:?$/i) { # case-insensitive, w or w/o the : # This command is only supported from v1.2 - $tainted_val =~ /^(true|false)$/ || fatal("invalid parameters for replace command: $tainted_val",1,$directive_file_contents); + $tainted_val =~ /^(true|false)$/ or fatal("invalid parameters for replace command: $tainted_val",1,$directive_file_contents); $info{"replace"} = $1; #ok. } elsif ($tainted_cmd =~ /^comment:?$/i) { # case-insensitive, w or w/o the : # Comments are ok, we ignore them @@ -1109,7 +1109,7 @@ sub read_directive_file { # Configuration must exist for the package -d $package_config_base . '/' . $info{"package"} - || fatal("no configuration directory for package $info{package}",0); + or fatal("no configuration directory for package $info{package}",0); # Check that we have a keyring for this package: my @keyrings = keyring_file ($info{package},$info{directory}); @@ -1385,7 +1385,7 @@ sub install_files { # change it if you like, let's move on ... my @mkdir_args = ("/bin/mkdir", "-p", $destdir); system (@mkdir_args); - -d $destdir || fatal("no directory $destdir",1); + -d $destdir or fatal("no directory $destdir",1); my ($t1, $t2) = (0,0); @@ -1428,7 +1428,7 @@ sub install_files { for my $f (($sig_file, $upload_file)) { chmod 0644, "$desttmp/$f"; rename ("$desttmp/$f", "$destdir/$f") - || fatal("rename($desttmp/$f, $destdir/$f) failed: $!",0); + or fatal("rename($desttmp/$f, $destdir/$f) failed: $!",0); } } @@ -1473,16 +1473,16 @@ sub execute_commands { chdir($destdir); # if the symlink already exists, remove it if (-l $info{$key}{link}) { - unlink($info{$key}{link}) || fatal("removal of symlink $info{$key}{link} failed: $!",1); + unlink($info{$key}{link}) or fatal("removal of symlink $info{$key}{link} failed: $!",1); } # symlink away! - symlink("$target",$info{$key}{link}) || fatal("creation of symlink $info{$key}{link} to $target in $destdir failed: $!",1); + symlink("$target",$info{$key}{link}) or fatal("creation of symlink $info{$key}{link} to $target in $destdir failed: $!",1); # go back to current working dir ftp_syslog('info', "($log_style) added symlink $destdir/" . $info{$key}{link} . " pointing to $destdir/$target"); - chdir($cwd) || fatal("chdir to $cwd failed: $!",1); + chdir($cwd) or fatal("chdir to $cwd failed: $!",1); } elsif ($key =~ /^rmsymlink-(.*)/) { fatal("refusing to remove a non-symlink file",1) unless -l "$destdir/$1"; - unlink("$destdir/$1") || fatal("removal of symlink $1 failed: $!",1); + unlink("$destdir/$1") or fatal("removal of symlink $1 failed: $!",1); ftp_syslog('info', "($log_style) removed symlink $destdir/$1"); } elsif ($key =~ /^archive-(.*)/) { # We now also allow archiving entire directories @@ -1512,18 +1512,18 @@ sub success_upload { mail ("upload of $upload_file and $sig_file complete",1); - unlink ($directive_file) || ftp_warn("unlink($directive_file) failed: $!"); + unlink ($directive_file) or ftp_warn("unlink($directive_file) failed: $!"); } sub success_directive { my $directive_file = shift; mail ("processing of $directive_file complete",1); - unlink ($directive_file) || ftp_warn("unlink($directive_file) failed: $!"); + unlink ($directive_file) or ftp_warn("unlink($directive_file) failed: $!"); } sub cleanup_dir { my $dir = shift; - opendir(DIR, $dir) || ftp_die("Can’t opendir $dir in cleanup_dir: $!"); + opendir(DIR, $dir) or ftp_die("Can’t opendir $dir in cleanup_dir: $!"); my @files = grep { ! /^\./ && -f "$dir/$_" } readdir(DIR); closedir DIR; @@ -1559,12 +1559,12 @@ sub cleanup { # the chdir simplifies our filename parsing, so the base names don't # have any directory. -chdir ($incoming_dir) || ftp_die("FATAL: chdir($incoming_dir) failed: $!"); +chdir ($incoming_dir) or ftp_die("FATAL: chdir($incoming_dir) failed: $!"); my @incoming = scan_incoming (); # we've moved the files to work on to a new directory. -chdir ($incoming_tmp) || ftp_die("FATAL: chdir($incoming_tmp) failed: $!"); +chdir ($incoming_tmp) or ftp_die("FATAL: chdir($incoming_tmp) failed: $!"); for my $files (@incoming) { # each list element is a hash reference. ftp_syslog('info',"($log_style) found directive: $files->{directive}\n");