debianqueued: use POSIX::access to check for write access

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

diff --git a/tools/debianqueued-0.9/debianqueued b/tools/debianqueued-0.9/debianqueued
index 0ead31ccc7049683dba0c95719b4b1722438f5a3..c19c1c3311e546305caf8f5c4e09f0befc022164 100755 (executable)
--- a/tools/debianqueued-0.9/debianqueued
+++ b/tools/debianqueued-0.9/debianqueued
@@ -45,16 +45,11 @@ $junk = $conf::valid_files;
 $junk = $conf::max_upload_retries;
 $junk = $conf::upload_delay_1;
 $junk = $conf::upload_delay_2;
-$junk = $conf::ar;
-$junk = $conf::gzip;
-$junk = $conf::cp;
 $junk = $conf::check_md5sum;
 
 #$junk = $conf::ls;
-$junk         = $conf::chmod;
 $junk         = $conf::ftpdebug;
 $junk         = $conf::ftptimeout;
-$junk         = $conf::no_changes_timeout;
 $junk         = @conf::nonus_packages;
 $junk         = @conf::test_binaries;
 $junk         = @conf::maintainer_mail;
@@ -182,7 +177,7 @@ do {
 # check if all programs exist
 my $prg;
 foreach $prg ( $conf::gpg, $conf::ssh, $conf::scp, $conf::ssh_agent,
-               $conf::ssh_add, $conf::md5sum, $conf::mail, $conf::mkfifo )
+               $conf::ssh_add, $conf::mail, $conf::mkfifo )
 {
   die "Required program $prg doesn't exist or isn't executable\n"
     if !-x $prg;
@@ -234,7 +229,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(@);
@@ -1486,9 +1480,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
@@ -1527,9 +1526,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;
@@ -1575,8 +1579,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)
 
@@ -1593,7 +1601,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" );
@@ -1641,25 +1649,31 @@ sub pgp_check($) {
 
   $stat = 1;
   if ( -x $conf::gpg ) {
-    debug(   "executing $conf::gpg --no-options --batch "
-           . "--no-default-keyring --always-trust "
-           . "--keyring "
-           . join( " --keyring ", @conf::keyrings )
-           . " --verify '$file'" );
-    if (
-         !open( PIPE,
-                    "$conf::gpg --no-options --batch "
-                  . "--no-default-keyring --always-trust "
-                  . "--keyring "
-                  . join( " --keyring ", @conf::keyrings )
-                  . " --verify '$file'"
-                  . " 2>&1 |"
-              )
-       )
-    {
-      msg( "log", "Can't open pipe to $conf::gpg: $!\n" );
+    my @command = ("$conf::gpg", "--no-options", "--batch", "--no-tty",
+                   "--trust-model", "always", "--no-default-keyring",
+                  (map +("--keyring" => $_), @conf::keyrings),
+                  "--verify", "-");
+    debug(   "executing " . join(" ", @command) );
+
+    my $child = open(PIPE, "-|");
+    if (!defined($child)) {
+      msg("log", "Can't open pipe to $conf::gpg: $!\n");
       return "LOCAL ERROR";
-    } ## end if ( !open( PIPE, "$conf::gpg --no-options --batch "...
+    }
+    if ($child == 0) {
+      unless (open(STDERR, ">&", \*STDOUT)) {
+        print "Could not redirect STDERR.";
+       exit(-1);
+      }
+      unless (open(STDIN, "<", $file)) {
+        print "Could not open $file: $!";
+       exit(-1);
+      }
+      { exec(@command) }; # BLOCK avoids warning about likely unreachable code
+      print "Could not exec gpg: $!";
+      exit(-1);
+    }
+
     $output .= $_ while (<PIPE>);
     close(PIPE);
     $stat = $?;
@@ -2017,19 +2031,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)
 #
@@ -2094,8 +2095,10 @@ 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" );
+    unless(POSIX::access($main::current_targetdir, &POSIX::W_OK)) {
+      $msg = "No write access: $!";
+      $stat = 1;
+    }
   }
   chomp($msg);
   debug("exit status: $stat, output was: $msg");