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 re-enstate 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   if (!open PIDFILE, ">$fname") {
 363     $this->pm_warn("open: $fname: $!");
 364     return;
 365   }
 366   print PIDFILE "$$\n";
 367   close PIDFILE;
 368 }
 369
 370 =head2 pm_remove_pid_file
 371
 372  instance or export
 373  () pm_remove_pid_file()
 374
 375 DESCRIPTION:
 376
 377 Removes optionally specified file.  If no filename is specified, it uses
 378 the value of the C<pid_fname> parameter.
 379
 380 =cut
 381
 382 sub pm_remove_pid_file {
 383   my ($this,$fname) = self_or_default(@_);
 384   $fname ||= $this->pid_fname() or return;
 385   my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
 386   return $ret;
 387 }
 388
 389 =head2 sig_sub
 390
 391  instance
 392  () sig_sub(string name)
 393
 394 DESCRIPTION:
 395
 396 The name of this method is passed to POSIX::sigaction(), and handles signals
 397 for the process manager.  If $SIG_CODEREF is set, then the input arguments
 398 to this are passed to a call to that.
 399
 400 =cut
 401
 402 sub sig_sub {
 403   $SIG_CODEREF->(@_) if ref $SIG_CODEREF;
 404 }
 405
 406 =head2 sig_manager
 407
 408  instance
 409  () sig_manager(string name)
 410
 411 DESCRIPTION:
 412
 413 Handles signals of the process manager.  Takes as input the name of signal
 414 being handled.
 415
 416 =cut
 417
 418 sub sig_manager {
 419   my ($this,$name) = @_;
 420   if ($name eq "TERM") {
 421     $this->pm_notify("received signal $name");
 422     $this->pm_die("safe exit from signal $name");
 423   } elsif ($name eq "HUP") {
 424     # send a TERM to each of the servers, and pretend like nothing happened..
 425     if (my @pids = keys %{$this->{PIDS}}) {
 426       $this->pm_notify("sending TERM to PIDs, @pids");
 427       kill "TERM", @pids;
 428     }
 429   } else {
 430     $this->pm_notify("ignoring signal $name");
 431   }
 432 }
 433
 434 =head1 Handler methods
 435
 436 =head2 handling_init
 437
 438  instance or export
 439  () handling_init()
 440
 441 DESCRIPTION:
 442
 443 =cut
 444
 445 sub handling_init {
 446   my ($this) = @_;
 447
 448   # begin to handle signals.
 449   # We'll want accept(2) to return -1(EINTR) on caught signal..
 450   unless ($this->no_signals()) {
 451     sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
 452     sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
 453     $SIG_CODEREF = sub { $this->sig_handler(@_) };
 454   }
 455
 456   # change the name of this process as it appears in ps(1) output.
 457   $this->pm_change_process_name("perl-fcgi");
 458 }
 459
 460 =head2 pm_pre_dispatch
 461
 462  instance or export
 463  () pm_pre_dispatch()
 464
 465 DESCRIPTION:
 466
 467 =cut
 468
 469 sub pm_pre_dispatch {
 470   my ($this) = self_or_default(@_);
 471
 472   # Now, we want the request to continue unhindered..
 473   unless ($this->no_signals()) {
 474     sigaction(SIGTERM, $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
 475     sigaction(SIGHUP,  $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
 476   }
 477 }
 478
 479 =head2 pm_post_dispatch
 480
 481  instance or export
 482  () pm_post_dispatch()
 483
 484 DESCRIPTION:
 485
 486 =cut
 487
 488 sub pm_post_dispatch {
 489   my ($this) = self_or_default(@_);
 490   if ($this->pm_received_signal("TERM")) {
 491     $this->pm_exit("safe exit after SIGTERM");
 492   }
 493   if ($this->pm_received_signal("HUP")) {
 494     $this->pm_exit("safe exit after SIGHUP");
 495   }
 496   if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
 497     $this->pm_exit("safe exit: manager has died");
 498   }
 499   # We'll want accept(2) to return -1(EINTR) on caught signal..
 500   unless ($this->no_signals()) {
 501     sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
 502     sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
 503   }
 504 }
 505
 506 =head2 sig_handler
 507
 508  instance or export
 509  () sig_handler()
 510
 511 DESCRIPTION:
 512
 513 =cut
 514
 515 sub sig_handler {
 516   my ($this,$name) = @_;
 517   $this->pm_received_signal($name,1);
 518 }
 519
 520 =head1 Common methods and routines
 521
 522 =head2 self_or_default
 523
 524  private global
 525  (ProcManager, @args) self_or_default([ ProcManager, ] @args);
 526
 527 DESCRIPTION:
 528
 529 This is a helper subroutine to acquire or otherwise create a singleton
 530 default object if one is not passed in, e.g., a method call.
 531
 532 =cut
 533
 534 sub self_or_default {
 535   return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
 536   if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
 537              !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
 538     $Q or $Q = $FCGI::ProcManager::Default->new;
 539     unshift @_, $Q;
 540   }
 541   return wantarray ? @_ : $Q;
 542 }
 543
 544 =head2 pm_change_process_name
 545
 546  instance or export
 547  () pm_change_process_name()
 548
 549 DESCRIPTION:
 550
 551 =cut
 552
 553 sub pm_change_process_name {
 554   my ($this,$name) = self_or_default(@_);
 555   $0 = $name;
 556 }
 557
 558 =head2 pm_received_signal
 559
 560  instance or export
 561  () pm_received signal()
 562
 563 DESCRIPTION:
 564
 565 =cut
 566
 567 sub pm_received_signal {
 568   my ($this,$sig,$received) = self_or_default(@_);
 569   $sig or return $this->{SIG_RECEIVED};
 570   $received and $this->{SIG_RECEIVED}->{$sig}++;
 571   return $this->{SIG_RECEIVED}->{$sig};
 572 }
 573
 574 =head1 parameters
 575
 576 =head2 pm_parameter
 577
 578  instance or export
 579  () pm_parameter()
 580
 581 DESCRIPTION:
 582
 583 =cut
 584
 585 sub pm_parameter {
 586   my ($this,$key,$value) = self_or_default(@_);
 587   defined $value and $this->{$key} = $value;
 588   return $this->{$key};
 589 }
 590
 591 =head2 n_processes
 592
 593 =head2 no_signals
 594
 595 =head2 pid_fname
 596
 597 =head2 die_timeout
 598
 599 =head2 role
 600
 601 =head2 start_delay
 602
 603 DESCRIPTION:
 604
 605 =cut
 606
 607 sub n_processes     { shift->pm_parameter("n_processes",     @_); }
 608 sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
 609 sub no_signals      { shift->pm_parameter("no_signals",      @_); }
 610 sub die_timeout     { shift->pm_parameter("die_timeout",     @_); }
 611 sub role            { shift->pm_parameter("role",            @_); }
 612 sub start_delay     { shift->pm_parameter("start_delay",     @_); }
 613
 614 =head1 notification and death
 615
 616 =head2 pm_warn
 617
 618  instance or export
 619  () pm_warn()
 620
 621 DESCRIPTION:
 622
 623 =cut
 624
 625 sub pm_warn {
 626   my ($this,$msg) = self_or_default(@_);
 627   $this->pm_notify($msg);
 628 }
 629
 630 =head2 pm_notify
 631
 632  instance or export
 633  () pm_notify()
 634
 635 DESCRIPTION:
 636
 637 =cut
 638
 639 sub pm_notify {
 640   my ($this,$msg) = self_or_default(@_);
 641   $msg =~ s/\s*$/\n/;
 642   print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
 643 }
 644
 645 =head2 pm_exit
 646
 647  instance or export
 648  () pm_exit(string msg[, int exit_status])
 649
 650 DESCRIPTION:
 651
 652 =cut
 653
 654 sub pm_exit {
 655   my ($this,$msg,$n) = self_or_default(@_);
 656   $n ||= 0;
 657
 658   # if we still have children at this point, something went wrong.
 659   # SIGKILL them now.
 660   kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
 661
 662   $this->pm_warn($msg);
 663   $@ = $msg;
 664   exit $n;
 665 }
 666
 667 =head2 pm_abort
 668
 669  instance or export
 670  () pm_abort(string msg[, int exit_status])
 671
 672 DESCRIPTION:
 673
 674 =cut
 675
 676 sub pm_abort {
 677   my ($this,$msg,$n) = self_or_default(@_);
 678   $n ||= 1;
 679   $this->pm_exit($msg,1);
 680 }
 681
 682 1;
 683 __END__
 684
 685 =head1 BUGS
 686
 687 No known bugs, but this does not mean no bugs exist.
 688
 689 =head1 SEE ALSO
 690
 691 L<FCGI>.
 692
 693 =head1 MAINTAINER
 694
 695 Gareth Kirwan <gbjk@thermeon.com>
 696
 697 =head1 AUTHOR
 698
 699 James E Jurach Jr.
 700
 701 =head1 COPYRIGHT
 702
 703  FCGI-ProcManager - A Perl FCGI Process Manager
 704  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 705
 706  This library is free software; you can redistribute it and/or
 707  modify it under the terms of the GNU Lesser General Public
 708  License as published by the Free Software Foundation; either
 709  version 2 of the License, or (at your option) any later version.
 710
 711  BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 712  BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 713  OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 714  LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 715  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 716  ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 717  AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 718  License for more details.
 719
 720  You should have received a copy of the GNU Lesser General Public
 721  License along with this library; if not, write to the Free Software
 722  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
 723
 724 =cut