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