use Net::FTP;
use Socket qw( PF_INET AF_INET SOCK_STREAM );
use Config;
+use Sys::Hostname;
+use File::Copy;
+
+setlocale(&POSIX::LC_ALL, "C");
# ---------------------------------------------------------------------------
# configuration
$junk = $conf::ar;
$junk = $conf::gzip;
$junk = $conf::cp;
+$junk = $conf::check_md5sum;
#$junk = $conf::ls;
$junk = $conf::chmod;
$junk = @conf::maintainer_mail;
$junk = @conf::targetdir_delayed;
$junk = $conf::mail ||= '/usr/sbin/sendmail';
+$junk = $conf::overridemail;
$conf::target = "localhost" if $conf::upload_method eq "copy";
package main;
( $main::progname = $0 ) =~ s,.*/,,;
+($main::hostname, undef, undef, undef, undef) = gethostbyname(hostname());
+
my %packages = ();
# extract -r and -k args
POSIX::sigsuspend($sigset);
waitpid( $pid, WNOHANG );
if ( kill( 0, $pid ) ) {
- print "Daemon started in background (pid $pid)\n";
+ print "Daemon (on $main::hostname) started in background (pid $pid)\n";
exit 0;
} else {
exit 1;
do {
my $version;
- ( $version =
-'Release: 0.9 $Revision: 1.51 $ $Date: 1999/07/08 09:43:21 $ $Author: ftplinux $'
- ) =~ s/\$ ?//g;
+ ( $version = 'Release: 0.95' ) =~ s/\$ ?//g;
print "debianqueued $version\n";
};
or die "$main::progname: Can't redirect stderr to $conf::logfile: $!\n";
# ok, from this point usually no "die" anymore, stderr is gone!
-msg( "log", "daemon (pid $$) started\n" );
+msg( "log", "daemon (pid $$) (on $main::hostname) started\n" );
# initialize variables used by send_status before launching the status daemon
$main::dstat = "i";
# ping target only if there is the possibility that we'll contact it (but
# also don't wait too long).
- my @have_changes = <*.changes *.commands>;
+ my @have_changes = <*.changes *.commands *.dak-commands>;
for ( my $delayed_dirs = 0 ;
$delayed_dirs <= $conf::max_delayed ;
$delayed_dirs++ )
return
);
- # look for *.commands files but not in delayed queues
+ # look for *.commands and *.dak-commands files but not in delayed queues
if ( $adelay == -1 ) {
foreach $file (<*.commands>) {
init_mail($file);
write_status_file() if $conf::statusdelay;
finish_mail();
} ## end foreach $file (<*.commands>)
+ foreach $file (<*.dak-commands>) {
+ init_mail($file);
+ block_signals();
+ process_dak_commands($file);
+ unblock_signals();
+ $main::dstat = "c";
+ write_status_file() if $conf::statusdelay;
+ finish_mail();
+ }
} ## end if ( $adelay == -1 )
opendir( INC, "." )
or (
$pgplines, @files, @filenames, @changes_stats,
$failure_file, $retries, $last_retry, $upload_time,
$file, $do_report, $ls_l, $problems_reported,
- $errs, $pkgname, $signator
+ $errs, $pkgname, $signator, $extralines
);
local (*CHANGES);
local (*FAILS);
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 .*---+$/) {
++$pgplines;
- } elsif (/^Maintainer:\s*/i) {
+ next;
+ }
+ if ( $pgplines < 1 or $pgplines >= 3 ) {
+ $extralines++ if length $_ > 1;
+ next;
+ }
+ if (/^Maintainer:\s*/i) {
chomp( $main::mail_addr = $' );
$main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
} elsif (/^Source:\s*/i) {
@$keep_list = @filenames;
# some consistency checks
+ if ( $extralines ) {
+ msg( "log,mail",
+"$main::current_incoming_short/$changes contained lines outside the pgp signed "
+."part, cannot process\n" );
+ goto remove_only_changes;
+ } ## end if ( $extralines )
if ( !$main::mail_addr ) {
msg( "log,mail",
"$main::current_incoming_short/$changes doesn't contain a Maintainer: field; "
#}
} ## end sub process_changes($\@)
+#
+# process one .dak-commands file
+#
+sub process_dak_commands {
+ my $commands = shift;
+
+ msg("log", "processing ${main::current_incoming_short}/$commands\n");
+
+ # TODO: get mail address from signed contents
+ # and NOT implement a third parser for armored PGP...
+ $main::mail_addr = undef;
+
+ # check signature
+ my $signator = pgp_check($commands);
+ if (!$signator) {
+ msg("log,mail",
+ "$main::current_incoming_short/$commands has bad PGP/GnuPG signature!\n");
+ msg("log,mail",
+ "Removing $main::current_incoming_short/$commands\n");
+ rm($commands);
+ return;
+ }
+ elsif ($signator eq 'LOCAL ERROR') {
+ debug("Can't check signature for $main::current_incoming_short/$commands -- don't process it for now");
+ return;
+ }
+ msg("log,mail", "(PGP/GnuPG signature by $signator)\n");
+
+ # check target
+ my @filenames = ($commands);
+ if (my $ls_l = is_on_target($commands, @filenames)) {
+ msg("log,mail", "$main::current_incoming_short/$commands is already present on target host:\n");
+ msg("log,mail", "$ls_l\n");
+ msg("log,mail", "Job $commands removed.\n");
+ rm($commands);
+ return;
+ }
+
+ if (!copy_to_target($commands)) {
+ msg("log,mail", "$commands couldn't be uploaded to target.\n");
+ msg("log,mail", "Giving up and removing it.\n");
+ rm($commands);
+ return;
+ }
+
+ rm($commands);
+ msg("mail", "$commands uploaded successfully to $conf::target\n");
+}
+
#
# process one .commands file
#
$selecteddelayed = $1;
s,^DELAYED/[0-9]+-day/,,;
}
- if ( $origword eq "--searchdirs" ) {
+ if (m,(^|/)\*,) {
+ msg("mail,log", "$_: filename component cannot start with a wildcard\n");
+ } elsif ( $origword eq "--searchdirs" ) {
$selecteddelayed = -2;
} elsif (m,/,) {
msg(
if ( $afile =~ m/\.changes$/ ) {
utime undef, undef, ("$dir/$afile");
}
- if ( !rename "$dir/$afile", "$target_dir/$afile" ) {
- msg( "mail,log", "rename: $!\n" );
+ if ( !move("$dir/$afile", "$target_dir/$afile") ) {
+ msg( "mail,log", "move: $!\n" );
} else {
msg( "mail,log", "$afile moved to $target_delay-day\n" );
}
my @thesefiles = ( $achanges =~ m,.*/([^/]*), );
push( @thesefiles, get_filelist_from_known_good_changes($achanges) );
for my $afile (@thesefiles) {
- if ( !rename "$dir/$afile", "$target_dir/$afile" ) {
- msg( "log", "rename: $!\n" );
+ if ( !move("$dir/$afile", "$target_dir/$afile") ) {
+ msg( "log", "move: $!\n" );
} else {
msg( "log", "$afile moved to $target_dir\n" );
}
# check md5sums or sizes on target against our own
my $have_md5sums = 1;
- if ( $conf::upload_method eq "ssh" ) {
- ( $msgs, $stat ) = ssh_cmd("md5sum @files");
- goto err if $stat;
- @md5sum = split( "\n", $msgs );
- } elsif ( $conf::upload_method eq "ftp" ) {
- my ( $rv, $err, $file );
- foreach $file (@files) {
- ( $rv, $err ) = ftp_cmd( "quot", "site", "md5sum", $file );
- if ($err) {
- next if ftp_code() == 550; # file not found
- if ( ftp_code() == 500 ) { # unimplemented
- $have_md5sums = 0;
- goto get_sizes_instead;
- }
- $msgs = $err;
- goto err;
- } ## end if ($err)
- chomp( my $t = ftp_response() );
- push( @md5sum, $t );
- } ## end foreach $file (@files)
- if ( !$have_md5sums ) {
- get_sizes_instead:
+ if ($conf::check_md5sum) {
+ if ( $conf::upload_method eq "ssh" ) {
+ ( $msgs, $stat ) = ssh_cmd("md5sum @files");
+ goto err if $stat;
+ @md5sum = split( "\n", $msgs );
+ } elsif ( $conf::upload_method eq "ftp" ) {
+ my ( $rv, $err, $file );
foreach $file (@files) {
- ( $rv, $err ) = ftp_cmd( "size", $file );
+ ( $rv, $err ) = ftp_cmd( "quot", "site", "md5sum", $file );
if ($err) {
next if ftp_code() == 550; # file not found
+ if ( ftp_code() == 500 ) { # unimplemented
+ $have_md5sums = 0;
+ goto get_sizes_instead;
+ }
$msgs = $err;
goto err;
- }
- push( @md5sum, "$rv $file" );
+ } ## end if ($err)
+ chomp( my $t = ftp_response() );
+ push( @md5sum, $t );
} ## end foreach $file (@files)
- } ## end if ( !$have_md5sums )
- } else {
- ( $msgs, $stat ) = local_cmd("$conf::md5sum @files");
- goto err if $stat;
- @md5sum = split( "\n", $msgs );
- }
+ if ( !$have_md5sums ) {
+ get_sizes_instead:
+ foreach $file (@files) {
+ ( $rv, $err ) = ftp_cmd( "size", $file );
+ if ($err) {
+ next if ftp_code() == 550; # file not found
+ $msgs = $err;
+ goto err;
+ }
+ push( @md5sum, "$rv $file" );
+ } ## end foreach $file (@files)
+ } ## end if ( !$have_md5sums )
+ } else {
+ ( $msgs, $stat ) = local_cmd("$conf::md5sum @files");
+ goto err if $stat;
+ @md5sum = split( "\n", $msgs );
+ }
- @expected_files = @files;
- foreach (@md5sum) {
- chomp;
- ( $sum, $name ) = split;
- next if !grep { $_ eq $name } @files; # a file we didn't upload??
- next if $sum eq "md5sum:"; # looks like an error message
- if ( ( $have_md5sums && $sum ne md5sum($name) )
- || ( !$have_md5sums && $sum != ( -s $name ) ) )
- {
- msg(
- "log,mail",
- "Upload of $name to $conf::target failed ",
- "(" . ( $have_md5sums ? "md5sum" : "size" ) . " mismatch)\n"
- );
+ @expected_files = @files;
+ foreach (@md5sum) {
+ chomp;
+ ( $sum, $name ) = split;
+ next if !grep { $_ eq $name } @files; # a file we didn't upload??
+ next if $sum eq "md5sum:"; # looks like an error message
+ if ( ( $have_md5sums && $sum ne md5sum($name) )
+ || ( !$have_md5sums && $sum != ( -s $name ) ) )
+ {
+ msg(
+ "log,mail",
+ "Upload of $name to $conf::target failed ",
+ "(" . ( $have_md5sums ? "md5sum" : "size" ) . " mismatch)\n"
+ );
+ goto err;
+ } ## end if ( ( $have_md5sums &&...
+
+ # seen that file, remove it from expect list
+ @expected_files = map { $_ eq $name ? () : $_ } @expected_files;
+ } ## end foreach (@md5sum)
+ if (@expected_files) {
+ msg( "log,mail", "Failed to upload the files\n" );
+ msg( "log,mail", " ", join( ", ", @expected_files ), "\n" );
+ msg( "log,mail", "(Not present on target after upload)\n" );
goto err;
- } ## end if ( ( $have_md5sums &&...
-
- # seen that file, remove it from expect list
- @expected_files = map { $_ eq $name ? () : $_ } @expected_files;
- } ## end foreach (@md5sum)
- if (@expected_files) {
- msg( "log,mail", "Failed to upload the files\n" );
- msg( "log,mail", " ", join( ", ", @expected_files ), "\n" );
- msg( "log,mail", "(Not present on target after upload)\n" );
- goto err;
- } ## end if (@expected_files)
+ } ## end if (@expected_files)
+ } ## end if ($conf::check_md5sum)
if ($conf::chmod_on_target) {
Net::FTP->new(
$conf::target,
Debug => $conf::ftpdebug,
- Timeout => $conf::ftptimeout
+ Timeout => $conf::ftptimeout,
+ Passive => 1,
)
)
)
$Email::Send::Sendmail::SENDMAIL = $conf::mail;
}
+ if ($conf::overridemail) {
+ $addr = $conf::overridemail;
+ }
+
my $date = sprintf "%s",
strftime( "%a, %d %b %Y %T %z", ( localtime(time) ) );
my $message = <<__MESSAGE__;
To: $addr
-From: Archive Administrator <dak\@ftp-master.debian.org>
+From: Debian FTP Masters <ftpmaster\@ftp-master.debian.org>
Subject: $subject
Date: $date
X-Debian: DAK
+X-DAK: DAK
__MESSAGE__
if ( length $package ) {
}
$message .= "\n$text";
- $message .= "\nGreetings,\n\n\tYour Debian queue daemon\n";
+ $message .= "\nGreetings,\n\n\tYour Debian queue daemon (running on host $main::hostname)\n";
my $mail = Email::Send->new;
for (qw[Sendmail SMTP]) {