]> err.no Git - dak/commitdiff
Use perltidy on debianqueued
authorJoerg Jaspert <joerg@debian.org>
Sun, 21 Sep 2008 14:28:27 +0000 (16:28 +0200)
committerJoerg Jaspert <joerg@debian.org>
Sun, 21 Sep 2008 14:28:27 +0000 (16:28 +0200)
Use perltidy -i=2 -syn -lp -csc -cscw -ce -l=78 -cti=1  -b debianqueued

Signed-off-by: Joerg Jaspert <joerg@debian.org>
tools/debianqueued-0.9/ChangeLog
tools/debianqueued-0.9/debianqueued

index c27e2423013b733e466e3f8b187af23d752dd44e..ff440e693467af7a5bdcfff4d797ea7b3209e51b 100644 (file)
@@ -1,5 +1,7 @@
 2008-09-21  Joerg Jaspert  <joerg@debian.org>
 
+       * debianqueued: Use perltidy
+
        * Queue.README: Its ftp.upload.debian.org now, not
        ftp-master.debian.org.
 
index eebb91513b9aca8ac3339fa41c7d89e27185380c..72bd603788d89d8419886c207553eb37d12d953b 100755 (executable)
@@ -27,10 +27,10 @@ use Config;
 # ---------------------------------------------------------------------------
 
 package conf;
-($conf::queued_dir = (($0 !~ m,^/,) ? POSIX::getcwd()."/" : "") . $0)
-       =~ s,/[^/]+$,,;
+( $conf::queued_dir = ( ( $0 !~ m,^/, ) ? POSIX::getcwd() . "/" : "" ) . $0 )
+  =~ s,/[^/]+$,,;
 require "$conf::queued_dir/config";
-my $junk = $conf::debug; # avoid spurious warnings about unused vars
+my $junk = $conf::debug;    # avoid spurious warnings about unused vars
 $junk = $conf::ssh_key_file;
 $junk = $conf::stray_remove_timeout;
 $junk = $conf::problem_report_timeout;
@@ -43,149 +43,156 @@ $junk = $conf::upload_delay_2;
 $junk = $conf::ar;
 $junk = $conf::gzip;
 $junk = $conf::cp;
+
 #$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;
-$junk = @conf::targetdir_delayed;
-$junk = $conf::mail ||= '/usr/sbin/sendmail';
+$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;
+$junk         = @conf::targetdir_delayed;
+$junk         = $conf::mail ||= '/usr/sbin/sendmail';
 $conf::target = "localhost" if $conf::upload_method eq "copy";
+
 package main;
 
-($main::progname = $0) =~ s,.*/,,;
+( $main::progname = $0 ) =~ s,.*/,,;
 
 my %packages = ();
 
 # extract -r and -k args
 $main::arg = "";
-if (@ARGV == 1 && $ARGV[0] =~ /^-[rk]$/) {
-       $main::arg = ($ARGV[0] eq '-k') ? "kill" : "restart";
-       shift @ARGV;
+if ( @ARGV == 1 && $ARGV[0] =~ /^-[rk]$/ ) {
+  $main::arg = ( $ARGV[0] eq '-k' ) ? "kill" : "restart";
+  shift @ARGV;
 }
 
 # test for another instance of the queued already running
-my ($pid, $delayed_dirs, $adelayedcore);
-if (open( PIDFILE, "<$conf::pidfile" )) {
-       chomp( $pid = <PIDFILE> );
-       close( PIDFILE );
-       if (!$pid) {
-               # remove stale pid file
-               unlink( $conf::pidfile );
-       }
-       elsif ($main::arg) {
-               local($|) = 1;
-               print "Killing running daemon (pid $pid) ...";
-               kill( 15, $pid );
-               my $cnt = 20;
-               while( kill( 0, $pid ) && $cnt-- > 0 ) {
-                       sleep 1;
-                       print ".";
-               }
-               if (kill( 0, $pid )) {
-                       print " failed!\nProcess $pid still running.\n";
-                       exit 1;
-               }
-               print "ok\n";
-               if (-e "$conf::incoming/core") {
-                       unlink( "$conf::incoming/core" );
-                       print "(Removed core file)\n";
-               }
-               for ($delayed_dirs = 0; $delayed_dirs <= $conf::max_delayed; 
-                        $delayed_dirs++) {
-                       $adelayedcore = sprintf( "$conf::incoming_delayed/core",
-                                                                        $delayed_dirs );
-                       if (-e $adelayedcore) {
-                               unlink( $adelayedcore );
-                               print "(Removed core file)\n";
-                       }
-               }
-               exit 0 if $main::arg eq "kill";
-       }
-       else {
-               die "Another $main::progname is already running (pid $pid)\n"
-                       if $pid && kill( 0, $pid );
-       }
-}
-elsif ($main::arg eq "kill") {
-       die "No daemon running\n";
-}
-elsif ($main::arg eq "restart") {
-       print "(No daemon running; starting anyway)\n";
+my ( $pid, $delayed_dirs, $adelayedcore );
+if ( open( PIDFILE, "<$conf::pidfile" ) ) {
+  chomp( $pid = <PIDFILE> );
+  close(PIDFILE);
+  if ( !$pid ) {
+
+    # remove stale pid file
+    unlink($conf::pidfile);
+  } elsif ($main::arg) {
+    local ($|) = 1;
+    print "Killing running daemon (pid $pid) ...";
+    kill( 15, $pid );
+    my $cnt = 20;
+    while ( kill( 0, $pid ) && $cnt-- > 0 ) {
+      sleep 1;
+      print ".";
+    }
+    if ( kill( 0, $pid ) ) {
+      print " failed!\nProcess $pid still running.\n";
+      exit 1;
+    }
+    print "ok\n";
+    if ( -e "$conf::incoming/core" ) {
+      unlink("$conf::incoming/core");
+      print "(Removed core file)\n";
+    }
+    for ( $delayed_dirs = 0 ;
+          $delayed_dirs <= $conf::max_delayed ;
+          $delayed_dirs++ )
+    {
+      $adelayedcore =
+        sprintf( "$conf::incoming_delayed/core", $delayed_dirs );
+      if ( -e $adelayedcore ) {
+        unlink($adelayedcore);
+        print "(Removed core file)\n";
+      }
+    } ## end for ( $delayed_dirs = 0...
+    exit 0 if $main::arg eq "kill";
+  } else {
+    die "Another $main::progname is already running (pid $pid)\n"
+      if $pid && kill( 0, $pid );
+  }
+} elsif ( $main::arg eq "kill" ) {
+  die "No daemon running\n";
+} elsif ( $main::arg eq "restart" ) {
+  print "(No daemon running; starting anyway)\n";
 }
 
 # if started without arguments (initial invocation), then fork
-if (!@ARGV) {
-       # now go to background
-       die "$main::progname: fork failed: $!\n" unless defined( $pid = fork );
-       if ($pid) {
-               # parent: wait for signal from child (SIGCHLD or SIGUSR1) and exit
-               my $sigset = POSIX::SigSet->new();
-               $sigset->emptyset();
-               $SIG{"CHLD"} = sub { };
-               $SIG{"USR1"} = sub { };
-               POSIX::sigsuspend( $sigset );
-               waitpid( $pid, WNOHANG );
-               if (kill( 0, $pid )) {
-                       print "Daemon started in background (pid $pid)\n";
-                       exit 0;
-               }
-               else {
-                       exit 1;
-               }
-       }
-       else {
-               # child
-               setsid;
-               if ($conf::upload_method eq "ssh") { 
-                       # exec an ssh-agent that starts us again
-                       # force shell to be /bin/sh, ssh-agent may base its decision
-                       # whether to use a fd or a Unix socket on the shell...
-                       $ENV{"SHELL"} = "/bin/sh";
-                       exec $conf::ssh_agent, $0, "startup", getppid();
-                       die "$main::progname: Could not exec $conf::ssh_agent: $!\n";
-               }
-               else {
-                       # no need to exec, just set up @ARGV as expected below
-                       @ARGV = ("startup", getppid());
-               }
-       }
-}
+if ( !@ARGV ) {
+
+  # now go to background
+  die "$main::progname: fork failed: $!\n"
+    unless defined( $pid = fork );
+  if ($pid) {
+
+    # parent: wait for signal from child (SIGCHLD or SIGUSR1) and exit
+    my $sigset = POSIX::SigSet->new();
+    $sigset->emptyset();
+    $SIG{"CHLD"} = sub { };
+    $SIG{"USR1"} = sub { };
+    POSIX::sigsuspend($sigset);
+    waitpid( $pid, WNOHANG );
+    if ( kill( 0, $pid ) ) {
+      print "Daemon started in background (pid $pid)\n";
+      exit 0;
+    } else {
+      exit 1;
+    }
+  } else {
+
+    # child
+    setsid;
+    if ( $conf::upload_method eq "ssh" ) {
+
+      # exec an ssh-agent that starts us again
+      # force shell to be /bin/sh, ssh-agent may base its decision
+      # whether to use a fd or a Unix socket on the shell...
+      $ENV{"SHELL"} = "/bin/sh";
+      exec $conf::ssh_agent, $0, "startup", getppid();
+      die "$main::progname: Could not exec $conf::ssh_agent: $!\n";
+    } else {
+
+      # no need to exec, just set up @ARGV as expected below
+      @ARGV = ( "startup", getppid() );
+    }
+  } ## end else [ if ($pid)
+} ## end if ( !@ARGV )
 die "Please start without any arguments.\n"
-       if @ARGV != 2 || $ARGV[0] ne "startup";
+  if @ARGV != 2 || $ARGV[0] ne "startup";
 my $parent_pid = $ARGV[1];
 
 do {
-       my $version;
-       ($version = 'Release: 0.9 $Revision: 1.51 $ $Date: 1999/07/08 09:43:21 $ $Author: ftplinux $') =~ s/\$ ?//g;
-       print "debianqueued $version\n";
+  my $version;
+  ( $version =
+'Release: 0.9 $Revision: 1.51 $ $Date: 1999/07/08 09:43:21 $ $Author: ftplinux $'
+  ) =~ s/\$ ?//g;
+  print "debianqueued $version\n";
 };
 
 # 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 ) {
-       die "Required program $prg doesn't exist or isn't executable\n"
-               if ! -x $prg;
-# check for correct upload method
-die "Bad upload method '$conf::upload_method'.\n"
-       if $conf::upload_method ne "ssh" &&
-          $conf::upload_method ne "ftp" &&
-          $conf::upload_method ne "copy";
-die "No keyrings\n" if ! @conf::keyrings;
-
-}
+               $conf::ssh_add, $conf::md5sum, $conf::mail, $conf::mkfifo )
+{
+  die "Required program $prg doesn't exist or isn't executable\n"
+    if !-x $prg;
+
+  # check for correct upload method
+  die "Bad upload method '$conf::upload_method'.\n"
+    if $conf::upload_method ne "ssh"
+      && $conf::upload_method ne "ftp"
+      && $conf::upload_method ne "copy";
+  die "No keyrings\n" if !@conf::keyrings;
+
+} ## end foreach $prg ( $conf::gpg, ...
 die "statusfile path must be absolute."
-       if $conf::statusfile !~ m,^/,;
+  if $conf::statusfile !~ m,^/,;
 die "upload and target queue paths must be absolute."
-       if $conf::incoming !~ m,^/, ||
-          $conf::incoming_delayed !~ m,^/, ||
-          $conf::targetdir !~ m,^/, ||
-          $conf::targetdir_delayed !~ m,^/,;
-
+  if $conf::incoming !~ m,^/,
+    || $conf::incoming_delayed !~ m,^/,
+    || $conf::targetdir !~ m,^/,
+    || $conf::targetdir_delayed !~ m,^/,;
 
 # ---------------------------------------------------------------------------
 #                                                         initializations
@@ -242,7 +249,7 @@ sub restart_statusd();
 sub fatal_signal($);
 
 $ENV{"PATH"} = "/bin:/usr/bin";
-$ENV{"IFS"} = "" if defined($ENV{"IFS"} && $ENV{"IFS"} ne "");
+$ENV{"IFS"} = "" if defined( $ENV{"IFS"} && $ENV{"IFS"} ne "" );
 
 # constants for stat
 sub ST_DEV()   { 0 }
@@ -256,45 +263,47 @@ sub ST_SIZE()  { 7 }
 sub ST_ATIME() { 8 }
 sub ST_MTIME() { 9 }
 sub ST_CTIME() { 10 }
+
 # fixed lengths of data items passed over status pipe
 sub STATNUM_LEN() { 30 }
 sub STATSTR_LEN() { 128 }
 
 # init list of signals
-defined $Config{sig_name} or die "$main::progname: No signal list defined!\n";
+defined $Config{sig_name}
+  or die "$main::progname: No signal list defined!\n";
 my $i = 0;
 my $name;
-foreach $name (split( ' ', $Config{sig_name} )) {
-       $main::signo{$name} = $i++;
+foreach $name ( split( ' ', $Config{sig_name} ) ) {
+  $main::signo{$name} = $i++;
 }
 
 @main::fatal_signals = qw( INT QUIT ILL TRAP ABRT BUS FPE USR2 SEGV PIPE
-                                                  TERM XCPU XFSZ PWR );
+  TERM XCPU XFSZ PWR );
 
 $main::block_sigset = POSIX::SigSet->new;
 $main::block_sigset->addset( $main::signo{"INT"} );
 $main::block_sigset->addset( $main::signo{"TERM"} );
 
 # some constant net stuff
-$main::tcp_proto = (getprotobyname('tcp'))[2]
-       or die "Cannot get protocol number for 'tcp'\n";
-my $used_service = ($conf::upload_method eq "ssh") ? "ssh" : "ftp";
-$main::echo_port = (getservbyname($used_service, 'tcp'))[2]
-       or die "Cannot get port number for service '$used_service'\n";
+$main::tcp_proto = ( getprotobyname('tcp') )[2]
+  or die "Cannot get protocol number for 'tcp'\n";
+my $used_service = ( $conf::upload_method eq "ssh" ) ? "ssh" : "ftp";
+$main::echo_port = ( getservbyname( $used_service, 'tcp' ) )[2]
+  or die "Cannot get port number for service '$used_service'\n";
 
 # clear queue of stored mails
 @main::stored_mails = ();
 
 # run ssh-add to bring the key into the agent (will use stdin/stdout)
