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.25';
  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() or $^O eq 'Win32') {
 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 sub _set_signal_handler {
 158   my ($this, $signal, $restart);
 159
 160   if ($^O eq 'Win32') {
 161     $SIG{$signal} = 'FCGI::ProcManager::sig_sub';
 162   } else {
 163     no strict 'refs';
 164     sigaction(&{"POSIX::SIG$signal"}(), $restart ? $this->{sigaction_sa_restart} : $this->{sigaction_no_sa_restart})
 165       or $this->pm_warn("sigaction: SIG$signal: $!");
 166   }
 167 }
 168
 169 =head1 Manager methods
 170
 171 =head2 pm_manage
 172
 173  instance or export
 174  (int) pm_manage([hash parameters])
 175
 176 DESCRIPTION:
 177
 178 When this is called by a FastCGI script to manage application servers.  It
 179 defines a sequence of instructions for a process to enter this method and
 180 begin forking off and managing those handlers, and it defines a sequence of
 181 instructions to intialize those handlers.
 182
 183 If n_processes < 1, the managing section is subverted, and only the
 184 handling sequence is executed.
 185
 186 Either returns the return value of pm_die() and/or pm_abort() (which will
 187 not ever return in general), or returns 1 to the calling script to begin
 188 handling requests.
 189
 190 =cut
 191
 192 sub pm_manage {
 193   my ($this,%values) = self_or_default(@_);
 194   map { $this->pm_parameter($_,$values{$_}) } keys %values;
 195
 196   local $SIG{CHLD}; # Replace the SIGCHLD default handler in case
 197                     # somebody shit on it whilst loading code.
 198
 199   # skip to handling now if we won't be managing any processes.
 200   $this->n_processes() or return;
 201
 202   # call the (possibly overloaded) management initialization hook.
 203   $this->role("manager");
 204   $this->managing_init();
 205   $this->pm_notify("initialized");
 206
 207   my $manager_pid = $$;
 208
 209  MANAGING_LOOP: while (1) {
 210
 211     $this->n_processes() > 0 or
 212       return $this->pm_die();
 213
 214     # while we have fewer servers than we want.
 215   PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
 216
 217       if (my $pid = fork()) {
 218     # the manager remembers the server.
 219     $this->{PIDS}->{$pid} = { pid=>$pid };
 220         $this->pm_notify("server (pid $pid) started");
 221
 222       } elsif (! defined $pid) {
 223     return $this->pm_abort("fork: $!");
 224
 225       } else {
 226     $this->{MANAGER_PID} = $manager_pid;
 227     # the server exits the managing loop.
 228     last MANAGING_LOOP;
 229       }
 230
 231       for (my $s = $this->start_delay(); $s > 0; $s -= sleep $s) {};
 232     }
 233
 234     # this should block until the next server dies.
 235     $this->pm_wait();
 236
 237   }# while 1
 238
 239 HANDLING:
 240
 241   # forget any children we had been collecting.
 242   delete $this->{PIDS};
 243
 244   # call the (possibly overloaded) handling init hook
 245   $this->role("server");
 246   $this->handling_init();
 247   $this->pm_notify("initialized");
 248
 249   # server returns
 250   return 1;
 251 }
 252
 253 =head2 managing_init
 254
 255  instance
 256  () managing_init()
 257
 258 DESCRIPTION:
 259
 260 Overrideable method which initializes a process manager.  In order to
 261 handle signals, manage the PID file, and change the process name properly,
 262 any method which overrides this should call SUPER::managing_init().
 263
 264 =cut
 265
 266 sub managing_init {
 267   my ($this) = @_;
 268
 269   # begin to handle signals.
 270   # We do NOT want SA_RESTART in the process manager.
 271   # -- we want start the shutdown sequence immediately upon SIGTERM.
 272   unless ($this->no_signals()) {
 273     $this->_set_signal_handler('TERM', 0);
 274     $this->_set_signal_handler('HUP', 0);
 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($this->pm_parameter('pm_title'));
 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   return 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   my $PIDFILE;
 373   if (!open $PIDFILE, ">$fname") {
 374     $this->pm_warn("open: $fname: $!");
 375     return;
 376   }
 377   print $PIDFILE "$$\n" or die "Could not print PID: $!";
 378   close $PIDFILE or die "Could not close PID file: $!";
 379 }
 380
 381 =head2 pm_remove_pid_file
 382
 383  instance or export
 384  () pm_remove_pid_file()
 385
 386 DESCRIPTION:
 387
 388 Removes optionally specified file.  If no filename is specified, it uses
 389 the value of the C<pid_fname> parameter.
 390
 391 =cut
 392
 393 sub pm_remove_pid_file {
 394   my ($this,$fname) = self_or_default(@_);
 395   $fname ||= $this->pid_fname() or return;
 396   my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
 397   return $ret;
 398 }
 399
 400 =head2 sig_sub
 401
 402  instance
 403  () sig_sub(string name)
 404
 405 DESCRIPTION:
 406
 407 The name of this method is passed to POSIX::sigaction(), and handles signals
 408 for the process manager.  If $SIG_CODEREF is set, then the input arguments
 409 to this are passed to a call to that.
 410
 411 =cut
 412
 413 sub sig_sub {
 414   $SIG_CODEREF->(@_) if ref $SIG_CODEREF;
 415 }
 416
 417 =head2 sig_manager
 418
 419  instance
 420  () sig_manager(string name)
 421
 422 DESCRIPTION:
 423
 424 Handles signals of the process manager.  Takes as input the name of signal
 425 being handled.
 426
 427 =cut
 428
 429 sub sig_manager {
 430   my ($this,$name) = @_;
 431   if ($name eq "TERM") {
 432     $this->pm_notify("received signal $name");
 433     $this->pm_die("safe exit from signal $name");
 434   } elsif ($name eq "HUP") {
 435     # send a TERM to each of the servers, and pretend like nothing happened..
 436     if (my @pids = keys %{$this->{PIDS}}) {
 437       $this->pm_notify("sending TERM to PIDs, @pids");
 438       kill "TERM", @pids;
 439     }
 440   } else {
 441     $this->pm_notify("ignoring signal $name");
 442   }
 443 }
 444
 445 =head1 Handler methods
 446
 447 =head2 handling_init
 448
 449  instance or export
 450  () handling_init()
 451
 452 DESCRIPTION:
 453
 454 =cut
 455
 456 sub handling_init {
 457   my ($this) = @_;
 458
 459   # begin to handle signals.
 460   # We'll want accept(2) to return -1(EINTR) on caught signal..
 461   unless ($this->no_signals()) {
 462     $this->_set_signal_handler('TERM', 0);
 463     $this->_set_signal_handler('HUP', 0);
 464     $SIG_CODEREF = sub { $this->sig_handler(@_) };
 465   }
 466
 467   # change the name of this process as it appears in ps(1) output.
 468   $this->pm_change_process_name("perl-fcgi");
 469
 470   # Re-srand in case someone called rand before the fork, so that
 471   # children get different random numbers.
 472   srand;
 473 }
 474
 475 =head2 pm_pre_dispatch
 476
 477  instance or export
 478  () pm_pre_dispatch()
 479
 480 DESCRIPTION:
 481
 482 =cut
 483
 484 sub pm_pre_dispatch {
 485   my ($this) = self_or_default(@_);
 486
 487   # Now, we want the request to continue unhindered..
 488   unless ($this->no_signals()) {
 489     $this->_set_signal_handler('TERM', 1);
 490     $this->_set_signal_handler('HUP', 1);
 491   }
 492 }
 493
 494 =head2 pm_post_dispatch
 495
 496  instance or export
 497  () pm_post_dispatch()
 498
 499 DESCRIPTION:
 500
 501 =cut
 502
 503 sub pm_post_dispatch {
 504   my ($this) = self_or_default(@_);
 505   if ($this->pm_received_signal("TERM")) {
 506     $this->pm_exit("safe exit after SIGTERM");
 507   }
 508   if ($this->pm_received_signal("HUP")) {
 509     $this->pm_exit("safe exit after SIGHUP");
 510   }
 511   if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
 512     $this->pm_exit("safe exit: manager has died");
 513   }
 514   # We'll want accept(2) to return -1(EINTR) on caught signal..
 515   unless ($this->no_signals()) {
 516     $this->_set_signal_handler('TERM', 0);
 517     $this->_set_signal_handler('HUP', 0);
 518   }
 519 }
 520
 521 =head2 sig_handler
 522
 523  instance or export
 524  () sig_handler()
 525
 526 DESCRIPTION:
 527
 528 =cut
 529
 530 sub sig_handler {
 531   my ($this,$name) = @_;
 532   $this->pm_received_signal($name,1);
 533 }
 534
 535 =head1 Common methods and routines
 536
 537 =head2 self_or_default
 538
 539  private global
 540  (ProcManager, @args) self_or_default([ ProcManager, ] @args);
 541
 542 DESCRIPTION:
 543
 544 This is a helper subroutine to acquire or otherwise create a singleton
 545 default object if one is not passed in, e.g., a method call.
 546
 547 =cut
 548
 549 sub self_or_default {
 550   return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
 551   if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
 552              !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
 553     $Q or $Q = $FCGI::ProcManager::Default->new;
 554     unshift @_, $Q;
 555   }
 556   return wantarray ? @_ : $Q;
 557 }
 558
 559 =head2 pm_change_process_name
 560
 561  instance or export
 562  () pm_change_process_name()
 563
 564 DESCRIPTION:
 565
 566 =cut
 567
 568 sub pm_change_process_name {
 569   my ($this,$name) = self_or_default(@_);
 570   $0 = $name;
 571 }
 572
 573 =head2 pm_received_signal
 574
 575  instance or export
 576  () pm_received signal()
 577
 578 DESCRIPTION:
 579
 580 =cut
 581
 582 sub pm_received_signal {
 583   my ($this,$sig,$received) = self_or_default(@_);
 584   $sig or return $this->{SIG_RECEIVED};
 585   $received and $this->{SIG_RECEIVED}->{$sig}++;
 586   return $this->{SIG_RECEIVED}->{$sig};
 587 }
 588
 589 =head1 parameters
 590
 591 =head2 pm_parameter
 592
 593  instance or export
 594  () pm_parameter()
 595
 596 DESCRIPTION:
 597
 598 =cut
 599
 600 sub pm_parameter {
 601   my ($this,$key,$value) = self_or_default(@_);
 602   defined $value and $this->{$key} = $value;
 603   return $this->{$key};
 604 }
 605
 606 =head2 n_processes
 607
 608 =head2 no_signals
 609
 610 =head2 pid_fname
 611
 612 =head2 die_timeout
 613
 614 =head2 role
 615
 616 =head2 start_delay
 617
 618 DESCRIPTION:
 619
 620 =cut
 621
 622 sub n_processes     { shift->pm_parameter("n_processes",     @_); }
 623 sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
 624 sub no_signals      { shift->pm_parameter("no_signals",      @_); }
 625 sub die_timeout     { shift->pm_parameter("die_timeout",     @_); }
 626 sub role            { shift->pm_parameter("role",            @_); }
 627 sub start_delay     { shift->pm_parameter("start_delay",     @_); }
 628
 629 =head1 notification and death
 630
 631 =head2 pm_warn
 632
 633  instance or export
 634  () pm_warn()
 635
 636 DESCRIPTION:
 637
 638 =cut
 639
 640 sub pm_warn {
 641   my ($this,$msg) = self_or_default(@_);
 642   $this->pm_notify($msg);
 643 }
 644
 645 =head2 pm_notify
 646
 647  instance or export
 648  () pm_notify()
 649
 650 DESCRIPTION:
 651
 652 =cut
 653
 654 sub pm_notify {
 655   my ($this,$msg) = self_or_default(@_);
 656   $msg =~ s/\s*$/\n/;
 657   print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
 658 }
 659
 660 =head2 pm_exit
 661
 662  instance or export
 663  () pm_exit(string msg[, int exit_status])
 664
 665 DESCRIPTION:
 666
 667 =cut
 668
 669 sub pm_exit {
 670   my ($this,$msg,$n) = self_or_default(@_);
 671   $n ||= 0;
 672
 673   # if we still have children at this point, something went wrong.
 674   # SIGKILL them now.
 675   kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
 676
 677   $this->pm_warn($msg);
 678   $@ = $msg;
 679   exit $n;
 680 }
 681
 682 =head2 pm_abort
 683
 684  instance or export
 685  () pm_abort(string msg[, int exit_status])
 686
 687 DESCRIPTION:
 688
 689 =cut
 690
 691 sub pm_abort {
 692   my ($this,$msg,$n) = self_or_default(@_);
 693   $n ||= 1;
 694   $this->pm_exit($msg,1);
 695 }
 696
 697 1;
 698 __END__
 699
 700 =head1 BUGS
 701
 702 No known bugs, but this does not mean no bugs exist.
 703
 704 =head1 SEE ALSO
 705
 706 L<FCGI>.
 707
 708 =head1 MAINTAINER
 709
 710 Gareth Kirwan <gbjk@thermeon.com>
 711
 712 =head1 AUTHOR
 713
 714 James E Jurach Jr.
 715
 716 =head1 COPYRIGHT
 717
 718  FCGI-ProcManager - A Perl FCGI Process Manager
 719  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 720
 721  This library is free software; you can redistribute it and/or
 722  modify it under the terms of the GNU Lesser General Public
 723  License as published by the Free Software Foundation; either
 724  version 2 of the License, or (at your option) any later version.
 725
 726  BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 727  BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 728  OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 729  LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 730  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 731  ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 732  AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 733  License for more details.
 734
 735  You should have received a copy of the GNU Lesser General Public
 736  License along with this library; if not, write to the Free Software
 737  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
 738
 739 =cut