# Make the directory if it doesn't exist (for, e.g., a new gcc/x.y.z
# subdir). When the destination file exists, archive it automatically first.
#
+# TODO: - currently assumes files are located in $incoming_tmp
+# - factor out final staging
sub install_files {
my $header = shift;
- my $files = shift;
+ my $step = shift; # [ install => $filename ]
+
+ my $destdir = File::Spec->catdir
+ ($destfinal, File::Spec::Unix->splitdir($header->{directory}));
+ my $install_as = $step->[1];
+
+ my $upload_file = $header->{filename};
+ my $sig_file = $header->{filename}.'.sig';
+
+ my $stage_upload = File::Spec->catfile($desttmp, $upload_file);
+ my $stage_signature = File::Spec->catfile($desttmp, $sig_file);
+
+ my $final_upload = File::Spec->catfile($destdir, $install_as);
+ my $final_signature = File::Spec->catfile($destdir, $install_as.'.sig');
- my ($sig_file,$upload_file) = ($files->{"sig"}, $files->{"upload"});
- my $destdir = "$destfinal/$header->{directory}";
# File::Path is 200 lines of Perl and requires reading an external
# text file. In my mind, it is a toss-up as to whether that or
# forking the system mkdir is safer. We could debate endlessly,
system (@mkdir_args);
-d $destdir or fatal("no directory $destdir",1);
- my ($t1, $t2) = (0,0);
+ my $notification_str = '';
# We now allow overwriting of files - without warning!!
- if (-e "$destdir/$sig_file") {
+ if (-e $final_signature) {
if ($header->{options}{replace}) {
archive($destdir, $header->{directory}, $sig_file);
ftp_syslog('info', "archived and overwrote "
- ."$destdir/$sig_file with uploaded version");
- $t1 = 1;
+ ."$final_signature with uploaded version");
+ $notification_str .=
+ "Archived and overwrote $final_signature with uploaded version\n";
} else {
- fatal("This signature file exists: $destdir/$sig_file, if you want to "
+ fatal("This signature file exists: $final_signature, if you want to "
."replace the pair please use the 'replace' directive",1);
}
}
- if (-e "$destdir/$upload_file") {
+ if (-e $final_upload) {
if ($header->{options}{replace}) {
archive($destdir, $header->{directory}, $upload_file);
ftp_syslog('info', "overwrote "
- ."$destdir/$upload_file with uploaded version");
- $t2 = 1;
+ ."$final_upload with uploaded version");
+ $notification_str .=
+ "Archived and overwrote $final_upload with uploaded version\n";
} else {
- fatal("This file exists: $destdir/$upload_file, if you want to "
+ fatal("This file exists: $final_upload, if you want to "
."replace the pair please use the 'replace' directive",1);
}
}
- my $notification_str = '';
- $notification_str .=
- "Archived and overwrote $destdir/$sig_file with uploaded version\n"
- if ($t1);
- $notification_str .=
- "Archived and overwrote $destdir/$upload_file with uploaded version\n"
- if ($t2);
- mail ($notification_str) if ($notification_str ne '');
+
+ mail ($notification_str) if ($notification_str ne '');
# Do we need a subdirectory on $desttmp as well? Can't quite picture
# when we'd have a collision, so skip that for now.
#
for my $f (($sig_file, $upload_file)) {
- my @mv_args = ("/bin/mv", $f, "$desttmp/$f");
+ my $stage = File::Spec->catfile($desttmp, $f);
+ my @mv_args = ("/bin/mv", File::Spec->catfile($incoming_tmp, $f), $stage);
fatal("@mv_args failed",0) if system (@mv_args) != 0;
+ chmod 0644, $stage;
}
# Do atomic rename (if the system crashes between or during the mv's,
# too bad :). This is so we don't ever have a partial file that could
# be found by mirrors, etc.
#
- for my $f (($sig_file, $upload_file)) {
- chmod 0644, "$desttmp/$f";
- rename ("$desttmp/$f", "$destdir/$f")
- or fatal("rename($desttmp/$f, $destdir/$f) failed: $!",0);
- }
+ rename $stage_signature, $final_signature
+ or fatal("rename($stage_signature, $final_signature) failed: $!",0);
+ rename $stage_upload, $final_upload
+ or fatal("rename($stage_upload, $final_upload) failed: $!",0);
}
sub execute_commands {
foreach my $step (@{$oplist}[1..$#$oplist]) { # skip the header
if ($step->[0] eq 'install') {
check_files($incoming_tmp, $header);
- install_files($header, $files);
+ install_files($header, $step);
} elsif ($step->[0] eq 'symlink') {
my $target = $step->[1];
my $linkname = $step->[2];