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