1 package FCGI::ProcManager;
3 # Copyright (c) 2000, FundsXpress Financial Network, Inc.
4 # This library is free software released under the GNU Lesser General
5 # Public License, Version 2.1. Please read the important licensing and
6 # disclaimer information included below.
8 # $Id: ProcManager.pm,v 1.23 2001/04/23 16:10:11 muaddie Exp $
12 use POSIX qw(:signal_h);
14 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q $SIG_CODEREF);
18 @EXPORT_OK = qw(pm_manage pm_die pm_wait
19 pm_write_pid_file pm_remove_pid_file
20 pm_pre_dispatch pm_post_dispatch
21 pm_change_process_name pm_received_signal pm_parameter
22 pm_warn pm_notify pm_abort pm_exit
24 $EXPORT_TAGS{all} = \@EXPORT_OK;
25 $FCGI::ProcManager::Default = 'FCGI::ProcManager';
30 FCGI::ProcManager - functions for managing FastCGI applications.
35 # In Object-oriented style.
37 use FCGI::ProcManager;
38 my $proc_manager = FCGI::ProcManager->new({
41 $proc_manager->pm_manage();
42 while (my $cgi = CGI::Fast->new()) {
43 $proc_manager->pm_pre_dispatch();
44 # ... handle the request here ...
45 $proc_manager->pm_post_dispatch();
48 # This style is also supported:
50 use FCGI::ProcManager qw(pm_manage pm_pre_dispatch
52 pm_manage( n_processes => 10 );
53 while (my $cgi = CGI::Fast->new()) {
61 FCGI::ProcManager is used to serve as a FastCGI process manager. By
62 re-implementing it in perl, developers can more finely tune performance in
63 their web applications, and can take advantage of copy-on-write semantics
64 prevalent in UNIX kernel process management. The process manager should
65 be invoked before the caller''s request loop
67 The primary routine, C<pm_manage>, enters a loop in which it maintains a
68 number of FastCGI servers (via fork(2)), and which reaps those servers
69 when they die (via wait(2)).
71 C<pm_manage> provides too hooks:
73 C<managing_init> - called just before the manager enters the manager loop.
74 C<handling_init> - called just before a server is returns from C<pm_manage>
76 It is necessary for the caller, when implementing its request loop, to
77 insert a call to C<pm_pre_dispatch> at the top of the loop, and then
78 7C<pm_post_dispatch> at the end of the loop.
80 =head2 Signal Handling
82 FCGI::ProcManager attempts to do the right thing for proper shutdowns now.
84 When it receives a SIGHUP, it sends a SIGTERM to each of its children, and
85 then resumes its normal operations.
87 When it receives a SIGTERM, it sends a SIGTERM to each of its children, sets
88 an alarm(3) "die timeout" handler, and waits for each of its children to
89 die. If all children die before this timeout, process manager exits with
90 return status 0. If all children do not die by the time the "die timeout"
91 occurs, the process manager sends a SIGKILL to each of the remaining
92 children, and exists with return status 1.
94 In order to get FastCGI servers to exit upon receiving a signal, it is
95 necessary to use its FAIL_ACCEPT_ON_INTR. See FCGI.pm's description of
96 FAIL_ACCEPT_ON_INTR. Unfortunately, if you want/need to use CGI::Fast, it
97 appears currently necessary to modify your installation of FCGI.pm, with
98 something like the following:
101 --- FCGI.pm 2001/03/09 01:44:00 1.1.1.3
102 +++ FCGI.pm 2001/03/09 01:47:32 1.2
104 *FAIL_ACCEPT_ON_INTR = sub() { 1 };
106 sub Request(;***$$$) {
107 - my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, 0);
108 + my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, FAIL_ACCEPT_ON_INTR());
109 splice @defaults,0,@_,@_;
114 Otherwise, if you don't, there is a loop around accept(2) which prevents
115 os_unix.c OS_Accept() from returning the necessary error when FastCGI
116 servers blocking on accept(2) receive the SIGTERM or SIGHUP.
118 FCGI::ProcManager uses POSIX::sigaction() to override the default SA_RESTART
119 policy used for perl's %SIG behavior. Specifically, the process manager
120 never uses SA_RESTART, while the child FastCGI servers turn off SA_RESTART
121 around the accept(2) loop, but re-enstate it otherwise.
123 The desired (and implemented) effect is to give a request as big a chance as
124 possible to succeed and to delay their exits until after their request,
125 while allowing the FastCGI servers waiting for new requests to die right
133 (ProcManager) new([hash parameters])
135 Constructs a new process manager. Takes an option has of initial parameter
136 values, and assigns these to the constructed object HASH, overriding any
137 default values. The default parameter values currently are:
146 my ($proto,$init) = @_;
155 bless $this, ref($proto)||$proto;
159 # initialize signal constructions.
160 unless ($this->no_signals()) {
161 $this->{sigaction_no_sa_restart} =
162 POSIX::SigAction->new('FCGI::ProcManager::sig_sub');
163 $this->{sigaction_sa_restart} =
164 POSIX::SigAction->new('FCGI::ProcManager::sig_sub',undef,POSIX::SA_RESTART);
170 =head1 Manager methods
175 (int) pm_manage([hash parameters])
179 When this is called by a FastCGI script to manage application servers. It
180 defines a sequence of instructions for a process to enter this method and
181 begin forking off and managing those handlers, and it defines a sequence of
182 instructions to intialize those handlers.
184 If n_processes < 1, the managing section is subverted, and only the
185 handling sequence is executed.
187 Either returns the return value of pm_die() and/or pm_abort() (which will
188 not ever return in general), or returns 1 to the calling script to begin
194 my ($this,%values) = self_or_default(@_);
195 map { $this->pm_parameter($_,$values{$_}) } keys %values;
197 # skip to handling now if we won't be managing any processes.
198 $this->n_processes() or return;
200 # call the (possibly overloaded) management initialization hook.
201 $this->role("manager");
202 $this->managing_init();
203 $this->pm_notify("initialized");
205 my $manager_pid = $$;
207 MANAGING_LOOP: while (1) {
209 # if the calling process goes away, perform cleanup.
211 return $this->pm_die("calling process has died");
213 $this->n_processes() > 0 or
214 return $this->pm_die();
216 # while we have fewer servers than we want.
217 PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
219 if (my $pid = fork()) {
220 # the manager remembers the server.
221 $this->{PIDS}->{$pid} = { pid=>$pid };
222 $this->pm_notify("server (pid $pid) started");
224 } elsif (! defined $pid) {
225 return $this->pm_abort("fork: $!");
228 $this->{MANAGER_PID} = $manager_pid;
229 # the server exits the managing loop.
233 for (my $s = $this->start_delay(); $s; $s = sleep $s) {};
236 # this should block until the next server dies.
243 # forget any children we had been collecting.
244 delete $this->{PIDS};
246 # call the (possibly overloaded) handling init hook
247 $this->role("server");
248 $this->handling_init();
249 $this->pm_notify("initialized");
262 Overrideable method which initializes a process manager. In order to
263 handle signals, manage the PID file, and change the process name properly,
264 any method which overrides this should call SUPER::managing_init().
271 # begin to handle signals.
272 # We do NOT want SA_RESTART in the process manager.
273 # -- we want start the shutdown sequence immediately upon SIGTERM.
274 unless ($this->no_signals()) {
275 sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or
276 $this->pm_warn("sigaction: SIGTERM: $!");
277 sigaction(SIGHUP, $this->{sigaction_no_sa_restart}) or
278 $this->pm_warn("sigaction: SIGHUP: $!");
279 $SIG_CODEREF = sub { $this->sig_manager(@_) };
282 # change the name of this process as it appears in ps(1) output.
283 $this->pm_change_process_name("perl-fcgi-pm");
285 $this->pm_write_pid_file();
291 () pm_die(string msg[, int exit_status])
295 This method is called when a process manager receives a notification to
296 shut itself down. pm_die() attempts to shutdown the process manager
297 gently, sending a SIGTERM to each managed process, waiting die_timeout()
298 seconds to reap each process, and then exit gracefully once all children
299 are reaped, or to abort if all children are not reaped.
304 my ($this,$msg,$n) = self_or_default(@_);
306 # stop handling signals.
308 $SIG{HUP} = 'DEFAULT';
309 $SIG{TERM} = 'DEFAULT';
311 $this->pm_remove_pid_file();
313 # prepare to die no matter what.
314 if (defined $this->die_timeout()) {
315 $SIG{ALRM} = sub { $this->pm_abort("wait timeout") };
316 alarm $this->die_timeout();
319 # send a TERM to each of the servers.
320 if (my @pids = keys %{$this->{PIDS}}) {
321 $this->pm_notify("sending TERM to PIDs, @pids");
325 # wait for the servers to die.
326 while (%{$this->{PIDS}}) {
331 $this->pm_exit("dying: ".$msg,$n);
341 This calls wait() which suspends execution until a child has exited.
342 If the process ID returned by wait corresponds to a managed process,
343 pm_notify() is called with the exit status of that process.
344 pm_wait() returns with the return value of wait().
349 my ($this) = self_or_default(@_);
351 # wait for the next server to die.
352 next if (my $pid = wait()) < 0;
354 # notify when one of our servers have died.
355 delete $this->{PIDS}->{$pid} and
356 $this->pm_notify("server (pid $pid) exited with status $?");
361 =head2 pm_write_pid_file
364 () pm_write_pid_file([string filename])
368 Writes current process ID to optionally specified file. If no filename is
369 specified, it uses the value of the C<pid_fname> parameter.
373 sub pm_write_pid_file {
374 my ($this,$fname) = self_or_default(@_);
375 $fname ||= $this->pid_fname() or return;
376 if (!open PIDFILE, ">$fname") {
377 $this->pm_warn("open: $fname: $!");
380 print PIDFILE "$$\n";
384 =head2 pm_remove_pid_file
387 () pm_remove_pid_file()
391 Removes optionally specified file. If no filename is specified, it uses
392 the value of the C<pid_fname> parameter.
396 sub pm_remove_pid_file {
397 my ($this,$fname) = self_or_default(@_);
398 $fname ||= $this->pid_fname() or return;
399 my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
406 () sig_sub(string name)
410 The name of this method is passed to POSIX::sigaction(), and handles signals
411 for the process manager. If $SIG_CODEREF is set, then the input arguments
412 to this are passed to a call to that.
417 $SIG_CODEREF->(@_) if ref $SIG_CODEREF;
423 () sig_manager(string name)
427 Handles signals of the process manager. Takes as input the name of signal
433 my ($this,$name) = @_;
434 if ($name eq "TERM") {
435 $this->pm_notify("received signal $name");
436 $this->pm_die("safe exit from signal $name");
437 } elsif ($name eq "HUP") {
438 # send a TERM to each of the servers, and pretend like nothing happened..
439 if (my @pids = keys %{$this->{PIDS}}) {
440 $this->pm_notify("sending TERM to PIDs, @pids");
444 $this->pm_notify("ignoring signal $name");
448 =head1 Handler methods
462 # begin to handle signals.
463 # We'll want accept(2) to return -1(EINTR) on caught signal..
464 unless ($this->no_signals()) {
465 sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
466 sigaction(SIGHUP, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
467 $SIG_CODEREF = sub { $this->sig_handler(@_) };
470 # change the name of this process as it appears in ps(1) output.
471 $this->pm_change_process_name("perl-fcgi");
474 =head2 pm_pre_dispatch
483 sub pm_pre_dispatch {
484 my ($this) = self_or_default(@_);
486 # Now, we want the request to continue unhindered..
487 unless ($this->no_signals()) {
488 sigaction(SIGTERM, $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
489 sigaction(SIGHUP, $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
493 =head2 pm_post_dispatch
496 () pm_post_dispatch()
502 sub pm_post_dispatch {
503 my ($this) = self_or_default(@_);
504 if ($this->pm_received_signal("TERM")) {
505 $this->pm_exit("safe exit after SIGTERM");
507 if ($this->pm_received_signal("HUP")) {
508 $this->pm_exit("safe exit after SIGHUP");
510 if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
511 $this->pm_exit("safe exit: manager has died");
513 # We'll want accept(2) to return -1(EINTR) on caught signal..
514 unless ($this->no_signals()) {
515 sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
516 sigaction(SIGHUP, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
530 my ($this,$name) = @_;
531 $this->pm_received_signal($name,1);
534 =head1 Common methods and routines
536 =head2 self_or_default
539 (ProcManager, @args) self_or_default([ ProcManager, ] @args);
543 This is a helper subroutine to acquire or otherwise create a singleton
544 default object if one is not passed in, e.g., a method call.
548 sub self_or_default {
549 return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
550 if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
551 !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
552 $Q or $Q = $FCGI::ProcManager::Default->new;
555 return wantarray ? @_ : $Q;
558 =head2 pm_change_process_name
561 () pm_change_process_name()
567 sub pm_change_process_name {
568 my ($this,$name) = self_or_default(@_);
572 =head2 pm_received_signal
575 () pm_received signal()
581 sub pm_received_signal {
582 my ($this,$sig,$received) = self_or_default(@_);
583 $sig or return $this->{SIG_RECEIVED};
584 $received and $this->{SIG_RECEIVED}->{$sig}++;
585 return $this->{SIG_RECEIVED}->{$sig};
600 my ($this,$key,$value) = self_or_default(@_);
601 defined $value and $this->{$key} = $value;
602 return $this->{$key};
621 sub n_processes { shift->pm_parameter("n_processes", @_); }
622 sub pid_fname { shift->pm_parameter("pid_fname", @_); }
623 sub no_signals { shift->pm_parameter("no_signals", @_); }
624 sub die_timeout { shift->pm_parameter("die_timeout", @_); }
625 sub role { shift->pm_parameter("role", @_); }
626 sub start_delay { shift->pm_parameter("start_delay", @_); }
628 =head1 notification and death
640 my ($this,$msg) = self_or_default(@_);
641 $this->pm_notify($msg);
654 my ($this,$msg) = self_or_default(@_);
656 print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
662 () pm_exit(string msg[, int exit_status])
669 my ($this,$msg,$n) = self_or_default(@_);
672 # if we still have children at this point, something went wrong.
674 kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
676 $this->pm_warn($msg);
684 () pm_abort(string msg[, int exit_status])
691 my ($this,$msg,$n) = self_or_default(@_);
693 $this->pm_exit($msg,1);
701 No known bugs, but this does not mean no bugs exist.
709 FCGI-ProcManager - A Perl FCGI Process Manager
710 Copyright (c) 2000, FundsXpress Financial Network, Inc.
712 This library is free software; you can redistribute it and/or
713 modify it under the terms of the GNU Lesser General Public
714 License as published by the Free Software Foundation; either
715 version 2 of the License, or (at your option) any later version.
717 BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
718 BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
719 OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
720 LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
721 MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
722 ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
723 AND EFFORT IS WITH THE YOU. See the GNU Lesser General Public
724 License for more details.
726 You should have received a copy of the GNU Lesser General Public
727 License along with this library; if not, write to the Free Software
728 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA