Import version as of 2008-07-12 for upload-ftp-v1.1.pl
authorunknown <sysadmin@gnu.org>
Sat, 12 Jul 2008 22:38:15 +0000 (17:38 -0500)
committerJacob Bachmeyer <jcb@gnu.org>
Wed, 29 Jul 2020 03:06:53 +0000 (22:06 -0500)
upload-ftp-v1.1.pl

index 9b708ea74b9b11d56216a42dcdc4efd24265e7cc..7b51bb3bd407588ffe271920411b9e072a6f4435 100755 (executable)
@@ -83,6 +83,7 @@ use Net::SMTP;
 use Date::Manip;
 use Sys::Syslog qw(:DEFAULT setlogsock);
 use Getopt::Long;
+use Text::Wrap;
 umask (022);
 
 $ENV{"LC_ALL"} = "C";  # do not think about multibyte characters
@@ -95,19 +96,12 @@ my $V1_COMPAT_ALLOWED = 1;
 
 my $NAME = 'upload-ftp-v1.1.pl';
 my $VERSION = '1.1'; # This is the protocol version
-my $DATE = '2007/11/13 14:25:44';
+my $DATE = '2008/06/23 12:02:44';
 my $AUTHOR = "the Free Software Foundation <sysadmin\@gnu.org>";
-my $COPYRIGHT = "2003-2007";
+my $COPYRIGHT = "2003-2008";
 my $LICENSE = "GPL - http://www.fsf.org/licenses/gpl.txt";
 my $URL = "http://www.gnu.org/prep/maintain/html_node/Automated-FTP-Uploads.html";
 
-#my $NAME = $CVSNAME;
-#$NAME =~ s/^.RCSfile: (.*?),v .$/$1/g;
-#my $VERSION = $CVSVERSION;
-#$VERSION =~ s/^.Revision: (.*?) .$/$1/g;
-#my $DATE = $CVSDATE;
-#$DATE =~ s/^.Date: (.*?) .*?.$/$1/g;
-
 my $style = '';
 my $help = '';
 my $version = '';
@@ -290,16 +284,20 @@ sub execute_commands {
       &check_files($files,%originfo);
       &install_files($files,%originfo);
     } elsif ($key =~ /^symlink-(.*)/) {
+      my $target = $1;
       # Get current working dir
-      my $cwd = `pwd`;
+      my $cwd = `/bin/pwd`;
+      $cwd =~ m,^(/[^\.\.]*)$, || &fatal("invalid directory $cwd",1,'');       # Just make sure there are no double dots
+      $cwd = $1;  # so far so good, untainted
       chomp($cwd);
       # change to destination dir
       chdir($destdir);
       # symlink away!
-      symlink("$1",$info{$key}{link}) || &fatal("creation of symlink $info{$key}{link} to $1 in $destdir failed: $!",1);
+      symlink("$target",$info{$key}{link}) || &fatal("creation of symlink $info{$key}{link} to $1 in $destdir failed: $!",1);
       # go back to current working dir
-      chdir($cwd);
       ftp_syslog('info', "($log_style) added symlink $destdir/" . $info{$key}{link} . " pointing to $destdir/$1");
+      chdir($cwd) || &fatal("chdir to $cwd failed: $!",1);
     } elsif ($key =~ /^rmsymlink-(.*)/) {
       unlink("$destdir/$1") || &fatal("removal of symlink $1 failed: $!",1);
       ftp_syslog('info', "($log_style) removed symlink $destdir/$1");
@@ -471,7 +469,7 @@ sub email_addresses {
        my @ret;
 
        open (EMAIL_FILE, "<", "$package_config_base/$package_name/email")
-               || &fatal("unable to find configuration for package $package_name, probably caused by a missing/erroneous 'directory' line in your directive file",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;
@@ -1034,7 +1032,10 @@ sub mail {
                        ftp_syslog('warning', "($log_style) Error uploading package: $msg");
   }
   $smtp->datasend ("\n\n");
-  $smtp->datasend ("$msg\n");
+
+  # Wrap message at 78 characters, this is e-mail...
+  $Text::Wrap::columns=78;
+  $smtp->datasend (wrap('','',$msg) . "\n");
   $smtp->dataend ();
 
   $smtp->quit ();