debianqueued: log which .dak-commands file we are processing

[dak.git] / tools / debianqueued-0.9 / debianqueued

diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued
index af8d70daef1a1cb14e497e350bad386234380937..45f1242781fe7bc54948fa66a19ad215957b2e22 100755 (executable)
--- a/tools/debianqueued-0.9/debianqueued
+++ b/tools/debianqueued-0.9/debianqueued
@@ -22,6 +22,7 @@ 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");
 
@@ -58,6 +59,7 @@ $junk         = @conf::test_binaries;
 $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;
@@ -385,7 +387,7 @@ while (1) {
 
   # 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++ )
@@ -485,7 +487,7 @@ sub check_dir() {
            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);
@@ -496,6 +498,15 @@ sub check_dir() {
         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 (
@@ -692,7 +703,7 @@ sub process_changes($\@) {
        $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);
@@ -709,12 +720,19 @@ sub process_changes($\@) {
   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) {
@@ -760,6 +778,12 @@ outer_loop: while (<CHANGES>) {
   @$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; "
@@ -1102,6 +1126,55 @@ outer_loop: while (<CHANGES>) {
   #}
 } ## 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
 #
@@ -1320,8 +1393,8 @@ outer_loop: while (<COMMANDS>) {
             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" );
             }
@@ -1391,8 +1464,8 @@ sub age_delayed_queues() {
         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" );
           }
@@ -2329,14 +2402,19 @@ sub send_mail($$$) {
     $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 ) {