debianqueued: use Perl, not shell

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

diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued
index 4d2daa093ee72dbb37662c56637a6df06b5a3ba3..05eaaa7585c9959a141f188e164f0917a2ede0cc 100755 (executable)
--- a/tools/debianqueued-0.9/debianqueued
+++ b/tools/debianqueued-0.9/debianqueued
@@ -234,7 +234,6 @@ sub ftp_code();
 sub ftp_error();
 sub ssh_cmd($);
 sub scp_cmd(@);
-sub local_cmd($;$);
 sub check_alive(;$);
 sub check_incoming_writable();
 sub rm(@);
@@ -490,6 +489,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);
@@ -499,6 +499,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);
@@ -522,6 +523,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
@@ -562,6 +564,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",
@@ -1482,9 +1485,14 @@ sub copy_to_target(@) {
       goto err if !$rv;
     }
   } else {
-    ( $msgs, $stat ) =
-      local_cmd( "$conf::cp @files $main::current_targetdir", 'NOCD' );
-    goto err if $stat;
+    for my $file (@files) {
+      eval { File::Copy::copy($file, $main::current_targetdir) };
+      if ($@) {
+        $stat = 1;
+        $msgs = $@;
+        goto err;
+      }
+    }
   }
 
   # check md5sums or sizes on target against our own
@@ -1523,9 +1531,14 @@ sub copy_to_target(@) {
         } ## end foreach $file (@files)
       } ## end if ( !$have_md5sums )
     } else {
-      ( $msgs, $stat ) = local_cmd("$conf::md5sum @files");
-      goto err if $stat;
-      @md5sum = split( "\n", $msgs );
+      for my $file (@files) {
+        my $md5 = eval { md5sum("$main::current_targetdir/$file") };
+        if ($@) {
+          $msgs = $@;
+          goto err;
+        }
+        push @md5sum, "$md5 $file" if $md5;
+      }
     }
 
     @expected_files = @files;
@@ -1571,8 +1584,12 @@ sub copy_to_target(@) {
         goto err if !$rv;
       } ## end foreach $file (@files)
     } else {
-      ( $msgs, $stat ) = local_cmd("$conf::chmod 644 @files");
-      goto err if $stat;
+      for my $file (@files) {
+        unless (chmod 0644, "$main::current_targetdir/$file") {
+          $msgs = "Could not chmod $file: $!";
+          goto err;
+        }
+      }
     }
   } ## end if ($conf::chmod_on_target)
 
@@ -1589,7 +1606,7 @@ err:
 
   # If "permission denied" was among the errors, test if the incoming is
   # writable at all.
-  if ( $msgs =~ /(permission denied|read-?only file)/i ) {
+  if ( $msgs && $msgs =~ /(permission denied|read-?only file)/i ) {
     if ( !check_incoming_writable() ) {
       msg( "log,mail", "(The incoming directory seems to be ",
            "unwritable.)\n" );
@@ -2013,19 +2030,6 @@ sub scp_cmd(@) {
   return ( $msg, $stat );
 } ## end sub scp_cmd(@)
 
-sub local_cmd($;$) {
-  my $cmd  = shift;
-  my $nocd = shift;
-  my ( $msg, $stat );
-
-  my $ecmd = ( $nocd ? "" : "cd $main::current_targetdir; " ) . $cmd;
-  debug("executing $ecmd");
-  $msg  = `($ecmd) 2>&1`;
-  $stat = $?;
-  return ( $msg, $stat );
-
-} ## end sub local_cmd($;$)
-
 #
 # check if target is alive (code stolen from Net::Ping.pm)
 #
@@ -2090,8 +2094,18 @@ sub check_incoming_writable() {
     unlink $file;
     ftp_cmd( "delete", $file );
   } elsif ( $conf::upload_method eq "copy" ) {
-    ( $msg, $stat ) =
-      local_cmd( "rm -f $testfile; touch $testfile; " . "rm -f $testfile" );
+    unlink("$main::current_targetdir/$testfile");
+    unless (open my $fh, ">>", "$main::current_targetdir/$testfile") {
+      $stat = 1;
+      $msg = "Could not create $testfile: $!";
+    }
+    else {
+      close $fh;
+      unless (unlink("$main::current_targetdir/$testfile")) {
+        $stat = 1;
+        $msg = "Could not unlink file $testfile: $!";
+      }
+    }
   }
   chomp($msg);
   debug("exit status: $stat, output was: $msg");
@@ -2130,9 +2144,10 @@ 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;