ProcManager.pm

   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 use strict;
  11 use Exporter;
  12 use POSIX qw(:signal_h);
  13
  14 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q $SIG_CODEREF);
  15 BEGIN {
  16   $VERSION = '0.17';
  17   @ISA = qw(Exporter);
  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
  23                   $SIG_CODEREF);
  24   $EXPORT_TAGS{all} = \@EXPORT_OK;
  25   $FCGI::ProcManager::Default = 'FCGI::ProcManager';
  26 }
  27
  28 =head1 NAME
  29
  30  FCGI::ProcManager - functions for managing FastCGI applications.
  31
  32 =head1 SYNOPSIS
  33
  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<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)).
  70
  71 C<pm_manage> provides too hooks:
  72
  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>
  75
  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.
  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 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:
  99
 100  -*- patch -*-
 101  --- FCGI.pm     2001/03/09 01:44:00     1.1.1.3
 102  +++ FCGI.pm     2001/03/09 01:47:32     1.2
 103  @@ -24,7 +24,7 @@
 104   *FAIL_ACCEPT_ON_INTR = sub() { 1 };
 105
 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,@_,@_;
 110       RequestX(@defaults);
 111   }
 112  -*- end patch -*-
 113
 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.
 117
 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.
 122
 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
 126 away.
 127
 128 =head1 METHODS
 129
 130 =head2 new
 131
 132  class or instance
 133  (ProcManager) new([hash parameters])
 134
 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:
 138
 139  role         => manager
 140  start_delay  => 0
 141  die_timeout  => 60
 142
 143 =cut
 144
 145 sub new {
 146   my ($proto,$init) = @_;
 147   $init ||= {};
 148
 149   my $this = {
 150               role => "manager",
 151               start_delay => 0,
 152               die_timeout => 60,
 153               %$init
 154              };
 155   bless $this, ref($proto)||$proto;
 156
 157   $this->{PIDS} = {};
 158
 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);
 165   }
 166
 167   return $this;
 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   my ($this,%values) = self_or_default(@_);
 195   map { $this->pm_parameter($_,$values{$_}) } keys %values;
 196
 197   # skip to handling now if we won't be managing any processes.
 198   $this->n_processes() or return;
 199
 200   # call the (possibly overloaded) management initialization hook.
 201   $this->role("manager");
 202   $this->managing_init();
 203   $this->pm_notify("initialized");
 204
 205   my $manager_pid = $$;
 206
 207  MANAGING_LOOP: while (1) {
 208
 209     # if the calling process goes away, perform cleanup.
 210     getppid() == 1 and
 211       return $this->pm_die("calling process has died");
 212
 213     $this->n_processes() > 0 or
 214       return $this->pm_die();
 215
 216     # while we have fewer servers than we want.
 217   PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
 218
 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");
 223
 224       } elsif (! defined $pid) {
 225         return $this->pm_abort("fork: $!");
 226
 227       } else {
 228         $this->{MANAGER_PID} = $manager_pid;
 229         # the server exits the managing loop.
 230         last MANAGING_LOOP;
 231       }
 232
 233       for (my $s = $this->start_delay(); $s; $s = sleep $s) {};
 234     }
 235
 236     # this should block until the next server dies.
 237     $this->pm_wait();
 238
 239   }# while 1
 240
 241 HANDLING:
 242
 243   # forget any children we had been collecting.
 244   delete $this->{PIDS};
 245
 246   # call the (possibly overloaded) handling init hook
 247   $this->role("server");
 248   $this->handling_init();
 249   $this->pm_notify("initialized");
 250
 251   # server returns
 252   return 1;
 253 }
 254
 255 =head2 managing_init
 256
 257  instance
 258  () managing_init()
 259
 260 DESCRIPTION:
 261
 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().
 265
 266 =cut
 267
 268 sub managing_init {
 269   my ($this) = @_;
 270
 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(@_) };
 280   }
 281
 282   # change the name of this process as it appears in ps(1) output.
 283   $this->pm_change_process_name("perl-fcgi-pm");
 284
 285   $this->pm_write_pid_file();
 286 }
 287
 288 =head2 pm_die
 289
 290  instance or export
 291  () pm_die(string msg[, int exit_status])
 292
 293 DESCRIPTION:
 294
 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.
 300
 301 =cut
 302
 303 sub pm_die {
 304   my ($this,$msg,$n) = self_or_default(@_);
 305
 306   # stop handling signals.
 307   undef $SIG_CODEREF;
 308   $SIG{HUP}  = 'DEFAULT';
 309   $SIG{TERM} = 'DEFAULT';
 310
 311   $this->pm_remove_pid_file();
 312
 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();
 317   }
 318
 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");
 322     kill "TERM", @pids;
 323   }
 324
 325   # wait for the servers to die.
 326   while (%{$this->{PIDS}}) {
 327     $this->pm_wait();
 328   }
 329
 330   # die already.
 331   $this->pm_exit("dying: ".$msg,$n);
 332 }
 333
 334 =head2 pm_wait
 335
 336  instance or export
 337  (int pid) pm_wait()
 338
 339 DESCRIPTION:
 340
 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().
 345
 346 =cut
 347
 348 sub pm_wait {
 349   my ($this) = self_or_default(@_);
 350
 351   # wait for the next server to die.
 352   next if (my $pid = wait()) < 0;
 353
 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 $?");
 357
 358   return $pid;
 359 }
 360
 361 =head2 pm_write_pid_file
 362
 363  instance or export
 364  () pm_write_pid_file([string filename])
 365
 366 DESCRIPTION:
 367
 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.
 370
 371 =cut
 372
 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: $!");
 378     return;
 379   }
 380   print PIDFILE "$$\n";
 381   close PIDFILE;
 382 }
 383
 384 =head2 pm_remove_pid_file
 385
 386  instance or export
 387  () pm_remove_pid_file()
 388
 389 DESCRIPTION:
 390
 391 Removes optionally specified file.  If no filename is specified, it uses
 392 the value of the C<pid_fname> parameter.
 393
 394 =cut
 395
 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: $!");
 400   return $ret;
 401 }
 402
 403 =head2 sig_sub
 404
 405  instance
 406  () sig_sub(string name)
 407
 408 DESCRIPTION:
 409
 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.
 413
 414 =cut
 415
 416 sub sig_sub {
 417   $SIG_CODEREF->(@_) if ref $SIG_CODEREF;
 418 }
 419
 420 =head2 sig_manager
 421
 422  instance
 423  () sig_manager(string name)
 424
 425 DESCRIPTION:
 426
 427 Handles signals of the process manager.  Takes as input the name of signal
 428 being handled.
 429
 430 =cut
 431
 432 sub sig_manager {
 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");
 441       kill "TERM", @pids;
 442     }
 443   } else {
 444     $this->pm_notify("ignoring signal $name");
 445   }
 446 }
 447
 448 =head1 Handler methods
 449
 450 =head2 handling_init
 451
 452  instance or export
 453  () handling_init()
 454
 455 DESCRIPTION:
 456
 457 =cut
 458
 459 sub handling_init {
 460   my ($this) = @_;
 461
 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(@_) };
 468   }
 469
 470   # change the name of this process as it appears in ps(1) output.
 471   $this->pm_change_process_name("perl-fcgi");
 472 }
 473
 474 =head2 pm_pre_dispatch
 475
 476  instance or export
 477  () pm_pre_dispatch()
 478
 479 DESCRIPTION:
 480
 481 =cut
 482
 483 sub pm_pre_dispatch {
 484   my ($this) = self_or_default(@_);
 485
 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: $!");
 490   }
 491 }
 492
 493 =head2 pm_post_dispatch
 494
 495  instance or export
 496  () pm_post_dispatch()
 497
 498 DESCRIPTION:
 499
 500 =cut
 501
 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");
 506   }
 507   if ($this->pm_received_signal("HUP")) {
 508     $this->pm_exit("safe exit after SIGHUP");
 509   }
 510   if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
 511     $this->pm_exit("safe exit: manager has died");
 512   }
 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: $!");
 517   }
 518 }
 519
 520 =head2 sig_handler
 521
 522  instance or export
 523  () sig_handler()
 524
 525 DESCRIPTION:
 526
 527 =cut
 528
 529 sub sig_handler {
 530   my ($this,$name) = @_;
 531   $this->pm_received_signal($name,1);
 532 }
 533
 534 =head1 Common methods and routines
 535
 536 =head2 self_or_default
 537
 538  private global
 539  (ProcManager, @args) self_or_default([ ProcManager, ] @args);
 540
 541 DESCRIPTION:
 542
 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.
 545
 546 =cut
 547
 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;
 553     unshift @_, $Q;
 554   }
 555   return wantarray ? @_ : $Q;
 556 }
 557
 558 =head2 pm_change_process_name
 559
 560  instance or export
 561  () pm_change_process_name()
 562
 563 DESCRIPTION:
 564
 565 =cut
 566
 567 sub pm_change_process_name {
 568   my ($this,$name) = self_or_default(@_);
 569   $0 = $name;
 570 }
 571
 572 =head2 pm_received_signal
 573
 574  instance or export
 575  () pm_received signal()
 576
 577 DESCRIPTION:
 578
 579 =cut
 580
 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};
 586 }
 587
 588 =head1 parameters
 589
 590 =head2 pm_parameter
 591
 592  instance or export
 593  () pm_parameter()
 594
 595 DESCRIPTION:
 596
 597 =cut
 598
 599 sub pm_parameter {
 600   my ($this,$key,$value) = self_or_default(@_);
 601   defined $value and $this->{$key} = $value;
 602   return $this->{$key};
 603 }
 604
 605 =head2 n_processes
 606
 607 =head2 no_signals
 608
 609 =head2 pid_fname
 610
 611 =head2 die_timeout
 612
 613 =head2 role
 614
 615 =head2 start_delay
 616
 617 DESCRIPTION:
 618
 619 =cut
 620
 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",     @_); }
 627
 628 =head1 notification and death
 629
 630 =head2 pm_warn
 631
 632  instance or export
 633  () pm_warn()
 634
 635 DESCRIPTION:
 636
 637 =cut
 638
 639 sub pm_warn {
 640   my ($this,$msg) = self_or_default(@_);
 641   $this->pm_notify($msg);
 642 }
 643
 644 =head2 pm_notify
 645
 646  instance or export
 647  () pm_notify()
 648
 649 DESCRIPTION:
 650
 651 =cut
 652
 653 sub pm_notify {
 654   my ($this,$msg) = self_or_default(@_);
 655   $msg =~ s/\s*$/\n/;
 656   print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
 657 }
 658
 659 =head2 pm_exit
 660
 661  instance or export
 662  () pm_exit(string msg[, int exit_status])
 663
 664 DESCRIPTION:
 665
 666 =cut
 667
 668 sub pm_exit {
 669   my ($this,$msg,$n) = self_or_default(@_);
 670   $n ||= 0;
 671
 672   # if we still have children at this point, something went wrong.
 673   # SIGKILL them now.
 674   kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
 675
 676   $this->pm_warn($msg);
 677   $@ = $msg;
 678   exit $n;
 679 }
 680
 681 =head2 pm_abort
 682
 683  instance or export
 684  () pm_abort(string msg[, int exit_status])
 685
 686 DESCRIPTION:
 687
 688 =cut
 689
 690 sub pm_abort {
 691   my ($this,$msg,$n) = self_or_default(@_);
 692   $n ||= 1;
 693   $this->pm_exit($msg,1);
 694 }
 695
 696 1;
 697 __END__
 698
 699 =head1 BUGS
 700
 701 No known bugs, but this does not mean no bugs exist.
 702
 703 =head1 SEE ALSO
 704
 705 L<FCGI>.
 706
 707 =head1 COPYRIGHT
 708
 709  FCGI-ProcManager - A Perl FCGI Process Manager
 710  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 711
 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.
 716
 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.
 725
 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
 729
 730 =cut