-if ($conf::upload_method eq "ssh") {
-       system "$conf::ssh_add $conf::ssh_key_file"
-               and die "$main::progname: Running $conf::ssh_add failed ".
-                               "(exit status ", $? >> 8, ")\n";
+if ( $conf::upload_method eq "ssh" ) {
+  system "$conf::ssh_add $conf::ssh_key_file"
+    and die "$main::progname: Running $conf::ssh_add failed "
+    . "(exit status ", $? >> 8, ")\n";
 }
 
 # change to queue dir
-chdir( $conf::incoming )
-       or die "$main::progname: cannot cd to $conf::incoming: $!\n";
+chdir($conf::incoming)
+  or die "$main::progname: cannot cd to $conf::incoming: $!\n";
 
 # needed before /dev/null redirects, some system send a SIGHUP when loosing
 # the controlling tty
@@ -302,53 +311,57 @@ $SIG{"HUP"} = "IGNORE";
 
 # open logfile, make it unbuffered
 open( LOG, ">>$conf::logfile" )
-       or die "Cannot open my logfile $conf::logfile: $!\n";
+  or die "Cannot open my logfile $conf::logfile: $!\n";
 chmod( 0644, $conf::logfile )
-       or die "Cannot set modes of $conf::logfile: $!\n";
-select( (select(LOG), $| = 1)[0] );
+  or die "Cannot set modes of $conf::logfile: $!\n";
+select( ( select(LOG), $| = 1 )[0] );
 
-sleep( 1 );
+sleep(1);
 $SIG{"HUP"} = \&close_log;
 
 # redirect stdin, ... to /dev/null
 open( STDIN, "</dev/null" )
-       or die "$main::progname: Can't redirect stdin to /dev/null: $!\n";
+  or die "$main::progname: Can't redirect stdin to /dev/null: $!\n";
 open( STDOUT, ">&LOG" )
-       or die "$main::progname: Can't redirect stdout to $conf::logfile: $!\n";
+  or die "$main::progname: Can't redirect stdout to $conf::logfile: $!\n";
 open( STDERR, ">&LOG" )
-       or die "$main::progname: Can't redirect stderr to $conf::logfile: $!\n";
+  or die "$main::progname: Can't redirect stderr to $conf::logfile: $!\n";
+
 # ok, from this point usually no "die" anymore, stderr is gone!
 msg( "log", "daemon (pid $$) started\n" );
 
 # initialize variables used by send_status before launching the status daemon
 $main::dstat = "i";
-format_status_num( $main::next_run, time+10 );
+format_status_num( $main::next_run, time + 10 );
 format_status_str( $main::current_changes, "" );
 check_alive();
-$main::incoming_writable = 1; # assume this for now
+$main::incoming_writable = 1;    # assume this for now
 
 # start the daemon watching the 'status' FIFO
-if ($conf::statusfile && $conf::statusdelay == 0) {
-       $main::statusd_pid = fork_statusd();
-       $SIG{"CHLD"} = \&kid_died; # watch out for dead status daemon
-       # SIGUSR1 triggers status info
-       $SIG{"USR1"} = \&send_status;
-}
+if ( $conf::statusfile && $conf::statusdelay == 0 ) {
+  $main::statusd_pid = fork_statusd();
+  $SIG{"CHLD"}       = \&kid_died;       # watch out for dead status daemon
+                                         # SIGUSR1 triggers status info
+  $SIG{"USR1"}       = \&send_status;
+} ## end if ( $conf::statusfile...
 $main::maind_pid = $$;
 
-END { kill( $main::signo{"ABRT"}, $$ ) if defined $main::signo{"ABRT"}; }
+END {
+  kill( $main::signo{"ABRT"}, $$ )
+    if defined $main::signo{"ABRT"};
+}
 
 # write the pid file
 open( PIDFILE, ">$conf::pidfile" )
-       or msg( "log", "Can't open $conf::pidfile: $!\n" );
+  or msg( "log", "Can't open $conf::pidfile: $!\n" );
 printf PIDFILE "%5d\n", $$;
-close( PIDFILE );
+close(PIDFILE);
 chmod( 0644, $conf::pidfile )
-       or die "Cannot set modes of $conf::pidfile: $!\n";
+  or die "Cannot set modes of $conf::pidfile: $!\n";
 
 # other signals will just log an error and exit
-foreach ( @main::fatal_signals ) {
-       $SIG{$_} = \&fatal_signal;
+foreach (@main::fatal_signals) {
+  $SIG{$_} = \&fatal_signal;
 }
 
 # send signal to user-started process that we're ready and it can exit
@@ -359,1171 +372,1301 @@ kill( $main::signo{"USR1"}, $parent_pid );
 # ---------------------------------------------------------------------------
 
 # default to classical incoming/target
-$main::current_incoming = $conf::incoming;
+$main::current_incoming  = $conf::incoming;
 $main::current_targetdir = $conf::targetdir;
 
 $main::dstat = "i";
 write_status_file() if $conf::statusdelay;
-while( 1 ) {
-
-       # ping target only if there is the possibility that we'll contact it (but
-       # also don't wait too long).
-       my @have_changes = <*.changes *.commands>;
-       for ( my $delayed_dirs = 0; $delayed_dirs <= $conf::max_delayed; 
-                 $delayed_dirs++) {
-               my $adelayeddir = sprintf( "$conf::incoming_delayed",
-                                                                  $delayed_dirs );
-               push( @have_changes,
-                         <$adelayeddir/*.changes> );
-       }
-       check_alive() if @have_changes || (time - $main::last_ping_time) > 8*60*60;
-
-       if (@have_changes && $main::target_up) {
-               check_incoming_writable if !$main::incoming_writable;
-               check_dir() if $main::incoming_writable;
-       }
-       $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 );
-       my $delta;
-       while( ($delta = calc_delta()) > 0 ) {
-               debug( "mainloop sleeping $delta secs" );
-               sleep( $delta );
-               # check if statusd died, if using status FIFO, or update status file
-               if ($conf::statusdelay) {
-                       write_status_file();
-               }
-               else {
-                       restart_statusd();
-               }
-       }
-}
+while (1) {
+
+  # ping target only if there is the possibility that we'll contact it (but
+  # also don't wait too long).
+  my @have_changes = <*.changes *.commands>;
+  for ( my $delayed_dirs = 0 ;
+        $delayed_dirs <= $conf::max_delayed ;
+        $delayed_dirs++ )
+  {
+    my $adelayeddir = sprintf( "$conf::incoming_delayed", $delayed_dirs );
+    push( @have_changes, <$adelayeddir/*.changes> );
+  } ## end for ( my $delayed_dirs ...
+  check_alive()
+    if @have_changes || ( time - $main::last_ping_time ) > 8 * 60 * 60;
+
+  if ( @have_changes && $main::target_up ) {
+    check_incoming_writable if !$main::incoming_writable;
+    check_dir() if $main::incoming_writable;
+  }
+  $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 );
+  my $delta;
+  while ( ( $delta = calc_delta() ) > 0 ) {
+    debug("mainloop sleeping $delta secs");
+    sleep($delta);
+
+    # check if statusd died, if using status FIFO, or update status file
+    if ($conf::statusdelay) {
+      write_status_file();
+    } else {
+      restart_statusd();
+    }
+  } ## end while ( ( $delta = calc_delta...
+} ## end while (1)
 
 sub calc_delta() {
-       my $delta;
-       
-       $delta = $main::next_run - time;
-       $delta = $conf::statusdelay
-               if $conf::statusdelay && $conf::statusdelay < $delta;
-       return $delta;
-}
+  my $delta;
 
+  $delta = $main::next_run - time;
+  $delta = $conf::statusdelay
+    if $conf::statusdelay && $conf::statusdelay < $delta;
+  return $delta;
+} ## end sub calc_delta()
 
 # ---------------------------------------------------------------------------
 #                                                      main working functions
 # ---------------------------------------------------------------------------
 
-
 #
 # main function for checking the incoming dir
 #
 sub check_dir() {
-       my( @files, @changes, @keep_files, @this_keep_files, @stats, $file ,
-               $adelay );
-       
-       debug( "starting checkdir" );
-       $main::dstat = "c";
-       write_status_file() if $conf::statusdelay;
-
-       # test if needed binaries are available; this is if they're on maybe
-       # slow-mounted NFS filesystems
-       foreach (@conf::test_binaries) {
-               next if -f $_;
-               # maybe the mount succeeds now
-               sleep 5;
-               next if -f $_;
-               msg( "log", "binary test failed for $_; delaying queue run\n");
-               goto end_run;
-       }
-
-       for ( $adelay=-1; $adelay <= $conf::max_delayed; $adelay++ ) {
-               if ( $adelay == -1 ) {
-                       $main::current_incoming = $conf::incoming;
-                       $main::current_incoming_short = "";
-                       $main::current_targetdir = $conf::targetdir;
-               }
-               else {
-                       $main::current_incoming = sprintf( $conf::incoming_delayed,
-                                                                                          $adelay );
-                       $main::current_incoming_short = sprintf( "DELAYED/%d-day",
-                                                                                                        $adelay );
-                       $main::current_targetdir = sprintf( $conf::targetdir_delayed,
-                                                                                               $adelay );
-               }
-
-               # need to clear directory specific variables
-               undef ( @keep_files );
-               undef ( @this_keep_files );
-
-               chdir ( $main::current_incoming )
-                       or (msg( "log",
-                                        "Cannot change to dir ".
-                                        "${main::current_incoming_short}: $!\n" ),
-                               return);
-
-               # 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);
-               @files = readdir( INC );
-               closedir( INC );
-
-               # process all .changes files found
-               @changes = grep /\.changes$/, @files;
-               push( @keep_files, @changes ); # .changes files aren't stray
-               foreach $file ( @changes ) {
-                       init_mail( $file );
-                       # wrap in an eval to allow jumpbacks to here with die in case
-                       # of errors
-                       block_signals();
-                       eval { process_changes( $file, @this_keep_files ); };
-                       unblock_signals();
-                       msg( "log,mail", $@ ) if $@;
-                       $main::dstat = "c";
-                       write_status_file() if $conf::statusdelay;
-               
-                       # files which are ok in conjunction with this .changes
-                       debug( "$file tells to keep @this_keep_files" );
-                       push( @keep_files, @this_keep_files );
-                       finish_mail();
-
-                       # break out of this loop if the incoming dir has become unwritable
-                       goto end_run if !$main::incoming_writable;
-               }
-               ftp_close() if $conf::upload_method eq "ftp";
-
-               # find files which aren't related to any .changes
-               foreach $file ( @files ) {
-                       # filter out files we never want to delete
-                       next if ! -f $file ||   # may have disappeared in the meantime
-                           $file eq "." || $file eq ".." ||
-                           (grep { $_ eq $file } @keep_files) ||
-                               $file =~ /$conf::keep_files/;
-                       # Delete such files if they're older than
-                       # $stray_remove_timeout; they could be part of an
-                       # yet-incomplete upload, with the .changes still missing.
-                       # Cannot send any notification, since owner unknown.
-                       next if !(@stats = stat( $file ));
-                       my $age = time - $stats[ST_MTIME];
-                       my( $maint, $pattern, @job_files );
-                       if ($file =~ /^junk-for-writable-test/ ||
-                               $file !~ m,$conf::valid_files, ||
-                               $age >= $conf::stray_remove_timeout) {
-                               msg( "log", "Deleted stray file ${main::current_incoming_short}/$file\n" ) if rm( $file );
-                       }
-                       elsif ($age > $conf::no_changes_timeout &&
-                                  is_debian_file( $file ) &&
-                                  # not already reported
-                                  !($stats[ST_MODE] & S_ISGID) &&
-                                  ($pattern = debian_file_stem( $file )) &&
-                                  (@job_files = glob($pattern)) &&
-                                  # If a .changes is in the list, it has the same stem as the
-                                  # found file (probably a .orig.tar.gz). Don't report in this
-                                  # case.
-                                  !(grep( /\.changes$/, @job_files ))) {
-                               $maint = get_maintainer( $file );
-                               # Don't send a mail if this looks like the recompilation of a
-                               # package for a non-i386 arch. For those, the maintainer field is
-                               # useless :-(
-                               if (!grep( /(\.dsc|_(i386|all)\.deb)$/, @job_files )) {
-                                       msg( "log", "Found an upload without .changes and with no ",
-                                                       ".dsc file\n" );
-                                       msg( "log", "Not sending a report, because probably ",
-                                                       "recompilation job\n" );
-                               }
-                               elsif ($maint) {
-                                       init_mail();
-                                       $main::mail_addr = $maint;
-                                       $main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
-                                       $main::mail_subject = "Incomplete upload found in ".
-                                                                 "Debian upload queue";
-                                       msg( "mail", "Probably you are the uploader of the following ".
-                                                                "file(s) in\n" );
-                                       msg( "mail", "the Debian upload queue directory:\n  " );
-                                       msg( "mail", join( "\n  ", @job_files ), "\n" );
-                                       msg( "mail", "This looks like an upload, but a .changes file ".
-                                                                "is missing, so the job\n" );
-                                       msg( "mail", "cannot be processed.\n\n" );
-                                       msg( "mail", "If no .changes file arrives within ",
-                                                                print_time( $conf::stray_remove_timeout - $age ),
-                                                                ", the files will be deleted.\n\n" );
-                                       msg( "mail", "If you didn't upload those files, please just ".
-                                                                "ignore this message.\n" );
-                                       finish_mail();
-                                       msg( "log", "Sending problem report for an upload without a ".
-                                                               ".changes\n" );
-                                       msg( "log", "Maintainer: $maint\n" );
-                               }
-                               else {
-                                       msg( "log", "Found an upload without .changes, but can't ".
-                                                               "find a maintainer address\n" );
-                               }
-                               msg( "log", "Files: @job_files\n" );
-                               # remember we already have sent a mail regarding this file
-                               foreach ( @job_files ) {
-                                       my @st = stat($_);
-                                       next if !@st; # file may have disappeared in the meantime
-                                       chmod +($st[ST_MODE] |= S_ISGID), $_;
-                               }
-                       }
-                       else {
-                               debug( "found stray file ${main::current_incoming_short}/$file, deleting in ",
-                                          print_time($conf::stray_remove_timeout - $age) );
-                       }
-               }
-       }
-       chdir( $conf::incoming );
-
-  end_run:
-       $main::dstat = "i";
-       write_status_file() if $conf::statusdelay;
-}
+  my ( @files, @changes, @keep_files, @this_keep_files, @stats, $file,
+       $adelay );
+
+  debug("starting checkdir");
+  $main::dstat = "c";
+  write_status_file() if $conf::statusdelay;
+
+  # test if needed binaries are available; this is if they're on maybe
+  # slow-mounted NFS filesystems
+  foreach (@conf::test_binaries) {
+    next if -f $_;
+
+    # maybe the mount succeeds now
+    sleep 5;
+    next if -f $_;
+    msg( "log", "binary test failed for $_; delaying queue run\n" );
+    goto end_run;
+  } ## end foreach (@conf::test_binaries)
+
+  for ( $adelay = -1 ; $adelay <= $conf::max_delayed ; $adelay++ ) {
+    if ( $adelay == -1 ) {
+      $main::current_incoming       = $conf::incoming;
+      $main::current_incoming_short = "";
+      $main::current_targetdir      = $conf::targetdir;
+    } else {
+      $main::current_incoming = sprintf( $conf::incoming_delayed, $adelay );
+      $main::current_incoming_short = sprintf( "DELAYED/%d-day", $adelay );
+      $main::current_targetdir = sprintf( $conf::targetdir_delayed, $adelay );
+    }
+
+    # need to clear directory specific variables
+    undef(@keep_files);
+    undef(@this_keep_files);
+
+    chdir($main::current_incoming)
+      or (
+           msg(
+                "log",
+                "Cannot change to dir "
+                  . "${main::current_incoming_short}: $!\n"
+              ),
+           return
+         );
+
+    # 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();
+      } ## end foreach $file (<*.commands>)
+    } ## end if ( $adelay == -1 )
+    opendir( INC, "." )
+      or (
+           msg(
+                "log", "Cannot open dir ${main::current_incoming_short}: $!\n"
+              ),
+           return
+         );
+    @files = readdir(INC);
+    closedir(INC);
+
+    # process all .changes files found
+    @changes = grep /\.changes$/, @files;
+    push( @keep_files, @changes );    # .changes files aren't stray
+    foreach $file (@changes) {
+      init_mail($file);
+
+      # wrap in an eval to allow jumpbacks to here with die in case
+      # of errors
+      block_signals();
+      eval { process_changes( $file, @this_keep_files ); };
+      unblock_signals();
+      msg( "log,mail", $@ ) if $@;
+      $main::dstat = "c";
+      write_status_file() if $conf::statusdelay;
+
+      # files which are ok in conjunction with this .changes
+      debug("$file tells to keep @this_keep_files");
+      push( @keep_files, @this_keep_files );
+      finish_mail();
+
+      # break out of this loop if the incoming dir has become unwritable
+      goto end_run if !$main::incoming_writable;
+    } ## end foreach $file (@changes)
+    ftp_close() if $conf::upload_method eq "ftp";
+
+    # find files which aren't related to any .changes
+    foreach $file (@files) {
+
+      # filter out files we never want to delete
+      next if !-f $file ||    # may have disappeared in the meantime
+             $file eq "."
+          || $file eq ".."
+          || ( grep { $_ eq $file } @keep_files )
+          || $file =~ /$conf::keep_files/;
+
+      # Delete such files if they're older than
+      # $stray_remove_timeout; they could be part of an
+      # yet-incomplete upload, with the .changes still missing.
+      # Cannot send any notification, since owner unknown.
+      next if !( @stats = stat($file) );
+      my $age = time - $stats[ST_MTIME];
+      my ( $maint, $pattern, @job_files );
+      if (    $file =~ /^junk-for-writable-test/
+           || $file !~ m,$conf::valid_files,
+           || $age >= $conf::stray_remove_timeout )
+      {
+        msg( "log",
+             "Deleted stray file ${main::current_incoming_short}/$file\n" )
+          if rm($file);
+      } elsif (
+        $age > $conf::no_changes_timeout
+        && is_debian_file($file)
+        &&
+
+        # not already reported
+          !( $stats[ST_MODE] & S_ISGID )
+        && ( $pattern   = debian_file_stem($file) )
+        && ( @job_files = glob($pattern) )
+        &&
+
+        # If a .changes is in the list, it has the same stem as the
+        # found file (probably a .orig.tar.gz). Don't report in this
+        # case.
+        !( grep( /\.changes$/, @job_files ) )
+              )
+      {
+        $maint = get_maintainer($file);
+
+        # Don't send a mail if this looks like the recompilation of a
+        # package for a non-i386 arch. For those, the maintainer field is
+        # useless :-(
+        if ( !grep( /(\.dsc|_(i386|all)\.deb)$/, @job_files ) ) {
+          msg( "log", "Found an upload without .changes and with no ",
+               ".dsc file\n" );
+          msg( "log",
+               "Not sending a report, because probably ",
+               "recompilation job\n" );
+        } elsif ($maint) {
+          init_mail();
+          $main::mail_addr = $maint;
+          $main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
+          $main::mail_subject =
+            "Incomplete upload found in " . "Debian upload queue";
+          msg(
+               "mail",
+               "Probably you are the uploader of the following "
+                 . "file(s) in\n"
+             );
+          msg( "mail", "the Debian upload queue directory:\n  " );
+          msg( "mail", join( "\n  ", @job_files ), "\n" );
+          msg(
+               "mail",
+               "This looks like an upload, but a .changes file "
+                 . "is missing, so the job\n"
+             );
+          msg( "mail", "cannot be processed.\n\n" );
+          msg(
+               "mail",
+               "If no .changes file arrives within ",
+               print_time( $conf::stray_remove_timeout - $age ),
+               ", the files will be deleted.\n\n"
+             );
+          msg(
+               "mail",
+               "If you didn't upload those files, please just "
+                 . "ignore this message.\n"
+             );
+          finish_mail();
+          msg(
+               "log",
+               "Sending problem report for an upload without a "
+                 . ".changes\n"
+             );
+          msg( "log", "Maintainer: $maint\n" );
+        } else {
+          msg(
+               "log",
+               "Found an upload without .changes, but can't "
+                 . "find a maintainer address\n"
+             );
+        } ## end else [ if ( !grep( /(\.dsc|_(i386|all)\.deb)$/...
+        msg( "log", "Files: @job_files\n" );
+
+        # remember we already have sent a mail regarding this file
+        foreach (@job_files) {
+          my @st = stat($_);
+          next if !@st;    # file may have disappeared in the meantime
+          chmod +( $st[ST_MODE] |= S_ISGID ), $_;
+        }
+      } else {
+        debug(
+"found stray file ${main::current_incoming_short}/$file, deleting in ",
+          print_time( $conf::stray_remove_timeout - $age )
+        );
+      } ## end else [ if ( $file =~ /^junk-for-writable-test/...
+    } ## end foreach $file (@files)
+  } ## end for ( $adelay = -1 ; $adelay...
+  chdir($conf::incoming);
+
+end_run:
+  $main::dstat = "i";
+  write_status_file() if $conf::statusdelay;
+} ## end sub check_dir()
 
 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;
-}
+  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] );
+      } ## end while (<CHANGES>)
+    } ## end if (/^Files:/i)
+  } ## end while (<CHANGES>)
+  close(CHANGES);
+  return @filenames;
+} ## end sub get_filelist_from_known_good_changes($)
 
 #
 # process one .changes file
 #
 sub process_changes($\@) {
-       my $changes = shift;
-       my $keep_list = shift;
-       my( $pgplines, @files, @filenames, @changes_stats, $failure_file,
-           $retries, $last_retry, $upload_time, $file, $do_report, $ls_l,
-           $problems_reported, $errs, $pkgname, $signator );
-       local( *CHANGES );
-       local( *FAILS );
-
-       format_status_str( $main::current_changes, "$main::current_incoming_short/$changes" );
-       $main::dstat = "c";
-       write_status_file() if $conf::statusdelay;
-
-       @$keep_list = ();
-       msg( "log", "processing ${main::current_incoming_short}/$changes\n" );
-
-       # parse the .changes file
-       open( CHANGES, "<$changes" )
-               or die "Cannot open ${main::current_incoming_short}/$changes: $!\n";
-       $pgplines = 0;
-       $main::mail_addr = "";
-       @files = ();
-       outer_loop: while( <CHANGES> ) {
-               if (/^---+(BEGIN|END) PGP .*---+$/) {
-                       ++$pgplines;
-               }
-               elsif (/^Maintainer:\s*/i) {
-                       chomp( $main::mail_addr = $' );
-                       $main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
-               }
-               elsif (/^Source:\s*/i) {
-                       chomp( $pkgname = $' );
-                       $pkgname =~ s/\s+$//;
-                        $main::packages{$pkgname}++;
-               }
-               elsif (/^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" );
-                                       msg( "mail", "File '$field[5]' mentioned in $main::current_incoming_short/$changes\n",
-                                                "has bad characters in its name. Removed.\n" );
-                                       rm( $field[5] );
-                                       next;
-                               }
-                               push( @files, { md5  => $field[1],
-                                                               size => $field[2],
-                                                               name => $field[5] } );
-                               push( @filenames, $field[5] );
-                               debug( "includes file $field[5], size $field[2], ",
-                                          "md5 $field[1]" );
-                       }
-               }
-       }
-       close( CHANGES );
-
-       # tell check_dir that the files mentioned in this .changes aren't stray,
-       # we know about them somehow
-       @$keep_list = @filenames;
-
-       # some consistency checks
-       if (!$main::mail_addr) {
-               msg( "log,mail", "$main::current_incoming_short/$changes doesn't contain a Maintainer: field; ".
-                        "cannot process\n" );
-               goto remove_only_changes;
-       }
-       if ($main::mail_addr !~ /^(buildd_\S+-\S+|\S+\@\S+\.\S+)/) {
-               # doesn't look like a mail address, maybe only the name
-               my( $new_addr, @addr_list );
-               if ($new_addr = try_to_get_mail_addr( $main::mail_addr, \@addr_list )){
-                       # substitute (unique) found addr, but give a warning
-                       msg( "mail", "(The Maintainer: field didn't contain a proper ".
-                                                "mail address.\n" );
-                       msg( "mail", "Looking for `$main::mail_addr' in the Debian ".
-                                                "keyring gave your address\n" );
-                       msg( "mail", "as unique result, so I used this.)\n" );
-                       msg( "log", "Substituted $new_addr for malformed ".
-                                               "$main::mail_addr\n" );
-                       $main::mail_addr = $new_addr;
-               }
-               else {
-                       # not found or not unique: hold the job and inform queue maintainer
-                       my $old_addr = $main::mail_addr;
-                       $main::mail_addr = $conf::maintainer_mail;
-                       msg( "mail", "The job ${main::current_incoming_short}/$changes doesn't have a correct email\n" );
-                   msg( "mail", "address in the Maintainer: field:\n" );
-                       msg( "mail", "  $old_addr\n" );
-                       msg( "mail", "A check for this in the Debian keyring gave:\n" );
-                       msg( "mail", @addr_list ?
-                                                "  " . join( ", ", @addr_list ) . "\n" :
-                                                "  nothing\n" );
-                       msg( "mail", "Please fix this manually\n" );
-                       msg( "log", "Bad Maintainer: field in ${main::current_incoming_short}/$changes: $old_addr\n" );
-                       goto remove_only_changes;
-               }
-       }
-       if ($pgplines < 3) {
-               msg( "log,mail", "$main::current_incoming_short/$changes isn't signed with PGP/GnuPG\n" );
-               msg( "log", "(uploader $main::mail_addr)\n" );
-               goto remove_only_changes;
-       }
-       if (!@files) {
-               msg( "log,mail", "$main::current_incoming_short/$changes doesn't mention any files\n" );
-               msg( "log", "(uploader $main::mail_addr)\n" );
-               goto remove_only_changes;
-       }
-
-       # check for packages that shouldn't be processed
-       if (grep( $_ eq $pkgname, @conf::nonus_packages )) {
-               msg( "log,mail", "$pkgname is a package that must be uploaded ".
-                                    "to nonus.debian.org\n" );
-               msg( "log,mail", "instead of target.\n" );
-               msg( "log,mail", "Job rejected and removed all files belonging ".
-                                                "to it:\n" );
-               msg( "log,mail", "  ", join( ", ", @filenames ), "\n" );
-               rm( $changes, @filenames );
-               return;
-       }
-
-       $failure_file = $changes . ".failures";
-       $retries = $last_retry = 0;
-       if (-f $failure_file) {
-               open( FAILS, "<$failure_file" )
-                       or die "Cannot open $main::current_incoming_short/$failure_file: $!\n";
-               my $line = <FAILS>;
-               close( FAILS );
-               ( $retries, $last_retry ) = ( $1, $2 ) if $line =~ /^(\d+)\s+(\d+)$/;
-               push( @$keep_list, $failure_file );
-       }
-
-       # run PGP on the file to check the signature
-       if (!($signator = pgp_check( $changes ))) {
-               msg( "log,mail", "$main::current_incoming_short/$changes has bad PGP/GnuPG signature!\n" );
-               msg( "log", "(uploader $main::mail_addr)\n" );
-         remove_only_changes:
-               msg( "log,mail", "Removing $main::current_incoming_short/$changes, but keeping its associated ",
-                                    "files for now.\n" );
-               rm( $changes );
-               # Set SGID bit on associated files, so that the test for Debian files
-               # without a .changes doesn't consider them.
-               foreach ( @filenames ) {
-                       my @st = stat($_);
-                       next if !@st; # file may have disappeared in the meantime
-                       chmod +($st[ST_MODE] |= S_ISGID), $_;
-               }
-               return;
-       }
-       elsif ($signator eq "LOCAL ERROR") {
-               # An error has appened when starting pgp... Don't process the file,
-               # but also don't delete it
-               debug( "Can't PGP/GnuPG check $main::current_incoming_short/$changes -- don't process it for now" );
-               return;
-       }
-
-       die "Cannot stat ${main::current_incoming_short}/$changes (??): $!\n"
-               if !(@changes_stats = stat( $changes ));
-       # Make $upload_time the maximum of all modification times of files
-       # related to this .changes (and the .changes it self). This is the
-       # last time something changes to these files.
-       $upload_time = $changes_stats[ST_MTIME];
-       for $file ( @files ) {
-               my @stats;
-               next if !(@stats = stat( $file->{"name"} ));
-               $file->{"stats"} = \@stats;
-               $upload_time = $stats[ST_MTIME] if $stats[ST_MTIME] > $upload_time;
-       }
-
-       $do_report = (time - $upload_time) > $conf::problem_report_timeout;
-       $problems_reported = $changes_stats[ST_MODE] & S_ISGID;
-       # if any of the files is newer than the .changes' ctime (the time
-       # we sent a report and set the sticky bit), send new problem reports
-       if ($problems_reported && $changes_stats[ST_CTIME] < $upload_time) {
-               $problems_reported = 0;
-               chmod +($changes_stats[ST_MODE] &= ~S_ISGID), $changes;
-               debug( "upload_time>changes-ctime => resetting problems reported" );
-       }
-       debug( "do_report=$do_report problems_reported=$problems_reported" );
-       
-       # now check all files for correct size and md5 sum
-       for $file ( @files ) {
-               my $filename = $file->{"name"};
-               if (!defined( $file->{"stats"} )) {
-                       # could be an upload that isn't complete yet, be quiet,
-                       # but don't process the file;
-                       msg( "log,mail", "$filename doesn't exist\n" )
-                               if $do_report && !$problems_reported;
-                       msg( "log", "$filename doesn't exist (ignored for now)\n" )
-                               if !$do_report;
-                       msg( "log", "$filename doesn't exist (already reported)\n" )
-                               if $problems_reported;
-                       ++$errs;
-               }
-               elsif ($file->{"stats"}->[ST_SIZE] < $file->{"size"} && !$do_report) {
-                       # could be an upload that isn't complete yet, be quiet,
-                       # but don't process the file
-                       msg( "log", "$filename is too small (ignored for now)\n" );
-                       ++$errs;
-               }
-               elsif ($file->{"stats"}->[ST_SIZE] != $file->{"size"}) {
-                       msg( "log,mail", "$filename has incorrect size; deleting it\n" );
-                       rm( $filename );
-                       ++$errs;
-               }
-               elsif (md5sum( $filename ) ne $file->{"md5"}) {
-                       msg( "log,mail", "$filename has incorrect md5 checksum; ",
-                                            "deleting it\n" );
-                       rm( $filename );
-                       ++$errs;
-               }
-       }
-
-       if ($errs) {
-               if ((time - $upload_time) > $conf::bad_changes_timeout) {
-                       # if a .changes fails for a really long time (several days
-                       # or so), remove it and all associated files
-                       msg( "log,mail",
-                                "$main::current_incoming_short/$changes couldn't be processed for ",
-                                int($conf::bad_changes_timeout/(60*60)),
-                                " hours and is now deleted\n" );
-                       msg( "log,mail",
-                                "All files it mentions are also removed:\n" );
-                       msg( "log,mail", "  ", join( ", ", @filenames ), "\n" );
-                       rm( $changes, @filenames, $failure_file );
-               }
-               elsif ($do_report && !$problems_reported) {
-                       # otherwise, send a problem report, if not done already
-                       msg( "mail",
-                                "Due to the errors above, the .changes file couldn't ",
-                                "be processed.\n",
-                                "Please fix the problems for the upload to happen.\n" );
-                       # remember we already have sent a mail regarding this file
-                       debug( "Sending problem report mail and setting SGID bit" );
-                       my $mode = $changes_stats[ST_MODE] |= S_ISGID;
-                       msg( "log", "chmod failed: $!" ) if (chmod ($mode, $changes) != 1);
-               }
-               # else: be quiet
-               
-               return;
-       }
-
-       # if this upload already failed earlier, wait until the delay requirement
-       # is fulfilled
-       if ($retries > 0 && (time - $last_retry) <
-               ($retries == 1 ? $conf::upload_delay_1 : $conf::upload_delay_2)) {
-               msg( "log", "delaying retry of upload\n" );
-               return;
-       }
-
-       if ($conf::upload_method eq "ftp") {
-               return if !ftp_open();
-       }
-
-       # 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, @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 ",
-                                "came first.\n" );
-               msg( "log,mail", "Job $changes removed.\n" );
-               rm( $changes, @filenames, $failure_file );
-               return;
-       }
-               
-       # clear sgid bit before upload, scp would copy it to target. We don't need
-       # it anymore, we know there are no problems if we come here. Also change
-       # mode of files to 644 if this should be done locally.
-       $changes_stats[ST_MODE] &= ~S_ISGID;
-       if (!$conf::chmod_on_target) {
-               $changes_stats[ST_MODE] &= ~0777;
-               $changes_stats[ST_MODE] |= 0644;
-       }
-       chmod +($changes_stats[ST_MODE]), $changes;
-
-       # try uploading to target
-       if (!copy_to_target( $changes, @filenames )) {
-               # if the upload failed, increment the retry counter and remember the
-               # current time; both things are written to the .failures file. Don't
-               # increment the fail counter if the error was due to incoming
-               # unwritable.
-               return if !$main::incoming_writable;
-               if (++$retries >= $conf::max_upload_retries) {
-                       msg( "log,mail",
-                                "$changes couldn't be uploaded for $retries times now.\n" );
-                       msg( "log,mail",
-                                "Giving up and removing it and its associated files:\n" );
-                       msg( "log,mail", "  ", join( ", ", @filenames ), "\n" );
-                       rm( $changes, @filenames, $failure_file );
-               }
-               else {
-                       $last_retry = time;
-                       if (open( FAILS, ">$failure_file" )) {
-                               print FAILS "$retries $last_retry\n";
-                               close( FAILS );
-                               chmod( 0600, $failure_file )
-                                       or die "Cannot set modes of $failure_file: $!\n";
-                       }
-                       push( @$keep_list, $failure_file );
-                       debug( "now $retries failed uploads" );
-                       msg( "mail",
-                                "The upload will be retried in ",
-                                print_time( $retries == 1 ? $conf::upload_delay_1 :
-                                                        $conf::upload_delay_2 ), "\n" );
-               }
-               return;
-       }
-
-       # If the files were uploaded ok, remove them
-       rm( $changes, @filenames, $failure_file );
-
-       msg( "mail", "$changes uploaded successfully to $conf::target\n" );
-       msg( "mail", "along with the files:\n  ",
-                        join( "\n  ", @filenames ), "\n" );
-       msg( "log", "$changes processed successfully (uploader $main::mail_addr)\n" );
-
-       # Check for files that have the same stem as the .changes (and weren't
-       # mentioned there) and delete them. It happens often enough that people
-       # upload a .orig.tar.gz where it isn't needed and also not in the
-       # .changes. Explicitly deleting it (and not waiting for the
-       # $stray_remove_timeout) reduces clutter in the queue dir and maybe also
-       # educates uploaders :-)
-
-#      my $pattern = debian_file_stem( $changes );
-#      my $spattern = substr( $pattern, 0, -1 ); # strip off '*' at end
-#      my @other_files = glob($pattern);
-       # filter out files that have a Debian revision at all and a different
-       # revision. Those belong to a different upload.
-#      if ($changes =~ /^\Q$spattern\E-([\d.+-]+)/) {
-#              my $this_rev = $1;
-#              @other_files = grep( !/^\Q$spattern\E-([\d.+-]+)/ || $1 eq $this_rev,
-#                                                       @other_files);
-       #}
-       # Also do not remove those files if a .changes is among them. Then there
-       # is probably a second upload for another version or another architecture.
-#      if (@other_files && !grep( /\.changes$/, @other_files )) {
-#              rm( @other_files );
-#              msg( "mail", "\nThe following file(s) seemed to belong to the same ".
-#                                       "upload, but weren't listed\n" );
-#              msg( "mail", "in the .changes file:\n  " );
-#              msg( "mail", join( "\n  ", @other_files ), "\n" );
-#              msg( "mail", "They have been deleted.\n" );
-#              msg( "log", "Deleted files in upload not in $changes: @other_files\n" );
-       #}
-}
+  my $changes   = shift;
+  my $keep_list = shift;
+  my (
+       $pgplines,     @files,     @filenames,  @changes_stats,
+       $failure_file, $retries,   $last_retry, $upload_time,
+       $file,         $do_report, $ls_l,       $problems_reported,
+       $errs,         $pkgname,   $signator
+     );
+  local (*CHANGES);
+  local (*FAILS);
+
+  format_status_str( $main::current_changes,
+                     "$main::current_incoming_short/$changes" );
+  $main::dstat = "c";
+  write_status_file() if $conf::statusdelay;
+
+  @$keep_list = ();
+  msg( "log", "processing ${main::current_incoming_short}/$changes\n" );
+
+  # parse the .changes file
+  open( CHANGES, "<$changes" )
+    or die "Cannot open ${main::current_incoming_short}/$changes: $!\n";
+  $pgplines        = 0;
+  $main::mail_addr = "";
+  @files           = ();
+outer_loop: while (<CHANGES>) {
+    if (/^---+(BEGIN|END) PGP .*---+$/) {
+      ++$pgplines;
+    } elsif (/^Maintainer:\s*/i) {
+      chomp( $main::mail_addr = $' );
+      $main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
+    } elsif (/^Source:\s*/i) {
+      chomp( $pkgname = $' );
+      $pkgname =~ s/\s+$//;
+      $main::packages{$pkgname}++;
+    } elsif (/^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" );
+          msg(
+            "mail",
+"File '$field[5]' mentioned in $main::current_incoming_short/$changes\n",
+            "has bad characters in its name. Removed.\n"
+          );
+          rm( $field[5] );
+          next;
+        } ## end if ( $1 ne $field[5] )
+        push(
+              @files,
+              {
+                md5  => $field[1],
+                size => $field[2],
+                name => $field[5]
+              }
+            );
+        push( @filenames, $field[5] );
+        debug( "includes file $field[5], size $field[2], ", "md5 $field[1]" );
+      } ## end while (<CHANGES>)
+    } ## end elsif (/^Files:/i)
+  } ## end while (<CHANGES>)
+  close(CHANGES);
+
+  # tell check_dir that the files mentioned in this .changes aren't stray,
+  # we know about them somehow
+  @$keep_list = @filenames;
+
+  # some consistency checks
+  if ( !$main::mail_addr ) {
+    msg( "log,mail",
+"$main::current_incoming_short/$changes doesn't contain a Maintainer: field; "
+        . "cannot process\n" );
+    goto remove_only_changes;
+  } ## end if ( !$main::mail_addr)
+  if ( $main::mail_addr !~ /^(buildd_\S+-\S+|\S+\@\S+\.\S+)/ ) {
+
+    # doesn't look like a mail address, maybe only the name
+    my ( $new_addr, @addr_list );
+    if ( $new_addr = try_to_get_mail_addr( $main::mail_addr, \@addr_list ) ) {
+
+      # substitute (unique) found addr, but give a warning
+      msg(
+           "mail",
+           "(The Maintainer: field didn't contain a proper "
+             . "mail address.\n"
+         );
+      msg(
+           "mail",
+           "Looking for `$main::mail_addr' in the Debian "
+             . "keyring gave your address\n"
+         );
+      msg( "mail", "as unique result, so I used this.)\n" );
+      msg( "log",
+           "Substituted $new_addr for malformed " . "$main::mail_addr\n" );
+      $main::mail_addr = $new_addr;
+    } else {
+
+      # not found or not unique: hold the job and inform queue maintainer
+      my $old_addr = $main::mail_addr;
+      $main::mail_addr = $conf::maintainer_mail;
+      msg(
+        "mail",
+"The job ${main::current_incoming_short}/$changes doesn't have a correct email\n"
+      );
+      msg( "mail", "address in the Maintainer: field:\n" );
+      msg( "mail", "  $old_addr\n" );
+      msg( "mail", "A check for this in the Debian keyring gave:\n" );
+      msg( "mail",
+           @addr_list
+           ? "  " . join( ", ", @addr_list ) . "\n"
+           : "  nothing\n" );
+      msg( "mail", "Please fix this manually\n" );
+      msg(
+        "log",
+"Bad Maintainer: field in ${main::current_incoming_short}/$changes: $old_addr\n"
+      );
+      goto remove_only_changes;
+    } ## end else [ if ( $new_addr = try_to_get_mail_addr...
+  } ## end if ( $main::mail_addr ...
+  if ( $pgplines < 3 ) {
+    msg(
+        "log,mail",
+        "$main::current_incoming_short/$changes isn't signed with PGP/GnuPG\n"
+       );
+    msg( "log", "(uploader $main::mail_addr)\n" );
+    goto remove_only_changes;
+  } ## end if ( $pgplines < 3 )
+  if ( !@files ) {
+    msg( "log,mail",
+       "$main::current_incoming_short/$changes doesn't mention any files\n" );
+    msg( "log", "(uploader $main::mail_addr)\n" );
+    goto remove_only_changes;
+  } ## end if ( !@files )
+
+  # check for packages that shouldn't be processed
+  if ( grep( $_ eq $pkgname, @conf::nonus_packages ) ) {
+    msg(
+         "log,mail",
+         "$pkgname is a package that must be uploaded "
+           . "to nonus.debian.org\n"
+       );
+    msg( "log,mail", "instead of target.\n" );
+    msg( "log,mail",
+         "Job rejected and removed all files belonging " . "to it:\n" );
+    msg( "log,mail", "  ", join( ", ", @filenames ), "\n" );
+    rm( $changes, @filenames );
+    return;
+  } ## end if ( grep( $_ eq $pkgname...
+
+  $failure_file = $changes . ".failures";
+  $retries = $last_retry = 0;
+  if ( -f $failure_file ) {
+    open( FAILS, "<$failure_file" )
+      or die "Cannot open $main::current_incoming_short/$failure_file: $!\n";
+    my $line = <FAILS>;
+    close(FAILS);
+    ( $retries, $last_retry ) = ( $1, $2 )
+      if $line =~ /^(\d+)\s+(\d+)$/;
+    push( @$keep_list, $failure_file );
+  } ## end if ( -f $failure_file )
+
+  # run PGP on the file to check the signature
+  if ( !( $signator = pgp_check($changes) ) ) {
+    msg(
+       "log,mail",
+       "$main::current_incoming_short/$changes has bad PGP/GnuPG signature!\n"
+    );
+    msg( "log", "(uploader $main::mail_addr)\n" );
+  remove_only_changes:
+    msg(
+      "log,mail",
+"Removing $main::current_incoming_short/$changes, but keeping its associated ",
+      "files for now.\n"
+    );
+    rm($changes);
+
+    # Set SGID bit on associated files, so that the test for Debian files
+    # without a .changes doesn't consider them.
+    foreach (@filenames) {
+      my @st = stat($_);
+      next if !@st;    # file may have disappeared in the meantime
+      chmod +( $st[ST_MODE] |= S_ISGID ), $_;
+    }
+    return;
+  } elsif ( $signator eq "LOCAL ERROR" ) {
+
+    # An error has appened when starting pgp... Don't process the file,
+    # but also don't delete it
+    debug(
+"Can't PGP/GnuPG check $main::current_incoming_short/$changes -- don't process it for now"
+    );
+    return;
+  } ## end elsif ( $signator eq "LOCAL ERROR")
+
+  die "Cannot stat ${main::current_incoming_short}/$changes (??): $!\n"
+    if !( @changes_stats = stat($changes) );
+
+  # Make $upload_time the maximum of all modification times of files
+  # related to this .changes (and the .changes it self). This is the
+  # last time something changes to these files.
+  $upload_time = $changes_stats[ST_MTIME];
+  for $file (@files) {
+    my @stats;
+    next if !( @stats = stat( $file->{"name"} ) );
+    $file->{"stats"} = \@stats;
+    $upload_time = $stats[ST_MTIME] if $stats[ST_MTIME] > $upload_time;
+  } ## end for $file (@files)
+
+  $do_report = ( time - $upload_time ) > $conf::problem_report_timeout;
+  $problems_reported = $changes_stats[ST_MODE] & S_ISGID;
+
+  # if any of the files is newer than the .changes' ctime (the time
+  # we sent a report and set the sticky bit), send new problem reports
+  if ( $problems_reported && $changes_stats[ST_CTIME] < $upload_time ) {
+    $problems_reported = 0;
+    chmod +( $changes_stats[ST_MODE] &= ~S_ISGID ), $changes;
+    debug("upload_time>changes-ctime => resetting problems reported");
+  }
+  debug("do_report=$do_report problems_reported=$problems_reported");
+
+  # now check all files for correct size and md5 sum
+  for $file (@files) {
+    my $filename = $file->{"name"};
+    if ( !defined( $file->{"stats"} ) ) {
+
+      # could be an upload that isn't complete yet, be quiet,
+      # but don't process the file;
+      msg( "log,mail", "$filename doesn't exist\n" )
+        if $do_report && !$problems_reported;
+      msg( "log", "$filename doesn't exist (ignored for now)\n" )
+        if !$do_report;
+      msg( "log", "$filename doesn't exist (already reported)\n" )
+        if $problems_reported;
+      ++$errs;
+    } elsif ( $file->{"stats"}->[ST_SIZE] < $file->{"size"}
+              && !$do_report )
+    {
+
+      # could be an upload that isn't complete yet, be quiet,
+      # but don't process the file
+      msg( "log", "$filename is too small (ignored for now)\n" );
+      ++$errs;
+    } elsif ( $file->{"stats"}->[ST_SIZE] != $file->{"size"} ) {
+      msg( "log,mail", "$filename has incorrect size; deleting it\n" );
+      rm($filename);
+      ++$errs;
+    } elsif ( md5sum($filename) ne $file->{"md5"} ) {
+      msg( "log,mail",
+           "$filename has incorrect md5 checksum; ",
+           "deleting it\n" );
+      rm($filename);
+      ++$errs;
+    } ## end elsif ( md5sum($filename)...
+  } ## end for $file (@files)
+
+  if ($errs) {
+    if ( ( time - $upload_time ) > $conf::bad_changes_timeout ) {
+
+      # if a .changes fails for a really long time (several days
+      # or so), remove it and all associated files
+      msg(
+          "log,mail",
+          "$main::current_incoming_short/$changes couldn't be processed for ",
+          int( $conf::bad_changes_timeout / ( 60 * 60 ) ),
+          " hours and is now deleted\n"
+         );
+      msg( "log,mail", "All files it mentions are also removed:\n" );
+      msg( "log,mail", "  ", join( ", ", @filenames ), "\n" );
+      rm( $changes, @filenames, $failure_file );
+    } elsif ( $do_report && !$problems_reported ) {
+
+      # otherwise, send a problem report, if not done already
+      msg(
+           "mail",
+           "Due to the errors above, the .changes file couldn't ",
+           "be processed.\n",
+           "Please fix the problems for the upload to happen.\n"
+         );
+
+      # remember we already have sent a mail regarding this file
+      debug("Sending problem report mail and setting SGID bit");
+      my $mode = $changes_stats[ST_MODE] |= S_ISGID;
+      msg( "log", "chmod failed: $!" )
+        if ( chmod( $mode, $changes ) != 1 );
+    } ## end elsif ( $do_report && !$problems_reported)
+
+    # else: be quiet
+
+    return;
+  } ## end if ($errs)
+
+  # if this upload already failed earlier, wait until the delay requirement
+  # is fulfilled
+  if ( $retries > 0
+       && ( time - $last_retry ) <
+       ( $retries == 1 ? $conf::upload_delay_1 : $conf::upload_delay_2 ) )
+  {
+    msg( "log", "delaying retry of upload\n" );
+    return;
+  } ## end if ( $retries > 0 && (...
+
+  if ( $conf::upload_method eq "ftp" ) {
+    return if !ftp_open();
+  }
+
+  # 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, @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 ",
+         "came first.\n" );
+    msg( "log,mail", "Job $changes removed.\n" );
+    rm( $changes, @filenames, $failure_file );
+    return;
+  } ## end if ( $ls_l = is_on_target...
+
+  # clear sgid bit before upload, scp would copy it to target. We don't need
+  # it anymore, we know there are no problems if we come here. Also change
+  # mode of files to 644 if this should be done locally.
+  $changes_stats[ST_MODE] &= ~S_ISGID;
+  if ( !$conf::chmod_on_target ) {
+    $changes_stats[ST_MODE] &= ~0777;
+    $changes_stats[ST_MODE] |= 0644;
+  }
+  chmod +( $changes_stats[ST_MODE] ), $changes;
+
+  # try uploading to target
+  if ( !copy_to_target( $changes, @filenames ) ) {
+
+    # if the upload failed, increment the retry counter and remember the
+    # current time; both things are written to the .failures file. Don't
+    # increment the fail counter if the error was due to incoming
+    # unwritable.
+    return if !$main::incoming_writable;
+    if ( ++$retries >= $conf::max_upload_retries ) {
+      msg( "log,mail",
+           "$changes couldn't be uploaded for $retries times now.\n" );
+      msg( "log,mail",
+           "Giving up and removing it and its associated files:\n" );
+      msg( "log,mail", "  ", join( ", ", @filenames ), "\n" );
+      rm( $changes, @filenames, $failure_file );
+    } else {
+      $last_retry = time;
+      if ( open( FAILS, ">$failure_file" ) ) {
+        print FAILS "$retries $last_retry\n";
+        close(FAILS);
+        chmod( 0600, $failure_file )
+          or die "Cannot set modes of $failure_file: $!\n";
+      } ## end if ( open( FAILS, ">$failure_file"...
+      push( @$keep_list, $failure_file );
+      debug("now $retries failed uploads");
+      msg(
+           "mail",
+           "The upload will be retried in ",
+           print_time(
+                         $retries == 1
+                       ? $conf::upload_delay_1
+                       : $conf::upload_delay_2
+                     ),
+           "\n"
+         );
+    } ## end else [ if ( ++$retries >= $conf::max_upload_retries)
+    return;
+  } ## end if ( !copy_to_target( ...
+
+  # If the files were uploaded ok, remove them
+  rm( $changes, @filenames, $failure_file );
+
+  msg( "mail", "$changes uploaded successfully to $conf::target\n" );
+  msg( "mail", "along with the files:\n  ", join( "\n  ", @filenames ),
+       "\n" );
+  msg( "log",
+       "$changes processed successfully (uploader $main::mail_addr)\n" );
+
+  # Check for files that have the same stem as the .changes (and weren't
+  # mentioned there) and delete them. It happens often enough that people
+  # upload a .orig.tar.gz where it isn't needed and also not in the
+  # .changes. Explicitly deleting it (and not waiting for the
+  # $stray_remove_timeout) reduces clutter in the queue dir and maybe also
+  # educates uploaders :-)
+
+  #    my $pattern = debian_file_stem( $changes );
+  #    my $spattern = substr( $pattern, 0, -1 ); # strip off '*' at end
+  #    my @other_files = glob($pattern);
+  # filter out files that have a Debian revision at all and a different
+  # revision. Those belong to a different upload.
+  #    if ($changes =~ /^\Q$spattern\E-([\d.+-]+)/) {
+  #            my $this_rev = $1;
+  #            @other_files = grep( !/^\Q$spattern\E-([\d.+-]+)/ || $1 eq $this_rev,
+  #                                                     @other_files);
+  #}
+  # Also do not remove those files if a .changes is among them. Then there
+  # is probably a second upload for another version or another architecture.
+  #    if (@other_files && !grep( /\.changes$/, @other_files )) {
+  #            rm( @other_files );
+  #            msg( "mail", "\nThe following file(s) seemed to belong to the same ".
+  #                                     "upload, but weren't listed\n" );
+  #            msg( "mail", "in the .changes file:\n  " );
+  #            msg( "mail", join( "\n  ", @other_files ), "\n" );
+  #            msg( "mail", "They have been deleted.\n" );
+  #            msg( "log", "Deleted files in upload not in $changes: @other_files\n" );
+  #}
+} ## end sub process_changes($\@)
 
 #
 # process one .commands file
 #
 sub process_commands($) {
-       my $commands = shift;
-       my( @cmds, $cmd, $pgplines, $signator );
-       local( *COMMANDS );
-       my( @files, $file, @removed, $target_delay );
-       
-       format_status_str( $main::current_changes, $commands );
-       $main::dstat = "c";
-       write_status_file() if $conf::statusdelay;
-       
-       msg( "log", "processing $main::current_incoming_short/$commands\n" );
-
-       # parse the .commands file
-       if (!open( COMMANDS, "<$commands" )) {
-               msg( "log", "Cannot open $main::current_incoming_short/$commands: $!\n" );
-               return;
-       }
-       $pgplines = 0;
-       $main::mail_addr = "";
-       @cmds = ();
-       outer_loop: while( <COMMANDS> ) {
-               if (/^---+(BEGIN|END) PGP .*---+$/) {
-                       ++$pgplines;
-               }
-               elsif (/^Uploader:\s*/i) {
-                       chomp( $main::mail_addr = $' );
-                       $main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
-               }
-               elsif (/^Commands:/i) {
-                       $_ = $';
-                       for(;;) {
-                               s/^\s*(.*)\s*$/$1/; # delete whitespace at both ends
-                               if (!/^\s*$/) {
-                                       push( @cmds, $_ );
-                                       debug( "includes cmd $_" );
-                               }
-                               last outer_loop if !defined( $_ = scalar(<COMMANDS>) );
-                               chomp;
-                               redo outer_loop if !/^\s/ || /^$/;
-                       }
-               }
-       }
-       close( COMMANDS );
-       
-       # some consistency checks
-       if (!$main::mail_addr || $main::mail_addr !~ /^\S+\@\S+\.\S+/) {
-               msg( "log,mail", "$main::current_incoming_short/$commands contains no or bad Uploader: field: ".
-                                                "$main::mail_addr\n" );
-               msg( "log,mail", "cannot process $main::current_incoming_short/$commands\n" );
-               $main::mail_addr = "";
-               goto remove;
-       }
-       msg( "log", "(command uploader $main::mail_addr)\n" );
-
-       if ($pgplines < 3) {
-               msg( "log,mail", "$main::current_incoming_short/$commands isn't signed with PGP/GnuPG\n" );
-               msg( "mail", "or the uploaded file is broken. Make sure to transfer in binary mode\n" );
-               msg( "mail", "or better yet - use dcut for commands files\n");
-               goto remove;
-       }
-       
-       # run PGP on the file to check the signature
-       if (!($signator = pgp_check( $commands ))) {
-               msg( "log,mail", "$main::current_incoming_short/$commands has bad PGP/GnuPG signature!\n" );
-         remove:
-               msg( "log,mail", "Removing $main::current_incoming_short/$commands\n" );
-               rm( $commands );
-               return;
-       }
-       elsif ($signator eq "LOCAL ERROR") {
-               # An error has appened when starting pgp... Don't process the file,
-               # but also don't delete it
-               debug( "Can't PGP/GnuPG check $main::current_incoming_short/$commands -- don't process it for now" );
-               return;
-       }
-       msg( "log", "(PGP/GnuPG signature by $signator)\n" );
-
-       # now process commands
-       msg( "mail", "Log of processing your commands file $main::current_incoming_short/$commands:\n\n" );
-       foreach $cmd ( @cmds ) {
-               my @word = split( /\s+/, $cmd );
-               msg( "mail,log", "> @word\n" );
-        my $selecteddelayed = -1;
-               next if @word < 1;
-
-               if ($word[0] eq "rm") {
-                       foreach ( @word[1..$#word] ) {
-                               my $origword = $_;
-                               if (m,^DELAYED/([0-9]+)-day/,) {
-                                       $selecteddelayed = $1;
-                    s,^DELAYED/[0-9]+-day/,,;
-                               }
-                               if ($origword eq "--searchdirs") {
-                                       $selecteddelayed = -2;
-                               }
-                               elsif (m,/,) {
-                                       msg( "mail,log", "$_: filename may not contain slashes except for DELAYED/#-day/ prefixes\n" );
-                               }
-                               else {
-                                       # process wildcards but also plain names
-                                       my (@thesefiles);
-                                       my $pat = quotemeta($_);
-                                       $pat =~ s/\\\*/.*/g;
-                                       $pat =~ s/\\\?/.?/g;
-                                       $pat =~ s/\\([][])/$1/g;
-
-                                       if ( $selecteddelayed < 0) { # scanning or explicitly incoming
-                                               opendir( DIR, "." );
-                                               push (@thesefiles, grep /^$pat$/, readdir(DIR) );
-                                               closedir( DIR );
-                                       }
-                                       if ( $selecteddelayed >= 0) {
-                                               my $dir = sprintf( $conf::incoming_delayed, $selecteddelayed );
-                                               opendir( DIR, $dir );
-                                               push( @thesefiles, map ("$dir/$_", grep /^$pat$/, readdir(DIR) ));
-                                               closedir( DIR );
-                                       }
-                                       elsif ( $selecteddelayed == -2) {
-                                               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 );
-                                               }
-                                       }
-                                       push (@files, @thesefiles);
-                                       if (! @thesefiles) {
-                                               msg( "mail,log", "$origword did not match anything\n" );
-                                       }
-                               }
-                       }
-                       if (!@files) {
-                               msg( "mail,log", "No files to delete\n" );
-                       }
-                       else {
-                               @removed = ();
-                               foreach $file ( @files ) {
-                                       if (!-f $file) {
-                                               msg( "mail,log", "$file: no such file\n" );
-                                       }
-                                       elsif ($file =~ /$conf::keep_files/) {
-                                               msg( "mail,log", "$file is protected, cannot ".
-                                                        "remove\n" );
-                                       }
-                                       elsif (!unlink( $file )) {
-                                               msg( "mail,log", "$file: rm: $!\n" );
-                                       }
-                                       else {
-                        $file =~ s,$conf::incoming/?,,;
-                                               push( @removed, $file );
-                                       }
-                               }
-                               msg( "mail,log", "Files removed: @removed\n" ) if @removed;
-                       }
-               }
-               elsif ($word[0] eq "reschedule") {
-                       if (@word != 3) {
-                               msg( "mail,log", "Wrong number of arguments\n" );
-                       }
-                       elsif ($conf::upload_method ne "copy") {
-                               msg( "mail,log", "reschedule not available\n" );
-                       }
-                       elsif ($word[1] =~ m,/, || $word[1] !~ m/\.changes/) {
-                               msg( "mail,log", "$word[1]: filename may not contain slashes and must be .changes\n" );
-                       }
-                       elsif (! (($target_delay) = $word[2] =~ m,^([0-9]+)-day$,) || $target_delay > $conf::max_delayed) {
-                               msg( "mail,log", "$word[2]: rescheduling target must be #-day with # between 0 and $conf::max_delayed (in particular, no '/' allowed)\n");
-                       }
-                       elsif ($word[1] =~ /$conf::keep_files/) {
-                               msg( "mail,log", "$word[1] is protected, cannot do stuff with it\n" );
-                       }
-                       else {
-                               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 {
-                                       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 ($afile =~ m/\.changes$/) {
-                                                       utime undef,undef,("$dir/$afile");
-                                               }
-                                               if (! rename "$dir/$afile","$target_dir/$afile") {
-                                                       msg( "mail,log", "rename: $!\n" );
-                                               }
-                                               else {
-                                                       msg( "mail,log", "$afile moved to $target_delay-day\n" );
-                                               }
-                                       }
-                               }
-                       }
-               }
-               elsif ($word[0] eq "cancel") {
-                       if (@word != 2) {
-                               msg( "mail,log", "Wrong number of arguments\n" );
-                       }
-                       elsif ($conf::upload_method ne "copy") {
-                               msg( "mail,log", "cancel not available\n" );
-                       }
-                       elsif ($word[1] !~ m,^[a-zA-Z0-9.+_:@=%-][~a-zA-Z0-9.+_:@=%-]*\.changes$,) {
-                               msg( "mail,log", "argument to cancel must be one .changes filename without path\n" );
-                       }
-                   my (@files) = ();
-                       for ( my($adelay)=0; $adelay <= $conf::max_delayed; $adelay++ ) {
-                               my($dir) = sprintf( "$conf::targetdir_delayed",$adelay );
-                               if (-f "$dir/$word[1]") {
-                                       @removed = ();
-                                       push (@files, "$word[1]");
-                                       push (@files,get_filelist_from_known_good_changes("$dir/$word[1]"));
-                                       foreach $file ( @files ) {
-                                               if (!-f "$dir/$file") {
-                                                       msg( "mail,log", "$dir/$file: no such file\n" );
-                                               }
-                                               elsif ("$dir/$file" =~ /$conf::keep_files/) {
-                                                       msg( "mail,log", "$dir/$file is protected, cannot ".
-                                                                "remove\n" );
-                                               }
-                                               elsif (!unlink( "$dir/$file" )) {
-                                                       msg( "mail,log", "$dir/$file: rm: $!\n" );
-                                               }
-                                               else {
-                                                       push( @removed, $file );
-                                               }
-                                       }
-                                   msg( "mail,log", "Files removed from $adelay-day: @removed\n" ) if @removed;
-                               }
-                       }
-                       if (!@files) {
-                               msg( "mail,log", "No upload found: $word[1]\n" );
-                       }
-               }
-               else {
-                       msg( "mail,log", "unknown command $word[0]\n" );
-               }
-       }
-       rm( $commands );
-       msg( "log", "-- End of $main::current_incoming_short/$commands processing\n" );
-}
+  my $commands = shift;
+  my ( @cmds, $cmd, $pgplines, $signator );
+  local (*COMMANDS);
+  my ( @files, $file, @removed, $target_delay );
+
+  format_status_str( $main::current_changes, $commands );
+  $main::dstat = "c";
+  write_status_file() if $conf::statusdelay;
+
+  msg( "log", "processing $main::current_incoming_short/$commands\n" );
+
+  # parse the .commands file
+  if ( !open( COMMANDS, "<$commands" ) ) {
+    msg( "log", "Cannot open $main::current_incoming_short/$commands: $!\n" );
+    return;
+  }
+  $pgplines        = 0;
+  $main::mail_addr = "";
+  @cmds            = ();
+outer_loop: while (<COMMANDS>) {
+    if (/^---+(BEGIN|END) PGP .*---+$/) {
+      ++$pgplines;
+    } elsif (/^Uploader:\s*/i) {
+      chomp( $main::mail_addr = $' );
+      $main::mail_addr = $1 if $main::mail_addr =~ /<([^>]*)>/;
+    } elsif (/^Commands:/i) {
+      $_ = $';
+      for ( ; ; ) {
+        s/^\s*(.*)\s*$/$1/;    # delete whitespace at both ends
+        if ( !/^\s*$/ ) {
+          push( @cmds, $_ );
+          debug("includes cmd $_");
+        }
+        last outer_loop if !defined( $_ = scalar(<COMMANDS>) );
+        chomp;
+        redo outer_loop if !/^\s/ || /^$/;
+      } ## end for ( ; ; )
+    } ## end elsif (/^Commands:/i)
+  } ## end while (<COMMANDS>)
+  close(COMMANDS);
+
+  # some consistency checks
+  if ( !$main::mail_addr || $main::mail_addr !~ /^\S+\@\S+\.\S+/ ) {
+    msg( "log,mail",
+"$main::current_incoming_short/$commands contains no or bad Uploader: field: "
+        . "$main::mail_addr\n" );
+    msg( "log,mail",
+         "cannot process $main::current_incoming_short/$commands\n" );
+    $main::mail_addr = "";
+    goto remove;
+  } ## end if ( !$main::mail_addr...
+  msg( "log", "(command uploader $main::mail_addr)\n" );
+
+  if ( $pgplines < 3 ) {
+    msg(
+       "log,mail",
+       "$main::current_incoming_short/$commands isn't signed with PGP/GnuPG\n"
+    );
+    msg(
+      "mail",
+      "or the uploaded file is broken. Make sure to transfer in binary mode\n"
+    );
+    msg( "mail", "or better yet - use dcut for commands files\n" );
+    goto remove;
+  } ## end if ( $pgplines < 3 )
+
+  # run PGP on the file to check the signature
+  if ( !( $signator = pgp_check($commands) ) ) {
+    msg(
+      "log,mail",
+      "$main::current_incoming_short/$commands has bad PGP/GnuPG signature!\n"
+    );
+  remove:
+    msg( "log,mail", "Removing $main::current_incoming_short/$commands\n" );
+    rm($commands);
+    return;
+  } elsif ( $signator eq "LOCAL ERROR" ) {
+
+    # An error has appened when starting pgp... Don't process the file,
+    # but also don't delete it
+    debug(
+"Can't PGP/GnuPG check $main::current_incoming_short/$commands -- don't process it for now"
+    );
+    return;
+  } ## end elsif ( $signator eq "LOCAL ERROR")
+  msg( "log", "(PGP/GnuPG signature by $signator)\n" );
+
+  # now process commands
+  msg(
+    "mail",
+"Log of processing your commands file $main::current_incoming_short/$commands:\n\n"
+  );
+  foreach $cmd (@cmds) {
+    my @word = split( /\s+/, $cmd );
+    msg( "mail,log", "> @word\n" );
+    my $selecteddelayed = -1;
+    next if @word < 1;
+
+    if ( $word[0] eq "rm" ) {
+      foreach ( @word[ 1 .. $#word ] ) {
+        my $origword = $_;
+        if (m,^DELAYED/([0-9]+)-day/,) {
+          $selecteddelayed = $1;
+          s,^DELAYED/[0-9]+-day/,,;
+        }
+        if ( $origword eq "--searchdirs" ) {
+          $selecteddelayed = -2;
+        } elsif (m,/,) {
+          msg(
+            "mail,log",
+"$_: filename may not contain slashes except for DELAYED/#-day/ prefixes\n"
+          );
+        } else {
+
+          # process wildcards but also plain names
+          my (@thesefiles);
+          my $pat = quotemeta($_);
+          $pat =~ s/\\\*/.*/g;
+          $pat =~ s/\\\?/.?/g;
+          $pat =~ s/\\([][])/$1/g;
+
+          if ( $selecteddelayed < 0 ) {    # scanning or explicitly incoming
+            opendir( DIR, "." );
+            push( @thesefiles, grep /^$pat$/, readdir(DIR) );
+            closedir(DIR);
+          }
+          if ( $selecteddelayed >= 0 ) {
+            my $dir = sprintf( $conf::incoming_delayed, $selecteddelayed );
+            opendir( DIR, $dir );
+            push( @thesefiles,
+                  map ( "$dir/$_", grep /^$pat$/, readdir(DIR) ) );
+            closedir(DIR);
+          } elsif ( $selecteddelayed == -2 ) {
+            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);
+            } ## end for ( my ($adelay) = 0 ...
+          } ## end elsif ( $selecteddelayed ...
+          push( @files, @thesefiles );
+          if ( !@thesefiles ) {
+            msg( "mail,log", "$origword did not match anything\n" );
+          }
+        } ## end else [ if ( $origword eq "--searchdirs")
+      } ## end foreach ( @word[ 1 .. $#word...
+      if ( !@files ) {
+        msg( "mail,log", "No files to delete\n" );
+      } else {
+        @removed = ();
+        foreach $file (@files) {
+          if ( !-f $file ) {
+            msg( "mail,log", "$file: no such file\n" );
+          } elsif ( $file =~ /$conf::keep_files/ ) {
+            msg( "mail,log", "$file is protected, cannot " . "remove\n" );
+          } elsif ( !unlink($file) ) {
+            msg( "mail,log", "$file: rm: $!\n" );
+          } else {
+            $file =~ s,$conf::incoming/?,,;
+            push( @removed, $file );
+          }
+        } ## end foreach $file (@files)
+        msg( "mail,log", "Files removed: @removed\n" ) if @removed;
+      } ## end else [ if ( !@files )
+    } elsif ( $word[0] eq "reschedule" ) {
+      if ( @word != 3 ) {
+        msg( "mail,log", "Wrong number of arguments\n" );
+      } elsif ( $conf::upload_method ne "copy" ) {
+        msg( "mail,log", "reschedule not available\n" );
+      } elsif ( $word[1] =~ m,/, || $word[1] !~ m/\.changes/ ) {
+        msg(
+           "mail,log",
+           "$word[1]: filename may not contain slashes and must be .changes\n"
+        );
+      } elsif ( !( ($target_delay) = $word[2] =~ m,^([0-9]+)-day$, )
+                || $target_delay > $conf::max_delayed )
+      {
+        msg(
+          "mail,log",
+"$word[2]: rescheduling target must be #-day with # between 0 and $conf::max_delayed (in particular, no '/' allowed)\n"
+        );
+      } elsif ( $word[1] =~ /$conf::keep_files/ ) {
+        msg( "mail,log", "$word[1] is protected, cannot do stuff with it\n" );
+      } else {
+        my ($adelay);
+        for ( $adelay = 0 ;
+            $adelay <= $conf::max_delayed
+            && !-f (
+              sprintf( "$conf::targetdir_delayed", $adelay ) . "/$word[1]" ) ;
+            $adelay++ )
+        {
+        } ## end for ( $adelay = 0 ; $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 {
+          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 ( $afile =~ m/\.changes$/ ) {
+              utime undef, undef, ("$dir/$afile");
+            }
+            if ( !rename "$dir/$afile", "$target_dir/$afile" ) {
+              msg( "mail,log", "rename: $!\n" );
+            } else {
+              msg( "mail,log", "$afile moved to $target_delay-day\n" );
+            }
+          } ## end for my $afile (@thesefiles)
+        } ## end else [ if ( $adelay > $conf::max_delayed)
+      } ## end else [ if ( @word != 3 )
+    } elsif ( $word[0] eq "cancel" ) {
+      if ( @word != 2 ) {
+        msg( "mail,log", "Wrong number of arguments\n" );
+      } elsif ( $conf::upload_method ne "copy" ) {
+        msg( "mail,log", "cancel not available\n" );
+      } elsif (
+          $word[1] !~ m,^[a-zA-Z0-9.+_:@=%-][~a-zA-Z0-9.+_:@=%-]*\.changes$, )
+      {
+        msg( "mail,log",
+          "argument to cancel must be one .changes filename without path\n" );
+      } ## end elsif ( $word[1] !~ ...
+      my (@files) = ();
+      for ( my ($adelay) = 0 ; $adelay <= $conf::max_delayed ; $adelay++ ) {
+        my ($dir) = sprintf( "$conf::targetdir_delayed", $adelay );
+        if ( -f "$dir/$word[1]" ) {
+          @removed = ();
+          push( @files, "$word[1]" );
+          push( @files,
+                get_filelist_from_known_good_changes("$dir/$word[1]") );
+          foreach $file (@files) {
+            if ( !-f "$dir/$file" ) {
+              msg( "mail,log", "$dir/$file: no such file\n" );
+            } elsif ( "$dir/$file" =~ /$conf::keep_files/ ) {
+              msg( "mail,log",
+                   "$dir/$file is protected, cannot " . "remove\n" );
+            } elsif ( !unlink("$dir/$file") ) {
+              msg( "mail,log", "$dir/$file: rm: $!\n" );
+            } else {
+              push( @removed, $file );
+            }
+          } ## end foreach $file (@files)
+          msg( "mail,log", "Files removed from $adelay-day: @removed\n" )
+            if @removed;
+        } ## end if ( -f "$dir/$word[1]")
+      } ## end for ( my ($adelay) = 0 ...
+      if ( !@files ) {
+        msg( "mail,log", "No upload found: $word[1]\n" );
+      }
+    } else {
+      msg( "mail,log", "unknown command $word[0]\n" );
+    }
+  } ## end foreach $cmd (@cmds)
+  rm($commands);
+  msg( "log",
+       "-- End of $main::current_incoming_short/$commands processing\n" );
+} ## end sub process_commands($)
 
 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 || $adelay==0) {
-                               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" );
-                                       }
-                               }
-                       }
-               }
-       }
-}
+  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 || $adelay == 0 ) {
+        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" );
+          }
+        } ## end for my $afile (@thesefiles)
+      } ## end if ( $mtime + 24 * 60 ...
+    } ## end for my $achanges (<$dir/*.changes>)
+  } ## end for ( my ($adelay) = 0 ...
+} ## end sub age_delayed_queues()
 
 #
 # check if a file is already 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" );
-       }
-       elsif ($conf::upload_method eq "ftp") {
-               my $err;
-               ($msg, $err) = ftp_cmd( "dir", $file );
-               if ($err) {
-                       $stat = 1;
-                       $msg = $err;
-               }
-               elsif (!$msg) {
-                       $stat = 1;
-                       $msg = "ls: no such file\n";
-               }
-               else {
-                       $stat = 0;
-                       $msg = join( "\n", @$msg );
-               }
-       }
-       else {
-               my @allfiles = ($file);
-               push ( @allfiles, @$filelist);
-               $stat = 1;
-               $msg = "no such file";
-               for my $afile(@allfiles) {
-                       if (-f "$conf::targetdir/$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" );
-
-       return "" if $stat && $msg =~ /no such file/i; # file not present
-       msg( "log", "strange ls -l output on target:\n", $msg ), return ""
-               if $stat || $@; # some other error, but still try to upload
-
-       # ls -l returned 0 -> file already there
-       $msg =~ s/\s\s+/ /g; # make multiple spaces into one, to save space
-       return $msg;
-}
+  my $file     = shift;
+  my $filelist = shift;
+  my $msg;
+  my $stat;
+
+  if ( $conf::upload_method eq "ssh" ) {
+    ( $msg, $stat ) = ssh_cmd("ls -l $file");
+  } elsif ( $conf::upload_method eq "ftp" ) {
+    my $err;
+    ( $msg, $err ) = ftp_cmd( "dir", $file );
+    if ($err) {
+      $stat = 1;
+      $msg  = $err;
+    } elsif ( !$msg ) {
+      $stat = 1;
+      $msg  = "ls: no such file\n";
+    } else {
+      $stat = 0;
+      $msg = join( "\n", @$msg );
+    }
+  } else {
+    my @allfiles = ($file);
+    push( @allfiles, @$filelist );
+    $stat = 1;
+    $msg  = "no such file";
+    for my $afile (@allfiles) {
+      if ( -f "$conf::targetdir/$afile" ) {
+        $stat = 0;
+        $msg  = "$afile";
+      }
+    } ## end for my $afile (@allfiles)
+    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";
+        } ## end if ( -f ( sprintf( "$conf::targetdir_delayed"...
+      } ## end for my $afile (@allfiles)
+    } ## end for ( my ($adelay) = 0 ...
+  } ## end else [ if ( $conf::upload_method...
+  chomp($msg);
+  debug("exit status: $stat, output was: $msg");
+
+  return "" if $stat && $msg =~ /no such file/i;    # file not present
+  msg( "log", "strange ls -l output on target:\n", $msg ), return ""
+    if $stat || $@;    # some other error, but still try to upload
+
+  # ls -l returned 0 -> file already there
+  $msg =~ s/\s\s+/ /g;    # make multiple spaces into one, to save space
+  return $msg;
+} ## end sub is_on_target($\@)
 
 #
 # copy a list of files to target
 #
 sub copy_to_target(@) {
-       my @files = @_;
-       my( @md5sum, @expected_files, $sum, $name, $msgs, $stat );
-       
-       $main::dstat = "u";
-       write_status_file() if $conf::statusdelay;
-
-       # copy the files
-       if ($conf::upload_method eq "ssh") {
-               ($msgs, $stat) = scp_cmd( @files );
-               goto err if $stat;
-       }
-       elsif ($conf::upload_method eq "ftp") {
-               my($rv, $file);
-               if (!$main::FTP_chan->cwd( $main::current_targetdir )) {
-                       msg( "log,mail", "Can't cd to $main::current_targetdir on $conf::target\n" );
-                       goto err;
-               }
-               foreach $file (@files) {
-                       ($rv, $msgs) = ftp_cmd( "put", $file );
-                       goto err if !$rv;
-               }
-       }
-       else {
-               ($msgs, $stat) = local_cmd( "$conf::cp @files $main::current_targetdir", 'NOCD' );
-               goto err if $stat;
-       }
-       
-       # check md5sums or sizes on target against our own
-       my $have_md5sums = 1;
-       if ($conf::upload_method eq "ssh") {
-               ($msgs, $stat) = ssh_cmd( "md5sum @files" );
-               goto err if $stat;
-               @md5sum = split( "\n", $msgs );
-       }
-       elsif ($conf::upload_method eq "ftp") {
-               my ($rv, $err, $file);
-               foreach $file (@files) {
-                       ($rv, $err) = ftp_cmd( "quot", "site", "md5sum", $file );
-                       if ($err) {
-                               next if ftp_code() == 550; # file not found
-                               if (ftp_code() == 500) { # unimplemented
-                                       $have_md5sums = 0;
-                                       goto get_sizes_instead;
-                               }
-                               $msgs = $err;
-                               goto err;
-                       }
-                       chomp( my $t = ftp_response() );
-                       push( @md5sum, $t );
-               }
-               if (!$have_md5sums) {
-                 get_sizes_instead:
-                       foreach $file (@files) {
-                               ($rv, $err) = ftp_cmd( "size", $file );
-                               if ($err) {
-                                       next if ftp_code() == 550; # file not found
-                                       $msgs = $err;
-                                       goto err;
-                               }
-                               push( @md5sum, "$rv $file" );
-                       }
-               }
-       }
-       else {
-               ($msgs, $stat) = local_cmd( "$conf::md5sum @files" );
-               goto err if $stat;
-               @md5sum = split( "\n", $msgs );
-       }
-       
-       @expected_files = @files;
-       foreach (@md5sum) {
-               chomp;
-               ($sum,$name) = split;
-               next if !grep { $_ eq $name } @files; # a file we didn't upload??
-               next if $sum eq "md5sum:"; # looks like an error message
-               if (($have_md5sums && $sum ne md5sum( $name )) ||
-                       (!$have_md5sums && $sum != (-s $name))) {
-                       msg( "log,mail", "Upload of $name to $conf::target failed ",
-                                "(".($have_md5sums ? "md5sum" : "size")." mismatch)\n" );
-                       goto err;
-               }
-               # seen that file, remove it from expect list
-               @expected_files = map { $_ eq $name ? () : $_ } @expected_files;
-       }
-       if (@expected_files) {
-               msg( "log,mail", "Failed to upload the files\n" );
-               msg( "log,mail", "  ", join( ", ", @expected_files ), "\n" );
-               msg( "log,mail", "(Not present on target after upload)\n" );
-               goto err;
-       }
-
-       if ($conf::chmod_on_target) {
-               # change file's mode explicitly to 644 on target
-               if ($conf::upload_method eq "ssh") {
-                       ($msgs, $stat) = ssh_cmd( "chmod 644 @files" );
-                       goto err if $stat;
-               }
-               elsif ($conf::upload_method eq "ftp") {
-                       my ($rv, $file);
-                       foreach $file (@files) {
-                               ($rv, $msgs) = ftp_cmd( "quot", "site", "chmod", "644", $file );
-                               msg( "log", "Can't chmod $file on target:\n$msgs" )
-                                       if $msgs;
-                               goto err if !$rv;
-                       }
-               }
-               else {
-                       ($msgs, $stat) = local_cmd( "$conf::chmod 644 @files" );
-                       goto err if $stat;
-               }
-       }
-
-       $main::dstat = "c";
-       write_status_file() if $conf::statusdelay;
-       return 1;
-       
-  err:
-       msg( "log,mail", "Upload to $conf::target failed",
-                $? ? ", last exit status ".sprintf( "%s", $?>>8 ) : "", "\n" );
-       msg( "log,mail", "Error messages:\n", $msgs )
-               if $msgs;
-
-       # If "permission denied" was among the errors, test if the incoming is
-       # writable at all.
-       if ($msgs =~ /(permission denied|read-?only file)/i) {
-               if (!check_incoming_writable()) {
-                       msg( "log,mail", "(The incoming directory seems to be ",
-                                            "unwritable.)\n" );
-               }
-       }
-
-       # remove bad files or an incomplete upload on target
-       if ($conf::upload_method eq "ssh") {
-               ssh_cmd( "rm -f @files" );
-       }
-       elsif ($conf::upload_method eq "ftp") {
-               my $file;
-               foreach $file (@files) {
-                       my ($rv, $err);
-                       ($rv, $err) = ftp_cmd( "delete", $file );
-                       msg( "log", "Can't delete $file on target:\n$err" )
-                               if $err;
-               }
-       }
-       else {
-               my @tfiles = map { "$main::current_targetdir/$_" } @files;
-               debug( "executing unlink(@tfiles)" );
-               rm( @tfiles );
-       }
-       $main::dstat = "c";
-       write_status_file() if $conf::statusdelay;
-       return 0;
-}
+  my @files = @_;
+  my ( @md5sum, @expected_files, $sum, $name, $msgs, $stat );
+
+  $main::dstat = "u";
+  write_status_file() if $conf::statusdelay;
+
+  # copy the files
+  if ( $conf::upload_method eq "ssh" ) {
+    ( $msgs, $stat ) = scp_cmd(@files);
+    goto err if $stat;
+  } elsif ( $conf::upload_method eq "ftp" ) {
+    my ( $rv, $file );
+    if ( !$main::FTP_chan->cwd($main::current_targetdir) ) {
+      msg( "log,mail",
+           "Can't cd to $main::current_targetdir on $conf::target\n" );
+      goto err;
+    }
+    foreach $file (@files) {
+      ( $rv, $msgs ) = ftp_cmd( "put", $file );
+      goto err if !$rv;
+    }
+  } else {
+    ( $msgs, $stat ) =
+      local_cmd( "$conf::cp @files $main::current_targetdir", 'NOCD' );
+    goto err if $stat;
+  }
+
+  # check md5sums or sizes on target against our own
+  my $have_md5sums = 1;
+  if ( $conf::upload_method eq "ssh" ) {
+    ( $msgs, $stat ) = ssh_cmd("md5sum @files");
+    goto err if $stat;
+    @md5sum = split( "\n", $msgs );
+  } elsif ( $conf::upload_method eq "ftp" ) {
+    my ( $rv, $err, $file );
+    foreach $file (@files) {
+      ( $rv, $err ) = ftp_cmd( "quot", "site", "md5sum", $file );
+      if ($err) {
+        next if ftp_code() == 550;    # file not found
+        if ( ftp_code() == 500 ) {    # unimplemented
+          $have_md5sums = 0;
+          goto get_sizes_instead;
+        }
+        $msgs = $err;
+        goto err;
+      } ## end if ($err)
+      chomp( my $t = ftp_response() );
+      push( @md5sum, $t );
+    } ## end foreach $file (@files)
+    if ( !$have_md5sums ) {
+    get_sizes_instead:
+      foreach $file (@files) {
+        ( $rv, $err ) = ftp_cmd( "size", $file );
+        if ($err) {
+          next if ftp_code() == 550;    # file not found
+          $msgs = $err;
+          goto err;
+        }
+        push( @md5sum, "$rv $file" );
+      } ## end foreach $file (@files)
+    } ## end if ( !$have_md5sums )
+  } else {
+    ( $msgs, $stat ) = local_cmd("$conf::md5sum @files");
+    goto err if $stat;
+    @md5sum = split( "\n", $msgs );
+  }
+
+  @expected_files = @files;
+  foreach (@md5sum) {
+    chomp;
+    ( $sum, $name ) = split;
+    next if !grep { $_ eq $name } @files;    # a file we didn't upload??
+    next if $sum eq "md5sum:";               # looks like an error message
+    if (    ( $have_md5sums && $sum ne md5sum($name) )
+         || ( !$have_md5sums && $sum != ( -s $name ) ) )
+    {
+      msg(
+           "log,mail",
+           "Upload of $name to $conf::target failed ",
+           "(" . ( $have_md5sums ? "md5sum" : "size" ) . " mismatch)\n"
+         );
+      goto err;
+    } ## end if ( ( $have_md5sums &&...
+
+    # seen that file, remove it from expect list
+    @expected_files = map { $_ eq $name ? () : $_ } @expected_files;
+  } ## end foreach (@md5sum)
+  if (@expected_files) {
+    msg( "log,mail", "Failed to upload the files\n" );
+    msg( "log,mail", "  ", join( ", ", @expected_files ), "\n" );
+    msg( "log,mail", "(Not present on target after upload)\n" );
+    goto err;
+  } ## end if (@expected_files)
+
+  if ($conf::chmod_on_target) {
+
+    # change file's mode explicitly to 644 on target
+    if ( $conf::upload_method eq "ssh" ) {
+      ( $msgs, $stat ) = ssh_cmd("chmod 644 @files");
+      goto err if $stat;
+    } elsif ( $conf::upload_method eq "ftp" ) {
+      my ( $rv, $file );
+      foreach $file (@files) {
+        ( $rv, $msgs ) = ftp_cmd( "quot", "site", "chmod", "644", $file );
+        msg( "log", "Can't chmod $file on target:\n$msgs" )
+          if $msgs;
+        goto err if !$rv;
+      } ## end foreach $file (@files)
+    } else {
+      ( $msgs, $stat ) = local_cmd("$conf::chmod 644 @files");
+      goto err if $stat;
+    }
+  } ## end if ($conf::chmod_on_target)
+
+  $main::dstat = "c";
+  write_status_file() if $conf::statusdelay;
+  return 1;
+
+err:
+  msg( "log,mail",
+       "Upload to $conf::target failed",
+       $? ? ", last exit status " . sprintf( "%s", $? >> 8 ) : "", "\n" );
+  msg( "log,mail", "Error messages:\n", $msgs )
+    if $msgs;
+
+  # If "permission denied" was among the errors, test if the incoming is
+  # writable at all.
+  if ( $msgs =~ /(permission denied|read-?only file)/i ) {
+    if ( !check_incoming_writable() ) {
+      msg( "log,mail", "(The incoming directory seems to be ",
+           "unwritable.)\n" );
+    }
+  } ## end if ( $msgs =~ /(permission denied|read-?only file)/i)
+
+  # remove bad files or an incomplete upload on target
+  if ( $conf::upload_method eq "ssh" ) {
+    ssh_cmd("rm -f @files");
+  } elsif ( $conf::upload_method eq "ftp" ) {
+    my $file;
+    foreach $file (@files) {
+      my ( $rv, $err );
+      ( $rv, $err ) = ftp_cmd( "delete", $file );
+      msg( "log", "Can't delete $file on target:\n$err" )
+        if $err;
+    } ## end foreach $file (@files)
+  } else {
+    my @tfiles = map { "$main::current_targetdir/$_" } @files;
+    debug("executing unlink(@tfiles)");
+    rm(@tfiles);
+  }
+  $main::dstat = "c";
+  write_status_file() if $conf::statusdelay;
+  return 0;
+} ## end sub copy_to_target(@)
 
 #
 # check if a file is correctly signed with PGP
 #
 sub pgp_check($) {
-       my $file = shift;
-       my $output = "";
-       my $signator;
-       my $found = 0;
-       my $stat;
-       local( *PIPE );
-
-       $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" );
-                       return "LOCAL ERROR";
-               }
-               $output .= $_ while( <PIPE> );
-               close( PIPE );
-               $stat = $?;
-       }
-
-       if ($stat) {
-               msg( "log,mail", "GnuPG signature check failed on $file\n" );
-               msg( "mail", $output );
-               msg( "log,mail", "(Exit status ", $stat >> 8, ")\n" );
-               return "";
-       }
-
-       $output =~ /^(gpg: )?good signature from (user )?"(.*)"\.?$/im;
-       ($signator = $3) ||= "unknown signator";
-       if ($conf::debug) {
-               debug( "GnuPG signature ok (by $signator)" );
-       }
-       return $signator;
-}
-
+  my $file   = shift;
+  my $output = "";
+  my $signator;
+  my $found = 0;
+  my $stat;
+  local (*PIPE);
+
+  $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" );
+      return "LOCAL ERROR";
+    } ## end if ( !open( PIPE, "$conf::gpg --no-options --batch "...
+    $output .= $_ while (<PIPE>);
+    close(PIPE);
+    $stat = $?;
+  } ## end if ( -x $conf::gpg )
+
+  if ($stat) {
+    msg( "log,mail", "GnuPG signature check failed on $file\n" );
+    msg( "mail",     $output );
+    msg( "log,mail", "(Exit status ", $stat >> 8, ")\n" );
+    return "";
+  } ## end if ($stat)
+
+  $output =~ /^(gpg: )?good signature from (user )?"(.*)"\.?$/im;
+  ( $signator = $3 ) ||= "unknown signator";
+  if ($conf::debug) {
+    debug("GnuPG signature ok (by $signator)");
+  }
+  return $signator;
+} ## end sub pgp_check($)
 
 # ---------------------------------------------------------------------------
 #                                                        the status daemon
