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.17 2001/02/09 16:15:47 muaddie Exp $
   9
  10 use strict;
  11 use Exporter;
  12
  13 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $Q);
  14 BEGIN {
  15   $VERSION = '0.16';
  16   @ISA = qw(Exporter);
  17   @EXPORT_OK = qw(pm_manage pm_die pm_wait
  18                   pm_write_pid_file pm_remove_pid_file
  19                   pm_pre_dispatch pm_post_dispatch
  20                   pm_change_process_name pm_received_signal pm_parameter
  21                   pm_warn pm_notify pm_abort pm_exit);
  22   $EXPORT_TAGS{all} = \@EXPORT_OK;
  23   $FCGI::ProcManager::Default = 'FCGI::ProcManager';
  24 }
  25
  26 =head1 NAME
  27
  28  FCGI::ProcManager - functions for managing FastCGI applications.
  29
  30 =head1 SYNOPSIS
  31
  32 {
  33  # In Object-oriented style.
  34  use CGI::Fast;
  35  use FCGI::ProcManager;
  36  my $proc_manager = FCGI::ProcManager->new({
  37         n_processes => 10
  38  });
  39  $proc_manager->pm_manage();
  40  while (my $cgi = CGI::Fast->new()) {
  41    $proc_manager->pm_pre_dispatch();
  42    # ... handle the request here ...
  43    $proc_manager->pm_post_dispatch();
  44  }
  45
  46  # This style is also supported:
  47  use CGI::Fast;
  48  use FCGI::ProcManager qw(pm_manage pm_pre_dispatch
  49                           pm_post_dispatch);
  50  pm_manage( n_processes => 10 );
  51  while (my $cgi = CGI::Fast->new()) {
  52    pm_pre_dispatch();
  53    #...
  54    pm_post_dispatch();
  55  }
  56
  57 =head1 DESCRIPTION
  58
  59 FCGI::ProcManager is used to serve as a FastCGI process manager.  By
  60 re-implementing it in perl, developers can more finely tune performance in
  61 their web applications, and can take advantage of copy-on-write semantics
  62 prevalent in UNIX kernel process management.  The process manager should
  63 be invoked before the caller''s request loop
  64
  65 The primary routine, C<pm_manage>, enters a loop in which it maintains a
  66 number of FastCGI servers (via fork(2)), and which reaps those servers
  67 when they die (via wait(2)).
  68
  69 C<pm_manage> provides too hooks:
  70
  71  C<managing_init> - called just before the manager enters the manager loop.
  72  C<handling_init> - called just before a server is returns from C<pm_manage>
  73
  74 It is necessary for the caller, when implementing its request loop, to
  75 insert a call to C<pm_pre_dispatch> at the top of the loop, and then
  76 7C<pm_post_dispatch> at the end of the loop.
  77
  78
  79 =head1 METHODS
  80
  81 =head2 new
  82
  83  class or instance
  84  (ProcManager) new([hash parameters])
  85
  86 Constructs a new process manager.  Takes an option has of initial parameter
  87 values, and assigns these to the constructed object HASH, overriding any
  88 default values.  The default parameter values currently are:
  89
  90  role         => manager
  91  start_delay  => 0
  92  die_timeout  => 60
  93
  94 =cut
  95
  96 sub new {
  97   my ($proto,$init) = @_;
  98
  99   my $this = {
 100               role => "manager",
 101               start_delay => 0,
 102               die_timeout => 60
 103              };
 104   $init and %$this = %$init;
 105
 106   bless $this, ref($proto)||$proto;
 107
 108   $this->{PIDS} = {};
 109
 110   return $this;
 111 }
 112
 113 =head1 Manager methods
 114
 115 =head2 pm_manage
 116
 117  instance or export
 118  (int) pm_manage([hash parameters])
 119
 120 DESCRIPTION:
 121
 122 When this is called by a FastCGI script to manage application servers.  It
 123 defines a sequence of instructions for a process to enter this method and
 124 begin forking off and managing those handlers, and it defines a sequence of
 125 instructions to intialize those handlers.
 126
 127 If n_processes < 1, the managing section is subverted, and only the
 128 handling sequence is executed.
 129
 130 Either returns the return value of pm_die() and/or pm_abort() (which will
 131 not ever return in general), or returns 1 to the calling script to begin
 132 handling requests.
 133
 134 =cut
 135
 136 sub pm_manage {
 137   my ($this,%values) = self_or_default(@_);
 138   map { $this->pm_parameter($_,$values{$_}) } keys %values;
 139
 140   # skip to handling now if we won't be managing any processes.
 141   $this->n_processes() or goto HANDLING;
 142
 143   # call the (possibly overloaded) management initialization hook.
 144   $this->role("manager");
 145   $this->managing_init();
 146   $this->pm_notify("initialized");
 147
 148   my $manager_pid = $$;
 149
 150  MANAGING_LOOP: while (1) {
 151
 152     # if the calling process goes away, perform cleanup.
 153     getppid() == 1 and
 154       return $this->pm_die("calling process has died");
 155
 156     $this->n_processes() > 0 or
 157       return $this->pm_die();
 158
 159     # while we have fewer servers than we want.
 160   PIDS: while (keys(%{$this->{PIDS}}) < $this->n_processes()) {
 161
 162       if (my $pid = fork()) {
 163         # the manager remembers the server.
 164         $this->{PIDS}->{$pid} = { pid=>$pid };
 165         $this->pm_notify("server (pid $pid) started");
 166
 167       } elsif (! defined $pid) {
 168         return $this->pm_abort("fork: $!");
 169
 170       } else {
 171         $this->role("server");
 172         $this->{MANAGER_PID} = $manager_pid;
 173         # the server exits the managing loop.
 174         last MANAGING_LOOP;
 175       }
 176
 177       for (my $s = $this->start_delay(); $s; $s = sleep $s) {};
 178     }
 179
 180     # this should block until the next server dies.
 181     $this->pm_wait();
 182
 183   }# while 1
 184
 185 HANDLING:
 186
 187   # forget any children we had been collecting.
 188   delete $this->{PIDS};
 189
 190   # call the (possibly overloaded) handling init hook
 191   $this->role("server");
 192   $this->handling_init();
 193   $this->pm_notify("initialized");
 194
 195   # server returns
 196   return 1;
 197 }
 198
 199 =head2 managing_init
 200
 201  instance
 202  () managing_init()
 203
 204 DESCRIPTION:
 205
 206 Overrideable method which initializes a process manager.  In order to
 207 handle signals, manage the PID file, and change the process name properly,
 208 any method which overrides this should call SUPER::managing_init().
 209
 210 =cut
 211
 212 sub managing_init {
 213   my ($this) = @_;
 214
 215   # begin to handle signals.
 216   $SIG{TERM} = sub { $this->sig_manager(@_) };
 217   $SIG{HUP}  = sub { $this->sig_manager(@_) };
 218
 219   # change the name of this process as it appears in ps(1) output.
 220   $this->pm_change_process_name("perl-fcgi-pm");
 221
 222   $this->pm_write_pid_file();
 223 }
 224
 225
 226 =head2 pm_die
 227
 228  instance or export
 229  () pm_die(string msg[, int exit_status])
 230
 231 DESCRIPTION:
 232
 233 This method is called when a process manager receives a notification to
 234 shut itself down.  pm_die() attempts to shutdown the process manager
 235 gently, sending a SIGTERM to each managed process, waiting die_timeout()
 236 seconds to reap each process, and then exit gracefully once all children
 237 are reaped, or to abort if all children are not reaped.
 238
 239 =cut
 240
 241 sub pm_die {
 242   my ($this,$msg,$n) = self_or_default(@_);
 243
 244   # stop handling signals.
 245   $SIG{HUP}  = 'DEFAULT';
 246   $SIG{TERM} = 'DEFAULT';
 247
 248   $this->pm_remove_pid_file();
 249
 250   # prepare to die no matter what.
 251   if (defined $this->die_timeout()) {
 252     $SIG{ARLM} = sub { $this->pm_abort("wait timeout") };
 253     alarm $this->die_timeout();
 254   }
 255
 256   # send a TERM to each of the servers.
 257   kill "TERM", keys %{$this->{PIDS}};
 258
 259   # wait for the servers to die.
 260   while (%{$this->{PIDS}}) {
 261     $this->pm_wait();
 262   }
 263
 264   # die already.
 265   $this->pm_exit("dying: ".$msg,$n);
 266 }
 267
 268 =head2 pm_wait
 269
 270  instance or export
 271  (int pid) pm_wait()
 272
 273 DESCRIPTION:
 274
 275 This calls wait() which suspends execution until a child has exited.
 276 If the process ID returned by wait corresponds to a managed process,
 277 pm_notify() is called with the exit status of that process.
 278 pm_wait() returns with the return value of wait().
 279
 280 =cut
 281
 282 sub pm_wait {
 283   my ($this) = self_or_default(@_);
 284
 285   # wait for the next server to die.
 286   next if (my $pid = wait()) < 0;
 287
 288   # notify when one of our servers have died.
 289   delete $this->{PIDS}->{$pid} and
 290     $this->pm_notify("server (pid $pid) exited with status $?");
 291
 292   return $pid;
 293 }
 294
 295 =head2 pm_write_pid_file
 296
 297  instance or export
 298  () pm_write_pid_file([string filename])
 299
 300 DESCRIPTION:
 301
 302 Writes current process ID to optionally specified file.  If no filename is
 303 specified, it uses the value of the C<pid_fname> parameter.
 304
 305 =cut
 306
 307 sub pm_write_pid_file {
 308   my ($this,$fname) = self_or_default(@_);
 309   $fname ||= $this->pid_fname() or return;
 310   if (!open PIDFILE, ">$fname") {
 311     $this->pm_warn("open: $fname: $!");
 312     return;
 313   }
 314   print PIDFILE "$$\n";
 315   close PIDFILE;
 316 }
 317
 318 =head2 pm_remove_pid_file
 319
 320  instance or export
 321  () pm_remove_pid_file()
 322
 323 DESCRIPTION:
 324
 325 Removes optionally specified file.  If no filename is specified, it uses
 326 the value of the C<pid_fname> parameter.
 327
 328 =cut
 329
 330 sub pm_remove_pid_file {
 331   my ($this,$fname) = self_or_default(@_);
 332   $fname ||= $this->pid_fname() or return;
 333   my $ret = unlink($fname) or $this->pm_warn("unlink: $fname: $!");
 334   return $ret;
 335 }
 336
 337 =head2 sig_manager
 338
 339  instance
 340  () sig_manager(string name)
 341
 342 DESCRIPTION:
 343
 344 Handles signals of the process manager.  Takes as input the name of signal
 345 being handled.
 346
 347 =cut
 348
 349 sub sig_manager {
 350   my ($this,$name) = @_;
 351   if ($name eq "TERM" or $name eq "HUP") {
 352     $this->pm_notify("received signal $name");
 353     $this->pm_die("safe exit from signal $name");
 354   } else {
 355     $this->pm_notify("ignoring signal $name");
 356   }
 357 }
 358
 359 =head1 Handler methods
 360
 361 =head2 handling_init
 362
 363  instance or export
 364  () handling_init()
 365
 366 DESCRIPTION:
 367
 368 =cut
 369
 370 sub handling_init {
 371   my ($this) = @_;
 372
 373   # begin to handle signals.
 374   $SIG{TERM} = sub { $this->sig_handler(@_) };
 375   $SIG{HUP}  = sub { $this->sig_handler(@_) };
 376
 377   # change the name of this process as it appears in ps(1) output.
 378   $this->pm_change_process_name("perl-fcgi");
 379 }
 380
 381 =head2 pm_pre_dispatch
 382
 383  instance or export
 384  () pm_pre_dispatch()
 385
 386 DESCRIPTION:
 387
 388 =cut
 389
 390 sub pm_pre_dispatch {
 391   my ($this) = self_or_default(@_);
 392 }
 393
 394 =head2 pm_post_dispatch
 395
 396  instance or export
 397  () pm_post_dispatch()
 398
 399 DESCRIPTION:
 400
 401 =cut
 402
 403 sub pm_post_dispatch {
 404   my ($this) = self_or_default(@_);
 405   if ($this->pm_received_signal("TERM")) {
 406     $this->pm_exit("safe exit after SIGTERM");
 407   }
 408   if ($this->pm_received_signal("HUP")) {
 409     $this->pm_exit("safe exit after SIGHUP");
 410   }
 411   if ($this->{MANAGER_PID} and getppid() != $this->{MANAGER_PID}) {
 412     $this->pm_exit("safe exit: manager has died");
 413   }
 414 }
 415
 416 =head2 sig_handler
 417
 418  instance or export
 419  () sig_handler()
 420
 421 DESCRIPTION:
 422
 423 =cut
 424
 425 sub sig_handler {
 426   my ($this,$name) = @_;
 427   $this->pm_received_signal($name,1);
 428 }
 429
 430 =head1 Common methods and routines
 431
 432 =head2 self_or_default
 433
 434  private global
 435  (ProcManager, @args) self_or_default([ ProcManager, ] @args);
 436
 437 DESCRIPTION:
 438
 439 This is a helper subroutine to acquire or otherwise create a singleton
 440 default object if one is not passed in, e.g., a method call.
 441
 442 =cut
 443
 444 sub self_or_default {
 445   return @_ if defined $_[0] and !ref $_[0] and $_[0] eq 'FCGI::ProcManager';
 446   if (!defined $_[0] or (ref($_[0]) ne 'FCGI::ProcManager' and
 447                          !UNIVERSAL::isa($_[0],'FCGI::ProcManager'))) {
 448     $Q or $Q = $FCGI::ProcManager::Default->new;
 449     unshift @_, $Q;
 450   }
 451   return wantarray ? @_ : $Q;
 452 }
 453
 454 =head2 pm_change_process_name
 455
 456  instance or export
 457  () pm_change_process_name()
 458
 459 DESCRIPTION:
 460
 461 =cut
 462
 463 sub pm_change_process_name {
 464   my ($this,$name) = self_or_default(@_);
 465   $0 = $name;
 466 }
 467
 468 =head2 pm_received_signal
 469
 470  instance or export
 471  () pm_received signal()
 472
 473 DESCRIPTION:
 474
 475 =cut
 476
 477 sub pm_received_signal {
 478   my ($this,$sig,$received) = self_or_default(@_);
 479   $sig or return $this->{SIG_RECEIVED};
 480   $received and $this->{SIG_RECEIVED}->{$sig}++;
 481   return $this->{SIG_RECEIVED}->{$sig};
 482 }
 483
 484 =head1 parameters
 485
 486 =head2 pm_parameter
 487
 488  instance or export
 489  () pm_parameter()
 490
 491 DESCRIPTION:
 492
 493 =cut
 494
 495 sub pm_parameter {
 496   my ($this,$key,$value) = self_or_default(@_);
 497   defined $value and $this->{$key} = $value;
 498   return $this->{$key};
 499 }
 500
 501 =head2 n_processes
 502
 503 =head2 no_signals
 504
 505 =head2 pid_fname
 506
 507 =head2 die_timeout
 508
 509 =head2 role
 510
 511 =head2 start_delay
 512
 513 DESCRIPTION:
 514
 515 =cut
 516
 517 sub n_processes     { shift->pm_parameter("n_processes",     @_); }
 518 sub pid_fname       { shift->pm_parameter("pid_fname",       @_); }
 519 sub no_signals      { shift->pm_parameter("no_signals",      @_); }
 520 sub die_timeout     { shift->pm_parameter("die_timeout",     @_); }
 521 sub role            { shift->pm_parameter("role",            @_); }
 522 sub start_delay     { shift->pm_parameter("start_delay",     @_); }
 523
 524 =head1 notification and death
 525
 526 =head2 pm_warn
 527
 528  instance or export
 529  () pm_warn()
 530
 531 DESCRIPTION:
 532
 533 =cut
 534
 535 sub pm_warn {
 536   my ($this,$msg) = self_or_default(@_);
 537   $this->pm_notify($msg);
 538 }
 539
 540 =head2 pm_notify
 541
 542  instance or export
 543  () pm_notify()
 544
 545 DESCRIPTION:
 546
 547 =cut
 548
 549 sub pm_notify {
 550   my ($this,$msg) = self_or_default(@_);
 551   $msg =~ s/\s*$/\n/;
 552   print STDERR "FastCGI: ".$this->role()." (pid $$): ".$msg;
 553 }
 554
 555 =head2 pm_exit
 556
 557  instance or export
 558  () pm_exit(string msg[, int exit_status])
 559
 560 DESCRIPTION:
 561
 562 =cut
 563
 564 sub pm_exit {
 565   my ($this,$msg,$n) = self_or_default(@_);
 566   $n ||= 0;
 567
 568   # if we still have children at this point, something went wrong.
 569   # SIGKILL them now.
 570   kill "KILL", keys %{$this->{PIDS}} if $this->{PIDS};
 571
 572   $this->pm_warn($msg);
 573   $@ = $msg;
 574   exit $n;
 575 }
 576
 577 =head2 pm_abort
 578
 579  instance or export
 580  () pm_abort(string msg[, int exit_status])
 581
 582 DESCRIPTION:
 583
 584 =cut
 585
 586 sub pm_abort {
 587   my ($this,$msg,$n) = self_or_default(@_);
 588   $n ||= 1;
 589   $this->pm_exit($msg,1);
 590 }
 591
 592 1;
 593 __END__
 594
 595 =head1 BUGS
 596
 597 No known bugs, but this does not mean no bugs exist.
 598
 599 =head1 SEE ALSO
 600
 601 L<FCGI>.
 602
 603 =head1 COPYRIGHT
 604
 605  FCGI-ProcManager - A Perl FCGI Process Manager
 606  Copyright (c) 2000, FundsXpress Financial Network, Inc.
 607
 608  This library is free software; you can redistribute it and/or
 609  modify it under the terms of the GNU Lesser General Public
 610  License as published by the Free Software Foundation; either
 611  version 2 of the License, or (at your option) any later version.
 612
 613  BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 614  BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 615  OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 616  LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 617  MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 618  ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 619  AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 620  License for more details.
 621
 622  You should have received a copy of the GNU Lesser General Public
 623  License along with this library; if not, write to the Free Software
 624  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
 625
 626 =cut