File Coverage

blib/lib/FCGI/ProcManager.pm
Criterion Covered Total %
statement 44 171 25.7
branch 10 74 13.5
condition 12 33 36.3
subroutine 12 37 32.4
pod 27 27 100.0
total 105 342 30.7


line stmt bran cond sub pod time code
1             package FCGI::ProcManager;
2              
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.
7              
8             # $Id: ProcManager.pm,v 1.23 2001/04/23 16:10:11 muaddie Exp $
9              
10 2     2   7577 use strict;
  2         3  
  2         45  
11 2     2   5 use Exporter;
  2         7  
  2         67  
12 2     2   850 use POSIX qw(:signal_h);
  2         10185  
  2         8  
13              
14 2     2   1920 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q $SIG_CODEREF);
  2         2  
  2         210  
15             BEGIN {
16 2     2   2 $VERSION = '0.27';
17 2         87 $VERSION = eval $VERSION;
18 2         16 @ISA = qw(Exporter);
19 2         4 @EXPORT_OK = qw(pm_manage pm_die pm_wait
20             pm_write_pid_file pm_remove_pid_file
21             pm_pre_dispatch pm_post_dispatch
22             pm_change_process_name pm_received_signal pm_parameter
23             pm_warn pm_notify pm_abort pm_exit
24             $SIG_CODEREF);
25 2         4 $EXPORT_TAGS{all} = \@EXPORT_OK;
26 2         279 $FCGI::ProcManager::Default = 'FCGI::ProcManager';
27             }
28              
29             =head1 NAME
30              
31             FCGI::ProcManager - functions for managing FastCGI applications.
32              
33             =head1 SYNOPSIS
34              
35             # In Object-oriented style.
36             use CGI::Fast;
37             use FCGI::ProcManager;
38             my $proc_manager = FCGI::ProcManager->new({
39             n_processes => 10
40             });
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();
46             }
47              
48             # This style is also supported:
49             use CGI::Fast;
50             use FCGI::ProcManager qw(pm_manage pm_pre_dispatch
51             pm_post_dispatch);
52             pm_manage( n_processes => 10 );
53             while (my $cgi = CGI::Fast->new()) {
54             pm_pre_dispatch();
55             #...
56             pm_post_dispatch();
57             }
58              
59             =head1 DESCRIPTION
60              
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
66              
67             The primary routine, C, 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)).
70              
71             C provides too hooks:
72              
73             C - called just before the manager enters the manager loop.
74             C - called just before a server is returns from C
75              
76             It is necessary for the caller, when implementing its request loop, to
77             insert a call to C at the top of the loop, and then
78             7C at the end of the loop.
79              
80             =head2 Signal Handling
81              
82             FCGI::ProcManager attempts to do the right thing for proper shutdowns now.
83              
84             When it receives a SIGHUP, it sends a SIGTERM to each of its children, and
85             then resumes its normal operations.
86              
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.
93              
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 L's description of
96             FAIL_ACCEPT_ON_INTR. Unfortunately, if you want/need to use L, it
97             is currently necessary to run the latest (at the time of writing) development
98             version of FCGI.pm. (>= 0.71_02)
99              
100             Otherwise, if you don't, there is a loop around accept(2) which prevents
101             os_unix.c OS_Accept() from returning the necessary error when FastCGI
102             servers blocking on accept(2) receive the SIGTERM or SIGHUP.
103              
104             FCGI::ProcManager uses POSIX::sigaction() to override the default SA_RESTART
105             policy used for perl's %SIG behavior. Specifically, the process manager
106             never uses SA_RESTART, while the child FastCGI servers turn off SA_RESTART
107             around the accept(2) loop, but reinstate it otherwise.
108              
109             The desired (and implemented) effect is to give a request as big a chance as
110             possible to succeed and to delay their exits until after their request,
111             while allowing the FastCGI servers waiting for new requests to die right
112             away.
113              
114             =head1 METHODS
115              
116             =head2 new
117              
118             class or instance
119             (ProcManager) new([hash parameters])
120              
121             Constructs a new process manager. Takes an option has of initial parameter
122             values, and assigns these to the constructed object HASH, overriding any
123             default values. The default parameter values currently are:
124              
125             role => manager
126             start_delay => 0
127             die_timeout => 60
128             pm_title => 'perl-fcgi-pm'
129              
130             =cut
131              
132             sub new {
133 2     2 1 12 my ($proto,$init) = @_;
134 2   50     12 $init ||= {};
135              
136 2         11 my $this = {
137             role => "manager",
138             start_delay => 0,
139             die_timeout => 60,
140             pm_title => 'perl-fcgi-pm',
141             %$init
142             };
143 2   33     9 bless $this, ref($proto)||$proto;
144              
145 2         10 $this->{PIDS} = {};
146              
147             # initialize signal constructions.
148 2 50 33     7 unless ($this->no_signals() or $^O eq 'MSWin32') {
149             $this->{sigaction_no_sa_restart} =
150 2         16 POSIX::SigAction->new('FCGI::ProcManager::sig_sub');
151             $this->{sigaction_sa_restart} =
152 2         16 POSIX::SigAction->new('FCGI::ProcManager::sig_sub',undef,POSIX::SA_RESTART);
153             }
154              
155 2         13 return $this;
156             }
157              
158             sub _set_signal_handler {
159 0     0   0 my ($this, $signal, $restart);
160              
161 0 0       0 if ($^O eq 'MSWin32') {
162 0         0 $SIG{$signal} = 'FCGI::ProcManager::sig_sub';
163             } else {
164 2     2   6 no strict 'refs';
  2         2  
  2         2768  
165 0         0 sigaction(&{"POSIX::SIG$signal"}(), $restart ? $this->{sigaction_sa_restart} : $this->{sigaction_no_sa_restart})
166 0 0       0 or $this->pm_warn("sigaction: SIG$signal: $!");
    0          
167             }
168             }
169              
170             =head1 Manager methods
171              
172             =head2 pm_manage
173              
174             instance or export
175             (int) pm_manage([hash parameters])
176              
177             DESCRIPTION:
178              
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.
183              
184             If n_processes < 1, the managing section is subverted, and only the
185             handling sequence is executed.
186              
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
189             handling requests.
190              
191             =cut
192              
193             sub pm_manage {
194 2     2 1 5 my ($this,%values) = self_or_default(@_);
195 2         10 map { $this->pm_parameter($_,$values{$_}) } keys %values;
  0         0  
196              
197 2         34 local $SIG{CHLD}; # Replace the SIGCHLD default handler in case
198             # somebody shit on it whilst loading code.
199              
200             # skip to handling now if we won't be managing any processes.
201 2 50       6 $this->n_processes() or return;
202              
203             # call the (possibly overloaded) management initialization hook.
204 0         0 $this->role("manager");
205 0         0 $this->managing_init();
206 0         0 $this->pm_notify("initialized");
207              
208 0         0 my $manager_pid = $$;
209              
210 0         0 MANAGING_LOOP: while (1) {
211              
212 0 0       0 $this->n_processes() > 0 or
213             return $this->pm_die();
214              
215             # while we have fewer servers than we want.
216 0         0 PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
  0         0  
217              
218 0 0       0 if (my $pid = fork()) {
    0          
219             # the manager remembers the server.
220 0         0 $this->{PIDS}->{$pid} = { pid=>$pid };
221 0         0 $this->pm_notify("server (pid $pid) started");
222              
223             } elsif (! defined $pid) {
224 0         0 return $this->pm_abort("fork: $!");
225              
226             } else {
227 0         0 $this->{MANAGER_PID} = $manager_pid;
228             # the server exits the managing loop.
229 0         0 last MANAGING_LOOP;
230             }
231              
232 0         0 for (my $s = $this->start_delay(); $s > 0; $s -= sleep $s) {};
233             }
234              
235             # this should block until the next server dies.
236 0         0 $this->pm_wait();
237              
238             }# while 1
239              
240             HANDLING:
241              
242             # forget any children we had been collecting.
243 0         0 delete $this->{PIDS};
244              
245             # call the (possibly overloaded) handling init hook
246 0         0 $this->role("server");
247 0         0 $this->handling_init();
248 0         0 $this->pm_notify("initialized");
249              
250             # server returns
251 0         0 return 1;
252             }
253              
254             =head2 managing_init
255              
256             instance
257             () managing_init()
258              
259             DESCRIPTION:
260              
261             Overrideable method which initializes a process manager. In order to
262             handle signals, manage the PID file, and change the process name properly,
263             any method which overrides this should call SUPER::managing_init().
264              
265             =cut
266              
267             sub managing_init {
268 0     0 1 0 my ($this) = @_;
269              
270             # begin to handle signals.
271             # We do NOT want SA_RESTART in the process manager.
272             # -- we want start the shutdown sequence immediately upon SIGTERM.
273 0 0       0 unless ($this->no_signals()) {
274 0         0 $this->_set_signal_handler('TERM', 0);
275 0         0 $this->_set_signal_handler('HUP', 0);
276 0     0   0 $SIG_CODEREF = sub { $this->sig_manager(@_) };
  0         0  
277             }
278              
279             # change the name of this process as it appears in ps(1) output.
280 0         0 $this->pm_change_process_name($this->pm_parameter('pm_title'));
281              
282 0         0 $this->pm_write_pid_file();
283             }
284              
285             =head2 pm_die
286              
287             instance or export
288             () pm_die(string msg[, int exit_status])
289              
290             DESCRIPTION:
291              
292             This method is called when a process manager receives a notification to
293             shut itself down. pm_die() attempts to shutdown the process manager
294             gently, sending a SIGTERM to each managed process, waiting die_timeout()
295             seconds to reap each process, and then exit gracefully once all children
296             are reaped, or to abort if all children are not reaped.
297              
298             =cut
299              
300             sub pm_die {
301 0     0 1 0 my ($this,$msg,$n) = self_or_default(@_);
302              
303             # stop handling signals.
304 0         0 undef $SIG_CODEREF;
305 0         0 $SIG{HUP} = 'DEFAULT';
306 0         0 $SIG{TERM} = 'DEFAULT';
307              
308 0         0 $this->pm_remove_pid_file();
309              
310             # prepare to die no matter what.
311 0 0       0 if (defined $this->die_timeout()) {
312 0     0   0 $SIG{ALRM} = sub { $this->pm_abort("wait timeout") };
  0         0  
313 0         0 alarm $this->die_timeout();
314             }
315              
316             # send a TERM to each of the servers.
317 0 0       0 if (my @pids = keys %{$this->{PIDS}}) {
  0         0  
318 0         0 $this->pm_notify("sending TERM to PIDs, @pids");
319 0         0 kill "TERM", @pids;
320             }
321              
322             # wait for the servers to die.
323 0         0 while (%{$this->{PIDS}}) {
  0         0  
324 0         0 $this->pm_wait();
325             }
326              
327             # die already.
328 0         0 $this->pm_exit("dying: ".$msg,$n);
329             }
330              
331             =head2 pm_wait
332              
333             instance or export
334             (int pid) pm_wait()
335              
336             DESCRIPTION:
337              
338             This calls wait() which suspends execution until a child has exited.
339             If the process ID returned by wait corresponds to a managed process,
340             pm_notify() is called with the exit status of that process.
341             pm_wait() returns with the return value of wait().
342              
343             =cut
344              
345             sub pm_wait {
346 0     0 1 0 my ($this) = self_or_default(@_);
347              
348             # wait for the next server to die.
349 0 0       0 return if ((my $pid = wait()) < 0);
350              
351             # notify when one of our servers have died.
352 0 0       0 delete $this->{PIDS}->{$pid} and
353             $this->pm_notify("server (pid $pid) exited with status $?");
354              
355 0         0 return $pid;
356             }
357              
358             =head2 pm_write_pid_file
359              
360             instance or export
361             () pm_write_pid_file([string filename])
362              
363             DESCRIPTION:
364              
365             Writes current process ID to optionally specified file. If no filename is
366             specified, it uses the value of the C parameter.
367              
368             =cut
369              
370             sub pm_write_pid_file {
371 0     0 1 0 my ($this,$fname) = self_or_default(@_);
372 0 0 0     0 $fname ||= $this->pid_fname() or return;
373 0         0 my $PIDFILE;
374 0 0       0 if (!open $PIDFILE, ">$fname") {
375 0         0 $this->pm_warn("open: $fname: $!");
376 0         0 return;
377             }
378 0 0       0 print $PIDFILE "$$\n" or die "Could not print PID: $!";
379 0 0       0 close $PIDFILE or die "Could not close PID file: $!";
380             }
381              
382             =head2 pm_remove_pid_file
383              
384             instance or export
385             () pm_remove_pid_file()
386              
387             DESCRIPTION:
388              
389             Removes optionally specified file. If no filename is specified, it uses
390             the value of the C parameter.
391              
392             =cut
393              
394             sub pm_remove_pid_file {
395 0     0 1 0 my ($this,$fname) = self_or_default(@_);
396 0 0 0     0 $fname ||= $this->pid_fname() or return;
397 0 0       0 my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
398 0         0 return $ret;
399             }
400              
401             =head2 sig_sub
402              
403             instance
404             () sig_sub(string name)
405              
406             DESCRIPTION:
407              
408             The name of this method is passed to POSIX::sigaction(), and handles signals
409             for the process manager. If $SIG_CODEREF is set, then the input arguments
410             to this are passed to a call to that.
411              
412             =cut
413              
414             sub sig_sub {
415 0 0   0 1 0 $SIG_CODEREF->(@_) if ref $SIG_CODEREF;
416             }
417              
418             =head2 sig_manager
419              
420             instance
421             () sig_manager(string name)
422              
423             DESCRIPTION:
424              
425             Handles signals of the process manager. Takes as input the name of signal
426             being handled.
427              
428             =cut
429              
430             sub sig_manager {
431 0     0 1 0 my ($this,$name) = @_;
432 0 0       0 if ($name eq "TERM") {
    0          
433 0         0 $this->pm_notify("received signal $name");
434 0         0 $this->pm_die("safe exit from signal $name");
435             } elsif ($name eq "HUP") {
436             # send a TERM to each of the servers, and pretend like nothing happened..
437 0 0       0 if (my @pids = keys %{$this->{PIDS}}) {
  0         0  
438 0         0 $this->pm_notify("sending TERM to PIDs, @pids");
439 0         0 kill "TERM", @pids;
440             }
441             } else {
442 0         0 $this->pm_notify("ignoring signal $name");
443             }
444             }
445              
446             =head1 Handler methods
447              
448             =head2 handling_init
449              
450             instance or export
451             () handling_init()
452              
453             DESCRIPTION:
454              
455             =cut
456              
457             sub handling_init {
458 0     0 1 0 my ($this) = @_;
459              
460             # begin to handle signals.
461             # We'll want accept(2) to return -1(EINTR) on caught signal..
462 0 0       0 unless ($this->no_signals()) {
463 0         0 $this->_set_signal_handler('TERM', 0);
464 0         0 $this->_set_signal_handler('HUP', 0);
465 0     0   0 $SIG_CODEREF = sub { $this->sig_handler(@_) };
  0         0  
466             }
467              
468             # change the name of this process as it appears in ps(1) output.
469 0         0 $this->pm_change_process_name("perl-fcgi");
470              
471             # Re-srand in case someone called rand before the fork, so that
472             # children get different random numbers.
473 0         0 srand;
474             }
475              
476             =head2 pm_pre_dispatch
477              
478             instance or export
479             () pm_pre_dispatch()
480              
481             DESCRIPTION:
482              
483             =cut
484              
485             sub pm_pre_dispatch {
486 0     0 1 0 my ($this) = self_or_default(@_);
487              
488             # Now, we want the request to continue unhindered..
489 0 0       0 unless ($this->no_signals()) {
490 0         0 $this->_set_signal_handler('TERM', 1);
491 0         0 $this->_set_signal_handler('HUP', 1);
492             }
493             }
494              
495             =head2 pm_post_dispatch
496              
497             instance or export
498             () pm_post_dispatch()
499              
500             DESCRIPTION:
501              
502             =cut
503              
504             sub pm_post_dispatch {
505 0     0 1 0 my ($this) = self_or_default(@_);
506 0 0       0 if ($this->pm_received_signal("TERM")) {
507 0         0 $this->pm_exit("safe exit after SIGTERM");
508             }
509 0 0       0 if ($this->pm_received_signal("HUP")) {
510 0         0 $this->pm_exit("safe exit after SIGHUP");
511             }
512 0 0 0     0 if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
513 0         0 $this->pm_exit("safe exit: manager has died");
514             }
515             # We'll want accept(2) to return -1(EINTR) on caught signal..
516 0 0       0 unless ($this->no_signals()) {
517 0         0 $this->_set_signal_handler('TERM', 0);
518 0         0 $this->_set_signal_handler('HUP', 0);
519             }
520             }
521              
522             =head2 sig_handler
523              
524             instance or export
525             () sig_handler()
526              
527             DESCRIPTION:
528              
529             =cut
530              
531             sub sig_handler {
532 0     0 1 0 my ($this,$name) = @_;
533 0         0 $this->pm_received_signal($name,1);
534             }
535              
536             =head1 Common methods and routines
537              
538             =head2 self_or_default
539              
540             private global
541             (ProcManager, @args) self_or_default([ ProcManager, ] @args);
542              
543             DESCRIPTION:
544              
545             This is a helper subroutine to acquire or otherwise create a singleton
546             default object if one is not passed in, e.g., a method call.
547              
548             =cut
549              
550             sub self_or_default {
551 12 50 100 12 1 53 return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
      66        
552 12 100 66     63 if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
      66        
553             !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
554 4 100       11 $Q or $Q = $FCGI::ProcManager::Default->new;
555 4         5 unshift @_, $Q;
556             }
557 12 50       44 return wantarray ? @_ : $Q;
558             }
559              
560             =head2 pm_change_process_name
561              
562             instance or export
563             () pm_change_process_name()
564              
565             DESCRIPTION:
566              
567             =cut
568              
569             sub pm_change_process_name {
570 0     0 1 0 my ($this,$name) = self_or_default(@_);
571 0         0 $0 = $name;
572             }
573              
574             =head2 pm_received_signal
575              
576             instance or export
577             () pm_received signal()
578              
579             DESCRIPTION:
580              
581             =cut
582              
583             sub pm_received_signal {
584 0     0 1 0 my ($this,$sig,$received) = self_or_default(@_);
585 0 0       0 $sig or return $this->{SIG_RECEIVED};
586 0 0       0 $received and $this->{SIG_RECEIVED}->{$sig}++;
587 0         0 return $this->{SIG_RECEIVED}->{$sig};
588             }
589              
590             =head1 parameters
591              
592             =head2 pm_parameter
593              
594             instance or export
595             () pm_parameter()
596              
597             DESCRIPTION:
598              
599             =cut
600              
601             sub pm_parameter {
602 10     10 1 26 my ($this,$key,$value) = self_or_default(@_);
603 10 100       28 defined $value and $this->{$key} = $value;
604 10         42 return $this->{$key};
605             }
606              
607             =head2 n_processes
608              
609             =head2 no_signals
610              
611             =head2 pid_fname
612              
613             =head2 die_timeout
614              
615             =head2 role
616              
617             =head2 start_delay
618              
619             DESCRIPTION:
620              
621             =cut
622              
623 5     5 1 14 sub n_processes { shift->pm_parameter("n_processes", @_); }
624 0     0 1 0 sub pid_fname { shift->pm_parameter("pid_fname", @_); }
625 2     2 1 8 sub no_signals { shift->pm_parameter("no_signals", @_); }
626 0     0 1   sub die_timeout { shift->pm_parameter("die_timeout", @_); }
627 0     0 1   sub role { shift->pm_parameter("role", @_); }
628 0     0 1   sub start_delay { shift->pm_parameter("start_delay", @_); }
629              
630             =head1 notification and death
631              
632             =head2 pm_warn
633              
634             instance or export
635             () pm_warn()
636              
637             DESCRIPTION:
638              
639             =cut
640              
641             sub pm_warn {
642 0     0 1   my ($this,$msg) = self_or_default(@_);
643 0           $this->pm_notify($msg);
644             }
645              
646             =head2 pm_notify
647              
648             instance or export
649             () pm_notify()
650              
651             DESCRIPTION:
652              
653             =cut
654              
655             sub pm_notify {
656 0     0 1   my ($this,$msg) = self_or_default(@_);
657 0           $msg =~ s/\s*$/\n/;
658 0           print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
659             }
660              
661             =head2 pm_exit
662              
663             instance or export
664             () pm_exit(string msg[, int exit_status])
665              
666             DESCRIPTION:
667              
668             =cut
669              
670             sub pm_exit {
671 0     0 1   my ($this,$msg,$n) = self_or_default(@_);
672 0   0       $n ||= 0;
673              
674             # if we still have children at this point, something went wrong.
675             # SIGKILL them now.
676 0 0         kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
  0            
677              
678 0           $this->pm_warn($msg);
679 0           $@ = $msg;
680 0           exit $n;
681             }
682              
683             =head2 pm_abort
684              
685             instance or export
686             () pm_abort(string msg[, int exit_status])
687              
688             DESCRIPTION:
689              
690             =cut
691              
692             sub pm_abort {
693 0     0 1   my ($this,$msg,$n) = self_or_default(@_);
694 0   0       $n ||= 1;
695 0           $this->pm_exit($msg,1);
696             }
697              
698             1;
699             __END__