@@ -1531,167 +1674,175 @@ sub pgp_check($) {
 
 #
 # fork a subprocess that watches the 'status' FIFO
-# 
+#
 # that process blocks until someone opens the FIFO, then sends a
-# signal (SIGUSR1) to the main process, expects 
+# signal (SIGUSR1) to the main process, expects
 #
 sub fork_statusd() {
-       my $statusd_pid;
-       my $main_pid = $$;
-       my $errs;
-       local( *STATFIFO );
-
-       $statusd_pid = open( STATUSD, "|-" );
-       die "cannot fork: $!\n" if !defined( $statusd_pid );
-       # parent just returns
-       if ($statusd_pid) {
-               msg( "log", "forked status daemon (pid $statusd_pid)\n" );
-               return $statusd_pid;
-       }
-       # child: the status FIFO daemon
-
-       # ignore SIGPIPE here, in case some closes the FIFO without completely
-       # reading it
-       $SIG{"PIPE"} = "IGNORE";
-       # also ignore SIGCLD, we don't want to inherit the restart-statusd handler
-       # from our parent
-       $SIG{"CHLD"} = "DEFAULT";
-       
-       rm( $conf::statusfile );
-       $errs = `$conf::mkfifo $conf::statusfile`;
-       die "$main::progname: cannot create named pipe $conf::statusfile: $errs"
-               if $?;
-       chmod( 0644, $conf::statusfile )
-               or die "Cannot set modes of $conf::statusfile: $!\n";
-
-       # close log file, so that log rotating works
-       close( LOG );
-       close( STDOUT );
-       close( STDERR );
-       
-       while( 1 ) {
-               my( $status, $mup, $incw, $ds, $next_run, $last_ping, $currch, $l );
-
-               # open the FIFO for writing; this blocks until someone (probably ftpd)
-               # opens it for reading
-               open( STATFIFO, ">$conf::statusfile" )
-                       or die "Cannot open $conf::statusfile\n";
-               select( STATFIFO );
-               # tell main daemon to send us status infos
-               kill( $main::signo{"USR1"}, $main_pid );
-
-               # get the infos from stdin; must loop until enough bytes received!
-               my $expect_len = 3 + 2*STATNUM_LEN + STATSTR_LEN;
-               for( $status = ""; ($l = length($status)) < $expect_len; ) {
-                       sysread( STDIN, $status, $expect_len-$l, $l );
-               }
-
-               # disassemble the status byte stream
-               my $pos = 0;
-               foreach ( [ mup => 1 ], [ incw => 1 ], [ ds => 1 ],
-                                 [ next_run => STATNUM_LEN ], [ last_ping => STATNUM_LEN ],
-                                 [ currch => STATSTR_LEN ] ) {
-                       eval "\$$_->[0] = substr( \$status, $pos, $_->[1] );";
-                       $pos += $_->[1];
-               }
-               $currch =~ s/\n+//g;
-
-               print_status( $mup, $incw, $ds, $next_run, $last_ping, $currch );
-               close( STATFIFO );
-
-               # This sleep is necessary so that we can't reopen the FIFO
-               # immediately, in case the reader hasn't closed it yet if we get to
-               # the open again. Is there a better solution for this??
-               sleep 1;
-       }
-}
+  my $statusd_pid;
+  my $main_pid = $$;
+  my $errs;
+  local (*STATFIFO);
+
+  $statusd_pid = open( STATUSD, "|-" );
+  die "cannot fork: $!\n" if !defined($statusd_pid);
+
+  # parent just returns
+  if ($statusd_pid) {
+    msg( "log", "forked status daemon (pid $statusd_pid)\n" );
+    return $statusd_pid;
+  }
+
+  # child: the status FIFO daemon
+
+  # ignore SIGPIPE here, in case some closes the FIFO without completely
+  # reading it
+  $SIG{"PIPE"} = "IGNORE";
+
+  # also ignore SIGCLD, we don't want to inherit the restart-statusd handler
+  # from our parent
+  $SIG{"CHLD"} = "DEFAULT";
+
+  rm($conf::statusfile);
+  $errs = `$conf::mkfifo $conf::statusfile`;
+  die "$main::progname: cannot create named pipe $conf::statusfile: $errs"
+    if $?;
+  chmod( 0644, $conf::statusfile )
+    or die "Cannot set modes of $conf::statusfile: $!\n";
+
+  # close log file, so that log rotating works
+  close(LOG);
+  close(STDOUT);
+  close(STDERR);
+
+  while (1) {
+    my ( $status, $mup, $incw, $ds, $next_run, $last_ping, $currch, $l );
+
+    # open the FIFO for writing; this blocks until someone (probably ftpd)
+    # opens it for reading
+    open( STATFIFO, ">$conf::statusfile" )
+      or die "Cannot open $conf::statusfile\n";
+    select(STATFIFO);
+
+    # tell main daemon to send us status infos
+    kill( $main::signo{"USR1"}, $main_pid );
+
+    # get the infos from stdin; must loop until enough bytes received!
+    my $expect_len = 3 + 2 * STATNUM_LEN + STATSTR_LEN;
+    for ( $status = "" ; ( $l = length($status) ) < $expect_len ; ) {
+      sysread( STDIN, $status, $expect_len - $l, $l );
+    }
+
+    # disassemble the status byte stream
+    my $pos = 0;
+    foreach (
+              [ mup       => 1 ],
+              [ incw      => 1 ],
+              [ ds        => 1 ],
+              [ next_run  => STATNUM_LEN ],
+              [ last_ping => STATNUM_LEN ],
+              [ currch    => STATSTR_LEN ]
+            )
+    {
+      eval "\$$_->[0] = substr( \$status, $pos, $_->[1] );";
+      $pos += $_->[1];
+    } ## end foreach ( [ mup => 1 ], [ incw...
+    $currch =~ s/\n+//g;
+
+    print_status( $mup, $incw, $ds, $next_run, $last_ping, $currch );
+    close(STATFIFO);
+
+    # This sleep is necessary so that we can't reopen the FIFO
+    # immediately, in case the reader hasn't closed it yet if we get to
+    # the open again. Is there a better solution for this??
+    sleep 1;
+  } ## end while (1)
+} ## end sub fork_statusd()
 
 #
 # update the status file, in case we use a plain file and not a FIFO
 #
 sub write_status_file() {
 
-       return if !$conf::statusfile;
-       
-       open( STATFILE, ">$conf::statusfile" ) or
-               (msg( "log", "Could not open $conf::statusfile: $!\n" ), return);
-       my $oldsel = select( STATFILE );
+  return if !$conf::statusfile;
 
-       print_status( $main::target_up, $main::incoming_writable, $main::dstat,
-                                 $main::next_run, $main::last_ping_time,
-                                 $main::current_changes );
+  open( STATFILE, ">$conf::statusfile" )
+    or ( msg( "log", "Could not open $conf::statusfile: $!\n" ), return );
+  my $oldsel = select(STATFILE);
 
-       select( $oldsel );
-       close( STATFILE );
-}
+  print_status(
+                $main::target_up,      $main::incoming_writable,
+                $main::dstat,          $main::next_run,
+                $main::last_ping_time, $main::current_changes
+              );
+
+  select($oldsel);
+  close(STATFILE);
+} ## end sub write_status_file()
 
 sub print_status($$$$$$) {
-       my $mup = shift;
-       my $incw = shift;
-       my $ds = shift;
-       my $next_run = shift;
-       my $last_ping = shift;
-       my $currch = shift;
-       my $approx;
-       my $version;
-
-       ($version = 'Release: 0.9 $Revision: 1.51 $') =~ s/\$ ?//g;
-       print "debianqueued $version\n";
-       
-       $approx = $conf::statusdelay ? "approx. " : "";
-       
-       if ($mup eq "0") {
-               print "$conf::target is down, queue pausing\n";
-               return;
-       }
-       elsif ($conf::upload_method ne "copy") {
-               print "$conf::target seems to be up, last ping $approx",
-                         print_time(time-$last_ping), " ago\n";
-       }
-
-       if ($incw eq "0") {
-               print "The incoming directory is not writable, queue pausing\n";
-               return;
-       }
-       
-       if ($ds eq "i") {
-               print "Next queue check in $approx",print_time($next_run-time),"\n";
-               return;
-       }
-       elsif ($ds eq "c") {
-               print "Checking queue directory\n";
-       }
-       elsif ($ds eq "u") {
-               print "Uploading to $conf::target\n";
-       }
-       else {
-               print "Bad status data from daemon: \"$mup$incw$ds\"\n";
-               return;
-       }
-       
-       print "Current job is $currch\n" if $currch;
-}              
+  my $mup       = shift;
+  my $incw      = shift;
+  my $ds        = shift;
+  my $next_run  = shift;
+  my $last_ping = shift;
+  my $currch    = shift;
+  my $approx;
+  my $version;
+
+  ( $version = 'Release: 0.9 $Revision: 1.51 $' ) =~ s/\$ ?//g;
+  print "debianqueued $version\n";
+
+  $approx = $conf::statusdelay ? "approx. " : "";
+
+  if ( $mup eq "0" ) {
+    print "$conf::target is down, queue pausing\n";
+    return;
+  } elsif ( $conf::upload_method ne "copy" ) {
+    print "$conf::target seems to be up, last ping $approx",
+      print_time( time - $last_ping ), " ago\n";
+  }
+
+  if ( $incw eq "0" ) {
+    print "The incoming directory is not writable, queue pausing\n";
+    return;
+  }
+
+  if ( $ds eq "i" ) {
+    print "Next queue check in $approx", print_time( $next_run - time ), "\n";
+    return;
+  } elsif ( $ds eq "c" ) {
+    print "Checking queue directory\n";
+  } elsif ( $ds eq "u" ) {
+    print "Uploading to $conf::target\n";
+  } else {
+    print "Bad status data from daemon: \"$mup$incw$ds\"\n";
+    return;
+  }
+
+  print "Current job is $currch\n" if $currch;
+} ## end sub print_status($$$$$$)
 
 #
 # format a number for sending to statusd (fixed length STATNUM_LEN)
 #
 sub format_status_num(\$$) {
-       my $varref = shift;
-       my $num = shift;
-       
-       $$varref = sprintf "%".STATNUM_LEN."d", $num;
-}
+  my $varref = shift;
+  my $num    = shift;
+
+  $$varref = sprintf "%" . STATNUM_LEN . "d", $num;
+} ## end sub format_status_num(\$$)
 
 #
 # format a string for sending to statusd (fixed length STATSTR_LEN)
 #
 sub format_status_str(\$$) {
-       my $varref = shift;
-       my $str = shift;
+  my $varref = shift;
+  my $str    = shift;
 
-       $$varref = substr( $str, 0, STATSTR_LEN );
-       $$varref .= "\n" x (STATSTR_LEN - length($$varref));
-}
+  $$varref = substr( $str, 0, STATSTR_LEN );
+  $$varref .= "\n" x ( STATSTR_LEN - length($$varref) );
+} ## end sub format_status_str(\$$)
 
 #
 # send a status string to the status daemon
