[perl-Sendmail-PMilter] Fix some process control issues
Paul Howarth
pghmcfc at fedoraproject.org
Thu Jun 13 12:43:24 UTC 2013
commit 0b08cb324def8fef9def2e0bade82b743362349a
Author: Paul Howarth <paul at city-fan.org>
Date: Thu Jun 13 13:38:37 2013 +0100
Fix some process control issues
- Reset SIGCHLD handler in milters (CPAN RT#85826, #970138)
- Block instead of erroring on max children (CPAN RT#85833, #970197)
- BR: perl(Thread::Semaphore) and perl(Time::HiRes)
- BR:/R: all optional modules for different socket/dispatcher styles
Sendmail-PMilter-1.00-protocol.patch | 106 ++++++++++++++++++++++++++++++++++
Sendmail-PMilter-1.00-sigchld.patch | 10 +++
perl-Sendmail-PMilter.spec | 31 ++++++++++-
3 files changed, 146 insertions(+), 1 deletions(-)
---
diff --git a/Sendmail-PMilter-1.00-protocol.patch b/Sendmail-PMilter-1.00-protocol.patch
new file mode 100644
index 0000000..7091623
--- /dev/null
+++ b/Sendmail-PMilter-1.00-protocol.patch
@@ -0,0 +1,106 @@
+--- lib/Sendmail/PMilter.pm
++++ lib/Sendmail/PMilter.pm
+@@ -44,6 +44,7 @@
+ use Sendmail::Milter 0.18; # get needed constants
+ use Socket;
+ use Symbol;
++use Time::HiRes 'time';
+ use UNIVERSAL;
+
+ our $VERSION = '1.00';
+@@ -654,6 +655,7 @@
+ sub ithread_dispatcher {
+ require threads;
+ require threads::shared;
++ require Thread::Semaphore;
+
+ my $nchildren = 0;
+
+@@ -664,6 +666,11 @@
+ my $lsocket = shift;
+ my $handler = shift;
+ my $maxchildren = $this->get_max_interpreters();
++ my $child_sem;
++
++ if ($maxchildren) {
++ $child_sem = Thread::Semaphore->new($maxchildren);
++ }
+
+ my $siginfo = exists($SIG{INFO}) ? 'INFO' : 'USR1';
+ local $SIG{$siginfo} = sub {
+@@ -681,6 +688,9 @@
+
+ lock($nchildren);
+ $nchildren--;
++ if ($child_sem) {
++ $child_sem->up();
++ }
+ warn $died if $died;
+ };
+
+@@ -690,18 +700,12 @@
+
+ warn "$$: incoming connection\n" if ($DEBUG > 0);
+
+- # If the load's too high, fail and go back to top of loop.
+- if ($maxchildren) {
+- my $cnchildren = $nchildren; # make constant
+-
+- if ($cnchildren >= $maxchildren) {
+- warn "load too high: children $cnchildren >= max $maxchildren";
+-
+- $socket->autoflush(1);
+- $socket->print(pack('N/a*', 't')); # SMFIR_TEMPFAIL
+- $socket->close();
+- next;
+- }
++ if ($child_sem and ! $child_sem->down_nb()) {
++ warn "pausing for high load: children $nchildren >= max $maxchildren";
++ my $start = time();
++ $child_sem->down();
++ my $end = time();
++ warn sprintf("paused for %.1f seconds due to high load", $end - $start);
+ }
+
+ # scoping block for lock()
+@@ -867,6 +871,10 @@
+ otherwise mostly idle mail traffic, as the idle-time resource consumption is
+ very low.
+
++If the maximum number of interpreters is running when a new connection
++comes in, this dispatcher blocks until a slot becomes available for a
++new interpreter.
++
+ =cut
+
+ sub postfork_dispatcher () {
+@@ -900,17 +908,22 @@
+ warn "$$: incoming connection\n" if ($DEBUG > 0);
+
+ # If the load's too high, fail and go back to top of loop.
+- if ($maxchildren) {
++ my $paused = undef;
++ while ($maxchildren) {
+ my $cnchildren = $nchildren; # make constant
+
+ if ($cnchildren >= $maxchildren) {
+- warn "load too high: children $cnchildren >= max $maxchildren";
+-
+- $socket->autoflush(1);
+- $socket->print(pack('N/a*', 't')); # SMFIR_TEMPFAIL
+- $socket->close();
+- next;
++ warn "pausing for high load: children $cnchildren >= max $maxchildren";
++ $paused = time() if (! $paused);
++ pause();
+ }
++ else {
++ last;
++ }
++ }
++
++ if ($paused) {
++ warn sprintf("paused for %.1f seconds due to high load", time() - $paused);
+ }
+
+ my $pid = fork();
diff --git a/Sendmail-PMilter-1.00-sigchld.patch b/Sendmail-PMilter-1.00-sigchld.patch
new file mode 100644
index 0000000..90067bb
--- /dev/null
+++ b/Sendmail-PMilter-1.00-sigchld.patch
@@ -0,0 +1,10 @@
+--- lib/Sendmail/PMilter.pm
++++ lib/Sendmail/PMilter.pm
+@@ -925,6 +925,7 @@
+ undef $lsocket;
+ undef $@;
+ $SIG{PIPE} = 'IGNORE'; # so close_callback will be reached
++ $SIG{CHLD} = 'DEFAULT';
+ $SIG{$siginfo} = 'DEFAULT';
+
+ &$handler($socket);
diff --git a/perl-Sendmail-PMilter.spec b/perl-Sendmail-PMilter.spec
index 829eb10..0fca30b 100644
--- a/perl-Sendmail-PMilter.spec
+++ b/perl-Sendmail-PMilter.spec
@@ -1,7 +1,7 @@
Summary: Perl binding of Sendmail Milter protocol
Name: perl-Sendmail-PMilter
Version: 1.00
-Release: 7%{?dist}
+Release: 8%{?dist}
License: BSD
Group: Development/Libraries
URL: http://search.cpan.org/dist/Sendmail-PMilter/
@@ -10,6 +10,8 @@ Patch0: Sendmail-PMilter-Context.pm_pod.patch
Patch1: Sendmail-PMilter-0.97-setdbg-settimeout.patch
Patch2: Sendmail-PMilter-0.97-data-command.patch
Patch3: Sendmail-PMilter-1.00-macro-head.patch
+Patch4: Sendmail-PMilter-1.00-sigchld.patch
+Patch5: Sendmail-PMilter-1.00-protocol.patch
BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(id -nu)
BuildArch: noarch
BuildRequires: perl(base)
@@ -17,9 +19,24 @@ BuildRequires: perl(Carp)
BuildRequires: perl(constant)
BuildRequires: perl(ExtUtils::MakeMaker)
BuildRequires: perl(IO::Select)
+BuildRequires: perl(IO::Socket::INET)
+BuildRequires: perl(IO::Socket::INET6)
+BuildRequires: perl(IO::Socket::UNIX)
BuildRequires: perl(Socket)
+BuildRequires: perl(Socket6)
BuildRequires: perl(Test::More)
+BuildRequires: perl(threads)
+BuildRequires: perl(threads::shared)
+BuildRequires: perl(Thread::Semaphore)
+BuildRequires: perl(Time::HiRes)
Requires: perl(:MODULE_COMPAT_%(eval "`perl -V:version`"; echo $version))
+Requires: perl(IO::Socket::INET)
+Requires: perl(IO::Socket::INET6)
+Requires: perl(IO::Socket::UNIX)
+Requires: perl(Socket6)
+Requires: perl(threads)
+Requires: perl(threads::shared)
+Requires: perl(Thread::Semaphore)
Obsoletes: perl-Sendmail-Milter <= 0.18
%description
@@ -51,6 +68,12 @@ called Mail::Milter.
# Fix addheader, getsymval bugs (CPAN RT#84941, #957886)
%patch3 -p1
+# Reset SIGCHLD handler in milters (CPAN RT#85826, #970138)
+%patch4
+
+# Block instead of erroring on max children (CPAN RT#85833, #970197)
+%patch5
+
# Fix interpreters in examples and turn off exec bits to avoid extra deps
sed -i -e 's@/usr/local/bin/perl@/usr/bin/perl@' examples/*.pl
chmod -x examples/*.pl
@@ -81,6 +104,12 @@ rm -rf %{buildroot}
%{_mandir}/man3/Sendmail::PMilter::Context.3pm*
%changelog
+* Thu Jun 13 2013 Paul Howarth <paul at city-fan.org> - 1.00-8
+- Reset SIGCHLD handler in milters (CPAN RT#85826, #970138)
+- Block instead of erroring on max children (CPAN RT#85833, #970197)
+- BR: perl(Thread::Semaphore) and perl(Time::HiRes)
+- BR:/R: all optional modules for different socket/dispatcher styles
+
* Tue Apr 30 2013 Paul Howarth <paul at city-fan.org> - 1.00-7
- Fix addheader, getsymval bugs (CPAN RT#84941, #957886)
- Don't need to remove empty directories from the buildroot
More information about the perl-devel
mailing list