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
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 = '';
&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");
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;
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 ();