@@ -1701,19 +1852,18 @@ sub format_status_str(\$$) {
 # signal handler. So use only already-defined variables.
 #
 sub send_status() {
-    local $! = 0; # preserve errno
-       
-       # re-setup handler, in case we have broken SysV signals
-       $SIG{"USR1"} = \&send_status;
-
-       syswrite( STATUSD, $main::target_up, 1 );
-       syswrite( STATUSD, $main::incoming_writable, 1 );
-       syswrite( STATUSD, $main::dstat, 1 );
-       syswrite( STATUSD, $main::next_run, STATNUM_LEN );
-       syswrite( STATUSD, $main::last_ping_time, STATNUM_LEN );
-       syswrite( STATUSD, $main::current_changes, STATSTR_LEN );
-}
+  local $! = 0;    # preserve errno
+
+  # re-setup handler, in case we have broken SysV signals
+  $SIG{"USR1"} = \&send_status;
 
+  syswrite( STATUSD, $main::target_up,         1 );
+  syswrite( STATUSD, $main::incoming_writable, 1 );
+  syswrite( STATUSD, $main::dstat,             1 );
+  syswrite( STATUSD, $main::next_run,          STATNUM_LEN );
+  syswrite( STATUSD, $main::last_ping_time,    STATNUM_LEN );
+  syswrite( STATUSD, $main::current_changes,   STATSTR_LEN );
+} ## end sub send_status()
 
 # ---------------------------------------------------------------------------
 #                                                          FTP functions
