X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=tools%2Fdebianqueued-0.9%2Fdebianqueued;h=78de89083fe13feff143d4c95b5569bfe629a31a;hb=55915adf132ee756540de8e96c906d4dc1a30a2b;hp=1ca65d0e3d8e29bd4f868d79e90abb12d565e906;hpb=bcb20725c99e687a341d56383725d7b96853221a;p=dak.git

diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued
index 1ca65d0e..78de8908 100755
--- a/tools/debianqueued-0.9/debianqueued
+++ b/tools/debianqueued-0.9/debianqueued
@@ -268,7 +268,7 @@ $junk = $conf::upload_delay_2;
 $junk = $conf::ar;
 $junk = $conf::gzip;
 $junk = $conf::cp;
-$junk = $conf::ls;
+#$junk = $conf::ls;
 $junk = $conf::chmod;
 $junk = $conf::ftpdebug;
 $junk = $conf::ftptimeout;
@@ -419,9 +419,12 @@ die "upload and target queue paths must be absolute."
 # prototypes
 sub calc_delta();
 sub check_dir();
+sub get_filelist_from_known_good_changes($);
+sub age_delayed_queues();
 sub process_changes($\@);
 sub process_commands($);
-sub is_on_target($);
+sub age_delayed_queues();
+sub is_on_target($\@);
 sub copy_to_target(@);
 sub pgp_check($);
 sub check_alive(;$);
