From: unknown Date: Wed, 2 Sep 2009 20:48:58 +0000 (-0500) Subject: Import version as of 2009-09-02 for upload-ftp-v1.1.pl X-Git-Tag: 20200730__import~39 X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=5c1cc0dbf1356de877a9146df18b15f3e77e876b;p=gatekeeper.git Import version as of 2009-09-02 for upload-ftp-v1.1.pl --- diff --git a/upload-ftp-v1.1.pl b/upload-ftp-v1.1.pl index 8ea1511..cfd7f80 100755 --- a/upload-ftp-v1.1.pl +++ b/upload-ftp-v1.1.pl @@ -340,7 +340,7 @@ sub scan_incoming { while (my $tainted_ent = readdir (INCOMING)) { # don't look at files with a leading dot or dash, but allow those chars # subsequently. Omit files containing any other weird characters. - next unless $tainted_ent =~ /^([\w_\+][-.\w_\+]*)$/; + next unless $tainted_ent =~ /^([\w_\+][-.\w_\+\~]*)$/; my $ent = $1; # Don't look at files with really long names, either. @@ -504,6 +504,28 @@ sub email_addresses { return @ret; } +sub parse_directory_line { + my $tainted_val = shift; + my $directive_file_contents = 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. + $tainted_val =~ m,^(\w[-.\w]*(/\w[-.\w]*)*)$, || &fatal("invalid directory $tainted_val\n$directive_file_contents",1,$directive_file_contents); + my $val = $1; # so far so good + + # 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; + + # 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"}; + + $info{"directory"} = $val; # ok. + ($info{"package"} = $val) =~ s,/.*$,,; # top-level name, no subdir + # Set email addresses + push (@{$info{email}}, email_addresses ($info{package})); +} # Return the information for this upload out of DIRECTIVE_FILE -- @@ -521,12 +543,23 @@ sub read_directive_file { # We default to v1.1 $info{'v1_compat_mode'} = 0; + # For debugging purposes, see below + my $directive_file_contents = ''; + my @lines = (); + # Read the contents of the directive file. We require one # non-white non-pgp line: # Directory: dirname[/subdirname] # open (DIRECTIVE_FILE, "<", $directive_file) || ftp_die("FATAL: open($directive_file) failed: $!"); + my $cnt = 0; # Keep track of the order of directives... + while () { + my $line = $_; + $directive_file_contents .= $line; + push(@lines,$line); + } + close (DIRECTIVE_FILE) || ftp_warn("close($directive_file) failed: $!"); # If we don't know whose project this file belongs to, because the # 'directory:' line is messed up or not there, we'd still like to let the @@ -540,7 +573,7 @@ sub read_directive_file { } close(TMP); - my $tmp_retval = &verify_keyring($directive_file,@tmp_keyrings); + my $tmp_retval = &verify_keyring($directive_file,$directive_file_contents,@tmp_keyrings); push(@{$info{email}},$1) if ($tmp_retval =~ /Good signature from .*?<(.*?)>/); my $signed = 0; @@ -549,17 +582,6 @@ sub read_directive_file { # to upload a directive file only to archive/create symlinks/remove symlinks my $filename_required = 1; - # For debugging purposes, see below - my $directive_file_contents = ''; - my @lines = (); - - my $cnt = 0; # Keep track of the order of directives... - while () { - my $line = $_; - $directive_file_contents .= $line; - push(@lines,$line); - } - foreach my $line (@lines) { $line =~ s/\r\n/\n/g; # deal with dos-based line endings... $line =~ s/\s+$/\n/; # Some people like to put spaces after their commands @@ -579,27 +601,10 @@ sub read_directive_file { my ($tainted_cmd,$tainted_val) = split(' ',$line,2); if ($tainted_cmd =~ /^Directory:?$/i) { # case-insensitive, w or w/o the : - # 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. - $tainted_val =~ m,^(\w[-.\w]*(/\w[-.\w]*)*)$, || &fatal("invalid directory $tainted_val",1,$directive_file_contents); - my $val = $1; # so far so good - - # 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; - - # 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"}; - - $info{"directory"} = $val; # ok. - ($info{"package"} = $val) =~ s,/.*$,,; # top-level name, no subdir - # Set email addresses - push (@{$info{email}}, email_addresses ($info{package})); + parse_directory_line($tainted_val, $directive_file_contents); } 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); + $tainted_val =~ /^([\w_\+][-.\w_\+\~]*)$/ || &fatal("invalid filename $tainted_val",1,$directive_file_contents); my $val = $1; # so far so good # Only let them specify one filename directive. @@ -640,7 +645,6 @@ sub read_directive_file { &fatal("unrecognized directive ($tainted_cmd)",1,$directive_file_contents); } } - close (DIRECTIVE_FILE) || ftp_warn("close($directive_file) failed: $!"); # 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 @@ -732,7 +736,7 @@ sub read_directive_file { if ! $info{"version"}; } - my $retval = &verify_keyring($directive_file,@keyrings); + my $retval = &verify_keyring($directive_file,$directive_file_contents,@keyrings); # Now check that the timestamp of signing for the directive is not older # than the one for the last file that was uploaded @@ -803,6 +807,14 @@ sub read_directive_file { return 0; } +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); + } +} + # # Verify that the signature used for the directive file is valid for @@ -810,7 +822,7 @@ sub read_directive_file { # sub-most directory, until we find one that matches (or not!) # sub verify_keyring { - my ($directive_file, @keyrings) = @_; + my ($directive_file, $directive_file_contents, @keyrings) = @_; foreach (@keyrings) { # We need what gpgv writes to STDERR to determine the timestamp # Hence the silly trick with storing the return code of gpgv in @@ -826,12 +838,14 @@ sub verify_keyring { 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); } 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! } } + guess_uploader_email($directive_file_contents); &fatal("gpg verify of directive file failed",1); } @@ -1025,8 +1039,17 @@ sub mail { # Some messages should be sent to the user, some should not push (@email_list, @{$info{email}}) if (defined $info{email} && $send_to_user); + # If this is an e-mail to the uploader, don't send it to the script maintainer. shift(@email_list) if ($send_to_user); + if ($#email_list == -1) { + # Something went wrong, but we can't figure out which package this upload belongs to. + # Mention that in the logs, and then mail this to the script maintainer anyway. + ftp_syslog('info', "($log_style) No uploader e-mail address(es) to report this error to!"); + @email_list = ($email_always); + } + ftp_syslog('info', "($log_style) Sending email to @email_list"); + my $sender = 'ftp-upload-script@gnu.org'; $sender = 'ftp-upload@gnu.org' if ($send_to_user); # We really want replies to go to the ftp-upload queue @@ -1040,7 +1063,6 @@ sub mail { $smtp->bcc ($email_always) if ($send_to_user); $smtp->recipient (@email_list, { SkipBad => 1}); - ftp_syslog('info', "($log_style) Sending email to @email_list"); $smtp->data (); $smtp->datasend ("To: " . join (", ", @email_list) . "\n"); $smtp->datasend ("From: $sender\n");