@@ -1724,80 +1874,91 @@ sub send_status() {
 #
 sub ftp_open() {
 
-       if ($main::FTP_chan) {
-               # is already open, but might have timed out; test with a cwd
-               return $main::FTP_chan if $main::FTP_chan->cwd( $main::current_targetdir );
-               # cwd didn't work, channel is closed, try to reopen it
-               $main::FTP_chan = undef;
-       }
-       
-       if (!($main::FTP_chan = Net::FTP->new( $conf::target,
-                                                                                  Debug => $conf::ftpdebug,
-                                                                                  Timeout => $conf::ftptimeout ))) {
-               msg( "log,mail", "Cannot open FTP server $conf::target\n" );
-               goto err;
-       }
-       if (!$main::FTP_chan->login()) {
-               msg( "log,mail", "Anonymous login on FTP server $conf::target failed\n" );
-               goto err;
-       }
-       if (!$main::FTP_chan->binary()) {
-               msg( "log,mail", "Can't set binary FTP mode on $conf::target\n" );
-               goto err;
-       }
-       if (!$main::FTP_chan->cwd( $main::current_targetdir )) {
-               msg( "log,mail", "Can't cd to $main::current_targetdir on $conf::target\n" );
-               goto err;
-       }
-       debug( "opened FTP channel to $conf::target" );
-       return 1;
-
-  err:
-       $main::FTP_chan = undef;
-       return 0;
-}
+  if ($main::FTP_chan) {
+
+    # is already open, but might have timed out; test with a cwd
+    return $main::FTP_chan
+      if $main::FTP_chan->cwd($main::current_targetdir);
+
+    # cwd didn't work, channel is closed, try to reopen it
+    $main::FTP_chan = undef;
+  } ## end if ($main::FTP_chan)
+
+  if (
+       !(
+          $main::FTP_chan =
+          Net::FTP->new(
+                         $conf::target,
+                         Debug   => $conf::ftpdebug,
+                         Timeout => $conf::ftptimeout
+                       )
+        )
+     )
+  {
+    msg( "log,mail", "Cannot open FTP server $conf::target\n" );
+    goto err;
+  } ## end if ( !( $main::FTP_chan...
+  if ( !$main::FTP_chan->login() ) {
+    msg( "log,mail", "Anonymous login on FTP server $conf::target failed\n" );
+    goto err;
+  }
+  if ( !$main::FTP_chan->binary() ) {
+    msg( "log,mail", "Can't set binary FTP mode on $conf::target\n" );
+    goto err;
+  }
+  if ( !$main::FTP_chan->cwd($main::current_targetdir) ) {
+    msg( "log,mail",
+         "Can't cd to $main::current_targetdir on $conf::target\n" );
+    goto err;
+  }
+  debug("opened FTP channel to $conf::target");
+  return 1;
+
+err:
+  $main::FTP_chan = undef;
+  return 0;
+} ## end sub ftp_open()
 
 sub ftp_cmd($@) {
-       my $cmd = shift;
-       my ($rv, $err);
-       my $direct_resp_cmd = ($cmd eq "quot");
-       
-       debug( "executing FTP::$cmd(".join(", ",@_).")" );
-       $SIG{"ALRM"} = sub { die "timeout in FTP::$cmd\n" } ;
-       alarm( $conf::remote_timeout );
-       eval { $rv = $main::FTP_chan->$cmd( @_ ); };
-       alarm( 0 );
-       $err = "";
-       $rv = (ftp_code() =~ /^2/) ? 1 : 0 if $direct_resp_cmd;
-       if ($@) {
-               $err = $@;
-               undef $rv;
-       }
-       elsif (!$rv) {
-               $err = ftp_response();
-       }
-       return ($rv, $err);
-}
+  my $cmd = shift;
+  my ( $rv, $err );
+  my $direct_resp_cmd = ( $cmd eq "quot" );
+
+  debug( "executing FTP::$cmd(" . join( ", ", @_ ) . ")" );
+  $SIG{"ALRM"} = sub { die "timeout in FTP::$cmd\n" };
+  alarm($conf::remote_timeout);
+  eval { $rv = $main::FTP_chan->$cmd(@_); };
+  alarm(0);
+  $err = "";
+  $rv = ( ftp_code() =~ /^2/ ) ? 1 : 0 if $direct_resp_cmd;
+  if ($@) {
+    $err = $@;
+    undef $rv;
+  } elsif ( !$rv ) {
+    $err = ftp_response();
+  }
+  return ( $rv, $err );
+} ## end sub ftp_cmd($@)
 
 sub ftp_close() {
-       if ($main::FTP_chan) {
-               $main::FTP_chan->quit();
-               $main::FTP_chan = undef;
-       }
-       return 1;
-}
+  if ($main::FTP_chan) {
+    $main::FTP_chan->quit();
+    $main::FTP_chan = undef;
+  }
+  return 1;
+} ## end sub ftp_close()
 
 sub ftp_response() {
-       return join( '', @{${*$main::FTP_chan}{'net_cmd_resp'}} );
+  return join( '', @{ ${*$main::FTP_chan}{'net_cmd_resp'} } );
 }
 
 sub ftp_code() {
-       return ${*$main::FTP_chan}{'net_cmd_code'};
+  return ${*$main::FTP_chan}{'net_cmd_code'};
 }
 
 sub ftp_error() {
-       my $code = ftp_code();
-       return ($code =~ /^[45]/) ? 1 : 0;
+  my $code = ftp_code();
+  return ( $code =~ /^[45]/ ) ? 1 : 0;
 }
 
 # ---------------------------------------------------------------------------
