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::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" );
}
my $stat;
local (*PIPE);
+ if ($file =~ /^([-\w.+~]+)$/) {
+ $file = $1;
+ } else {
+ msg( "log", "Tainted filename, skipping: $file\n" );
+ return "LOCAL ERROR";
+ }
+
$stat = 1;
if ( -x $conf::gpg ) {
debug( "executing $conf::gpg --no-options --batch "
$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]) {
projects / dak.git / blobdiff