# 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");
}
\f
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 (<EMAIL_FILE>) {
chomp;
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");
while (<PWD>) {
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);
}
# 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.
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
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
#
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.
# 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)) {
# 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.
while (defined (my $line = <GPGV>)) {
$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
# 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 (<DIRECTIVE_FILE>) {
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
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.
$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!
$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
# 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});
# 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);
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);
}
}
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
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;
# 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");