lib/FCGI/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.26_01';
  17   $VERSION = eval $VERSION;
  18   @ISA = qw(Exporter);
  19   @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   $EXPORT_TAGS{all} = \@EXPORT_OK;
  26   $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<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 L<FCGI>'s description of
  96 FAIL_ACCEPT_ON_INTR.  Unfortunately, if you want/need to use L<CGI::Fast>, 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   my ($proto,$init) = @_;
 134   $init ||= {};
 135
 136   my $this = {
 137           role => "manager",
 138           start_delay => 0,
 139           die_timeout => 60,
 140         pm_title => 'perl-fcgi-pm',
 141           %$init
 142          };
 143   bless $this, ref($proto)||$proto;
 144
 145   $this->{PIDS} = {};
 146
 147   # initialize signal constructions.
 148   unless ($this->no_signals() or $^O eq 'Win32') {
 149     $this->{sigaction_no_sa_restart} =
 150     POSIX::SigAction->new('FCGI::ProcManager::sig_sub');
 151     $this->{sigaction_sa_restart} =
 152     POSIX::SigAction->new('FCGI::ProcManager::sig_sub',undef,POSIX::SA_RESTART);
 153   }
 154
 155   return $this;
 156 }
 157
 158 sub _set_signal_handler {
 159   my ($this, $signal, $restart);
 160
 161   if ($^O eq 'Win32') {
 162     $SIG{$signal} = 'FCGI::ProcManager::sig_sub';
 163   } else {
 164     no strict 'refs';
 165     sigaction(&{"POSIX::SIG$signal"}(), $restart ? $this->{sigaction_sa_restart} : $this->{sigaction_no_sa_restart})
 166       or $this->pm_warn("sigaction: SIG$signal: $!");
 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   my ($this,%values) = self_or_default(@_);
 195   map { $this->pm_parameter($_,$values{$_}) } keys %values;
 196
 197   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   $this->n_processes() or return;
 202
 203   # call the (possibly overloaded) management initialization hook.
 204   $this->role("manager");
 205   $this->managing_init();
 206   $this->pm_notify("initialized");
 207
 208   my $manager_pid = $$;
 209
 210  MANAGING_LOOP: while (1) {
 211
 212     $this->n_processes() > 0 or
 213       return $this->pm_die();
 214
 215     # while we have fewer servers than we want.
 216   PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
 217
 218       if (my $pid = fork()) {
 219     # the manager remembers the server.
 220     $this->{PIDS}->{$pid} = { pid=>$pid };
 221         $this->pm_notify("server (pid $pid) started");
 222
 223       } elsif (! defined $pid) {
 224     return $this->pm_abort("fork: $!");
 225
 226       } else {
 227     $this->{MANAGER_PID} = $manager_pid;
 228     # the server exits the managing loop.
 229     last MANAGING_LOOP;
 230       }
 231
 232       for (my $s = $this->start_delay(); $s > 0; $s -= sleep $s) {};
 233     }
 234
 235     # this should block until the next server dies.
 236     $this->pm_wait();
 237
 238   }# while 1
 239
 240 HANDLING:
 241
 242   # forget any children we had been collecting.
 243   delete $this->{PIDS};
 244
 245   # call the (possibly overloaded) handling init hook
 246   $this->role("server");
 247   $this->handling_init();
 248   $this->pm_notify("initialized");
 249
 250   # server returns
 251   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   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   unless ($this->no_signals()) {
 274     $this->_set_signal_handler('TERM', 0);
 275     $this->_set_signal_handler('HUP', 0);
 276     $SIG_CODEREF = sub { $this->sig_manager(@_) };
 277   }
 278
 279   # change the name of this process as it appears in ps(1) output.
 280   $this->pm_change_process_name($this->pm_parameter('pm_title'));
 281
 282   $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   my ($this,$msg,$n) = self_or_default(@_);
 302
 303   # stop handling signals.
 304   undef $SIG_CODEREF;
 305   $SIG{HUP}  = 'DEFAULT';
 306   $SIG{TERM} = 'DEFAULT';
 307
 308   $this->pm_remove_pid_file();
 309
 310   # prepare to die no matter what.
 311   if (defined $this->die_timeout()) {
 312     $SIG{ALRM} = sub { $this->pm_abort("wait timeout") };
 313     alarm $this->die_timeout();
 314   }
 315
 316   # send a TERM to each of the servers.
 317   if (my @pids = keys %{$this->{PIDS}}) {
 318     $this->pm_notify("sending TERM to PIDs, @pids");
 319     kill "TERM", @pids;
 320   }
 321
 322   # wait for the servers to die.
 323   while (%{$this->{PIDS}}) {
 324     $this->pm_wait();
 325   }
 326
 327   # die already.
 328   $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   my ($this) = self_or_default(@_);
 347
 348   # wait for the next server to die.
 349   return if ((my $pid = wait()) < 0);
 350
 351   # notify when one of our servers have died.
 352   delete $this->{PIDS}->{$pid} and
 353     $this->pm_notify("server (pid $pid) exited with status $?");
 354
 355   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<pid_fname> parameter.
 367
 368 =cut
 369
 370 sub pm_write_pid_file {
 371   my ($this,$fname) = self_or_default(@_);
 372   $fname ||= $this->pid_fname() or return;
 373   my $PIDFILE;
 374   if (!open $PIDFILE, ">$fname") {
 375     $this->pm_warn("open: $fname: $!");
 376     return;
 377   }
 378   print $PIDFILE "$$\n" or die "Could not print PID: $!";
 379   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<pid_fname> parameter.
 391
 392 =cut
 393
 394 sub pm_remove_pid_file {
 395   my ($this,$fname) = self_or_default(@_);
 396   $fname ||= $this->pid_fname() or return;
 397   my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
 398   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   $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   my ($this,$name) = @_;
 432   if ($name eq "TERM") {
 433     $this->pm_notify("received signal $name");
 434     $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     if (my @pids = keys %{$this->{PIDS}}) {
 438       $this->pm_notify("sending TERM to PIDs, @pids");
 439       kill "TERM", @pids;
 440     }
 441   } else {
 442     $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   my ($this) = @_;
 459
 460   # begin to handle signals.
 461   # We'll want accept(2) to return -1(EINTR) on caught signal..
 462   unless ($this->no_signals()) {
 463     $this->_set_signal_handler('TERM', 0);
 464     $this->_set_signal_handler('HUP', 0);
 465     $SIG_CODEREF = sub { $this->sig_handler(@_) };
 466   }
 467
 468   # change the name of this process as it appears in ps(1) output.
 469   $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   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   my ($this) = self_or_default(@_);
 487
 488   # Now, we want the request to continue unhindered..
 489   unless ($this->no_signals()) {
 490     $this->_set_signal_handler('TERM', 1);
 491     $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   my ($this) = self_or_default(@_);
 506   if ($this->pm_received_signal("TERM")) {
 507     $this->pm_exit("safe exit after SIGTERM");
 508   }
 509   if ($this->pm_received_signal("HUP")) {
 510     $this->pm_exit("safe exit after SIGHUP");
 511   }
 512   if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
 513     $this->pm_exit("safe exit: manager has died");
 514   }
 515   # We'll want accept(2) to return -1(EINTR) on caught signal..
 516   unless ($this->no_signals()) {
 517     $this->_set_signal_handler('TERM', 0);
 518     $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   my ($this,$name) = @_;
 533   $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   return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
 552   if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
 553              !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
 554     $Q or $Q = $FCGI::ProcManager::Default->new;
 555     unshift @_, $Q;
 556   }
 557   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   my ($this,$name) = self_or_default(@_);
 571   $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   my ($this,$sig,$received) = self_or_default(@_);
 585   $sig or return $this->{SIG_RECEIVED};
 586   $received and $this->{SIG_RECEIVED}->{$sig}++;
 587   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   my ($this,$key,$value) = self_or_default(@_);
 603   defined $value and $this->{$key} = $value;
 604   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 sub n_processes     { shift->pm_parameter("n_processes",     @_); }
 624 sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
 625 sub no_signals      { shift->pm_parameter("no_signals",      @_); }
 626 sub die_timeout     { shift->pm_parameter("die_timeout",     @_); }
 627 sub role            { shift->pm_parameter("role",            @_); }
 628 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   my ($this,$msg) = self_or_default(@_);
 643   $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   my ($this,$msg) = self_or_default(@_);
 657   $msg =~ s/\s*$/\n/;
 658   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   my ($this,$msg,$n) = self_or_default(@_);
 672   $n ||= 0;
 673
 674   # if we still have children at this point, something went wrong.
 675   # SIGKILL them now.
 676   kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
 677
 678   $this->pm_warn($msg);
 679   $@ = $msg;
 680   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   my ($this,$msg,$n) = self_or_default(@_);
 694   $n ||= 1;
 695   $this->pm_exit($msg,1);
 696 }
 697
 698 1;
 699 __END__
 700
 701 =head1 BUGS
 702
 703 No known bugs, but this does not mean no bugs exist.
 704
 705 =head1 SEE ALSO
 706
 707 L<FCGI>.
 708
 709 =head1 MAINTAINER
 710
 711 Gareth Kirwan <gbjk@thermeon.com>
 712
 713 =head1 AUTHOR
 714
 715 James E Jurach Jr.
 716
 717 =head1 COPYRIGHT
 718
 719  FCGI-ProcManager - A Perl FCGI Process Manager
 720  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 721
 722  This library is free software; you can redistribute it and/or
 723  modify it under the terms of the GNU Lesser General Public
 724  License as published by the Free Software Foundation; either
 725  version 2 of the License, or (at your option) any later version.
 726
 727  BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 728  BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 729  OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 730  LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 731  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 732  ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 733  AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 734  License for more details.
 735
 736  You should have received a copy of the GNU Lesser General Public
 737  License along with this library; if not, write to the Free Software
 738  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
 739
 740 =cut