#
require 5.002;
+no lib '.';
use strict;
use POSIX;
use POSIX qw( strftime sys_stat_h sys_wait_h signal_h );
use Digest::MD5;
setlocale(&POSIX::LC_ALL, "C");
+$ENV{"LC_ALL"} = "C";
# ---------------------------------------------------------------------------
# configuration
$junk = $conf::max_upload_retries;
$junk = $conf::upload_delay_1;
$junk = $conf::upload_delay_2;
-$junk = $conf::ar;
-$junk = $conf::gzip;
-$junk = $conf::cp;
$junk = $conf::check_md5sum;
#$junk = $conf::ls;
-$junk = $conf::chmod;
$junk = $conf::ftpdebug;
$junk = $conf::ftptimeout;
-$junk = $conf::no_changes_timeout;
$junk = @conf::nonus_packages;
$junk = @conf::test_binaries;
$junk = @conf::maintainer_mail;
($main::hostname, undef, undef, undef, undef) = gethostbyname(hostname());
my %packages = ();
-my $re_file_safe_prefix = qr/\A([a-zA-Z0-9][a-zA-Z0-9_.:~+-]*)/s;
+my $re_file_safe_prefix = qr/\A([a-zA-Z0-9.][a-zA-Z0-9_.:~+-]*)/s;
my $re_file_safe = qr/$re_file_safe_prefix\z/s;
# extract -r and -k args
# check if all programs exist
my $prg;
foreach $prg ( $conf::gpg, $conf::ssh, $conf::scp, $conf::ssh_agent,
- $conf::ssh_add, $conf::md5sum, $conf::mail, $conf::mkfifo )
+ $conf::ssh_add, $conf::mail, $conf::mkfifo )
{
die "Required program $prg doesn't exist or isn't executable\n"
if !-x $prg;
sub ftp_error();
sub ssh_cmd($);
sub scp_cmd(@);
-sub local_cmd($;$);
sub check_alive(;$);
sub check_incoming_writable();
sub rm(@);
my (
$pgplines, @files, @filenames, @changes_stats,
$failure_file, $retries, $last_retry, $upload_time,
- $file, $do_report, $ls_l, $problems_reported,
+ $file, $do_report, $ls_l,
$errs, $pkgname, $signator, $extralines
);
local (*CHANGES);
format_status_str( $main::current_changes,
"$main::current_incoming_short/$changes" );
$main::dstat = "c";
+ $main::mail_addr = "";
write_status_file() if $conf::statusdelay;
@$keep_list = ();
msg( "log", "processing ${main::current_incoming_short}/$changes\n" );
+ # run PGP on the file to check the signature
+ if ( !( $signator = pgp_check($changes) ) ) {
+ msg(
+ "log,mail",
+ "$main::current_incoming_short/$changes has bad PGP/GnuPG signature!\n"
+ );
+ goto remove_only_changes;
+ } elsif ( $signator eq "LOCAL ERROR" ) {
+
+ # An error has appened when starting pgp... Don't process the file,
+ # but also don't delete it
+ debug(
+"Can't PGP/GnuPG check $main::current_incoming_short/$changes -- don't process it for now"
+ );
+ return;
+ } ## end elsif ( $signator eq "LOCAL ERROR")
+
# parse the .changes file
open( CHANGES, "<", $changes )
or die "Cannot open ${main::current_incoming_short}/$changes: $!\n";
$pgplines = 0;
$extralines = 0;
- $main::mail_addr = "";
@files = ();
outer_loop: while (<CHANGES>) {
if (/^---+(BEGIN|END) PGP .*---+$/) {
push( @$keep_list, $failure_file );
} ## end if ( -f $failure_file )
- # run PGP on the file to check the signature
- if ( !( $signator = pgp_check($changes) ) ) {
- msg(
- "log,mail",
- "$main::current_incoming_short/$changes has bad PGP/GnuPG signature!\n"
- );
- msg( "log", "(uploader $main::mail_addr)\n" );
- remove_only_changes:
- msg(
- "log,mail",
-"Removing $main::current_incoming_short/$changes, but keeping its associated ",
- "files for now.\n"
- );
- rm($changes);
-
- # Set SGID bit on associated files, so that the test for Debian files
- # without a .changes doesn't consider them.
- foreach (@filenames) {
- my @st = stat($_);
- next if !@st; # file may have disappeared in the meantime
- chmod +( $st[ST_MODE] |= S_ISGID ), $_;
- }
- return;
- } elsif ( $signator eq "LOCAL ERROR" ) {
-
- # An error has appened when starting pgp... Don't process the file,
- # but also don't delete it
- debug(
-"Can't PGP/GnuPG check $main::current_incoming_short/$changes -- don't process it for now"
- );
- return;
- } ## end elsif ( $signator eq "LOCAL ERROR")
-
die "Cannot stat ${main::current_incoming_short}/$changes (??): $!\n"
if !( @changes_stats = stat($changes) );
} ## end for $file (@files)
$do_report = ( time - $upload_time ) > $conf::problem_report_timeout;
- $problems_reported = $changes_stats[ST_MODE] & S_ISGID;
-
- # if any of the files is newer than the .changes' ctime (the time
- # we sent a report and set the sticky bit), send new problem reports
- if ( $problems_reported && $changes_stats[ST_CTIME] < $upload_time ) {
- $problems_reported = 0;
- chmod +( $changes_stats[ST_MODE] &= ~S_ISGID ), $changes;
- debug("upload_time>changes-ctime => resetting problems reported");
- }
- debug("do_report=$do_report problems_reported=$problems_reported");
# now check all files for correct size and md5 sum
for $file (@files) {
# could be an upload that isn't complete yet, be quiet,
# but don't process the file;
- msg( "log,mail", "$filename doesn't exist\n" )
- if $do_report && !$problems_reported;
- msg( "log", "$filename doesn't exist (ignored for now)\n" )
- if !$do_report;
- msg( "log", "$filename doesn't exist (already reported)\n" )
- if $problems_reported;
+ msg( "log", "$filename doesn't exist (ignored for now)\n" );
++$errs;
} elsif ( $file->{"stats"}->[ST_SIZE] < $file->{"size"}
&& !$do_report )
msg( "log,mail", "All files it mentions are also removed:\n" );
msg( "log,mail", " ", join( ", ", @filenames ), "\n" );
rm( $changes, @filenames, $failure_file );
- } elsif ( $do_report && !$problems_reported ) {
-
- # otherwise, send a problem report, if not done already
- msg(
- "mail",
- "Due to the errors above, the .changes file couldn't ",
- "be processed.\n",
- "Please fix the problems for the upload to happen.\n"
- );
-
- # remember we already have sent a mail regarding this file
- debug("Sending problem report mail and setting SGID bit");
- my $mode = $changes_stats[ST_MODE] |= S_ISGID;
- msg( "log", "chmod failed: $!" )
- if ( chmod( $mode, $changes ) != 1 );
- } ## end elsif ( $do_report && !$problems_reported)
+ }
# else: be quiet
return;
} ## end if ( $retries > 0 && (...
- if ( $conf::upload_method eq "ftp" ) {
- return if !ftp_open();
- }
+ return if !ftp_open();
# check if the job is already present on target
# (moved to here, to avoid bothering target as long as there are errors in
msg( "log",
"$changes processed successfully (uploader $main::mail_addr)\n" );
+ return;
+
+ remove_only_changes:
+ msg(
+ "log,mail",
+ "Removing $main::current_incoming_short/$changes, but keeping its "
+ . "associated files for now.\n"
+ );
+ rm($changes);
+ return;
+
# Check for files that have the same stem as the .changes (and weren't
# mentioned there) and delete them. It happens often enough that people
# upload a .orig.tar.gz where it isn't needed and also not in the
}
msg("log,mail", "(PGP/GnuPG signature by $signator)\n");
+ return if !ftp_open();
+
# check target
my @filenames = ($commands);
if (my $ls_l = is_on_target($commands, @filenames)) {
my $commands = shift;
my ( @cmds, $cmd, $pgplines, $signator );
local (*COMMANDS);
- my ( @files, $file, @removed, $target_delay );
+ my ($file, @removed, $target_delay );
format_status_str( $main::current_changes, $commands );
$main::dstat = "c";
+ $main::mail_addr = "";
write_status_file() if $conf::statusdelay;
msg( "log", "processing $main::current_incoming_short/$commands\n" );
+ # run PGP on the file to check the signature
+ if ( !( $signator = pgp_check($commands) ) ) {
+ msg(
+ "log,mail",
+ "$main::current_incoming_short/$commands has bad PGP/GnuPG signature!\n"
+ );
+ goto remove;
+ } elsif ( $signator eq "LOCAL ERROR" ) {
+
+ # An error has appened when starting pgp... Don't process the file,
+ # but also don't delete it
+ debug(
+"Can't PGP/GnuPG check $main::current_incoming_short/$commands -- don't process it for now"
+ );
+ return;
+ } ## end elsif ( $signator eq "LOCAL ERROR")
+ msg( "log", "(PGP/GnuPG signature by $signator)\n" );
+
# parse the .commands file
if ( !open( COMMANDS, "<", $commands ) ) {
msg( "log", "Cannot open $main::current_incoming_short/$commands: $!\n" );
return;
}
$pgplines = 0;
- $main::mail_addr = "";
@cmds = ();
outer_loop: while (<COMMANDS>) {
if (/^---+(BEGIN|END) PGP .*---+$/) {
goto remove;
} ## end if ( $pgplines < 3 )
- # run PGP on the file to check the signature
- if ( !( $signator = pgp_check($commands) ) ) {
- msg(
- "log,mail",
- "$main::current_incoming_short/$commands has bad PGP/GnuPG signature!\n"
- );
- remove:
- msg( "log,mail", "Removing $main::current_incoming_short/$commands\n" );
- rm($commands);
- return;
- } elsif ( $signator eq "LOCAL ERROR" ) {
-
- # An error has appened when starting pgp... Don't process the file,
- # but also don't delete it
- debug(
-"Can't PGP/GnuPG check $main::current_incoming_short/$commands -- don't process it for now"
- );
- return;
- } ## end elsif ( $signator eq "LOCAL ERROR")
- msg( "log", "(PGP/GnuPG signature by $signator)\n" );
-
# now process commands
msg(
"mail",
next if @word < 1;
if ( $word[0] eq "rm" ) {
+ my @files = ();
foreach ( @word[ 1 .. $#word ] ) {
my $origword = $_;
if (m,^DELAYED/([0-9]+)-day/,) {
} elsif ( $conf::upload_method ne "copy" ) {
msg( "mail,log", "cancel not available\n" );
} elsif (
- $word[1] !~ m,$re_file_safe_prefix.changes\z, )
+ $word[1] !~ m,$re_file_safe_prefix\.changes\z, )
{
msg( "mail,log",
"argument to cancel must be one .changes filename without path\n" );
rm($commands);
msg( "log",
"-- End of $main::current_incoming_short/$commands processing\n" );
+ return;
+
+ remove:
+ msg("log,mail", "Removing $main::current_incoming_short/$commands\n");
+ rm($commands);
+ return;
} ## end sub process_commands($)
sub age_delayed_queues() {
goto err if !$rv;
}
} else {
- ( $msgs, $stat ) =
- local_cmd( "$conf::cp @files $main::current_targetdir", 'NOCD' );
- goto err if $stat;
+ for my $file (@files) {
+ eval { File::Copy::copy($file, $main::current_targetdir) };
+ if ($@) {
+ $stat = 1;
+ $msgs = $@;
+ goto err;
+ }
+ }
}
# check md5sums or sizes on target against our own
} ## end foreach $file (@files)
} ## end if ( !$have_md5sums )
} else {
- ( $msgs, $stat ) = local_cmd("$conf::md5sum @files");
- goto err if $stat;
- @md5sum = split( "\n", $msgs );
+ for my $file (@files) {
+ my $md5 = eval { md5sum("$main::current_targetdir/$file") };
+ if ($@) {
+ $msgs = $@;
+ goto err;
+ }
+ push @md5sum, "$md5 $file" if $md5;
+ }
}
@expected_files = @files;
goto err if !$rv;
} ## end foreach $file (@files)
} else {
- ( $msgs, $stat ) = local_cmd("$conf::chmod 644 @files");
- goto err if $stat;
+ for my $file (@files) {
+ unless (chmod 0644, "$main::current_targetdir/$file") {
+ $msgs = "Could not chmod $file: $!";
+ goto err;
+ }
+ }
}
} ## end if ($conf::chmod_on_target)
# If "permission denied" was among the errors, test if the incoming is
# writable at all.
- if ( $msgs =~ /(permission denied|read-?only file)/i ) {
+ if ( $msgs && $msgs =~ /(permission denied|read-?only file)/i ) {
if ( !check_incoming_writable() ) {
msg( "log,mail", "(The incoming directory seems to be ",
"unwritable.)\n" );
my $output = "";
my $signator;
my $found = 0;
- my $stat;
+ my $stat = 1;
local (*PIPE);
+ local $_;
if ($file =~ /$re_file_safe/) {
$file = $1;
return "LOCAL ERROR";
}
- $stat = 1;
+ # check the file has only one clear-signed section
+ my $fh;
+ unless (open $fh, "<", $file) {
+ msg("log,mail", "Could not open $file\n");
+ return "";
+ }
+ unless (<$fh> eq "-----BEGIN PGP SIGNED MESSAGE-----\n") {
+ msg("log,mail", "$file: does not start with a clearsigned message\n");
+ return "";
+ }
+ my $pgplines = 1;
+ while (<$fh>) {
+ if (/\A- /) {
+ msg("log,mail", "$file: dash-escaped messages are not accepted\n");
+ return "";
+ }
+ elsif ($_ eq "-----BEGIN PGP SIGNATURE-----\n"
+ || $_ eq "-----END PGP SIGNATURE-----\n") {
+ $pgplines++;
+ }
+ elsif (/\A--/) {
+ msg("log,mail", "$file: unexpected OpenPGP armor\n");
+ return "";
+ }
+ elsif ($pgplines > 3 && /\S/) {
+ msg("log,mail", "$file: found text after end of signature\n");
+ return "";
+ }
+ }
+ if ($pgplines != 3) {
+ msg("log,mail", "$file: doesn't seem to be a valid clearsigned OpenPGP message\n");
+ return "";
+ }
+ close $fh;
+
if ( -x $conf::gpg ) {
- debug( "executing $conf::gpg --no-options --batch "
- . "--no-default-keyring --always-trust "
- . "--keyring "
- . join( " --keyring ", @conf::keyrings )
- . " --verify '$file'" );
- if (
- !open( PIPE,
- "$conf::gpg --no-options --batch "
- . "--no-default-keyring --always-trust "
- . "--keyring "
- . join( " --keyring ", @conf::keyrings )
- . " --verify '$file'"
- . " 2>&1 |"
- )
- )
- {
- msg( "log", "Can't open pipe to $conf::gpg: $!\n" );
+ my @command = ("$conf::gpg", "--no-options", "--batch", "--no-tty",
+ "--trust-model", "always", "--no-default-keyring",
+ (map +("--keyring" => $_), @conf::keyrings),
+ "--verify", "-");
+ debug( "executing " . join(" ", @command) );
+
+ my $child = open(PIPE, "-|");
+ if (!defined($child)) {
+ msg("log", "Can't open pipe to $conf::gpg: $!\n");
return "LOCAL ERROR";
- } ## end if ( !open( PIPE, "$conf::gpg --no-options --batch "...
+ }
+ if ($child == 0) {
+ unless (open(STDERR, ">&", \*STDOUT)) {
+ print "Could not redirect STDERR.";
+ exit(-1);
+ }
+ unless (open(STDIN, "<", $file)) {
+ print "Could not open $file: $!";
+ exit(-1);
+ }
+ { exec(@command) }; # BLOCK avoids warning about likely unreachable code
+ print "Could not exec gpg: $!";
+ exit(-1);
+ }
+
$output .= $_ while (<PIPE>);
close(PIPE);
$stat = $?;
# open FTP connection to target host if not already open
#
sub ftp_open() {
+ return 1 unless $conf::upload_method eq "ftp";
if ($main::FTP_chan) {
return ( $msg, $stat );
} ## end sub scp_cmd(@)
-sub local_cmd($;$) {
- my $cmd = shift;
- my $nocd = shift;
- my ( $msg, $stat );
-
- my $ecmd = ( $nocd ? "" : "cd $main::current_targetdir; " ) . $cmd;
- debug("executing $ecmd");
- $msg = `($ecmd) 2>&1`;
- $stat = $?;
- return ( $msg, $stat );
-
-} ## end sub local_cmd($;$)
-
#
# check if target is alive (code stolen from Net::Ping.pm)
#
unlink $file;
ftp_cmd( "delete", $file );
} elsif ( $conf::upload_method eq "copy" ) {
- ( $msg, $stat ) =
- local_cmd( "rm -f $testfile; touch $testfile; " . "rm -f $testfile" );
+ unless(POSIX::access($main::current_targetdir, &POSIX::W_OK)) {
+ $msg = "No write access: $!";
+ $stat = 1;
+ }
}
chomp($msg);
debug("exit status: $stat, output was: $msg");
my $package =
keys %main::packages ? join( ' ', keys %main::packages ) : "";
- use Email::Send;
-
- unless ( defined($Email::Send::Sendmail::SENDMAIL) ) {
- $Email::Send::Sendmail::SENDMAIL = $conf::mail;
- }
+ use Email::Sender::Simple;
if ($conf::overridemail) {
$addr = $conf::overridemail;
Date: $date
X-Debian: DAK
X-DAK: DAK
+Precedence: bulk
+Auto-Submitted: auto-generated
__MESSAGE__
if ( length $package ) {
$message .= "\n$text";
$message .= "\nGreetings,\n\n\tYour Debian queue daemon (running on host $main::hostname)\n";
- my $mail = Email::Send->new;
- for (qw[Sendmail SMTP]) {
- $mail->mailer($_) and last if $mail->mailer_available($_);
- }
-
- my $ret = $mail->send($message);
- if ( $ret && $ret !~ /Message sent|success/ ) {
- return 0;
- }
-
- return 1;
+ return Email::Sender::Simple->try_to_send($message);
} ## end sub send_mail($$$)
#
projects / dak.git / blobdiff