From a0149d3c1bb77a3aa8006d70b732d5f81f84020b Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 5 Oct 2009 12:17:14 -0500 Subject: [PATCH] Import version as of 2009-10-05 for upload-ftp-v1.1.pl --- upload-ftp-v1.1.pl | 161 +++++++++++++++++++++++++++------------------ 1 file changed, 96 insertions(+), 65 deletions(-) diff --git a/upload-ftp-v1.1.pl b/upload-ftp-v1.1.pl index cfd7f80..68ecde3 100755 --- a/upload-ftp-v1.1.pl +++ b/upload-ftp-v1.1.pl @@ -106,7 +106,9 @@ my $style = ''; my $help = ''; my $version = ''; # Set this to 1 or higher to get debug output in the log file. -my $DEBUG = 1; +my $DEBUG = 0; + +my $NOMAIL = 0; GetOptions ("style=s" => \$style, "debug=i" => \$DEBUG, "help" => \$help, "version" => \$version); @@ -433,7 +435,7 @@ sub scan_incoming { 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."); + ftp_syslog('info',"($log_style) Found directive file with filename directive ($base), 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 @@ -496,8 +498,9 @@ sub email_addresses { while () { chomp; - push (@ret, $_) - if $_ =~ /^[[:graph:]]+@[[:graph:]]+$/; # simple sanity check + my $line = $_; + next if (grep($_ eq $line,@ret) > 0); # Skip duplicates + push (@ret, $line) if $line =~ /^[[:graph:]]+@[[:graph:]]+$/; # simple sanity check } close (EMAIL_FILE) || ftp_warn("close($package_config_base/$package_name/email) failed: $!"); @@ -507,6 +510,9 @@ sub email_addresses { sub parse_directory_line { my $tainted_val = shift; my $directive_file_contents = shift; + # $do_not_fail is set to 1 if this sub is called as a last resort in an attempt to find *someone* to report an error to. + # When it is set, this sub will not die with &fatal. + my $do_not_fail = shift; # Can't let it start with - . / or contain strange characters. # This disallows .. as a file name component since no component # can start with a . at all. @@ -515,16 +521,20 @@ sub parse_directory_line { # A couple of subdir levels are ok, but don't allow hundreds. my $slash_count = ($val =~ tr,/,/,); - &fatal("$slash_count slashes is too many, in $val",1,$directive_file_contents) if $slash_count > 3; - + &fatal("$slash_count slashes is too many, in $val",1,$directive_file_contents) if ($slash_count > 3 and not $do_not_fail); + # Only let them specify one directory directive. &fatal("Only one directory directive is allowed per directive file. Error at directory directive: $val",1,$directive_file_contents) - if exists $info{"directory"}; + if (exists $info{"directory"} and not $do_not_fail); + $info{"directory"} = $val; # ok. ($info{"package"} = $val) =~ s,/.*$,,; # top-level name, no subdir # Set email addresses - push (@{$info{email}}, email_addresses ($info{package})); + my @a = email_addresses($info{package}); + foreach my $address (@a) { + push (@{$info{email}}, $address) unless (grep($_ eq $address,@{$info{email}}) > 0); # Do not include duplicates + } } @@ -601,7 +611,7 @@ sub read_directive_file { my ($tainted_cmd,$tainted_val) = split(' ',$line,2); if ($tainted_cmd =~ /^Directory:?$/i) { # case-insensitive, w or w/o the : - parse_directory_line($tainted_val, $directive_file_contents); + parse_directory_line($tainted_val, $directive_file_contents,0); } elsif ($tainted_cmd =~ /^Filename:?$/i) { # case-insensitive, w or w/o the : # We use the same filename restrictions as scan_incoming $tainted_val =~ /^([\w_\+][-.\w_\+\~]*)$/ || &fatal("invalid filename $tainted_val",1,$directive_file_contents); @@ -809,9 +819,8 @@ sub read_directive_file { sub guess_uploader_email { my $directive_file_contents = shift; - if ($directive_file_contents =~ /^Directory:? (.*)$/im) { # case-insensitive, w or w/o the : - parse_directory_line($1, $directive_file_contents); + parse_directory_line($1, $directive_file_contents,1); } } @@ -834,19 +843,22 @@ sub verify_keyring { ($verify_str) = $verify_str =~ /^(.*)$/; + ftp_syslog('info',"$verify_str\n") if ($DEBUG > 0); my $retval = `$verify_str`; if (!defined($retval)) { # This is bad - we couldn't even execute the gpgv command properly guess_uploader_email($directive_file_contents); - &fatal("gpg verify of directive file failed: $!",1); + &fatal("gpg verify of directive file failed (error executing gpgv): $!",0,'',2); } elsif ($retval =~ /\n0\n$/s) { # We store the return value of gpgv on the last line of the output ftp_syslog('info', "($log_style) verified against $_\n"); return $retval; # We got return value 0 from gpgv -> key verified! - } + } else { + # gpgv returned an error - most likely just key not found. Ignore, since we are testing all keyrings. + } } guess_uploader_email($directive_file_contents); - &fatal("gpg verify of directive file failed",1); + &fatal("gpg verify of directive file failed",1,'',2); } @@ -991,17 +1003,16 @@ sub cleanup { sub fatal { my ($tainted_msg) = shift; my ($send_to_user) = shift; - # If we fail before we have sent a copy of the directive file contents to the maintainer # (when running in DEBUG mode), that copy is passed along, and we can send it from here. my ($directive_file_contents) = shift; + my $exit_code = shift; + $directive_file_contents ||= ''; if (($directive_file_contents ne '') && $DEBUG) { &mail ($directive_file_contents,0,"debug: directive file contents"); } - 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 @@ -1024,7 +1035,7 @@ sub fatal { } else { # child exec ("/bin/pwd") || ftp_die("can't exec pwd: $!"); } - ftp_die("(in $cwd) $msg"); + ftp_die("(in $cwd) $msg",$exit_code); } # Used for both success and failure. @@ -1032,7 +1043,7 @@ sub fatal { sub mail { my ($msg) = shift; my ($send_to_user) = shift; - my ($subject) = shift; + my ($subject) = shift; $subject ||= ''; my @email_list = ($email_always); @@ -1056,55 +1067,72 @@ sub mail { # print STDERR "final emails: @email_list\n"; # return @_; - my $smtp = Net::SMTP->new ("127.0.0.1"); - ftp_die("FATAL: SMTP connection failed") unless $smtp; - - $smtp->mail ($sender); - $smtp->bcc ($email_always) if ($send_to_user); - $smtp->recipient (@email_list, { SkipBad => 1}); - - $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) Subject: '$subject'"); - } elsif (defined $info{package}) { - $smtp->datasend ("Subject: [gnu-ftp-upload] $info{package}"); - ftp_syslog('info', "($log_style) Subject: $info{package}"); + if ($NOMAIL) { + if ($subject ne '') { + ftp_syslog('info', "($log_style) Subject: '$subject'"); + } elsif (defined $info{package}) { + ftp_syslog('info', "($log_style) Subject: $info{package}"); + } else { + ftp_syslog('warning', "($log_style) Error uploading package: $msg"); + ftp_syslog('info', "($log_style) Subject: generic failure"); + } + ftp_syslog('info', "($log_style) Body: $msg"); } 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; - $smtp->datasend (wrap('','',$msg) . "\n"); - $smtp->dataend (); + my $smtp = Net::SMTP->new ("127.0.0.1"); + ftp_die("FATAL: SMTP connection failed") unless $smtp; - $smtp->quit (); + $smtp->mail ($sender); + $smtp->bcc ($email_always) if ($send_to_user); + $smtp->recipient (@email_list, { SkipBad => 1}); + + $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) Subject: '$subject'"); + } elsif (defined $info{package}) { + $smtp->datasend ("Subject: [gnu-ftp-upload] $info{package}"); + 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; + $smtp->datasend (wrap('','',$msg) . "\n"); + $smtp->dataend (); + + $smtp->quit (); + } } sub debug { my $msg = shift; - my $smtp = Net::SMTP->new ("127.0.0.1"); - ftp_die("FATAL: SMTP connection failed") unless $smtp; - $smtp->mail ("ftp-upload-script\@gnu.org"); - $smtp->recipient ($maintainer_email, { SkipBad => 1}); - - $smtp->data (); - $smtp->datasend ("To: $maintainer_email\n"); - $smtp->datasend ("From: ftp-upload-script\@gnu.org\n"); - $smtp->datasend ("Reply-To: ftp-upload\@gnu.org\n"); - $smtp->datasend ("Subject: [$m_style gnu-ftp-debug] new upload processed"); - $smtp->datasend ("\n\n"); - $smtp->datasend ("$msg\n"); - $smtp->dataend (); - $smtp->quit (); + + if ($NOMAIL) { + ftp_syslog('info', "($log_style) Subject: [$m_style gnu-ftp-debug] new upload processed\nBody: $msg"); + } else { + my $smtp = Net::SMTP->new ("127.0.0.1"); + ftp_die("FATAL: SMTP connection failed") unless $smtp; + $smtp->mail ("ftp-upload-script\@gnu.org"); + $smtp->recipient ($maintainer_email, { SkipBad => 1}); + + $smtp->data (); + $smtp->datasend ("To: $maintainer_email\n"); + $smtp->datasend ("From: ftp-upload-script\@gnu.org\n"); + $smtp->datasend ("Reply-To: ftp-upload\@gnu.org\n"); + $smtp->datasend ("Subject: [$m_style gnu-ftp-debug] new upload processed"); + $smtp->datasend ("\n\n"); + $smtp->datasend ("$msg\n"); + $smtp->dataend (); + $smtp->quit (); + } } sub ftp_warn($) { @@ -1112,9 +1140,12 @@ sub ftp_warn($) { warn $_[0]; } -sub ftp_die($) { - ftp_syslog('err', "($log_style) " . $_[0]); - exit 1; +sub ftp_die($$) { + my $msg = shift; + my $exitcode = shift; + $exitcode ||= 1; + ftp_syslog('err', "($log_style) " . $msg); + exit $exitcode; } sub ftp_syslog { -- 2.25.1