svn-commit.2

The BuildBot is a system to automate the compile/test cycle required by most software projects. CVS

+
+    $self->{child_just_exited} = 0;
     ($nfound, $timeleft) = select($rout=$rin, undef, $eout=$rin, $tout);
-  };
-  alarm 0;
+    $selerr = $!;
 
-  if ($@) {
-    warn "prefork: select timeout failed! recovering\n";
-    sleep 1;        # avoid overload
-    return;
-  }
+  });
+
+  # bug 4696: under load, the process can go for such a long time without
+  # being context-switched in, that when it does return the alarm() fires
+  # before the select() timeout does.   Treat this as a select() timeout
+  if ($timer->timed_out) {
+    dbg("prefork: select timed out (via alarm)");
+    $nfound = 0;
+    $timeleft = 0;
+  }
+
+  # errors; handle undef *or* -1 returned.  do this before "errors on
+  # the handle" below, since an error condition is signalled both via
+  # a -1 return and a $eout bit.
+  if (!defined $nfound || $nfound < 0)
+  {
+    if (exists &Errno::EINTR && $selerr == &Errno::EINTR)
+    {
+      # this happens if the process is signalled during the select(),
+      # for example if someone sends SIGHUP to reload the configuration.
+      # just return inmmediately
+      dbg("prefork: select returned err $selerr, probably signalled");
+      return;
+    }
+
+    # if a child exits during that select() call, it generates a spurious
+    # error, like this:
+    #
+    # Jan 29 12:53:17 dogma spamd[18518]: prefork: child states: BI
+    # Jan 29 12:53:17 dogma spamd[18518]: spamd: handled cleanup of child pid 13101 due to SIGCHLD
+    # Jan 29 12:53:17 dogma spamd[18518]: prefork: select returned -1! recovering:
+    #
+    # avoid by setting a boolean in the child_exited() callback and checking
+    # it here.  log $! just in case, though.
+    if ($self->{child_just_exited} && $nfound == -1) {
+      dbg("prefork: select returned -1 due to child exiting, ignored ($selerr)");
+      return;
+    }
+
+    warn "prefork: select returned ".
+            (defined $nfound ? $nfound : "undef").
+            "! recovering: $selerr\n";
 
-  if (!defined $nfound) {
-    warn "prefork: select returned undef! recovering\n";
     sleep 1;        # avoid overload
     return;
   }
@@ -213,7 +256,7 @@
   # errors on the handle?
   # return them immediately, they may be from a SIGHUP restart signal
   if (vec ($eout, $self->{server_fileno}, 1)) {
-    warn "prefork: select returned error on server filehandle: $!\n";
+    warn "prefork: select returned error on server filehandle: $selerr $!\n";
     return;
   }
 
@@ -282,7 +325,7 @@
 
   my ($sock, $kid);
   while (($kid, $sock) = each %{$self->{backchannel}->{kids}}) {
-    $self->syswrite_with_retry($sock, PF_PING_ORDER) and next;
+    $self->syswrite_with_retry($sock, PF_PING_ORDER, $kid, 3) and next;
 
     warn "prefork: write of ping failed to $kid fd=".$sock->fileno.": ".$!;
 
@@ -353,7 +396,7 @@
       return $self->order_idle_child_to_accept();
     }
 
-    if (!$self->syswrite_with_retry($sock, PF_ACCEPT_ORDER))
+    if (!$self->syswrite_with_retry($sock, PF_ACCEPT_ORDER, $kid))
     {
       # failure to write to the child; bad news.  call it dead
       warn "prefork: killing rogue child $kid, failed to write on fd ".$sock->fileno.": $!\n";
@@ -396,7 +439,7 @@
   my ($self, $kid) = @_;
   if ($self->{waiting_for_idle_child}) {
     my $sock = $self->{backchannel}->get_socket_for_child($kid);
-    $self->syswrite_with_retry($sock, PF_ACCEPT_ORDER)
+    $self->syswrite_with_retry($sock, PF_ACCEPT_ORDER, $kid)
         or die "prefork: $kid claimed it was ready, but write failed on fd ".
                             $sock->fileno.": ".$!;
     $self->{waiting_for_idle_child} = 0;
@@ -426,7 +469,7 @@
 sub report_backchannel_socket {
   my ($self, $str) = @_;
   my $sock = $self->{backchannel}->get_parent_socket();
-  $self->syswrite_with_retry($sock, $str)
+  $self->syswrite_with_retry($sock, $str, 'parent')
         or write "syswrite() to parent failed: $!";
 }
 
@@ -537,12 +580,31 @@
 }
 
 sub syswrite_with_retry {
-  my ($self, $sock, $buf) = @_;
+  my ($self, $sock, $buf, $targetname, $numretries) = @_;
+  $numretries ||= 10;       # default 10 retries
 
   my $written = 0;
+  my $try = 0;
 
 retry_write:
+
+  $try++;
+  if ($try > 1) {
+    warn "prefork: syswrite(".$sock->fileno.") to $targetname failed on try $try";
+    if ($try > $numretries) {
+      warn "prefork: giving up";
+      return undef;
+    }
+    else {
+      # give it 1 second to recover.  we retry indefinitely.
+      my $rout = '';
+      vec($rout, $sock->fileno, 1) = 1;
+      select(undef, $rout, undef, 1);
+    }
+  }
+
   my $nbytes = $sock->syswrite($buf);
+
   if (!defined $nbytes) {
     unless ((exists &Errno::EAGAIN && $! == &Errno::EAGAIN)
         || (exists &Errno::EWOULDBLOCK && $! == &Errno::EWOULDBLOCK))
@@ -551,13 +613,7 @@
       return undef;
     }
 
-    warn "prefork: syswrite(".$sock->fileno.") failed, retrying...";
-
-    # give it 5 seconds to recover.  we retry indefinitely.
-    my $rout = '';
-    vec($rout, $sock->fileno, 1) = 1;
-    select(undef, $rout, undef, 5);
-
+    warn "prefork: retrying syswrite(): $!";
     goto retry_write;
   }
   else {
@@ -568,7 +624,8 @@
       return $written;      # it's complete, we can return
     }
     else {
-      warn "prefork: partial write of $nbytes, towrite=".length($buf).
+      warn "prefork: partial write of $nbytes to ".
+            $targetname.", towrite=".length($buf).
             " sofar=".$written." fd=".$sock->fileno.", recovering";
       goto retry_write;
     }

Added: spamassassin/branches/3.1/lib/Mail/SpamAssassin/Timeout.pm
URL: http://svn.apache.org/viewcvs/spamassassin/branches/3.1/lib/Mail/SpamAssassin/Timeout.pm?rev=384590&view=auto
==============================================================================
--- spamassassin/branches/3.1/lib/Mail/SpamAssassin/Timeout.pm (added)
+++ spamassassin/branches/3.1/lib/Mail/SpamAssassin/Timeout.pm Thu Mar  9 11:51:59 2006
@@ -0,0 +1,215 @@
+# <@LICENSE>
+# Copyright 2004 Apache Software Foundation
+# 
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+# 
+#     http://www.apache.org/licenses/LICENSE-2.0
+# 
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+# </@LICENSE>
+
+=head1 NAME
+
+Mail::SpamAssassin::Timeout - safe, reliable timeouts in perl
+
+=head1 SYNOPSIS
+
+    # non-timeout code...
+
+    my $t = Mail::SpamAssassin::Timeout->new({ secs => 5 });
+    
+    $t->run(sub {
+        # code to run with a 5-second timeout...
+    });
+
+    if ($t->timed_out()) {
+        # do something...
+    }
+
+    # more non-timeout code...
+
+=head1 DESCRIPTION
+
+This module provides a safe, reliable and clean API to provide
+C<alarm(2)>-based timeouts for perl code.
+
+Note that C<$SIG{ALRM}> is used to provide the timeout, so this will not
+interrupt out-of-control regular expression matches.
+
+Nested timeouts are supported.
+
+=head1 PUBLIC METHODS
+
+=over 4
+
+=cut
+
+package Mail::SpamAssassin::Timeout;
+
+use strict;
+use warnings;
+use bytes;
+
+use vars qw{
+  @ISA
+};
+
+@ISA = qw();
+
+###########################################################################
+
+=item my $t = Mail::SpamAssassin::Timeout->new({ ... options ... });
+
+Constructor.  Options include:
+
+=over 4
+
+=item secs => $seconds
+
+timeout, in seconds.  Optional; if not specified, no timeouts will be applied.
+
+=back
+
+=cut
+
+sub new {
+  my ($class, $opts) = @_;
+  $class = ref($class) || $class;
+  my %selfval = $opts ? %{$opts} : ();
+  my $self = \%selfval;
+
+  bless ($self, $class);
+  $self;
+}
+
+###########################################################################
+
+=item $t->run($coderef)
+
+Run a code reference within the currently-defined timeout.
+
+The timeout is as defined by the B<secs> parameter to the constructor.
+
+Returns whatever the subroutine returns, or C<undef> on timeout.
+If the timer times out, C<$t-<gt>timed_out()> will return C<1>.
+
+Time elapsed is not cumulative; multiple runs of C<run> will restart the
+timeout from scratch.
+
+=item $t->run_and_catch($coderef)
+
+Run a code reference, as per C<$t-<gt>run()>, but also catching any
+C<die()> calls within the code reference.
+
+Returns C<undef> if no C<die()> call was executed and C<$@> was unset, or the
+value of C<$@> if it was set.  (The timeout event doesn't count as a C<die()>.)
+
+=cut
+
+sub run { $_[0]->_run($_[1], 0); }
+
+sub run_and_catch { $_[0]->_run($_[1], 1); }
+
+sub _run {      # private
+  my ($self, $sub, $and_catch) = @_;
+
+  delete $self->{timed_out};
+
+  if (!$self->{secs}) { # no timeout!  just call the sub and return.
+    return &$sub;
+  }
+
+  # assertion
+  if ($self->{secs} < 0) {
+    die "Mail::SpamAssassin::Timeout: oops? neg value for 'secs': $self->{secs}";
+  }
+
+  my $oldalarm = 0;
+  my $ret;
+
+  eval {
+    # note use of local to ensure closed scope here
+    local $SIG{ALRM} = sub { die "__alarm__ignore__\n" };
+    local $SIG{__DIE__};   # bug 4631
+
+    $oldalarm = alarm($self->{secs});
+
+    $ret = &$sub;
+
+    # Unset the alarm() before we leave eval{ } scope, as that stack-pop
+    # operation can take a second or two under load. Note: previous versions
+    # restored $oldalarm here; however, that is NOT what we want to do, since
+    # it creates a new race condition, namely that an old alarm could then fire
+    # while the stack-pop was underway, thereby appearing to be *this* timeout
+    # timing out. In terms of how we might possibly have nested timeouts in
+    # SpamAssassin, this is an academic issue with little impact, but it's
+    # still worth avoiding anyway.
+
+    alarm 0;
+  };
+
+  my $err = $@;
+
+  if (defined $oldalarm) {
+    # now, we could have died from a SIGALRM == timed out.  if so,
+    # restore the previously-active one, or zero all timeouts if none
+    # were previously active.
+    alarm $oldalarm;
+  }
+
+  if ($err) {
+    if ($err =~ /__alarm__ignore__/) {
+      $self->{timed_out} = 1;
+    } else {
+      if ($and_catch) {
+        return $@;
+      } else {
+        die $@;             # propagate any "real" errors
+      }
+    }
+  }
+
+  if ($and_catch) {
+    return;                 # undef
+  } else {
+    return $ret;
+  }
+}
+
+###########################################################################
+
+=item $t->timed_out()
+
+Returns C<1> if the most recent code executed in C<run()> timed out, or
+C<undef> if it did not.
+
+=cut
+
+sub timed_out {
+  my ($self) = @_;
+  return $self->{timed_out};
+}
+
+###########################################################################
+
+=item $t->reset()
+
+If called within a C<run()> code reference, causes the current alarm timer to
+be reset to its starting value.
+
+=cut
+
+sub reset {
+  my ($self) = @_;
+  alarm($self->{secs});
+}
+
+###########################################################################
+
+1;

Modified: spamassassin/branches/3.1/spamd/spamd.raw
URL: http://svn.apache.org/viewcvs/spamassassin/branches/3.1/spamd/spamd.raw?rev=384590&r1=384589&r2=384590&view=diff
==============================================================================
--- spamassassin/branches/3.1/spamd/spamd.raw (original)
+++ spamassassin/branches/3.1/spamd/spamd.raw Thu Mar  9 11:51:59 2006
@@ -2049,6 +2049,9 @@
   foreach (keys %children) {
     kill 'INT' => $_;
     my $pid = waitpid($_, 0);
+    if ($scaling) {
+      $scaling->child_exited($pid);
+    }
     info("spamd: child $pid killed successfully");
   }
   %children = ();