Import version as of 2008-10-23 for upload-ftp-v1.1.pl

diff --git a/upload-ftp-v1.1.pl b/upload-ftp-v1.1.pl
index 6247395f25f9b559f850e207c4c2864d09fe70e4..8ea151140b60ae4e9a747fe48c99250c30bb8afc 100755 (executable)
--- a/upload-ftp-v1.1.pl
+++ b/upload-ftp-v1.1.pl
@@ -182,17 +182,19 @@ sub main
     #   onto the next triplet.
     eval {
                # set up the %info variable
-               &read_directive_file ($files->{"directive"},$files->{"upload"},$files->{"directive_only"});
+               my $retval = &read_directive_file ($files->{"directive"},$files->{"upload"},$files->{"directive_only"});
    
-      # do the work
-      &execute_commands($files,%info);
-
-      # report success
-      if (!$files->{"directive_only"}) {
-       &success_upload($files->{"sig"}, $files->{"upload"},$files->{"directive"}); 
-      } else {
-        &success_directive($files->{directive});
-      }
+           if ($retval != -1) {
+             # do the work
+             &execute_commands($files,%info);
+
+             # report success
+             if (!$files->{"directive_only"}) {
+               &success_upload($files->{"sig"}, $files->{"upload"},$files->{"directive"}); 
+             } else {
+               &success_directive($files->{directive});
+             }
+           }
     };
 
     # clean up files if we abort while processing a triplet
@@ -411,16 +413,37 @@ sub scan_incoming {
       delete $possible{$sig};
       delete $possible{$directive};
     } elsif (exists($possible{$base}) && !exists($possible{"$bare_base.sig"}) && ($base =~ /\.directive\.asc$/)) {
-      # Directive file only, no actual file to deal with
-      # This can happen when dealing with symlink/rmsymlink/archive options
-      push (@ret, { "directive" => $base, "sig" => '',
-                    "upload" => '', "directive_only" => 1 });
-      # 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);
 
+                       # Here we have a potential problem. It's possible that we are seeing a
+                       # directive file that belongs to a triplet the rest of which has not been
+                       # uploaded yet. If so, we should ignore this file and not move it to
+                       # $incoming_dir. This means we need to read the file and see if there is a
+                       # 'filename:' directive.
+
+                       my $racecondition = 0;
+                       open(TMP,$base);
+                       while (<TMP>) {
+                               if (/^Filename:/i) {
+                                       $racecondition = 1;
+                                       last;
+                               }
+                       }
+                       close(TMP);
+
+                       if ($racecondition) {
+                               # Most likely a race condition. We've found a directive file but not the accompanying file(s).
+                               # Just ignore this directive file for now.
+                               ftp_syslog('info',"($log_style) Found directive file with filename directive, but no accompanying files. Ignoring directive file in this run.");
+                       } else {
+             # Directive file only, no actual file to deal with
+             # This can happen when dealing with symlink/rmsymlink/archive options
+             push (@ret, { "directive" => $base, "sig" => '',
+                           "upload" => '', "directive_only" => 1 });
+             # 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);
+                       }
       delete $possible{$base};
     } elsif ((-f $directive) && ((-s $directive) >= 50*1024)) {
        rename ("$incoming_dir/$directive", "$incoming_dir/.$directive");
@@ -502,8 +525,6 @@ sub read_directive_file {
   # non-white non-pgp line:
   #   Directory: dirname[/subdirname]
   # 
-  # We don't handle deletions if the wrong thing is uploaded.
-  # That'll take manual intervention (i.e., email to maintainers@gnu.org).
   open (DIRECTIVE_FILE, "<", $directive_file) 
   || ftp_die("FATAL: open($directive_file) failed: $!");
 
@@ -697,7 +718,7 @@ sub read_directive_file {
     # that needs to match the name of the uploaded file.
   
     # Filename has to match the name of the uploaded file
-    &fatal("filename ($info{filename}{value}) does not match name of the uploaded file ($uploaded_file)",1)
+    &fatal("The filename directive does not match name of the uploaded file.\n\n  Filename directive: $info{filename}{value}\n  Uploaded file: $uploaded_file\n",1)
       if ($uploaded_file ne $info{filename}{value});
 
     # Filename has to match the name of this directive file (a bit paranoid, but hey...)
@@ -779,7 +800,7 @@ sub read_directive_file {
     &fatal("gpg verification problem: could not extract timestamp",1);
   }
 
-  return %info;
+  return 0;
 }
 
 \f
@@ -967,6 +988,8 @@ sub fatal {
 
        print STDERR "$tainted_msg\n";
 
+       ftp_syslog('err', "($log_style) $tainted_msg");
+
   # Don't let them do perl or shell quoting tricks, but show everything
   # that's definitely harmless.
   #
@@ -976,8 +999,6 @@ sub fatal {
  
   &mail ($msg,$send_to_user);
 
-       ftp_syslog('err', "($log_style) $msg");
-
   my $pid = open(PWD, "-|");
   my $cwd;
 
@@ -1019,25 +1040,24 @@ sub mail {
   $smtp->bcc ($email_always) if ($send_to_user);
   $smtp->recipient (@email_list, { SkipBad => 1});
 
-  ftp_syslog('warning', "Sending email to @email_list");
-  ftp_syslog('warning', "Subject is $subject");
-  ftp_syslog('warning', "message: $msg");
-
+  ftp_syslog('info', "($log_style) Sending email to @email_list");
   $smtp->data ();
   $smtp->datasend ("To: " . join (", ", @email_list) . "\n");
   $smtp->datasend ("From: $sender\n");
   $smtp->datasend ("Reply-To: ftp-upload\@gnu.org\n");
        if ($subject ne '') {
       $smtp->datasend ("Subject: [gnu-ftp-upload] $subject");
-                       ftp_syslog('info', "($log_style) Sending e-mail with subject: '$subject'");
+                       ftp_syslog('info', "($log_style) Subject: '$subject'");
   } elsif (defined $info{package}) {
       $smtp->datasend ("Subject: [gnu-ftp-upload] $info{package}");
-                       ftp_syslog('info', "($log_style) " . $info{package} . ": $msg");
+                       ftp_syslog('info', "($log_style) Subject: $info{package}");
   } else {
       $smtp->datasend ("Subject: [gnu-ftp-upload] generic failure");
                        ftp_syslog('warning', "($log_style) Error uploading package: $msg");
+                       ftp_syslog('info', "($log_style) Subject: generic failure");
   }
   $smtp->datasend ("\n\n");
+  ftp_syslog('info', "($log_style) Body: $msg");
 
   # Wrap message at 78 characters, this is e-mail...
   $Text::Wrap::columns=78;