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.22';
  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   # skip to handling now if we won't be managing any processes.
 185   $this->n_processes() or return;
 186
 187   # call the (possibly overloaded) management initialization hook.
 188   $this->role("manager");
 189   $this->managing_init();
 190   $this->pm_notify("initialized");
 191
 192   my $manager_pid = $$;
 193
 194  MANAGING_LOOP: while (1) {
 195
 196     $this->n_processes() > 0 or
 197       return $this->pm_die();
 198
 199     # while we have fewer servers than we want.
 200   PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
 201
 202       if (my $pid = fork()) {
 203     # the manager remembers the server.
 204     $this->{PIDS}->{$pid} = { pid=>$pid };
 205         $this->pm_notify("server (pid $pid) started");
 206
 207       } elsif (! defined $pid) {
 208     return $this->pm_abort("fork: $!");
 209
 210       } else {
 211     $this->{MANAGER_PID} = $manager_pid;
 212     # the server exits the managing loop.
 213     last MANAGING_LOOP;
 214       }
 215
 216       for (my $s = $this->start_delay(); $s > 0; $s -= sleep $s) {};
 217     }
 218
 219     # this should block until the next server dies.
 220     $this->pm_wait();
 221
 222   }# while 1
 223
 224 HANDLING:
 225
 226   # forget any children we had been collecting.
 227   delete $this->{PIDS};
 228
 229   # call the (possibly overloaded) handling init hook
 230   $this->role("server");
 231   $this->handling_init();
 232   $this->pm_notify("initialized");
 233
 234   # server returns
 235   return 1;
 236 }
 237
 238 =head2 managing_init
 239
 240  instance
 241  () managing_init()
 242
 243 DESCRIPTION:
 244
 245 Overrideable method which initializes a process manager.  In order to
 246 handle signals, manage the PID file, and change the process name properly,
 247 any method which overrides this should call SUPER::managing_init().
 248
 249 =cut
 250
 251 sub managing_init {
 252   my ($this) = @_;
 253
 254   # begin to handle signals.
 255   # We do NOT want SA_RESTART in the process manager.
 256   # -- we want start the shutdown sequence immediately upon SIGTERM.
 257   unless ($this->no_signals()) {
 258     sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or
 259     $this->pm_warn("sigaction: SIGTERM: $!");
 260     sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or
 261     $this->pm_warn("sigaction: SIGHUP: $!");
 262     $SIG_CODEREF = sub { $this->sig_manager(@_) };
 263   }
 264
 265   # change the name of this process as it appears in ps(1) output.
 266   $this->pm_change_process_name($this->pm_parameter('pm_title'));
 267
 268   $this->pm_write_pid_file();
 269 }
 270
 271 =head2 pm_die
 272
 273  instance or export
 274  () pm_die(string msg[, int exit_status])
 275
 276 DESCRIPTION:
 277
 278 This method is called when a process manager receives a notification to
 279 shut itself down.  pm_die() attempts to shutdown the process manager
 280 gently, sending a SIGTERM to each managed process, waiting die_timeout()
 281 seconds to reap each process, and then exit gracefully once all children
 282 are reaped, or to abort if all children are not reaped.
 283
 284 =cut
 285
 286 sub pm_die {
 287   my ($this,$msg,$n) = self_or_default(@_);
 288
 289   # stop handling signals.
 290   undef $SIG_CODEREF;
 291   $SIG{HUP}  = 'DEFAULT';
 292   $SIG{TERM} = 'DEFAULT';
 293
 294   $this->pm_remove_pid_file();
 295
 296   # prepare to die no matter what.
 297   if (defined $this->die_timeout()) {
 298     $SIG{ALRM} = sub { $this->pm_abort("wait timeout") };
 299     alarm $this->die_timeout();
 300   }
 301
 302   # send a TERM to each of the servers.
 303   if (my @pids = keys %{$this->{PIDS}}) {
 304     $this->pm_notify("sending TERM to PIDs, @pids");
 305     kill "TERM", @pids;
 306   }
 307
 308   # wait for the servers to die.
 309   while (%{$this->{PIDS}}) {
 310     $this->pm_wait();
 311   }
 312
 313   # die already.
 314   $this->pm_exit("dying: ".$msg,$n);
 315 }
 316
 317 =head2 pm_wait
 318
 319  instance or export
 320  (int pid) pm_wait()
 321
 322 DESCRIPTION:
 323
 324 This calls wait() which suspends execution until a child has exited.
 325 If the process ID returned by wait corresponds to a managed process,
 326 pm_notify() is called with the exit status of that process.
 327 pm_wait() returns with the return value of wait().
 328
 329 =cut
 330
 331 sub pm_wait {
 332   my ($this) = self_or_default(@_);
 333
 334   # wait for the next server to die.
 335   return if (my $pid = wait() < 0);
 336
 337   # notify when one of our servers have died.
 338   delete $this->{PIDS}->{$pid} and
 339     $this->pm_notify("server (pid $pid) exited with status $?");
 340
 341   return $pid;
 342 }
 343
 344 =head2 pm_write_pid_file
 345
 346  instance or export
 347  () pm_write_pid_file([string filename])
 348
 349 DESCRIPTION:
 350
 351 Writes current process ID to optionally specified file.  If no filename is
 352 specified, it uses the value of the C<pid_fname> parameter.
 353
 354 =cut
 355
 356 sub pm_write_pid_file {
 357   my ($this,$fname) = self_or_default(@_);
 358   $fname ||= $this->pid_fname() or return;
 359   if (!open PIDFILE, ">$fname") {
 360     $this->pm_warn("open: $fname: $!");
 361     return;
 362   }
 363   print PIDFILE "$$\n";
 364   close PIDFILE;
 365 }
 366
 367 =head2 pm_remove_pid_file
 368
 369  instance or export
 370  () pm_remove_pid_file()
 371
 372 DESCRIPTION:
 373
 374 Removes optionally specified file.  If no filename is specified, it uses
 375 the value of the C<pid_fname> parameter.
 376
 377 =cut
 378
 379 sub pm_remove_pid_file {
 380   my ($this,$fname) = self_or_default(@_);
 381   $fname ||= $this->pid_fname() or return;
 382   my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
 383   return $ret;
 384 }
 385
 386 =head2 sig_sub
 387
 388  instance
 389  () sig_sub(string name)
 390
 391 DESCRIPTION:
 392
 393 The name of this method is passed to POSIX::sigaction(), and handles signals
 394 for the process manager.  If $SIG_CODEREF is set, then the input arguments
 395 to this are passed to a call to that.
 396
 397 =cut
 398
 399 sub sig_sub {
 400   $SIG_CODEREF->(@_) if ref $SIG_CODEREF;
 401 }
 402
 403 =head2 sig_manager
 404
 405  instance
 406  () sig_manager(string name)
 407
 408 DESCRIPTION:
 409
 410 Handles signals of the process manager.  Takes as input the name of signal
 411 being handled.
 412
 413 =cut
 414
 415 sub sig_manager {
 416   my ($this,$name) = @_;
 417   if ($name eq "TERM") {
 418     $this->pm_notify("received signal $name");
 419     $this->pm_die("safe exit from signal $name");
 420   } elsif ($name eq "HUP") {
 421     # send a TERM to each of the servers, and pretend like nothing happened..
 422     if (my @pids = keys %{$this->{PIDS}}) {
 423       $this->pm_notify("sending TERM to PIDs, @pids");
 424       kill "TERM", @pids;
 425     }
 426   } else {
 427     $this->pm_notify("ignoring signal $name");
 428   }
 429 }
 430
 431 =head1 Handler methods
 432
 433 =head2 handling_init
 434
 435  instance or export
 436  () handling_init()
 437
 438 DESCRIPTION:
 439
 440 =cut
 441
 442 sub handling_init {
 443   my ($this) = @_;
 444
 445   # begin to handle signals.
 446   # We'll want accept(2) to return -1(EINTR) on caught signal..
 447   unless ($this->no_signals()) {
 448     sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
 449     sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
 450     $SIG_CODEREF = sub { $this->sig_handler(@_) };
 451   }
 452
 453   # change the name of this process as it appears in ps(1) output.
 454   $this->pm_change_process_name("perl-fcgi");
 455 }
 456
 457 =head2 pm_pre_dispatch
 458
 459  instance or export
 460  () pm_pre_dispatch()
 461
 462 DESCRIPTION:
 463
 464 =cut
 465
 466 sub pm_pre_dispatch {
 467   my ($this) = self_or_default(@_);
 468
 469   # Now, we want the request to continue unhindered..
 470   unless ($this->no_signals()) {
 471     sigaction(SIGTERM, $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
 472     sigaction(SIGHUP,  $this->{sigaction_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
 473   }
 474 }
 475
 476 =head2 pm_post_dispatch
 477
 478  instance or export
 479  () pm_post_dispatch()
 480
 481 DESCRIPTION:
 482
 483 =cut
 484
 485 sub pm_post_dispatch {
 486   my ($this) = self_or_default(@_);
 487   if ($this->pm_received_signal("TERM")) {
 488     $this->pm_exit("safe exit after SIGTERM");
 489   }
 490   if ($this->pm_received_signal("HUP")) {
 491     $this->pm_exit("safe exit after SIGHUP");
 492   }
 493   if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
 494     $this->pm_exit("safe exit: manager has died");
 495   }
 496   # We'll want accept(2) to return -1(EINTR) on caught signal..
 497   unless ($this->no_signals()) {
 498     sigaction(SIGTERM, $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGTERM: $!");
 499     sigaction(SIGHUP,  $this->{sigaction_no_sa_restart}) or $this->pm_warn("sigaction: SIGHUP: $!");
 500   }
 501 }
 502
 503 =head2 sig_handler
 504
 505  instance or export
 506  () sig_handler()
 507
 508 DESCRIPTION:
 509
 510 =cut
 511
 512 sub sig_handler {
 513   my ($this,$name) = @_;
 514   $this->pm_received_signal($name,1);
 515 }
 516
 517 =head1 Common methods and routines
 518
 519 =head2 self_or_default
 520
 521  private global
 522  (ProcManager, @args) self_or_default([ ProcManager, ] @args);
 523
 524 DESCRIPTION:
 525
 526 This is a helper subroutine to acquire or otherwise create a singleton
 527 default object if one is not passed in, e.g., a method call.
 528
 529 =cut
 530
 531 sub self_or_default {
 532   return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
 533   if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
 534              !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
 535     $Q or $Q = $FCGI::ProcManager::Default->new;
 536     unshift @_, $Q;
 537   }
 538   return wantarray ? @_ : $Q;
 539 }
 540
 541 =head2 pm_change_process_name
 542
 543  instance or export
 544  () pm_change_process_name()
 545
 546 DESCRIPTION:
 547
 548 =cut
 549
 550 sub pm_change_process_name {
 551   my ($this,$name) = self_or_default(@_);
 552   $0 = $name;
 553 }
 554
 555 =head2 pm_received_signal
 556
 557  instance or export
 558  () pm_received signal()
 559
 560 DESCRIPTION:
 561
 562 =cut
 563
 564 sub pm_received_signal {
 565   my ($this,$sig,$received) = self_or_default(@_);
 566   $sig or return $this->{SIG_RECEIVED};
 567   $received and $this->{SIG_RECEIVED}->{$sig}++;
 568   return $this->{SIG_RECEIVED}->{$sig};
 569 }
 570
 571 =head1 parameters
 572
 573 =head2 pm_parameter
 574
 575  instance or export
 576  () pm_parameter()
 577
 578 DESCRIPTION:
 579
 580 =cut
 581
 582 sub pm_parameter {
 583   my ($this,$key,$value) = self_or_default(@_);
 584   defined $value and $this->{$key} = $value;
 585   return $this->{$key};
 586 }
 587
 588 =head2 n_processes
 589
 590 =head2 no_signals
 591
 592 =head2 pid_fname
 593
 594 =head2 die_timeout
 595
 596 =head2 role
 597
 598 =head2 start_delay
 599
 600 DESCRIPTION:
 601
 602 =cut
 603
 604 sub n_processes     { shift->pm_parameter("n_processes",     @_); }
 605 sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
 606 sub no_signals      { shift->pm_parameter("no_signals",      @_); }
 607 sub die_timeout     { shift->pm_parameter("die_timeout",     @_); }
 608 sub role            { shift->pm_parameter("role",            @_); }
 609 sub start_delay     { shift->pm_parameter("start_delay",     @_); }
 610
 611 =head1 notification and death
 612
 613 =head2 pm_warn
 614
 615  instance or export
 616  () pm_warn()
 617
 618 DESCRIPTION:
 619
 620 =cut
 621
 622 sub pm_warn {
 623   my ($this,$msg) = self_or_default(@_);
 624   $this->pm_notify($msg);
 625 }
 626
 627 =head2 pm_notify
 628
 629  instance or export
 630  () pm_notify()
 631
 632 DESCRIPTION:
 633
 634 =cut
 635
 636 sub pm_notify {
 637   my ($this,$msg) = self_or_default(@_);
 638   $msg =~ s/\s*$/\n/;
 639   print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
 640 }
 641
 642 =head2 pm_exit
 643
 644  instance or export
 645  () pm_exit(string msg[, int exit_status])
 646
 647 DESCRIPTION:
 648
 649 =cut
 650
 651 sub pm_exit {
 652   my ($this,$msg,$n) = self_or_default(@_);
 653   $n ||= 0;
 654
 655   # if we still have children at this point, something went wrong.
 656   # SIGKILL them now.
 657   kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
 658
 659   $this->pm_warn($msg);
 660   $@ = $msg;
 661   exit $n;
 662 }
 663
 664 =head2 pm_abort
 665
 666  instance or export
 667  () pm_abort(string msg[, int exit_status])
 668
 669 DESCRIPTION:
 670
 671 =cut
 672
 673 sub pm_abort {
 674   my ($this,$msg,$n) = self_or_default(@_);
 675   $n ||= 1;
 676   $this->pm_exit($msg,1);
 677 }
 678
 679 1;
 680 __END__
 681
 682 =head1 BUGS
 683
 684 No known bugs, but this does not mean no bugs exist.
 685
 686 =head1 SEE ALSO
 687
 688 L<FCGI>.
 689
 690 =head1 MAINTAINER
 691
 692 Gareth Kirwan <gbjk@thermeon.com>
 693
 694 =head1 AUTHOR
 695
 696 James E Jurach Jr.
 697
 698 =head1 COPYRIGHT
 699
 700  FCGI-ProcManager - A Perl FCGI Process Manager
 701  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 702
 703  This library is free software; you can redistribute it and/or
 704  modify it under the terms of the GNU Lesser General Public
 705  License as published by the Free Software Foundation; either
 706  version 2 of the License, or (at your option) any later version.
 707
 708  BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 709  BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 710  OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 711  LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 712  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 713  ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 714  AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 715  License for more details.
 716
 717  You should have received a copy of the GNU Lesser General Public
 718  License along with this library; if not, write to the Free Software
 719  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
 720
 721 =cut