@@ -596,7 +599,7 @@ while( 1 ) {
 		my $adelayeddir = sprintf( "$conf::incoming_delayed",
 								   $delayed_dirs );
 		push( @have_changes,
-			  <$adelayeddir/*.changes $adelayeddir/*.commands> );
+			  <$adelayeddir/*.changes> );
 	}
 	check_alive() if @have_changes || (time - $main::last_ping_time) > 8*60*60;
 
@@ -607,6 +610,10 @@ while( 1 ) {
 	$main::dstat = "i";
 	write_status_file() if $conf::statusdelay;
 
+	if ($conf::upload_method eq "copy") {
+		age_delayed_queues();
+	}
+
 	# sleep() returns if we received a signal (SIGUSR1 for status FIFO), so
 	# calculate the end time once and wait for it being reached.
 	format_status_num( $main::next_run, time + $conf::queue_delay );
@@ -685,18 +692,19 @@ sub check_dir() {
 					 "Cannot change to dir ".
 					 "${main::current_incoming_short}: $!\n" ),
 				return);
-	
-		# look for *.commands files
-		foreach $file ( <*.commands> ) {
-			init_mail( $file );
-			block_signals();
-			process_commands( $file );
-			unblock_signals();
-			$main::dstat = "c";
-			write_status_file() if $conf::statusdelay;
-			finish_mail();
+
+		# look for *.commands files but not in delayed queues
+		if ( $adelay==-1 ) {
+			foreach $file ( <*.commands> ) {
+				init_mail( $file );
+				block_signals();
+				process_commands( $file );
+				unblock_signals();
+				$main::dstat = "c";
+				write_status_file() if $conf::statusdelay;
+				finish_mail();
+			}
 		}
-	
 		opendir( INC, "." )
 			or (msg( "log", "Cannot open dir ${main::current_incoming_short}: $!\n" ),
 				return);
@@ -814,6 +822,36 @@ sub check_dir() {
 	write_status_file() if $conf::statusdelay;
 }
 
+sub get_filelist_from_known_good_changes($) {
+	my $changes = shift;
+
+	local( *CHANGES );
+	my(@filenames);
+
+	# parse the .changes file
+	open( CHANGES, "<$changes" )
+		or die "$changes: $!\n";
+	outer_loop: while( <CHANGES> ) {
+		if (/^Files:/i) {
+			while( <CHANGES> ) {
+				redo outer_loop if !/^\s/;
+				my @field = split( /\s+/ );
+				next if @field != 6;
+				# 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.+_:@=%-]*)/;
+				if ($1 ne $field[5]) {
+					msg( "log", "found suspicious filename $field[5]\n" );
+					next;
+				}
+				push( @filenames, $field[5] );
+			}
+		}
+	}
+	close( CHANGES );
+	return @filenames;
+}
+
 #
 # process one .changes file
 #
@@ -1077,7 +1115,7 @@ sub process_changes($\@) {
 	# check if the job is already present on target
 	# (moved to here, to avoid bothering target as long as there are errors in
 	# the job)
-	if ($ls_l = is_on_target( $changes )) {
+	if ($ls_l = is_on_target( $changes, @filenames )) {
 		msg( "log,mail", "$main::current_incoming_short/$changes is already present on target host:\n" );
 		msg( "log,mail", "$ls_l\n" );
 		msg( "mail", "Either you already uploaded it, or someone else ",
@@ -1173,8 +1211,9 @@ sub process_changes($\@) {
 #
 sub process_commands($) {
 	my $commands = shift;
-	my( @cmds, $cmd, $pgplines, $signator, $adelay );
+	my( @cmds, $cmd, $pgplines, $signator );
 	local( *COMMANDS );
+	my( @files, $file, @removed, $target_delay );
 	
 	format_status_str( $main::current_changes, $commands );
 	$main::dstat = "c";
@@ -1255,46 +1294,56 @@ sub process_commands($) {
 		next if @word < 1;
 		
 		if ($word[0] eq "rm") {
-			my( @files, $file, @removed );
 			foreach ( @word[1..$#word] ) {
-                if (m,^DELAYED/([0-9]+)-day/,) {
-                    $adelay = $1;
-                    s,^DELAYED/[0-9]+-day/,,
-                }
-                else {
-                    $adelay = -1;
-                }
 				if (m,/,) {
 					msg( "mail,log", "$_: filename may not contain slashes\n" );
 				}
-				else {
+				elsif (/[*?[]/) {
 					# process wildcards but also plain names (for delayed target removal)
+					my (@thesefiles);
 					my $pat = quotemeta($_);
 					$pat =~ s/\\\*/.*/g;
 					$pat =~ s/\\\?/.?/g;
 					$pat =~ s/\\([][])/$1/g;
-                    if ($adelay == -1) {
-						opendir( DIR, "." );
-						push( @files, grep /^$pat$/, readdir(DIR) );
+					opendir( DIR, "." );
+					push (@thesefiles, grep /^$pat$/, readdir(DIR) );
+					closedir( DIR );
+					for ( my($adelay)=0; (! @thesefiles) && $adelay <= $conf::max_delayed; $adelay++ ) {
+						my($dir) = sprintf( $conf::incoming_delayed,
+								    $adelay );
+						opendir( DIR, "$dir" );
+						push( @thesefiles, map ("$dir/$_", grep /^$pat$/, readdir(DIR) ));
 						closedir( DIR );
-                    }
-					else {
-						if ($conf::upload_method eq "copy") {
-			            	my($dir) = sprintf( $conf::incoming_delayed,
-												$adelay );
-							opendir( DIR, "$dir" );
-							push( @files, map ("$dir/$_", grep /^$pat$/, readdir(DIR) ));
-							closedir( DIR );
-			            	$dir = sprintf( $conf::targetdir_delayed,
-											$adelay );
-							opendir( DIR, "$dir" );
-							push( @files, map ("$dir/$_", grep /^$pat$/, readdir(DIR) ));
-							closedir( DIR );
+					}
+					push (@files, @thesefiles);
+					if (! @thesefiles) {
+						msg( "mail,log", "$_ did not match anything\n" );
+					}
+				}
+				else {
+				    my (@thesefiles);
+				    $file = $_;
+				    if (-f $file) {
+						push (@thesefiles, $file);
+					}
+					for ( my($adelay)=0; $adelay <= $conf::max_delayed; $adelay++ ) {
+						if (-f $file) {
+							push (@thesefiles, $file);
 						}
-						else {
-							msg( "mail,log", "No DELAYED removal possible\n" );
+				    }
+					if ($file =~ m/\.changes$/ &&  $conf::upload_method eq "copy") {
+						for ( my($adelay)=0; $adelay <= $conf::max_delayed; $adelay++ ) {
+							my($dir) = sprintf( "$conf::targetdir_delayed",$adelay );
+							if (-f "$dir/$file") {
+								push (@thesefiles, "$dir/$file");
+								push (@thesefiles, map( "$dir/$_",get_filelist_from_known_good_changes("$dir/$file")));
+							}
 						}
 					}
+					if (!@thesefiles) {
+						msg( "mail,log", "No file found: $file\n" );
+					}
+					push (@files, @thesefiles);
 				}
 			}
 			if (!@files) {
@@ -1324,27 +1373,39 @@ sub process_commands($) {
 			if (@word != 3) {
 				msg( "mail,log", "Wrong number of arguments\n" );
 			}
-			elsif ($word[1] =~ m,/,) {
+			elsif ($word[1] =~ m,/, || $word[1] !~ m/\.changes/) {
 				msg( "mail,log", "$word[1]: filename may not contain slashes\n" );
 			}
-			elsif ($word[2] =~ m,/,) {
-				msg( "mail,log", "$word[2]: filename may not contain slashes\n" );
-			}
-			elsif (!-f $word[1]) {
-				msg( "mail,log", "$word[1]: no such file\n" );
-			}
-			elsif (-e $word[2]) {
-				msg( "mail,log", "$word[2]: file exists\n" );
+			elsif (! (($target_delay) = $word[2] =~ m,^([0-9]+)-day$,) || $target_delay > $conf::max_delayed) {
+				msg( "mail,log", "$word[2]: target must be #-day with # between 0 and $conf::max_delayed\n");
 			}
 			elsif ($word[1] =~ /$conf::keep_files/) {
 				msg( "mail,log", "$word[1] is protected, cannot rename\n" );
 			}
 			else {
-				if (!rename( $word[1], $word[2] )) {
-					msg( "mail,log", "rename: $!\n" );
+				my($adelay);
+				for ( $adelay=0; $adelay <= $conf::max_delayed && ! -f (sprintf( "$conf::targetdir_delayed",$adelay )."/$word[1]"); $adelay++ ) {
+				}
+				if ( $adelay > $conf::max_delayed) {
+					msg( "mail,log", "$word[1] not found\n" );
+				}
+				elsif ($adelay == $target_delay) {
+					msg( "mail,log", "$word[1] already is in $word[2]\n" );
 				}
 				else {
-					msg( "mail,log", "OK\n" );
+					my(@thesefiles);
+					my($dir) = sprintf( "$conf::targetdir_delayed",$adelay );
+					my($target_dir) = sprintf( "$conf::targetdir_delayed",$target_delay );
+					push (@thesefiles, $word[1]);
+					push (@thesefiles, get_filelist_from_known_good_changes("$dir/$word[1]"));
+					for my $afile(@thesefiles) {
+						if (! rename "$dir/$afile","$target_dir/$afile") {
+							msg( "mail,log", "rename: $!\n" );
+						}
+						else {
+							msg( "mail,log", "$afile moved to $target_delay-day\n" );
+						}
+					}
 				}
 			}
 		}
@@ -1356,14 +1417,44 @@ sub process_commands($) {
 	msg( "log", "-- End of $main::current_incoming_short/$commands processing\n" );
 }
 
+sub age_delayed_queues() {
+	for ( my($adelay)=0 ; $adelay <= $conf::max_delayed ; $adelay++ ) {
+		my($dir) = sprintf( "$conf::targetdir_delayed",$adelay );
+		my($target_dir);
+		if ($adelay == 0) {
+		    $target_dir = $conf::targetdir;
+		}
+		else {
+			$target_dir = sprintf( "$conf::targetdir_delayed",$adelay-1 );
+		}
+		for my $achanges (<$dir/*.changes>) {
+			my $mtime = (stat($achanges))[9];
+			if ($mtime + 24*60*60 <= time) {
+				utime undef,undef,($achanges);
+				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" );
+					}
+					else {
+						msg( "log", "$afile moved to $target_dir\n" );
+					}
+				}
+			}
+		}
+	}
+}
+
 #
 # check if a file is already on target
 #
-sub is_on_target($) {
+sub is_on_target($\@) {
 	my $file = shift;
+	my $filelist = shift;
 	my $msg;
 	my $stat;
-	
+
 	if ($conf::upload_method eq "ssh") {
 		($msg, $stat) = ssh_cmd( "ls -l $file" );
 	}
@@ -1384,7 +1475,24 @@ sub is_on_target($) {
 		}
 	}
 	else {
-		($msg, $stat) = local_cmd( "$conf::ls -l $file" );
+		my @allfiles = ($file);
+		push ( @allfiles, @$filelist);
+		$stat = 1;
+		$msg = "no such file";
+		for my $afile(@allfiles) {
+			if (-f "$conf::incoming/$afile") {
+				$stat = 0;
+        	    $msg = "$afile";
+			}
+		}
+		for ( my($adelay)=0 ; $adelay <= $conf::max_delayed && $stat ; $adelay++ ) {
+			for my $afile(@allfiles) {
+				if (-f (sprintf( "$conf::targetdir_delayed",$adelay )."/$afile")) {
+					$stat = 0;
+					$msg = sprintf( "%d-day",$adelay )."/$afile";
+				}
+			}
+		}
 	}
 	chomp( $msg );
 	debug( "exit status: $stat, output was: $msg" );