@@ -1805,176 +1966,178 @@ sub ftp_error() {
 # ---------------------------------------------------------------------------
 
 sub ssh_cmd($) {
-       my $cmd = shift;
-       my ($msg, $stat);
-
-       my $ecmd = "$conf::ssh $conf::ssh_options $conf::target ".
-                          "-l $conf::targetlogin \'cd $main::current_targetdir; $cmd\'";
-       debug( "executing $ecmd" );
-       $SIG{"ALRM"} = sub { die "timeout in ssh command\n" } ;
-       alarm( $conf::remote_timeout );
-       eval { $msg = `$ecmd 2>&1`; };
-       alarm( 0 );
-       if ($@) {
-               $msg = $@;
-               $stat = 1;
-       }
-       else {
-               $stat = $?;
-       }
-       return ($msg, $stat);
-}
+  my $cmd = shift;
+  my ( $msg, $stat );
+
+  my $ecmd = "$conf::ssh $conf::ssh_options $conf::target "
+    . "-l $conf::targetlogin \'cd $main::current_targetdir; $cmd\'";
+  debug("executing $ecmd");
+  $SIG{"ALRM"} = sub { die "timeout in ssh command\n" };
+  alarm($conf::remote_timeout);
+  eval { $msg = `$ecmd 2>&1`; };
+  alarm(0);
+  if ($@) {
+    $msg  = $@;
+    $stat = 1;
+  } else {
+    $stat = $?;
+  }
+  return ( $msg, $stat );
+} ## end sub ssh_cmd($)
 
 sub scp_cmd(@) {
-       my ($msg, $stat);
-
-       my $ecmd = "$conf::scp $conf::ssh_options @_ ".
-                          "$conf::targetlogin\@$conf::target:$main::current_targetdir";
-       debug( "executing $ecmd" );
-       $SIG{"ALRM"} = sub { die "timeout in scp\n" } ;
-       alarm( $conf::remote_timeout );
-       eval { $msg = `$ecmd 2>&1`; };
-       alarm( 0 );
-       if ($@) {
-               $msg = $@;
-               $stat = 1;
-       }
-       else {
-               $stat = $?;
-       }
-       return ($msg, $stat);
-}
+  my ( $msg, $stat );
+
+  my $ecmd = "$conf::scp $conf::ssh_options @_ "
+    . "$conf::targetlogin\@$conf::target:$main::current_targetdir";
+  debug("executing $ecmd");
+  $SIG{"ALRM"} = sub { die "timeout in scp\n" };
+  alarm($conf::remote_timeout);
+  eval { $msg = `$ecmd 2>&1`; };
+  alarm(0);
+  if ($@) {
+    $msg  = $@;
+    $stat = 1;
+  } else {
+    $stat = $?;
+  }
+  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);
-       
-}
+  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)
 #
 sub check_alive(;$) {
-    my $timeout = shift;
-    my( $saddr, $ret, $target_ip );
-    local( *PINGSOCK );
-
-       if ($conf::upload_method eq "copy") {
-               format_status_num( $main::last_ping_time, time );
-               $main::target_up = 1;
-               return;
-       }
-       
-    $timeout ||= 30;
-
-       if (!($target_ip = (gethostbyname($conf::target))[4])) {
-               msg( "log", "Cannot get IP address of $conf::target\n" );
-               $ret = 0;
-               goto out;
-       }
-    $saddr = pack( 'S n a4 x8', AF_INET, $main::echo_port, $target_ip );
-    $SIG{'ALRM'} = sub { die } ;
-    alarm( $timeout );
-    
-       $ret = $main::tcp_proto; # avoid warnings about unused variable
+  my $timeout = shift;
+  my ( $saddr, $ret, $target_ip );
+  local (*PINGSOCK);
+
+  if ( $conf::upload_method eq "copy" ) {
+    format_status_num( $main::last_ping_time, time );
+    $main::target_up = 1;
+    return;
+  }
+
+  $timeout ||= 30;
+
+  if ( !( $target_ip = ( gethostbyname($conf::target) )[4] ) ) {
+    msg( "log", "Cannot get IP address of $conf::target\n" );
     $ret = 0;
-    eval <<'EOM' ;
+    goto out;
+  }
+  $saddr = pack( 'S n a4 x8', AF_INET, $main::echo_port, $target_ip );
+  $SIG{'ALRM'} = sub { die };
+  alarm($timeout);
+
+  $ret = $main::tcp_proto;    # avoid warnings about unused variable
+  $ret = 0;
+  eval <<'EOM' ;
     return unless socket( PINGSOCK, PF_INET, SOCK_STREAM, $main::tcp_proto );
     return unless connect( PINGSOCK, $saddr );
     $ret = 1;
 EOM
-    alarm( 0 );
-    close( PINGSOCK );
-       msg( "log", "pinging $conf::target: " . ($ret ? "ok" : "down") . "\n" );
-  out:
-       $main::target_up = $ret ? "1" : "0";
-       format_status_num( $main::last_ping_time, time );
-       write_status_file() if $conf::statusdelay;
-}
+  alarm(0);
+  close(PINGSOCK);
+  msg( "log", "pinging $conf::target: " . ( $ret ? "ok" : "down" ) . "\n" );
+out:
+  $main::target_up = $ret ? "1" : "0";
+  format_status_num( $main::last_ping_time, time );
+  write_status_file() if $conf::statusdelay;
+} ## end sub check_alive(;$)
 
 #
 # check if incoming dir on target is writable
 #
 sub check_incoming_writable() {
-       my $testfile = ".debianqueued-testfile";
-       my ($msg, $stat);
-
-       if ($conf::upload_method eq "ssh") {
-               ($msg, $stat) = ssh_cmd( "rm -f $testfile; touch $testfile; ".
-                                                                "rm -f $testfile" );
-       }
-       elsif ($conf::upload_method eq "ftp") {
-               my $file = "junk-for-writable-test-".format_time();
-               $file =~ s/[ :.]/-/g;
-               local( *F );
-               open( F, ">$file" ); close( F );
-               my $rv;
-               ($rv, $msg) = ftp_cmd( "put", $file );
-               $stat = 0;
-               $msg = "" if !defined $msg;
-               unlink $file;
-               ftp_cmd( "delete", $file );
-       }
-       elsif ($conf::upload_method eq "copy") {
-               ($msg, $stat) = local_cmd( "rm -f $testfile; touch $testfile; ".
-                                                                  "rm -f $testfile" );
-       }
-       chomp( $msg );
-       debug( "exit status: $stat, output was: $msg" );
-
-       if (!$stat) {
-               # change incoming_writable only if ssh didn't return an error
-               $main::incoming_writable =
-                       ($msg =~ /(permission denied|read-?only file|cannot create)/i) ? "0":"1";
-       }
-       else {
-               debug( "local error, keeping old status" );
-       }
-       debug( "incoming_writable = $main::incoming_writable" );
-       write_status_file() if $conf::statusdelay;
-       return $main::incoming_writable;
-}
+  my $testfile = ".debianqueued-testfile";
+  my ( $msg, $stat );
+
+  if ( $conf::upload_method eq "ssh" ) {
+    ( $msg, $stat ) =
+      ssh_cmd( "rm -f $testfile; touch $testfile; " . "rm -f $testfile" );
+  } elsif ( $conf::upload_method eq "ftp" ) {
+    my $file = "junk-for-writable-test-" . format_time();
+    $file =~ s/[ :.]/-/g;
+    local (*F);
+    open( F, ">$file" );
+    close(F);
+    my $rv;
+    ( $rv, $msg ) = ftp_cmd( "put", $file );
+    $stat = 0;
+    $msg = "" if !defined $msg;
+    unlink $file;
+    ftp_cmd( "delete", $file );
+  } elsif ( $conf::upload_method eq "copy" ) {
+    ( $msg, $stat ) =
+      local_cmd( "rm -f $testfile; touch $testfile; " . "rm -f $testfile" );
+  }
+  chomp($msg);
+  debug("exit status: $stat, output was: $msg");
+
+  if ( !$stat ) {
+
+    # change incoming_writable only if ssh didn't return an error
+    $main::incoming_writable =
+      ( $msg =~ /(permission denied|read-?only file|cannot create)/i )
+      ? "0"
+      : "1";
+  } else {
+    debug("local error, keeping old status");
+  }
+  debug("incoming_writable = $main::incoming_writable");
+  write_status_file() if $conf::statusdelay;
+  return $main::incoming_writable;
+} ## end sub check_incoming_writable()
 
 #
 # remove a list of files, log failing ones
 #
 sub rm(@) {
-       my $done = 0;
+  my $done = 0;
 
-       foreach ( @_ ) {
-               (unlink $_ and ++$done)
-                       or $! == ENOENT or msg( "log", "Could not delete $_: $!\n" );
-       }
-       return $done;
-}
+  foreach (@_) {
+    ( unlink $_ and ++$done )
+      or $! == ENOENT
+      or msg( "log", "Could not delete $_: $!\n" );
+  }
+  return $done;
+} ## end sub rm(@)
 
 #
 # get md5 checksum of a file
 #
 sub md5sum($) {
-       my $file = shift;
-       my $line;
+  my $file = shift;
+  my $line;
 
-       chomp( $line = `$conf::md5sum $file` );
-       debug( "md5sum($file): ", $? ? "exit status $?" :
-                                     $line =~ /^(\S+)/ ? $1 : "match failed" );
-       return $? ? "" : $line =~ /^(\S+)/ ? $1 : "";
-}
+  chomp( $line = `$conf::md5sum $file` );
+  debug( "md5sum($file): ",
+           $? ? "exit status $?"
+         : $line =~ /^(\S+)/ ? $1
+         :                     "match failed" );
+  return $? ? "" : $line =~ /^(\S+)/ ? $1 : "";
+} ## 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/;
+  my $file = shift;
+  return $file =~ /\.(deb|dsc|(diff|tar)\.gz)$/
+    && $file !~ /\.orig\.tar\.gz/;
 }
 
 #
