X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=tools%2Fdebianqueued-0.9%2Fdebianqueued;h=0ead31ccc7049683dba0c95719b4b1722438f5a3;hb=b20b1d58b688bebb896144c6a4c10ed7fb37fe2b;hp=4fe899a03432b578e081802460a96c732e2b26d1;hpb=d3b91e7ec18eda0646d19c81228997b2adfa31f2;p=dak.git

diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued
index 4fe899a0..0ead31cc 100755
--- a/tools/debianqueued-0.9/debianqueued
+++ b/tools/debianqueued-0.9/debianqueued
@@ -82,7 +82,7 @@ if ( @ARGV == 1 && $ARGV[0] =~ /^-[rk]$/ ) {
 
 # test for another instance of the queued already running
 my ( $pid, $delayed_dirs, $adelayedcore );
-if ( open( PIDFILE, "<$conf::pidfile" ) ) {
+if ( open( PIDFILE, "<", $conf::pidfile ) ) {
   chomp( $pid = <PIDFILE> );
   close(PIDFILE);
   if ( !$pid ) {
@@ -239,8 +239,6 @@ sub check_alive(;$);
 sub check_incoming_writable();
 sub rm(@);
 sub md5sum($);
-sub is_debian_file($);
-sub debian_file_stem($);
 sub msg($@);
 sub debug(@);
 sub init_mail(;$);
@@ -318,7 +316,7 @@ chdir($conf::incoming)
 $SIG{"HUP"} = "IGNORE";
 
 # open logfile, make it unbuffered
-open( LOG, ">>$conf::logfile" )
+open( LOG, ">>", $conf::logfile )
   or die "Cannot open my logfile $conf::logfile: $!\n";
 chmod( 0644, $conf::logfile )
   or die "Cannot set modes of $conf::logfile: $!\n";
@@ -328,11 +326,11 @@ sleep(1);
 $SIG{"HUP"} = \&close_log;
 
 # redirect stdin, ... to /dev/null
-open( STDIN, "</dev/null" )
+open( STDIN, "<", "/dev/null" )
   or die "$main::progname: Can't redirect stdin to /dev/null: $!\n";
-open( STDOUT, ">&LOG" )
+open( STDOUT, ">&", \*LOG )
   or die "$main::progname: Can't redirect stdout to $conf::logfile: $!\n";
-open( STDERR, ">&LOG" )
+open( STDERR, ">&", \*LOG )
   or die "$main::progname: Can't redirect stderr to $conf::logfile: $!\n";
 
 # ok, from this point usually no "die" anymore, stderr is gone!
@@ -360,7 +358,7 @@ END {
 }
 
 # write the pid file
-open( PIDFILE, ">$conf::pidfile" )
+open( PIDFILE, ">", $conf::pidfile )
   or msg( "log", "Can't open $conf::pidfile: $!\n" );
 printf PIDFILE "%5d\n", $$;
 close(PIDFILE);
@@ -492,6 +490,7 @@ sub check_dir() {
     # look for *.commands and *.dak-commands files but not in delayed queues
     if ( $adelay == -1 ) {
       foreach $file (<*.commands>) {
+        next unless $file =~ /$re_file_safe/;
         init_mail($file);
         block_signals();
         process_commands($file);
@@ -501,6 +500,7 @@ sub check_dir() {
         finish_mail();
       } ## end foreach $file (<*.commands>)
 	  foreach $file (<*.dak-commands>) {
+		next unless $file =~ /$re_file_safe/;
 		init_mail($file);
 		block_signals();
 		process_dak_commands($file);
@@ -524,6 +524,7 @@ sub check_dir() {
     @changes = grep /\.changes$/, @files;
     push( @keep_files, @changes );    # .changes files aren't stray
     foreach $file (@changes) {
+      next unless $file =~ /$re_file_safe/;
       init_mail($file);
 
       # wrap in an eval to allow jumpbacks to here with die in case
@@ -564,6 +565,7 @@ sub check_dir() {
       my ( $maint, $pattern, @job_files );
       if (    $file =~ /^junk-for-writable-test/
            || $file !~ m,$conf::valid_files,
+           || $file !~ /$re_file_safe/
            || $age >= $conf::stray_remove_timeout )
       {
         msg( "log",
@@ -591,7 +593,7 @@ sub get_filelist_from_known_good_changes($) {
   my (@filenames);
 
   # parse the .changes file
-  open( CHANGES, "<$changes" )
+  open( CHANGES, "<", $changes )
     or die "$changes: $!\n";
 outer_loop: while (<CHANGES>) {
     if (/^Files:/i) {
@@ -639,7 +641,7 @@ sub process_changes($\@) {
   msg( "log", "processing ${main::current_incoming_short}/$changes\n" );
 
   # parse the .changes file
-  open( CHANGES, "<$changes" )
+  open( CHANGES, "<", $changes )
     or die "Cannot open ${main::current_incoming_short}/$changes: $!\n";
   $pgplines        = 0;
   $extralines      = 0;
@@ -790,7 +792,7 @@ outer_loop: while (<CHANGES>) {
   $failure_file = $changes . ".failures";
   $retries = $last_retry = 0;
   if ( -f $failure_file ) {
-    open( FAILS, "<$failure_file" )
+    open( FAILS, "<", $failure_file )
       or die "Cannot open $main::current_incoming_short/$failure_file: $!\n";
     my $line = <FAILS>;
     close(FAILS);
@@ -987,7 +989,7 @@ outer_loop: while (<CHANGES>) {
       rm( $changes, @filenames, $failure_file );
     } else {
       $last_retry = time;
-      if ( open( FAILS, ">$failure_file" ) ) {
+      if ( open( FAILS, ">", $failure_file ) ) {
         print FAILS "$retries $last_retry\n";
         close(FAILS);
         chmod( 0600, $failure_file )
@@ -1113,7 +1115,7 @@ sub process_commands($) {
   msg( "log", "processing $main::current_incoming_short/$commands\n" );
 
   # parse the .commands file
-  if ( !open( COMMANDS, "<$commands" ) ) {
+  if ( !open( COMMANDS, "<", $commands ) ) {
     msg( "log", "Cannot open $main::current_incoming_short/$commands: $!\n" );
     return;
   }
@@ -1730,7 +1732,7 @@ sub fork_statusd() {
 
     # open the FIFO for writing; this blocks until someone (probably ftpd)
     # opens it for reading
-    open( STATFIFO, ">$conf::statusfile" )
+    open( STATFIFO, ">", $conf::statusfile )
       or die "Cannot open $conf::statusfile\n";
     select(STATFIFO);
 
@@ -1776,7 +1778,7 @@ sub write_status_file() {
 
   return if !$conf::statusfile;
 
-  open( STATFILE, ">$conf::statusfile" )
+  open( STATFILE, ">", $conf::statusfile )
     or ( msg( "log", "Could not open $conf::statusfile: $!\n" ), return );
   my $oldsel = select(STATFILE);
 
@@ -2083,7 +2085,7 @@ sub check_incoming_writable() {
     my $file = "junk-for-writable-test-" . format_time();
     $file =~ s/[ :.]/-/g;
     local (*F);
-    open( F, ">$file" );
+    open( F, ">", $file );
     close(F);
     my $rv;
     ( $rv, $msg ) = ftp_cmd( "put", $file );
@@ -2132,44 +2134,15 @@ sub rm(@) {
 #
 sub md5sum($) {
   my $file = shift;
+  my $md5 = Digest::MD5->new;
 
   open my $fh, "<", $file or return "";
-  my $md5 = $md5->addfile($fh);
+  $md5->addfile($fh);
   close $fh;
 
   return $md5->hexdigest;
 } ## end sub md5sum($)
 
-#
-# check if a file probably belongs to a Debian upload
-#
-sub is_debian_file($) {
-  my $file = shift;
-  return $file =~ /\.(deb|dsc|(diff|tar)\.gz)$/
-    && $file !~ /\.orig\.tar\.gz/;
-}
-
-#
-# return a pattern that matches all files that probably belong to one job
-#
-sub debian_file_stem($) {
-  my $file = shift;
-  my ( $pkg, $version );
-
-  # strip file suffix
-  $file =~ s,\.(deb|dsc|changes|(orig\.)?tar\.gz|diff\.gz)$,,;
-
-  # if not is *_* (name_version), can't derive a stem and return just
-  # the file's name
-  return $file if !( $file =~ /^([^_]+)_([^_]+)/ );
-  ( $pkg, $version ) = ( $1, $2 );
-
-  # strip Debian revision from version
-  $version =~ s/^(.*)-[\d.+-]+$/$1/;
-
-  return "${pkg}_${version}*";
-} ## end sub debian_file_stem($)
-
 #
 # output a messages to several destinations
 #
@@ -2370,16 +2343,16 @@ sub close_log($) {
   close(STDOUT);
   close(STDERR);
 
-  open( LOG, ">>$conf::logfile" )
+  open( LOG, ">>", $conf::logfile )
     or die "Cannot open my logfile $conf::logfile: $!\n";
   chmod( 0644, $conf::logfile )
     or msg( "log", "Cannot set modes of $conf::logfile: $!\n" );
   select( ( select(LOG), $| = 1 )[0] );
 
-  open( STDOUT, ">&LOG" )
+  open( STDOUT, ">&", \*LOG )
     or msg( "log",
       "$main::progname: Can't redirect stdout to " . "$conf::logfile: $!\n" );
-  open( STDERR, ">&LOG" )
+  open( STDERR, ">&", \*LOG )
     or msg( "log",
       "$main::progname: Can't redirect stderr to " . "$conf::logfile: $!\n" );
   msg( "log", "Restart after SIGHUP\n" );