From b18f0dc2ca0d6d421f3ab8fb9e56250abe2f6252 Mon Sep 17 00:00:00 2001
From: unknown <sysadmin@gnu.org>
Date: Fri, 18 May 2012 10:28:20 -0500
Subject: [PATCH] Import version as of 2012-05-18 for upload-ftp-v1.1.pl

---
 upload-ftp-v1.1.pl | 41 ++++++++++++++++++++++++++++++-----------
 1 file changed, 30 insertions(+), 11 deletions(-)

diff --git a/upload-ftp-v1.1.pl b/upload-ftp-v1.1.pl
index de9308d..f10ed13 100755
--- a/upload-ftp-v1.1.pl
+++ b/upload-ftp-v1.1.pl
@@ -106,7 +106,7 @@ $ENV{"LC_ALL"} = "C";  # do not think about multibyte characters
 $ENV{"PATH"} = "/usr/bin:/bin:/usr/sbin";
 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
 
-my $V1_COMPAT_ALLOWED = 1;
+my $V1_COMPAT_ALLOWED = 0;
 
 my $NAME = 'upload-ftp-v1.1.pl';
 my $VERSION = '1.1'; # This is the protocol version
@@ -302,6 +302,7 @@ sub execute_commands {
   delete($info{package});
   delete($info{version});
   delete($info{'v1_compat_mode'});
+  delete($info{'replace'});
 
   my $destdir = "$destfinal/$originfo{directory}";
   foreach my $key (sort { $info{$a}{order} <=> $info{$b}{order} } keys %info) {
@@ -522,7 +523,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 emacs. We have no package named '$package_name'.",1);
+    || &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'.",1);
 
   while (<EMAIL_FILE>) {
     chomp;
@@ -672,8 +673,8 @@ sub read_directive_file {
       $tainted_val =~ /^(\d+\.\d+)$/ || &fatal("invalid version $tainted_val",1,$directive_file_contents);
       my $val = $1;  # so far so good
 
-      # We only support version 1.1 right now!
-      &fatal("invalid version $val, not supported",1,$directive_file_contents) if ($val ne '1.1');
+      # We only support version 1.1/1.2 right now!
+      &fatal("invalid version $val, not supported",1,$directive_file_contents) if (($val ne '1.1') and ($val ne '1.2'));
 
       # Only let them specify one version directive.
       &fatal("invalid second version $val, have $info{version}",1,$directive_file_contents) if exists $info{"version"};
@@ -695,6 +696,10 @@ sub read_directive_file {
       &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);
+      $info{"replace"} = $1; #ok.
     } elsif ($tainted_cmd =~ /^comment:?$/i) {  # case-insensitive, w or w/o the :
       # Comments are ok, we ignore them
     } else {
@@ -702,6 +707,12 @@ sub read_directive_file {
     }
   }
 
+  $info{'v1_compat_mode'} = 0;
+
+  if (exists($info{"replace"}) and (($info{'v1_compat_mode'} == 1) or ($info{"version"} eq '1.1'))) {
+    &fatal("invalid directive 'replace', not supported prior to version 1.2",1,$directive_file_contents);
+  }
+
   # Phone home. E-mail the contents of the directive file to the maintainer,
   # for debugging purposes. After this point, we don't need to pass the
   # $directive_file_contents to any subsequent &fatal calls.
@@ -751,7 +762,7 @@ sub read_directive_file {
         }
       } elsif (!$V1_COMPAT_ALLOWED) {
         # This is not allowed - we require a filename directive. No backwards compatibility.
-        &fatal("no filename directive specified in $directive_file. Upgrade to v1.1! See http://www.gnu.org/prep/maintain/maintain.html",1)
+        &fatal("no filename directive specified in $directive_file. Upgrade to the latest version! See http://www.gnu.org/prep/maintain/maintain.html",1)
       }
     } else {
       # We only have a directive file
@@ -1006,14 +1017,22 @@ sub install_files {
 
   # We now allow overwriting of files - without warning!!
   if (-e "$destdir/$sig_file") {
-    archive($destdir, $info{directory}, $sig_file);
-    ftp_syslog('info', "($log_style) archived and overwrote $destdir/$sig_file with uploaded version");
-    $t1 = 1;
+    if (not exists($info{'replace'}) or ($info{'replace'} ne 'true')) {
+      &fatal("This signature file exists: $destdir/$sig_file, if you want to replace the pair please use the 'replace' directive",1);
+    } else {
+      archive($destdir, $info{directory}, $sig_file);
+      ftp_syslog('info', "($log_style) archived and overwrote $destdir/$sig_file with uploaded version");
+      $t1 = 1;
+    }
   }
   if (-e "$destdir/$upload_file") {
-    archive($destdir, $info{directory}, $upload_file);
-    ftp_syslog('info', "($log_style) overwrote $destdir/$upload_file with uploaded version");
-    $t2 = 1;
+    if (not exists($info{'replace'}) or ($info{'replace'} ne 'true')) {
+      &fatal("This file exists: $destdir/$upload_file, if you want to replace the pair please use the 'replace' directive",1);
+    } else {
+      archive($destdir, $info{directory}, $upload_file);
+      ftp_syslog('info', "($log_style) overwrote $destdir/$upload_file with uploaded version");
+      $t2 = 1;
+    }
   }
   my $notification_str = '';
   $notification_str .= "Archived and overwrote $destdir/$sig_file with uploaded version\n" if ($t1);
-- 
2.25.1