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   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
 461 =head2 pm_pre_dispatch
 462
 463  instance or export
 464  () pm_pre_dispatch()
 465
 466 DESCRIPTION:
 467
 468 =cut
 469
 470 sub pm_pre_dispatch {
 471   my ($this) = self_or_default(@_);
 472
 473   # Now, we want the request to continue unhindered..
 474   unless ($this->no_signals()) {
 475     sigaction(SIGTERM, $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
 476     sigaction(SIGHUP,  $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
 477   }
 478 }
 479
 480 =head2 pm_post_dispatch
 481
 482  instance or export
 483  () pm_post_dispatch()
 484
 485 DESCRIPTION:
 486
 487 =cut
 488
 489 sub pm_post_dispatch {
 490   my ($this) = self_or_default(@_);
 491   if ($this->pm_received_signal("TERM")) {
 492     $this->pm_exit("safe exit after SIGTERM");
 493   }
 494   if ($this->pm_received_signal("HUP")) {
 495     $this->pm_exit("safe exit after SIGHUP");
 496   }
 497   if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
 498     $this->pm_exit("safe exit: manager has died");
 499   }
 500   # We'll want accept(2) to return -1(EINTR) on caught signal..
 501   unless ($this->no_signals()) {
 502     sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
 503     sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
 504   }
 505 }
 506
 507 =head2 sig_handler
 508
 509  instance or export
 510  () sig_handler()
 511
 512 DESCRIPTION:
 513
 514 =cut
 515
 516 sub sig_handler {
 517   my ($this,$name) = @_;
 518   $this->pm_received_signal($name,1);
 519 }
 520
 521 =head1 Common methods and routines
 522
 523 =head2 self_or_default
 524
 525  private global
 526  (ProcManager, @args) self_or_default([ ProcManager, ] @args);
 527
 528 DESCRIPTION:
 529
 530 This is a helper subroutine to acquire or otherwise create a singleton
 531 default object if one is not passed in, e.g., a method call.
 532
 533 =cut
 534
 535 sub self_or_default {
 536   return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
 537   if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
 538              !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
 539     $Q or $Q = $FCGI::ProcManager::Default->new;
 540     unshift @_, $Q;
 541   }
 542   return wantarray ? @_ : $Q;
 543 }
 544
 545 =head2 pm_change_process_name
 546
 547  instance or export
 548  () pm_change_process_name()
 549
 550 DESCRIPTION:
 551
 552 =cut
 553
 554 sub pm_change_process_name {
 555   my ($this,$name) = self_or_default(@_);
 556   $0 = $name;
 557 }
 558
 559 =head2 pm_received_signal
 560
 561  instance or export
 562  () pm_received signal()
 563
 564 DESCRIPTION:
 565
 566 =cut
 567
 568 sub pm_received_signal {
 569   my ($this,$sig,$received) = self_or_default(@_);
 570   $sig or return $this->{SIG_RECEIVED};
 571   $received and $this->{SIG_RECEIVED}->{$sig}++;
 572   return $this->{SIG_RECEIVED}->{$sig};
 573 }
 574
 575 =head1 parameters
 576
 577 =head2 pm_parameter
 578
 579  instance or export
 580  () pm_parameter()
 581
 582 DESCRIPTION:
 583
 584 =cut
 585
 586 sub pm_parameter {
 587   my ($this,$key,$value) = self_or_default(@_);
 588   defined $value and $this->{$key} = $value;
 589   return $this->{$key};
 590 }
 591
 592 =head2 n_processes
 593
 594 =head2 no_signals
 595
 596 =head2 pid_fname
 597
 598 =head2 die_timeout
 599
 600 =head2 role
 601
 602 =head2 start_delay
 603
 604 DESCRIPTION:
 605
 606 =cut
 607
 608 sub n_processes     { shift->pm_parameter("n_processes",     @_); }
 609 sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
 610 sub no_signals      { shift->pm_parameter("no_signals",      @_); }
 611 sub die_timeout     { shift->pm_parameter("die_timeout",     @_); }
 612 sub role            { shift->pm_parameter("role",            @_); }
 613 sub start_delay     { shift->pm_parameter("start_delay",     @_); }
 614
 615 =head1 notification and death
 616
 617 =head2 pm_warn
 618
 619  instance or export
 620  () pm_warn()
 621
 622 DESCRIPTION:
 623
 624 =cut
 625
 626 sub pm_warn {
 627   my ($this,$msg) = self_or_default(@_);
 628   $this->pm_notify($msg);
 629 }
 630
 631 =head2 pm_notify
 632
 633  instance or export
 634  () pm_notify()
 635
 636 DESCRIPTION:
 637
 638 =cut
 639
 640 sub pm_notify {
 641   my ($this,$msg) = self_or_default(@_);
 642   $msg =~ s/\s*$/\n/;
 643   print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
 644 }
 645
 646 =head2 pm_exit
 647
 648  instance or export
 649  () pm_exit(string msg[, int exit_status])
 650
 651 DESCRIPTION:
 652
 653 =cut
 654
 655 sub pm_exit {
 656   my ($this,$msg,$n) = self_or_default(@_);
 657   $n ||= 0;
 658
 659   # if we still have children at this point, something went wrong.
 660   # SIGKILL them now.
 661   kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
 662
 663   $this->pm_warn($msg);
 664   $@ = $msg;
 665   exit $n;
 666 }
 667
 668 =head2 pm_abort
 669
 670  instance or export
 671  () pm_abort(string msg[, int exit_status])
 672
 673 DESCRIPTION:
 674
 675 =cut
 676
 677 sub pm_abort {
 678   my ($this,$msg,$n) = self_or_default(@_);
 679   $n ||= 1;
 680   $this->pm_exit($msg,1);
 681 }
 682
 683 1;
 684 __END__
 685
 686 =head1 BUGS
 687
 688 No known bugs, but this does not mean no bugs exist.
 689
 690 =head1 SEE ALSO
 691
 692 L<FCGI>.
 693
 694 =head1 MAINTAINER
 695
 696 Gareth Kirwan <gbjk@thermeon.com>
 697
 698 =head1 AUTHOR
 699
 700 James E Jurach Jr.
 701
 702 =head1 COPYRIGHT
 703
 704  FCGI-ProcManager - A Perl FCGI Process Manager
 705  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 706
 707  This library is free software; you can redistribute it and/or
 708  modify it under the terms of the GNU Lesser General Public
 709  License as published by the Free Software Foundation; either
 710  version 2 of the License, or (at your option) any later version.
 711
 712  BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 713  BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 714  OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 715  LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 716  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 717  ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 718  AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 719  License for more details.
 720
 721  You should have received a copy of the GNU Lesser General Public
 722  License along with this library; if not, write to the Free Software
 723  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
 724
 725 =cut