]> git.decadent.org.uk Git - dak.git/blobdiff - tools/debianqueued-0.9/debianqueued
debianqueued: construct Digest::MD5 object before trying to use it
[dak.git] / tools / debianqueued-0.9 / debianqueued
index b783ef3a902c5e8c68ec452f31cbf1c13024d436..0ead31ccc7049683dba0c95719b4b1722438f5a3 100755 (executable)
@@ -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(;$);
@@ -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",
@@ -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
 #