X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=tools%2Fdebianqueued-0.9%2Fdebianqueued;h=393f0a0f1322f9685bb4e8b4d960bf9da907c79a;hb=573d74e03a1c0a1df33fc8b272923ce684649710;hp=2a45d5d88628226df990801451328b7154452de5;hpb=1e1894a99a1a6191bf91fe65251da0f6077a0e4f;p=dak.git

diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued
index 2a45d5d8..393f0a0f 100755
--- a/tools/debianqueued-0.9/debianqueued
+++ b/tools/debianqueued-0.9/debianqueued
@@ -69,6 +69,8 @@ package main;
 ($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 = qr/$re_file_safe_prefix\z/s;
 
 # extract -r and -k args
 $main::arg = "";
@@ -387,7 +389,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++ )
@@ -487,7 +489,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);
@@ -498,6 +500,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 (
@@ -671,7 +682,7 @@ outer_loop: while (<CHANGES>) {
 
         # forbid shell meta chars in the name, we pass it to a
         # subshell several times...
-        $field[5] =~ /^([a-zA-Z0-9.+_:@=%-][~a-zA-Z0-9.+_:@=%-]*)/;
+        $field[5] =~ /$re_file_safe/;
         if ( $1 ne $field[5] ) {
           msg( "log", "found suspicious filename $field[5]\n" );
           next;
@@ -738,7 +749,7 @@ outer_loop: while (<CHANGES>) {
 
         # forbid shell meta chars in the name, we pass it to a
         # subshell several times...
-        $field[5] =~ /^([a-zA-Z0-9.+_:@=%-][~a-zA-Z0-9.+_:@=%-]*)/;
+        $field[5] =~ /$re_file_safe/;
         if ( $1 ne $field[5] ) {
           msg( "log", "found suspicious filename $field[5]\n" );
           msg(
@@ -1117,6 +1128,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
 #
@@ -1349,7 +1409,7 @@ outer_loop: while (<COMMANDS>) {
       } elsif ( $conf::upload_method ne "copy" ) {
         msg( "mail,log", "cancel not available\n" );
       } elsif (
-          $word[1] !~ m,^[a-zA-Z0-9.+_:@=%-][~a-zA-Z0-9.+_:@=%-]*\.changes$, )
+          $word[1] !~ m,$re_file_safe_prefix.changes\z, )
       {
         msg( "mail,log",
           "argument to cancel must be one .changes filename without path\n" );
@@ -1650,6 +1710,13 @@ sub pgp_check($) {
   my $stat;
   local (*PIPE);
 
+  if ($file =~ /$re_file_safe/) {
+    $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 "