@@ -1982,104 +2145,109 @@ sub is_debian_file($) {
 # return "" if not possible
 #
 sub get_maintainer($) {
-       my $file = shift;
-       my $maintainer = "";
-       local( *F );
-       
-       if ($file =~ /\.diff\.gz$/) {
-               # parse a diff 
-               open( F, "$conf::gzip -dc '$file' 2>/dev/null |" ) or return "";
-               while( <F> ) {
-                       # look for header line of a file */debian/control
-                       last if m,^\+\+\+\s+[^/]+/debian/control(\s+|$),;
-               }
-               while( <F> ) {
-                       last if /^---/; # end of control file patch, no Maintainer: found
-                       # inside control file patch look for Maintainer: field
-                       $maintainer = $1, last if /^\+Maintainer:\s*(.*)$/i;
-               }
-               while( <F> ) { } # read to end of file to avoid broken pipe
-               close( F ) or return "";
-       }
-       elsif ($file =~ /\.(deb|dsc|tar\.gz)$/) {
-               if ($file =~ /\.deb$/ && $conf::ar) {
-                       # extract control.tar.gz from .deb with ar, then let tar extract
-                       # the control file itself
-                       open( F, "($conf::ar p '$file' control.tar.gz | ".
-                                    "$conf::tar -xOf - ".
-                                    "--use-compress-program $conf::gzip ".
-                                    "control) 2>/dev/null |" )
-                               or return "";
-               }
-               elsif ($file =~ /\.dsc$/) {
-                       # just do a plain grep
-                       debug( "get_maint: .dsc, no cmd" );
-                       open( F, "<$file" ) or return "";
-               }
-               elsif ($file =~ /\.tar\.gz$/) {
-                       # let tar extract a file */debian/control
-                       open(F, "$conf::tar -xOf '$file' ".
-                                   "--use-compress-program $conf::gzip ".
-                                   "\\*/debian/control 2>&1 |")
-                               or return "";
-               }
-               else {
-                       return "";
-               }
-               while( <F> ) {
-                       $maintainer = $1, last if /^Maintainer:\s*(.*)$/i;
-               }
-               close( F ) or return "";
-       }
-
-       return $maintainer;
-}
+  my $file       = shift;
+  my $maintainer = "";
+  local (*F);
+
+  if ( $file =~ /\.diff\.gz$/ ) {
+
+    # parse a diff
+    open( F, "$conf::gzip -dc '$file' 2>/dev/null |" ) or return "";
+    while (<F>) {
+
+      # look for header line of a file */debian/control
+      last if m,^\+\+\+\s+[^/]+/debian/control(\s+|$),;
+    }
+    while (<F>) {
+      last if /^---/;   # end of control file patch, no Maintainer: found
+                        # inside control file patch look for Maintainer: field
+      $maintainer = $1, last if /^\+Maintainer:\s*(.*)$/i;
+    }
+    while (<F>) { }     # read to end of file to avoid broken pipe
+    close(F) or return "";
+  } elsif ( $file =~ /\.(deb|dsc|tar\.gz)$/ ) {
+    if ( $file =~ /\.deb$/ && $conf::ar ) {
+
+      # extract control.tar.gz from .deb with ar, then let tar extract
+      # the control file itself
+      open( F,
+                "($conf::ar p '$file' control.tar.gz | "
+              . "$conf::tar -xOf - "
+              . "--use-compress-program $conf::gzip "
+              . "control) 2>/dev/null |"
+          ) or return "";
+    } elsif ( $file =~ /\.dsc$/ ) {
+
+      # just do a plain grep
+      debug("get_maint: .dsc, no cmd");
+      open( F, "<$file" ) or return "";
+    } elsif ( $file =~ /\.tar\.gz$/ ) {
+
+      # let tar extract a file */debian/control
+      open( F,
+                "$conf::tar -xOf '$file' "
+              . "--use-compress-program $conf::gzip "
+              . "\\*/debian/control 2>&1 |"
+          ) or return "";
+    } else {
+      return "";
+    }
+    while (<F>) {
+      $maintainer = $1, last if /^Maintainer:\s*(.*)$/i;
+    }
+    close(F) or return "";
+  } ## end elsif ( $file =~ /\.(deb|dsc|tar\.gz)$/)
+
+  return $maintainer;
+} ## end sub get_maintainer($)
 
 #
 # 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}*";
-}
-       
+  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
 #
 # first arg is a comma-separated list of destinations; valid are "log"
 # and "mail"; rest is stuff to be printed, just as with print
-# 
+#
 sub msg($@) {
-       my @dest = split( ',', shift );
+  my @dest = split( ',', shift );
 
-       if (grep /log/, @dest ) {
-               my $now = format_time();
-               print LOG "$now ", @_;
-       }
+  if ( grep /log/, @dest ) {
+    my $now = format_time();
+    print LOG "$now ", @_;
+  }
 
-       if (grep /mail/, @dest ) {
-               $main::mail_text .= join( '', @_ );
-       }
-}
+  if ( grep /mail/, @dest ) {
+    $main::mail_text .= join( '', @_ );
+  }
+} ## end sub msg($@)
 
 #
 # print a debug messages, if $debug is true
 #
 sub debug(@) {
-       return if !$conf::debug;
-       my $now = format_time();
-       print LOG "$now DEBUG ", @_, "\n";
+  return if !$conf::debug;
+  my $now = format_time();
+  print LOG "$now DEBUG ", @_, "\n";
 }
 
 #
@@ -2087,13 +2255,13 @@ sub debug(@) {
 # address, subject, ...)
 #
 sub init_mail(;$) {
-       my $file = shift;
+  my $file = shift;
 
-       $main::mail_addr = "";
-       $main::mail_text = "";
-        %main::packages  = ();
-       $main::mail_subject = $file ? "Processing of $file" : "";
-}
+  $main::mail_addr    = "";
+  $main::mail_text    = "";
+  %main::packages     = ();
+  $main::mail_subject = $file ? "Processing of $file" : "";
+} ## end sub init_mail(;$)
 
 #
 # finalize mail to be sent from msg(): check if something present, and
@@ -2101,48 +2269,60 @@ sub init_mail(;$) {
 #
 sub finish_mail() {
 
-       debug( "No mail for $main::mail_addr" )
-               if $main::mail_addr && !$main::mail_text;
-       return unless $main::mail_addr && $main::mail_text;
-
-       if (!send_mail($main::mail_addr, $main::mail_subject, $main::mail_text)) {
-               # store this mail in memory so it isn't lost if executing sendmail
-               # failed.
-               push( @main::stored_mails, { addr    => $main::mail_addr,
-                                                                        subject => $main::mail_subject,
-                                                                        text    => $main::mail_text } );
-       }
-       init_mail();
-
-       # try to send out stored mails
-       my $mailref;
-       while( $mailref = shift(@main::stored_mails) ) {
-               if (!send_mail( $mailref->{'addr'}, $mailref->{'subject'},
-                                           $mailref->{'text'} )) {
-                       unshift( @main::stored_mails, $mailref );
-                       last;
-               }
-       }
-}
+  debug("No mail for $main::mail_addr")
+    if $main::mail_addr && !$main::mail_text;
+  return unless $main::mail_addr && $main::mail_text;
+
+  if ( !send_mail( $main::mail_addr, $main::mail_subject, $main::mail_text ) )
+  {
+
+    # store this mail in memory so it isn't lost if executing sendmail
+    # failed.
+    push(
+          @main::stored_mails,
+          {
+            addr    => $main::mail_addr,
+            subject => $main::mail_subject,
+            text    => $main::mail_text
+          }
+        );
+  } ## end if ( !send_mail( $main::mail_addr...
+  init_mail();
+
+  # try to send out stored mails
+  my $mailref;
+  while ( $mailref = shift(@main::stored_mails) ) {
+    if (
+         !send_mail( $mailref->{'addr'}, $mailref->{'subject'},
+                     $mailref->{'text'} )
+       )
+    {
+      unshift( @main::stored_mails, $mailref );
+      last;
+    } ## end if ( !send_mail( $mailref...
+  } ## end while ( $mailref = shift(...
+} ## end sub finish_mail()
 
 #
 # send one mail
 #
 sub send_mail($$$) {
-       my $addr = shift;
-       my $subject = shift;
-       my $text = shift;
+  my $addr    = shift;
+  my $subject = shift;
+  my $text    = shift;
 
-       my $package = keys %main::packages ? join(' ', keys %main::packages) : "";
+  my $package =
+    keys %main::packages ? join( ' ', keys %main::packages ) : "";
 
-       use Email::Send;
+  use Email::Send;
 
-        unless (defined($Email::Send::Sendmail::SENDMAIL)) {
-               $Email::Send::Sendmail::SENDMAIL = $conf::mail;
-       }
+  unless ( defined($Email::Send::Sendmail::SENDMAIL) ) {
+    $Email::Send::Sendmail::SENDMAIL = $conf::mail;
+  }
 
-       my $date = sprintf "%s", strftime("%a, %d %b %Y %T %z", (localtime(time)));
-       my $message = <<__MESSAGE__;
+  my $date = sprintf "%s",
+    strftime( "%a, %d %b %Y %T %z", ( localtime(time) ) );
+  my $message = <<__MESSAGE__;
 To: $addr
 From: Archive Administrator <dak\@ftp-master.debian.org>
 Subject: $subject
@@ -2150,155 +2330,157 @@ Date: $date
 X-Debian: DAK
 __MESSAGE__
 
-       if (length $package) {
-               $message .= "X-Debian-Package: $package\n";
-       }
+  if ( length $package ) {
+    $message .= "X-Debian-Package: $package\n";
+  }
 
-       $message .= "\n$text";
-       $message .= "\nGreetings,\n\n\tYour Debian queue daemon\n";
+  $message .= "\n$text";
+  $message .= "\nGreetings,\n\n\tYour Debian queue daemon\n";
 
-       my $mail = Email::Send->new;
-       for ( qw[Sendmail SMTP] ) {
-               $mail->mailer($_) and last if $mail->mailer_available($_);
-       }
+  my $mail = Email::Send->new;
+  for (qw[Sendmail SMTP]) {
+    $mail->mailer($_) and last if $mail->mailer_available($_);
+  }
 
-       my $ret = $mail->send($message);
-       if ($ret && $ret !~ /Message sent|success/) {
-               return 0;
-       }
+  my $ret = $mail->send($message);
+  if ( $ret && $ret !~ /Message sent|success/ ) {
+    return 0;
+  }
 
-       return 1;
-}
+  return 1;
+} ## end sub send_mail($$$)
 
 #
 # try to find a mail address for a name in the keyrings
 #
 sub try_to_get_mail_addr($$) {
-       my $name = shift;
-       my $listref = shift;
-
-       @$listref = ();
-       open( F, "$conf::gpg --no-options --batch --no-default-keyring ".
-               "--always-trust --keyring ".
-               join (" --keyring ",@conf::keyrings).
-               " --list-keys |" )
-               or return "";
-       while( <F> ) {
-               if (/^pub / && / $name /) {
-                       /<([^>]*)>/;
-                       push( @$listref, $1 );
-               }
-       }
-       close( F );
-
-       return (@$listref >= 1) ? $listref->[0] : "";
-}
+  my $name    = shift;
+  my $listref = shift;
+
+  @$listref = ();
+  open( F,
+            "$conf::gpg --no-options --batch --no-default-keyring "
+          . "--always-trust --keyring "
+          . join( " --keyring ", @conf::keyrings )
+          . " --list-keys |"
+      ) or return "";
+  while (<F>) {
+    if ( /^pub / && / $name / ) {
+      /<([^>]*)>/;
+      push( @$listref, $1 );
+    }
+  } ## end while (<F>)
+  close(F);
+
+  return ( @$listref >= 1 ) ? $listref->[0] : "";
+} ## end sub try_to_get_mail_addr($$)
 
 #
 # return current time as string
 #
 sub format_time() {
-       my $t;
+  my $t;
 
-       # omit weekday and year for brevity
-       ($t = localtime) =~ /^\w+\s(.*)\s\d+$/;
-       return $1;
-}
+  # omit weekday and year for brevity
+  ( $t = localtime ) =~ /^\w+\s(.*)\s\d+$/;
+  return $1;
+} ## end sub format_time()
 
 sub print_time($) {
-       my $secs = shift;
-       my $hours = int($secs/(60*60));
+  my $secs = shift;
+  my $hours = int( $secs / ( 60 * 60 ) );
 
-       $secs -= $hours*60*60;
-       return sprintf "%d:%02d:%02d", $hours, int($secs/60), $secs % 60;
-}
+  $secs -= $hours * 60 * 60;
+  return sprintf "%d:%02d:%02d", $hours, int( $secs / 60 ), $secs % 60;
+} ## end sub print_time($)
 
 #
 # block some signals during queue processing
-# 
+#
 # This is just to avoid data inconsistency or uploads being aborted in the
 # middle. Only "soft" signals are blocked, i.e. SIGINT and SIGTERM, try harder
 # ones if you really want to kill the daemon at once.
 #
 sub block_signals() {
-       POSIX::sigprocmask( SIG_BLOCK, $main::block_sigset );
+  POSIX::sigprocmask( SIG_BLOCK, $main::block_sigset );
 }
 
 sub unblock_signals() {
-       POSIX::sigprocmask( SIG_UNBLOCK, $main::block_sigset );
+  POSIX::sigprocmask( SIG_UNBLOCK, $main::block_sigset );
 }
 
 #
 # process SIGHUP: close log file and reopen it (for logfile cycling)
 #
 sub close_log($) {
-       close( LOG );
-       close( STDOUT );
-       close( STDERR );
-
-       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" )
-               or msg( "log", "$main::progname: Can't redirect stdout to ".
-                           "$conf::logfile: $!\n" );
-       open( STDERR, ">&LOG" )
-               or msg( "log", "$main::progname: Can't redirect stderr to ".
-                           "$conf::logfile: $!\n" );
-       msg( "log", "Restart after SIGHUP\n" );
-}
+  close(LOG);
+  close(STDOUT);
+  close(STDERR);
+
+  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" )
+    or msg( "log",
+      "$main::progname: Can't redirect stdout to " . "$conf::logfile: $!\n" );
+  open( STDERR, ">&LOG" )
+    or msg( "log",
+      "$main::progname: Can't redirect stderr to " . "$conf::logfile: $!\n" );
+  msg( "log", "Restart after SIGHUP\n" );
+} ## end sub close_log($)
 
 #
 # process SIGCHLD: check if it was our statusd process
 #
 sub kid_died($) {
-       my $pid;
-
-       # reap statusd, so that it's no zombie when we try to kill(0) it
-       waitpid( $main::statusd_pid, WNOHANG );
-
-# Uncomment the following line if your Perl uses unreliable System V signal
-# (i.e. if handlers reset to default if the signal is delivered).
-# (Unfortunately, the re-setup can't be done in any case, since on some
-# systems this will cause the SIGCHLD to be delivered again if there are
-# still unreaped children :-(( )
-       
-#       $SIG{"CHLD"} = \&kid_died; # resetup handler for SysV
-}
+  my $pid;
+
+  # reap statusd, so that it's no zombie when we try to kill(0) it
+  waitpid( $main::statusd_pid, WNOHANG );
+
+  # Uncomment the following line if your Perl uses unreliable System V signal
+  # (i.e. if handlers reset to default if the signal is delivered).
+  # (Unfortunately, the re-setup can't be done in any case, since on some
+  # systems this will cause the SIGCHLD to be delivered again if there are
+  # still unreaped children :-(( )
+
+  #     $SIG{"CHLD"} = \&kid_died; # resetup handler for SysV
+} ## end sub kid_died($)
 
 sub restart_statusd() {
-       # restart statusd if it died
-       if (!kill( 0, $main::statusd_pid)) {
-               close( STATUSD ); # close out pipe end
-               $main::statusd_pid = fork_statusd();
-       }
-}
+
+  # restart statusd if it died
+  if ( !kill( 0, $main::statusd_pid ) ) {
+    close(STATUSD);    # close out pipe end
+    $main::statusd_pid = fork_statusd();
+  }
+} ## end sub restart_statusd()
 
 #
 # process a fatal signal: cleanup and exit
 #
 sub fatal_signal($) {
-       my $signame = shift;
-       my $sig;
-       
-       # avoid recursions of fatal_signal in case of BSD signals
-       foreach $sig ( qw( ILL ABRT BUS FPE SEGV PIPE ) ) {
-               $SIG{$sig} = "DEFAULT";
-       }
-
-       if ($$ == $main::maind_pid) {
-               # only the main daemon should do this
-               kill( $main::signo{"TERM"}, $main::statusd_pid )
-                       if defined $main::statusd_pid;
-               unlink( $conf::statusfile, $conf::pidfile );
-       }
-       msg( "log", "Caught SIG$signame -- exiting (pid $$)\n" );
-       exit 1;
-}
-
+  my $signame = shift;
+  my $sig;
+
+  # avoid recursions of fatal_signal in case of BSD signals
+  foreach $sig (qw( ILL ABRT BUS FPE SEGV PIPE )) {
+    $SIG{$sig} = "DEFAULT";
+  }
+
+  if ( $$ == $main::maind_pid ) {
+
+    # only the main daemon should do this
+    kill( $main::signo{"TERM"}, $main::statusd_pid )
+      if defined $main::statusd_pid;
+    unlink( $conf::statusfile, $conf::pidfile );
+  } ## end if ( $$ == $main::maind_pid)
+  msg( "log", "Caught SIG$signame -- exiting (pid $$)\n" );
+  exit 1;
+} ## end sub fatal_signal($)
 
 # Local Variables:
 #  tab-width: 4